X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=3b2a82fbac5d6a20c7825619e58bca146f707069;hb=65b5ab7e713d04e0d76bc0ee196374f6e57b922f;hp=4c7ce9c47743ee41e552d9cd84e169b053bd1e73;hpb=e3b3baf2f433b51d1864255c0e3adf1e58abcfc2;p=sbcl.git

diff --git a/src/code/load.lisp b/src/code/load.lisp
index 4c7ce9c..3b2a82f 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -20,7 +20,7 @@
 ;;;; here: certainly enough that I (dan, 2003.1.22) don't want to mess
 ;;;; around deciding how to thread-safetify it.  So we use a Big Lock.
 ;;;; Because this code is mutually recursive with the compiler, we use
-;;;; the *big-compiler-lock*
+;;;; the **WORLD-LOCK**.
 
 ;;;; miscellaneous load utilities
 
@@ -230,8 +230,8 @@
                      position ~A: Expected ~A, got ~A.~:@>"
              (invalid-fasl-stream condition)
              (invalid-fasl-byte-nr condition)
-             (invalid-fasl-byte condition)
-             (invalid-fasl-expected condition)))))
+             (invalid-fasl-expected condition)
+             (invalid-fasl-byte condition)))))
 
 (define-condition invalid-fasl-version (invalid-fasl)
   ((version :reader invalid-fasl-version :initarg :version))
@@ -269,6 +269,48 @@
              (invalid-fasl-features condition)
              (invalid-fasl-expected condition)))))
 
+;;; 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))
+
+;;; Returns T if the stream is a binary input stream with a FASL header.
+(defun fasl-header-p (stream &key errorp)
+  (let ((p (file-position stream)))
+    (unwind-protect
+         (let* ((header *fasl-header-string-start-string*)
+                (buffer (make-array (length header) :element-type '(unsigned-byte 8)))
+                (n 0))
+           (flet ((scan ()
+                    (maybe-skip-shebang-line stream)
+                    (setf n (read-sequence buffer stream))))
+             (if errorp
+                 (scan)
+                 (or (ignore-errors (scan))
+                     ;; no a binary input stream
+                     (return-from fasl-header-p nil))))
+           (if (mismatch buffer header
+                         :test #'(lambda (code char) (= code (char-code char))))
+               ;; Immediate EOF is valid -- we want to match what
+               ;; CHECK-FASL-HEADER does...
+               (or (zerop n)
+                   (when errorp
+                     (error 'fasl-header-missing
+                            :stream stream
+                            :fhsss buffer
+                            :expected header)))
+               t))
+      (file-position stream p))))
+
 ;;;; LOAD-AS-FASL
 ;;;;
 ;;;; Note: LOAD-AS-FASL is used not only by LOAD, but also (with
@@ -278,10 +320,11 @@
 
 ;;; a helper function for LOAD-FASL-GROUP
 ;;;
-;;; Return true if we successfully read a FASL header from the stream,
-;;; or NIL if EOF was hit before anything was read. Signal an error if
-;;; we encounter garbage.
+;;; Return true if we successfully read a FASL header from the stream, or NIL
+;;; if EOF was hit before anything except the optional shebang line was read.
+;;; Signal an error if we encounter garbage.
 (defun check-fasl-header (stream)
+  (maybe-skip-shebang-line stream)
   (let ((byte (read-byte stream nil)))
     (when byte
       ;; Read and validate constant string prefix in fasl header.
@@ -290,7 +333,7 @@
         (unless (= byte (char-code (schar fhsss 0)))
           (error 'invalid-fasl-header
                  :stream stream
-                 :first-byte-p t
+                 :byte-nr 0
                  :byte byte
                  :expected (char-code (schar fhsss 0))))
         (do ((byte (read-byte stream) (read-byte stream))
@@ -398,7 +441,7 @@
   (when (zerop (file-length stream))
     (error "attempt to load an empty FASL file:~%  ~S" (namestring stream)))
   (maybe-announce-load stream verbose)
-  (sb!thread:with-recursive-lock (sb!c::*big-compiler-lock*)
+  (with-world-lock ()
     (let* ((*fasl-input-stream* stream)
            (*fasl-symbol-buffer* (make-string 100))
            (*current-fop-table* (or (pop *free-fop-tables*) (make-array 1000)))
@@ -413,6 +456,8 @@
         ;; that this would go away?
         (fill *current-fop-table* nil))))
   t)
+
+(declaim (notinline read-byte)) ; Why is it even *declaimed* inline above?
 
 ;;;; stuff for debugging/tuning by collecting statistics on FOPs (?)