;;; -*- Mode: Common-Lisp; Package: sys; Base: 8.; Patch-File: T -*- ;;; Reason: Add Binding for UNDO-DECLARATIONS-FLAG in readfile-internal and SYS:FASLOAD-INTERNAL. [9013] ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for BASIC-FILE version 6.13 ;;; Written 05/24/90 13:24:59 by BERGER, ;;; while running on Pasteur from band LOD2 ;;; With SYSTEM 6.35, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.4, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.3, DISK-LABEL 6.0, BASIC-FILE 6.11, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.14, TV 6.25, DATALINK 6.0, CHAOSNET 6.7, GC 6.4, MEMORY-AUX 6.0, NVRAM 6.3, ;;; SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.0, INPUT-EDITOR 6.0, METER 6.2, ZWEI 6.17, ;;; DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.6, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0, ;;; NAMESPACE-EDITOR 6.5, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.47, CLEH 6.5, IP 3.62, ;;; Experimental CLX 6.11, CLUE 6.104, X11M 6.24, Experimental BUG 11.19, microcode 648, ;;; Band Name: rel6.0 1/23 #!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 READFILE-INTERNAL (*STANDARD-INPUT* PKG NO-MSG-P) ;; 2/5/85 DNG - Fix interpreter environment binding to not change mode. (LET* ((FILE-ID (FUNCALL *STANDARD-INPUT* :INFO)) (PATHNAME (FUNCALL *STANDARD-INPUT* :PATHNAME)) (GENERIC-PATHNAME (FUNCALL PATHNAME :GENERIC-PATHNAME)) (*PACKAGE* *PACKAGE*) (FDEFINE-FILE-DEFINITIONS) (FDEFINE-FILE-PATHNAME GENERIC-PATHNAME) (*INTERPRETER-ENVIRONMENT* NIL) (*INTERPRETER-FUNCTION-ENVIRONMENT* (EQ *INTERPRETER-FUNCTION-ENVIRONMENT* T)) (*INTERPRETER-EXTRA-ENVIRONMENT* NIL) ; DAB 01-31-90 [9013] (UNDO-DECLARATIONS-FLAG NIL) ; DAB 01-31-90 [9013] (COMPILER:*COMPILE-FILE-ENVIRONMENT* NIL) ; DAB 01-31-90 [9013] ) (FS:READ-ATTRIBUTE-LIST GENERIC-PATHNAME *STANDARD-INPUT*) ;; Enter appropriate environment for the file (MULTIPLE-VALUE-BIND (VARS VALS) (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 GENERIC-PATHNAME :PLIST)))) (REMPROP (LOCF PLIST) :PACKAGE) (LOCF PLIST)) GENERIC-PATHNAME)) (PROGV VARS VALS ;; If package overridden, do so. *PACKAGE* is bound in any case. (COND (PKG (SETQ *PACKAGE* (FIND-PACKAGE PKG))) (NO-MSG-P) ;And tell user what it was unless told not to (T (FORMAT T "~&; Loading ~A into package ~A~%" PATHNAME *PACKAGE*))) (DO ((EOF '(())) ;; If the file contains a SETQ, don't alter what package we recorded loading in. (*PACKAGE* *PACKAGE*) (FORM)) ((EQ (SETQ FORM (READ *STANDARD-INPUT* NIL EOF)) EOF)) (IF PRINT-LOADED-FORMS (PRINT (FUNCALL *LOADER-EVAL* FORM)) (FUNCALL *LOADER-EVAL* FORM))) (IF (EQ *LOADER-EVAL* '*EVAL) (PROGN ; for normal load (SET-FILE-LOADED-ID PATHNAME FILE-ID *PACKAGE*) (RECORD-FILE-DEFINITIONS PATHNAME (NREVERSE FDEFINE-FILE-DEFINITIONS)) PATHNAME) (SEND *STANDARD-INPUT* :TRUENAME)) ; cross-loader needs version number )))) (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) (*INTERPRETER-EXTRA-ENVIRONMENT* NIL) ; DAB 01-31-90 [9013] (UNDO-DECLARATIONS-FLAG NIL) ; DAB 01-31-90 [9013] (COMPILER:*COMPILE-FILE-ENVIRONMENT* NIL) ; DAB 01-31-90 [9013] ) ;; 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))) ))