;;; -*- Mode: Common-Lisp; Package: SI; Base: 8.; Patch-File: T -*-
;;; Patch file for BASIC-FILE version 6.2
;;; Reason: Fixed fasload-internal to handle the case were the calling function passed a PKG that did not exist. SYS:common-lisp-ar-1 would result.
;;; Written 06/13/89 10:07:53 by BERGER,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.5, VIRTUAL-MEMORY 6.1, EH 6.1, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.1, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.2, TV 6.6, DATALINK 6.0, CHAOSNET 6.0, GC 6.2, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.1, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.1,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.1, TI-CLOS 6.5, CLEH 6.3, IP 3.46,
;;;  Experimental BUG 11.7, Experimental CLX 6.1, CLUE 6.5, X11M 6.1, DECNET 1.67,
;;;   microcode 429, Band Name: Release 6.0 + SLE 6/5

#!C
; From file LOAD.LISP#> BASIC-FILE; SYS:
#8R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: BASIC-FILE; LOAD.#"


(DEFUN FASLOAD-INTERNAL (FASL-STREAM PKG NO-MSG-P)
  ;; 2/21/85 - Fix binding of INTERPRETER-FUNCTION-ENVIRONMENT to preserve mode.
  ;; 3/04/85 - Allow reading data files of either QFASL or XFASL type.
  ;; 2/02/87 - Change to allow code that loads XFASL data files to be embedded within XLD files.
  ;;10/07/87 CLM - The :random-forms property is no longer unconditionally placed on the
  ;;               generic pathname's property list.  If someone still wants this information,
  ;;               they must set the variable LOADER-PATHNAME-PROPERTIES to
  ;;               some non-NIL value.
  (using-resource (fasl-table fasl-table-resource)	
    (LET* ((PATHNAME (FUNCALL FASL-STREAM :PATHNAME))
	   (FDEFINE-FILE-PATHNAME
	     (IF (STRINGP PATHNAME)
		 PATHNAME
		 (FUNCALL PATHNAME :GENERIC-PATHNAME)))
	   (PATCH-SOURCE-FILE-NAMESTRING)
	   (FDEFINE-FILE-DEFINITIONS)
	   (FASL-GENERIC-PLIST-RECEIVER (FUNCALL FASL-STREAM :GENERIC-PATHNAME))
	   (FILE-ID (FUNCALL FASL-STREAM :INFO))
	   (FASL-STREAM-BYPASS-P (MEMBER :GET-INPUT-BUFFER
					 (FUNCALL FASL-STREAM :WHICH-OPERATIONS)
					 :TEST #'EQ))
	   FASL-STREAM-ARRAY FASL-STREAM-INDEX (FASL-STREAM-COUNT 0)
	   (FASL-STREAM-OFFSET 0)(LAST-FASL-STREAM-COUNT 0)(LAST-FASL-STREAM-INDEX 0)	
	   (FASLOAD-FILE-PROPERTY-LIST-FLAG NIL)
	   (FASL-PACKAGE-SPECIFIED PKG)
	   FASL-FILE-EVALUATIONS
	   FASL-FILE-PLIST
	   (PREVIOUS-TYPE ACTUAL-TYPE)		
	   FILE-TYPE
	   (*INTERPRETER-ENVIRONMENT* NIL)
	   (*INTERPRETER-FUNCTION-ENVIRONMENT* NIL))
      ;; Set up the environment
      (FASL-START)
      ;; Start by making sure the file type in the first word is really SIXBIT/QFASL/.
      (SETQ FILE-TYPE (VALIDATE-BINARY-FILE FASL-STREAM NIL))
      (FUNCALL FASL-GENERIC-PLIST-RECEIVER :REMPROP :MACROS-EXPANDED)
      ;; Read in the file property list before choosing a package.
      (WHEN (AND (FBOUNDP 'INTERN)
		 (= (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-FILE-PROPERTY-LIST))
      

	(FASL-FILE-PROPERTY-LIST)
	
	(UNLESS (OR (NULL (GET (LOCF FASL-FILE-PLIST) :COMPILE-DATA))
		    (EQ FILE-TYPE (LOCAL-BINARY-FILE-TYPE)))
	  ;; Data files such as written by DUMP-FORMS-TO-FILE can be read in
	  ;; either QFASL, XFASL, or XLD form, but files generated by the compiler
	  ;; must be of the proper type for the FEFs to be valid.
	  (FERROR NIL "~A is not a valid ~A file."
		  PATHNAME
		  (SYMBOL-NAME (LOCAL-BINARY-FILE-TYPE))))
	)

      ;; 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 :PLIST))))
		      (REMPROP (LOCF PLIST) :PACKAGE)
		      (LOCF PLIST))
		    FDEFINE-FILE-PATHNAME)))
	(PROGV VARS VALS
	  (LET-IF (FBOUNDP 'FIND-PACKAGE)
		  ((*PACKAGE* (or (and pkg (pkg-FIND-PACKAGE PKG))  ; DAB 06-13-89
				   *PACKAGE*)))
	    (LET-IF (FBOUNDP 'FIND-PACKAGE) ((*PACKAGE* *PACKAGE*))
	      (OR PKG (NOT (FBOUNDP 'FIND-PACKAGE))
		  ;; 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.
		  (=  (LOGAND (FASL-NIBBLE-PEEK) %FASL-GROUP-TYPE) FASL-OP-REL-FILE)
		  NO-MSG-P
		  (FORMAT T "~&; Loading ~A into package ~A~%" PATHNAME *PACKAGE*))
	      (IF (FBOUNDP 'FIND-PACKAGE)
		  (SETQ LAST-FASL-FILE-PACKAGE *PACKAGE*))
	      (FASL-TOP-LEVEL))			;load it.
	    (WHEN LOADER-PATHNAME-PROPERTIES 
	      (FUNCALL FASL-GENERIC-PLIST-RECEIVER :PUTPROP FASL-FILE-EVALUATIONS :RANDOM-FORMS))
	    (LET ((*PACKAGE* (IF (VARIABLE-BOUNDP *PACKAGE*) *PACKAGE* "SI")))
	      (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))
      (WHEN (AND PREVIOUS-TYPE
		 (NEQ PREVIOUS-TYPE FILE-TYPE))
	(SETQ ACTUAL-TYPE PREVIOUS-TYPE))
      PATHNAME)))
))