Changeset 11495


Ignore:
Timestamp:
Dec 9, 2008, 2:49:44 AM (11 years ago)
Author:
gz
Message:

Extend CCL:QUIT to accept a function to be used in place of #exit to actually exit the lisp

File:
1 edited

Legend:

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

    r11101 r11495  
    108108
    109109
    110 (defun quit (&optional (exit-status 0))
    111   (unless (typep exit-status '(signed-byte 32))
    112     (report-bad-arg exit-status '(signed-byte 32)))
     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"
     112  (if (or (null exit) (typep exit '(signed-byte 32)))
     113    (setq exit (let ((exit-status (or exit 0)))
     114                 #'(lambda () (#__exit exit-status))))
     115    (unless (typep exit 'function)
     116      (report-bad-arg exit '(or (signed-byte 32) function))))
    113117  (let* ((ip *initial-process*)
    114118         (cp *current-process*))
     
    119123                                                       #'(lambda ()
    120124                                                           (%set-toplevel nil)
    121                                                            (#__exit exit-status)))))
     125                                                           (funcall exit) ;; must exit
     126                                                           (bug "Exit function didn't exit")))))
    122127      (unless (eq cp ip)
    123128        (process-kill cp)))))
Note: See TracChangeset for help on using the changeset viewer.