(FILECREATED " 3-Aug-85 14:27:02" {ERIS}<LISPCORE>LISPUSERS>CMLCOMPILE.;1 13421
changes to: (VARS CMLCOMPILECOMS) (PROPS (DEFINEQ COMPILE-FILE-EXPRESSION) (*
COMPILE-FILE-EXPRESSION))
previous date: " 8-Jul-85 15:35:33" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS ((FNS COMPILE-FILE COMPILE-FILE-EXPRESSION ARGTYPE.STATE COMPILE.CHECK.ARGTYPE
COMPILE.FILE.DEFINEQ COMPILE.FILE.APPLY COMPILE.FILE.RESET) (VARS ARGTYPE.VARS) (PROP
COMPILE-FILE-EXPRESSION DEFINEQ *) (ADDVARS (SYSPROPS COMPILE-FILE-EXPRESSION)) (FNS NEWDEFC) (P (MOVD
(QUOTE NEWDEFC) (QUOTE DEFC))) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA) (NLAML) (LAMA COMPILE-FILE)))))
(DEFINEQ
(COMPILE-FILE
[LAMBDA \COMPILE-FILE.ARGCNT (* lmm " 8-Jul-85 15:21")
(PROGN (QUOTE DEFUN) (* ARGLIST = (FILENAME &KEY LAP REDEFINE OUTPUT-FILE
(SAVE-EXPRS T) (COMPILER-OUTPUT T) PROCESS-ENTIRE-FILE)
)
(DECLARE (LOCALVARS \COMPILE-FILE.ARGCNT))
(LET ((FILENAME (ARG \COMPILE-FILE.ARGCNT 1)))
(LET* [[LAP (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT (OR (\KEYSEARCH 2 :LAP
\COMPILE-FILE.ARGCNT)
(RETURN NIL]
[REDEFINE (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT
(OR (\KEYSEARCH 2 :REDEFINE \COMPILE-FILE.ARGCNT)
(RETURN NIL]
[OUTPUT-FILE (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT
(OR (\KEYSEARCH 2 :OUTPUT-FILE
\COMPILE-FILE.ARGCNT)
(RETURN NIL]
[SAVE-EXPRS (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT
(OR (\KEYSEARCH 2 :SAVE-EXPRS
\COMPILE-FILE.ARGCNT)
(RETURN T]
[COMPILER-OUTPUT (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT
(OR (\KEYSEARCH 2 :COMPILER-OUTPUT
\COMPILE-FILE.ARGCNT)
(RETURN T]
(PROCESS-ENTIRE-FILE (PROG NIL
(RETURN (ARG \COMPILE-FILE.ARGCNT
(OR (\KEYSEARCH 2 :PROCESS-ENTIRE-FILE
\COMPILE-FILE.ARGCNT)
(RETURN NIL]
(* COMPILE-FILE is like TCOMPL, except that it reads in all of FILES before starting any compilations, so that a
BLOCK can contain functions in several FILES. BLOCKS are set up using a DECLARE statement of the form
(DECLARE (BLOCK: BLKNAME BLKFN1 BLKFN2 ... (VAR1 VALUE) (VAR2 VALUE) ...) (BLOCK: BLKNAME ...) ...) -
where BLKFN1 ... are the functions in the BLOCK, and VAR1 ... are values for ENTRIES, RETFNS, SPECVARS, etc. A
variable setting of the form (VAR . list) sets variable to UNION of the list with the variable's top level value.
A variable setting of the form (VAR . ATOM) simply sets the variable to that atom, e.g. (NOLINKFLG . T))
(LET (COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE)
(DECLARE (SPECVARS COMPILE.FILE.AFTER))
[RESETLST (RESETSAVE NIL (LIST (QUOTE RESETUNDO))
(RESETUNDO))
(RESETSAVE NLAML NLAML)
(RESETSAVE NLAMA NLAMA)
(RESETSAVE LAMS LAMS)
(RESETSAVE LAMA LAMA)
(RESETSAVE DFNFLG NIL)
(RESETSAVE COUTFILE COMPILER-OUTPUT)
(RESETSAVE SVFLG (AND SAVE-EXPRS (QUOTE DEFER)))
(LET ((LOCALVARS SYSLOCALVARS)
(SPECVARS T)
STREAM LSTFIL ROOTNAME)
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ STREAM (OPENSTREAM FILENAME
(QUOTE INPUT]
(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)))
(COND
(OUTPUT-FILE (PRINT (LIST (QUOTE FILECREATED)
(DATE)
(CONS COMPILEHEADER FILENAME)
COMPVERSION "COMPILE.FILEd"
(QUOTE in)
HERALDSTRING
(QUOTE dated)
MAKESYSDATE)
OUTPUT-FILE FILERDTBL)))
(PROG (FILE.EXPRESSION DEFERRED.EXPRESSIONS)
(DECLARE (SPECVARS DEFERRED.EXPRESSIONS))
LP (COND
((OR (NULL (SETQ FILE.EXPRESSION (READ STREAM
FILERDTBL)))
(EQ FILE.EXPRESSION (QUOTE STOP)))
[AND PROCESS.ENTIRE.FILE
(MAPC (REVERSE DEFERRED.EXPRESSIONS)
(FUNCTION (LAMBDA (EXP)
(APPLY* (CAR EXP)
(CDR EXP)
OUTPUT-FILE FILERDTBL]
(CLOSEF STREAM)
(RETURN)))
(COMPILE-FILE-EXPRESSION FILE.EXPRESSION OUTPUT-FILE
NIL NIL PROCESS.ENTIRE.FILE)
(GO LP))
(PRINT (QUOTE STOP)
OUTPUT-FILE)
(SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE]
(* do these after UNDONLSETQ entered)
(MAPC (REVERSE COMPILE.FILE.AFTER)
(FUNCTION EVAL))
COMPILE.FILE.VALUE])
(COMPILE-FILE-EXPRESSION
[LAMBDA (FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER)
(* lmm " 8-Jul-85 15:21")
(SELECTQ (CAR (LISTP FORM))
(DECLARE: (PROG ((ORIG.COMPILE.TIME.TOO COMPILE.TIME.TOO)
(ORIG.DONT.COPY DONT.COPY)
(FORM (CDR FORM)))
LP (COND
((NLISTP FORM)
(RETURN))
((NLISTP (CAR FORM))
(SELECTQ (CAR FORM)
(DONTCOPY (SETQ DONT.COPY T))
((DOCOPY COPY)
(SETQ DONT.COPY NIL))
[COPYWHEN (SETQ DONT.COPY
(NOT (EVAL (CAR (SETQ FORM (CDR FORM]
(FIRST (PRINTOUT COUTFILE
"Warning: (DECLARE: -- FIRST -- --) not implemented in COMPILE.FILE: "
(CADR FORM)
T))
(NOTFIRST)
(DONTEVAL@COMPILE (SETQ COMPILE.TIME.TOO NIL))
((DOEVAL@COMPILE EVAL@COMPILE)
(SETQ COMPILE.TIME.TOO T))
[EVAL@COMPILEWHEN (SETQ COMPILE.TIME.TOO
(EVAL (CAR (SETQ FORM (CDR FORM]
(EVAL@LOADWHEN (SETQ FORM (CDR FORM)))
((DONTEVAL@LOAD DOEVAL@LOAD EVAL@LOAD)
NIL)
(PRINT (CONS (CAR FORM)
(QUOTE (UNRECOGNIZED DECLARE TAG)))
COUTFILE)))
(T (COMPILE-FILE-EXPRESSION (CAR FORM)
COMPILED.FILE COMPILE.TIME.TOO DONT.COPY
DEFER)))
(SETQ FORM (CDR FORM))
(GO LP)))
[EVAL.WHEN (LET* [(CONDITIONS (CADR FORM))
(COMPTIME (OR (FMEMB (QUOTE COMPILE)
CONDITIONS)
(AND COMPILE.TIME.TOO (FMEMB (QUOTE EVAL)
CONDITIONS]
(if (OR (FMEMB (QUOTE LOAD)
CONDITIONS))
then (for X in (CDDR FORM) do (COMPILE-FILE-EXPRESSION X
COMPILED.FILE
COMPTIME
DONT.COPY
DEFER))
elseif COMPTIME
then (MAPC (CDDR FORM)
(FUNCTION EVAL]
(PROGN (for X in (CDR FORM) do (COMPILE-FILE-EXPRESSION X COMPILED.FILE COMPILE.TIME.TOO
DONT.COPY DEFER)))
(PROGN (AND COMPILE.TIME.TOO (EVAL FORM))
(OR DONT.COPY (LET [(PROP (OR (GETPROP (CAR FORM)
(QUOTE COMPILE-FILE-EXPRESSION))
(GETPROP (CAR FORM)
(QUOTE COMPILE.FILE.EXPRESSION]
(if PROP
then (COMPILE.FILE.APPLY PROP FORM COMPILE.TIME.TOO
DONT.COPY DEFER)
elseif [AND (SETQ PROP (GETLIS (CAR FORM)
COMPILERMACROPROPS))
(NOT (EQUAL FORM (SETQ FORM (MACROEXPANSION
FORM
(CADR PROP]
then (COMPILE-FILE-EXPRESSION FORM COMPILED.FILE
COMPILE.TIME.TOO DONT.COPY
DEFER)
else (COMPILE.FILE.APPLY (FUNCTION PRINT)
FORM COMPILE.TIME.TOO DONT.COPY
DEFER])
(ARGTYPE.STATE
[LAMBDA NIL
(for X in ARGTYPE.VARS do (PRINTOUT T X , (EVAL (CADR X))
T])
(COMPILE.CHECK.ARGTYPE
[LAMBDA (X AT) (* lmm "15-Jun-85 16:58")
(if (NEQ AT (LET (BLKFLG)
(COMP.ARGTYPE X)))
then (* incorrectly on one of the defining lists)
(for ATYPEPAIR in ARGTYPE.VARS
do (LET [(VAL (FMEMB X (EVALV (CADR ATYPEPAIR]
(if (EQ AT (CAR ATYPEPAIR))
then (if VAL
then (PRINTOUT COUTFILE "Compiler confused: " X " on "
(CADR ATYPEPAIR)
" but compiler doesn't think its a "
(CADDR ATYPEPAIR)))
[/SETTOPVAL (CADR ATYPEPAIR)
(CONS X (PROGN (GETTOPVAL (CADR ATYPEPAIR]
else (if VAL
then (PRINTOUT COUTFILE "Warning: compiler thought " X " "
(LIST (QUOTE a)
(OR (CADDR (ASSOC AT ARGTYPE.VARS))
"LAMBDA spread")
(QUOTE function))
" was a "
(CADDR ATYPEPAIR)
" because it was incorrectly on "
(CADR ATYPEPAIR)
T)
(/SETTOPVAL (CADR ATYPEPAIR)
(REMOVE X (PROGN (GETTOPVAL (CADR ATYPEPAIR])
(COMPILE.FILE.DEFINEQ
[LAMBDA (FORM LCFIL RDTBL) (* lmm " 5-Jul-85 15:42")
(for DEF in (CDR FORM)
do (COMPILE.CHECK.ARGTYPE (CAR DEF)
(ARGTYPE (CADR DEF)))
(BYTECOMPILE2 (CAR DEF)
(COMPILE1A (CAR DEF)
(CADR DEF)
NIL])
(COMPILE.FILE.APPLY
[LAMBDA (PROP FORM COMPILE.TIME.TOO DONT.COPY DEFER) (* lmm "27-Jun-85 17:36")
(PROGN (AND COMPILE.TIME.TOO (EVAL FORM))
(OR DONT.COPY (if DEFER
then (push DEFERRED.EXPRESSIONS (CONS PROP FORM))
else (APPLY* PROP FORM COMPILED.FILE FILERDTBL])
(COMPILE.FILE.RESET
[LAMBDA (COMPILED.FILE SOURCEFILE ROOTNAME) (* lmm "15-Jun-85 16:52")
(* Cleans up after brecompile and bcompl have finished
operating,)
[COND
(COMPILED.FILE (CLOSEF? COMPILED.FILE)
(AND RESETSTATE (DELFILE COMPILED.FILE]
(COND
(SOURCEFILE (CLOSEF? SOURCEFILE)))
(COND
((NULL RESETSTATE) (* Finished successfully.)
(/SETATOMVAL (QUOTE NOTCOMPILEDFILES)
(REMOVE ROOTNAME NOTCOMPILEDFILES)) (* Removes FILES from NOTCOMPILEDFILES.)
])
)
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread") (2 LAMA "LAMBDA nospread") (0 LAMS "LAMBDA spread") (3
NLAMA "NLAMBDA no-spread")))
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(ADDTOVAR SYSPROPS COMPILE-FILE-EXPRESSION)
(DEFINEQ
(NEWDEFC
[LAMBDA (NM DF) (* lmm "15-Jun-85 17:08")
(COND
((EQ SVFLG (QUOTE DEFER))
(push COMPILE.FILE.AFTER (LIST (FUNCTION NEWDEFC)
NM DF T)))
((OR (NULL DFNFLG)
(EQ DFNFLG T))
[COND
((GETD NM)
(VIRGINFN NM T)
(COND
((NULL DFNFLG)
(PRINT (CONS NM (QUOTE (redefined)))
T T) (* NOTE: this call to PRINT is changed to LISPXPRINT
later in the loadup.)
(SAVEDEF NM]
(/PUTD NM DF T) (* NOTE: this call to \PUTD is changed to /PUTD later
in the loadup.)
)
(T (/PUTPROP NM (QUOTE CODE)
DF) (* NOTE: this call to /PUTPROP is changed to /PUTPROP
later in the loadup.)
))
DF])
)
(MOVD (QUOTE NEWDEFC) (QUOTE DEFC))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (824 11885 (COMPILE-FILE 834 . 5980) (COMPILE-FILE-EXPRESSION 5982 . 9095) (
ARGTYPE.STATE 9097 . 9220) (COMPILE.CHECK.ARGTYPE 9222 . 10492) (COMPILE.FILE.DEFINEQ 10494 . 10841) (
COMPILE.FILE.APPLY 10843 . 11184) (COMPILE.FILE.RESET 11186 . 11883)) (12189 13160 (NEWDEFC 12199 .
13158)))))
STOP