1
0
mirror of synced 2026-03-13 06:00:45 +00:00

Compiler functions were not respecting the external format as copied from the source file

This commit is contained in:
rmkaplan
2026-02-25 23:33:39 -08:00
parent 80a47b1409
commit af574e5c6c
6 changed files with 310 additions and 218 deletions

View File

@@ -1,18 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "24-Sep-2023 14:11:25" {WMEDLEY}<sources>CMLCOMPILE.;2 22597
(FILECREATED "25-Feb-2026 23:03:38" {WMEDLEY}<sources>CMLCOMPILE.;4 25235
:EDIT-BY rmk
:CHANGES-TO (FNS COMPILE-IN-CORE)
:CHANGES-TO (FNS FAKE-COMPILE-FILE)
:PREVIOUS-DATE " 2-Jul-90 20:24:02" {WMEDLEY}<sources>CMLCOMPILE.;1)
:PREVIOUS-DATE "25-Feb-2026 19:50:29" {WMEDLEY}<sources>CMLCOMPILE.;3)
(* ; "
Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS
@@ -46,8 +42,111 @@ Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
(DEFINEQ
(FAKE-COMPILE-FILE
(CL:LAMBDA (FILENAME &KEY LAP REDEFINE OUTPUT-FILE (SAVE-EXPRS T) (COMPILER-OUTPUT T) (PROCESS-ENTIRE-FILE NIL PEFP)) (* ; "Edited 29-Jun-90 19:19 by nm") (LET (COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE (NLAML NLAML) (NLAMA NLAMA) (LAMS LAMS) (LAMA LAMA) (DFNFLG NIL)) (DECLARE (CL:SPECIAL COMPILE.FILE.AFTER COMPILE.FILE.VALUE NLAML NLAMA LAMS LAMA DFNFLG)) (RESETLST (RESETSAVE NIL (LIST (QUOTE RESETUNDO)) (RESETUNDO)) (RESETSAVE COUTFILE COMPILER-OUTPUT) (RESETSAVE STRF REDEFINE) (RESETSAVE SVFLG (AND SAVE-EXPRS REDEFINE (QUOTE DEFER))) (RESETSAVE LAPFLG LAP) (LET ((*PACKAGE* *INTERLISP-PACKAGE*) (*READ-BASE* 10) (LOCALVARS SYSLOCALVARS) (SPECVARS T) STREAM LSTFIL ROOTNAME INTERLISP-FORMAT ENV FORM) (DECLARE (CL:SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ STREAM (OPENSTREAM FILENAME (QUOTE INPUT))))) (CL:MULTIPLE-VALUE-SETQ (ENV FORM) (\PARSE-FILE-HEADER STREAM (QUOTE RETURN) T)) (SETQ INTERLISP-FORMAT (AND ENV (NEQ ENV *COMMON-LISP-READ-ENVIRONMENT*))) (if (NOT PEFP) then (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT)) (if LAP then (SETQ LSTFIL COUTFILE)) (SETQ FILENAME (FULLNAME STREAM)) (RESETSAVE NIL (LIST (FUNCTION COMPILE.FILE.RESET) (SETQ OUTPUT-FILE (OPENSTREAM (OR OUTPUT-FILE (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE EXTENSION) COMPILE.EXT (QUOTE BODY) FILENAME)) (QUOTE OUTPUT) (QUOTE NEW) (QUOTE ((TYPE BINARY))))) STREAM (ROOTFILENAME FILENAME))) (if OUTPUT-FILE then (RESETSAVE LCFIL OUTPUT-FILE) (PRINT-COMPILE-HEADER (LIST STREAM) (QUOTE ("COMPILE-FILEd")) ENV)) (WITH-READER-ENVIRONMENT ENV (PROG ((DEFERRED.EXPRESSIONS NIL) (*PRINT-ARRAY* T) (*PRINT-LEVEL* NIL) (*PRINT-LENGTH* NIL) (FIRSTFORMS NIL) (AFTERS NIL) (SCRATCH.LCOM (QUOTE {CORE}SCRATCH.LCOM)) DUMMYFILE TEMPVAL) (DECLARE (CL:SPECIAL DEFERRED.EXPRESSIONS *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH* FIRSTFORMS AFTERS DEFERS)) (* ; "Edited by TT (11-June-90 : for AR#11185) all contents of file are read, and each forms are compiled.(This reading method is for supporting %"FIRST%", %"NOTFIRST%" tag.)") (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ DUMMYFILE (OPENSTREAM SCRATCH.LCOM (QUOTE BOTH) (QUOTE NEW))))) LPDUMP (if (EQUAL (CAR FORM) (QUOTE RPAQQ)) then (* ; "This is the support method of %"COMPILERVARS%" (2-July-1990 TT)") (SETQ TEMPVAL (CADDR FORM)) (if (SETQ TEMPVAL (ASSOC (QUOTE DECLARE%:) TEMPVAL)) then (if (SETQ TEMPVAL (FMEMB (QUOTE COMPILERVARS) (FMEMB (QUOTE DOEVAL@COMPILE) TEMPVAL))) then (SETQ DFNFLG T) (if (SETQ TEMPVAL (FMEMB (QUOTE ADDVARS) (SETQ TEMPVAL (CADR TEMPVAL)))) then (CL:DOLIST (ARG (CDR TEMPVAL)) (APPLY (QUOTE ADDTOVAR) ARG)))))) (COMPILE-FILE-EXPRESSION FORM DUMMYFILE NIL PROCESS-ENTIRE-FILE) (SKIPSEPRCODES STREAM) (if (EOFP STREAM) then (CLOSEF STREAM) (for FORM in FIRSTFORMS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL PROCESS-ENTIRE-FILE T)) (COPYBYTES DUMMYFILE OUTPUT-FILE 0 (GETFILEPTR DUMMYFILE)) (CLOSEF? DUMMYFILE) (DELFILE (FULLNAME DUMMYFILE)) (AND PROCESS-ENTIRE-FILE (for EXP in (REVERSE DEFERRED.EXPRESSIONS) do (APPLY* (CAR EXP) (CDR EXP) OUTPUT-FILE))) (for FORM in AFTERS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL PROCESS-ENTIRE-FILE T)) (RETURN)) (SETQ FORM (READ STREAM)) (GO LPDUMP)) (PRINT NIL OUTPUT-FILE)) (SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE)))) (* ; "Do these after UNDONLSETQ entered") (MAPC (REVERSE COMPILE.FILE.AFTER) (FUNCTION EVAL)) COMPILE.FILE.VALUE))
)
(CL:LAMBDA
(FILENAME &KEY LAP REDEFINE OUTPUT-FILE (SAVE-EXPRS T)
(COMPILER-OUTPUT T)
(PROCESS-ENTIRE-FILE NIL PEFP)) (* ; "Edited 25-Feb-2026 23:02 by rmk")
(* ; "Edited 29-Jun-90 19:19 by nm")
(LET
(COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE (NLAML NLAML)
(NLAMA NLAMA)
(LAMS LAMS)
(LAMA LAMA)
(DFNFLG NIL))
(DECLARE (CL:SPECIAL COMPILE.FILE.AFTER COMPILE.FILE.VALUE NLAML NLAMA LAMS LAMA DFNFLG))
(RESETLST
(RESETSAVE NIL (LIST 'RESETUNDO)
(RESETUNDO))
(RESETSAVE COUTFILE COMPILER-OUTPUT)
(RESETSAVE STRF REDEFINE)
(RESETSAVE SVFLG (AND SAVE-EXPRS REDEFINE 'DEFER))
(RESETSAVE LAPFLG LAP)
(LET
((*PACKAGE* *INTERLISP-PACKAGE*)
(*READ-BASE* 10)
(LOCALVARS SYSLOCALVARS)
(SPECVARS T)
STREAM LSTFIL ROOTNAME INTERLISP-FORMAT ENV FORM)
(DECLARE (CL:SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL))
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ STREAM (OPENSTREAM FILENAME 'INPUT]
(CL:MULTIPLE-VALUE-SETQ (ENV FORM)
(\PARSE-FILE-HEADER STREAM 'RETURN T))
(SETQ INTERLISP-FORMAT (AND ENV (NEQ ENV *COMMON-LISP-READ-ENVIRONMENT*)))
(if (NOT PEFP)
then (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT))
(if LAP
then (SETQ LSTFIL COUTFILE))
(SETQ FILENAME (FULLNAME STREAM))
(RESETSAVE NIL (LIST (FUNCTION COMPILE.FILE.RESET)
[SETQ OUTPUT-FILE (OPENSTREAM (OR OUTPUT-FILE (PACKFILENAME.STRING
'VERSION NIL
'EXTENSION COMPILE.EXT
'BODY FILENAME))
'OUTPUT
'NEW
`((TYPE BINARY)
(:EXTERNAL-FORMAT ,ENV]
STREAM
(ROOTFILENAME FILENAME)))
(if OUTPUT-FILE
then (RESETSAVE LCFIL OUTPUT-FILE)
(PRINT-COMPILE-HEADER (LIST STREAM)
'("COMPILE-FILEd")
ENV))
(WITH-READER-ENVIRONMENT ENV
(PROG ((DEFERRED.EXPRESSIONS NIL)
(*PRINT-ARRAY* T)
(*PRINT-LEVEL* NIL)
(*PRINT-LENGTH* NIL)
(FIRSTFORMS NIL)
(AFTERS NIL)
(SCRATCH.LCOM '{CORE}SCRATCH.LCOM)
DUMMYFILE TEMPVAL)
(DECLARE (CL:SPECIAL DEFERRED.EXPRESSIONS *PRINT-ARRAY* *PRINT-LEVEL*
*PRINT-LENGTH* FIRSTFORMS AFTERS DEFERS))
(* ; "Edited by TT (11-June-90 : for AR#11185) all contents of file are read, and each forms are compiled.(This reading method is for supporting %"FIRST%", %"NOTFIRST%" tag.)")
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ DUMMYFILE (OPENSTREAM SCRATCH.LCOM 'BOTH 'NEW
`((:EXTERNAL-FORMAT ,ENV]
LPDUMP
[if (EQUAL (CAR FORM)
'RPAQQ)
then (* ;
 "This is the support method of %"COMPILERVARS%" (2-July-1990 TT)")
(SETQ TEMPVAL (CADDR FORM))
(if (SETQ TEMPVAL (ASSOC 'DECLARE%: TEMPVAL))
then (if (SETQ TEMPVAL (FMEMB 'COMPILERVARS (FMEMB 'DOEVAL@COMPILE
TEMPVAL)))
then (SETQ DFNFLG T)
(if [SETQ TEMPVAL (FMEMB 'ADDVARS (SETQ TEMPVAL
(CADR TEMPVAL]
then (CL:DOLIST (ARG (CDR TEMPVAL))
(APPLY 'ADDTOVAR ARG))]
(COMPILE-FILE-EXPRESSION FORM DUMMYFILE NIL PROCESS-ENTIRE-FILE)
(SKIPSEPRCODES STREAM)
(if (EOFP STREAM)
then (CLOSEF STREAM)
(for FORM in FIRSTFORMS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL
PROCESS-ENTIRE-FILE T))
(COPYBYTES DUMMYFILE OUTPUT-FILE 0 (GETFILEPTR DUMMYFILE))
(CLOSEF? DUMMYFILE)
(DELFILE (FULLNAME DUMMYFILE))
(CL:WHEN PROCESS-ENTIRE-FILE
(for EXP in (REVERSE DEFERRED.EXPRESSIONS)
do (APPLY* (CAR EXP)
(CDR EXP)
OUTPUT-FILE)))
(for FORM in AFTERS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL
PROCESS-ENTIRE-FILE T))
(RETURN))
(SETQ FORM (READ STREAM))
(GO LPDUMP))
(PRINT NIL OUTPUT-FILE))
(SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE)))) (* ; "Do these after UNDONLSETQ entered")
(MAPC (REVERSE COMPILE.FILE.AFTER)
(FUNCTION EVAL))
COMPILE.FILE.VALUE)))
(INTERLISP-FORMAT-P
[LAMBDA (STREAM) (* bvm%: " 3-Aug-86 14:01")
@@ -302,14 +401,13 @@ Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1636 2253 (CL:DISASSEMBLE 1636 . 2253)) (2254 17523 (FAKE-COMPILE-FILE 2264 . 5700) (
INTERLISP-FORMAT-P 5702 . 5920) (INTERLISP-NLAMBDA-FUNCTION-P 5922 . 6156) (COMPILE-FILE-EXPRESSION
6158 . 9508) (COMPILE-FILE-WALK-FUNCTION 9510 . 9757) (ARGTYPE.STATE 9759 . 9919) (
COMPILE.CHECK.ARGTYPE 9921 . 11913) (COMPILE.FILE.DEFINEQ 11915 . 12408) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 12410 . 13004) (COMPILE-FILE-EX/IMPORT 13006 . 13334) (
COMPILE.FILE.APPLY 13336 . 13596) (COMPILE.FILE.RESET 13598 . 14459) (COMPILE-IN-CORE 14461 . 17521))
(17524 19253 (COMPILE-FILE-SCAN-FIRST 17534 . 19251)) (19796 21163 (COMPILE-FILE-DECLARE%: 19796 .
21163)) (21164 22228 (NEWDEFC 21174 . 22226)))))
(FILEMAP (NIL (1569 2186 (CL:DISASSEMBLE 1569 . 2186)) (2187 20243 (FAKE-COMPILE-FILE 2197 . 8420) (
INTERLISP-FORMAT-P 8422 . 8640) (INTERLISP-NLAMBDA-FUNCTION-P 8642 . 8876) (COMPILE-FILE-EXPRESSION
8878 . 12228) (COMPILE-FILE-WALK-FUNCTION 12230 . 12477) (ARGTYPE.STATE 12479 . 12639) (
COMPILE.CHECK.ARGTYPE 12641 . 14633) (COMPILE.FILE.DEFINEQ 14635 . 15128) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 15130 . 15724) (COMPILE-FILE-EX/IMPORT 15726 . 16054) (
COMPILE.FILE.APPLY 16056 . 16316) (COMPILE.FILE.RESET 16318 . 17179) (COMPILE-IN-CORE 17181 . 20241))
(20244 21973 (COMPILE-FILE-SCAN-FIRST 20254 . 21971)) (22516 23883 (COMPILE-FILE-DECLARE%: 22516 .
23883)) (23884 24948 (NEWDEFC 23894 . 24946)))))
STOP

BIN
sources/CMLCOMPILE.DFASL Normal file

Binary file not shown.

BIN
sources/CMLREAD.DFASL Normal file

Binary file not shown.

Binary file not shown.

View File

@@ -1,20 +1,19 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "COMPILER" (USE "LISP" "XCL")))
(IL:FILECREATED "19-Sep-2020 22:02:59" 
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10| 78326
(DEFINE-FILE-INFO :PACKAGE (DEFPACKAGE "COMPILER" (:USE "LISP" "XCL")) :READTABLE "XCL" :BASE 10)
IL:|changes| IL:|to:| (IL:FUNCTIONS START-COMPILATION)
(IL:FILECREATED "25-Feb-2026 23:03:55" IL:|{WMEDLEY}<sources>XCLC-TOP-LEVEL.;2| 78162
IL:|previous| IL:|date:| "19-Sep-2020 21:33:34"
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
:EDIT-BY IL:|rmk|
:CHANGES-TO (IL:FUNCTIONS COMPILE-FILE)
:PREVIOUS-DATE "19-Sep-2020 22:02:59" IL:|{WMEDLEY}<sources>XCLC-TOP-LEVEL.;1|)
; Copyright (c) 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2020 by Venue & Xerox Corporation. All rights reserved.
(IL:PRETTYCOMPRINT IL:XCLC-TOP-LEVELCOMS)
(IL:RPAQQ IL:XCLC-TOP-LEVELCOMS
(
(IL:* IL:|;;| "Top-level entry points ")
(IL:* IL:|;;| "Top-level entry points ")
(IL:STRUCTURES COMPILER-CONTEXT)
(IL:VARIABLES *COMPILE-FILE-CONTEXT* *COMPILE-SCAN-CONTEXT* *COMPILE-DEFINER-CONTEXT*)
@@ -33,18 +32,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(IL:COMS (IL:STRUCTURES ASSEMBLER-ERROR)
(IL:FUNCTIONS ASSEMBLER-ERROR))
(IL:* IL:|;;| "Reading the #, macro")
(IL:* IL:|;;| "Reading the #, macro")
(IL:VARIABLES *COMPILER-IS-READING*)
(IL:STRUCTURES EVAL-WHEN-LOAD)
(IL:* IL:|;;| "Support for Block Compilation")
(IL:* IL:|;;| "Support for Block Compilation")
(IL:VARIABLES *BLOCK-HASH-TABLE* *BLOCKS* *CURRENT-BLOCK*)
(IL:STRUCTURES BLOCK-DECL)
(IL:FUNCTIONS SET-UP-BLOCK-DECLS)
(IL:* IL:|;;| "Processing of top-level forms in a file")
(IL:* IL:|;;| "Processing of top-level forms in a file")
(IL:VARIABLES PASS)
(IL:FUNCTIONS CONSTANT-EXPRESSION-P)
@@ -60,14 +59,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
COMPILE-FILE-PROCESS-FUNCTION)
(IL:FUNCTIONS CRACK-DEFMACRO ESTABLISH-MACRO-IN-COMPILER)
(IL:* IL:|;;| "Support for :Process-Entire-File")
(IL:* IL:|;;| "Support for :Process-Entire-File")
(IL:VARIABLES *DEFERRED-FORMS* *MAKING-SECOND-PASS* *PREPROCESSING-PHASE*)
(IL:FUNCTIONS COMPILE-SCAN-DECLARE\: COMPILE-SCAN-DEFINE-FILE-INFO COMPILE-SCAN-MACROLET
COMPILE-SCAN-DEFINER COMPILE-SCAN-LOOSE-FORM COMPILE-SCAN-OUTSTANDING-LOOSE-FORMS)
(IL:FUNCTIONS MERGE-FIRST-FORMS)
(IL:* IL:|;;| "for compiling definers")
(IL:* IL:|;;| "for compiling definers")
(IL:VARIABLES *LAP-FLG* *AUTOMATIC-SPECIAL-DECLARATIONS*)
(IL:FUNCTIONS COMPILE COMPILE-DEFINER)
@@ -75,11 +74,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(IL:FUNCTIONS COMPILE-DEFINER-DEFINER COMPILE-DEFINER-NAMED-PROGN
COMPILE-DEFINER-PROCESS-FUNCTION COMPILE-DEFINER-OUTSTANDING-LOOSE-FORMS)
(IL:* IL:|;;| "Arrange for correct compiler to be used.")
(IL:* IL:|;;| "Arrange for correct compiler to be used.")
(IL:PROP IL:FILETYPE IL:XCLC-TOP-LEVEL)
(IL:* IL:|;;| "Arrange for the correct makefile environment")
(IL:* IL:|;;| "Arrange for the correct makefile environment")
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:XCLC-TOP-LEVEL)))
@@ -89,9 +88,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(DEFSTRUCT (COMPILER-CONTEXT (:FAST-ACCESSORS T)
(:CONC-NAME NIL)
(:COPIER NIL)
(:PREDICATE NIL))
(:CONC-NAME NIL)
(:COPIER NIL)
(:PREDICATE NIL))
SETF-SYMBOL-FUNCTION-FN
DEFINEQ-FN
DEFCONSTANT-FN
@@ -185,51 +184,50 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(DEFVAR *LOOSE-NAME* NIL)
(DEFUN COMPILE-FILE (INPUT-FILE &KEY (OUTPUT-FILE NIL)
(LAP-FILE NIL)
(ERROR-FILE NIL)
(ERRORS-TO-TERMINAL T)
(FILE-MANAGER-FORMAT NIL F-M-F-GIVEN)
(PROCESS-ENTIRE-FILE NIL P-E-F-GIVEN)
(LOAD NIL))
(LAP-FILE NIL)
(ERROR-FILE NIL)
(ERRORS-TO-TERMINAL T)
(FILE-MANAGER-FORMAT NIL F-M-F-GIVEN)
(PROCESS-ENTIRE-FILE NIL P-E-F-GIVEN)
(LOAD NIL)) (IL:* IL:\; "Edited 25-Feb-2026 21:33 by rmk")
(IL:* IL:|;;;| "Compiles the forms on Input-File, producing a FASL file.")
(IL:* IL:|;;;| "Compiles the forms on Input-File, producing a FASL file.")
(IL:* IL:|;;;| " :Output-File")
(IL:* IL:|;;;| " :Output-File")
(IL:* IL:|;;| "The name of a file to which binary code should be written.")
(IL:* IL:|;;| "The name of a file to which binary code should be written.")
(IL:* IL:|;;| " Defaults to Input-File with the extension '.dfasl'")
(IL:* IL:|;;| " Defaults to Input-File with the extension '.dfasl'")
(IL:* IL:|;;;| ":Lap-File")
(IL:* IL:|;;;| ":Lap-File")
(IL:* IL:|;;| "The name of a file to which LAP assemble code should be written.")
(IL:* IL:|;;| "The name of a file to which LAP assemble code should be written.")
(IL:* IL:|;;|
 " If T, defulats to Input-File with the extension '.dlap', if NIL, no LAP file is produced.")
(IL:* IL:|;;|
 " If T, defulats to Input-File with the extension '.dlap', if NIL, no LAP file is produced.")
(IL:* IL:|;;;| ":Error-FIle")
(IL:* IL:|;;;| ":Error-FIle")
(IL:* IL:|;;| "The name of a file to which compiler error messages should be written. Defaults like :Lap-File, but with the extension '.log'")
(IL:* IL:|;;| "The name of a file to which compiler error messages should be written. Defaults like :Lap-File, but with the extension '.log'")
(IL:* IL:|;;;| ":Errors-To-Terminal")
(IL:* IL:|;;;| ":Errors-To-Terminal")
(IL:* IL:|;;|
 "True if error messages should be sent to *ERROR-OUTPUT* as well as any :Error-File.")
(IL:* IL:|;;|
 "True if error messages should be sent to *ERROR-OUTPUT* as well as any :Error-File.")
(IL:* IL:|;;;| ":File-Manager-Format")
(IL:* IL:|;;;| ":File-Manager-Format")
(IL:* IL:|;;|
 "True if the file should be assumed to have been produced by the MAKEFILE function.")
(IL:* IL:|;;| "True if the file should be assumed to have been produced by the MAKEFILE function.")
(IL:* IL:|;;| "If not specified, we check the first non-blank character in the file. If that character is a left-paren, we assume that MAKEFILE made the file.")
(IL:* IL:|;;| "If not specified, we check the first non-blank character in the file. If that character is a left-paren, we assume that MAKEFILE made the file.")
(IL:* IL:|;;;| ":Process-Entire-File")
(IL:* IL:|;;;| ":Process-Entire-File")
(IL:* IL:|;;| "If true, the whole file is read in, evaluating those forms which are explicitly or implicitly EVAL-WHEN (OMPILE), before any code is generated. This allows macros to be defined after use, for example. This defaults to T if the file is declared or discovered to be in Interlisp format.")
(IL:* IL:|;;| "If true, the whole file is read in, evaluating those forms which are explicitly or implicitly EVAL-WHEN (OMPILE), before any code is generated. This allows macros to be defined after use, for example. This defaults to T if the file is declared or discovered to be in Interlisp format.")
(IL:* IL:|;;;| ":Load")
(IL:* IL:|;;;| ":Load")
(IL:* IL:|;;| "If true, definitions will be installed in the environment after they are compiled. If this is :SAVE, the any previous definitions are saved on the property list before the new ones are installed.")
(IL:* IL:|;;| "If true, definitions will be installed in the environment after they are compiled. If this is :SAVE, the any previous definitions are saved on the property list before the new ones are installed.")
(LET ((*ERROR-OUTPUT* *ERROR-OUTPUT*)
(*INPUT-STREAM* NIL)
@@ -246,10 +244,10 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(*OUTSTANDING-LOOSE-FORMS* NIL)
(*PROCESSED-FUNCTIONS* NIL)
(*UNKNOWN-FUNCTIONS* NIL)
(*INPUT-FILECOMS-VARIABLE* NIL) (IL:* IL:\;
 "Bound for the convenience of the optimizers on RPAQQ and PRETTYCOMPRINT.")
(*INPUT-FILECOMS-VARIABLE* NIL) (IL:* IL:\;
 "Bound for the convenience of the optimizers on RPAQQ and PRETTYCOMPRINT.")
(IL:* IL:|;;| "Rebind all of these both to set up a canonical environment inside the compiler and to protect the outside environment from anything that might happen during this file.")
(IL:* IL:|;;| "Rebind all of these both to set up a canonical environment inside the compiler and to protect the outside environment from anything that might happen during this file.")
(IL:SPECVARS T)
(IL:LOCALVARS IL:SYSLOCALVARS)
@@ -259,11 +257,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(IL:NLAML IL:NLAML)
(IL:LAMA IL:LAMA)
(IL:DONTCOMPILEFNS IL:DONTCOMPILEFNS))
(DECLARE (SPECIAL IL:SPECVARS IL:LOCALVARS IL:LOCALFREEVARS IL:GLOBALVARS IL:NLAMA
IL:NLAML IL:LAMA IL:DONTCOMPILEFNS))
(DECLARE (SPECIAL IL:SPECVARS IL:LOCALVARS IL:LOCALFREEVARS IL:GLOBALVARS IL:NLAMA IL:NLAML
IL:LAMA IL:DONTCOMPILEFNS))
(UNWIND-PROTECT
(PROGN
(IL:* IL:|;;| "Set up the input stream.")
(IL:* IL:|;;| "Set up the input stream.")
(LET ((PATH (OR (PROBE-FILE INPUT-FILE)
(PROBE-FILE (MERGE-PATHNAMES INPUT-FILE ".lisp")))))
@@ -281,19 +279,17 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(T (ERROR "The file \"~A\" is nonexistent or cannot be read.~%" INPUT-FILE
))))
(IL:* IL:|;;| "Set up the FASL output stream.")
(IL:* IL:|;;| "Set up the FASL output stream.")
(SETQ FASL-PATHNAME (COND
(OUTPUT-FILE (PATHNAME OUTPUT-FILE))
(T (MAKE-PATHNAME :TYPE
(STRING (LOCALLY (DECLARE (SPECIAL
IL:FASL.EXT)
)
(STRING (LOCALLY (DECLARE (SPECIAL IL:FASL.EXT))
IL:FASL.EXT))
:VERSION :NEWEST :DEFAULTS *INPUT-FILENAME*))))
(SETQ *FASL-HANDLE* (FASL:OPEN-FASL-HANDLE FASL-PATHNAME))
(IL:* IL:|;;| "Set up the LAP stream.")
(IL:* IL:|;;| "Set up the LAP stream.")
(WHEN LAP-FILE
(SETQ *LAP-STREAM* (OPEN (IF (EQ LAP-FILE T)
@@ -302,7 +298,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
LAP-FILE)
:DIRECTION :OUTPUT)))
(IL:* IL:|;;| "Set up the error output stream.")
(IL:* IL:|;;| "Set up the error output stream.")
(WHEN ERROR-FILE
(SETQ ERROR-FILE-STREAM (OPEN (IF (EQ ERROR-FILE T)
@@ -317,8 +313,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
*ERROR-OUTPUT*)
ERROR-FILE-STREAM))
(IL:* IL:|;;|
 "Fix up the default values of FILE-MANAGER-FORMAT and PROCESS-ENTIRE-FILE.")
(IL:* IL:|;;|
 "Fix up the default values of FILE-MANAGER-FORMAT and PROCESS-ENTIRE-FILE.")
(IF (NOT F-M-F-GIVEN)
(SETQ FILE-MANAGER-FORMAT (EQ (IL:SKIPSEPRCODES *INPUT-STREAM* IL:FILERDTBL)
@@ -326,22 +322,22 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(IF (NOT P-E-F-GIVEN)
(SETQ PROCESS-ENTIRE-FILE FILE-MANAGER-FORMAT))
(IL:* IL:|;;| "Pick the right readtable and do the compilation.")
(IL:* IL:|;;| "Pick the right readtable and do the compilation.")
(IL:WITH-READER-ENVIRONMENT (IF FILE-MANAGER-FORMAT
IL:*OLD-INTERLISP-READ-ENVIRONMENT*
IL:*DEFINE-FILE-INFO-ENV*
IL:*COMMON-LISP-READ-ENVIRONMENT*)
(START-COMPILATION)
(PROCESS-FORMS PROCESS-ENTIRE-FILE)
(FINISH-COMPILATION)
(SETQ COMPILATION-SUCCEEDED T)
(IL:* IL:|;;|
 "Return the DFASL pathname so that people can say, for example, (LOAD (COMPILE-FILE ...))")
(IL:* IL:|;;|
 "Return the DFASL pathname so that people can say, for example, (LOAD (COMPILE-FILE ...))")
FASL-PATHNAME))
(IL:* IL:|;;| "The compilation is over. Close all of the streams. If the compilations did not succeed (that is, we have aborted it), then delete the FASL file as well rather than leave garbage around.")
(IL:* IL:|;;| "The compilation is over. Close all of the streams. If the compilations did not succeed (that is, we have aborted it), then delete the FASL file as well rather than leave garbage around.")
(IF (STREAMP *INPUT-STREAM*)
(CLOSE *INPUT-STREAM*))
@@ -352,9 +348,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(IF (STREAMP *LAP-STREAM*)
(CLOSE *LAP-STREAM*)))))
(DEFUN START-COMPILATION () (IL:* IL:\; "Edited 19-Sep-2020 22:02 by rmk:")
(DEFUN START-COMPILATION () (IL:* IL:\; "Edited 19-Sep-2020 22:02 by rmk:")
(IL:* IL:|;;;| "Write out banners on the various output files.")
(IL:* IL:|;;;| "Write out banners on the various output files.")
(FLET ((DATE-STRING (UNIV-TIME)
(MULTIPLE-VALUE-BIND (SECONDS MINUTES HOUR DATE MONTH YEAR DAY-OF-WEEK)
@@ -370,7 +366,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;9|)
(LET ((FASL-STREAM (FASL:BEGIN-TEXT *FASL-HANDLE*))
(FILECREATED (IL:READ-FILECREATED *INPUT-STREAM*)))
(IL:* IL:|;;| "RMK: This had a complicated format, didn't work, so I reverted to printout. PRIN3 to stop wrap around")
(IL:* IL:|;;| "RMK: This had a complicated format, didn't work, so I reverted to printout. PRIN3 to stop wrap around")
(IL:PRINTOUT FASL-STREAM "XCL Compiler output for source file " IL:\#
(IL:PRIN3 (OR (CADDR FILECREATED)
@@ -395,9 +391,9 @@ LAP file created ~A.~%~%"
(DEFUN FINISH-COMPILATION ()
(IL:* IL:|;;;| "Clean up after the compilation.")
(IL:* IL:|;;;| "Clean up after the compilation.")
(IL:* IL:|;;| "Remove this file from IL:NOTCOMPILEDFILES for CLEANUP.")
(IL:* IL:|;;| "Remove this file from IL:NOTCOMPILEDFILES for CLEANUP.")
(LOCALLY (DECLARE (IL:GLOBALVARS IL:NOTCOMPILEDFILES))
(SETQ IL:NOTCOMPILEDFILES (REMOVE (INTERN (LET ((TYPE (PATHNAME-TYPE *INPUT-FILENAME*)))
@@ -411,13 +407,13 @@ LAP file created ~A.~%~%"
"INTERLISP")
IL:NOTCOMPILEDFILES)))
(IL:* IL:|;;| "Possibly warn about unknown functions encountered during compilation.")
(IL:* IL:|;;| "Possibly warn about unknown functions encountered during compilation.")
(WARN-ABOUT-UNKNOWN-FUNCTIONS))
(DEFUN SCAN-ONE-FORM (FORM COMPILER-CONTEXT)
(IL:* IL:|;;| "Assumes sedit like comments have already been stripped ")
(IL:* IL:|;;| "Assumes sedit like comments have already been stripped ")
(IF (ATOM FORM)
FORM
@@ -433,8 +429,7 @@ LAP file created ~A.~%~%"
(CERROR "Ignore this DEFMACRO." "~S is not a legal macro name." NAME)
)
(T (UNLESS *MAKING-SECOND-PASS*
(ESTABLISH-MACRO-IN-COMPILER NAME (CRACK-DEFMACRO
FORM)))
(ESTABLISH-MACRO-IN-COMPILER NAME (CRACK-DEFMACRO FORM)))
(SCAN-ONE-FORM (OPTIMIZE-AND-MACROEXPAND-1 FORM)
COMPILER-CONTEXT)))))
((EVAL-WHEN) (IF (NOT (AND (LISTP (SECOND FORM))
@@ -476,12 +471,11 @@ LAP file created ~A.~%~%"
VALUE)))))))
((DEFCONSTANT) (COMPILER-APPLY DEFCONSTANT COMPILER-CONTEXT FORM))
((IL:DECLARE\:) (COMPILER-APPLY IL:DECLARE\: COMPILER-CONTEXT FORM))
((IL:SETF-SYMBOL-FUNCTION) (COMPILER-APPLY IL:SETF-SYMBOL-FUNCTION COMPILER-CONTEXT
FORM))
((IL:SETF-SYMBOL-FUNCTION) (COMPILER-APPLY IL:SETF-SYMBOL-FUNCTION COMPILER-CONTEXT FORM))
((IL:DEFINEQ) (COMPILER-APPLY IL:DEFINEQ COMPILER-CONTEXT FORM))
((IL:DEFINE-FILE-INFO) (COMPILER-APPLY IL:DEFINE-FILE-INFO COMPILER-CONTEXT FORM))
((MAKE-PACKAGE IN-PACKAGE SHADOW SHADOWING-IMPORT EXPORT UNEXPORT USE-PACKAGE
UNUSE-PACKAGE IMPORT DEFPACKAGE) (COMPILER-APPLY PACKAGE-FORM COMPILER-CONTEXT
UNUSE-PACKAGE IMPORT DEFPACKAGE) (COMPILER-APPLY PACKAGE-FORM COMPILER-CONTEXT
FORM))
((PROCLAIM) (COMPILER-APPLY PROCLAIM COMPILER-CONTEXT FORM))
((COMPILER-LET) (COMPILER-APPLY COMPILER-LET COMPILER-CONTEXT FORM))
@@ -522,11 +516,11 @@ LAP file created ~A.~%~%"
(DOLIST (PAIR (UNKNOWN-FUNCTION-WARNING-CALL-LIST CONDITION))
(FORMAT T " ~S -- called from " (CAR PAIR))
(IL:* IL:|;;|
 "I almost used this hairy thing, but FORMAT is too slow... Aren't you glad?")
(IL:* IL:|;;|
 "I almost used this hairy thing, but FORMAT is too slow... Aren't you glad?")
(IL:* IL:|;;|
 "\"~:[nowhere?!~;~:*~{~#[~;~S~;~S and ~S~:;~@{~#[~;and ~]~S~^, ~}~]~}.~]~%\"")
(IL:* IL:|;;|
 "\"~:[nowhere?!~;~:*~{~#[~;~S~;~S and ~S~:;~@{~#[~;and ~]~S~^, ~}~]~}.~]~%\"")
(COND
((NULL (CDR PAIR))
@@ -563,32 +557,32 @@ LAP file created ~A.~%~%"
(DEFUN WARN-ABOUT-UNKNOWN-FUNCTIONS ()
(IL:* IL:|;;;| "If there's anything on *UNKNOWN-FUNCTIONS*, issue a summary and warning.")
(IL:* IL:|;;;| "If there's anything on *UNKNOWN-FUNCTIONS*, issue a summary and warning.")
(WHEN (NOT (NULL *UNKNOWN-FUNCTIONS*))
(WARN 'UNKNOWN-FUNCTION-WARNING :CALL-LIST *UNKNOWN-FUNCTIONS*)))
(DEFVAR *PROCESSED-FUNCTIONS*
(IL:* IL:|;;;| "A list of the names of the global functions processed during this compilation. Used in conjunction with *UNKNOWN-FUNCTIONS* to produce a warning at the end of compilation if there are any functions called but not defined.")
(IL:* IL:|;;;| "A list of the names of the global functions processed during this compilation. Used in conjunction with *UNKNOWN-FUNCTIONS* to produce a warning at the end of compilation if there are any functions called but not defined.")
)
(DEFVAR *UNKNOWN-FUNCTIONS*
(IL:* IL:|;;;| "A list containing the names of undefined global functions called from code in the current compilation. Actually, it's an AList mapping the unknown function to the list of functions in which it is called. Used in conjunction with *PROCESSED-FUNCTIONS* to produce a warning at the end of compilation if there are any functions called but not defined.")
(IL:* IL:|;;;| "A list containing the names of undefined global functions called from code in the current compilation. Actually, it's an AList mapping the unknown function to the list of functions in which it is called. Used in conjunction with *PROCESSED-FUNCTIONS* to produce a warning at the end of compilation if there are any functions called but not defined.")
)
(DEFVAR *CURRENT-FUNCTION*
(IL:* IL:|;;;| "The name of the unit currently being compiled.")
(IL:* IL:|;;;| "The name of the unit currently being compiled.")
)
(DEFINE-CONDITION ASSEMBLER-ERROR
(IL:* IL:|;;;| "Signalled by an assembler when it encounters an unrecoverable error. The compiler catches such, prints an error message, and continues with the next form on the file.")
(IL:* IL:|;;;| "Signalled by an assembler when it encounters an unrecoverable error. The compiler catches such, prints an error message, and continues with the next form on the file.")
(ERROR)
(FORMAT-STRING FORMAT-ARGUMENTS)
@@ -620,33 +614,33 @@ LAP file created ~A.~%~%"
(DEFVAR *BLOCK-HASH-TABLE* NIL
(IL:* IL:|;;;| "A mapping from function names to lists of BLOCK-DECL structures describing blocks that include that function. Initialized from the list of BLOCK: declarations gathered into *BLOCKS* (q.v.) during the preprocessing scan.")
(IL:* IL:|;;;| "A mapping from function names to lists of BLOCK-DECL structures describing blocks that include that function. Initialized from the list of BLOCK: declarations gathered into *BLOCKS* (q.v.) during the preprocessing scan.")
)
(DEFVAR *BLOCKS* NIL
(IL:* IL:|;;;| "A list of the Interlisp block descriptions found on the file. This list is added to during the preprocessing scan of the file and then used for initialising *BLOCK-HASH-TABLE* (q.v.)")
(IL:* IL:|;;;| "A list of the Interlisp block descriptions found on the file. This list is added to during the preprocessing scan of the file and then used for initialising *BLOCK-HASH-TABLE* (q.v.)")
)
(DEFVAR *CURRENT-BLOCK* NIL
(IL:* IL:|;;;| "Bound during compilation of a LAMBDA to the BLOCK-DECL structure describing the block containing the current function. This is NIL if the function is not a part of any block.")
(IL:* IL:|;;;| "Bound during compilation of a LAMBDA to the BLOCK-DECL structure describing the block containing the current function. This is NIL if the function is not a part of any block.")
)
(DEFSTRUCT (BLOCK-DECL (:INLINE NIL))
(IL:* IL:|;;;|
"A BLOCK-DECL holds the information describing a particular Interlisp BLOCK: declaration.")
(IL:* IL:|;;;|
"A BLOCK-DECL holds the information describing a particular Interlisp BLOCK: declaration.")
(IL:* IL:|;;;| "NAME is the symbol naming the block or NIL if this is only a pseudo-block.")
(IL:* IL:|;;;| "NAME is the symbol naming the block or NIL if this is only a pseudo-block.")
(IL:* IL:|;;;|
"FN-NAME-MAP is an AList mapping internal function names to their new \\BLOCK/FN style name.")
(IL:* IL:|;;;|
"FN-NAME-MAP is an AList mapping internal function names to their new \\BLOCK/FN style name.")
(IL:* IL:|;;;| "SPECVARS, LOCALVARS, LOCALFREEVARS and GLOBALVARS contain the values those variables should have during the compilation of functions in this block.")
(IL:* IL:|;;;| "SPECVARS, LOCALVARS, LOCALFREEVARS and GLOBALVARS contain the values those variables should have during the compilation of functions in this block.")
NAME
FN-NAME-MAP
@@ -657,7 +651,7 @@ LAP file created ~A.~%~%"
(DEFUN SET-UP-BLOCK-DECLS (DECLS)
(IL:* IL:|;;;| "Parse the given list of Interlisp BLOCK: declarations and return a hash-table mapping functions named therein to a list of the BLOCK-DECLs representing decls mentioning that function.")
(IL:* IL:|;;;| "Parse the given list of Interlisp BLOCK: declarations and return a hash-table mapping functions named therein to a list of the BLOCK-DECLs representing decls mentioning that function.")
(LET ((HASH-TABLE (MAKE-HASH-TABLE)))
(DOLIST (DECL DECLS)
@@ -670,9 +664,9 @@ LAP file created ~A.~%~%"
(NOT-RENAMED-FNS (CONS BLOCK-NAME (UNION IL:RETFNS IL:NOLINKFNS)))
(FNS NIL))
(DECLARE (SPECIAL IL:SPECVARS IL:LOCALVARS IL:LOCALFREEVARS IL:GLOBALVARS
IL:NOLINKFNS))
IL:NOLINKFNS))
(IL:* IL:|;;| "We do this next bit because BCOMPL2 does it.")
(IL:* IL:|;;| "We do this next bit because BCOMPL2 does it.")
(COND
((NULL BLOCK-NAME)
@@ -681,7 +675,7 @@ LAP file created ~A.~%~%"
(T (SETQ IL:LOCALVARS T)
(SETQ IL:SPECVARS IL:SYSSPECVARS)))
(IL:* IL:|;;| "For each item in the declaration, either add it to the list of functions or make the appropriate modifications to the named variable.")
(IL:* IL:|;;| "For each item in the declaration, either add it to the list of functions or make the appropriate modifications to the named variable.")
(DOLIST (ITEM (CDR DECL))
(COND
@@ -709,8 +703,8 @@ LAP file created ~A.~%~%"
"DONTCOMPILEFNS is not supported in BLOCK: declarations."
))
((IL:BLKAPPLYFNS IL:NOLINKFNS IL:RETFNS IL:ENTRIES)
(IL:* IL:\;
 "These functions should not be renamed, according to BYTEBLOCKCOMPILE2.")
(IL:* IL:\;
 "These functions should not be renamed, according to BYTEBLOCKCOMPILE2.")
(WHEN (CONSP (CDR ITEM))
(SETQ NOT-RENAMED-FNS (APPEND (CDR ITEM)
NOT-RENAMED-FNS))))
@@ -729,14 +723,14 @@ LAP file created ~A.~%~%"
IL:GLOBALVARS)
(LET* ((BLOCK-NAME-STRING (STRING BLOCK-NAME))
(BLOCK-PACKAGE (SYMBOL-PACKAGE BLOCK-NAME)))
(UNLESS (NULL BLOCK-NAME) (IL:* IL:\;
 "NIL blocks don't do renaming.")
(UNLESS (NULL BLOCK-NAME) (IL:* IL:\;
 "NIL blocks don't do renaming.")
(SETF (BLOCK-DECL-FN-NAME-MAP BD)
(IL:|for| FN IL:|in| (NSET-DIFFERENCE FNS NOT-RENAMED-FNS)
IL:|collect| (CONS FN (INTERN (CONCATENATE 'STRING "\\"
BLOCK-NAME-STRING "/"
(STRING FN))
BLOCK-PACKAGE))))))))
BLOCK-NAME-STRING "/"
(STRING FN))
BLOCK-PACKAGE))))))))
HASH-TABLE))
@@ -761,8 +755,8 @@ LAP file created ~A.~%~%"
(RETURN NIL))))))))
(DEFUN COMPILE-AND-DUMP (NAME DEFN KIND)
(LET ((*CURRENT-BLOCK* NIL) (IL:* IL:\;
 "So that we aren't dependent upon the top-level binding.")
(LET ((*CURRENT-BLOCK* NIL) (IL:* IL:\;
 "So that we aren't dependent upon the top-level binding.")
)
(COND
((AND (SYMBOLP NAME)
@@ -783,7 +777,7 @@ LAP file created ~A.~%~%"
(IL:LOCALFREEVARS (BLOCK-DECL-LOCALFREEVARS *CURRENT-BLOCK*))
(IL:GLOBALVARS (BLOCK-DECL-GLOBALVARS *CURRENT-BLOCK*)))
(DECLARE (SPECIAL IL:SPECVARS IL:LOCALVARS IL:LOCALFREEVARS
IL:GLOBALVARS))
IL:GLOBALVARS))
(COMPILE-AND-DUMP-1 NEW-NAME DEFN KIND)))))))
(T (COMPILE-AND-DUMP-1 NAME DEFN KIND)))))
@@ -824,14 +818,14 @@ LAP file created ~A.~%~%"
(SYMBOL-FUNCTION NAME)))
(SETF (SYMBOL-FUNCTION NAME)
(D-ASSEM:INTERN-DCODE DCODE)))
(:ONE-SHOT (LET ((IL:FILEPKGFLG NIL)) (IL:* IL:\;
 "so that things don't get marked as changed when you execute the one-shot.")
(:ONE-SHOT (LET ((IL:FILEPKGFLG NIL)) (IL:* IL:\;
 "so that things don't get marked as changed when you execute the one-shot.")
(DECLARE (SPECIAL IL:FILEPKGFLG))
(FUNCALL (D-ASSEM:INTERN-DCODE DCODE))))))))
(DEFUN COMPILE-ONE-LAMBDA (NAME DEFN)
(IL:* IL:|;;;| "Return a LAP function for the given function definition. NAME is the symbol with which the definition will be associated at load time and DEFN is the LAMBDA-expression to be compiled.")
(IL:* IL:|;;;| "Return a LAP function for the given function definition. NAME is the symbol with which the definition will be associated at load time and DEFN is the LAMBDA-expression to be compiled.")
(LET ((*CONTEXT* *NULL-CONTEXT*)
(*AUTOMATIC-SPECIAL-DECLARATIONS* NIL))
@@ -844,9 +838,9 @@ LAP file created ~A.~%~%"
LAP-CODE)))
(DEFUN OPTIMIZE-AND-MACROEXPAND (FORM &OPTIONAL (ENVIRONMENT *ENVIRONMENT*)
(CONTEXT *CONTEXT*))
(CONTEXT *CONTEXT*))
(IL:* IL:|;;;| "Analagous to MACROEXPAND: keep trying OPTIMIZE-AND-MACROEXPAND-1 until it fails to change the form.")
(IL:* IL:|;;;| "Analagous to MACROEXPAND: keep trying OPTIMIZE-AND-MACROEXPAND-1 until it fails to change the form.")
(PROG (NEW-FORM CHANGED-P)
(MULTIPLE-VALUE-SETQ (NEW-FORM CHANGED-P)
@@ -861,9 +855,9 @@ LAP file created ~A.~%~%"
(RETURN (VALUES NEW-FORM T)))))
(DEFUN OPTIMIZE-AND-MACROEXPAND-1 (FORM &OPTIONAL (ENVIRONMENT *ENVIRONMENT*)
(CONTEXT *CONTEXT*))
(CONTEXT *CONTEXT*))
(IL:* IL:|;;;| "If the given form is a list, then look for macros and optimizers defined for its CAR. Return two values like MACROEXPAND-1.")
(IL:* IL:|;;;| "If the given form is a list, then look for macros and optimizers defined for its CAR. Return two values like MACROEXPAND-1.")
(LET ((*NEW-COMPILER-IS-EXPANDING* T))
(COND
@@ -871,23 +865,23 @@ LAP file created ~A.~%~%"
(NOT (SYMBOLP (CAR FORM))))
(VALUES FORM NIL))
(T
(IL:* IL:|;;| "Check for compiler optimizers.")
(IL:* IL:|;;| "Check for compiler optimizers.")
(LET ((OPTIMIZERS (OPTIMIZER-LIST (CAR FORM))))
(WHEN (AND (NOT (NULL OPTIMIZERS))
(NOT (ENV-FBOUNDP ENVIRONMENT (CAR FORM)
:LEXICAL-ONLY T))
(NOT (ENV-INLINE-DISALLOWED ENVIRONMENT (CAR FORM))))
(IL:* IL:\;
 "Optimizers cannot apply to lexical functions or macros or to functions declared NOTINLINE.")
(IL:* IL:\;
 "Optimizers cannot apply to lexical functions or macros or to functions declared NOTINLINE.")
(DOLIST (OPT-FN OPTIMIZERS)
(LET ((RESULT (FUNCALL OPT-FN FORM ENVIRONMENT CONTEXT)))
(UNLESS (OR (EQ RESULT 'PASS)
(EQ RESULT 'IL:IGNOREMACRO)
(EQ RESULT FORM))(IL:* IL:\; "This optimizer fired.")
(EQ RESULT FORM))(IL:* IL:\; "This optimizer fired.")
(RETURN-FROM OPTIMIZE-AND-MACROEXPAND-1 (VALUES RESULT T)))))))
(IL:* IL:|;;| "Check for a macro expansion function.")
(IL:* IL:|;;| "Check for a macro expansion function.")
(MACROEXPAND-1 FORM ENVIRONMENT)))))
@@ -919,47 +913,45 @@ LAP file created ~A.~%~%"
(IL:RPAQQ (IF (EQ (SECOND FORM)
*INPUT-FILECOMS-VARIABLE*)
(IL:* IL:|;;|
 "Don't remove comments from file coms")
(IL:* IL:|;;| "Don't remove comments from file coms")
FORM
(REMOVE-COMMENTS FORM)))
(IL:DEFCLASS
(IL:* IL:|;;|
 "Don't remove comments from LOOPS DEFCLASS forms")
(IL:* IL:|;;| "Don't remove comments from LOOPS DEFCLASS forms")
FORM)
(IL:DATATYPE
(IL:* IL:|;;| "Don't remove comments from record declarations")
(IL:* IL:|;;| "Don't remove comments from record declarations")
FORM)
(IL:RECORD
(IL:* IL:|;;| "Don't remove comments from record declarations")
(IL:* IL:|;;| "Don't remove comments from record declarations")
FORM)
(IL:BLOCKRECORD
(IL:* IL:|;;| "Don't remove comments from record declarations")
(IL:* IL:|;;| "Don't remove comments from record declarations")
FORM)
(IL:DECLARE\:
(IL:* IL:|;;|
 "Process each form inside this as though it were at top-level")
(IL:* IL:|;;|
 "Process each form inside this as though it were at top-level")
(IL:FOR X IL:IN FORM
IL:COLLECT (COND
((NOT (CONSP X))
X)
(T (CASE (CAR X)
(IL:DEFCLASS X)
(IL:DATATYPE X)
(IL:RECORD X)
(IL:BLOCKRECORD X)
(OTHERWISE (REMOVE-COMMENTS X)))))))
((NOT (CONSP X))
X)
(T (CASE (CAR X)
(IL:DEFCLASS X)
(IL:DATATYPE X)
(IL:RECORD X)
(IL:BLOCKRECORD X)
(OTHERWISE (REMOVE-COMMENTS X)))))))
(OTHERWISE (REMOVE-COMMENTS FORM)))))
(SCAN-ONE-FORM NEW-FORM *COMPILE-SCAN-CONTEXT*))
(SCAN-ONE-FORM FORM *COMPILE-FILE-CONTEXT*)))
@@ -988,9 +980,10 @@ LAP file created ~A.~%~%"
(WHEN *EVAL-WHEN-COMPILE* (EVAL FORM))
(LET ((NAME (SECOND NAME-FORM))
(DEFINITION (SECOND FUNCTION-FORM)))
(COMPILER-APPLY PROCESS-FUNCTION COMPILER-CONTEXT (FORMAT NIL "~s ~a"
(CAR DEFINITION)
NAME)
(COMPILER-APPLY PROCESS-FUNCTION COMPILER-CONTEXT (FORMAT NIL "~s ~a" (CAR
DEFINITION
)
NAME)
NAME DEFINITION)))
(T (COMPILER-APPLY PROCESS-LOOSE-FORM COMPILER-CONTEXT FORM)))))
@@ -1002,8 +995,8 @@ LAP file created ~A.~%~%"
(SECOND DEFN)
(CONS 'IL:LAMBDA (CDR DEFN)))))
(COMPILER-APPLY PROCESS-FUNCTION COMPILER-CONTEXT (FORMAT NIL "~s ~s"
(CAR REAL-DEFN)
(CAR DEFN))
(CAR REAL-DEFN)
(CAR DEFN))
(CAR DEFN)
REAL-DEFN)))
(CDR FORM)))
@@ -1019,10 +1012,10 @@ LAP file created ~A.~%~%"
VALUE)
(ENV-DECLARE-A-GLOBAL (FIND-TOP-ENVIRONMENT *ENVIRONMENT*)
SYMBOL)))
(SCAN-ONE-FORM `(NAMED-PROGN DEFCONSTANT ,SYMBOL
(LOCALLY (DECLARE (GLOBAL ,SYMBOL))
,(EXPAND-DEFINER 'DEFCONSTANT (REMOVE-COMMENTS FORM)
*ENVIRONMENT*)))
(SCAN-ONE-FORM `(NAMED-PROGN DEFCONSTANT ,SYMBOL (LOCALLY (DECLARE (GLOBAL ,SYMBOL))
,(EXPAND-DEFINER 'DEFCONSTANT
(REMOVE-COMMENTS FORM)
*ENVIRONMENT*)))
COMPILER-CONTEXT)))
(DEFUN COMPILE-FILE-DECLARE\: (COMPILER-CONTEXT FORM &OPTIONAL (DOCOPY T))
@@ -1044,9 +1037,8 @@ LAP file created ~A.~%~%"
((IL:COPYWHEN) (SETQ DOCOPY (IL:EVAL (CAR (SETQ TAIL (CDR TAIL))))))
((IL:FIRST) )
((IL:NOTFIRST IL:COMPILERVARS) )
(OTHERWISE (COMPILER-MESSAGE
"Warning: Ignoring unrecognized DECLARE: tag: ~S~%" (CAR TAIL))))
)
(OTHERWISE (COMPILER-MESSAGE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%"
(CAR TAIL)))))
((EQ 'IL:DECLARE\: (CAR (CAR TAIL)))
(COMPILER-APPLY IL:DECLARE\: COMPILER-CONTEXT (CAR TAIL)
DOCOPY))
@@ -1068,11 +1060,13 @@ LAP file created ~A.~%~%"
IL:FILECREATEDLOC)
(DECLARE (SPECIAL *STANDARD-INPUT* IL:FILECREATEDLOC))
(EVAL FORM))
(COMPILER-APPLY PROCESS-LOOSE-FORM COMPILER-CONTEXT
`(LET ((*STANDARD-INPUT* (OPEN "{Null}" :DIRECTION :OUTPUT))
IL:FILECREATEDLOC)
(DECLARE (SPECIAL *STANDARD-INPUT* IL:FILECREATEDLOC))
,FORM))
(COMPILER-APPLY PROCESS-LOOSE-FORM COMPILER-CONTEXT `(LET ((*STANDARD-INPUT* (OPEN "{Null}"
:DIRECTION
:OUTPUT))
IL:FILECREATEDLOC)
(DECLARE (SPECIAL *STANDARD-INPUT*
IL:FILECREATEDLOC))
,FORM))
(COMPILER-APPLY PROCESS-OUTSTANDING-LOOSE-FORMS COMPILER-CONTEXT))
(DEFUN COMPILE-FILE-PACKAGE-FORM (COMPILER-CONTEXT FORM)
@@ -1229,7 +1223,7 @@ LAP file created ~A.~%~%"
(DEFUN CRACK-DEFMACRO (FORM)
(IL:* IL:|;;;| "FORM is a call to DEFMACRO. Return two values: the LAMBDA-expression representing the expansion function for the macro and the documentation string, if present.")
(IL:* IL:|;;;| "FORM is a call to DEFMACRO. Return two values: the LAMBDA-expression representing the expansion function for the macro and the documentation string, if present.")
(LET ((NAME (SECOND FORM))
(ARG-LIST (THIRD FORM))
@@ -1245,7 +1239,7 @@ LAP file created ~A.~%~%"
(DEFUN ESTABLISH-MACRO-IN-COMPILER (NAME EXPN-FN)
(IL:* IL:|;;;| "Arrange for the symbol NAME to refer to a macro with the given expansion-function EXPN-FN within this compilation.")
(IL:* IL:|;;;| "Arrange for the symbol NAME to refer to a macro with the given expansion-function EXPN-FN within this compilation.")
(ENV-BIND-FUNCTION (FIND-TOP-ENVIRONMENT *ENVIRONMENT*)
NAME :MACRO EXPN-FN))
@@ -1261,18 +1255,18 @@ LAP file created ~A.~%~%"
(DEFVAR *MAKING-SECOND-PASS* NIL
(IL:* IL:|;;;| "Bound to T during second pass over saved forms; used for :Process-Entire-File option to compile-file.")
(IL:* IL:|;;;| "Bound to T during second pass over saved forms; used for :Process-Entire-File option to compile-file.")
)
(DEFVAR *PREPROCESSING-PHASE* NIL
(IL:* IL:|;;;| "Bound to T during the preprocessing phase so that inferiors can tell.")
(IL:* IL:|;;;| "Bound to T during the preprocessing phase so that inferiors can tell.")
)
(DEFUN COMPILE-SCAN-DECLARE\: (COMPILER-CONTEXT FORM &OPTIONAL (DOCOPY T)
(DOFIRST NIL))
(DOFIRST NIL))
(LET ((FIRST-FORMS NIL)
(IL:DFNFLG IL:DFNFLG)
(*EVAL-WHEN-COMPILE* *EVAL-WHEN-COMPILE*))
@@ -1295,9 +1289,8 @@ LAP file created ~A.~%~%"
((IL:FIRST) (SETQ DOFIRST T))
((IL:NOTFIRST) (SETQ DOFIRST NIL))
((IL:COMPILERVARS) (SETQ IL:DFNFLG T))
(OTHERWISE (COMPILER-MESSAGE
"Warning: Ignoring unrecognized DECLARE: tag: ~S~%" (CAR TAIL))))
)
(OTHERWISE (COMPILER-MESSAGE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%"
(CAR TAIL)))))
((EQ 'IL:DECLARE\: (CAR (CAR TAIL)))
(COMPILER-APPLY IL:DECLARE\: COMPILER-CONTEXT (CAR TAIL)
DOCOPY DOFIRST))
@@ -1416,7 +1409,7 @@ LAP file created ~A.~%~%"
(*UNKNOWN-FUNCTIONS* NIL)
(*CURRENT-FUNCTION* NAME)
(*INPUT-STREAM* NIL)
(*LAP-FLG* LAP) (IL:* IL:\; "FXAR-111")
(*LAP-FLG* LAP) (IL:* IL:\; "FXAR-111")
(COMPILED-DEFN (RAW-COMPILE NAME DEFN)))
(DECLARE (SPECIAL IL:SPECVARS IL:LOCALVARS IL:LOCALFREEVARS IL:GLOBALVARS))
(WARN-ABOUT-UNKNOWN-FUNCTIONS)
@@ -1516,7 +1509,7 @@ LAP file created ~A.~%~%"
(LET ((*ENVIRONMENT* (COPY-ENV *ENVIRONMENT*))
COMPILED-DEFN)
(IL:* IL:|;;| "The resulting function is defined locally, so we have to compile for the host architecture rather than the target architecture:")
(IL:* IL:|;;| "The resulting function is defined locally, so we have to compile for the host architecture rather than the target architecture:")
(SETF (ENV-TARGET-ARCHITECTURE *ENVIRONMENT*)
*HOST-ARCHITECTURE*)
@@ -1531,20 +1524,20 @@ LAP file created ~A.~%~%"
(DEFUN COMPILE-DEFINER-OUTSTANDING-LOOSE-FORMS (COMPILER-CONTEXT)
(IL:* IL:|;;|
 "Compile any outstanding loose forms in the context of a structure definition being compiled")
(IL:* IL:|;;|
 "Compile any outstanding loose forms in the context of a structure definition being compiled")
(WHEN (NOT (NULL *OUTSTANDING-LOOSE-FORMS*))
(LET* ((*ENVIRONMENT* (COPY-ENV *ENVIRONMENT*))
COMPILED-DEFN)
(IL:* IL:|;;| "The resulting function is executed locally, so have to compile for the host architecture rather than the target architecture:")
(IL:* IL:|;;| "The resulting function is executed locally, so have to compile for the host architecture rather than the target architecture:")
(SETF (ENV-TARGET-ARCHITECTURE *ENVIRONMENT*)
*HOST-ARCHITECTURE*)
(SETQ COMPILED-DEFN (RAW-COMPILE *LOOSE-NAME* `(LAMBDA NIL ,@(REVERSE
*OUTSTANDING-LOOSE-FORMS*
))))
))))
(SETQ *OUTSTANDING-LOOSE-FORMS* NIL)
(FUNCALL COMPILED-DEFN))))
@@ -1561,36 +1554,37 @@ LAP file created ~A.~%~%"
(IL:PUTPROPS IL:XCLC-TOP-LEVEL IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
(DEFPACKAGE "COMPILER"
(:USE "LISP" "XCL"))))
(IL:PUTPROPS IL:XCLC-TOP-LEVEL IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1989 1990 1991
1994 2020))
(DEFPACKAGE "COMPILER" (:USE "LISP"
"XCL"))))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (7050 7194 (COMPILER-ERROR 7050 . 7194)) (8749 17618 (COMPILE-FILE 8749 . 17618)) (
17620 20017 (START-COMPILATION 17620 . 20017)) (20019 21292 (FINISH-COMPILATION 20019 . 21292)) (21294
26872 (SCAN-ONE-FORM 21294 . 26872)) (26874 27071 (FUNCTION-P 26874 . 27071)) (28998 29614 (
CHECK-FOR-UNKNOWN-FUNCTION 28998 . 29614)) (29616 29870 (WARN-ABOUT-UNKNOWN-FUNCTIONS 29616 . 29870))
(31345 31475 (ASSEMBLER-ERROR 31345 . 31475)) (33238 38333 (SET-UP-BLOCK-DECLS 33238 . 38333)) (38481
39021 (CONSTANT-EXPRESSION-P 38481 . 39021)) (39023 40665 (COMPILE-AND-DUMP 39023 . 40665)) (40667
42619 (COMPILE-AND-DUMP-1 40667 . 42619)) (42621 43312 (COMPILE-ONE-LAMBDA 42621 . 43312)) (43314
44035 (OPTIMIZE-AND-MACROEXPAND 43314 . 44035)) (44037 45685 (OPTIMIZE-AND-MACROEXPAND-1 44037 . 45685
)) (45893 49547 (PROCESS-FORMS 45893 . 49547)) (49549 49684 (MAYBE-REMOVE-COMMENTS 49549 . 49684)) (
49686 50599 (COMPILE-FILE-SETF-SYMBOL-FUNCTION 49686 . 50599)) (50601 51400 (COMPILE-FILE-DEFINEQ
50601 . 51400)) (51402 52329 (COMPILE-FILE-DEFCONSTANT 51402 . 52329)) (52331 54264 (
COMPILE-FILE-DECLARE\: 52331 . 54264)) (54266 54828 (COMPILE-FILE-DEFINE-FILE-INFO 54266 . 54828)) (
54830 55074 (COMPILE-FILE-PACKAGE-FORM 54830 . 55074)) (55076 57795 (COMPILE-FILE-PROCLAMATION 55076
. 57795)) (57797 59208 (COMPILE-FILE-COMPILER-LET 57797 . 59208)) (59210 59890 (COMPILE-FILE-MACROLET
59210 . 59890)) (59892 60882 (COMPILE-FILE-DEFINER 59892 . 60882)) (60884 61812 (
COMPILE-FILE-NAMED-PROGN 60884 . 61812)) (61814 62464 (COMPILE-FILE-OUTSTANDING-LOOSE-FORMS 61814 .
62464)) (62466 62608 (COMPILE-FILE-LOOSE-FORM 62466 . 62608)) (62610 62929 (
COMPILE-FILE-PROCESS-FUNCTION 62610 . 62929)) (62931 63608 (CRACK-DEFMACRO 62931 . 63608)) (63610
63893 (ESTABLISH-MACRO-IN-COMPILER 63610 . 63893)) (64587 66834 (COMPILE-SCAN-DECLARE\: 64587 . 66834)
) (66836 67198 (COMPILE-SCAN-DEFINE-FILE-INFO 66836 . 67198)) (67200 68114 (COMPILE-SCAN-MACROLET
67200 . 68114)) (68116 68751 (COMPILE-SCAN-DEFINER 68116 . 68751)) (68753 68886 (
COMPILE-SCAN-LOOSE-FORM 68753 . 68886)) (68888 68962 (COMPILE-SCAN-OUTSTANDING-LOOSE-FORMS 68888 .
68962)) (68964 69412 (MERGE-FIRST-FORMS 68964 . 69412)) (69537 71788 (COMPILE 69537 . 71788)) (71790
72043 (COMPILE-DEFINER 71790 . 72043)) (72045 73084 (COMPILE-FORM 72045 . 73084)) (73086 73958 (
RAW-COMPILE 73086 . 73958)) (73960 75059 (COMPILE-DEFINER-DEFINER 73960 . 75059)) (75061 75899 (
COMPILE-DEFINER-NAMED-PROGN 75061 . 75899)) (75901 76736 (COMPILE-DEFINER-PROCESS-FUNCTION 75901 .
76736)) (76738 77694 (COMPILE-DEFINER-OUTSTANDING-LOOSE-FORMS 76738 . 77694)))))
(IL:FILEMAP (NIL (6860 7004 (COMPILER-ERROR 6860 . 7004)) (7006 7507 (COMPILER-APPLY 7006 . 7507)) (
8559 17297 (COMPILE-FILE 8559 . 17297)) (17299 19704 (START-COMPILATION 17299 . 19704)) (19706 20979 (
FINISH-COMPILATION 19706 . 20979)) (20981 26437 (SCAN-ONE-FORM 20981 . 26437)) (26439 26636 (
FUNCTION-P 26439 . 26636)) (26638 26760 (COMPILER-MESSAGE 26638 . 26760)) (26762 26850 (
COMPILING-MESSAGE 26762 . 26850)) (26852 26919 (DONE-MESSAGE 26852 . 26919)) (28567 29183 (
CHECK-FOR-UNKNOWN-FUNCTION 28567 . 29183)) (29185 29439 (WARN-ABOUT-UNKNOWN-FUNCTIONS 29185 . 29439))
(30914 31044 (ASSEMBLER-ERROR 30914 . 31044)) (32807 37890 (SET-UP-BLOCK-DECLS 32807 . 37890)) (38038
38578 (CONSTANT-EXPRESSION-P 38038 . 38578)) (38580 40220 (COMPILE-AND-DUMP 38580 . 40220)) (40222
42176 (COMPILE-AND-DUMP-1 40222 . 42176)) (42178 42869 (COMPILE-ONE-LAMBDA 42178 . 42869)) (42871
43588 (OPTIMIZE-AND-MACROEXPAND 42871 . 43588)) (43590 45236 (OPTIMIZE-AND-MACROEXPAND-1 43590 . 45236
)) (45238 45442 (EXPAND-DEFINER 45238 . 45442)) (45444 48977 (PROCESS-FORMS 45444 . 48977)) (48979
49114 (MAYBE-REMOVE-COMMENTS 48979 . 49114)) (49116 50132 (COMPILE-FILE-SETF-SYMBOL-FUNCTION 49116 .
50132)) (50134 50925 (COMPILE-FILE-DEFINEQ 50134 . 50925)) (50927 51935 (COMPILE-FILE-DEFCONSTANT
50927 . 51935)) (51937 53854 (COMPILE-FILE-DECLARE\: 51937 . 53854)) (53856 54795 (
COMPILE-FILE-DEFINE-FILE-INFO 53856 . 54795)) (54797 55041 (COMPILE-FILE-PACKAGE-FORM 54797 . 55041))
(55043 57762 (COMPILE-FILE-PROCLAMATION 55043 . 57762)) (57764 59175 (COMPILE-FILE-COMPILER-LET 57764
. 59175)) (59177 59857 (COMPILE-FILE-MACROLET 59177 . 59857)) (59859 60849 (COMPILE-FILE-DEFINER
59859 . 60849)) (60851 61779 (COMPILE-FILE-NAMED-PROGN 60851 . 61779)) (61781 62431 (
COMPILE-FILE-OUTSTANDING-LOOSE-FORMS 61781 . 62431)) (62433 62575 (COMPILE-FILE-LOOSE-FORM 62433 .
62575)) (62577 62896 (COMPILE-FILE-PROCESS-FUNCTION 62577 . 62896)) (62898 63575 (CRACK-DEFMACRO 62898
. 63575)) (63577 63860 (ESTABLISH-MACRO-IN-COMPILER 63577 . 63860)) (64554 66781 (
COMPILE-SCAN-DECLARE\: 64554 . 66781)) (66783 67145 (COMPILE-SCAN-DEFINE-FILE-INFO 66783 . 67145)) (
67147 68061 (COMPILE-SCAN-MACROLET 67147 . 68061)) (68063 68698 (COMPILE-SCAN-DEFINER 68063 . 68698))
(68700 68833 (COMPILE-SCAN-LOOSE-FORM 68700 . 68833)) (68835 68909 (
COMPILE-SCAN-OUTSTANDING-LOOSE-FORMS 68835 . 68909)) (68911 69359 (MERGE-FIRST-FORMS 68911 . 69359)) (
69484 71735 (COMPILE 69484 . 71735)) (71737 71990 (COMPILE-DEFINER 71737 . 71990)) (71992 73031 (
COMPILE-FORM 71992 . 73031)) (73033 73905 (RAW-COMPILE 73033 . 73905)) (73907 75006 (
COMPILE-DEFINER-DEFINER 73907 . 75006)) (75008 75846 (COMPILE-DEFINER-NAMED-PROGN 75008 . 75846)) (
75848 76683 (COMPILE-DEFINER-PROCESS-FUNCTION 75848 . 76683)) (76685 77639 (
COMPILE-DEFINER-OUTSTANDING-LOOSE-FORMS 76685 . 77639)))))
IL:STOP

Binary file not shown.