Changeset 11495

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:

• branches/working-0711/ccl/level-1/l1-readloop.lisp (modified) (2 diffs)

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

@@ -108 +108 @@
 
 
-(defun quit (&optional (exit-status 0))
-  (unless (typep exit-status '(signed-byte 32))
-    (report-bad-arg exit-status '(signed-byte 32)))
+(defun quit (&optional (exit 0))
+  "exit must be either a (signed-byte 32) exit status or a function to call to exit lisp"
+  (if (or (null exit) (typep exit '(signed-byte 32)))
+    (setq exit (let ((exit-status (or exit 0)))
+                 #'(lambda () (#__exit exit-status))))
+    (unless (typep exit 'function)
+      (report-bad-arg exit '(or (signed-byte 32) function))))
   (let* ((ip *initial-process*)
          (cp *current-process*))
@@ -119 +123 @@
                                                        #'(lambda ()
                                                            (%set-toplevel nil)
-                                                           (#__exit exit-status)))))
+                                                           (funcall exit) ;; must exit
+                                                           (bug "Exit function didn't exit")))))
       (unless (eq cp ip)
         (process-kill cp)))))