[uim-commit] r2843 - branches/r5rs/sigscheme

[kzk at freedesktop.org]

Author: kzk
Date: 2006-01-08 01:35:39 -0800 (Sun, 08 Jan 2006)
New Revision: 2843

Modified:
   branches/r5rs/sigscheme/storage-compact.h
   branches/r5rs/sigscheme/storage-gc.c
Log:
* sigscheme/storage-compact.h
  - (SCM_HAS_VALID_CDR_GCBITP): new macro

* sigscheme/storage-gc.c
  - (within_heapp): check the consistency between obj's tag and cdr's
    GC bit.
  - (mark_obj): split into compact version and fatty version.


Modified: branches/r5rs/sigscheme/storage-compact.h
===================================================================
--- branches/r5rs/sigscheme/storage-compact.h	2006-01-08 09:31:24 UTC (rev 2842)
+++ branches/r5rs/sigscheme/storage-compact.h	2006-01-08 09:35:39 UTC (rev 2843)
@@ -942,6 +942,10 @@
 #define SCM_CANBE_MARKED(a)   (SCM_TAG(a) != SCM_TAG_IMM)
 #define SCM_STRIP_TAG_INFO(a) (SCM_STRIP_TAG(a))
 
+/* the upper bit of obj's tag and cdr's GC bit must be the same value */
+#define SCM_HAS_VALID_CDR_GCBITP(obj, cdr)                             \
+    ((SCM_TAG(obj) >> (SCM_TAG_OFFSET + (SCM_TAG_WIDTH - 1))) == SCM_GCBIT(cdr))
+
 /* When we sweep the object, we have no type information because the pointer is
  * not tagged (raw pointer to heap). So, we see the S->cdr's GC bit and its
  * value is 1, the object contains the pointer to be freed. */

Modified: branches/r5rs/sigscheme/storage-gc.c
===================================================================
--- branches/r5rs/sigscheme/storage-gc.c	2006-01-08 09:31:24 UTC (rev 2842)
+++ branches/r5rs/sigscheme/storage-gc.c	2006-01-08 09:35:39 UTC (rev 2843)
@@ -343,21 +343,67 @@
     }
 }
 
+#if SCM_OBJ_COMPACT
 static void
 mark_obj(ScmObj obj)
 {
     int i = 0;
+    unsigned int tag;
 
 mark_loop:
-#if SCM_OBJ_COMPACT
     /* no need to mark immediates */
     if (!SCM_CANBE_MARKED(obj))
         return;
-#else
+
+    /* avoid cyclic marking */
+    if (SCM_IS_MARKED(obj))
+        return;
+
+    /* mark this object */
+    SCM_DO_MARK(obj);
+
+    /* mark recursively */
+    tag = SCM_TAG(obj);
+    switch (tag) {
+    case SCM_TAG_CONS:
+        mark_obj(SCM_CAR(obj));
+        obj = CDR(obj);
+        goto mark_loop;
+
+    case SCM_TAG_CLOSURE:
+        mark_obj(SCM_CLOSURE_EXP(obj));
+        obj = SCM_CLOSURE_ENV(obj);
+        goto mark_loop;
+
+    case SCM_TAG_OTHERS:
+        if (SYMBOLP(obj)) {
+            obj = SCM_SYMBOL_VCELL(obj);
+            goto mark_loop;
+        } else if (VECTORP(obj)) {
+            for (i = 0; i < SCM_VECTOR_LEN(obj); i++) {
+                mark_obj(SCM_VECTOR_VEC(obj)[i]);
+            }
+        } else if (VALUEPACKETP(obj)) {
+            obj = SCM_VALUEPACKET_VALUES(obj);
+            goto mark_loop;
+        }
+        break;
+
+    default:
+        break;
+    }
+}
+#else /* SCM_OBJ_COMPACT */
+static void
+mark_obj(ScmObj obj)
+{
+    int i = 0;
+
+mark_loop:
     /* no need to mark constants */
     if (SCM_CONSTANTP(obj))
         return;
-#endif
+
     /* avoid cyclic marking */
     if (SCM_IS_MARKED(obj))
         return;
@@ -400,6 +446,7 @@
         break;
     }
 }
+#endif /* SCM_OBJ_COMPACT */
 
 static void
 finalize_protected_var(void)
@@ -435,8 +482,14 @@
 
     for (i = 0; i < n_heaps; i++) {
         heap = heaps[i];
-        if (heap && &heap[0] <= ptr && ptr < &heap[heap_size])
+        if (heap && &heap[0] <= ptr && ptr < &heap[heap_size]) {
+#if SCM_OBJ_COMPACT
+            /* Check the consistency between obj's tag and ptr->cdr's GC bit. */
+            if (!SCM_HAS_VALID_CDR_GCBITP(obj, ptr->cdr))
+                return scm_false;
+#endif
             return scm_true;
+        }
     }
 
     return scm_false;