X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Fpurify.c;h=c4309e24405fc798c45526242209ccc738ba06b2;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=772b905b58385f47160f6fcd97cab5337c7ef7eb;hpb=34dcb46f78a01d543756703d7ccdf3d999a134d0;p=sbcl.git

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index 772b905..c4309e2 100644
--- a/src/runtime/purify.c
+++ b/src/runtime/purify.c
@@ -45,6 +45,7 @@
  */
 static lispobj *dynamic_space_free_pointer;
 #endif
+extern unsigned long bytes_consed_between_gcs;
 
 #define gc_abort() \
   lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
@@ -132,17 +133,11 @@ dynamic_pointer_p(lispobj ptr)
 
 static unsigned pointer_filter_verbose = 0;
 
-/* FIXME: This is substantially the same code as in gencgc.c. (There
- * are some differences, at least (1) the gencgc.c code needs to worry
- * about return addresses on the stack pinning code objects, (2) the
- * gencgc.c code needs to worry about the GC maybe happening in an
- * interrupt service routine when the main thread of control was
- * interrupted just as it had allocated memory and before it
- * initialized it, while PURIFY needn't worry about that, and (3) the
- * gencgc.c code has mutated more under maintenance since the fork
- * from CMU CL than the code here has.) The two versions should be
- * made to explicitly share common code, instead of just two different
- * cut-and-pasted versions. */
+/* FIXME: This is substantially the same code as
+ * possibly_valid_dynamic_space_pointer in gencgc.c.  The only
+ * relevant difference seems to be that the gencgc code also checks
+ * for raw pointers into Code objects */
+
 static int
 valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 {
@@ -274,7 +269,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 	case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
 	case SIMPLE_ARRAY_WIDETAG:
-	case COMPLEX_STRING_WIDETAG:
+	case COMPLEX_BASE_STRING_WIDETAG:
+	case COMPLEX_VECTOR_NIL_WIDETAG:
 	case COMPLEX_BIT_VECTOR_WIDETAG:
 	case COMPLEX_VECTOR_WIDETAG:
 	case COMPLEX_ARRAY_WIDETAG:
@@ -288,7 +284,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 #ifdef LONG_FLOAT_WIDETAG
 	case LONG_FLOAT_WIDETAG:
 #endif
-	case SIMPLE_STRING_WIDETAG:
+	case SIMPLE_ARRAY_NIL_WIDETAG:
+	case SIMPLE_BASE_STRING_WIDETAG:
 	case SIMPLE_BIT_VECTOR_WIDETAG:
 	case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
 	case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
@@ -905,6 +902,7 @@ static lispobj
 ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
 {
     switch (widetag_of(header)) {
+	/* FIXME: this needs a reindent */
       case BIGNUM_WIDETAG:
       case SINGLE_FLOAT_WIDETAG:
       case DOUBLE_FLOAT_WIDETAG:
@@ -921,12 +919,14 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
       case SAP_WIDETAG:
-        return ptrans_unboxed(thing, header);
+	  return ptrans_unboxed(thing, header);
 
       case RATIO_WIDETAG:
       case COMPLEX_WIDETAG:
       case SIMPLE_ARRAY_WIDETAG:
-      case COMPLEX_STRING_WIDETAG:
+      case COMPLEX_BASE_STRING_WIDETAG:
+      case COMPLEX_BIT_VECTOR_WIDETAG:
+      case COMPLEX_VECTOR_NIL_WIDETAG:
       case COMPLEX_VECTOR_WIDETAG:
       case COMPLEX_ARRAY_WIDETAG:
         return ptrans_boxed(thing, header, constant);
@@ -938,7 +938,10 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case SYMBOL_HEADER_WIDETAG:
         return ptrans_boxed(thing, header, 0);
 
-      case SIMPLE_STRING_WIDETAG:
+      case SIMPLE_ARRAY_NIL_WIDETAG:
+        return ptrans_vector(thing, 0, 0, 0, constant);
+
+      case SIMPLE_BASE_STRING_WIDETAG:
         return ptrans_vector(thing, 8, 1, 0, constant);
 
       case SIMPLE_BIT_VECTOR_WIDETAG:
@@ -1063,7 +1066,7 @@ pscav_code(struct code*code)
         gc_assert(!dynamic_pointer_p(func));
 
 #ifdef __i386__
-	/* Temporarly convert the self pointer to a real function
+	/* Temporarily convert the self pointer to a real function
 	 * pointer. */
 	((struct simple_fun *)native_pointer(func))->self
 	    -= FUN_RAW_ADDR_OFFSET;
@@ -1149,7 +1152,11 @@ pscav(lispobj *addr, int nwords, boolean constant)
                 count = 1;
                 break;
 
-              case SIMPLE_STRING_WIDETAG:
+	      case SIMPLE_ARRAY_NIL_WIDETAG:
+		count = 2;
+		break;
+
+              case SIMPLE_BASE_STRING_WIDETAG:
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
                 break;
@@ -1488,6 +1495,7 @@ purify(lispobj static_roots, lispobj read_only_roots)
 
 #if !defined(__i386__)
     dynamic_space_free_pointer = current_dynamic_space;
+    set_auto_gc_trigger(bytes_consed_between_gcs);
 #else
 #if defined LISP_FEATURE_GENCGC
     gc_free_heap();
@@ -1500,6 +1508,5 @@ purify(lispobj static_roots, lispobj read_only_roots)
     printf(" done]\n");
     fflush(stdout);
 #endif
-
     return 0;
 }