(FILECREATED " 3-Jan-84 13:45:31" {PHYLUM}<LISPCORE>SOURCES>LOADFNS.;4 33463
changes to: (FNS SCANEXP)
previous date: "15-Dec-83 21:52:26" {PHYLUM}<LISPCORE>SOURCES>LOADFNS.;3)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT LOADFNSCOMS)
(RPAQQ LOADFNSCOMS [(FNS LOADFROM LOADBLOCK LOADCOMP LOADCOMP? LOADVARS LOADEFS LOADFILEMAP LOADFNS
LOADFNS0 LOADFNS1 GETBLOCKDEC LOADFNSCAN SCANFILE0 SCANCOMPILEDFN
SCANDEFINEQ SCANEXP SCANDECLARE: SCANFILE1 SCANFILE2 TMPSUBFN RETRYSCAN
SCANFILEHELP)
(VARS (NOT-FOUNDTAG (QUOTE NOT-FOUND:)))
(BLOCKS (SCANFILEBLOCK LOADFNSCAN SCANFILE0 SCANCOMPILEDFN SCANDEFINEQ SCANEXP SCANDECLARE:
SCANFILE1 SCANFILE2 TMPSUBFN (LOCALFREEVARS FNADRLST DICT DICT0 ADR)
(SPECVARS LDFLG PRINTFLG FNS FNLST VARLST VARS DONELST)
(GLOBALVARS SYSFILES FILEPKGFLG DWIMFLG ADDSPELLFLG BUILDMAPFLG
NOFIXVARSLST NOFIXFNSLST DFNFLG FILERDTBL LOADOPTIONS
UPDATEMAPFLG)
(ENTRIES LOADFNSCAN TMPSUBFN SCANFILE1)
(RETFNS SCANFILE0))
(NIL LOADFROM (GLOBALVARS LASTWORD DWIMFLG))
(NIL LOADFNS LOADFNS0 LOADFNS1 (GLOBALVARS DWIMFLG UPDATEMAPFLG BUILDMAPFLG
FILEPKGFLG ADDSPELLFLG LOADOPTIONS
SYSFILES DFNFLG NOT-FOUNDTAG))
(NIL LOADFILEMAP (GLOBALVARS UPDATEMAPFLG])
(DEFINEQ
(LOADFROM
[LAMBDA (FILE FNS LDFLG) (* wt: "21-SEP-79 12:03")|
(* 'notices' file.)|
(PROG1 (LOADFNS FNS FILE LDFLG (QUOTE LOADFROM))|
(AND DWIMFLG FNS (SETQ LASTWORD (COND|
((ATOM FNS)|
FNS)|
(T (CAR (LAST FNS])
(LOADBLOCK
[LAMBDA (FN FILE LDFLG)
(PROG (TEM)
(OR FILE (SETQ FILE (LOADFNS0 FN)))
(RETURN (AND [SETQ TEM (SUBSET (OR (GETBLOCKDEC FN FILE T)
(LIST FN))
(FUNCTION (LAMBDA (FN)
(NOT (EXPRP (VIRGINFN FN]
(LOADFNS TEM FILE LDFLG])
(LOADCOMP
[LAMBDA (FILE LDFLG) (* rmk: "17-NOV-81 01:37")
(* Save FULLNAME for LOADCOMP?)
(PROG (BLOCKS (FULLNAME (OR (FINDFILE FILE)
FILE)))
(RETURN (PROG1 (LOADFNS T FULLNAME LDFLG (QUOTE LOADCOMP))
(/PUTPROP (NAMEFIELD FULLNAME)
(QUOTE LOADCOMP)
FULLNAME])
(LOADCOMP?
[LAMBDA (FILE LDFLG) (* rmk: "17-NOV-81 01:38")
(PROG (BLOCKS TEM (FULLNAME (OR (FINDFILE FILE)
FILE)))
(DECLARE (SPECVARS FULLNAME))
(COND
([AND (OR [NULL (SETQ TEM (GETPROP (NAMEFIELD FULLNAME)
(QUOTE LOADCOMP]
(NEQ TEM FULLNAME))
(NULL (SEARCHPDL (FUNCTION (LAMBDA (NAME FRAME)
(AND (EQ NAME (QUOTE LOADCOMP))
(EQ FULLNAME (EVALV (QUOTE FILE)
FRAME]
(LOADCOMP FULLNAME LDFLG)))
(RETURN FILE])
(LOADVARS
[LAMBDA (VARS FILE LDFLG)
(LOADFNS NIL FILE LDFLG VARS])
(LOADEFS
[LAMBDA (FNS FILE) (* wt: " 9-APR-80 20:27")
(LOADFNS FNS FILE (QUOTE GETDEF])
(LOADFILEMAP
[LAMBDA (FILE) (* wt: "16-MAY-79 22:05")
(* user wants the full filemap. scan file if necessary. if updatemapflg=T and any changes are made, e.g. map does
|
not exist on file, or is wrong (due to transferring from dorado to maxc), loafns will rewrite the map)
(LOADFNS NIL FILE NIL (QUOTE FILEMAP])
(LOADFNS
[LAMBDA (FNS FILE LDFLG VARS) (* rmk: "20-FEB-83 22:38")
(RESETVARS ((DFNFLG LDFLG)
(BUILDMAPFLG BUILDMAPFLG)
(FILEPKGFLG FILEPKGFLG)
(ADDSPELLFLG ADDSPELLFLG))
(RETURN
(RESETLST
(PROG (FNLST VARLST DONELST ROOTNAME FILEMAP TEM
FILECREATEDLST (PRLST (AND FILEPKGFLG
(
FILEPKGCHANGES)))
(LISPXHIST LISPXHIST))
(DECLARE (SPECVARS FILECREATEDLST))
TOP (COND
((OR (EQ LDFLG (QUOTE EXPRESSIONS))
(EQ LDFLG (QUOTE GETDEF))
(MEMB LDFLG LOADOPTIONS)))
((AND DWIMFLG (SETQ TEM
(FIXSPELL LDFLG NIL LOADOPTIONS T)))
(SETQ LDFLG TEM)
(SETQ DFNFLG TEM))
(T (SETQ LDFLG (ERROR
"unrecognized load option"
LDFLG))
(GO TOP)))
(COND
((EQ LDFLG (QUOTE SYSLOAD))
(SETQ DFNFLG T)
(SETQ ADDSPELLFLG NIL)
(SETQ BUILDMAPFLG NIL)
(SETQ FILEPKGFLG NIL)
(SETQ LISPXHIST NIL)))
[AND LISPXHIST (COND
((SETQ TEM (FMEMB (QUOTE SIDE)
LISPXHIST))
(FRPLACA (CADR TEM)
-1))
(T (LISPXPUT (QUOTE SIDE)
(LIST -1)
NIL LISPXHIST]
(* So that UNDOSAVE will keep saving regardless of how many undosaves are involved)
(SETQ FNLST (LOADFNS1 FNS T))
[OR FILE (SETQ FILE (LOADFNS0 (CAR FNLST]
RETRY
[COND
[(SETQ TEM (OPENP FILE (QUOTE INPUT)))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
(SETQ FILE TEM)
(GETFILEPTR FILE)))
(* FILE already open)
(OR (EQ FILE (INPUT))
(RESETSAVE NIL (LIST (QUOTE INPUT)
(INPUT FILE]
(T (RESETSAVE NIL (LIST (QUOTE INPUT)
(INFILE FILE)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
(SETQ FILE (INPUT]
(COND
((NOT (RANDACCESSP FILE))
(SETQ FILE (ERROR FILE
"not a random access file"))
(GO RETRY)))
(SETFILEPTR NIL 0)
(* Gets full file name. Also note thatthee may have been some error correction done in INFILE< e.g. spelling
correction or obtaining another directory)
(SETQ ROOTNAME (ROOTFILENAME FILE))
(SETQ FILEMAP (GETFILEMAP FILE ROOTNAME))
(SETQ VARLST
(SELECTQ
VARS
(NIL NIL)
(VARS (* Means load, i.e. evaluate, ALL rpaq/rpaqq)
(QUOTE VARS))
[FNS/VARS (LIST (FILECOMS ROOTNAME
(QUOTE COMS))
(FILECOMS ROOTNAME
(QUOTE BLOCKS]
(DEFS (* means return the list of definitions.)
(* should be done via LDFLG = EXPRESSIONS)
(SHOULDNT))
(LOADCOMP (* evaluate the EVAL@COMPILE expresions, notice the fns and vars.)
(SETQ FNLST T)
(QUOTE LOADCOMP))
(FILEMAP (* just built the filemap if one not already available)
(COND
((AND FILEMAP
(NULL (CAR FILEMAP)))
(RETURN FILEMAP))
((NULL BUILDMAPFLG)
(RETURN NIL)))
(QUOTE FILEMAP))
(LOADFROM
(* evaluate all non-defineq expressions, but just return file name as value, i.e. dont bother adding to donelst)
(QUOTE LOADFROM))
(LOADFNS1 VARS)))
(SETQ TEM (COND
(FILEMAP (CAR FILEMAP))
(T T)))
(SETQ FILEMAP (LOADFNSCAN FILEMAP))
(* SCANFILE0 rturns a 'map' for the file. The form of the map is (ADR ADRLST ADRLST ...) where ADR is last address
scanned to in file, or NIL if entire file was scanned, or (ADR) where the scan stopped after a function in the
middle of a DEFINEQ. Each ADRLST is either of the form (ADR1 ADR2 . FN) or (ADR1 ADR2 (FN ADRX . ADRY)
(FN ADRX . ADRY) ...) The first case corresponds to a compiled function, the second to a DEFINEQ.
In the first case, ADR1 is the address of the first character AFTER the function name in the file
(for use by LAPRD) and ADR2 the address of the first character after the de definition, i.e. aater LAPRD or LCSKIP
has finished. In the second case, ADR1 is the address of the lef paren before the DEFINEQ, and ADR2 either the
address of the first character after the entire DEFINEQ expression, or the address of the first chracter after the
last function that was scanned. In (FN ADRX . ADRY), ADR is the address of of the left prentheses before the
function name, ADRY the address of the character after the right paren that closes the definition.
-
A map of non-function's is not kept because (a) it would not be of use to MAKEFILE since it always recomputes VARS,
and (B) most requests for other than functions require scanning the entire file anyway, e.g. to find all RPAQQ's,
and (C) the expressions are usually small compared to DEFINEQ's.)
[COND
(FILEMAP
[COND
((NEQ TEM (CAR FILEMAP))
(* something was added)
(PUTFILEMAP FILE FILEMAP
FILECREATEDLST)
(AND UPDATEMAPFLG (UPDATEFILEMAP
FILE FILEMAP]
(COND
((AND DWIMFLG (LISTP FNLST))
[SETQ TEM
(for X in (CDR FILEMAP)
join (COND
((LISTP (SETQ TEM
(CDDR X)))
(for X in TEM
collect (CAR X)))
(TEM (LIST TEM]
(* makes a list of functions found for use for spelling correction.)
(AND
(SETQ TEM
(for X on FNLST
when
(AND
(NOT (FMEMB (CAR X)
TEM))
(SETQ X (FIXSPELL
(CAR X)
70 TEM NIL X)))
collect
(* The FMEMB check is necessary for when VARS=DEFS, as the reason that the function was not removed from FNLST may
have been because this was a compiled file.)
X))
(SCANFILE1 FILEMAP TEM]
[COND
((AND NOT-FOUNDTAG (LISTP FNLST))
(SETQ DONELST (CONS (CONS NOT-FOUNDTAG
FNLST)
DONELST]
[COND
([AND
NOT-FOUNDTAG
(LISTP VARLST)
(SETQ TEM
(COND
((FNTYP VARLST)
(AND (NULL DONELST)
(LIST VARLST)))
(T
(SUBSET
VARLST
(FUNCTION (LAMBDA (X)
(* Reason for this is if user says LOADVARS (DEFLIST file), then DEFLIST is not removed from VARLST, since you want
all such instances.)
(NOT
(SOME
DONELST
(FUNCTION (LAMBDA (Y)
(COND
[(ATOM X)
(OR
(EQ
X
(CAR Y))
(EQ
X
(CADR Y]
(T (EDIT4E X Y]
(SETQ DONELST (CONS (CONS NOT-FOUNDTAG TEM)
DONELST]
[COND
((EQ LDFLG (QUOTE SYSLOAD))
(AND (NOT (MEMB (SETQ ROOTNAME
(ROOTFILENAME
FILE
(CDR FILECREATEDLST)))
SYSFILES))
(SETQ SYSFILES (NCONC1 SYSFILES
ROOTNAME)))
(SMASHFILECOMS ROOTNAME))
(FILEPKGFLG
(AND (NEQ VARS (QUOTE FILEMAP))
(NEQ LDFLG (QUOTE EXPRESSIONS))
(NEQ LDFLG (QUOTE GETDEF))
(ADDFILE FILE
(SELECTQ
VARS
((T LOADFROM)
(QUOTE LOADFNS))
(LOADCOMP (QUOTE LOADCOMP))
(QUOTE loadfns))
PRLST FILECREATEDLST]
(RETURN (COND
((EQ VARS (QUOTE FILEMAP))
FILEMAP)
((EQ VARS (QUOTE LOADFROM))
FILE)
(T (DREVERSE DONELST])
(LOADFNS0
[LAMBDA (FN) (* wt: "14-NOV-78 02:04")
(RESETVARS ((DWIMFLG T)
(FILEPKGFLG T))
(RETURN (OR (EDITLOADFNS? FN)
(AND (EQ (NARGS (QUOTE WHEREIS))
4)
(EDITLOADFNS? FN NIL NIL T))
(ERROR FN (QUOTE "'s file not found")
T])
(LOADFNS1
[LAMBDA (X FNSFLG) (* wt: " 6-MAR-80 11:14")
(COND
((EQ X T)
(* Eleanor's option, load every fn found in FILE.)
T)
((NULL X)
NIL)
((LITATOM X)
(LIST X))
((NLISTP X)
(ERROR (QUOTE "illegal arg")
X))
[(NULL FNSFLG)
(MAPCAR X (FUNCTION (LAMBDA (X)|
(EDITFPAT X]|
(T (MAPCONC X (FUNCTION (LAMBDA (X)
(COND
((LITATOM X)
(LIST X))
(T (LISPXPRIN2 X T T)
(LISPXPRIN1 (QUOTE " isn't a function name -- ignored.
"))
NIL])
(GETBLOCKDEC
[LAMBDA (FN FILE FNSONLY) (* lmm " 7-SEP-78 18:39")
(PROG (BLOCKS BLOCK)
(OR FILE (SETQ FILE (LOADFNS0 FN)))
(AND [LISTP (SETQ BLOCKS (FILECOMSLST FILE (QUOTE BLOCKS]
[SOME BLOCKS (FUNCTION (LAMBDA (X)
(MEMB FN (SETQ BLOCK X]
(RETURN (COND
((NULL FNSONLY)
BLOCK)
(T (OR [AND (CAR BLOCK)
(SETQ BLOCKS (SUBSET (CDR BLOCK)
(FUNCTION ATOM]
(LIST FN])
(LOADFNSCAN
[LAMBDA (DICT) (* wt: " 7-DEC-79 11:57")
(PROG (ADR)
(SCANFILE0)
(RETURN DICT])
(SCANFILE0
[LAMBDA NIL (* rmk: "21-FEB-83 00:20")
(PROG (NXT NXT1 NXT2 FNADRLST (DICT0 (CDR DICT)))
[COND
[(NULL DICT)
(AND BUILDMAPFLG (SETQ DICT (LIST 0]
(FNLST (SCANFILE1 (CDR DICT]
(COND
([AND (NULL VARLST)
(OR (NULL FNLST)
(AND DICT (NULL (CAR DICT]
(* Either all functions were found, or else the entire file having been scaaned, no point in scanning further)
(RETURN DICT)))
(COND
((AND VARLST (NEQ VARLST (QUOTE FILEMAP)))
(* Note that at this point there may or may not be some functions to be scanned for. in any event, since there are
VARS to be obtained, we have to start scanning at the beginning, although DICT can be of use to save scanning of
DEFINEQ's.)
(SETFILEPTR NIL 0))
((LISTP (CAR DICT)) (* The scan stopped in the middle of a DEFINEQ.)
(SETFILEPTR NIL (SETQ ADR (CAAR DICT)))
[AND BUILDMAPFLG (SETQ FNADRLST
(LCONC NIL (CAR (LAST DICT]
(SETQ DICT0 NIL)
(SCANDEFINEQ T))
(DICT (* Scan stopped after a compiled function.)
(SETFILEPTR NIL (CAR DICT))
(SETQ DICT0 NIL)))
PEEKLP
(SETQ NXT (SKIPSEPRS NIL FILERDTBL))
(SETQ NXT1 (CHCON1 NXT))
(COND
[(OR (SYNTAXP NXT1 (QUOTE LEFTPAREN)
FILERDTBL)
(SYNTAXP NXT1 (QUOTE LEFTBRACKET)
FILERDTBL)) (* Opening paren and bracket.)
(SETQ ADR (GETFILEPTR))
(READC) (* Flush the peeked-at paren.)
(SETQ NXT1 (RATOM NIL FILERDTBL))
(COND
((EQ NXT1 (QUOTE DEFINEQ))
(SCANDEFINEQ))
(T
(* some functions may be inside of declare:'s so have to look at each expression, even if varlst=NIL)
(SETQ NXT2 (RATOM NIL FILERDTBL))
(* Corresponds to CADR of the expression.
in the file)
(SETFILEPTR NIL ADR) (* file pointer now points to just before the expression..)
(SCANEXP NXT1 NXT2 (NEQ VARLST (QUOTE LOADCOMP]
((OR (EQ (SETQ NXT (READ NIL FILERDTBL))
(QUOTE STOP))
(NULL NXT)) (* End of file.)
(AND (CAR DICT)
(RPLACA DICT NIL)) (* says scan of entire map now complete)
(RETURN))
((LITATOM NXT)
(SETQ ADR (GETFILEPTR))
(SCANCOMPILEDFN NXT)))
(GO PEEKLP])
(SCANCOMPILEDFN
[LAMBDA (FNAME) (* wt: " 9-APR-80 20:54")
(PROG NIL
[COND
(DICT0 (AND (NOT (EQP (CAAR DICT0)
ADR))
[NOT (SETQ DICT0 (SOME DICT0 (FUNCTION (LAMBDA (X)
(IEQP ADR (CAR X]
(RETRYSCAN))
(* redudnacy check the SOME is bcause of the (admittedly obsucre but actually happened) case where there are |
DEFINEQ's inside of a DECLARE:.. in this case, they would appear on the filemap, but DICT0 would not have been |
stepped because the DEFINIEQ's would not have been seen in the scan.)
(SETFILEPTR NIL (CADAR DICT0))
(* We know this function is not of interest, or it ould have been picked up in SCANFILE1. Furthermore, we know its |
final address, so no need to LCSKIP)
(SETQ DICT0 (CDR DICT0))
(RETURN T))
(BUILDMAPFLG (NCONC1 DICT (SETQ FNADRLST (CONS (GETFILEPTR)
(CONS NIL FNAME]
[COND
[[AND FNLST (NEQ LDFLG (QUOTE EXPRESSIONS))
(NEQ LDFLG (QUOTE GETDEF))|
(NEQ VARS (QUOTE LOADCOMP))
(OR (EQ FNLST T)
(MEMB FNAME FNLST)
(SOME FNLST (FUNCTION (LAMBDA (X)
(TMPSUBFN FNAME X] (* We want FNAME if it is on FNLST, or a SUBFN of |
anything on FNLST. or if FNLST, is T, i.e. load |
everything.)
(LAPRD FNAME)
(SETQ DONELST (CONS FNAME DONELST))
[AND FNADRLST (RPLACA (CDR FNADRLST)
(SETQ ADR (GETFILEPTR]
(COND
((AND (NEQ FNLST T)
(NULL (SETQ FNLST (DREMOVE FNAME FNLST)))
(NULL VARLST))
(AND DICT (RPLACA DICT ADR))
(RETFROM (QUOTE SCANFILE0]
(T (LCSKIP FNAME)
(AND FNADRLST (RPLACA (CDR FNADRLST)
(GETFILEPTR]
(RETURN T])
(SCANDEFINEQ
[LAMBDA (CONTINUEFLG) (* wt: " 9-APR-80 20:54")
(* L called with file pointer just after atom DEFINEQ)
(PROG (FNAME TEM)
(COND
(CONTINUEFLG (GO DEFQLP))
([AND DICT0 (NOT (EQP (CAAR DICT0)
ADR))
(NOT (SETQ DICT0 (SOME DICT0 (FUNCTION (LAMBDA (X)
(IEQP ADR (CAR X]
(RETRYSCAN)))
(* Double check. the SOME is bcause of the (admittedly obsucre but actually happened) case where there are DEFINEQ's
inside of a DECLARE:.. in this case, they would appear on the filemap, but DICT0 would not have been stepped because
the DEFINIEQ's would not have been seen in the scan. Now we know that CAR of DICT0 corrresponds to this DEFINEQ.
We process DEFINEQ's the same when there are functions to be found, i.e. when FNLST is non-NIL, as when there aren't
any, on the grounds that it takes about as long to do many little SKREAD's as one big SKREAD, and this way we also
get to build the map.)
[COND
((CADAR DICT0)
(* This entire DEFINEQ was scanned, and ADR is the address of the first character after it. SFPTR and go on, i.e. |
dont have to do SKREAD Note thatthis applies even if we are looking for functions,, i.e. FNLST not NIL, because in |
this case all function of interest would have been picked up by SCANFILE1.)
(SETFILEPTR NIL (CADAR DICT0))
(SETQ DICT0 (CDR DICT0))
(RETURN T))
(DICT0
(* The scan previously stopped in the middle of a DEFINEQ. The address of the end of the scan, i.e. |
(CAAR DICT), corresponds to the character after the last function scanned.)
[SETFILEPTR NIL (COND
((LISTP (CAR DICT))
(CAAR DICT))
(T
(* Another redudancy check. If the entire DEFINEQ had been processed, then CADAR of DICT0 would be non-NIL, and
caught above. Therefore, processing stopped in the middle of the DEFINEQ, and CAR of DICT should be a list.)
(RETRYSCAN]
[AND BUILDMAPFLG (SETQ FNADRLST (LCONC NIL (CAR DICT0]
(SETQ DICT0 NIL))
(BUILDMAPFLG (SETQ FNADRLST (TCONC NIL ADR))
(TCONC FNADRLST NIL)
(NCONC1 DICT (CAR FNADRLST]
DEFQLP
(SELECTQ (RATOM NIL FILERDTBL)
(%) (* Closes DEFINEQ.)
(AND FNADRLST (RPLACA (CDAR FNADRLST)
(GETFILEPTR)))
(* FNADRLST is a ONC format list, hence want to RPLACA |
CDAR, not just CDR.)
(RETURN T))
(%] (SCANFILEHELP))
[(%( %[)
(SETQ ADR (SUB1 (GETFILEPTR))) (* The address of the position of the left paren.)
(SETQ FNAME (READ NIL FILERDTBL))
(AND FNADRLST (TCONC FNADRLST (LIST FNAME ADR]
(SCANFILEHELP))
(SETFILEPTR NIL ADR)
(* Positions file pointer at left paren or brakcet so if fn/def pair is closed bby either right paren or bracket, |
read or skread will do the right thing.)
(COND
[(AND FNLST (OR (EQ FNLST T)
(MEMB FNAME FNLST)))
(SELECTQ VARS
(LOADCOMP (AND (NOT (FMEMB FNAME NOFIXFNSLST))
(SETQ NOFIXFNSLST (CONS FNAME NOFIXFNSLST)))
(SKREAD))
(SETQ DONELST (NCONC [COND
((OR (EQ LDFLG (QUOTE EXPRESSIONS))|
(EQ LDFLG (QUOTE GETDEF)))|
(LIST (READ NIL FILERDTBL)))
(T (DEFINE (LIST (READ NIL FILERDTBL]
DONELST)))
(AND (NEQ FNLST T)
(SETQ FNLST (DREMOVE FNAME FNLST]
(T (SKREAD)))
(AND FNADRLST (RPLACD (CDADR FNADRLST)
(GETFILEPTR)))
(* FNADRLST is a TCONC format, so its CADR is its last element. This is supposed to be of the form |
(FN ADRX . ADRY). This adds the ADRY.)
[COND
((AND (NULL FNLST)
(NULL VARLST))
(* Actually this check only need be made in the case that a function was actually read, i.e. second clause in above
|
COND, but its cheap enough.)
[AND DICT (RPLACA DICT (LIST (ADD1 (GETFILEPTR]
(* says scan stopped in middle of defineq)
(RETFROM (QUOTE SCANFILE0]
(GO DEFQLP])
(SCANEXP
[LAMBDA (EXP1 EXP2 EVALFLG) (* rmk: " 3-Jan-84 13:45")
(* exp1 is car of the expression, exp2 cadr. file pointer is just before opening left paren and scanexp reads
expression if it needs to.)
(DECLARE (USEDFREE FILECREATEDLST))
(PROG (EXP)
(COND
((EQ VARLST (QUOTE COMPILING)) (* wants whole declare:)
(GO YES))
((EQ EXP1 (QUOTE DECLARE:))
(COND
(EXP (SETFILEPTR NIL ADR)))
(RATOM NIL FILERDTBL)
(RATOM NIL FILERDTBL) (* SKIP OVER THE PAREN AND THE DECLARE:)
(SCANDECLARE: EVALFLG)
(RETURN T)))
(SELECTQ VARLST
((T LOADFROM)
(AND EVALFLG (GO YES)))
[VARS (AND EVALFLG (COND
((OR (EQ EXP1 (QUOTE RPAQQ))
(EQ EXP1 (QUOTE RPAQ))
(EQ EXP1 (QUOTE RPAQ?)))
(GO YES]
(LOADCOMP (AND EVALFLG (GO YES))
(SELECTQ EXP1
[(RPAQQ RPAQ RPAQ?)
(SETQ NOFIXVARSLST (AND (NOT (FMEMB EXP2 NOFIXVARSLST))
(CONS EXP2 NOFIXVARSLST]
NIL))
(AND (LISTP VARLST)
[COND
((FNTYP VARLST)
(COND
((NULL (SETQ EXP (APPLY* VARLST EXP1 EXP2)))
(* the functional expression is ree to move filepinter.)
(SETFILEPTR NIL ADR)
NIL)
((NLISTP EXP) (* matched, but user elected not to return entire
expression)
(SETFILEPTR NIL ADR)
(SETQ EXP (READ NIL FILERDTBL)))
(T T)))
(T (SOME VARLST (FUNCTION (LAMBDA (X)
(COND
((OR (EQ EXP1 X)
(EQ EXP2 X)))
((LISTP X) (* edit pattern)
[COND
((NULL EXP)
(* The expression on VARLST is a list, which is interpred as an edit pattern, therefore we have to read the entire
expression from the file. Note that this is only done once, i.e. if there are several patterns on VARLST, the
expression from the file is read only once.)
(SETQ EXP (READ NIL FILERDTBL]
(EDIT4E X EXP]
(GO YES)))
(COND
((EQ EXP1 (QUOTE FILECREATED))
[SETQ FILECREATEDLST (NCONC1 FILECREATEDLST (CDR (OR EXP (SETQ EXP (READ NIL FILERDTBL]
(* So that ADDFILE will have necessary information when
it is called.)
(FILECREATED1 (CDR EXP)) (* does error checking on filecreated expression)
)
((NULL EXP)
(SKREAD)))
(RETURN T)
YES (* This IS one of the expressions specified by VARLST.)
[COND
((NULL EXP)
(* If EXP is non-null, means for some eason it had to be READ, e.g. there was an dit pattern in VARLST.
IN this case not necessary to SKREAD since we have already passed over that expression.)
(SETQ EXP (READ NIL FILERDTBL]
[COND
((AND (NEQ VARLST (QUOTE LOADFROM))
(NEQ VARLST (QUOTE LOADCOMP)))
(SETQ DONELST (CONS EXP DONELST]
(COND
((AND (NEQ LDFLG (QUOTE EXPRESSIONS))
(NEQ LDFLG (QUOTE GETDEF)))
(EVAL EXP)))
(RETURN T])
(SCANDECLARE:
[LAMBDA (EVALFLG) (* lmm "17-APR-81 21:02")
(* handles DECLARE:'s only called for either VARS=COMP, or for looking for specific expression or expresions, e.g.
VARS, or edit pattern. For EXPRESSIONS, T, etc., higher call to SCANEXP has already decided what to do.)
(PROG (TEM)
LP (SETQ ADR (GETFILEPTR))
[SELECTQ (SETQ TEM (RATOM NIL FILERDTBL))
((%( %[)
(SETQ ADR (SUB1 (GETFILEPTR)))
(* reason for this is that there may have been some separators before the %(, e.g. a space and c.r., and in this
case the ADR will not match up with what was stored in the file map, which would be the position justbefore the %(.
The right way to do this is of course not to RATOM but to do a loop with peekc until you ee a non-separator and then
record the address. however, thi is inefficient and unnecessary since this is the nly case where it matters)
(SELECTQ (SETQ TEM (RATOM NIL FILERDTBL))
(DEFINEQ (PROG ((ADR ADR))
(SCANDEFINEQ)
(* easier to call scandefineq even if FNS is NIL because it knows how to position file pointer without aving to call
skread by using filemap)
)
[COND
((AND EVALFLG (EQ VARLST (QUOTE LOADCOMP))
(EQ FNLST T))
(* LOADCOMP is handled specially. the SCANDEFINEQ would not have actually done
any defining, just scanned for the purposes of constructing the map.)
(SETFILEPTR NIL ADR)
(SETQ TEM (READ NIL FILERDTBL))
(COND
((OR (EQ LDFLG (QUOTE EXPRESSIONS))
(EQ LDFLG (QUOTE GETDEF)))
(SETQ DONELST (CONS TEM DONELST)))
(T (EVAL TEM])
(DECLARE: (SCANDECLARE: EVALFLG))
(SCANEXP TEM (PROG1 (RATOM NIL FILERDTBL)
(SETFILEPTR NIL ADR))
EVALFLG)))
((%) %])
(RETURN T))
(COND
((NEQ LDFLG (QUOTE GETDEF))
(* getdef means ignore tags, find it if its there.)
(SELECTQ TEM
((EVAL@COMPILE DOEVAL@COMPILE)
(AND (EQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG T)))
(DONTEVAL@COMPILE (AND (EQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG NIL)))
((EVAL@LOAD DOEVAL@LOAD)
(AND (NEQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG T)))
(DONTEVAL@LOAD (AND (NEQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG NIL)))
[EVAL@COMPILEWHEN (SETQ TEM (READ NIL FILERDTBL))
(AND (EQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG (EVAL TEM]
[EVAL@LOADWHEN (SETQ TEM (READ NIL FILERDTBL))
(AND (NEQ VARLST (QUOTE LOADCOMP))
(SETQ EVALFLG (EVAL TEM]
(COPYWHEN (SKREAD))
NIL]
(GO LP])
(SCANFILE1
[LAMBDA (DICT LST) (* wt: " 9-APR-80 20:56")
(AND (NULL LST)
(SETQ LST FNLST)) (* looks up functions on LST, if given, but removes them
from FNLST. This so can be called directly from
LOADFNS.)
(PROG (($$LST1 DICT)
X FNAME TEM)
$$LP(SETQ X (CAR $$LST1))
(COND
((OR (NLISTP $$LST1)
(NOT LST))
(RETURN NIL)))
(COND
[(NLISTP (SETQ FNAME (CDDR X))) (* compiled definition.)
(COND
((OR (EQ LDFLG (QUOTE EXPRESSIONS))
(EQ LDFLG (QUOTE GETDEF))|
(EQ VARS (QUOTE LOADCOMP))) (* User wants symbolic definitions only.)
)
([OR (EQ LST T)
(MEMB FNAME LST)
(SOME LST (FUNCTION (LAMBDA (Y)
(TMPSUBFN FNAME Y]
(SETFILEPTR NIL (CAR X))
(COND
([NOT (OR (EQ (SETQ TEM (READ NIL FILERDTBL))
(QUOTE BINARY))
(GETPROP TEM (QUOTE CODEREADER]
(* a file map was built in core, but it isnt right, e.g. user ftped another file by same name since this map was
built in core. so remove map and retry)
(RETRYSCAN)))
(SETFILEPTR NIL (CAR X))
(LAPRD FNAME)
(AND (OR (EQ DFNFLG (QUOTE PROP))
(EQ DFNFLG (QUOTE ALLPROP)))
(UNSAVEDEF FNAME))
(SCANFILE2 FNAME]
(T (* DEFINEQ.)
(for Y in (CDDR X) do [COND
[(EQ VARS (QUOTE LOADCOMP))
(AND (NOT (FMEMB (CAR Y)
NOFIXFNSLST))
(SETQ NOFIXFNSLST (CONS (CAR Y)
NOFIXFNSLST]
((OR (EQ LST T)
(MEMB (CAR Y)
LST))
(SETFILEPTR NIL (CADR Y))
(COND
([NEQ (CAR Y)
(CAR (SETQ TEM (READ NIL FILERDTBL]
(ERROR (QUOTE "filemap does not agree with contents of")
(INPUT)
T)))
(COND
((OR (EQ LDFLG (QUOTE EXPRESSIONS))|
(EQ LDFLG (QUOTE GETDEF)))|
(SCANFILE2 TEM))
(T (DEFINE (LIST TEM))
(SCANFILE2 (CAR TEM]
while LST)))
$$ITERATE
(SETQ $$LST1 (CDR $$LST1))
(GO $$LP])
(SCANFILE2
[LAMBDA (X)
(SETQ DONELST (CONS X DONELST))
(AND (NEQ FNLST T)
(SETQ FNLST (DREMOVE (COND
((LISTP X)
(CAR X))
(T X))
FNLST])
(TMPSUBFN
(LAMBDA (X FN) (* JonL "15-Dec-83 21:48")
(* This guy wants names like FNAnnnnAmmmm...)
(PROG ((N (STRPOS FN X 1 NIL T T))
NX)
(OR N (RETURN))
(OR (ZEROP (IMOD (IDIFFERENCE (SETQ NX (ADD1 (NCHARS X)))
N)
5))
(RETURN))
LP (if (OR (NEQ (NTHCHARCODE X N)
(CHARCODE A))
(find I C from 1 to 4 suchthat (OR (NULL (SETQ C (NTHCHARCODE X (IPLUS I N))))
(ILESSP C (CHARCODE 0))
(IGREATERP C (CHARCODE 9)))))
then (RETURN)
elseif (IGEQ (add N 5)
NX)
then (RETURN T))
(GO LP))))
(RETRYSCAN
[LAMBDA NIL (* wt: "27-DEC-79 22:37")|
(PROG (TEM)|
(COND|
((GETPROP (SETQ TEM (NAMEFIELD FILE T))|
(QUOTE FILEMAP))|
(REMPROP TEM (QUOTE FILEMAP))|
(PRIN1 "something is wrong with the filemap for " T)|
(PRINT FILE T)|
(PRIN1 "rebuilding map..." T)|
(RETFROM (QUOTE LOADFNSCAN)|
(LOADFNSCAN)))|
(T (SCANFILEHELP])
(SCANFILEHELP
(LAMBDA NIL (* JonL "15-Dec-83 21:04")
(* This function used to spit out a "sermon" about
sysouting and informing W. Teitelman.)
(PRIN1 (QUOTE "something is wrong with either the filemap or format of ")
T)
(PRIN1 (INPUT)
T)
(TERPRI T)
(PRIN1 (QUOTE
"Here are some possibilities:
(1) you edited the file with a text editor;
(2) you printed a DEFINEQ in the file directly, i.e. without using
the FNS command;
(3) the file got clobbered.
If you are convinced it is none of the above, then please inform
the 1100Support program.")
T)
(TERPRI T)
(PRIN1 (QUOTE
"Note: for (1) and (2), you may still be
able to use this file by setting USEMAPFLG to NIL,
and then reexecuting the operation that caused this
message.")
T)
(TERPRI T)
(HELP)))
)
(RPAQQ NOT-FOUNDTAG NOT-FOUND:)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: SCANFILEBLOCK LOADFNSCAN SCANFILE0 SCANCOMPILEDFN SCANDEFINEQ SCANEXP SCANDECLARE: SCANFILE1
SCANFILE2 TMPSUBFN (LOCALFREEVARS FNADRLST DICT DICT0 ADR)
(SPECVARS LDFLG PRINTFLG FNS FNLST VARLST VARS DONELST)
(GLOBALVARS SYSFILES FILEPKGFLG DWIMFLG ADDSPELLFLG BUILDMAPFLG NOFIXVARSLST NOFIXFNSLST
DFNFLG FILERDTBL LOADOPTIONS UPDATEMAPFLG)
(ENTRIES LOADFNSCAN TMPSUBFN SCANFILE1)
(RETFNS SCANFILE0))
(BLOCK: NIL LOADFROM (GLOBALVARS LASTWORD DWIMFLG))
(BLOCK: NIL LOADFNS LOADFNS0 LOADFNS1 (GLOBALVARS DWIMFLG UPDATEMAPFLG BUILDMAPFLG FILEPKGFLG
ADDSPELLFLG LOADOPTIONS SYSFILES DFNFLG
NOT-FOUNDTAG))
(BLOCK: NIL LOADFILEMAP (GLOBALVARS UPDATEMAPFLG))
]
(PUTPROPS LOADFNS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1332 32602 (LOADFROM 1342 . 1707) (LOADBLOCK 1709 . 2011) (LOADCOMP 2013 . 2413) (
LOADCOMP? 2415 . 2977) (LOADVARS 2979 . 3057) (LOADEFS 3059 . 3201) (LOADFILEMAP 3203 . 3615) (LOADFNS
3617 . 11415) (LOADFNS0 11417 . 11739) (LOADFNS1 11741 . 12362) (GETBLOCKDEC 12364 . 12847) (
LOADFNSCAN 12849 . 13019) (SCANFILE0 13021 . 15573) (SCANCOMPILEDFN 15575 . 17388) (SCANDEFINEQ 17390
. 21815) (SCANEXP 21817 . 25142) (SCANDECLARE: 25144 . 27977) (SCANFILE1 27979 . 30230) (SCANFILE2
30232 . 30404) (TMPSUBFN 30406 . 31159) (RETRYSCAN 31161 . 31656) (SCANFILEHELP 31658 . 32600)))))
STOP