X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=a9f69b6dbc1a23217a21a5707399533546a6eb0c;hb=f4d1ece090effb9fdfbd570baf1baa51bb5b21cb;hp=fb006cbdf48af1e3583618c42ae8a57e55b18517;hpb=6cbed049e2373d34fde8c96a3ce7b32b7034a7f2;p=sbcl.git

diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index fb006cb..a9f69b6 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -382,7 +382,7 @@ scav_code_header(lispobj *where, lispobj object)
         scavenge(&function_ptr->name, 1);
         scavenge(&function_ptr->arglist, 1);
         scavenge(&function_ptr->type, 1);
-        scavenge(&function_ptr->xrefs, 1);
+        scavenge(&function_ptr->info, 1);
     }
 
     return n_words;
@@ -1885,7 +1885,7 @@ scav_lose(lispobj *where, lispobj object)
 {
     lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
          (unsigned long)object,
-         widetag_of(*(lispobj*)native_pointer(object)));
+         widetag_of(object));
 
     return 0; /* bogus return value to satisfy static type checking */
 }
@@ -2406,9 +2406,8 @@ gc_search_space(lispobj *start, size_t words, lispobj *pointer)
 boolean
 maybe_gc(os_context_t *context)
 {
-#ifndef LISP_FEATURE_WIN32
+    lispobj gc_happened;
     struct thread *thread = arch_os_get_current_thread();
-#endif
 
     fake_foreign_function_call(context);
     /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
@@ -2434,32 +2433,115 @@ maybe_gc(os_context_t *context)
      * outer context.
      */
 #ifndef LISP_FEATURE_WIN32
-    if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
+    check_gc_signals_unblocked_or_lose(os_context_sigmask_addr(context));
+    unblock_gc_signals(0, 0);
+#endif
+    FSHOW((stderr, "/maybe_gc: calling SUB_GC\n"));
+    /* FIXME: Nothing must go wrong during GC else we end up running
+     * the debugger, error handlers, and user code in general in a
+     * potentially unsafe place. Running out of the control stack or
+     * the heap in SUB-GC are ways to lose. Of course, deferrables
+     * cannot be unblocked because there may be a pending handler, or
+     * we may even be in a WITHOUT-INTERRUPTS. */
+    gc_happened = funcall0(StaticSymbolFunction(SUB_GC));
+    FSHOW((stderr, "/maybe_gc: gc_happened=%s\n",
+           (gc_happened == NIL) ? "NIL" : "T"));
+    if ((gc_happened != NIL) &&
+        /* See if interrupts are enabled or it's possible to enable
+         * them. POST-GC has a similar check, but we don't want to
+         * unlock deferrables in that case and get a pending interrupt
+         * here. */
+        ((SymbolValue(INTERRUPTS_ENABLED,thread) != NIL) ||
+         (SymbolValue(ALLOW_WITH_INTERRUPTS,thread) != NIL))) {
+#ifndef LISP_FEATURE_WIN32
         sigset_t *context_sigmask = os_context_sigmask_addr(context);
-#ifdef LISP_FEATURE_SB_THREAD
-        /* What if the context we'd like to restore has GC signals
-         * blocked? Just skip the GC: we can't set GC_PENDING, because
-         * that would block the next attempt, and we don't know when
-         * we'd next check for it -- and it's hard to be sure that
-         * unblocking would be safe.
-         *
-         * FIXME: This is not actually much better: we may already have
-         * GC_PENDING set, and presumably our caller assumes that we will
-         * clear it. Perhaps we should, even though we don't actually GC? */
-        if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) {
-            undo_fake_foreign_function_call(context);
-            return 1;
+        if (!deferrables_blocked_p(context_sigmask)) {
+            thread_sigmask(SIG_SETMASK, context_sigmask, 0);
+            check_gc_signals_unblocked_or_lose(0);
+#endif
+            FSHOW((stderr, "/maybe_gc: calling POST_GC\n"));
+            funcall0(StaticSymbolFunction(POST_GC));
+#ifndef LISP_FEATURE_WIN32
+        } else {
+            FSHOW((stderr, "/maybe_gc: punting on POST_GC due to blockage\n"));
         }
 #endif
-        thread_sigmask(SIG_SETMASK, context_sigmask, 0);
     }
-    else
-        unblock_gc_signals();
-#endif
-    /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
-     * otherwise two threads racing here may deadlock: the other will
-     * wait on the GC lock, and the other cannot stop the first one... */
-    funcall0(StaticSymbolFunction(SUB_GC));
     undo_fake_foreign_function_call(context);
-    return 1;
+    FSHOW((stderr, "/maybe_gc: returning\n"));
+    return (gc_happened != NIL);
+}
+
+#define BYTES_ZERO_BEFORE_END (1<<12)
+
+/* There used to be a similar function called SCRUB-CONTROL-STACK in
+ * Lisp and another called zero_stack() in cheneygc.c, but since it's
+ * shorter to express in, and more often called from C, I keep only
+ * the C one after fixing it. -- MG 2009-03-25 */
+
+/* Zero the unused portion of the control stack so that old objects
+ * are not kept alive because of uninitialized stack variables.
+ *
+ * "To summarize the problem, since not all allocated stack frame
+ * slots are guaranteed to be written by the time you call an another
+ * function or GC, there may be garbage pointers retained in your dead
+ * stack locations. The stack scrubbing only affects the part of the
+ * stack from the SP to the end of the allocated stack." - ram, on
+ * cmucl-imp, Tue, 25 Sep 2001
+ *
+ * So, as an (admittedly lame) workaround, from time to time we call
+ * scrub-control-stack to zero out all the unused portion. This is
+ * supposed to happen when the stack is mostly empty, so that we have
+ * a chance of clearing more of it: callers are currently (2002.07.18)
+ * REPL, SUB-GC and sig_stop_for_gc_handler. */
+
+/* Take care not to tread on the guard page and the hard guard page as
+ * it would be unkind to sig_stop_for_gc_handler. Touching the return
+ * guard page is not dangerous. For this to work the guard page must
+ * be zeroed when protected. */
+
+/* FIXME: I think there is no guarantee that once
+ * BYTES_ZERO_BEFORE_END bytes are zero the rest are also zero. This
+ * may be what the "lame" adjective in the above comment is for. In
+ * this case, exact gc may lose badly. */
+void
+scrub_control_stack(void)
+{
+    struct thread *th = arch_os_get_current_thread();
+    os_vm_address_t guard_page_address = CONTROL_STACK_GUARD_PAGE(th);
+    os_vm_address_t hard_guard_page_address = CONTROL_STACK_HARD_GUARD_PAGE(th);
+    lispobj *sp;
+#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+    sp = (lispobj *)&sp - 1;
+#else
+    sp = current_control_stack_pointer;
+#endif
+ scrub:
+    if ((((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size)) &&
+         ((os_vm_address_t)sp >= hard_guard_page_address)) ||
+        (((os_vm_address_t)sp < (guard_page_address + os_vm_page_size)) &&
+         ((os_vm_address_t)sp >= guard_page_address) &&
+         (th->control_stack_guard_page_protected != NIL)))
+        return;
+#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
+    do {
+        *sp = 0;
+    } while (((unsigned long)sp--) & (BYTES_ZERO_BEFORE_END - 1));
+    if ((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size))
+        return;
+    do {
+        if (*sp)
+            goto scrub;
+    } while (((unsigned long)sp--) & (BYTES_ZERO_BEFORE_END - 1));
+#else
+    do {
+        *sp = 0;
+    } while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1));
+    if ((os_vm_address_t)sp >= hard_guard_page_address)
+        return;
+    do {
+        if (*sp)
+            goto scrub;
+    } while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1));
+#endif
 }