Changeset 11498 for branches/working-0711/ccl/level-1/l1-events.lisp
- Timestamp:
- Dec 9, 2008, 4:22:09 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/working-0711/ccl/level-1/l1-events.lisp
r11482 r11498 120 120 (defglobal *quit-interrupt-hook* nil) 121 121 122 (defun force-async-quit ( )122 (defun force-async-quit (signum) 123 123 (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)))) 126 130 127 131 (defstatic *running-periodic-tasks* nil) … … 154 158 (handle-gc-hooks) 155 159 (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. 160 165 (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) 164 170 (let* ((proc (select-interactive-abort-process))) 165 171 (if proc
Note: See TracChangeset
for help on using the changeset viewer.