0.8.3.76

     GC fixes and miscellaneous commentary:

     Frob VOP attributes for {push-words-on,pop-words-from}-c-stack,
     per APD comment

     Comment: why WITH-PINNED-OBJECTS doesn't need an UNWIND-PROTECT

     In x86 pseudo-atomic start, clear interrupted bit _before_
     setting atomic bit, to eliminate window where a pa section might
     be interrupted immediately after starting then have the evidence
     of interruption erased

     When scavenging thread control stacks on gencgc, also look at live
     interrupt contexts that might not be on the current stack (e.g.
     alternate signal stacks).

     When stopping a thread so it may be GCed, save the signal context
     _before_ decrementing countdown_to_gc

     In lose(), send SIGSTOP to all threads other than the currently
     losing one, so we have a chance to examine what went wrong before
     they stomp all over memory

src/compiler/fndb.lisp

@@ -1422,10 +1422,10 @@
 
 ;;;; ALIEN and call-out-to-C stuff
 
-;;; 'call' attribute because we store the arg on the stack, which is in
+;;; 'unsafe' attribute because we store the arg on the stack, which is in
 ;;; some sense 'passing it upwards'
-(defknown sb!vm::push-word-on-c-stack (system-area-pointer) (values) (call))
-(defknown sb!vm::pop-words-from-c-stack (index) (values) (call))
+(defknown sb!vm::push-word-on-c-stack (system-area-pointer) (values) (unsafe))
+(defknown sb!vm::pop-words-from-c-stack (index) (values) ())
 
 ;;;; miscellaneous internal utilities
 

src/compiler/x86/macros.lisp

@@ -303,11 +303,11 @@
 (defmacro pseudo-atomic (&rest forms)
   (with-unique-names (label)
     `(let ((,label (gen-label)))
-      (inst fs-segment-prefix)
-      (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
       (inst fs-segment-prefix)
       (inst mov (make-ea :byte 
-		 :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) 
+		 :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
+      (inst fs-segment-prefix)
+      (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
       ,@forms
       (inst fs-segment-prefix)
       (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0)
@@ -433,7 +433,7 @@
 	       value)
 	 (move result value)))))
 
-;;; helper for alien stuff
+;;; helper for alien stuff.
 (defmacro sb!sys::with-pinned-objects ((&rest objects) &body body)
   "Arrange with the garbage collector that the pages occupied by
 OBJECTS will not be moved in memory for the duration of BODY.
@@ -445,4 +445,9 @@ garbage collection"
 		 collect `(push-word-on-c-stack
 			   (int-sap (sb!kernel:get-lisp-obj-address ,p))))
 	 ,@body)
+     ;; If the body returned normally, we should restore the stack pointer
+     ;; for the benefit of any following code in the same function.  If
+     ;; there's a non-local exit in the body, sp is garbage anyway and
+     ;; will get set appropriately from {a, the} frame pointer before it's
+     ;; next needed
      (pop-words-from-c-stack ,(length objects))))

src/runtime/gencgc.c

@@ -3674,6 +3674,7 @@ garbage_collect_generation(int generation, int raise)
     for_each_thread(th) {
 	void **ptr;
 	void **esp= (void **) &raise;
+	int i=0,free;
 #ifdef LISP_FEATURE_SB_THREAD
 	if(th!=arch_os_get_current_thread()) {
 	    os_context_t *last_context=get_interrupt_context_for_thread(th);
@@ -3683,6 +3684,16 @@ garbage_collect_generation(int generation, int raise)
 	for (ptr = (void **)th->control_stack_end; ptr > esp;  ptr--) {
 	    preserve_pointer(*ptr);
 	}
+	/* also need to check registers in any interrupt contexts on
+	 * an alternate signal stack */
+	free=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th));
+	for(i=0;i<free;i++){
+	    os_context_t *c=th->interrupt_contexts[i];
+	    if(c>=th->control_stack_end && c<esp) continue;
+	    for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) {
+		preserve_pointer(*ptr);
+	    }
+	}
     }
 
 #if QSHOW

src/runtime/interr.c

@@ -27,6 +27,7 @@
 #include "lispregs.h"
 #include "genesis/static-symbols.h"
 #include "genesis/vector.h"
+#include "thread.h"
 
 /* the way that we shut down the system on a fatal error */
 
@@ -47,6 +48,15 @@ lose(char *fmt, ...)
 {
     va_list ap;
     fprintf(stderr, "fatal error encountered in SBCL pid %d",getpid());
+    /* freeze all the other threads, so we have a chance of debugging them 
+     */
+    if(all_threads) {
+	struct thread *th1,*th=arch_os_get_current_thread();
+	for_each_thread(th1) {
+	    if(th1!=th) kill(th1->pid,SIGSTOP);
+	}
+    }
+
     if (fmt) {
 	fprintf(stderr, ":\n");
 	va_start(ap, fmt);

src/runtime/interrupt.c

@@ -425,6 +425,8 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 
 void
 run_deferred_handler(struct interrupt_data *data, void *v_context) {
+    fprintf(stderr,"Running deferred handler for %d, 0x%x\n",
+	    data->pending_signal, data->pending_handler);
     (*(data->pending_handler))
 	(data->pending_signal,&(data->pending_info), v_context);
 }
@@ -514,12 +516,15 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
     sigemptyset(&block);
     sigaddset_blockable(&block);
     sigprocmask(SIG_BLOCK, &block, 0);
+
+    /* need the context stored so it can have registers scavenged */
+    fake_foreign_function_call(context); 
+
     get_spinlock(&all_threads_lock,thread->pid);
     countdown_to_gc--;
     release_spinlock(&all_threads_lock);
-    /* need the context stored so it can have registers scavenged */
-    fake_foreign_function_call(context); 
     kill(getpid(),SIGSTOP);
+
     undo_fake_foreign_function_call(context);
 }
 

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.3.75"
+"0.8.3.76"