From 8ccaec4f25b17fbb0c3e661bbcbcb228e035a2c3 Mon Sep 17 00:00:00 2001
From: pmai <pmai>
Date: Sun, 7 Apr 2002 00:14:13 +0000
Subject: [PATCH] Change the new FASL format code to use a new FOP for the long
 version number, retaining the old FOP for short (one byte) version numbers.
 This enables old lisp versions to gracefully fail on new FASLs (reporting an
 unknown FOP), and new lisp versions to gracefully fail on old FASLs
 (reporting a version mismatch), yet still allowing the user to safely proceed
 from that error.

---
 bootfiles/18c/boot10.lisp         | 48 ++++++++++++-------------------
 code/load.lisp                    | 13 +++++----
 compiler/dump.lisp                |  6 ++--
 compiler/generic/new-genesis.lisp |  6 ++--
 4 files changed, 32 insertions(+), 41 deletions(-)

diff --git a/bootfiles/18c/boot10.lisp b/bootfiles/18c/boot10.lisp
index e2055d8aa..d8d0b1e82 100644
--- a/bootfiles/18c/boot10.lisp
+++ b/bootfiles/18c/boot10.lisp
@@ -9,43 +9,33 @@
 ;; function FOP-CODE-FORMAT. We work around the check so that it is
 ;; possible to build from 18c, without requiring a cross-compile.
 ;;
-;; Additionally, the FASL file format was changed slightly: the FASL
-;; version number is written as uint32, rather than as a single octet.
-;;
-;; You will encounter a continuable error during the first worldload
-;; in the function CHECK-VERSION, saying that the FASL file version
-;; numbers are incompatible. In the debugger prompt, say
-;;
-;; 0] (setq cl::*skip-fasl-file-version-check* t)
-;;
-;; then select the CONTINUE restart. The rest of the build should
-;; proceed without problems.
-
+;; Additionally, the FASL file format was changed slightly: We use the new
+;; FOP-LONG-CODE-FORMAT with code 157, because the version number is now
+;; an uint32 instead of a single octet.  The old FOP-CODE-FORMAT with code
+;; 57 is retained, in order to correctly read/detect old version numbers.
 
 (in-package :cl)
 
-(defparameter *skip-fasl-file-version-check* t)
+;; Declare new variable defined in code/load.lisp, so that new-genesis
+;; can reference it, before code/load is loaded.
+(defvar *skip-fasl-file-version-check* nil)
 
-;; override original definition from code/load.lisp
-(define-fop (fop-code-format 57 :nope)
-  (let ((implementation (read-arg 1))
-	(version (read-arg 1)))
-    (declare (ignore implementation version))
-    (warn "FOP-CODE-FORMAT ignoring incompatible FASL file versions during rebuild")))
-
-;; override original definition from compiler/generic/new-genesis.lisp 
-(define-fop (cold-fop-code-format 57 :nope)
+;; Define nop FOP for the new FOP code of FOP-CODE-FORMAT
+(define-fop (fop-long-code-format 157 :nope)
   (let ((implementation (read-arg 1))
 	(version (read-arg 4)))
     (declare (ignore implementation version))
-    (warn "COLD-FOP-CODE-FORMAT ignoring incompatible FASL file versions during rebuild")))
-
+    (warn "FOP-LONG-CODE-FORMAT ignoring FASL file versions during rebuild")))
 
 (in-package :c)
 
-;; this is a DEFCONSTANT, so can't SETQ
+;; this is a DEFCONSTANT, so can't use SETQ
 (setf (symbol-value 'byte-fasl-file-version) #x18d)
 
+(setf (backend-fasl-file-version *target-backend*) #x18d)
+
+;; Use the new format for newly created FASLs
+
 (defun open-fasl-file (name where &optional byte-p)
   (declare (type pathname name))
   (let* ((stream (open name :direction :output
@@ -65,7 +55,7 @@
 	      "FASL FILE output from ~A.~@
 	       Compiled ~A on ~A~@
 	       Compiler ~A, Lisp ~A~@
-	       Targeted for ~A, FASL version ~D~%"
+	       Targeted for ~A, FASL version ~X~%"
 	      where
 	      (ext:format-universal-time nil (get-universal-time))
 	      (machine-instance) compiler-version
@@ -75,10 +65,8 @@
       ;; Terminate header.
       (dump-byte 255 res)
       ;;
-      ;; Specify code format
-      (dump-fop 'lisp::fop-code-format res)
-
+      ;; Specify code format.
+      (dump-fop 'lisp::fop-long-code-format res)
       (dump-byte f-imp res)
-      ;; !! following  line is changed
       (dump-unsigned-32 f-vers res))
     res))
diff --git a/code/load.lisp b/code/load.lisp
index 8671483ae..229081f9a 100644
--- a/code/load.lisp
+++ b/code/load.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.82 2002/03/31 14:48:35 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.83 2002/04/07 00:14:12 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1112,9 +1112,12 @@
 ;;;; Loading functions:
 
 ;;; must be compatible with the function OPEN-FASL-FILE in compiler/dump.lisp
-(define-fop (fop-code-format 57 :nope)
+;;; The old fop-code-format FOP is legacy support for FASL formats prior to
+;;; #x18d, which used a single octet for the version number.
+(clone-fop (fop-long-code-format 157 :nope)
+	   (fop-code-format 57)
   (let ((implementation (read-arg 1))
-	(version (read-arg 4)))
+	(version (clone-arg)))
     (flet ((check-version (imp vers)
 	     (when (eql imp implementation)
 	       (unless (eql version vers)
@@ -1139,8 +1142,8 @@
               "~A was compiled for a ~A, but this is a ~A"
               *Fasl-file*
               (imp-name implementation)
-              (imp-name #.(c:backend-fasl-file-implementation c:*backend*)))))))
-
+              (imp-name
+	       #.(c:backend-fasl-file-implementation c:*backend*)))))))
 
 ;;; Load-Code loads a code object.  NItems objects are popped off the stack for
 ;;; the boxed storage section, then Size bytes of code are read in.
diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index 3e39fe55a..d87e6ea91 100644
--- a/compiler/dump.lisp
+++ b/compiler/dump.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.74 2002/03/31 14:48:36 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.75 2002/04/07 00:14:13 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -383,7 +383,7 @@
 	      "FASL FILE output from ~A.~@
 	       Compiled ~A on ~A~@
 	       Compiler ~A, Lisp ~A~@
-	       Targeted for ~A, FASL version ~D~%"
+	       Targeted for ~A, FASL version ~X~%"
 	      where
 	      (ext:format-universal-time nil (get-universal-time))
 	      (machine-instance) compiler-version
@@ -394,7 +394,7 @@
       (dump-byte 255 res)
       ;;
       ;; Specify code format.
-      (dump-fop 'lisp::fop-code-format res)
+      (dump-fop 'lisp::fop-long-code-format res)
       (dump-byte f-imp res)
       (dump-unsigned-32 f-vers res))
     res))
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 7ea3909ac..f20a3a808 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.45 2002/03/31 14:48:38 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.46 2002/04/07 00:14:13 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1582,9 +1582,9 @@
   (pop-stack))
 
 ;;; must be compatible with the function OPEN-FASL-FILE in compiler/dump.lisp
-(define-cold-fop (fop-code-format :nope)
+(clone-cold-fop (fop-long-code-format :nope) (fop-code-format)
   (let ((implementation (read-arg 1))
-	(version (read-arg 4)))
+	(version (clone-arg)))
     (unless (= implementation (c:backend-fasl-file-implementation c:*backend*))
       (cerror
        "Load ~A anyway"
-- 
GitLab