X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=f9fb1f6b28d26fe91473dbce074ff128af3f3107;hb=230707c1899c1c008f7ce2ad97e2fd04849f7443;hp=9c01fa924a97d499a8ee1151b984fcd8d892b8cc;hpb=fec3614baf361523a4fb154ed80d9b73e1452b2d;p=sbcl.git

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 9c01fa9..f9fb1f6 100644
--- 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)
 
 ;;;; 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,29 @@ 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")
+                                 (merge-pathnames (sbcl-homedir-pathname)
+                                                  "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 +514,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 +576,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"))))))))))