;;; -*- Mode: Common-Lisp; Package: system; Base: 8.; Patch-File: T -*- ;;; Reason: Fixed make-system to only loaded pacthes for component systems that are patchable. [11176] ;;; 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 MAKE-SYSTEM version 6.4 ;;; Written 06/12/90 08:42:26 by BERGER, ;;; while running on ARIES from band LODX ;;; With SYSTEM 6.38, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.3, DISK-LABEL 6.1, BASIC-FILE 6.13, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.18, TV 6.26, DATALINK 6.0, CHAOSNET 6.8, 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.21, ;;; DEBUG-TOOLS 6.5, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.7, 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.6, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.51, CLEH 6.5, IP 3.65, ;;; Experimental CLX 6.11, CLUE 6.105, X11M 6.30, Experimental BUG 11.19, VISIDOC-SERVER 6.2, ;;; microcode 483, Band Name: 6.1-A 5-31 +P6/4 #!C ; From file MAKSYS.LISP#> MAKE-SYSTEM; 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: MAKE-SYSTEM; MAKSYS.#" (DEFUN MAKE-SYSTEM (SYSTEM &REST KEYWORDS &AUX *SOMETHING-LOADED*) "Operate on the files of the system SYSTEM. Most commonly used to compile or load those files which need it. Keywords are not followed by values. Commonly used keywords include: :COMPILE - recompile source files that have been changed since last make-system. '(:COMPILE :compiler-keyword1 value1 :compiler-keyword2 value2 ...) - pass these options to the compiler. :RECOMPILE - recompile and reload all files for this system. '(:RECOMPILE :compiler-keyword1 value1 :compiler-keyword2 value2 ...) - pass these options to the compiler. :NOLOAD - don't load compiled files. :RELOAD - load even files already loaded. :SELECTIVE - ask user about each file individually. :NOCONFIRM - do not ask for confirmation of make-system files. :NOWARN - do not prompt for ANY confirmations, including loader redefinition warnings. :SILENT - don't print lists of files or loader warnings on the terminal at all. :NO-INCREMENT-PATCH - don't increment the patch version number of a patchable system. :INCREMENT-PATCH - do increment the patch version number. :NO-LOAD-PATCHES - do not load patches for patchable system being loaded. :UNRELEASED - load unreleased patches as well. Ignored if :no-load-patches is specified. :FORCE-UNFINISHED - load unfinished patches as well. Ignored if :no-load-patches is specified. :NO-RELOAD-SYSTEM-DECLARATION - don't reload the file that contains the DEFSYSTEM. :PRINT-ONLY - don't load or compile anything, just say what needs to be done. :DESCRIBE - say when files were compiled or loaded, etc. :BATCH - write a file containing any warnings produced by compilation. Just load the file, as lisp code, to reload the warnings. :SERIAL - do transformations exactly in the order specifed in the defsystem :DEFAULTED-BATCH - like :BATCH except warnings file is defaulted instead of asked for. :DO-NOT-DO-COMPONENTS - do not include systems defined by :component-systems. :RECORD - record the file version numbers for the current system (:VERSION [num]) - remake an old major version of a system if that previous system was recorded via the :RECORD option. :SAFE - in determining source later than object, go by the creation date. The default depends on :OUTPUT-VERSION from the DEFSYSTEM :NOOP - this option is ignored." ;********************** ;; note: *somethig-loaded* is a special variable defined by a defvar in the file DEFS. ;; It realy should be included in the list *make-system-special-variables* and removed ;; from the defun line. It is not really an aux variable but a klude way to insure ;; *something-loaded* is reset on each entry. (PROGW *MAKE-SYSTEM-SPECIAL-VARIABLES* (UNWIND-PROTECT (CATCH 'EXIT-MAKE-SYSTEM (SETQ KEYWORDS (COPY-LIST KEYWORDS)) ;get copy of &rest arg to be safe (FIND-SYSTEM-NAMED SYSTEM NIL NIL KEYWORDS) ;be sure the defsystem is loaded (MAYBE-RELOAD-SYSTEM-DECLARATION SYSTEM KEYWORDS) ; and that it is current ;;initialize some make-system-special-variables (SETQ *SYSTEM-BEING-MADE* (FIND-SYSTEM-NAMED SYSTEM t t KEYWORDS)) ;get the real system, in case new one loaded (SETQ *SYSTEM-DEFAULT-BINARY-FILE-TYPE* (OR (GETF (SYSTEM-PLIST *SYSTEM-BEING-MADE*) 'DEFAULT-BINARY-FILE-TYPE) (LOCAL-BINARY-FILE-TYPE))) (SETQ *TOP-LEVEL-TRANSFORMATIONS* `(,@*LOAD-TYPE-TRANSFORMATIONS* DO-COMPONENTS-INTERNAL)) (SETQ *MAKE-SYSTEM-SERIALLY* (SERIAL-P *SYSTEM-BEING-MADE*)) ;get the :serial attribute for the system. dkm 02/88 DKM ;; Do all the keywords (DO-THE-KEYWORDS KEYWORDS) (SETUP-FOR-OUTPUT-VERSION) ;;If we are doing an old version (via :VERSION keyword), get all that setup (AND *USE-OLD-VERSION* (DO-VERSION-KEYWORD)) ;; Make :NO-INCREMENT-PATCH override :COMPILE even if :COMPILE comes later. (WHEN *NO-INCREMENT-PATCH* (SETQ *TOP-LEVEL-TRANSFORMATIONS* (DELETE-IF #'(LAMBDA (X) (MEMBER X '(INCREMENT-COMPILED-VERSION) :TEST #'EQ)) *TOP-LEVEL-TRANSFORMATIONS*))) ;; If this is a patchable system, let's be sure the patch files are ;; around now instead of waiting for all the other transformations to ;; finish before finding this out. This isn't necessary, but it is a ;; convience for the user to know of this situation early. ; (AND (SYSTEM-PATCHABLE-P *SYSTEM-BEING-MADE*) ;all we care about is the side effect of ; (PATCH-VERSION-NEWER-THAN-LOADED)) ;insuring the patch directories are out there ;; Process forms with compiler context (DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-BEFORE*) (eval form)) (IF (FBOUNDP 'COMPILER:COMPILER-WARNINGS-CONTEXT-BIND) (COMPILER:COMPILER-WARNINGS-CONTEXT-BIND (PERFORM-TRANSFORMATIONS (COLLECT-TOP-LEVEL-TRANSFORMATIONS *SYSTEM-BEING-MADE*))) ;;Compiler isn't around. Go without it. (PERFORM-TRANSFORMATIONS (COLLECT-TOP-LEVEL-TRANSFORMATIONS *SYSTEM-BEING-MADE*))) ;; Finally process any forms queued by the keywords with compiler context (DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-AFTER*) (eval form)) ;; See if any patches need to be loaded for this system. (WHEN (AND *LOAD-PATCHES* (GET-PATCH-SYSTEM-NAMED *SYSTEM-BEING-MADE* T T) (SYSTEM-PATCHABLE-P *SYSTEM-BEING-MADE*)) (LET ((LOAD-PATCHES-ARGS NIL)) (AND *SILENT-P* (PUSH :SILENT LOAD-PATCHES-ARGS)) (AND (EQ *QUERY-TYPE* :NOCONFIRM) (PUSH :NOCONFIRM LOAD-PATCHES-ARGS)) (AND *UNRELEASED* (PUSH :UNRELEASED LOAD-PATCHES-ARGS)) ; DAB 01-12-89 (AND *FORCE-UNFINISHED* (PUSH :FORCE-UNFINISHED LOAD-PATCHES-ARGS)) ; DAB 01-12-89 (APPLY #'LOAD-PATCHES :SYSTEMS (cons (SYSTEM-SYMBOLIC-NAME *SYSTEM-BEING-MADE*) ;;Lisp Ref. P 24-2. All operation form on all components. (REMOVE-IF-NOT #'(LAMBDA (NAME) ; DAB 06-12-90 Remove component system not patchable.[11176] (SYSTEM-PATCHABLE-P (FIND-SYSTEM-NAMED NAME))) (SYSTEM-COMPONENT-SYSTEMS *SYSTEM-BEING-MADE*)) ) LOAD-PATCHES-ARGS))) ;;If :RECORD option was specified, do it. (AND *RECORD-VERSION-NUMBERS* (RECORD-SYSTEM-IN-LOG)) ;; System has been made! Set :MADE-P flag to T ;;;;; BMK -- 8/26/87 (if (and *SOMETHING-LOADED* (not (member :print-only keywords))) ;01-17-89 DAB (progn (SETF (GETF (SYSTEM-PLIST *SYSTEM-BEING-MADE*) :MADE-P) ;;;;; T) ;;;;; (PUSHNEW (STRING (SYSTEM-SYMBOLIC-NAME *SYSTEM-BEING-MADE*)) ;;;;; *MODULES*))) (remember-generic-pathnames SYSTEM) ; DAB 04-14-89 ) ;;;;; ;; Now forms outside of compiler context ;; These are done even if there was an error. (DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-FINALLY*) (eval form))) *SOMETHING-LOADED*)) ))