0.9.15.17:

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

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 9c01fa9..f3ef3e2 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
@@ -357,8 +360,12 @@ steppers to maintain contextual information.")
   (/show0 "entering TOPLEVEL-INIT")
   (let (;; value of --sysinit option
         (sysinit nil)
+        ;; t if --no-sysinit option given
+        (no-sysinit nil)
         ;; value of --userinit option
         (userinit nil)
+        ;; t if --no-userinit option given
+        (no-userinit nil)
         ;; values of --eval options, in reverse order; and also any
         ;; other options (like --load) which're translated into --eval
         ;;
@@ -409,11 +416,17 @@ steppers to maintain contextual information.")
                        (if sysinit
                            (startup-error "multiple --sysinit options")
                            (setf sysinit (pop-option))))
+                      ((string= option "--no-sysinit")
+                       (pop-option)
+                       (setf no-sysinit t))
                       ((string= option "--userinit")
                        (pop-option)
                        (if userinit
                            (startup-error "multiple --userinit options")
                            (setf userinit (pop-option))))
+                      ((string= option "--no-userinit")
+                       (pop-option)
+                       (setf no-userinit t))
                       ((string= option "--eval")
                        (pop-option)
                        (push (pop-option) reversed-evals))
@@ -461,27 +474,30 @@ steppers to maintain contextual information.")
                                 &rest default-init-file-names)
                (declare (type list default-init-file-names))
                (if explicitly-specified-init-file-name
-                   (or (probe-file explicitly-specified-init-file-name)
-                        (startup-error "The file ~S was not found."
-                                       explicitly-specified-init-file-name))
+                   (or (probe-file
+                        (parse-native-namestring
+                         explicitly-specified-init-file-name))
+                       (startup-error "The file ~S was not found."
+                                      explicitly-specified-init-file-name))
                    (find-if (lambda (x)
-                              (and (stringp x) (probe-file x)))
-                            default-init-file-names)))
-             ;; shared idiom for creating default names for
-             ;; SYSINITish and USERINITish files
-             (init-file-name (maybe-dir-name basename)
-               (and maybe-dir-name
-                    (concatenate 'string maybe-dir-name "/" basename))))
+                              (and (pathnamep x) (probe-file x)))
+                            default-init-file-names))))
         (let ((sysinit-truename
                (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")
+                                 (let ((sbcl-homedir (sbcl-homedir-pathname)))
+                                   (when sbcl-homedir
+                                     (merge-pathnames sbcl-homedir "sbclrc")))
+                                 #!-win32
+                                 "/etc/sbclrc"
+                                 #!+win32
+                                 (merge-pathnames
+                                  (sb!win32::get-folder-pathname
+                                   sb!win32::csidl_common_appdata)
+                                  "\\sbcl\\sbclrc")))
+              (userinit-truename
+               (probe-init-files userinit
+                                 (merge-pathnames (user-homedir-pathname)
                                                   ".sbclrc"))))
-
           ;; This CATCH is needed for the debugger command TOPLEVEL to
           ;; work.
           (catch 'toplevel-catcher
@@ -499,8 +515,8 @@ steppers to maintain contextual information.")
             ;; figure out what's going on.)
             (restart-case
                 (progn
-                  (process-init-file sysinit-truename)
-                  (process-init-file userinit-truename)
+                  (unless no-sysinit (process-init-file sysinit-truename))
+                  (unless no-userinit (process-init-file userinit-truename))
                   (process-eval-options (reverse reversed-evals)))
               (abort ()
                 :report "Skip to toplevel READ/EVAL/PRINT loop."
@@ -561,10 +577,11 @@ 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.
+                     #!-win32
                      (sb!kernel::protect-control-stack-guard-page 1)
                      (funcall repl-fun noprint)
                      (critically-unreachable "after REPL"))))))))))