LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760030330. :SYSTEM-TYPE :LOGICAL :VERSION 13. :TYPE "LISP" :NAME "DEFSYSTEM" :DIRECTORY ("REL3-SOURCE" "COMPILER") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758302410. :AUTHOR "REL3" :LENGTH-IN-BYTES 16295. :LENGTH-IN-BLOCKS 16. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;;;  -*- Mode:Common-Lisp; Package:Compiler; Base:10 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;; This file defines the "Compiler" system.;;; 03/06/85 DNG - Original version of this file. The DEFSYSTEM was previously in ;;;                SYS;SYSDCL and :CROSS-LOAD was defined in SYS;QCDEFS, but that ;;;                didn't work because the;;;                DEFSYSTEM was processed before the :CROSS-LOAD definition was loaded.;;; 07/09/85 DNG - Original version for release 3; moved from SYS;QCSYS to ;;;                COMPILER;DEFSYSTEM.;;; 07/12/85 DNG -;;; 09/21/85 DNG - Use logical host "V2" instead of "REL2"; include package creation here.;;; 11/13/85 DNG - Use logical host "LROY" instead of "V2"; new file NUMOPT; separate;;;                disassembler for inclusion in the cold load.;;;  1/14/86 DNG - FORWARD-VALUE-CELL of TARGET-PROCESSOR so that #. works correctly.;;;  2/17/86 DNG - EXPORT the shadowed GLOBAL symbols; load "COMPILER;DEFMIC" after;;;   "COLD-BAND;DEFMIC".;;;  2/19/86 DNG - FORWARD-VALUE-CELL of FILE-CONSTANTS-LIST for EVAL-FOR-TARGET.;;;  3/13/86 DNG - Shadow PUTDECL and DEFDECL.;;;  3/20/86 DNG - Use file WALKER instead of QCLUKE.;;;  8/29/86 JK  - Add "VM2-FASL-OP-SETUP" so cross-compiler knows about VM2 FASL-OPS.;;;  9/12/86 DNG - Change file from Zetalisp to Common Lisp mode.;;;  9/18/86 DNG - Some adjustments for use under VM2.;;; 10/01/86 DNG - Use system name ELROY-COMPILER for cross-compiling the compiler.;;; 10/13/86 DNG - Add file FORMAT-MACRO.;;; 11/06/86 DNG - Replace physical pathnames with logical pathnames.;;; 11/11/86 DNG - Separate out the cold-load files into the DISASSEMBLER system.;;; 11/17/86 DNG - Change "U2:INFO;" to "SYS:UCODE;".;;; 11/22/86 DNG - Comment out setting of debug flag.;;;  1/09/87 DNG - Define DEFSYSCONST .;;;  1/30/87 DNG - Add file UNFASL.;;;  2/04/87 DNG - Add :AUXILIARY transformations for debug files not used in released product.;;;  3/09/87 DNG - Update :PATCHABLE declaration and add :WARNINGS-PATHNAME-DEFAULT .(comment;;;    ---  Temporary debugging flag  ---(eval-when (eval lisp:compile load)   (unless (member 'compiler:debug *features*)     (push 'compiler:debug *features*)))) ;;;    ---  Create the COMPILER2 package  ---#-Elroy(eval-when ( eval load compile )  (LET (( *PACKAGE* *PACKAGE* ))    ;; Create a new package for the release 3 compiler so that it can    ;; co-exist with the old compiler.    (IN-PACKAGE "COMPILER2" :NICKNAMES '("V2") :USE '("GLOBAL" "SYS"))    ;; Shadow symbols that are defined as part of the compiler but that    ;; reside in the GLOBAL or SYS package.    (SHADOW '(COMPILE COMPILE-LAMBDA      COMPILE-FILE QC-FILE QC-FILE-LOAD FASD-UPDATE-FILE DEFUN-COMPATIBILITY      DUMP-FORMS-TO-FILE MACROEXPAND-ALL      HEADER-TYPE-FEF LIST-SUM LIST-PRODUCT      UNCOMPILE DISASSEMBLE UNBIND EXPR WARN      TARGET-BINARY-FILE-TYPE      *LEXPR *EXPR *FEXPR      MAKE-OBSOLETE OBJECT-OPERATION-WITH-WARNINGS       MAKE-SYSTEM PUTDECL DEFDECL))    (EXPORT '(COMPILE COMPILE-LAMBDA      COMPILE-FILE QC-FILE QC-FILE-LOAD FASD-UPDATE-FILE DEFUN-COMPATIBILITY      DUMP-FORMS-TO-FILE MACROEXPAND-ALL      UNCOMPILE DISASSEMBLE WARN      TARGET-BINARY-FILE-TYPE      MAKE-OBSOLETE      MAKE-SYSTEM PUTDECL DEFDECL))    (IMPORT '(COMPILER:OPTIMIZE-SWITCH))    ;; Import some symbols that are really just used as keywords rather    ;; than having any value or definition.    (IMPORT '(COMPILER:MICRO-COMPILE      COMPILER:MACRO-COMPILE      COMPILER:COMPILE-TO-CORE      COMPILER:QFASL      COMPILER:REL      COMPILER:IGNORABLE-VARIABLE      COMPILER:UNDEFINED-FUNCTION-USED      COMPILER:TRY-INLINE      COMPILER:SIZE      COMPILER:RECURSIVE      COMPILER:QFASL-DONT-RECORD      COMPILER:VALUE      COMPILER:QUOTE-VECTOR      COMPILER:SYSTEM-CONSTANT ; this really should be in the SYS package      ) )    )  ; (globalize 'compiler:system-constant PKG-SYSTEM-PACKAGE)  (globalize 'SI:%CALL PKG-SYSTEM-PACKAGE) )#-Elroy(progn  (globalize 'V2:SINGLE-FLOATP PKG-SYSTEM-PACKAGE)  (globalize 'V2:DOUBLE-FLOATP PKG-SYSTEM-PACKAGE)  (globalize 'V2:%LOAD-MEMORY-MAP PKG-SYSTEM-PACKAGE)  (deff compiler2:get-defined-value #'identity); used in QCOM    (forward-value-cell 'compiler2:functions-referenced  'compiler:functions-referenced)  (forward-value-cell 'compiler2:FILE-SPECIAL-LIST  'compiler:FILE-SPECIAL-LIST)  (forward-value-cell 'compiler2:FILE-UNSPECIAL-LIST  'compiler:FILE-UNSPECIAL-LIST)  (forward-value-cell 'compiler2:target-processor  'compiler:target-processor)  (forward-value-cell 'compiler2:FILE-CONSTANTS-LIST  'compiler:FILE-CONSTANTS-LIST);; The following are forwarded because of references in the flavor system.  (forward-value-cell 'compiler2:qc-file-in-progress  'compiler:qc-file-in-progress)  (forward-value-cell 'compiler2:qc-file-load-flag  'compiler:qc-file-load-flag)  (forward-value-cell 'compiler2:*return-status*  'compiler:*return-status*)  )(unless (fboundp 'compiler2:defsysconst)  (deff compiler2:defsysconst 'si:defsysconst)) ; used in "UCODE;DEF-ELROY.LISP".#+(and Elroy compiler:debug)(progn;; These were in SYS in release 2 but not in release 3; this IMPORT is for;; compatibility of cross-compiled and natively compiled compiler code.;;  -- DNG 10/10/86(IMPORT 'SI:(FEF-ARG-AUX FEF-ARG-FREE FEF-ARG-INTERNAL FEF-ARG-INTERNAL-AUX     FEF-ARG-OPT FEF-ARG-REQ FEF-ARG-REST FEF-ARG-SYNTAX))(IMPORT 'SI:(FEF-INI-C-PNTR FEF-INI-COMP-C FEF-INI-EFF-ADR FEF-INI-NIL     FEF-INI-NONE FEF-INI-OPT-SA FEF-INI-PNTR FEF-INI-SELF FEF-INIT-OPTION     FEF-LOCAL FEF-NAME-PRESENT FEF-QT-DONTCARE FEF-QT-EVAL FEF-QT-QT     FEF-QUOTE-STATUS FEF-SPECIAL FEF-SPECIALNESS))(IMPORT 'SI:(INTERPRETED-DEFINITION THROW-N)))#+Elroy ; if not already defined(comment - not currently supported in release 3;;;     ---  Define :CROSS-LOAD transformation for DEFSYSTEM ---(SI:DEFINE-SIMPLE-TRANSFORMATION :CROSS-LOAD CROSS-LOAD-1 NOT-YET-CROSS-LOADED-P      (':LISP) NIL ("Cross-load" "Cross-loading" "cross-loaded")      NIL T)(DEFVAR FILES-CROSS-LOADED NIL) ; List of files that have been cross-loaded.(DEFUN CROSS-LOAD-1 (INFILE &AUX PATHNAME)  ;; Load INFILE for every target environment except the host environment,  ;; for which it should have been loaded previously.  (DECLARE (SPECIAL TARGET-KINDS HOST-PROCESSOR)) ; defined in COMPILER;TARGET  (DOLIST ( TARGET TARGET-KINDS )    (UNLESS (EQ TARGET HOST-PROCESSOR)      (SETQ SI:*SOMETHING-LOADED* T)      (SETQ PATHNAME (LOAD-FOR-TARGET INFILE TARGET SI:*FORCE-PACKAGE* T))      (PUSH (SEND PATHNAME :STRING-FOR-PRINTING)    FILES-CROSS-LOADED)  ) ))(DEFUN NOT-YET-CROSS-LOADED-P ( FILE-NAME )  ;; This is rather crude and might be improved later.  ;; Here we check version numbers, but not package or creation date.  (LET ( TRUENAME )    ;; Open the file with the same options READFILE will use.    (WITH-OPEN-STREAM (STREAM (SEND (FS:MERGE-PATHNAME-DEFAULTS      FILE-NAME FS:LOAD-PATHNAME-DEFAULTS NIL)    ':OPEN-CANONICAL-DEFAULT-TYPE ':LISP    ':ERROR ':REPROMPT))      (SETQ TRUENAME (SEND STREAM :TRUENAME)) )    (NOT (MEMBER (SEND TRUENAME :STRING-FOR-PRINTING) FILES-CROSS-LOADED :TEST #'EQUAL) ) ) ) ) ;;;     ---  Define compiler system  ---;;;;;;  There are two systems defined here: DISASSEMBLER, which is part of the ;;;  cold band, and COMPILER, which is optionally loaded by MAKE-SYSTEM.  ;;;  Both systems need to be recompiled for a full build.#+Elroy(DEFSYSTEM DISASSEMBLER  (:PATHNAME-DEFAULT "SYS:COMPILER;")  (:MODULE DEFS ("MINDEFS"))  ; definitions that need to be in the minimal cold-band  (:MODULE OPDEFS ("TARGET"))  ; defines macros used in the DEFOP file  (:SKIP :COMPILE-LOAD OPDEFS)  ; normally loaded with the COMPILER system  (:MODULE DISASS ("DISASS"))  ; the disassembler  (:MODULE MIC ("SYS:UCODE;DEFOP")) ; instruction set specification  (:MODULE DATA ("DAINFO"))  ; data from DEFOP used by the disassembler  (:SKIP :COMPILE-LOAD DEFS)  ; included in the cold load  (:COMPILE-LOAD DISASS (:FASLOAD DEFS))  (:READFILE MIC (:FASLOAD DEFS OPDEFS))  (:COMPILE DATA ((:FASLOAD DEFS OPDEFS)(:READFILE MIC))) ; not loaded because only used in cold load )#+Elroy(DEFSYSTEM #+compiler:debug COMPILER2 #-compiler:debug COMPILER ; release 3 native compiler  #+compiler:debug  (:NAME "Compiler2")  #-compiler:debug  (:NAME "Compiler")  #+compiler:debug  (:SHORT-NAME "Compiler")  ;; DO NOT specify the package here because the files WARN and FORMAT-MACRO  ;; are in different packages.  (:PATHNAME-DEFAULT "SYS:COMPILER;")  (:PATCHABLE "SYS:PATCH.COMPILER;" PATCH)  (:WARNINGS-PATHNAME-DEFAULT "SYS:CWARNS;COMPILER.LISP")  (:MODULE MINDEFS ("MINDEFS"))   ; definitions for minimal kernel  (:MODULE DEFS-A ("WARNDEFS"   ; warnings database macros   ))  (:MODULE DEFS-B ( "DEFS"   ; definitions for whole compiler "TARGET"   ; target environment and instruction set ))  (:MODULE DEFS-C ( "P1DEFS"   ; definitions needed only in pass 1 "P2DEFS"   ; definitions needed only in pass 2         ))  ;; Note: File WALKER is loaded first so that the symbol properties it defines  ;;   will end up in the property list after the more often used P1 and P2 properties.  (:MODULE MAIN ("WALKER"   ; code walker "FILE"   ; COMPILE-FILE, COMPILE-STREAM       "WARN"      ; warnings database functions "COMPILE"   ; compiler top-level "P1FUNS"   ; pass 1 functions "TYPEOPT"   ; type-checking pattern optimizer "P1HAND"   ; pass 1 handler functions "NUMOPT"   ; optimizers for numbers and characters "P1OPT"   ; other pass 1 optimizations "FORMAT-MACRO"   ; FORMAT optimizer "P1STYLE"   ; style checkers "ZETALISP"   ; Zetalisp support "MACLISP"   ; MacLisp compatibility "P2FUNS"   ; pass 2 functions "P2HAND"   ; pass 2 handler functions "PEEP"   ; peep-hole and branch optimizer "LAP"   ; Lisp Assembly Program [QLAPP] "FASD"   ; routines for writing object files "UNFASL"   ; object file decode#+compiler:debug "DEBUG"   ; temporary debugging aids ))  (:MODULE DEBUG ("DEBUG.LISP" "WARNDUMMY.LISP" "PERMUTE-KEY-ARGS.LISP" "STATISTICS.LISP") ; temporary debug aids   :NEVER-SHIP-P T) ; not part of release 3  (:MODULE CROSS ("COLD.LISP" "FLAV.LISP" "DEFMIC.LISP" "ELROY.LISP" "VM2-FASL-OP-SETUP.LISP") ; for cross-compilation only   :NEVER-SHIP-P T) ; not part of release 3  (:MODULE MIC-DEFS ("SYS:UCODE;DEF-ELROY"))  (:MODULE MIC ("SYS:UCODE;DEFOP""SYS:UCODE;DEFOP-AUX"))  (:SKIP :COMPILE-LOAD MINDEFS) ; not loaded here because included in cold-load  (:COMPILE-LOAD DEFS-A)  (:READFILE MIC-DEFS)  (:COMPILE-LOAD DEFS-B ((:FASLOAD MINDEFS DEFS-A) (:READFILE MIC-DEFS)))  (:COMPILE-LOAD DEFS-C (:FASLOAD MINDEFS DEFS-A DEFS-B))  (:COMPILE-LOAD MAIN ((:FASLOAD MINDEFS DEFS-A DEFS-B DEFS-C)))  (:READFILE MIC (:FASLOAD DEFS-B))  (:AUXILIARY DEBUG) (:AUXILIARY CROSS) ; not used in release 3 but don't throw away )(comment(defun user:build-compiler2 (batch-mode-p increment-version-p)  ;; Use this function to build a new major version of Compiler2 under release 2.  #-Elroy  (unless (get 'si:get-debug-info-field 'si:setf-method)    (load "kernel:baseline;debug-info"))  #-Elroy  (let (( si:inhibit-fdefine-warnings t ))    (make-system 'z-to-c :noconfirm)) ; needed for optimizations  (let (( si:inhibit-fdefine-warnings (and batch-mode-p :just-warn) ))    (make-system 'compiler2 :compile (if batch-mode-p :defaulted-batch :noop) (if increment-version-p :noop :no-increment-patch)))  ))#-Elroy(DEFSYSTEM COMPILER2 ;  release 3 compiler running under release 2  (:NAME "Compiler2")  (:PATHNAME-DEFAULT "LROY:COMPILER;")  (:PATCHABLE "LROY:PATCH-COMPILER;")  (:MODULE DEFS-A ("MINDEFS"   ; definitions for minimal kernel           #+Elroy "WARNDEFS"   ; warnings database macros ))  (:MODULE DEFS-B ( "DEFS"   ; definitions for whole compiler "TARGET"   ; target environment and instruction set ))  (:MODULE DEFS-C ( "P1DEFS"   ; definitions needed only in pass 1 "P2DEFS"   ; definitions needed only in pass 2         #-Elroy "COLD"   ; definitions needed in cold load         ))  #-Elroy  (:MODULE DEFS-D ( "VM2-FASL-OP-SETUP"   ; fasl-ops needed by FASD ))  ;; Note: File WALKER is loaded first so that the symbol properties it defines  ;;   will end up in the property list after the more often used P1 and P2 properties.  (:MODULE MAIN ("WALKER"   ; code walker "FILE"   ; COMPILE-FILE, COMPILE-STREAM         #+Elroy "WARN"      ; warnings database macros "COMPILE"   ; compiler top-level "P1FUNS"   ; pass 1 functions "TYPEOPT"   ; type-checking pattern optimizer "P1HAND"   ; pass 1 handler functions "NUMOPT"   ; optimizers for numbers and characters "P1OPT"   ; other pass 1 optimizations "FORMAT-MACRO"   ; FORMAT optimizer "P1STYLE"   ; style checkers "ZETALISP"   ; Zetalisp support "MACLISP"   ; MacLisp compatibility "P2FUNS"   ; pass 2 functions "P2HAND"   ; pass 2 handler functions "PEEP"   ; peep-hole and branch optimizer "LAP"   ; Lisp Assembly Program [QLAPP] "FASD"   ; routines for writing object files #+compiler:debug "DEBUG"  ; temporary debugging aids #-Elroy "FLAV"   ; temporary flavor interface "DISASS"   ; Disassembler ))  #-Elroy  (:MODULE SYSDEFS (#-compiler:debug "SYS: COLD-BAND; QCOM"    "SYS: COLD-BAND; DEFMIC" ) :PACKAGE "COMPILER2")  (:MODULE MIC #+Elroy       ("u2:info;def-elroy.lisp""U2:INFO;DEFOP.LISP""u2:info;defop-aux.lisp")       #-Elroy       (#-compiler:debug                "SYS: COLD-BAND; DOCMIC""DEFMIC"))  (:COMPILE-LOAD DEFS-A)  (:COMPILE-LOAD DEFS-B (:FASLOAD DEFS-A))  (:COMPILE-LOAD DEFS-C (:FASLOAD DEFS-A DEFS-B))  #-Elroy  (:READFILE DEFS-D (:FASLOAD DEFS-A DEFS-B DEFS-C))  (:COMPILE-LOAD MAIN ((:FASLOAD DEFS-A DEFS-B DEFS-C) #-Elroy (:READFILE DEFS-D)))  #-Elroy  (:READFILE SYSDEFS)  (:READFILE MIC #-Elroy (:READFILE SYSDEFS));;(:CROSS-LOAD SYSDEFS ((:FASLOAD DEFS)(:READFILE MIC))) )#-Elroy(DEFSYSTEM ELROY  ; cross-compiler for release 3 instruction set  (:PATHNAME-DEFAULT "LROY:COMPILER;")  (:MODULE DO-IT ( "ELROY" ))  (:MODULE DATA ( "u2:info;def-elroy.lisp"  "U2:INFO;DEFOP.LISP"  "u2:info;defop-aux.lisp"  "U2:INFO;LROY-QCOM.LISP" ))  (:AUXILIARY DATA)  (:READFILE DO-IT) )#-Elroy(defparameter *default-cc-pathname* (pathname "LROY:COMPILER;"))#-Elroy(defun user:cc-compiler ( file &optional output-file )  "Cross-compile individual compiler files"  (unless (get 'car :elroy)    (require 'elroy))  (unless (get 'compiler2:target-processor :elroy)    (compiler2:load-for-target "Lroy:Compiler;MinDefs" "Elroy"))  (unless (get 'FILE-OPERATION-WITH-WARNINGS :elroy)    (compiler2:load-for-target (if (<= (si:get-system-version 'compiler2) 9)   "Lroy:Compiler;WarnDummy" "Lroy:Compiler;WarnDefs")       "Elroy"))  (unless (get 'COMPILER2:LOCKING-RESOURCES :elroy)    (compiler2:load-for-target "Lroy:Compiler;Defs" "Elroy"))  (if (listp file)      (dolist ( f file (values) )(print  (user:cc-compiler f)))    (compiler2:compile-file      (fs:merge-pathname-defaults file *default-cc-pathname* :LISP)      :target 'elroy      :output-file output-file      )))(comment(defun user:cross-compile-compiler () ; to compile the whole thing  (require 'elroy)  (user:copy-output "KELVIN:GRAY.TEMP;BUILD.DRIBBLE"      (user:make-system-2 "ELROY-COMPILER"  '(:compile :target elroy)   :noload :no-increment-patch) )  ))seconds total."    (/ TOTAL-TIME INTERNAL-TIME-UNITS-PER-SECOND)))  (VALUES))(DEFUN T