X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=7ebf9911b3abd0294974ac99de487a63edb9ba01;hb=230707c1899c1c008f7ce2ad97e2fd04849f7443;hp=7847d61573d835f89ffbab961b7c1626a61bc5e7;hpb=701006499fa1508f73751a1d8eade18d6aa62613;p=sbcl.git

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index 7847d61..7ebf991 100644
--- a/src/runtime/purify.c
+++ b/src/runtime/purify.c
@@ -37,18 +37,10 @@
 
 #define PRINTNOISE
 
-#if defined(LISP_FEATURE_GENCGC)
-/* this is another artifact of the poor integration between gencgc and
- * the rest of the runtime: on cheney gc there is a global
- * dynamic_space_free_pointer which is valid whenever foreign function
- * call is active, but in gencgc there's no such variable and we have
- * to keep our own
- */
-static lispobj *dynamic_space_free_pointer;
-#endif
-
 extern unsigned long bytes_consed_between_gcs;
 
+static lispobj *dynamic_space_purify_pointer;
+
 
 /* These hold the original end of the read_only and static spaces so
  * we can tell what are forwarding pointers. */
@@ -102,12 +94,12 @@ dynamic_pointer_p(lispobj ptr)
 #ifndef LISP_FEATURE_GENCGC
     return (ptr >= (lispobj)current_dynamic_space
             &&
-            ptr < (lispobj)dynamic_space_free_pointer);
+            ptr < (lispobj)dynamic_space_purify_pointer);
 #else
     /* Be more conservative, and remember, this is a maybe. */
     return (ptr >= (lispobj)DYNAMIC_SPACE_START
             &&
-            ptr < (lispobj)dynamic_space_free_pointer);
+            ptr < (lispobj)dynamic_space_purify_pointer);
 #endif
 }
 
@@ -118,13 +110,13 @@ newspace_alloc(long nwords, int constantp)
     nwords=CEILING(nwords,2);
     if(constantp) {
         if(read_only_free + nwords >= (lispobj *)READ_ONLY_SPACE_END) {
-            lose("Ran out of read-only space while purifying!");
+            lose("Ran out of read-only space while purifying!\n");
         }
         ret=read_only_free;
         read_only_free+=nwords;
     } else {
         if(static_free + nwords >= (lispobj *)STATIC_SPACE_END) {
-            lose("Ran out of static space while purifying!");
+            lose("Ran out of static space while purifying!\n");
         }
         ret=static_free;
         static_free+=nwords;
@@ -376,6 +368,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 #endif
         case SAP_WIDETAG:
         case WEAK_POINTER_WIDETAG:
+#ifdef LUTEX_WIDETAG
+        case LUTEX_WIDETAG:
+#endif
             break;
 
         default:
@@ -537,8 +532,9 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant)
 static lispobj
 ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant)
 {
-    lispobj layout = ((struct instance *)native_pointer(thing))->slots[0];
-    lispobj pure = ((struct instance *)native_pointer(layout))->slots[15];
+    struct layout *layout =
+      (struct layout *) native_pointer(((struct instance *)native_pointer(thing))->slots[0]);
+    lispobj pure = layout->pure;
 
     switch (pure) {
     case T:
@@ -952,6 +948,11 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
 #endif
       case SAP_WIDETAG:
           return ptrans_unboxed(thing, header);
+#ifdef LUTEX_WIDETAG
+      case LUTEX_WIDETAG:
+          gencgc_unregister_lutex(native_pointer(thing));
+          return ptrans_unboxed(thing, header);
+#endif
 
       case RATIO_WIDETAG:
       case COMPLEX_WIDETAG:
@@ -1452,8 +1453,14 @@ purify(lispobj static_roots, lispobj read_only_roots)
     }
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-    dynamic_space_free_pointer =
+    dynamic_space_purify_pointer =
       (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
+#else
+#if defined(LISP_FEATURE_GENCGC)
+    dynamic_space_purify_pointer = get_alloc_pointer();
+#else
+    dynamic_space_purify_pointer = dynamic_space_free_pointer;
+#endif
 #endif
 
     read_only_end = read_only_free =
@@ -1515,10 +1522,12 @@ purify(lispobj static_roots, lispobj read_only_roots)
                (lispobj *)SymbolValue(BINDING_STACK_POINTER,thread) -
                (lispobj *)thread->binding_stack_start,
           0);
+#ifdef LISP_FEATURE_SB_THREAD
         pscav( (lispobj *) (thread+1),
                fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
                (sizeof (struct thread))/(sizeof (lispobj)),
           0);
+#endif
     }
 
 
@@ -1596,15 +1605,11 @@ purify(lispobj static_roots, lispobj read_only_roots)
     SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
     SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
 
-#if !defined(ALLOCATION_POINTER)
-    dynamic_space_free_pointer = current_dynamic_space;
-    set_auto_gc_trigger(bytes_consed_between_gcs);
-#else
 #if defined LISP_FEATURE_GENCGC
     gc_free_heap();
 #else
-#error unsupported case /* in CMU CL, was "ibmrt using GC" */
-#endif
+    dynamic_space_free_pointer = current_dynamic_space;
+    set_auto_gc_trigger(bytes_consed_between_gcs);
 #endif
 
     /* Blast away instruction cache */