0.7.2.11:
[sbcl.git] / src / code / toplevel.lisp
index 8c36aad..381a2b2 100644 (file)
 
 (in-package "SB!IMPL")
 \f
-(defconstant most-positive-fixnum #.sb!vm:*target-most-positive-fixnum*
-  #!+sb-doc
-  "the fixnum closest in value to positive infinity")
-
-(defconstant most-negative-fixnum #.sb!vm:*target-most-negative-fixnum*
-  #!+sb-doc
-  "the fixnum closest in value to negative infinity")
-\f
 ;;;; magic specials initialized by GENESIS
 
 ;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..))
   be any non-negative, non-complex number."
   (when (or (not (realp n))
            (minusp n))
-    (error "Invalid argument to SLEEP: ~S.~%~
-           Must be a non-negative, non-complex number."
-          n))
+    (error 'simple-type-error
+           :format-control "invalid argument to SLEEP: ~S"
+           :format-arguments (list n)
+           :datum n
+           :expected-type '(real 0)))
   (multiple-value-bind (sec usec)
       (if (integerp n)
          (values n 0)
          (multiple-value-bind (sec frac)
              (truncate n)
-           (values sec(truncate frac 1e-6))))
+           (values sec (truncate frac 1e-6))))
     (sb!unix:unix-select 0 0 0 0 sec usec))
   nil)
 \f
   (declare (optimize (speed 3) (safety 0))
           (values (unsigned-byte 20))) ; FIXME: DECLARE VALUES?
 
-  #!-x86 ; machines where stack grows upwards (I guess) -- WHN 19990906
+  #!-stack-grows-downward-not-upward
   (labels
       ((scrub (ptr offset count)
          (declare (type system-area-pointer ptr)
             (* (floor initial-offset sb!vm:n-word-bytes) sb!vm:n-word-bytes)
             0)))
 
-  #!+x86 ;; (Stack grows downwards.)
+  #!+stack-grows-downward-not-upward
   (labels
       ((scrub (ptr offset count)
         (declare (type system-area-pointer ptr)
   
   (let ((sysinit nil)        ; value of --sysinit option
        (userinit nil)       ; value of --userinit option
-       (reversed-evals nil) ; values of --eval options, in reverse order
+       (reversed-evals nil) ; values of --eval options, in reverse order; and
+                            ; also --load options, translated into --eval
        (noprint nil)        ; Has a --noprint option been seen?
-       (noprogrammer nil)   ; Has a --noprogammer option been seen?
+       (noprogrammer nil)   ; Has a --noprogrammer option been seen?
        (options (rest *posix-argv*))) ; skipping program name
 
     (/show0 "done with outer LET in TOPLEVEL-INIT")
     ;; READ an --eval string). Make sure that they're handled
     ;; reasonably. Also, perhaps all errors while parsing the command
     ;; line should cause the system to QUIT, instead of trying to go
-    ;; into the Lisp debugger.
+    ;; into the Lisp debugger, since trying to go into the debugger
+    ;; gets into various annoying issues of where we should go after
+    ;; the user tries to return from the debugger.
     
     ;; Parse command line options.
     (loop while options do
                                         eval-as-string))
                                 (t
                                  (push eval reversed-evals)))))))
+                   ((string= option "--load")
+                    (pop-option)
+                    (push `(load ,(pop-option)) reversed-evals))
                    ((string= option "--noprint")
                     (pop-option)
                     (setf noprint t))
       (setf *debugger-hook* 'noprogrammer-debugger-hook-fun
            *debug-io* *error-output*))
 
-    ;; FIXME: Verify that errors in init files and/or --eval operations
-    ;; lead to reasonable behavior.
-
     ;; Handle initialization files.
     (/show0 "handling initialization files in TOPLEVEL-INIT")
     (flet (;; If any of POSSIBLE-INIT-FILE-NAMES names a real file,
       (let* ((sbcl-home (posix-getenv "SBCL_HOME"))
             (sysinit-truename (if sbcl-home
                                   (probe-init-files sysinit
-                                                    (concatenate
-                                                     'string
-                                                     sbcl-home
-                                                     "/sbclrc"))
+                                                    (concatenate 'string
+                                                                 sbcl-home
+                                                                 "/sbclrc"))
                                   (probe-init-files sysinit
                                                     "/etc/sbclrc"
                                                     "/usr/local/etc/sbclrc")))
                            (error "The HOME environment variable is unbound, ~
                                    so user init file can't be found.")))
             (userinit-truename (probe-init-files userinit
-                                                 (concatenate
-                                                  'string
-                                                  user-home
-                                                  "/.sbclrc"))))
+                                                 (concatenate 'string
+                                                              user-home
+                                                              "/.sbclrc"))))
 
        ;; We wrap all the pre-REPL user/system customized startup code 
        ;; in a restart.
        ;; Unix environment errors, e.g. a missing file or a typo on
        ;; the Unix command line, and you don't need to get into Lisp
        ;; to debug them, you should just start over and do it right
-       ;; at the Unix level. Errors below here are usually errors in
-       ;; user Lisp code, and it might be helpful to let the user
-       ;; reach the REPL in order to help figure out what's going on.)
+       ;; at the Unix level. Errors below here are generally errors
+       ;; in user Lisp code, and it might be helpful to let the user
+       ;; reach the REPL in order to help figure out what's going
+       ;; on.)
        (restart-case
-           (flet ((process-init-file (truename)
-                    (when truename
-                      (unless (load truename)
-                        (error "~S was not successfully loaded." truename))
-                      (flush-standard-output-streams))))
-             (process-init-file sysinit-truename)
-             (process-init-file userinit-truename)
+           (progn
+             (flet ((process-init-file (truename)
+                      (when truename
+                        (unless (load truename)
+                          (error "~S was not successfully loaded." truename))
+                        (flush-standard-output-streams))))
+               (process-init-file sysinit-truename)
+               (process-init-file userinit-truename))
 
              ;; Process --eval options.
              (/show0 "handling --eval options in TOPLEVEL-INIT")
           (abort
            "Reduce debugger level (leaving debugger, returning to toplevel).")
         (catch 'toplevel-catcher
-          (sb!unix:unix-sigsetmask 0)  ; FIXME: What is this for?
+          #!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for?
           (repl noprint)
           (critically-unreachable "after REPL")))))))