0.8alpha.0.9:

[sbcl.git] / src / code / toplevel.lisp

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 3faf43e..1fc56c9 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -46,7 +46,7 @@
 ;;; by QUIT) is caught and any final processing and return codes are
 ;;; handled appropriately.
 (defmacro handling-end-of-the-world (&body body)
-  (let ((caught (gensym "CAUGHT")))
+  (with-unique-names (caught)
     `(let ((,caught (catch '%end-of-the-world
                      (/show0 "inside CATCH '%END-OF-THE-WORLD")
                      ,@body)))
@@ -521,7 +521,7 @@
           ;; have unwound enough stack by the time we get here that this
           ;; is now possible
           (sb!kernel::protect-control-stack-guard-page 1)
-          (repl :noprint noprint :break-level 0)
+          (funcall *repl-fun* noprint)
           (critically-unreachable "after REPL")))))))
 
 ;;; Our default REPL prompt is the minimal traditional one.
@@ -539,7 +539,6 @@
        (quit)
        form)))
 
-  
 ;;; hooks to support customized toplevels like ACL-style toplevel
 ;;; from KMR on sbcl-devel 2002-12-21
 (defvar *repl-read-form-fun* #'repl-read-form-fun
@@ -551,42 +550,32 @@
 (defvar *repl-prompt-fun* #'repl-prompt-fun
   "a function of one argument STREAM for the toplevel REPL to call: Prompt
   the user for input.")
-
-(defvar *noprint* nil "boolean: T if don't print prompt and output")
-(defvar *break-level* 0 "current break level")
-(defvar *inspect-break* nil "boolean: T if break caused by inspect")
-(defvar *continuable-break* nil "boolean: T if break caused by continuable error")
-
-(defun repl (&key
-            (break-level (1+ *break-level*))
-            (noprint *noprint*)
-            (inspect nil)
-            (continuable nil))
-  (let ((*noprint* noprint)
-       (*break-level* break-level)
-       (*inspect-break* inspect)
-       (*continuable-break* continuable))
-    (/show0 "entering REPL")
-    (loop
-     ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
-     (scrub-control-stack)
-     (unless *noprint*
-       (funcall *repl-prompt-fun* *standard-output*)
-       ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own
-       ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to
-       ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems
-       ;; odd. But maybe there *is* a valid reason in some
-       ;; circumstances? perhaps some deadlock issue when being driven
-       ;; by another process or something...)
-       (force-output *standard-output*))
-     (let* ((form (funcall *repl-read-form-fun*
-                          *standard-input*
-                          *standard-output*))
-           (results (multiple-value-list (interactive-eval form))))
-       (unless *noprint*
-        (dolist (result results)
-          (fresh-line)
-          (prin1 result)))))))
+(defvar *repl-fun* #'repl-fun
+  "a function of one argument NOPRINT that provides the REPL for the system.
+  Assumes that *standard-input* and *standard-output* are setup.")
+
+(defun repl-fun (noprint)
+  (/show0 "entering REPL")
+  (loop
+   ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
+   (scrub-control-stack)
+   (unless noprint
+     (funcall *repl-prompt-fun* *standard-output*)
+     ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own
+     ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to
+     ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems
+     ;; odd. But maybe there *is* a valid reason in some
+     ;; circumstances? perhaps some deadlock issue when being driven
+     ;; by another process or something...)
+     (force-output *standard-output*))
+   (let* ((form (funcall *repl-read-form-fun*
+                        *standard-input*
+                        *standard-output*))
+         (results (multiple-value-list (interactive-eval form))))
+     (unless noprint
+       (dolist (result results)
+        (fresh-line)
+        (prin1 result))))))
 
 ;;; suitable value for *DEBUGGER-HOOK* for a noninteractive Unix-y program
 (defun noprogrammer-debugger-hook-fun (condition old-debugger-hook)