1.0.25.37: block deferrables when gc pending in PA
[sbcl.git] / src / runtime / gencgc.c
index ab6aa6b..81ef8b2 100644 (file)
@@ -41,6 +41,7 @@
 #include "gc.h"
 #include "gc-internal.h"
 #include "thread.h"
+#include "pseudo-atomic.h"
 #include "alloc.h"
 #include "genesis/vector.h"
 #include "genesis/weak-pointer.h"
@@ -1154,6 +1155,7 @@ static page_index_t gencgc_alloc_start_page = -1;
 void
 gc_heap_exhausted_error_or_lose (long available, long requested)
 {
+    struct thread *thread = arch_os_get_current_thread();
     /* Write basic information before doing anything else: if we don't
      * call to lisp this is a must, and even if we do there is always
      * the danger that we bounce back here before the error has been
@@ -1166,12 +1168,13 @@ gc_heap_exhausted_error_or_lose (long available, long requested)
         /* If we are in GC, or totally out of memory there is no way
          * to sanely transfer control to the lisp-side of things.
          */
-        struct thread *thread = arch_os_get_current_thread();
         print_generation_stats(1);
         fprintf(stderr, "GC control variables:\n");
         fprintf(stderr, "          *GC-INHIBIT* = %s\n          *GC-PENDING* = %s\n",
                 SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true",
-                SymbolValue(GC_PENDING,thread)==NIL ? "false" : "true");
+                (SymbolValue(GC_PENDING, thread) == T) ?
+                "true" : ((SymbolValue(GC_PENDING, thread) == NIL) ?
+                  "false" : "in progress"));
 #ifdef LISP_FEATURE_SB_THREAD
         fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n",
                 SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true");
@@ -1181,6 +1184,18 @@ gc_heap_exhausted_error_or_lose (long available, long requested)
     else {
         /* FIXME: assert free_pages_lock held */
         (void)thread_mutex_unlock(&free_pages_lock);
+        gc_assert(get_pseudo_atomic_atomic(thread));
+        clear_pseudo_atomic_atomic(thread);
+        if (get_pseudo_atomic_interrupted(thread))
+            do_pending_interrupt();
+        /* Another issue is that signalling HEAP-EXHAUSTED error leads
+         * to running user code at arbitrary places, even in a
+         * WITHOUT-INTERRUPTS which may lead to a deadlock without
+         * running out of the heap. So at this point all bets are
+         * off. */
+        if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL)
+            corruption_warning_and_maybe_lose
+                ("Signalling HEAP-EXHAUSTED in a WITHOUT-INTERRUPTS.");
         funcall2(StaticSymbolFunction(HEAP_EXHAUSTED_ERROR),
                  alloc_number(available), alloc_number(requested));
         lose("HEAP-EXHAUSTED-ERROR fell through");
@@ -4087,7 +4102,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
         fprintf(stderr,
                 "/non-movable pages due to conservative pointers = %d (%d bytes)\n",
                 num_dont_move_pages,
-                npage_bytes(num_dont_move_pages);
+                npage_bytes(num_dont_move_pages));
     }
 #endif
 
@@ -4708,8 +4723,23 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg
             /* set things up so that GC happens when we finish the PA
              * section */
             SetSymbolValue(GC_PENDING,T,thread);
-            if (SymbolValue(GC_INHIBIT,thread) == NIL)
-              set_pseudo_atomic_interrupted(thread);
+            if (SymbolValue(GC_INHIBIT,thread) == NIL) {
+                set_pseudo_atomic_interrupted(thread);
+#ifdef LISP_FEATURE_PPC
+                /* PPC calls alloc() from a trap, look up the most
+                 * recent one and frob that. */
+                {
+                    int context_index =
+                        fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,
+                                                 thread));
+                    os_context_t *context =
+                        thread->interrupt_contexts[context_index - 1];
+                    maybe_save_gc_mask_and_block_deferrables(context);
+                }
+#else
+                maybe_save_gc_mask_and_block_deferrables(NULL);
+#endif
+            }
         }
     }
     new_obj = gc_alloc_with_region(nbytes, page_type_flag, region, 0);
@@ -4759,6 +4789,7 @@ general_alloc(long nbytes, int page_type_flag)
 lispobj *
 alloc(long nbytes)
 {
+    gc_assert(get_pseudo_atomic_atomic(arch_os_get_current_thread()));
     return general_alloc(nbytes, BOXED_PAGE_FLAG);
 }
 \f