mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

* Changed guardian representation to applicable smob.

Browse source 
* Improved error reporting for dynamic loading.
This commit is contained in:
Dirk Herrmann 2000-12-05 03:04:20 +00:00
parent 362306b956
commit 01449aa511
3 changed files with 116 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/ChangeLog
View file

@ -1,3 +1,30 @@
2000-12-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
* dynl.c (sysdep_dynl_link): Improved error reporting.
* guardians.c: Changed the representation from a compiled closure
to an applicable smob.
(guard1, CCLO_G): Removed.
(guard, g_mark, g_print, scm_tc16_guardian, scm_guardian_gc_init,
scm_guardian_zombify): Renamed to guardian_apply, guardian_mark,
guardian_print, tc16_guardian, guardian_gc_init and
guardian_zombify, respectively.
(guardian_free): Added, fixes a memory leak.
(guardian_print): Don't use sprintf hack.
(guardian_apply, scm_guard, scm_get_one_zombie,
scm_make_guardian): Don't use a compiled closure.
(guardian_zombify): Prefer !SCM_NULLP over SCM_NIMP. No need to
use SCM_GCCDR any more. Simplified loop condition.
(scm_init_guardian): Don't use scm_make_smob_type_mfpe for smob
initialization. Initialize applicable smob.
2000-12-04 Dirk Herrmann <D.Herrmann@tu-bs.de>
* chars.c (scm_char_eq_p): Minor cleanup/optimization.

7
libguile/dynl.c
View file

@ -239,8 +239,13 @@ sysdep_dynl_link (const char *fname, const char *subr)
handle = lt_dlopenext (fname);
if (NULL == handle)
{
SCM fn;
SCM msg;
SCM_ALLOW_INTS;
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
fn = scm_makfrom0str (fname);
msg = scm_makfrom0str (lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", SCM_LIST2 (fn, msg));
}
return (void *) handle;
}

156
libguile/guardians.c
View file

