X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftoplevel.lisp;h=be58064ba00d76845ce05d14a1fa8b45e63aee21;hb=93be0089fe7b2a9e34bf1cb6da9fe6e902769f5e;hp=2dae8cbdc1db3c5bdbadda399c48c82e5c120dea;hpb=04ae4aeb2cd1f95e0648d179c0d22ebf2148fc99;p=sbcl.git

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 2dae8cb..be58064 100644
--- 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))
@@ -465,7 +472,7 @@ steppers to maintain contextual information.")
              (init-file-name (maybe-dir-name basename)
                (and maybe-dir-name
                     (concatenate 'string maybe-dir-name "/" basename))))
-        (let ((sysinit-truename
+        #!-win32 (let ((sysinit-truename
                (probe-init-files sysinit
                                  (init-file-name (posix-getenv "SBCL_HOME")
                                                  "sbclrc")
@@ -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