X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=ede4e2d7a663d0789c53ba830dc78d367cad232f;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=ed29a41a0199bc18bd8d7bf56a4b6ccf5164f69b;hpb=8ee61a7761181511d15690246eb52d100e233935;p=sbcl.git

diff --git a/src/code/load.lisp b/src/code/load.lisp
index ed29a41..ede4e2d 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -128,7 +128,7 @@
 
 (declaim (inline ref-fop-table))
 (defun ref-fop-table (index)
-  (declare (index index))
+  (declare (type index index))
   (svref *fop-table* (the index (+ index 1))))
 
 (defun get-fop-table-index ()
@@ -150,14 +150,14 @@
 
 ;;; These three routines are used for both the stack and the table.
 (defun make-fop-vector (size)
-  (declare (index size))
+  (declare (type index size))
   (let ((vector (make-array size)))
     (setf (aref vector 0) 0)
     vector))
 
 (defun grow-fop-vector (old-vector old-size)
   (declare (simple-vector old-vector)
-           (index old-size))
+           (type index old-size))
   (let* ((new-size (* old-size 2))
          (new-vector (make-array new-size)))
     (declare (fixnum new-size)
@@ -168,6 +168,7 @@
 
 (defun nuke-fop-vector (vector)
   (declare (simple-vector vector)
+           #!-gencgc (ignore vector)
            (optimize speed))
   ;; Make sure we don't keep any garbage.
   #!+gencgc
@@ -187,7 +188,7 @@
 (defun pop-fop-stack ()
   (let* ((stack *fop-stack*)
          (top (svref stack 0)))
-    (declare (index top))
+    (declare (type index top))
     (when (eql 0 top)
       (error "FOP stack empty"))
     (setf (svref stack 0) (1- top))
@@ -196,7 +197,7 @@
 (defun push-fop-stack (value)
   (let* ((stack *fop-stack*)
          (next (1+ (the index (svref stack 0)))))
-    (declare (index next))
+    (declare (type index next))
     (when (eql (length stack) next)
       (setf stack (grow-fop-vector stack next)
             *fop-stack* stack))
@@ -314,7 +315,14 @@
 
 ;;; Returns T if the stream is a binary input stream with a FASL header.
 (defun fasl-header-p (stream &key errorp)
-  (unless (member (stream-element-type stream) '(character base-char))
+  (unless (and (member (stream-element-type stream) '(character base-char))
+               ;; give up if it's not a file stream, or it's an
+               ;; fd-stream but it's either not bivalent or not
+               ;; seekable (doesn't really have a file)
+               (or (not (typep stream 'file-stream))
+                   (and (typep stream 'fd-stream)
+                        (or (not (sb!impl::fd-stream-bivalent-p stream))
+                            (not (sb!impl::fd-stream-file stream))))))
     (let ((p (file-position stream)))
       (unwind-protect
            (let* ((header *fasl-header-string-start-string*)
@@ -468,16 +476,15 @@
   (when (zerop (file-length stream))
     (error "attempt to load an empty FASL file:~%  ~S" (namestring stream)))
   (maybe-announce-load stream verbose)
-  (with-world-lock ()
-    (let* ((*fasl-input-stream* stream)
-           (*fop-table* (make-fop-vector 1000))
-           (*fop-stack* (make-fop-vector 100)))
-      (unwind-protect
-           (loop while (load-fasl-group stream))
-        ;; Nuke the table and stack to avoid keeping garbage on
-        ;; conservatively collected platforms.
-        (nuke-fop-vector *fop-table*)
-        (nuke-fop-vector *fop-stack*))))
+  (let* ((*fasl-input-stream* stream)
+         (*fop-table* (make-fop-vector 1000))
+         (*fop-stack* (make-fop-vector 100)))
+    (unwind-protect
+         (loop while (load-fasl-group stream))
+      ;; Nuke the table and stack to avoid keeping garbage on
+      ;; conservatively collected platforms.
+      (nuke-fop-vector *fop-table*)
+      (nuke-fop-vector *fop-stack*)))
   t)
 
 (declaim (notinline read-byte)) ; Why is it even *declaimed* inline above?