@ -54,24 +54,29 @@
* Modified by: Mikael Djurfeldt
*/
#include <stdio.h>
#include <assert.h>
#include "libguile/_scm.h"
#include "libguile/ports.h"
#include "libguile/print.h"
#include "libguile/smob.h"
#include "libguile/vectors.h"
#include "libguile/validate.h"
#include "libguile/guardians.h"
static long scm_tc16_guardian;
/* The live and zombies FIFOs are implemented as tconcs as described
in Dybvig's paper. This decouples addition and removal of elements
so that no synchronization between these needs to take place.
*/
typedef struct tconc_t
{
SCM head;
SCM tail;
} tconc_t;
#define TCONC_EMPTYP(tc) (SCM_EQ_P ((tc).head, (tc).tail))
#define TCONC_IN(tc, obj, pair) \
do { \
SCM_SETCAR ((tc).tail, obj); \
@ -87,13 +92,8 @@ do { \
(tc).head = SCM_CDR ((tc).head); \
} while (0)
#define TCONC_EMPTYP(tc) (SCM_EQ_P ((tc).head, (tc).tail))
typedef struct tconc_t
{
SCM head;
SCM tail;
} tconc_t;
static long tc16_guardian;
typedef struct guardian_t
{
@ -107,33 +107,69 @@ typedef struct guardian_t
#define GUARDIAN_ZOMBIES(x) (GUARDIAN (x)->zombies)
#define GUARDIAN_NEXT(x) (GUARDIAN (x)->next)
#define CCLO_G(cclo) (SCM_VELTS (cclo)[1])
/* subr constructed from guard below. */
static SCM guard1;
/* during the gc mark phase, live guardians are linked into a list here. */
static guardian_t *first_live_guardian = NULL;
static guardian_t **current_link_field = NULL;
/* this is wrapped in a compiled closure and is the Scheme entry point
for each guardian: if arg is an object, it's added to the
guardian's live list. if arg is unbound, the next available
zombified object (or #f if none) is returned. */
/* mark a guardian by adding it to the live guardian list. */
static SCM
guard (SCM cclo, SCM arg)
guardian_mark (SCM ptr)
{
*current_link_field = GUARDIAN (ptr);
current_link_field = &GUARDIAN_NEXT (ptr);
GUARDIAN_NEXT (ptr) = NULL;
/* the objects protected by the guardian are not marked here: that
would prevent them from ever getting collected. instead marking
is done at the end of the mark phase by scm_guardian_zombify. */
return SCM_BOOL_F;
}
static scm_sizet
guardian_free (SCM ptr)
{
scm_must_free (GUARDIAN (ptr));
return sizeof (guardian_t);
}
static int
guardian_print (SCM g, SCM port, scm_print_state *pstate)
{
scm_puts ("#<guardian live objs: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_LIVE (g).head)), port);
scm_puts (" zombies: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_ZOMBIES (g).head)), port);
scm_puts (">", port);
return 1;
}
/* This is the Scheme entry point for each guardian: If arg is an object, it's
* added to the guardian's live list. If arg is unbound, the next available
* zombified object (or #f if none) is returned.
*/
static SCM
guardian_apply (SCM guardian, SCM arg)
{
if (!SCM_UNBNDP (arg))
{
scm_guard (cclo, arg);
scm_guard (guardian, arg);
return SCM_UNSPECIFIED;
}
else
return scm_get_one_zombie (cclo);
return scm_get_one_zombie (guardian);
}
void
scm_guard (SCM guardian, SCM obj)
{
SCM g = CCLO_G (guardian);
if (SCM_NIMP (obj))
if (!SCM_IMP (obj))
{
SCM z;
@ -141,25 +177,26 @@ scm_guard (SCM guardian, SCM obj)
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
TCONC_IN (GUARDIAN_LIVE (g), obj, z);
TCONC_IN (GUARDIAN_LIVE (guardian), obj, z);
SCM_ALLOW_INTS;
}
}
SCM
scm_get_one_zombie (SCM guardian)
{
SCM g = CCLO_G (guardian);
SCM res = SCM_BOOL_F;
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (g)))
TCONC_OUT (GUARDIAN_ZOMBIES (g), res);
if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (guardian)))
TCONC_OUT (GUARDIAN_ZOMBIES (guardian), res);
SCM_ALLOW_INTS;
return res;
}
SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
(),
"Create a new guardian.\n"
@ -181,8 +218,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
"and Implementation, June 1993.")
#define FUNC_NAME s_scm_make_guardian
{
SCM cclo = scm_makcclo (guard1, 2L);
guardian_t *g = SCM_MUST_MALLOC_TYPE(guardian_t);
guardian_t *g = SCM_MUST_MALLOC_TYPE (guardian_t);
SCM z1 = scm_cons (SCM_BOOL_F, SCM_EOL);
SCM z2 = scm_cons (SCM_BOOL_F, SCM_EOL);
SCM z;
@ -191,23 +227,16 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
g->live.head = g->live.tail = z1;
g->zombies.head = g->zombies.tail = z2;
SCM_NEWSMOB (z, scm_tc16_guardian, g);
SCM_NEWSMOB (z, tc16_guardian, g);
CCLO_G (cclo) = z;
return cclo;
return z;
}
#undef FUNC_NAME
/* during the gc mark phase, live guardians are linked into a list
here. */
static guardian_t *first_live_guardian = NULL;
static guardian_t **current_link_field = NULL;
/* called before gc mark phase begins to initialise the live guardian
list. */
/* called before gc mark phase begins to initialise the live guardian list. */
static void *
scm_guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
{
current_link_field = &first_live_guardian;
first_live_guardian = NULL;
@ -215,25 +244,12 @@ scm_guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
return 0;
}
/* mark a guardian by adding it to the live guardian list. */
static SCM
g_mark (SCM ptr)
{
*current_link_field = GUARDIAN (ptr);
current_link_field = &GUARDIAN_NEXT (ptr);
GUARDIAN_NEXT (ptr) = NULL;
/* the objects protected by the guardian are not marked here: that
would prevent them from ever getting collected. instead marking
is done at the end of the mark phase by scm_guardian_zombify. */
return SCM_BOOL_F;
}
/* this is called by the garbage collector between the mark and sweep
phases. for each marked guardian, it moves any unmarked object in
its live list (tconc) to its zombie list (tconc). */
static void *
scm_guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
{
guardian_t *first_guardian;
guardian_t **link_field = &first_live_guardian;
@ -282,7 +298,7 @@ scm_guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
/* Mark the cells of the live list (yes, the cells in the list,
even though we don't care about objects pointed to by the list
cars, since we know they are already marked). */
for (pair = g->live.head; SCM_NIMP (pair); pair = SCM_GCCDR (pair))
for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair))
SCM_SETGCMARK (pair);
}
@ -302,37 +318,25 @@ scm_guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
/* Preserve the zombies in their undead state, by marking to
prevent collection. Note that this may uncover zombified
guardians -- if so, they'll be processed in the next loop. */
for (g = first_guardian; g && (!*link_field || g != *link_field); g = g->next)
for (g = first_guardian; g != *link_field; g = g->next)
scm_gc_mark (g->zombies.head);
} while (current_link_field != link_field);
return 0;
}
/* not generally used, since guardian smob is wrapped in a closure.
maybe useful for debugging. */
static int
g_print (SCM exp, SCM port, scm_print_state *pstate)
{
char buf[256];
sprintf (buf, "#<guardian live objs: %lu zombies: %lu>",
scm_ilength (SCM_CDR (GUARDIAN_LIVE (exp).head)),
scm_ilength (SCM_CDR (GUARDIAN_ZOMBIES (exp).head)));
scm_puts (buf, port);
return 1;
}
void
scm_init_guardian()
{
scm_tc16_guardian = scm_make_smob_type_mfpe ("guardian", sizeof (guardian_t),
g_mark, NULL, g_print, NULL);
guard1 = scm_make_subr_opt ("guardian", scm_tc7_subr_2o, guard, 0);
scm_c_hook_add (&scm_before_mark_c_hook, scm_guardian_gc_init, 0, 0);
scm_c_hook_add (&scm_before_sweep_c_hook, scm_guardian_zombify, 0, 0);
tc16_guardian = scm_make_smob_type ("guardian", 0);
scm_set_smob_mark (tc16_guardian, guardian_mark);
scm_set_smob_free (tc16_guardian, guardian_free);
scm_set_smob_print (tc16_guardian, guardian_print);
scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 1, 0);
scm_c_hook_add (&scm_before_mark_c_hook, guardian_gc_init, 0, 0);
scm_c_hook_add (&scm_before_sweep_c_hook, guardian_zombify, 0, 0);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/guardians.x"