X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Fpurify.c;h=7ebf9911b3abd0294974ac99de487a63edb9ba01;hb=223a19cb93b3ace1b039f3afb3152723027a1fe9;hp=ca850dd4bd4af6127476073095413d35d1931e2d;hpb=c2144640eeb8875228a121c76cc778e2af661064;p=sbcl.git

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index ca850dd..7ebf991 100644
--- a/src/runtime/purify.c
+++ b/src/runtime/purify.c
@@ -37,27 +37,9 @@
 
 #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;
 
-#define gc_abort() \
-  lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
-
-#if 1
-#define gc_assert(ex) do { \
-        if (!(ex)) gc_abort(); \
-} while (0)
-#else
-#define gc_assert(ex)
-#endif
+static lispobj *dynamic_space_purify_pointer;
 
 
 /* These hold the original end of the read_only and static spaces so
@@ -112,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
 }
 
@@ -128,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;
@@ -386,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:
@@ -547,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:
@@ -962,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:
@@ -1462,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 =
@@ -1491,9 +1488,8 @@ purify(lispobj static_roots, lispobj read_only_roots)
     printf(" handlers");
     fflush(stdout);
 #endif
-    pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers,
-          sizeof(all_threads->interrupt_data->interrupt_handlers)
-          / sizeof(lispobj),
+    pscav((lispobj *) interrupt_handlers,
+          sizeof(interrupt_handlers) / sizeof(lispobj),
           0);
 
 #ifdef PRINTNOISE
@@ -1526,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
     }
 
 
@@ -1607,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 */