0.8.4.28:

	ASDF users, rejoice!
	* Add a condition SB-EXT:INVALID-FASL (subtype ERROR)
	* Make SB-FASL::CHECK-FASL-HEADER raise conditions that are subtype
	  SB-EXT:INVALID-FASL on the appropriate errors (or the other way
	  around, I forget)
	* Make SB-FASL::INTERNAL-LOAD also raise a condition if the FASL
	  header is broken.

diff --git a/NEWS b/NEWS
index 69147bb..6aee499 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2130,6 +2130,9 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4:
     of its result.
   * type declarations inside WITH-SLOTS are checked.  (reported by
     salex on #lisp)
+  * loading incompatible FASLs, e.g. those produced by an incompatible
+    lisp implementation, cause a condition of type SB-EXT:INVALID-FASL
+    (a subtype of ERROR) to be raised.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** incorrect optimization of TRUNCATE for a positive first
        argument and negative second.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index a7d35a3..4c2bb04 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -591,6 +591,11 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
              ;; to hide it from them..
              "INTERACTIVE-EVAL"
 
+            ;; Subtype of SIMPLE-ERROR signalled when attempt to
+            ;; load an invalid fasl is made, so that user-code can
+            ;; try to recompile, etc.
+            "INVALID-FASL"
+
              ;; weak pointers and finalization
              "CANCEL-FINALIZATION"
              "FINALIZE"

diff --git a/src/code/load.lisp b/src/code/load.lisp
index e8b9921..f97af52 100644 (file)
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -205,6 +205,70 @@
                (progn ,@forms)
                (setq *fop-stack-pointer* ,n-index)))))))
 \f
+;;;; Conditions signalled on invalid fasls (wrong fasl version, etc),
+;;;; so that user code (esp. ASDF) can reasonably handle attempts to
+;;;; load such fasls by recompiling them, etc. For simplicity's sake
+;;;; make only condition INVALID-FASL part of the public interface,
+;;;; and keep the guts internal.
+
+(define-condition sb!ext::invalid-fasl (error)
+  ((stream :reader invalid-fasl-stream :initarg :stream)
+   (expected :reader invalid-fasl-expected :initarg :expected))
+  (:report
+   (lambda (condition stream)
+     (format stream "~S is an invalid fasl file."
+            (invalid-fasl-stream condition)))))
+
+(define-condition invalid-fasl-header (sb!ext::invalid-fasl)
+  ((byte :reader invalid-fasl-byte :initarg :byte)
+   (byte-nr :reader invalid-fasl-byte-nr :initarg :byte-nr))
+  (:report
+   (lambda (condition stream)
+     (format stream "~@<~S contains an illegal byte in the FASL header at ~
+                     position ~A: Expected ~A, got ~A.~:@>"
+            (invalid-fasl-stream condition)
+            (invalid-fasl-byte-nr condition)
+            (invalid-fasl-byte condition)
+            (invalid-fasl-expected condition)))))
+
+(define-condition invalid-fasl-version (sb!ext::invalid-fasl)
+  ((variant :reader invalid-fasl-variant :initarg :variant)
+   (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.~:@>"
+            (invalid-fasl-stream condition)
+            (invalid-fasl-variant condition)
+            (invalid-fasl-version condition)
+            (invalid-fasl-expected condition)))))
+
+(define-condition invalid-fasl-implementation (sb!ext::invalid-fasl)
+  ((implementation :reader invalid-fasl-implementation
+                  :initarg :implementation))
+  (:report 
+   (lambda (condition stream)
+     (format stream "~S was compiled for implementation ~A, but this is a ~A."
+            (invalid-fasl-stream condition)
+            (invalid-fasl-implementation condition)
+            (invalid-fasl-expected condition)))))
+
+(define-condition invalid-fasl-features (sb!ext::invalid-fasl)
+  ((potential-features :reader invalid-fasl-potential-features
+                      :initarg :potential-features)
+   (features :reader invalid-fasl-features :initarg :features))
+  (:report
+   (lambda (condition stream)
+     (format stream "~@<incompatible ~S in fasl file ~S: ~2I~_~
+                     Of features affecting binary compatibility, ~4I~_~S~2I~_~
+                     the fasl has ~4I~_~A,~2I~_~
+                     while the runtime expects ~4I~_~A.~:>"
+            '*features* 
+            (invalid-fasl-stream condition)
+            (invalid-fasl-potential-features condition)
+            (invalid-fasl-features condition)
+            (invalid-fasl-expected condition)))))
+
 ;;;; LOAD-AS-FASL
 ;;;;
 ;;;; Note: LOAD-AS-FASL is used not only by LOAD, but also (with
@@ -226,7 +290,11 @@
       (let* ((fhsss *fasl-header-string-start-string*)
             (fhsss-length (length fhsss)))
        (unless (= byte (char-code (schar fhsss 0)))
-         (error "illegal first byte in fasl file header"))
+         (error 'invalid-fasl-header
+                :stream stream
+                :first-byte-p t
+                :byte byte
+                :expected (char-code (schar fhsss 0))))
        (do ((byte (read-byte stream) (read-byte stream))
             (count 1 (1+ count)))
            ((= byte +fasl-header-string-stop-char-code+)
@@ -234,8 +302,11 @@
          (declare (fixnum byte count))
          (when (and (< count fhsss-length)
                     (not (eql byte (char-code (schar fhsss count)))))
-           (error
-            "illegal subsequent (not first) byte in fasl file header"))))
+           (error 'invalid-fasl-header
+                  :stream stream
+                  :byte-nr count
+                  :byte byte
+                  :expected (char-code (schar fhsss count))))))
 
       ;; Read and validate version-specific compatibility stuff.
       (flet ((string-from-stream ()
@@ -253,34 +324,27 @@
                                 needed-version)
                   (when (string= possible-implementation implementation)
                     (or (= version needed-version)
-                        (error "~@<~S is in ~A fasl file format version ~W, ~
-                                 but this version of SBCL uses ~
-                                 format version ~W.~:@>"
-                               stream
-                               variant
-                               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 "~S was compiled for implementation ~A, ~
-                        but this is a ~A."
-                      stream
-                      implementation
-                      +backend-fasl-file-implementation+))))
+               (error 'invalid-fasl-implementation
+                      :stream stream
+                      :implementation implementation
+                      :expected +backend-fasl-file-implementation+))))
        ;; 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*)
