Changeset 11498

Timestamp:

Dec 9, 2008, 4:22:09 PM (12 years ago)

Author:

gz

Message:

Pass the signal number through to user handlers, use it to exit by resignalling

Location:

branches/working-0711/ccl

Files:

• level-1/l1-events.lisp (modified) (2 diffs)
• lisp-kernel/pmcl-kernel.c (modified) (1 diff)

branches/working-0711/ccl/level-1/l1-events.lisp

@@ -120 +120 @@
 (defglobal *quit-interrupt-hook* nil)
 
-(defun force-async-quit ()
+(defun force-async-quit (signum)
   (when *quit-interrupt-hook*
-    (funcall *quit-interrupt-hook*))
-  (quit 143))
+    (funcall *quit-interrupt-hook* signum))
+  ;; Exit by resignalling, as per http://www.cons.org/cracauer/sigint.html
+  (quit #'(lambda ()
+            (ff-call (%kernel-import target::kernel-import-lisp-sigexit) :signed signum)
+            ;; Shouldn't get here
+            (#__exit 143))))
 
 (defstatic *running-periodic-tasks* nil)
@@ -154 +158 @@
     (handle-gc-hooks)
     (unless *inhibit-abort*
-      (let ((id (pending-user-interrupt)))
-        (cond ((eql id $user-interrupt-quit)
-               ;; Doesn't matter where it happens, but try to use a process that
-               ;; has a shot at reporting any problems in user hook.
+      (let* ((id (pending-user-interrupt))
+             (kind (logand #xFF id)))
+        (cond ((eql kind $user-interrupt-quit)
+               ;; Try to use a process that has a shot at reporting any problems
+               ;; in case of bugs in user hook.
                (let* ((proc (or (select-interactive-abort-process)
-                                *initial-process*)))
-                 (process-interrupt proc #'force-async-quit)))
-              ((eql id $user-interrupt-break)
+                                *initial-process*))
+                      (signum (ash id -8)))
+                 (process-interrupt proc #'force-async-quit signum)))
+              ((eql kind $user-interrupt-break)
                (let* ((proc (select-interactive-abort-process)))
                  (if proc

branches/working-0711/ccl/lisp-kernel/pmcl-kernel.c

@@ -733 +733 @@
 {
   if (signum == SIGINT) {
-    lisp_global(INTFLAG) = (1 << fixnumshift);
+    lisp_global(INTFLAG) = (((signum<<8) + 1) << fixnumshift);
   }
   else if (signum == SIGTERM) {
-    lisp_global(INTFLAG) = (2 << fixnumshift);
+    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
+  }
+  else if (signum == SIGQUIT) {
+    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
   }
 #ifdef DARWIN