summaryrefslogtreecommitdiff
path: root/libguile/gc.c
diff options
context:
space:
mode:
authorMichael Livshin <mlivshin@bigfoot.com>2001-05-26 22:10:58 +0000
committerMichael Livshin <mlivshin@bigfoot.com>2001-05-26 22:10:58 +0000
commit6b1b030e4de34568273e87176d3eb93eddf81c7f (patch)
tree8c5fd246c52cdc0f7f1af03975f6db1aac34f780 /libguile/gc.c
parentc014a02eec7b99c54d8a156ce491ae8d1e341f97 (diff)
downloadguile-6b1b030e4de34568273e87176d3eb93eddf81c7f.tar.gz
* gc.c (scm_init_storage): init `scm_gc_registered_roots'.
(scm_igc): mark from them, too (precisely, not conservatively!). * root.h (scm_gc_registered_roots): new object in scm_sys_protects. * hooks.c (scm_create_hook): call `scm_gc_protect_object' instead `scm_protect_object'. shouldn't call it at all, though, it seems. * gc.c (scm_[un]protect_object): deprecated. (scm_gc_[un]protect_object): new names for scm_[un]protect_object. (scm_gc_[un]register_root[s]): new. * gc.h: add prototypes for scm_gc_[un]protect_object, scm_gc_[un]register_root[s].
Diffstat (limited to 'libguile/gc.c')
-rw-r--r--libguile/gc.c98
1 files changed, 93 insertions, 5 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index 2069a1628..750ef4969 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1063,7 +1063,7 @@ scm_igc (const char *what)
/ sizeof (SCM_STACKITEM)));
{
- size_t stack_len = scm_stack_size (scm_stack_base);
+ unsigned long stack_len = scm_stack_size (scm_stack_base);
#ifdef SCM_STACK_GROWS_UP
scm_mark_locations (scm_stack_base, stack_len);
#else
@@ -1082,6 +1082,18 @@ scm_igc (const char *what)
while (j--)
scm_gc_mark (scm_sys_protects[j]);
+ /* mark the registered roots */
+ {
+ long i;
+ for (i = 0; i < SCM_VECTOR_LENGTH (scm_gc_registered_roots); ++i) {
+ SCM l = SCM_VELTS (scm_gc_registered_roots)[i];
+ for (; ! SCM_NULLP (l); l = SCM_CDR (l)) {
+ SCM *p = (SCM *) (scm_num2long (SCM_CAAR (l), 0, NULL));
+ scm_gc_mark (*p);
+ }
+ }
+ }
+
/* FIXME: we should have a means to register C functions to be run
* in different phases of GC
*/
@@ -2464,6 +2476,22 @@ scm_remember (SCM *ptr)
"Use the `scm_remember_upto_here*' family of functions instead.");
}
+SCM
+scm_protect_object (SCM obj)
+{
+ scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
+ "Use `scm_gc_protect_object' instead.");
+ return scm_gc_protect_object (obj);
+}
+
+SCM
+scm_unprotect_object (SCM obj)
+{
+ scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
+ "Use `scm_gc_unprotect_object' instead.");
+ return scm_gc_unprotect_object (obj);
+}
+
#endif /* SCM_DEBUG_DEPRECATED == 0 */
/*
@@ -2499,7 +2527,7 @@ scm_permanent_object (SCM obj)
/* Protect OBJ from the garbage collector. OBJ will not be freed, even if all
other references are dropped, until the object is unprotected by calling
- scm_unprotect_object (OBJ). Calls to scm_protect/unprotect_object nest,
+ scm_gc_unprotect_object (OBJ). Calls to scm_gc_protect/unprotect_object nest,
i. e. it is possible to protect the same object several times, but it is
necessary to unprotect the object the same number of times to actually get
the object unprotected. It is an error to unprotect an object more often
@@ -2508,11 +2536,11 @@ scm_permanent_object (SCM obj)
*/
/* Implementation note: For every object X, there is a counter which
- scm_protect_object(X) increments and scm_unprotect_object(X) decrements.
+ scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements.
*/
SCM
-scm_protect_object (SCM obj)
+scm_gc_protect_object (SCM obj)
{
SCM handle;
@@ -2533,7 +2561,7 @@ scm_protect_object (SCM obj)
See scm_protect_object for more information. */
SCM
-scm_unprotect_object (SCM obj)
+scm_gc_unprotect_object (SCM obj)
{
SCM handle;
@@ -2561,6 +2589,65 @@ scm_unprotect_object (SCM obj)
return obj;
}
+void
+scm_gc_register_root (SCM *p)
+{
+ SCM handle;
+ SCM key = scm_long2num ((long) p);
+
+ /* This critical section barrier will be replaced by a mutex. */
+ SCM_REDEFER_INTS;
+
+ handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key, SCM_MAKINUM (0));
+ SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1)));
+
+ SCM_REALLOW_INTS;
+}
+
+void
+scm_gc_unregister_root (SCM *p)
+{
+ SCM handle;
+ SCM key = scm_long2num ((long) p);
+
+ /* This critical section barrier will be replaced by a mutex. */
+ SCM_REDEFER_INTS;
+
+ handle = scm_hashv_get_handle (scm_gc_registered_roots, key);
+
+ if (SCM_FALSEP (handle))
+ {
+ fprintf (stderr, "scm_gc_unregister_root called on unregistered root\n");
+ abort ();
+ }
+ else
+ {
+ SCM count = scm_difference (SCM_CDR (handle), SCM_MAKINUM (1));
+ if (SCM_EQ_P (count, SCM_MAKINUM (0)))
+ scm_hashv_remove_x (scm_gc_registered_roots, key);
+ else
+ SCM_SETCDR (handle, count);
+ }
+
+ SCM_REALLOW_INTS;
+}
+
+void
+scm_gc_register_roots (SCM *b, unsigned long n)
+{
+ SCM *p = b;
+ for (; p < b + n; ++p)
+ scm_gc_register_root (p);
+}
+
+void
+scm_gc_unregister_roots (SCM *b, unsigned long n)
+{
+ SCM *p = b;
+ for (; p < b + n; ++p)
+ scm_gc_unregister_root (p);
+}
+
int terminating;
/* called on process termination. */
@@ -2712,6 +2799,7 @@ scm_init_storage ()
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
scm_protects = scm_c_make_hash_table (31);
+ scm_gc_registered_roots = scm_c_make_hash_table (31);
return 0;
}