Changeset 12082


Ignore:
Timestamp:
May 19, 2009, 12:48:56 AM (10 years ago)
Author:
gz
Message:

Add an :error-handler keyword arg to cl:quit

Location:
branches/working-0711/ccl/level-1
Files:
2 edited

Legend:

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

    r11411 r12082  
    633633(defmethod process-exit-application ((process process) thunk)
    634634  (when (eq process *initial-process*)
    635     (prepare-to-quit)
     635    (with-standard-abort-handling "Exit Lisp"
     636      (prepare-to-quit)
     637      (fresh-line *stdout*)
     638      (finish-output *stdout*))
    636639    (%set-toplevel thunk)
    637     (fresh-line *stdout*)
    638     (finish-output *stdout*)
    639640    (toplevel)))
    640641
  • branches/working-0711/ccl/level-1/l1-readloop.lisp

    r12050 r12082  
    108108
    109109
    110 (defun quit (&optional (exit 0))
    111   "exit must be either a (signed-byte 32) exit status or a function to call to exit lisp"
     110(defun quit (&optional (exit 0) &key error-handler)
     111  "exit must be either a (signed-byte 32) exit status or a function to call to exit lisp
     112   error-handler can be a function of one argument, the condition, that will be called if an
     113   error occurs while preparing to quit.  The error handler should exit"
    112114  (if (or (null exit) (typep exit '(signed-byte 32)))
    113115    (setq exit (let ((exit-status (or exit 0)))
     
    120122      (process-interrupt ip
    121123                         #'(lambda ()
    122                              (process-exit-application *current-process*
    123                                                        #'(lambda ()
    124                                                            (%set-toplevel nil)
    125                                                            (funcall exit) ;; must exit
    126                                                            (bug "Exit function didn't exit")))))
     124                             (handler-bind ((error (lambda (c)
     125                                                     (when error-handler
     126                                                       (funcall error-handler c)))))
     127                               (process-exit-application *current-process*
     128                                                         #'(lambda ()
     129                                                             (%set-toplevel nil)
     130                                                             (funcall exit) ;; must exit
     131                                                             (bug "Exit function didn't exit"))))))
    127132      (unless (eq cp ip)
    128133        (process-kill cp)))))
Note: See TracChangeset for help on using the changeset viewer.