;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.54
;;; Reason:
;;;  FASL streams "remember" the internal FASL version on the FASL stream
;;;  property list receiver.  SI:QFASL-STREAM-PROPERTY-LIST and
;;;  FS:FILE-ATTRIBUTE-LIST now have the :FASL-VERSION property, whose value
;;;  is the stream's internal FASL version.
;;; Written 16-Aug-88 18:40:12 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 2
;;; with Experimental System 126.53, ZWEI 125.17, ZMail 73.2, Local-File 75.2, File-Server 24.1, Tape 24.2, Lambda-Diag 17.0, Experimental Unix-Interface 14.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:26
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(DEFUN FASLOAD-INTERNAL (FASL-STREAM PKG NO-MSG-P)
  (LET* ((PATHNAME (SEND FASL-STREAM :PATHNAME))
	 (size (or (send-if-handles fasl-stream :byte-size)
		   (send fasl-stream :get :byte-size)))
	 *fasl-nibble-peek* 
	 (*fasl-nibble-8bit* (ecase size
			       (8. t)
			       (16. nil)))
	 (FDEFINE-FILE-PATHNAME
	   (IF (STRINGP PATHNAME) PATHNAME
	     (SEND PATHNAME :GENERIC-PATHNAME)))
	 (PATCH-SOURCE-FILE-NAMESTRING)
	 (FDEFINE-FILE-DEFINITIONS)
	 (FASL-GENERIC-PLIST-RECEIVER (SEND FASL-STREAM :GENERIC-PATHNAME))
	 (FILE-ID (SEND FASL-STREAM :INFO))
	 (FASL-STREAM-BYPASS-P (OPERATION-HANDLED-P FASL-STREAM :GET-INPUT-BUFFER))
	 *FASL-STREAM-ARRAY* *FASL-STREAM-INDEX* (*FASL-STREAM-COUNT* 0)
	 (FASLOAD-FILE-PROPERTY-LIST-FLAG NIL)
	 (FASL-PACKAGE-SPECIFIED PKG)
	 ;(last-fasl-file-forms nil)
	 ;last-fasl-file-package
	 FASL-FILE-EVALUATIONS
	 FASL-FILE-PLIST
	 fasl-internal-version
	 DONT-CONVERT-DESTINATIONS
	 dont-convert-cdr-codes
	 (FASL-TABLE NIL))
    ;; Set up the environment
    (FASL-START)
    (PUSH (CAR (SEND FASL-STREAM :INFO)) FASLOADED-FILE-TRUENAMES)
    ;; Start by making sure the file type in the first word is really SIXBIT/QFASL/.
    (LET ((W1 (OR (fasl-nibble) 0))
	  (W2 (OR (fasl-nibble) 0)))
      (OR (AND (= W1 #o143150) (= W2 #o71660))
	  (FERROR "~A is not a QFASL file" PATHNAME)))
    (WHEN (= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-version-info)
      (check-version-info)
      (save-version-info))
    (SEND FASL-GENERIC-PLIST-RECEIVER :REMPROP :MACROS-EXPANDED)
    ;; Read in the file property list before choosing a package.
    (WHEN (= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-FILE-PROPERTY-LIST)
      (FASL-FILE-PROPERTY-LIST)
      (let ((compile-in-roots-prop (get (locf fasl-file-plist) :compile-in-roots)))
	(cond ((and compile-in-roots-prop
		    (not (cl:member (si:package-root-name (if pkg pkg *package*))
				    compile-in-roots-prop
				    :test 'string-equal)))
       ;gee, we're not supposed to load compiled code into this heirarchy.  Force READFILE.
	       (close fasl-stream)
	       (return-from fasload-internal
		 (readfile (fs:merge-pathname-defaults (send pathname :new-type :unspecified)
						       nil :LISP) pkg no-msg-p)))
	      (t
	       (let* ((fasd-data (OR (GET (LOCF FASL-FILE-PLIST) :FASD-DATA)
				     (GET (LOCF FASL-FILE-PLIST) :COMPILE-DATA)))
		      (fasd-data-plist (sixth fasd-data)))
		 (let ((version (fourth fasd-data)))
		   (and (not (null version))
			(< version 98.)
			(cerror "Try to load it anyway"
				"~This QFASL file was written from system version ~D~%~
			    and may be dangerous to load into this system.~"
				version))
		   (when fasd-data-plist
		     (setq dont-convert-destinations
			   (if (> version 98.) t
			     (getf fasd-data-plist 'compiler::new-destinations)))
		     (setq dont-convert-cdr-codes
			   (getf fasd-data-plist 'compiler::new-cdr-codes)))))))))
    ;; Enter appropriate environment defined by file property list
    (MULTIPLE-VALUE-BIND (VARS VALS)
	(IF (NOT (STRINGP PATHNAME))
	    (FS:FILE-ATTRIBUTE-BINDINGS
	      (IF PKG
		  ;; If package is specified, don't look up the file's package
		  ;; since that might ask the user a spurious question.
		  (LET ((PLIST (COPY-LIST (SEND FDEFINE-FILE-PATHNAME :PROPERTY-LIST))))
		    (REMF PLIST ':PACKAGE)
		    (LOCF PLIST))
		FDEFINE-FILE-PATHNAME)))
      (PROGV VARS VALS
	(LET ((*PACKAGE* (PKG-FIND-PACKAGE (OR PKG *PACKAGE*) :ASK)))
	  (LET ((*PACKAGE* *PACKAGE*))
	    (OR PKG
		;; Don't want this message for a REL file
		;; since we don't actually know its package yet
		;; and it might have parts in several packages.
		;; (WHEN (= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-version-info)
		;;   (check-version-info))
		;; The above lines have been added in other places where files are loaded.
		;; I don't know if they are needed here or not, since I don't think that this
		;; code works anyway -- Jim
		(= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-REL-FILE)
		NO-MSG-P
		(FORMAT *QUERY-IO* "~&Loading ~A into package ~A~%" PATHNAME *PACKAGE*))
	    (SETQ LAST-FASL-FILE-PACKAGE *PACKAGE*)
	    (FASL-TOP-LEVEL))			;load it.
	  (SEND FASL-GENERIC-PLIST-RECEIVER :PUTPROP FASL-FILE-EVALUATIONS ':RANDOM-FORMS)
	  (RECORD-FILE-DEFINITIONS PATHNAME (NREVERSE FDEFINE-FILE-DEFINITIONS)
				   T FASL-GENERIC-PLIST-RECEIVER)
	  (SET-FILE-LOADED-ID PATHNAME FILE-ID *PACKAGE*))))
    (SETQ *FASL-STREAM-ARRAY* NIL)
    (SETQ LAST-FASL-FILE-FORMS (NREVERSE LAST-FASL-FILE-FORMS))
    PATHNAME))

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:28
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(DEFUN QFASL-STREAM-PROPERTY-LIST (FASL-STREAM)
  (LET ((FASL-GENERIC-PLIST-RECEIVER (MAKE-INSTANCE 'SI:PROPERTY-LIST-MIXIN))
	(FASL-STREAM-BYPASS-P (OPERATION-HANDLED-P FASL-STREAM :GET-INPUT-BUFFER))
	*FASL-STREAM-ARRAY* *FASL-STREAM-INDEX* (*FASL-STREAM-COUNT* 0)
	;; smh 12aug88
	(*fasl-nibble-peek* ())
	(*fasl-nibble-8bit* (ecase (or (send-if-handles fasl-stream :byte-size)
				       (send fasl-stream :get :byte-size))
			      (8. t)
			      (16. nil)))
	(FASLOAD-FILE-PROPERTY-LIST-FLAG NIL)
	(FASL-TABLE NIL))
    ;; Set up the environment
    (FASL-START)
    ;; Start by making sure the file type in the first word is really SIXBIT/QFASL/.
    (LET ((W1 (FASL-NIBBLE))
	  (W2 (FASL-NIBBLE)))
      (OR (AND (= W1 #o143150) (= W2 #o71660))
	  (FERROR "~A is not a QFASL file" (SEND FASL-STREAM :PATHNAME))))
    (WHEN (= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-version-info)
      (check-version-info)
      (save-version-info))
    ;; Read in the file property list before choosing a package.
    (COND ((= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-FILE-PROPERTY-LIST)
	   (FASL-FILE-PROPERTY-LIST)))
    (return-fasl-table)
;   (AND FASL-TABLE (RETURN-ARRAY (PROG1 FASL-TABLE (SETQ FASL-TABLE NIL))))
    (SEND FASL-GENERIC-PLIST-RECEIVER :PROPERTY-LIST)))


))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:34
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defvar *machine-fasling-on* (compiler::target-processor-symbol)
  "Machine on which FASL input is being loaded on")

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:35
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defvar *fasl-version* 2
  "Version number of internal FASL format currently supported")

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:36
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defvar fasl-internal-version 2
  "Version number of current FASL")

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:40
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defun check-version-info ()
  (fasl-whack)
  t)

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:41
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defun fasl-op-version-info ()
  (let ((machine (fasl-next-value))
	(version (fasl-next-value)))
    (unless (eql machine *machine-fasling-on*)
      (ferror "File was compiled for ~A and is being loaded on ~A." machine *machine-fasling-on*))
    (cond ((eql version *fasl-version*))
	  ;; Versions 1 and 2 are compatible on the Lambda.
	  ((and (eql version 1)
		(eql *fasl-version* 2)
		(eql *machine-fasling-on* :lambda)))
	  (t (ferror "File was compiled with version ~A FASL format; version ~A was expected." version *fasl-version*)))
    (setq fasl-internal-version version)
    (enter-fasl-table ())))

))

; From modified file DJ: L.SYS; QFASL.LISP#515 at 16-Aug-88 18:41:43
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(defun save-version-info ()
  (send fasl-generic-plist-receiver :putprop fasl-internal-version :fasl-version))

))