X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fload.lisp;h=9ca88ae8742b7265284a25b1932c696b54ee0ae9;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=b21c7dd7a90ba8c3f4465e66b01adb7898d45e77;hpb=cb254941e176badff31a16a11509e1ac288ae249;p=sbcl.git diff --git a/src/code/load.lisp b/src/code/load.lisp index b21c7dd..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 @@ -174,9 +174,12 @@ (aver (member pushp '(nil t :nope))) (with-unique-names (fop-stack) `(let ((,fop-stack *fop-stack*)) - (declare (type (vector t) ,fop-stack)) + (declare (type (vector t) ,fop-stack) + (ignorable ,fop-stack)) (macrolet ((pop-stack () `(vector-pop ,',fop-stack)) + (push-stack (value) + `(vector-push-extend ,value ,',fop-stack)) (call-with-popped-args (fun n) `(%call-with-popped-args ,fun ,n ,',fop-stack))) ,(if pushp @@ -227,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))))) @@ -281,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)) @@ -306,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)) @@ -314,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*) @@ -365,10 +360,11 @@ (defun load-fasl-group (stream) (when (check-fasl-header stream) (catch 'fasl-group-end - (let ((*current-fop-table-index* 0)) + (let ((*current-fop-table-index* 0) + (*skip-until* nil)) + (declare (special *skip-until*)) (loop (let ((byte (read-byte stream))) - ;; Do some debugging output. #!+sb-show (when *show-fops-p* @@ -402,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)))