Changeset 11450


Ignore:
Timestamp:
Dec 2, 2008, 6:11:23 AM (11 years ago)
Author:
gz
Message:

On non-windows platforms, handle SIGTERM by quitting in an orderly fashion. If ccl:*quit-interrupt-hook* is non-nil, it should be a function of no arguments to be invoked before quitting.

Location:
trunk/source
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/PPC/ppc-misc.lisp

    r11150 r11450  
    942942
    943943
    944 (defppclapfunction break-event-pending-p ()
     944(defppclapfunction pending-user-interrupt ()
    945945  (ref-global arg_z target::intflag)
     946  ;; If another signal happens now, it will get ignored, same as if it happened
     947  ;; before whatever signal is in arg_z.  But then these are async signals, so
     948  ;; who can be sure it didn't actually happen just before...
    946949  (set-global rzero target::intflag)
    947   (cmpri arg_z 0)
    948   (li arg_z nil)
    949   (beqlr)
    950   (la arg_z target::t-offset arg_z)
    951950  (blr))
    952951
  • trunk/source/level-0/X86/X8632/x8632-misc.lisp

    r11422 r11450  
    659659  (single-value-return))
    660660
    661 (defx8632lapfunction break-event-pending-p ()
     661(defx8632lapfunction pending-user-interrupt ()
    662662  (xorl (% temp0) (% temp0))
    663   (ref-global x8632::intflag imm0)
     663  (ref-global x8632::intflag arg_z)
     664  ;; If another signal happens now, it will get ignored, same as if it happened
     665  ;; before whatever signal is in arg_z.  But then these are async signals, so
     666  ;; who can be sure it didn't actually happen just before...
    664667  (set-global temp0 x8632::intflag)
    665   (testl (% imm0) (% imm0))
    666   (setne (%b imm0))
    667   (andl ($ x8632::t-offset) (%l imm0))
    668   (lea (@ (target-nil-value) (% imm0)) (% arg_z))
    669668  (single-value-return))
    670669
  • trunk/source/level-0/X86/x86-misc.lisp

    r11150 r11450  
    622622
    623623
    624 (defx86lapfunction break-event-pending-p ()
     624(defx86lapfunction pending-user-interrupt ()
    625625  (xorq (% imm0) (% imm0))
    626   (ref-global x8664::intflag imm1)
     626  (ref-global x8664::intflag arg_z)
     627  ;; If another signal happens now, it will get ignored, same as if it happened
     628  ;; before whatever signal is in arg_z.  But then these are async signals, so
     629  ;; who can be sure it didn't actually happen just before...
    627630  (set-global imm0 x8664::intflag)
    628   (testq (% imm1) (% imm1))
    629   (setne (%b imm0))
    630   (andl ($ x8664::t-offset) (%l imm0))
    631   (lea (@ (target-nil-value) (% imm0)) (% arg_z))
    632631  (single-value-return))
    633632
  • trunk/source/level-1/l1-events.lisp

    r10141 r11450  
    118118                            (clear-input *terminal-io*))))))
    119119
    120 
    121 
     120(defglobal *quit-interrupt-hook* nil)
     121
     122(defun force-async-quit ()
     123  (when *quit-interrupt-hook*
     124    (funcall *quit-interrupt-hook*))
     125  (quit 143))
    122126
    123127(defstatic *running-periodic-tasks* nil)
     
    143147             (when (functionp f) (funcall f)))))))
    144148
     149(defconstant $user-interrupt-break 1)
     150(defconstant $user-interrupt-quit 2)
     151
    145152(defun housekeeping ()
    146153  (progn
    147154    (handle-gc-hooks)
    148155    (unless *inhibit-abort*
    149       (when (break-event-pending-p)
    150         (let* ((proc (select-interactive-abort-process)))
    151           (if proc
    152             (force-break-in-listener proc)))))
     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* ((proc (or (select-interactive-abort-process)
     161                                *initial-process*)))
     162                 (process-interrupt proc #'force-async-quit)))
     163              ((eql id $user-interrupt-break)
     164               (let* ((proc (select-interactive-abort-process)))
     165                 (if proc
     166                   (force-break-in-listener proc)))))))
    153167    (flet ((maybe-run-periodic-task (task)
    154168             (let ((now (get-tick-count))
  • trunk/source/lib/ccl-export-syms.lisp

    r11373 r11450  
    7171     *backtrace-format*
    7272     *quit-on-eof*
     73     *quit-interrupt-hook*
    7374     macroexpand-all
    7475     compiler-macroexpand
  • trunk/source/lisp-kernel/pmcl-kernel.c

    r11374 r11450  
    730730
    731731void
    732 sigint_handler (int signum, siginfo_t *info, ExceptionInformation *context)
     732user_signal_handler (int signum, siginfo_t *info, ExceptionInformation *context)
    733733{
    734734  if (signum == SIGINT) {
    735735    lisp_global(INTFLAG) = (1 << fixnumshift);
    736736  }
     737  else if (signum == SIGTERM) {
     738    lisp_global(INTFLAG) = (2 << fixnumshift);
     739  }
    737740#ifdef DARWIN
    738741  DarwinSigReturn(context);
     
    742745
    743746void
    744 register_sigint_handler()
     747register_user_signal_handler()
    745748{
    746749#ifdef WINDOWS
     
    751754  SetConsoleCtrlHandler(ControlEventHandler,TRUE);
    752755#else
    753   install_signal_handler(SIGINT, (void *)sigint_handler);
     756  install_signal_handler(SIGINT, (void *)user_signal_handler);
     757  install_signal_handler(SIGTERM, (void *)user_signal_handler);
    754758#endif
    755759}
     
    16721676  lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock());
    16731677  enable_fp_exceptions();
    1674   register_sigint_handler();
     1678  register_user_signal_handler();
    16751679
    16761680#ifdef PPC
Note: See TracChangeset for help on using the changeset viewer.