-           (error
-            "~@<incompatible ~S in fasl file ~S: ~2I~_~
-              Of features affecting binary compatibility, ~4I~_~S~2I~_~
-              this runtime has ~4I~_~A,~2I~_~
-              while the fasl expects ~4I~_~A.~:>"
-            '*features* 
-            stream
-            *features-potentially-affecting-fasl-format*
-            *features-affecting-fasl-format*
-            faff-in-this-file)))
+           (error 'invalid-fasl-features
+                  :stream stream
+                  :potential-features *features-potentially-affecting-fasl-format*
+                  :expected *features-affecting-fasl-format*
+                  :features faff-in-this-file)))
        ;; success
        t))))
 

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 56a139e..79c2e89 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -42,6 +42,16 @@
 \f
 ;;;; LOAD itself
 
+(define-condition fasl-header-missing (sb!ext::invalid-fasl)
+  ((fhsss :reader invalid-fasl-fhsss :initarg :fhsss))
+  (:report
+   (lambda (condition stream)
+     (format stream "~@<File ~S has a fasl file type, but no fasl header:~%~
+                     Expected ~S, but got ~S.~:@>"
+            (invalid-fasl-stream condition)
+            (invalid-fasl-expected condition)
+            (invalid-fasl-fhsss condition)))))
+
 ;;; a helper function for LOAD: Load the stuff in a file when we have
 ;;; the name.
 (defun internal-load (pathname truename if-does-not-exist verbose print
@@ -82,8 +92,10 @@
                          :binary))
          (t
           (when (string= (pathname-type truename) *fasl-file-type*)
-            (error "File has a fasl file type, but no fasl file header:~%  ~S"
-                   (namestring truename)))
+            (error 'fasl-header-missing
+                   :stream (namestring truename)
+                   :fhsss first-line
+                   :expected fhsss))
           (internal-load pathname truename if-does-not-exist verbose print
                          :source))))))))
 

diff --git a/version.lisp-expr b/version.lisp-expr
index b3ef367..771e200 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.4.27"
+"0.8.4.28"