NJF DOLIST/MACROLET patch for vmtran (sbcl-devel 2002-01-07,

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

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 85bc4c8..8c36aad 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -247,10 +247,6 @@
 (defvar +++ nil #!+sb-doc "the previous value of ++")
 (defvar -   nil #!+sb-doc "the form currently being evaluated")
 
-;;; the top level prompt string, or a function of no arguments that
-;;; returns a simple-string
-(defvar *prompt* "* ")
-
 (defun interactive-eval (form)
   "Evaluate FORM, returning whatever it returns and adjusting ***, **, *,
    +++, ++, +, ///, //, /, and -."
@@ -452,7 +448,9 @@
       (flush-standard-output-streams)
 
       (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL-INIT")
-      (toplevel-repl noprint))))
+      (toplevel-repl noprint)
+      ;; (classic CMU CL error message: "You're certainly a clever child.":-)
+      (critically-unreachable "after TOPLEVEL-REPL"))))
 
 ;;; read-eval-print loop for the default system toplevel
 (defun toplevel-repl (noprint)
@@ -461,20 +459,30 @@
        (- nil)
        (+ nil) (++ nil) (+++ nil)
        (/// nil) (// nil) (/ nil))
-    (/show0 "about to set up restarts in TOPLEVEL-REPL")
-    ;; There should only be one TOPLEVEL restart, and it's here, so
-    ;; restarting at TOPLEVEL always bounces you all the way out here.
-    (with-simple-restart (toplevel
-                         "Restart at toplevel READ/EVAL/PRINT loop.")
-      ;; We add a new ABORT restart for every debugger level, so 
-      ;; restarting at ABORT in a nested debugger gets you out to the
-      ;; innermost enclosing debugger, and only when you're in the
-      ;; outermost, unnested debugger level does restarting at ABORT 
-      ;; get you out to here.
-      (with-simple-restart (abort "Reduce debugger level (leaving debugger).")
-       (catch 'toplevel-catcher
-         (sb!unix:unix-sigsetmask 0)   ; FIXME: What is this for?
-         (repl noprint))))))
+    ;; WITH-SIMPLE-RESTART doesn't actually restart its body as some
+    ;; (like WHN for an embarrassingly long time ca. 2001-12-07) might
+    ;; think, but instead drops control back out at the end. So when a
+    ;; TOPLEVEL or outermost-ABORT restart happens, we need this outer
+    ;; LOOP wrapper to grab control and start over again. (And it also
+    ;; wraps CATCH 'TOPLEVEL-CATCHER for similar reasons.)
+    (loop
+     (/show0 "about to set up restarts in TOPLEVEL-REPL")
+     ;; There should only be one TOPLEVEL restart, and it's here, so
+     ;; restarting at TOPLEVEL always bounces you all the way out here.
+     (with-simple-restart (toplevel
+                          "Restart at toplevel READ/EVAL/PRINT loop.")
+       ;; We add a new ABORT restart for every debugger level, so 
+       ;; restarting at ABORT in a nested debugger gets you out to the
+       ;; innermost enclosing debugger, and only when you're in the
+       ;; outermost, unnested debugger level does restarting at ABORT 
+       ;; get you out to here.
+       (with-simple-restart
+          (abort
+           "Reduce debugger level (leaving debugger, returning to toplevel).")
+        (catch 'toplevel-catcher
+          (sb!unix:unix-sigsetmask 0)  ; FIXME: What is this for?
+          (repl noprint)
+          (critically-unreachable "after REPL")))))))
 
 (defun repl (noprint)
   (/show0 "entering REPL")
@@ -483,14 +491,11 @@
      ;; FIXME: It seems bad to have GC behavior depend on scrubbing the
      ;; control stack before each interactive command. Isn't there some
      ;; way we can convince the GC to just ignore dead areas of the
-     ;; control stack, so that we don't need to rely on this
-     ;; half-measure?
+     ;; control stack, so that we don't need to rely on this half-measure?
      (scrub-control-stack)
      (unless noprint
        (fresh-line)
-       (princ (if (functionp *prompt*)
-                 (funcall *prompt*)
-                 *prompt*))
+       (write-string "* ") ; arbitrary but customary REPL prompt
        (flush-standard-output-streams))
      (let ((form (read *standard-input* nil eof-marker)))
        (cond ((eq form eof-marker)