X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fload.lisp;h=ede4e2d7a663d0789c53ba830dc78d367cad232f;hb=0f3a5f2e8886d18d0b4f6485c38a42be629422ae;hp=68a6e227c0087427e2c65d87294d97edb0a7846b;hpb=b69fe40e09e86e60f96a61208ee0a6afa100d3b4;p=sbcl.git

diff --git a/src/code/load.lisp b/src/code/load.lisp
index 68a6e22..ede4e2d 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -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
@@ -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?