diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-06-28 10:26:52 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-06-28 10:26:52 +0000 |
commit | 939794ce7f602438ed45d70e74133b59358084a3 (patch) | |
tree | 2e3ce23b5846d49339628887d561e180bd669d82 | |
parent | 12acbbef543e5d6de5f6c344550cb865ecddd239 (diff) | |
download | guile-939794ce7f602438ed45d70e74133b59358084a3.tar.gz |
* Cleaned up initialization of asyncs.
* Moved handling of scm_gc_async to gc.c.
* Extracted handling of scheme level after-gc-hook from gc core.
-rw-r--r-- | libguile/ChangeLog | 36 | ||||
-rw-r--r-- | libguile/async.c | 38 | ||||
-rw-r--r-- | libguile/async.h | 3 | ||||
-rw-r--r-- | libguile/gc.c | 72 | ||||
-rw-r--r-- | libguile/init.c | 2 |
5 files changed, 106 insertions, 45 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 649fe9c4f..e5940c1b3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,41 @@ 2000-06-28 Dirk Herrmann <D.Herrmann@tu-bs.de> + * async.c (scm_gc_async, scm_gc_vcell, scm_sys_gc_async_thunk): + Moved to gc.c. + + (scm_init_async): Moved initialization for scm_gc_async and + scm_gc_vcell to gc.c. Moved initialization of scm_asyncs here + from gc.c. + + * async.h (scm_gc_async): Not globally visible any more. + + * gc.c (scm_gc_stats): Made callable even from within regions + where gc is blocked. + + (scm_gc_end): Eliminate the hardcoding of the marking of the + scm_gc_async from the gc core. + + (scm_init_storage): Don't initialize the scm_asyncs list here. + This is now done in asyncs.c. + + (scm_gc_vcell): Moved here from async.c. + + (gc_async): Renamed from scm_gc_async, moved here from async.c + and made static. + + (gc_async_thunk): Renamed from scm_sys_gc_async_thunk and moved + here from async.c. + + (mark_gc_async): New hook function for scm_after_gc_c_hook. + + (scm_init_gc): Added initialization of scm_gc_vcell and + gc_async. Further, add mark_gc_async to scm_after_gc_c_hook. + + * init.c (scm_boot_guile_1): scm_init_gc requires asyncs to be + initialized. + +2000-06-28 Dirk Herrmann <D.Herrmann@tu-bs.de> + * gc.c (scm_igc): Removed commented code that once was intended to unprotect struct types with no instances. diff --git a/libguile/async.c b/libguile/async.c index 39330a35f..b04796cd7 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -51,7 +51,6 @@ #include "libguile/throw.h" #include "libguile/root.h" #include "libguile/smob.h" -#include "libguile/gc.h" #include "libguile/validate.h" #include "libguile/async.h" @@ -442,36 +441,6 @@ SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, #undef FUNC_NAME #endif - - -/* points to the GC system-async, so that scm_gc_end can find it. */ -SCM scm_gc_async; - -/* the vcell for gc-thunk. */ -static SCM scm_gc_vcell; - -/* the thunk installed in the GC system-async, which is marked at the - end of garbage collection. */ -static SCM -scm_sys_gc_async_thunk (void) -{ - scm_c_run_hook (scm_after_gc_hook, SCM_EOL); - -#if (SCM_DEBUG_DEPRECATED == 0) - - /* The following code will be removed in Guile 1.5. */ - if (SCM_NFALSEP (scm_gc_vcell)) - { - SCM proc = SCM_CDR (scm_gc_vcell); - - if (SCM_NFALSEP (proc) && !SCM_UNBNDP (proc)) - scm_apply (proc, SCM_EOL, SCM_EOL); - } - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - - return SCM_UNSPECIFIED; -} @@ -501,15 +470,10 @@ SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, void scm_init_async () { - SCM a_thunk; - + scm_asyncs = SCM_EOL; tc16_async = scm_make_smob_type ("async", 0); scm_set_smob_mark (tc16_async, mark_async); - scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F); - a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk); - scm_gc_async = scm_system_async (a_thunk); - #include "libguile/async.x" } diff --git a/libguile/async.h b/libguile/async.h index 39d5868d7..b4fa403cb 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -49,11 +49,10 @@ #include "libguile/__scm.h" - extern unsigned int scm_mask_ints; -extern SCM scm_gc_async; + extern int scm_asyncs_pending (void); diff --git a/libguile/gc.c b/libguile/gc.c index c8aec31a9..0fe25d58b 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -572,7 +572,9 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, SCM answer; SCM_DEFER_INTS; - scm_block_gc = 1; + + ++scm_block_gc; + retry: heap_segs = SCM_EOL; n = scm_n_heap_segs; @@ -582,7 +584,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, heap_segs); if (scm_n_heap_segs != n) goto retry; - scm_block_gc = 0; + + --scm_block_gc; /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. @@ -619,12 +622,12 @@ scm_gc_start (const char *what) scm_gc_ports_collected = 0; } + void scm_gc_end () { scm_gc_rt = SCM_INUM (scm_get_internal_run_time ()) - scm_gc_rt; scm_gc_time_taken += scm_gc_rt; - scm_system_async_mark (scm_gc_async); } @@ -746,7 +749,6 @@ scm_alloc_cluster (scm_freelist_t *master) } #endif -SCM scm_after_gc_hook; scm_c_hook_t scm_before_gc_c_hook; scm_c_hook_t scm_before_mark_c_hook; @@ -880,6 +882,7 @@ scm_igc (const char *what) } + /* {Mark/Sweep} */ @@ -2309,7 +2312,6 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1, scm_stand_in_procs = SCM_EOL; scm_permobjs = SCM_EOL; scm_protects = scm_make_vector (SCM_MAKINUM (31), SCM_EOL); - scm_asyncs = SCM_EOL; scm_sysintern ("most-positive-fixnum", SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)); scm_sysintern ("most-negative-fixnum", SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)); #ifdef SCM_BIGDIG @@ -2317,12 +2319,72 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1, #endif return 0; } + +SCM scm_after_gc_hook; + +#if (SCM_DEBUG_DEPRECATED == 0) +static SCM scm_gc_vcell; /* the vcell for gc-thunk. */ +#endif /* SCM_DEBUG_DEPRECATED == 0 */ +static SCM gc_async; + + +/* The function gc_async_thunk causes the execution of the after-gc-hook. It + * is run after the gc, as soon as the asynchronous events are handled by the + * evaluator. + */ +static SCM +gc_async_thunk (void) +{ + scm_c_run_hook (scm_after_gc_hook, SCM_EOL); + +#if (SCM_DEBUG_DEPRECATED == 0) + + /* The following code will be removed in Guile 1.5. */ + if (SCM_NFALSEP (scm_gc_vcell)) + { + SCM proc = SCM_CDR (scm_gc_vcell); + + if (SCM_NFALSEP (proc) && !SCM_UNBNDP (proc)) + scm_apply (proc, SCM_EOL, SCM_EOL); + } + +#endif /* SCM_DEBUG_DEPRECATED == 0 */ + + return SCM_UNSPECIFIED; +} + + +/* The function mark_gc_async is run by the scm_after_gc_c_hook at the end of + * the garbage collection. The only purpose of this function is to mark the + * gc_async (which will eventually lead to the execution of the + * gc_async_thunk). + */ +static void * +mark_gc_async (void * hook_data, void *func_data, void *data) +{ + scm_system_async_mark (gc_async); + return NULL; +} + + void scm_init_gc () { + SCM after_gc_thunk; + scm_after_gc_hook = scm_create_hook ("after-gc-hook", 0); + +#if (SCM_DEBUG_DEPRECATED == 0) + scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F); +#endif /* SCM_DEBUG_DEPRECATED == 0 */ + /* Dirk:FIXME:: We don't really want a binding here. */ + after_gc_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, gc_async_thunk); + gc_async = scm_system_async (after_gc_thunk); + + scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0); + #include "libguile/gc.x" } diff --git a/libguile/init.c b/libguile/init.c index b7bb1644d..ea61c5b19 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -514,7 +514,7 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure) scm_init_hashtab (); scm_init_objprop (); scm_init_hooks (); /* Requires objprop until hook names are removed */ - scm_init_gc (); /* Requires hooks */ + scm_init_gc (); /* Requires hooks, async */ #ifdef GUILE_ISELECT scm_init_iselect (); #endif |