X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Falloc.c;h=2e056b54f8c9be5bf976082a3a9c869e04de072c;hb=02d7495253b9075e4d86275590c3e827c814b596;hp=82969472de94b2b9377e1c25b263744f618a98d7;hpb=60f5682d731a1973095c7fe620f2afb24fdfe087;p=sbcl.git

diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c
index 8296947..2e056b5 100644
--- a/src/runtime/alloc.c
+++ b/src/runtime/alloc.c
@@ -32,7 +32,7 @@
 #define ALIGNED_SIZE(n) ((n) + LOWTAG_MASK) & ~LOWTAG_MASK
 
 #ifdef LISP_FEATURE_GENCGC
-extern lispobj *alloc(int bytes);
+extern lispobj *alloc(long bytes);
 #endif
 
 static lispobj *
@@ -43,15 +43,33 @@ pa_alloc(int bytes)
     struct thread *th = arch_os_get_current_thread();
 
     /* FIXME: OOAO violation: see arch_pseudo_* */
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th);
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th);
+    clear_pseudo_atomic_interrupted(th);
+    set_pseudo_atomic_atomic(th);
     result = alloc(bytes);
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th);
-    if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th)))
-        /* Even if we gc at this point, the new allocation will be
-         * protected from being moved, because result is on the c stack
-         * and points to it. */
+    clear_pseudo_atomic_atomic(th);
+
+    if (get_pseudo_atomic_interrupted(th)) {
+        /* WARNING KLUDGE FIXME: pa_alloc() is not pseudo-atomic on
+         * anything but x86[-64]. maybe_defer_handler doesn't defer
+         * interrupts if foreign_function_call_active
+         *
+         * If the C stack is not scavenged during GC, result needs to
+         * be protected against not being referred to by any roots, so
+         * we push it onto the lisp control stack, and read it back
+         * off after any potential GC has finished */
+#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
+#error "!C_STACK_IS_CONTROL_STACK and STACK_GROWS_DOWNWARD_NOT_UPWARD is not supported"
+#endif
+        *current_control_stack_pointer = (lispobj) result;
+        current_control_stack_pointer += 1;
+#endif
         do_pending_interrupt();
+#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+        current_control_stack_pointer -= 1;
+        result = (lispobj *) *current_control_stack_pointer;
+#endif
+    }
 #else
     /* FIXME: this is not pseudo atomic at all, but is called only from
      * interrupt safe places like interrupt handlers. MG - 2005-08-09 */