X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=9ca88ae8742b7265284a25b1932c696b54ee0ae9;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=8b3067df27ca8639abed6154e0fd6fb4ab4a3e90;hpb=3ca73f72116001579bde0f59e5aa1359cc41631e;p=sbcl.git

diff --git a/src/code/load.lisp b/src/code/load.lisp
index 8b3067d..9ca88ae 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,18 +230,16 @@
                      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)
-  ((variant :reader invalid-fasl-variant :initarg :variant)
-   (version :reader invalid-fasl-version :initarg :version))
+  ((version :reader invalid-fasl-version :initarg :version))
   (:report
    (lambda (condition stream)
-     (format stream "~@<~S is in ~A fasl file format version ~W, ~
-                    but this version of SBCL uses format version ~W.~:@>"
+     (format stream "~@<~S is a fasl file compiled with SBCL ~W, and ~
+                      can't be loaded into SBCL ~W.~:@>"
              (invalid-fasl-stream condition)
-             (invalid-fasl-variant condition)
              (invalid-fasl-version condition)
              (invalid-fasl-expected condition)))))
 
@@ -284,17 +282,15 @@
 ;;; or NIL if EOF was hit before anything was read. Signal an error if
 ;;; we encounter garbage.
 (defun check-fasl-header (stream)
-
   (let ((byte (read-byte stream nil)))
     (when byte
-
       ;; Read and validate constant string prefix in fasl header.
       (let* ((fhsss *fasl-header-string-start-string*)
              (fhsss-length (length fhsss)))
         (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))
@@ -309,7 +305,6 @@
                    :byte-nr count
                    :byte byte
                    :expected (char-code (schar fhsss count))))))
-
       ;; Read and validate version-specific compatibility stuff.
       (flet ((string-from-stream ()
                (let* ((length (read-unsigned-byte-32-arg))
@@ -317,28 +312,25 @@
                  (read-string-as-bytes stream result)
                  result)))
         ;; Read and validate implementation and version.
-        (let* ((implementation (keywordicate (string-from-stream)))
-               ;; FIXME: The logic above to read a keyword from the fasl file
-               ;; could probably be shared with the read-a-keyword fop.
-               (version (read-word-arg)))
-          (flet ((check-version (variant
-                                 possible-implementation
-                                 needed-version)
-                   (when (string= possible-implementation implementation)
-                     (or (= version needed-version)
-                         (error 'invalid-fasl-version
-                                ;; :error :wrong-version
-                                :stream stream
-                                :variant variant
-                                :version version
-                                :expected needed-version)))))
-            (or (check-version "native code"
-                               +backend-fasl-file-implementation+
-                               +fasl-file-version+)
-                (error 'invalid-fasl-implementation
+        (let ((implementation (keywordicate (string-from-stream)))
+              (expected-implementation +backend-fasl-file-implementation+))
+          (unless (string= expected-implementation implementation)
+            (error 'invalid-fasl-implementation
+                   :stream stream
+                   :implementation implementation
+                   :expected expected-implementation)))
+        (let* ((fasl-version (read-word-arg))
+               (sbcl-version (if (<= fasl-version 76)
+                                 "1.0.11.18"
+                                 (string-from-stream)))
+               (expected-version (sb!xc:lisp-implementation-version)))
+          (unless (string= expected-version sbcl-version)
+            (restart-case
+                (error 'invalid-fasl-version
                        :stream stream
-                       :implementation implementation
-                       :expected +backend-fasl-file-implementation+))))
+                       :version sbcl-version
+                       :expected expected-version)
+              (continue () :report "Load the fasl file anyway"))))
         ;; Read and validate *FEATURES* which affect binary compatibility.
         (let ((faff-in-this-file (string-from-stream)))
           (unless (string= faff-in-this-file *features-affecting-fasl-format*)
@@ -406,7 +398,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)))