mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 16:50:21 +02:00
* 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.
This commit is contained in:
Dirk Herrmann
parent
12acbbef54
commit
939794ce7f
5 changed files with 106 additions and 45 deletions
|
|
@ -1,3 +1,39 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue