Changeset 11498


Ignore:
Timestamp:
Dec 9, 2008, 4:22:09 PM (11 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:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-events.lisp

    r11482 r11498  
    120120(defglobal *quit-interrupt-hook* nil)
    121121
    122 (defun force-async-quit ()
     122(defun force-async-quit (signum)
    123123  (when *quit-interrupt-hook*
    124     (funcall *quit-interrupt-hook*))
    125   (quit 143))
     124    (funcall *quit-interrupt-hook* signum))
     125  ;; Exit by resignalling, as per http://www.cons.org/cracauer/sigint.html
     126  (quit #'(lambda ()
     127            (ff-call (%kernel-import target::kernel-import-lisp-sigexit) :signed signum)
     128            ;; Shouldn't get here
     129            (#__exit 143))))
    126130
    127131(defstatic *running-periodic-tasks* nil)
     
    154158    (handle-gc-hooks)
    155159    (unless *inhibit-abort*
    156       (let ((id (pending-user-interrupt)))
    157         (cond ((eql id $user-interrupt-quit)
    158                ;; Doesn't matter where it happens, but try to use a process that
    159                ;; has a shot at reporting any problems in user hook.
     160      (let* ((id (pending-user-interrupt))
     161             (kind (logand #xFF id)))
     162        (cond ((eql kind $user-interrupt-quit)
     163               ;; Try to use a process that has a shot at reporting any problems
     164               ;; in case of bugs in user hook.
    160165               (let* ((proc (or (select-interactive-abort-process)
    161                                 *initial-process*)))
    162                  (process-interrupt proc #'force-async-quit)))
    163               ((eql id $user-interrupt-break)
     166                                *initial-process*))
     167                      (signum (ash id -8)))
     168                 (process-interrupt proc #'force-async-quit signum)))
     169              ((eql kind $user-interrupt-break)
    164170               (let* ((proc (select-interactive-abort-process)))
    165171                 (if proc
  • branches/working-0711/ccl/lisp-kernel/pmcl-kernel.c

    r11482 r11498  
    733733{
    734734  if (signum == SIGINT) {
    735     lisp_global(INTFLAG) = (1 << fixnumshift);
     735    lisp_global(INTFLAG) = (((signum<<8) + 1) << fixnumshift);
    736736  }
    737737  else if (signum == SIGTERM) {
    738     lisp_global(INTFLAG) = (2 << fixnumshift);
     738    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
     739  }
     740  else if (signum == SIGQUIT) {
     741    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
    739742  }
    740743#ifdef DARWIN
Note: See TracChangeset for help on using the changeset viewer.