(FILECREATED "23-Feb-84 17:34:27" {PHYLUM}<LISPCORE>NEW>APUTDQ.;1 16245
changes to: (FNS ENDLOADUP)
previous date: " 7-Feb-84 18:26:43" {PHYLUM}<LISPCORE>SOURCES>APUTDQ.;38)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT APUTDQCOMS)
(RPAQQ APUTDQCOMS [(FNS GREETFILENAME FAULTEVAL FAULTAPPLY ERRORX)
(FNS SMASHFILECOMS SMASHFILECOMSLST)
(INITVARS (DEFAULTREGISTRY)
(USERGREETFILES)
(LOGINHOST/DIR (QUOTE {DSK})))
(FNS RESETRESTORE RESETVARS RESETSAVE RESETVAR)
(FNS LOADUP ENDLOADUP)
(VARS LOADUPDIRECTORIES)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (SETINTERRUPT 4 (QUOTE RESET))
(SETINTERRUPT 3 (QUOTE RAID))
(SETINTERRUPT 20 (QUOTE CONTROL-T)))
(P (DUMMYDEF (ADDSTATS *)
(STATINIT NILL)
(LISPXWATCH NILL)
(CLBUFS NILL)
(FINDFILE INFILEP)
(FILEMAP *)
(VIRGINFN GETD)
(MKSWAPP NILL))
(DUMMYDEF (USERNUMBER ZERO)
(HOSTNUMBER ZERO)
(HOSTNAME NILL)
(TRAPCOUNT ZERO))
(DUMMYDEF (* QUOTE)
(GETP GETPROP)
(DECLARE QUOTE)
(FRPLNODE2 RPLNODE2)
(DISPLAYTERMP TRUE)
(LOADAV ZERO)
(MINFS EVQ)
(FRPLACA RPLACA)
(FRPLACD RPLACD)
(MISSPELLED? NILL)
(UNDOSAVE NILL)
(SETLINELENGTH ZERO)
(DOBE NILL)
(RELINK NILL)
(PUT PUTPROP)
(/PUT PUTPROP)
(MKSWAP EVQ)))
(ADDVARS (SYSFILES)
(LISPXHISTORY)
(LINKEDFNS))
(VARS (SHALLOWFLG)
(SPAGHETTIFLG T)
(WIDEPAPERFLG T)
(CLEARSTKLST T)
(SYSHASHARRAY (HASHARRAY 50))
(DISPLAYTERMFLG T)
(#UNDOSAVES)
(NLAMA)
(NLAML)
(LAMS)
(EVALQTFORMS)
(TTYLINELENGTH 82)
(COMPILE.EXT (QUOTE DCOM))
(SYSOUT.EXT (QUOTE SYSOUT))
(HOSTNAME)
(SYSTEMTYPE (SYSTEMTYPE)))
(P (GCGAG T)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA RESETSAVE RESETVARS FAULTEVAL)
(NLAML RESETVAR)
(LAMA])
(DEFINEQ
(GREETFILENAME
[LAMBDA (USER) (* lmm "12-JUN-83 16:56")
(* Returns name of an existing greeting file, or NIL)
(DECLARE (GLOBALVARS USERGREETFILES LOGINHOST/DIR COMPILE.EXT))
(SELECTQ USER
[T (OR (INFILEP (QUOTE {DSK}INIT.LISP))
(bind FILE while (SETQ FILE (PROMPTFORWORD (QUOTE
"Please enter name of system init file
(e.g. {server}<directory>INIT.extension): ")
NIL NIL PROMPTWINDOW))
until (SETQ FILE (INFILEP (MKATOM FILE))) finally (RETURN FILE]
(NIL)
(COND
((LISTP USERGREETFILES)
(PROG [(POS (STRPOS (QUOTE %.)
(SETQ USER (U-CASE USER]
[COND
([AND POS (OR (NULL DEFAULTREGISTRY)
(STREQUAL (SUBSTRING USER (ADD1 POS)
-1)
(MKSTRING DEFAULTREGISTRY]
(SETQ USER (SUBSTRING USER 1 (SUB1 POS]
(RETURN (for D in (COND
((LISTP (CAR USERGREETFILES))
USERGREETFILES)
(T (CONS USERGREETFILES)))
when [SETQ D (INFILEP (PACK (SUBPAIR (QUOTE (USER COM))
(LIST USER COMPILE.EXT)
D]
do (RETURN D])
(FAULTEVAL
[NLAMBDA FAULTX (* lmm "16-MAY-80 11:57")
(RAID FAULTX])
(FAULTAPPLY
[LAMBDA (FAULTFN FAULTARGS) (* lmm "16-MAY-80 11:58")
(RAID FAULTFN])
(ERRORX
[LAMBDA (ERXM) (* lmm "16-MAY-80 11:58")
(RAID ERXM])
)
(DEFINEQ
(SMASHFILECOMS
[LAMBDA (FILE) (* lmm "11-MAR-83 14:36")
(* dummy definition for APUTDQ)
(PROG (FILECOMS)
(COND
([BOUNDP (SETQ FILECOMS (PACK (LIST FILE (QUOTE COMS]
(* Already loaded, but may want to clobber its FNS,
VARS, and BLOCKS E.G. MISC, BASIC.)
(SMASHFILECOMSLST (GETATOMVAL FILECOMS])
(SMASHFILECOMSLST
[LAMBDA (COMS) (* lmm "11-MAR-83 13:17")
(MAPC COMS (FUNCTION (LAMBDA (COM)
(PROG (NAME)
(AND (EQ (CADR COM)
(QUOTE *))
(LITATOM (CADDR COM))
(SETQ NAME (CADDR COM)))
(SELECTQ (CAR COM)
[COMS (SMASHFILECOMSLST (COND
(NAME (GETATOMVAL NAME))
(T (CDR COM]
[FILEVARS (SETQ NAME (COND
((EQ (CADR COM)
(QUOTE *)) (* if caddr is a litatom, name was set to it above.
if caddr is not, dangerous to evaluate the form, so
punt)
(GETATOMVAL NAME))
(T (CDR COM]
[(PROP IFPROP)
(COND
((AND (EQ (CADDR COM)
(QUOTE *))
(LITATOM (CADDDR COM)))
(SETQ NAME (CADDDR COM]
NIL)
(COND
((AND NAME (LITATOM NAME))
(SET NAME (QUOTE NOBIND])
)
(RPAQ? DEFAULTREGISTRY )
(RPAQ? USERGREETFILES )
(RPAQ? LOGINHOST/DIR (QUOTE {DSK}))
(DEFINEQ
(RESETRESTORE
[LAMBDA (RESETVARSLST0 RESETSTATE)
(* wt: "15-MAR-78 14:25")
(* Goes down RESETVARSLST doing restoration until it gets to NIL or RESETVARSLST0. RESETSTATE is either NIL, ERROR,
or RESET, depending on whether restoration is at normal (successful) completion of a RESETLST, following an error or
control-E, or following a control-D)
(PROG (RESETZ OLDVALUE)
LP (COND
((AND RESETVARSLST (NOT (TAILP RESETVARSLST RESETVARSLST0)))
(SETQ RESETZ (CAR RESETVARSLST))
(SETQ RESETVARSLST (CDR RESETVARSLST))
[COND
((LISTP (CAR RESETZ))
[SETQ OLDVALUE (COND
((CDR RESETZ)
(* occurs for RESETSAVE's when second aagument is specified. In this case, (CADR RESETZ) is the value of the saving
form, i.e. the first argument to RESETSAVE.)
(CADR RESETZ))
(T (CADAR RESETZ]
(APPLY (CAAR RESETZ)
(CDAR RESETZ)))
(T (SETTOPVAL (CAR RESETZ)
(CDR RESETZ]
(GO LP])
(RESETVARS
[NLAMBDA RESETX (* wt: "14-JAN-80 23:29")
(PROG ([RESETW (SETQ RESETVARSLST (PROG ((RESETZ RESETVARSLST))
[MAPC (CAR RESETX)
(FUNCTION (LAMBDA (RESETY)
(SETQ RESETZ
(CONS [COND
[(LISTP RESETY)
(CONS (CAR RESETY)
(GETTOPVAL (CAR RESETY]
(T (CONS RESETY (GETTOPVAL RESETY]
RESETZ]
(RETURN RESETZ]
RESETY)
(SETQ RESETY RESETVARSLST)
(RETURN (CAR (OR [PROG1 (XNLSETQ (PROGN [MAPC (CAR RESETX)
(FUNCTION (LAMBDA (RESETY)
(COND
[(LISTP RESETY)
(SETTOPVAL (CAR RESETY)
(APPLY (QUOTE PROG1)
(CDR RESETY)
(QUOTE INTERNAL]
(T (SETTOPVAL RESETY]
(APPLY (QUOTE PROG)
(CONS NIL (CDR RESETX))
(QUOTE INTERNAL)))
INTERNAL)
[MAPC (CAR RESETX)
(FUNCTION (LAMBDA (Z)
(SETTOPVAL (CAAR RESETW)
(CDAR RESETW))
(SETQ RESETW (CDR RESETW]
(COND
((EQ RESETY RESETVARSLST)
(SETQ RESETVARSLST RESETW))
((NOT (TAILP RESETVARSLST RESETY))
(* some resetsaves may hae been performed inside of the resetvars. these should NOT be ndone until the corresonding
resetlst is exited (they wouldnt be in shallow system since restvarsis simply a prog) therefore the section of
resetvarlst corresponding to the variable rebindings must be spliced out)
(* the reason for the TAILP is that if resetvarslst has for some reason already been stripped back earlier than
resety, dont want to do the nleft/rplacd. (in fact nleft would generate an error). one can think of this as
analaogical to the code in resetrestore, where resetvarslst is walked down until it is a tail of resetvarslst0.)
(* reason for TAILP is to parallel the code in resetrestore, where resetvarslst is processed until it is a tail of
resetvarlst0. we are trying to avoid the situation where resetvarslst has for some reason been stripped back to
before resety. note that if for some reason resetvarslst is not a tail of resety, but resety is not a tail of
resetvarslst, then nleft will generate an error. this should not happen since things are supposed to be taken off
only in the order they were put on. if this turns out to be a problem, we can undo things on resetvarslst by
smashing them and leaving them alone.)
(RPLACD (NLEFT RESETVARSLST 1 RESETY)
RESETW]
(ERROR!])
(RESETSAVE
[NLAMBDA RESETX (* wt: "23-JUL-79 21:08")
(* for use under a RESETLST. If RESETX is atmic, like RESETVAR, otherwise like RESETFORM, i.e. performs the
resetting and saving associated with these functions. The restoration aad errorset protectionis done by RESETLST.
Note that its value is not any particularly useful quanitty. When used a la RESETFORM, can take a second argument
whose value (computed before firt argument) is restoration form, e.g. (RESETSAVE (SETSEPR --)
(LIST (QUOTE SETSEPR) (GETSEPR))) (RESETSAVE NIL form) means just add value of form to RESETVARLST>)
(SETQ RESETVARSLST (CONS [COND
[(AND (CAR RESETX)
(ATOM (CAR RESETX)))
(PROG1 (CONS (CAR RESETX)
(GETTOPVAL (CAR RESETX)))
(SETTOPVAL (CAR RESETX)
(EVAL (CADR RESETX)
(QUOTE INTERNAL]
[(CDR RESETX)
(* CADR of the entry put on resetvarslst is the value of the saving form. The variable OLDVALUE is bound to this
value during restoration. This makes it more convenient for the estoration to be conditional, e.g. the user can
perform (RESETSAVE (FOO mumble) (QUOTE (AND pred (FIE OLDVALUE)))))
(LIST (EVAL (CADR RESETX))
(EVAL (CAR RESETX]
(T (LIST (LIST (COND
((EQ (CAAR RESETX)
(QUOTE SETQ))
(CAR (CADDAR RESETX)))
(T (CAAR RESETX)))
(EVAL (CAR RESETX]
RESETVARSLST])
(RESETVAR
[NLAMBDA (RESETX RESETY RESETZ)
(* wt: "23-JUL-79 21:09")
(PROG (MACROX MACROY)
(* Permits evaluation of a form while resetting a top level variable, and provides for the variable to be
automatcally restored after valuation. In this way, the user pays when he wants to 'rebind' a globalvariable, but
does not have to pay for the possiblity, as would be the case if variables such as DFNFLG, LISPXHISTORY, etc. were
not global, i.e. were looked up. In the event of a control-D, or control-C reenter, the variabes will still be
restored by EVALQT. Note that STKEVALs will not do the right t on variables reset by RESETVAR.)
(SETQ MACROX (SETQ RESETVARSLST (CONS (CONS RESETX (GETTOPVAL RESETX))
RESETVARSLST)))
(SETQ MACROY (ERRORSET (LIST (QUOTE PROGN)
(LIST (QUOTE SETTOPVAL)
(LIST (QUOTE QUOTE)
RESETX)
RESETY)
RESETZ)
(QUOTE INTERNAL)))
(SETTOPVAL (CAAR MACROX)
(CDAR MACROX))
(SETQ RESETVARSLST (CDR MACROX))
[COND
(MACROY (RETURN (CAR MACROY]
(ERROR!])
)
(DEFINEQ
(LOADUP
[LAMBDA (OPTION/FILES) (* gbn " 7-Feb-84 18:26")
(SELECTQ OPTION/FILES
[PRELOADUP (* PRELIMS)
(SETQQ COMPILE.EXT DCOM)
(while BOOTLOADEDFILES do (pushnew SYSFILES (pop BOOTLOADEDFILES)))
(LOADUP (QUOTE (ACODE MACHINEINDEPENDENT POSTLOADUP]
(COMP (* COMPILER)
(LOADUP (QUOTE PRELOADUP))
(LOADUP (QUOTE (MACROS DLAP BYTECOMPILER COMPILE)))
(COMPILEMODE (QUOTE D)))
[NOENV (* BASIC ENVIRONMENT FILES)
(LOADUP (QUOTE PRELOADUP))
(LOADUP (QUOTE (EDIT WEDIT HELPDL PRETTY COMMENT BREAK ADVISE LOADFNS FILEPKG
DFILE DMISC]
[NOWINDOW (* MORE ENVIRONMENT)
(LOADUP (QUOTE NOENV))
(LOADUP (QUOTE COMP))
(LOADUP (QUOTE (HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD
ASSIST HPRINT MACROAUX ADDARITH)))
(LOADUP (QUOTE (MSANALYZE MSPARSE MASTERSCOPE BRKDWN MATCH)))
(DWIM (QUOTE C))
(LOADUP (QUOTE (AARITH)))
(LOADUP (QUOTE (DISKDLION]
[NONET (* DISPLAY/WINDOW)
(LOADUP (QUOTE NOWINDOW))
(LOADUP (QUOTE (ADISPLAY HLDISPLAY MENU WINDOW WBREAK DEXEC INSPECT)))
(LOADUP (QUOTE (DSPRINTDEF NEWPRINTDEF DEDIT TTYIN]
[SMALL (LOADUP (QUOTE NONET))
(LOADUP (QUOTE (AFONT PRESS]
[(NIL HUGE) (* MORE NETWORKING, AND STATS)
(LOADUP (QUOTE NONET))
(LOADUP (QUOTE (10MBDRIVER LLNS TRSERVER)))
(LOADUP (QUOTE (BSP CHAT DPUPFTP)))
(LOADUP (QUOTE (LLFCOMPILE APS PCALLSTATS)))
(LOADUP (QUOTE (SPP COURIER NSFILING AFONT PRESS INTERPRESS FLOPPY]
(COND
((LISTP OPTION/FILES)
(for X in OPTION/FILES
do (OR (FMEMB X SYSFILES)
(DOFILESLOAD (LIST (QUOTE (SYSLOAD FROM VALUEOF LOADUPDIRECTORIES))
X)))
(SMASHFILECOMS X)))
(T (HELP "BAD LOADUP OPTION" OPTION/FILES])
(ENDLOADUP
[LAMBDA NIL (* lmm "23-Feb-84 17:02")
(* set up for NONET configuration;
sites with ethernet can load in init from other places)
(SETQ DEFAULTPRINTINGHOST NIL)
(SETQ LISPUSERSDIRECTORIES (QUOTE ({DSK})))
(SETQ FONTDIRECTORIES (QUOTE ({DSK})))
(SETQ STARFONTDIRECTORIES (QUOTE ({DSK})))
(SETQ USERGREETFILES NIL)
(SETQ FONTWIDTHSFILES (QUOTE ({DSK}FONTS.WIDTHS)))
(SETQ DIRECTORIES)
[MAPC USERRECLST (FUNCTION (LAMBDA (R)
(RECORDPRIORITY R (QUOTE SYSTEM]
(SETQ ADVISEDFNS NIL)
[SETQ UPDATEMAPFLG (SETQ BUILDMAPFLG (SETQ FILEPKGFLG (SETQ ADDSPELLFLG (SETQ DWIMFLG T]
(CNDIR (QUOTE {DSK}])
)
(RPAQQ LOADUPDIRECTORIES ({PHYLUM}<LISPCORE>SOURCES> {PHYLUM}<LISPCORE>LIBRARY>
{PHYLUM}<LISP>LIBRARY> {PHYLUM}<LISPUSERS>))
(DECLARE: DONTEVAL@LOAD DOCOPY
(SETINTERRUPT 4 (QUOTE RESET))
(SETINTERRUPT 3 (QUOTE RAID))
(SETINTERRUPT 20 (QUOTE CONTROL-T))
(DUMMYDEF (ADDSTATS *)
(STATINIT NILL)
(LISPXWATCH NILL)
(CLBUFS NILL)
(FINDFILE INFILEP)
(FILEMAP *)
(VIRGINFN GETD)
(MKSWAPP NILL))
(DUMMYDEF (USERNUMBER ZERO)
(HOSTNUMBER ZERO)
(HOSTNAME NILL)
(TRAPCOUNT ZERO))
(DUMMYDEF (* QUOTE)
(GETP GETPROP)
(DECLARE QUOTE)
(FRPLNODE2 RPLNODE2)
(DISPLAYTERMP TRUE)
(LOADAV ZERO)
(MINFS EVQ)
(FRPLACA RPLACA)
(FRPLACD RPLACD)
(MISSPELLED? NILL)
(UNDOSAVE NILL)
(SETLINELENGTH ZERO)
(DOBE NILL)
(RELINK NILL)
(PUT PUTPROP)
(/PUT PUTPROP)
(MKSWAP EVQ))
(ADDTOVAR SYSFILES )
(ADDTOVAR LISPXHISTORY )
(ADDTOVAR LINKEDFNS )
(RPAQQ SHALLOWFLG NIL)
(RPAQQ SPAGHETTIFLG T)
(RPAQQ WIDEPAPERFLG T)
(RPAQQ CLEARSTKLST T)
(RPAQ SYSHASHARRAY (HASHARRAY 50))
(RPAQQ DISPLAYTERMFLG T)
(RPAQQ #UNDOSAVES NIL)
(RPAQQ NLAMA NIL)
(RPAQQ NLAML NIL)
(RPAQQ LAMS NIL)
(RPAQQ EVALQTFORMS NIL)
(RPAQQ TTYLINELENGTH 82)
(RPAQQ COMPILE.EXT DCOM)
(RPAQQ SYSOUT.EXT SYSOUT)
(RPAQQ HOSTNAME NIL)
(RPAQ SYSTEMTYPE (SYSTEMTYPE))
(GCGAG T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA RESETSAVE RESETVARS FAULTEVAL)
(ADDTOVAR NLAML RESETVAR)
(ADDTOVAR LAMA )
)
(PUTPROPS APUTDQ COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2120 3621 (GREETFILENAME 2130 . 3328) (FAULTEVAL 3330 . 3426) (FAULTAPPLY 3428 . 3526)
(ERRORX 3528 . 3619)) (3622 5077 (SMASHFILECOMS 3632 . 4156) (SMASHFILECOMSLST 4158 . 5075)) (5178
11535 (RESETRESTORE 5188 . 6229) (RESETVARS 6231 . 8830) (RESETSAVE 8832 . 10335) (RESETVAR 10337 .
11533)) (11536 14586 (LOADUP 11546 . 13796) (ENDLOADUP 13798 . 14584)))))
STOP