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

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index ba07c21..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
 }
 
@@ -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:
@@ -953,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:
@@ -1453,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 =
@@ -1516,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
     }
 
 
@@ -1597,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 */