summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-06-28 10:26:52 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-06-28 10:26:52 +0000
commit939794ce7f602438ed45d70e74133b59358084a3 (patch)
tree2e3ce23b5846d49339628887d561e180bd669d82
parent12acbbef543e5d6de5f6c344550cb865ecddd239 (diff)
downloadguile-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/ChangeLog36
-rw-r--r--libguile/async.c38
-rw-r--r--libguile/async.h3
-rw-r--r--libguile/gc.c72
-rw-r--r--libguile/init.c2
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