X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=bbebd5b83a12c0b49b042734ae848397589a9d52;hb=395c461b58f0cd484c21913c1e075593c206b5c1;hp=e2663661d75dd8c8ea70b359a8345aa3842b9fa5;hpb=6ce6b4d3e995f7fae210c8fe139a693fd413ed01;p=sbcl.git

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index e266366..bbebd5b 100644
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -20,6 +20,7 @@
 (progn
   (defvar sb!vm::*current-catch-block*)
   (defvar sb!vm::*current-unwind-protect-block*)
+  #!+hpux (defvar sb!vm::*c-lra*)
   (defvar *free-interrupt-context-index*))
 
 ;;; specials initialized by !COLD-INIT
@@ -207,7 +208,7 @@ command-line.")
          (initial-offset (logand csp (1- bytes-per-scrub-unit)))
          (end-of-stack
           (- (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*))
-             sb!c:*backend-page-size*)))
+             sb!c:*backend-page-bytes*)))
     (labels
         ((scrub (ptr offset count)
            (declare (type system-area-pointer ptr)
@@ -240,7 +241,7 @@ command-line.")
   #!+stack-grows-downward-not-upward
   (let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
          (end-of-stack (+ (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*))
-                          sb!c:*backend-page-size*))
+                          sb!c:*backend-page-bytes*))
          (initial-offset (logand csp (1- bytes-per-scrub-unit))))
     (labels
         ((scrub (ptr offset count)
@@ -381,6 +382,30 @@ command-line.")
       (dolist (option options)
         (process-1 option)))))
 
+;;; Skips past the shebang line on stream, if any.
+(defun maybe-skip-shebang-line (stream)
+  (let ((p (file-position stream)))
+    (flet ((next () (read-byte stream nil)))
+      (unwind-protect
+           (when (and (eq (next) (char-code #\#))
+                      (eq (next) (char-code #\!)))
+             (setf p nil)
+             (loop for x = (next)
+                   until (or (not x) (eq x (char-code #\newline)))))
+        (when p
+          (file-position stream p))))
+    t))
+
+(defun process-script (script)
+  (let ((pathname (native-pathname script))
+        (ok nil))
+    (unwind-protect
+         (with-open-file (f pathname :element-type :default)
+           (maybe-skip-shebang-line f)
+           (load f :verbose nil :print nil)
+           (setf ok t))
+      (quit :unix-status (if ok 0 1)))))
+
 ;; Errors while processing the command line cause the system to QUIT,
 ;; instead of trying to go into the Lisp debugger, because trying to
 ;; go into the Lisp debugger would get into various annoying issues of
@@ -415,6 +440,8 @@ command-line.")
         (reversed-options nil)
         ;; Has a --noprint option been seen?
         (noprint nil)
+        ;; Has a --script option been seen?
+        (script nil)
         ;; everything in *POSIX-ARGV* except for argv[0]=programname
         (options (rest *posix-argv*)))
 
@@ -436,7 +463,14 @@ command-line.")
                         (pop options)
                         (startup-error
                          "unexpected end of command line options"))))
-             (cond ((string= option "--sysinit")
+             (cond ((string= option "--script")
+                    (pop-option)
+                    (setf disable-debugger t
+                          no-userinit t
+                          no-sysinit t
+                          script (pop-option))
+                    (return))
+                   ((string= option "--sysinit")
                     (pop-option)
                     (if sysinit
                         (startup-error "multiple --sysinit options")
@@ -516,13 +550,23 @@ command-line.")
               (process-init-file sysinit :system))
             (unless no-userinit
               (process-init-file userinit :user))
-            (process-eval/load-options (nreverse reversed-options)))
+            (process-eval/load-options (nreverse reversed-options))
+            (when script
+              (process-script script)
+              (bug "PROCESS-SCRIPT returned")))
         (abort ()
-          :report "Skip to toplevel READ/EVAL/PRINT loop."
+          :report (lambda (s)
+                    (write-string
+                     (if script
+                         ;; In case script calls (enable-debugger)!
+                         "Abort script, exiting lisp."
+                         "Skip to toplevel READ/EVAL/PRINT loop.")
+                     s))
           (/show0 "CONTINUEing from pre-REPL RESTART-CASE")
           (values))                     ; (no-op, just fall through)
         (quit ()
           :report "Quit SBCL (calling #'QUIT, killing the process)."
+          :test (lambda (c) (declare (ignore c)) (not script))
           (/show0 "falling through to QUIT from pre-REPL RESTART-CASE")
           (quit :unix-status 1))))
 
@@ -594,6 +638,11 @@ that provides the REPL for the system. Assumes that *STANDARD-INPUT* and
 ;;; handle the Unix-style EOF-is-end-of-process convention.
 (defun repl-read-form-fun (in out)
   (declare (type stream in out) (ignore out))
+  ;; KLUDGE: *READ-SUPPRESS* makes the REPL useless, and cannot be
+  ;; recovered from -- flip it here.
+  (when *read-suppress*
+    (warn "Setting *READ-SUPPRESS* to NIL to restore toplevel usability.")
+    (setf *read-suppress* nil))
   (let* ((eof-marker (cons nil nil))
          (form (read in nil eof-marker)))
     (if (eq form eof-marker)