Ignore:
Timestamp:
Jun 5, 2009, 1:03:18 AM (10 years ago)
Author:
gz
Message:

Merge r11497:r11498 into trunk: pass signal number through to async quit handler so can exit by resignalling.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-events.lisp

    r12090 r12196  
    123123(defglobal *quit-interrupt-hook* nil)
    124124
    125 (defun force-async-quit ()
     125(defun force-async-quit (signum)
    126126  (when *quit-interrupt-hook*
    127     (funcall *quit-interrupt-hook*))
    128   (quit 143))
     127    (funcall *quit-interrupt-hook* signum))
     128  ;; Exit by resignalling, as per http://www.cons.org/cracauer/sigint.html
     129  (quit #'(lambda ()
     130            (ff-call (%kernel-import target::kernel-import-lisp-sigexit) :signed signum)
     131            ;; Shouldn't get here
     132            (#__exit 143))))
    129133
    130134(defstatic *running-periodic-tasks* nil)
     
    163167    (handle-gc-hooks)
    164168    (unless *inhibit-abort*
    165       (let ((id (pending-user-interrupt)))
    166         (cond ((eql id $user-interrupt-quit)
    167                ;; Doesn't matter where it happens, but try to use a process that
    168                ;; has a shot at reporting any problems in user hook.
     169      (let* ((id (pending-user-interrupt))
     170             (kind (logand #xFF id)))
     171        (cond ((eql kind $user-interrupt-quit)
     172               ;; Try to use a process that has a shot at reporting any problems
     173               ;; in case of bugs in user hook.
    169174               (let* ((proc (or (select-interactive-abort-process)
    170                                 *initial-process*)))
    171                  (process-interrupt proc #'force-async-quit)))
    172               ((eql id $user-interrupt-break)
     175                                *initial-process*))
     176                      (signum (ash id -8)))
     177                 (process-interrupt proc #'force-async-quit signum)))
     178              ((eql kind $user-interrupt-break)
    173179               (let* ((proc (select-interactive-abort-process)))
    174180                 (if proc
Note: See TracChangeset for help on using the changeset viewer.