Changeset 11482

Timestamp:

Dec 8, 2008, 5:15:49 PM (11 years ago)

Author:

gz

Message:

r11450 from trunk: *quit-interrupt-hook*

Location:

branches/working-0711/ccl

Files:

• level-0/X86/x86-misc.lisp (modified) (1 diff)
• level-1/l1-events.lisp (modified) (2 diffs)
• lib/ccl-export-syms.lisp (modified) (1 diff)
• lisp-kernel/pmcl-kernel.c (modified) (4 diffs)

branches/working-0711/ccl/level-0/X86/x86-misc.lisp

@@ -622 +622 @@
 
 
-(defx86lapfunction break-event-pending-p ()
+(defx86lapfunction pending-user-interrupt ()
   (xorq (% imm0) (% imm0))
-  (ref-global x8664::intflag imm1)
+  (ref-global x8664::intflag arg_z)
+  ;; If another signal happens now, it will get ignored, same as if it happened
+  ;; before whatever signal is in arg_z.  But then these are async signals, so
+  ;; who can be sure it didn't actually happen just before...
   (set-global imm0 x8664::intflag)
-  (testq (% imm1) (% imm1))
-  (setne (%b imm0))
-  (andl ($ x8664::t-offset) (%l imm0))
-  (lea (@ (target-nil-value) (% imm0)) (% arg_z))
   (single-value-return))
 

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

@@ -118 +118 @@
                             (clear-input *terminal-io*))))))
 
-
-
+(defglobal *quit-interrupt-hook* nil)
+
+(defun force-async-quit ()
+  (when *quit-interrupt-hook*
+    (funcall *quit-interrupt-hook*))
+  (quit 143))
 
 (defstatic *running-periodic-tasks* nil)
@@ -143 +147 @@
              (when (functionp f) (funcall f)))))))
 
+(defconstant $user-interrupt-break 1)
+(defconstant $user-interrupt-quit 2)
+
 (defun housekeeping ()
   (progn
     (handle-gc-hooks)
     (unless *inhibit-abort*
-      (when (break-event-pending-p)
-        (let* ((proc (select-interactive-abort-process)))
-          (if proc
-            (force-break-in-listener proc)))))
+      (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* ((proc (or (select-interactive-abort-process)
+                                *initial-process*)))
+                 (process-interrupt proc #'force-async-quit)))
+              ((eql id $user-interrupt-break)
+               (let* ((proc (select-interactive-abort-process)))
+                 (if proc
+                   (force-break-in-listener proc)))))))
     (flet ((maybe-run-periodic-task (task)
              (let ((now (get-tick-count))

branches/working-0711/ccl/lib/ccl-export-syms.lisp

@@ -65 +65 @@
      *backtrace-format*
      *quit-on-eof*
+     *quit-interrupt-hook*
      macroexpand-all
      compiler-macroexpand

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

@@ -730 +730 @@
 
 void
-sigint_handler (int signum, siginfo_t *info, ExceptionInformation *context)
+user_signal_handler (int signum, siginfo_t *info, ExceptionInformation *context)
 {
   if (signum == SIGINT) {
     lisp_global(INTFLAG) = (1 << fixnumshift);
   }
+  else if (signum == SIGTERM) {
+    lisp_global(INTFLAG) = (2 << fixnumshift);
+  }
 #ifdef DARWIN
   DarwinSigReturn(context);
@@ -742 +745 @@
 
 void
-register_sigint_handler()
+register_user_signal_handler()
 {
 #ifdef WINDOWS
@@ -751 +754 @@
   SetConsoleCtrlHandler(ControlEventHandler,TRUE);
 #else
-  install_signal_handler(SIGINT, (void *)sigint_handler);
+  install_signal_handler(SIGINT, (void *)user_signal_handler);
+  install_signal_handler(SIGTERM, (void *)user_signal_handler);
 #endif
 }
@@ -1672 +1676 @@
   lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock());
   enable_fp_exceptions();
-  register_sigint_handler();
+  register_user_signal_handler();
 
 #ifdef PPC