(FILECREATED "23-JUL-83 16:12:31" <NEWLISP>BOOTSTRAP.;1 22937
changes to: (FNS RPAQ RPAQ?)
previous date: "18-MAR-83 19:35:07" <LISP>BOOTSTRAP.;157)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT BOOTSTRAPCOMS)
(RPAQQ BOOTSTRAPCOMS ((FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? PUTDQ? SELECTQ SELECTQ1
NCONC1 PUTPROP PUTPROPS PROPNAMES ADDPROP REMPROP NAMEFIELD FILECREATED
FILECREATED1 DECLARE: DECLARE:1 LOAD ROOTFILENAME MEMB)
[P [MAPC (QUOTE ((PUTD . /PUTD)
(PUTPROP . /PUTPROP)
(PUTPROP . PUT)
(PUT . /PUT)
(PRIN1 . LISPXPRIN1)
(PRIN2 . LISPXPRIN2)
(PRINT . LISPXPRINT)
(TERPRI . LISPXTERPRI)
(SPACES . LISPXSPACES)
(GETPROP . GETP)
(SET . SAVESET)
(NILL . MISSPELLED?)))
(FUNCTION (LAMBDA (X)
(OR (CCODEP (CDR X))
(MOVD (CAR X)
(CDR X]
[PUTDQ? STRPOS (LAMBDA (X Y START SKIP ANCHOR TAIL)
[COND [(LITATOM X)
(SETQ X (CDR (VAG (IPLUS (LOC X)
2]
((NULL (STRINGP X))
(SETQ X (MKSTRING X]
[COND ((STRINGP Y))
[(LITATOM Y)
(SETQ Y (CDR (VAG (IPLUS (LOC Y)
2]
(T (SETQ Y (MKSTRING Y]
[COND (SKIP (SETQ SKIP (NTHCHAR SKIP 1]
(COND [START (COND ((MINUSP START)
(SETQ START (IPLUS START (NCHARS Y)
1]
(T (SETQ START 1)))
(SETQ Y (SUBSTRING Y START))
(PROG ((N START)
W X1 Y1)
L2
(SETQ X1 (SUBSTRING X 1))
(SETQ Y1 (SUBSTRING Y 1))
LP
(COND [(SETQ W (GNC X1))
(COND ((EQ W (GNC Y1))
(GO LP))
((EQ W SKIP)
(GO LP))
(T (GO NX]
(TAIL (RETURN (IPLUS (NCHARS X)
N)))
(T (RETURN N)))
NX
(COND (ANCHOR (RETURN)))
(COND ((GNC Y)
(SETQ N (ADD1 N))
(GO L2))
(T (RETURN]
(PUTDQ? PACKFILENAME [LAMBDA (X)
X])
(PUTDQ? UNPACKFILENAME [LAMBDA (X)
X])
(PUTDQ? RESETRESTORE (LAMBDA (RESETVARSLST0 RESETSTATE)
(PROG (RESETZ)
LP
(COND ((AND RESETVARSLST (NEQ RESETVARSLST
RESETVARSLST0))
(SETQ RESETZ (CAR RESETVARSLST))
(SETQ RESETVARSLST (CDR RESETVARSLST))
[COND ((LISTP (CAR RESETZ))
(APPLY (CAAR RESETZ)
(CDR (CAR RESETZ]
(GO LP]
(INITVARS (EOLCHARCODE (CHCON1 (QUOTE %
)))
(PRETTYHEADER)
(DWIMFLG)
(UPDATEMAPFLG)
(DFNFLG)
(ADDSPELLFLG)
(BUILDMAPFLG)
(FILEPKGFLG)
(SYSFILES)
(NOTCOMPILEDFILES)
(RESETVARSLST))
[VARS [FILERDTBL (OR (READTABLEP (EVALV (QUOTE FILERDTBL)))
(COPYREADTABLE (QUOTE ORIG]
(LISPXHIST)
(LISPXPRINTFLG T)
(PRETTYHEADER "FILE CREATED ")
(EDITRDTBL (COPYREADTABLE T))
(BELLS (QUOTE ""))
(LOADOPTIONS (QUOTE (SYSLOAD NIL T PROP ALLPROP]
(GLOBALVARS FILEPKGFLG PRETTYHEADER DWIMFLG PRETTYHEADER UPDATEMAPFLG LOADOPTIONS FILERDTBL
DFNFLG ADDSPELLFLG BUILDMAPFLG FILEPKGFLG SYSFILES)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DECLARE: FILECREATED PUTPROPS SELECTQ)
(NLAML PUTDQ? RPAQ? RPAQ RPAQQ)
(LAMA)))
(P (PRINTLEVEL 1000)
(RADIX 10)
(SETSEPR (QUOTE (20 124))
1 FILERDTBL))))
(DEFINEQ
(GETPROP
(LAMBDA (ATM PROP) (* Used to be called GETP)
(AND (LITATOM ATM)
(PROG NIL
(SETQ ATM (GETPROPLIST ATM))
LOOP(COND
((OR (NLISTP ATM)
(NLISTP (CDR ATM)))
(RETURN NIL))
((EQ (CAR ATM)
PROP)
(RETURN (CADR ATM))))
(SETQ ATM (CDDR ATM))
(GO LOOP)))))
(SETATOMVAL
[LAMBDA (X Y) (* wt: 27-JAN-76 23 20)
(* dummy defiition so
rpaqq will work.)
(COND
((GETD (QUOTE VCTOAC))
(SET X Y))
(T (SETTOPVAL X Y])
(RPAQQ
[NLAMBDA (X Y)
(SETATOMVAL X Y])
(RPAQ
[NLAMBDA (RPAQX RPAQY) (* lmm "23-JUL-83 16:10")
(* RPAQ and RPAQQ are used by PRETTYDEF to save VARS.)
(SETTOPVAL RPAQX (EVAL RPAQY])
(RPAQ?
[NLAMBDA (RPAQX RPAQY) (* lmm "23-JUL-83 16:12")
(* RPAQ? and RPAQQ are used by PRETTYDEF to save VARS.)
(OR (NEQ (GETTOPVAL RPAQX)
(QUOTE NOBIND))
(SETTOPVAL RPAQX (EVAL RPAQY])
(MOVD
[LAMBDA (FROM TO COPYFLG) (* wt: "15-JAN-79 23:00")
(PROG [(NEWFLG (NULL (GETD TO]
[PUTD TO (COND
(COPYFLG (COPY (VIRGINFN FROM)))
|
(T (GETD FROM]
(AND FILEPKGFLG (EXPRP TO)
(MARKASCHANGED TO (QUOTE FNS)
NEWFLG))
(RETURN TO])
(MOVD?
[LAMBDA (FROM TO COPYFLG) (* wt: "25-JAN-79 18:30")
(* Like MOVD but only does it if TO is not defined.)
(PROG [(NEWFLG (NULL (GETD TO]
(RETURN (COND
((NULL (GETD TO))
[PUTD TO (COND
(COPYFLG (COPY (VIRGINFN FROM)))
|
(T (GETD FROM]
(AND FILEPKGFLG (EXPRP TO)
(MARKASCHANGED TO (QUOTE FNS)
NEWFLG))
TO])
(PUTDQ?
[NLAMBDA (FN DEF)
(AND (NULL (GETD FN))
(PUTD FN DEF])
(SELECTQ
[NLAMBDA SELCQ
(APPLY (QUOTE PROGN)
(SELECTQ1 (EVAL (CAR SELCQ)
(QUOTE SELECTQ))
(CDR SELCQ))
(QUOTE SELECTQ])
(SELECTQ1
[LAMBDA (M L)
(PROG (C)
LP (SETQ C L)
[COND
((NULL (SETQ L (CDR L)))
(RETURN C))
([OR (EQ (CAR (SETQ C (CAR C)))
M)
(AND (LISTP (CAR C))
(FMEMB M (CAR C]
(RETURN (CDR C]
(GO LP])
(NCONC1
[LAMBDA (LST X)
(* included in wtmisc so can make the call to nconc be linked. so that user can then break on nconc.)
(NCONC LST (FRPLACD (CONS X LST])
(PUTPROP
[LAMBDA (ATM PROP VAL)
(* Included because it must be defined before the MOVD's in BOOTSTRAPCOMS that initialize /PUTPROP are executed.)
[COND
[(NULL ATM)
(ERRORX (LIST 7 (LIST ATM PROP]
((NOT (LITATOM ATM))
(ERRORX (LIST 14 ATM]
(PROG ((X (GETPROPLIST ATM))
X0)
LOOP(COND
((NLISTP X)
(COND
((AND (NULL X)
X0)
(* typical case. property list ran out on an even parity position. e.g. (A B C D))
(FRPLACD (CDR X0)
(LIST PROP VAL))
(RETURN VAL)))
(* propety list was initially NIL or a non-list, or else it ended in a non-list following an even parity position,
e.g. (A B . C) fall through and add new property at beginning)
)
((NLISTP (CDR X))
(* property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g.
(A B C) or (A B C . D) fall through and add at beginning)
)
((EQ (CAR X)
PROP)
(FRPLACA (CDR X)
VAL)
(RETURN VAL))
(T (SETQ X (CDDR (SETQ X0 X)))
(GO LOOP)))
[SETPROPLIST ATM (CONS PROP (CONS VAL (GETPROPLIST ATM]
(RETURN VAL])
(PUTPROPS
[NLAMBDA X
(MAP (CDR X)
[FUNCTION (LAMBDA (Y)
(/PUT (CAR X)
(CAR Y)
(CADR Y]
(FUNCTION CDDR])
(PROPNAMES
[LAMBDA (ATM) (* wt: " 3-AUG-78 01:23")
(MAPLIST (GETPROPLIST ATM)
(FUNCTION CAR)
(FUNCTION CDDR])
(ADDPROP
[LAMBDA (ATM PROP NEW FLG)
(* If FLG is T, NEW is consed onto the front, otherwise NCONCED onto the end.)
(* Value is new PROP value.)
[COND
[(NULL ATM)
(ERRORX (LIST 7 (LIST PROP NEW]
((NOT (LITATOM ATM))
(ERRORX (LIST 14 ATM]
(PROG ((X (GETPROPLIST ATM))
X0)
LOOP(COND
((NLISTP X)
(COND
((AND (NULL X)
X0) (* typical case. property list ran out on an even parity position.)
[FRPLACD (CDR X0)
(LIST PROP (SETQ NEW (LIST NEW]
(RETURN NEW)))
(* proprty list was initially NIL or a non-lit, or ele it ended in a non-list following an even parity position,
e.g. (A B . C) fall through and add property at beginning of property list.)
)
((NLISTP (CDR X))
(* property list runs out on an odd parity, or else ends in a non-list following an odd parity, e.g.
(A B C) or (A B C . D) fall through and add at beginning)
)
((EQ (CAR X)
PROP) (* PROP found)
[FRPLACA (CDR X)
(SETQ NEW (COND
(FLG (CONS NEW (CADR X)))
(T (NCONC1 (CADR X)
NEW]
(RETURN NEW))
(T (SETQ X (CDDR (SETQ X0 X)))
(GO LOOP))) (* Add to beginning of property list.)
[SETPROPLIST ATM (CONS PROP (CONS (SETQ NEW (LIST NEW))
(GETPROPLIST ATM]
(RETURN NEW])
(REMPROP
[LAMBDA (ATM PROP)
[COND
((NULL (LITATOM ATM))
(ERRORX (LIST 14 ATM]
(PROG ((X (GETPROPLIST ATM))
X0 VAL)
LP [COND
((OR (NLISTP X)
(NLISTP (CDR X)))
(RETURN VAL))
((EQ (CAR X)
PROP)
(SETQ VAL PROP)
[COND
(X0 (FRPLACD (CDR X0)
(CDDR X)))
(T (SETPROPLIST ATM (CDDR X]
(SETQ X (CDDR X)))
(T (SETQ X (CDDR (SETQ X0 X]
(GO LP])
(NAMEFIELD
[LAMBDA (FILE SUFFIXFLG) (* lmm "13-MAR-83 23:57")
(* BOOTSTRAP VERSION)
(PROG (POS (START 1)
END)
(while (SETQ POS (OR (STRPOS (QUOTE })
FILE START)
(STRPOS (QUOTE >)
FILE START)
(STRPOS (QUOTE /)
FILE START)))
do (SETQ START (ADD1 POS)))
[COND
((SETQ POS (STRPOS (QUOTE ;)
FILE))
(SETQ END (SUB1 POS))
(COND
((EQ (NTHCHAR FILE END)
(QUOTE %.)) (* eliminates null suffix)
(SETQ END (SUB1 END]
[COND
((SETQ POS (STRPOS (QUOTE %.)
FILE START))
(COND
((NULL SUFFIXFLG)
(SETQ END (SUB1 POS]
(RETURN (MKATOM (SUBSTRING FILE START END])
(FILECREATED
[NLAMBDA X (* rmk: "20-FEB-83 22:26")
(DECLARE (USEDFREE FILECREATEDLST))
(PROG ((FILEDATE (CAR X))
(FILE (CADR X))
(MESS (FILECREATED1 X)))
(SETQ FILECREATEDLST (NCONC1 FILECREATEDLST X))
(* I (W.T) have tried to keep FILECREATED not dependent on the fact that it was evaluated while being loaded.
However, the same FILECREATED expression has to act differently when it appears in a compiled file than symbolic
file. In latter case it can use (INPUT) for name of file, thereby obtaning directory name if different.
in former case, it must obtain name of file from the expression itself. I suppose we could always dump out the
directory name but this would lose if user copied it to a different directory, and or version number.
The best thing is to go with INPUT for symbolic files, and go the best you can on compiled files, i.e. get version
number from the first filecreated expression. Thus simply putting the FILECREATED expression on FILEDATES as a
string initially and then, if filepkgflg is on, doing the full shtick when addfile is called seems best.)
(COND
(PRETTYHEADER
(* Presumably if user sets prettyheader to NIL, he doesnt want to see any file created messages, even those frm
compiled files.)
(LISPXPRIN1 MESS T)
(LISPXPRIN1 FILEDATE T)
(LISPXTERPRI T)))
(COND
((AND FILE (LITATOM FILE))
(* This is just temporary, primarily for keeping dates of system files which are loaded with FILEPKGFLG=NIL.
The real setting up of file property lists is done when ADDFILE is called.)
(/PUT (NAMEFIELD FILE)
(QUOTE FILEDATES)
(LIST (CONS FILEDATE FILE])
(FILECREATED1
[LAMBDA (X) (* rmk: "20-FEB-83 21:50")
(* performs error checking on filecreated expressions. returns the thing to be printed. used by filecreated, and
loadfns)
(PROG ((FILE (CADR X)))
(RETURN (COND
((STRINGP FILE) (* old way of doing COMPILED ON)
FILE)
((LISTP FILE)
(* New. also used for printing COMPILED ON message. CDR is a list of files that were compiled.)
(CAR FILE))
(T (* FILE is an atom, the name of the file)
PRETTYHEADER])
(DECLARE:
[NLAMBDA X (* wt: "20-OCT-77 13:00")
(DECLARE:1 X T])
(DECLARE:1
[LAMBDA (X EVALFLG) (* wt: "20-OCT-77 13:09")
(PROG NIL
LP (COND
((NLISTP X)
(RETURN))
[(LISTP (CAR X))
(AND EVALFLG (COND
((EQ (CAAR X)
(QUOTE DECLARE:))
(DECLARE:1 (CDAR X)
T))
(T (EVAL (CAR X]
(T (SELECTQ (CAR X)
((EVAL@LOAD DOEVAL@LOAD)
(SETQ EVALFLG T))
(EVAL@LOADWHEN (SETQ EVALFLG
(EVAL (CADR X)))
(SETQ X (CDR X)))
(DONTEVAL@LOAD (SETQ EVALFLG NIL))
NIL)))
(SETQ X (CDR X))
(GO LP])
(LOAD
[LAMBDA (FILE LDFLG PRINTFLG)
(DECLARE (SPECVARS FILE LDFLG PRINTFLG)
(GLOBALVARS PRETTYHEADER))
(* lmm "13-MAR-83 22:55")
(RESETVARS ((DFNFLG LDFLG)
(BUILDMAPFLG BUILDMAPFLG)
(FILEPKGFLG FILEPKGFLG)
(ADDSPELLFLG ADDSPELLFLG))
(RETURN (RESETLST (PROG [LOADA FILEMAP FNADRLST ADR ROOTNAME TEM FILECREATEDLST
(LISPXHIST LISPXHIST)
(PRLST (AND FILEPKGFLG (FILEPKGCHANGES]
(DECLARE (SPECVARS FILECREATEDLST))
TOP (COND
((FMEMB 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
((OPENP FILE (QUOTE INPUT))
(CLOSEF FILE)))
(RESETSAVE NIL (LIST (QUOTE INPUT)
(INFILE FILE)))
(SETQ FILE (INPUT))
(COND
(PRETTYHEADER (LISPXTERPRI T)
(LISPXPRINT FILE T)))
(COND
((EQ LDFLG (QUOTE SYSLOAD))
(SETQ DFNFLG T)
(SETQ ADDSPELLFLG NIL)
(SETQ BUILDMAPFLG NIL)
(SETQ FILEPKGFLG NIL)
(SETQ LISPXHIST NIL)))
[AND LISPXHIST (COND
((SETQ LOADA (FMEMB (QUOTE SIDE)
LISPXHIST))
(FRPLACA (CADR LOADA)
-1))
(T (LISPXPUT (QUOTE SIDE)
(LIST -1)
NIL LISPXHIST]
(* So that UNDOSAVE will keep saving regardless of how many undosaves are
involved)
[COND
((AND BUILDMAPFLG (RANDACCESSP FILE)
(OR (NLISTP (SETQ TEM (GETFILEMAP FILE)))
(CAR TEM)))
(* no map, or incomplete map on file)
(SETQ FILEMAP (TCONC NIL NIL]
LP [COND
(FILEMAP (SETQ LOADA (RATOM NIL FILERDTBL)))
(T (SETQ LOADA (READ NIL FILERDTBL]
[SELECTQ LOADA
((STOP NIL)
(COND
((EQ LDFLG (QUOTE SYSLOAD))
(AND (NOT (MEMB (SETQ ROOTNAME
(ROOTFILENAME FILE
(CDR
FILECREATEDLST)))
SYSFILES))
(SETQ SYSFILES (NCONC1 SYSFILES ROOTNAME)))
(SMASHFILECOMS ROOTNAME))
(FILEPKGFLG (ADDFILE FILE T PRLST FILECREATEDLST)
(* Do not want any items that are added to FILEPKGCHANGES as a result of being mentioned in this file to remain on
FILEPKGCHANGES. Also, we want items mentioned earlier to be deleted if they are taken care of by this file.
The extra argument to ADDFILE allows it to restore FILEPKGCHANGES to the intersection of its current value and its
previous value.)
))
[COND
(FILEMAP (PUTFILEMAP FILE (CAR FILEMAP)
FILECREATEDLST)
(COND
(UPDATEMAPFLG (SETFILEPTR FILE ADR)
(* address of last expression read. good hint for finding filemap)
(UPDATEFILEMAP
FILE
(CAR FILEMAP]
(RETURN (CLOSEF FILE)))
(COND
((AND (LITATOM LOADA)
(EQ (NCHARS LOADA)
1)
(OR (SYNTAXP (CHCON1 LOADA)
(QUOTE LEFTPAREN)
FILERDTBL)
(SYNTAXP (CHCON1 LOADA)
(QUOTE LEFTBRACKET)
FILERDTBL)))
(SETQ ADR (SUB1 (GETFILEPTR FILE)))
(COND
((EQ (RATOM NIL FILERDTBL)
(QUOTE DEFINEQ))
[COND
(FILEMAP (SETQ FNADRLST (TCONC NIL ADR))
(TCONC FNADRLST NIL)
(TCONC FILEMAP (CAR FNADRLST]
(GO DEFQLP)))
(SETFILEPTR FILE ADR)
(SETQ LOADA (EVAL (READ NIL FILERDTBL)))
(GO LP1))
((LISTP LOADA)
(* e.g. if filemap is nil, then we wold have just read the expresson)
(SETQ LOADA (EVAL LOADA))
(GO LP1]
(* Atom found. compiled code defintion.)
(COND
(ADDSPELLFLG (ADDSPELL LOADA)))
(SETQ ADR (GETFILEPTR FILE))
(LAPRD LOADA)
(* The system readtable is not reset for entire load so that if user does a setbrk or setsepr as result of load, he
wont clobber it. instead we reset the readtable before calling laprd and then restoreit. we are protected against
control-d or eror by resetsave on setreadtable at top of function. thus we dont have to do a resetform each time we
go in and out of laprd.)
[AND FILEMAP (TCONC FILEMAP (CONS ADR (CONS (GETFILEPTR FILE)
LOADA]
LP1 (COND
(PRINTFLG (PRINT LOADA T T)))
(GO LP)
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.)
(SETQ LOADA (DEFINE (DREVERSE LOADA)))
(GO LP1))
((%( %[)
(* function/definition pair)
[SETFILEPTR NIL (SETQ ADR (SUB1 (GETFILEPTR]
(* BAcks up over %( or %[. Done this way instead of PEEKC because RATOM will also skip over any separators between
last %) and next %(, such as c.r.)
(SETQ LOADA (CONS (READ NIL FILERDTBL)
LOADA))
[AND FNADRLST (TCONC FNADRLST
(CONS (CAAR LOADA)
(CONS ADR (GETFILEPTR]
(GO DEFQLP))
NIL)
(ERROR "illegal argument in defineq"])
(ROOTFILENAME
[LAMBDA (NAME COMPFLG) (* rmk: "20-FEB-83 21:35")
(* Returns the root of the filename NAME, the atom that all file package properties will be associated with.
If NAME names a compiled file, then COMPFLG~=NIL and we assume that the extension is COMPILE.EXT, which is to be
stripped off. We thus have something of an anomaly: We can keep track of 2 symbolic files whose names differ only
in extension, but we confuse them when we deal with their compiled versions.)
(NAMEFIELD NAME (NOT COMPFLG])
(MEMB
[LAMBDA (X Y)
(PROG NIL
LP (RETURN (COND
((NLISTP Y)
NIL)
((EQ X (CAR Y))
Y)
(T (SETQ Y (CDR Y))
(GO LP])
)
[MAPC (QUOTE ((PUTD . /PUTD)
(PUTPROP . /PUTPROP)
(PUTPROP . PUT)
(PUT . /PUT)
(PRIN1 . LISPXPRIN1)
(PRIN2 . LISPXPRIN2)
(PRINT . LISPXPRINT)
(TERPRI . LISPXTERPRI)
(SPACES . LISPXSPACES)
(GETPROP . GETP)
(SET . SAVESET)
(NILL . MISSPELLED?)))
(FUNCTION (LAMBDA (X)
(OR (CCODEP (CDR X))
(MOVD (CAR X)
(CDR X]
[PUTDQ? STRPOS (LAMBDA (X Y START SKIP ANCHOR TAIL)
[COND [(LITATOM X)
(SETQ X (CDR (VAG (IPLUS (LOC X)
2]
((NULL (STRINGP X))
(SETQ X (MKSTRING X]
[COND ((STRINGP Y))
[(LITATOM Y)
(SETQ Y (CDR (VAG (IPLUS (LOC Y)
2]
(T (SETQ Y (MKSTRING Y]
[COND (SKIP (SETQ SKIP (NTHCHAR SKIP 1]
(COND [START (COND ((MINUSP START)
(SETQ START (IPLUS START (NCHARS Y)
1]
(T (SETQ START 1)))
(SETQ Y (SUBSTRING Y START))
(PROG ((N START)
W X1 Y1)
L2
(SETQ X1 (SUBSTRING X 1))
(SETQ Y1 (SUBSTRING Y 1))
LP
(COND [(SETQ W (GNC X1))
(COND ((EQ W (GNC Y1))
(GO LP))
((EQ W SKIP)
(GO LP))
(T (GO NX]
(TAIL (RETURN (IPLUS (NCHARS X)
N)))
(T (RETURN N)))
NX
(COND (ANCHOR (RETURN)))
(COND ((GNC Y)
(SETQ N (ADD1 N))
(GO L2))
(T (RETURN]
(PUTDQ? PACKFILENAME [LAMBDA (X)
X])
(PUTDQ? UNPACKFILENAME [LAMBDA (X)
X])
[PUTDQ? RESETRESTORE (LAMBDA (RESETVARSLST0 RESETSTATE)
(PROG (RESETZ)
LP
(COND ((AND RESETVARSLST (NEQ RESETVARSLST RESETVARSLST0))
(SETQ RESETZ (CAR RESETVARSLST))
(SETQ RESETVARSLST (CDR RESETVARSLST))
[COND ((LISTP (CAR RESETZ))
(APPLY (CAAR RESETZ)
(CDR (CAR RESETZ]
(GO LP]
(RPAQ? EOLCHARCODE (CHCON1 (QUOTE %
)))
(RPAQ? PRETTYHEADER )
(RPAQ? DWIMFLG )
(RPAQ? UPDATEMAPFLG )
(RPAQ? DFNFLG )
(RPAQ? ADDSPELLFLG )
(RPAQ? BUILDMAPFLG )
(RPAQ? FILEPKGFLG )
(RPAQ? SYSFILES )
(RPAQ? NOTCOMPILEDFILES )
(RPAQ? RESETVARSLST )
(RPAQ FILERDTBL (OR (READTABLEP (EVALV (QUOTE FILERDTBL)))
(COPYREADTABLE (QUOTE ORIG))))
(RPAQQ LISPXHIST NIL)
(RPAQQ LISPXPRINTFLG T)
(RPAQ PRETTYHEADER "FILE CREATED ")
(RPAQ EDITRDTBL (COPYREADTABLE T))
(RPAQQ BELLS "")
(RPAQQ LOADOPTIONS (SYSLOAD NIL T PROP ALLPROP))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS FILEPKGFLG PRETTYHEADER DWIMFLG PRETTYHEADER UPDATEMAPFLG LOADOPTIONS FILERDTBL
DFNFLG ADDSPELLFLG BUILDMAPFLG FILEPKGFLG SYSFILES)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA DECLARE: FILECREATED PUTPROPS SELECTQ)
(ADDTOVAR NLAML PUTDQ? RPAQ? RPAQ RPAQQ)
(ADDTOVAR LAMA )
)
(PRINTLEVEL 1000)
(RADIX 10)
(SETSEPR (QUOTE (20 124))
1 FILERDTBL)
(PUTPROPS BOOTSTRAP COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3310 19910 (GETPROP 3320 . 3666) (SETATOMVAL 3668 . 3923) (RPAQQ 3925 . 3970) (RPAQ
3972 . 4175) (RPAQ? 4177 . 4432) (MOVD 4434 . 4790) (MOVD? 4792 . 5306) (PUTDQ? 5308 . 5380) (SELECTQ
5382 . 5534) (SELECTQ1 5536 . 5801) (NCONC1 5803 . 5987) (PUTPROP 5989 . 7202) (PUTPROPS 7204 . 7335)
(PROPNAMES 7337 . 7491) (ADDPROP 7493 . 9003) (REMPROP 9005 . 9437) (NAMEFIELD 9439 . 10233) (
FILECREATED 10235 . 12077) (FILECREATED1 12079 . 12716) (DECLARE: 12718 . 12832) (DECLARE:1 12834 .
13405) (LOAD 13407 . 19131) (ROOTFILENAME 19133 . 19735) (MEMB 19737 . 19908)))))
STOP