(FILECREATED " 8-Jul-85 15:35:33" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;2 14308
changes to: (VARS CMLCOMPILECOMS)
(FNS COMPILE-FILE COMPILE-FILE-EXPRESSION COMPILE.FILE.EXPRESSION)
previous date: " 8-Jul-85 14:42:52" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS [(FNS COMPILE-FILE COMPILE-FILE-EXPRESSION COMPILE.FILE.EXPRESSION
ARGTYPE.STATE COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ
COMPILE.FILE.EXPRESSION 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])
(COMPILE.FILE.EXPRESSION
[LAMBDA (FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER)
(* lmm " 8-Jul-85 15:23")
(* for back compatibility)
(COMPILE-FILE-EXPRESSION FORM COMPILED.FILE 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.EXPRESSION
[LAMBDA (FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER)
(* lmm " 8-Jul-85 15:23")
(* for back compatibility)
(COMPILE-FILE-EXPRESSION FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER])
(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 (957 12746 (COMPILE-FILE 967 . 6113) (COMPILE-FILE-EXPRESSION 6115 . 9228) (
COMPILE.FILE.EXPRESSION 9230 . 9592) (ARGTYPE.STATE 9594 . 9717) (COMPILE.CHECK.ARGTYPE 9719 . 10989)
(COMPILE.FILE.DEFINEQ 10991 . 11338) (COMPILE.FILE.EXPRESSION 11340 . 11702) (COMPILE.FILE.APPLY 11704
. 12045) (COMPILE.FILE.RESET 12047 . 12744)) (13070 14041 (NEWDEFC 13080 . 14039)))))
STOP