0.9.10.39:

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

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 13bd93e..274b03d 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -145,6 +145,7 @@ steppers to maintain contextual information.")
            :format-arguments (list n)
            :datum n
            :expected-type '(real 0)))
+  #!-win32
   (multiple-value-bind (sec nsec)
       (if (integerp n)
           (values n 0)
@@ -152,6 +153,8 @@ steppers to maintain contextual information.")
               (truncate n)
             (values sec (truncate frac 1e-9))))
     (sb!unix:nanosleep sec nsec))
+  #!+win32
+  (sb!win32:millisleep (truncate (* n 1000)))
   nil)
 \f
 ;;;; SCRUB-CONTROL-STACK
@@ -182,7 +185,7 @@ steppers to maintain contextual information.")
   (let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
          (initial-offset (logand csp (1- bytes-per-scrub-unit)))
          (end-of-stack
-          (- (sb!vm:fixnumize sb!vm:*control-stack-end*)
+          (- (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*))
              sb!c:*backend-page-size*)))
     (labels
         ((scrub (ptr offset count)
@@ -215,7 +218,7 @@ steppers to maintain contextual information.")
 
   #!+stack-grows-downward-not-upward
   (let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
-         (end-of-stack (+ (sb!vm:fixnumize sb!vm:*control-stack-start*)
+         (end-of-stack (+ (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*))
                           sb!c:*backend-page-size*))
          (initial-offset (logand csp (1- bytes-per-scrub-unit))))
     (labels
@@ -324,23 +327,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 than 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 +368,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 +423,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 +476,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 +564,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.