0.9.8.34:

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

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 2dae8cb..d3b3271 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -25,9 +25,7 @@
 ;;; specials initialized by !COLD-INIT
 
 ;;; FIXME: These could be converted to DEFVARs.
-(declaim (special *gc-inhibit* *need-to-collect-garbage*
-                  *after-gc-hooks*
-                  #!+(or x86 x86-64) *pseudo-atomic-atomic*
+(declaim (special #!+(or x86 x86-64) *pseudo-atomic-atomic*
                   #!+(or x86 x86-64) *pseudo-atomic-interrupted*
                   sb!unix::*interrupts-enabled*
                   sb!unix::*interrupt-pending*
@@ -298,8 +296,10 @@ steppers to maintain contextual information.")
                   *error-output*
                   *query-io*
                   *standard-output*
-                  *trace-output*))
-    (finish-output (symbol-value name)))
+                  *trace-output*
+                  *terminal-io*))
+    ;; FINISH-OUTPUT may block more easily than FORCE-OUTPUT
+    (force-output (symbol-value name)))
   (values))
 
 (defun process-init-file (truename)
@@ -324,23 +324,29 @@ steppers to maintain contextual information.")
       (abort ()
         :report "Skip rest of initialization file."))))
 
-(defun process-eval-options (eval-strings)
+(defun process-eval-options (eval-strings-or-forms)
   (/show0 "handling --eval options")
-  (flet ((process-1 (string)
-           (multiple-value-bind (expr pos) (read-from-string string)
-             (unless (eq string (read-from-string string nil string :start pos))
-               (error "More the one expression in ~S" string))
-             (eval expr)
-             (flush-standard-output-streams))))
+  (flet ((process-1 (string-or-form)
+           (etypecase string-or-form
+             (string
+              (multiple-value-bind (expr pos) (read-from-string string-or-form)
+                (unless (eq string-or-form
+                            (read-from-string string-or-form nil string-or-form
+                                              :start pos))
+                  (error "More than one expression in ~S" string-or-form))
+                (eval expr)
+                (flush-standard-output-streams)))
+             (cons (eval string-or-form) (flush-standard-output-streams)))))
     (restart-case
-        (dolist (expr-as-string eval-strings)
+        (dolist (expr-as-string-or-form eval-strings-or-forms)
           (/show0 "handling one --eval option")
           (restart-case
-              (handler-bind ((error (lambda (e)
-                                      (error "Error during processing of --eval ~
-                                              option ~S:~%~%  ~A"
-                                             expr-as-string e))))
-                (process-1 expr-as-string))
+              (handler-bind
+                  ((error (lambda (e)
+                            (error "Error during processing of --eval ~
+                                    option ~S:~%~%  ~A"
+                                   expr-as-string-or-form e))))
+                (process-1 expr-as-string-or-form))
             (continue ()
               :report "Ignore and continue with next --eval option.")))
       (abort ()
@@ -359,7 +365,9 @@ steppers to maintain contextual information.")
         ;; The values are stored as strings, so that they can be
         ;; passed to READ only after their predecessors have been
         ;; EVALed, so that things work when e.g. REQUIRE in one EVAL
-        ;; form creates a package referred to in the next EVAL form.
+        ;; form creates a package referred to in the next EVAL form,
+        ;; except for forms transformed from syntactically-sugary
+        ;; switches like --load and --disable-debugger.
         (reversed-evals nil)
         ;; Has a --noprint option been seen?
         (noprint nil)
@@ -412,15 +420,14 @@ steppers to maintain contextual information.")
                       ((string= option "--load")
                        (pop-option)
                        (push
-                        ;; FIXME: see BUG 296
-                        (concatenate 'string "(|LOAD| \"" (pop-option) "\")")
+                        (list 'cl:load (native-pathname (pop-option)))
                         reversed-evals))
                       ((string= option "--noprint")
                        (pop-option)
                        (setf noprint t))
                       ((string= option "--disable-debugger")
                        (pop-option)
-                       (push "(|DISABLE-DEBUGGER|)" reversed-evals))
+                       (push (list 'sb!ext:disable-debugger) reversed-evals))
                       ((string= option "--end-toplevel-options")
                        (pop-option)
                        (return))
@@ -466,14 +473,14 @@ steppers to maintain contextual information.")
                (and maybe-dir-name
                     (concatenate 'string maybe-dir-name "/" basename))))
         (let ((sysinit-truename
-               (probe-init-files sysinit
-                                 (init-file-name (posix-getenv "SBCL_HOME")
-                                                 "sbclrc")
-                                 "/etc/sbclrc"))
+               #!-win32 (probe-init-files sysinit
+                                          (init-file-name (posix-getenv "SBCL_HOME")
+                                                          "sbclrc")
+                                          "/etc/sbclrc"))
                (userinit-truename
-                (probe-init-files userinit
-                                  (init-file-name (posix-getenv "HOME")
-                                                  ".sbclrc"))))
+                #!-win32 (probe-init-files userinit
+                                           (init-file-name (posix-getenv "HOME")
+                                                           ".sbclrc"))))
 
           ;; This CATCH is needed for the debugger command TOPLEVEL to
           ;; work.
@@ -554,7 +561,7 @@ steppers to maintain contextual information.")
                  (with-simple-restart
                      (abort "~@<Exit debugger, returning to top level.~@:>")
                    (catch 'toplevel-catcher
-                     (sb!unix::reset-signal-mask)
+                     #!-win32 (sb!unix::reset-signal-mask)
                      ;; In the event of a control-stack-exhausted-error, we
                      ;; should have unwound enough stack by the time we get
                      ;; here that this is now possible.
@@ -586,6 +593,7 @@ steppers to maintain contextual information.")
           (scrub-control-stack)
           (sb!thread::get-foreground)
           (unless noprint
+            (flush-standard-output-streams)
             (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