(FILECREATED "15-Sep-84 01:29:17" {ERIS}<LISPCORE>SOURCES>APUTDQ.;10 16939
changes to: (FNS ENDLOADUP)
previous date: " 7-Sep-84 17:16:02" {ERIS}<LISPCORE>SOURCES>APUTDQ.;9)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(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 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)
(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)
(NLAML RESETVAR)
(LAMA])
(DEFINEQ
(GREETFILENAME
[LAMBDA (USER) (* lmm "13-Apr-84 08:42")
(* 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): ")))
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) (* JonL " 8-Jun-84 10:43")
(* dummy definition for APUTDQ)
(PROG ((FILECOMS (PACK (LIST FILE (QUOTE COMS)))))
(COND
((BOUNDP FILECOMS) (* Already loaded, but may want to clobber its FNS,
VARS, and BLOCKS E.G. MISC, BASIC.)
(SMASHFILECOMSLST (GETATOMVAL FILECOMS))
(SET FILECOMS (QUOTE NOBIND)))))))
(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) (* rmk: " 7-Sep-84 17:15")
(SELECTQ OPTION/FILES
[PRELOADUP (* PRELIMS)
(SETQQ COMPILE.EXT DCOM)
(while BOOTLOADEDFILES do (pushnew SYSFILES (pop BOOTLOADEDFILES)))
(LOADUP (QUOTE (ACODE MACHINEINDEPENDENT POSTLOADUP]
[NOENV (* BASIC ENVIRONMENT FILES)
(LOADUP (QUOTE PRELOADUP))
(LOADUP (QUOTE (COMPATIBILITY EDIT WEDIT HELPDL PRETTY COMMENT BREAK ADVISE
LOADFNS FILEPKG DFILE DMISC]
[NOWINDOW (* MORE ENVIRONMENT)
(LOADUP (QUOTE NOENV))
(LOADUP (QUOTE (MACROS DLAP BYTECOMPILER COMPILE)))
(COMPILEMODE (QUOTE D))
(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)))
(LOADUP (QUOTE (DLIONFS]
[NONET (* DISPLAY/WINDOW)
(LOADUP (QUOTE NOWINDOW))
(LOADUP (QUOTE (ADISPLAY HLDISPLAY MENU WINDOW ATTACHEDWINDOW WBREAK DEXEC
INSPECT)))
(LOADUP (QUOTE (DSPRINTDEF NEWPRINTDEF DEDIT TTYIN]
[SMALL (LOADUP (QUOTE NONET))
(LOADUP (QUOTE (AFONT HARDCOPY PRESS]
[(NIL HUGE) (* MORE NETWORKING, AND STATS)
(LOADUP (QUOTE NONET))
(LOADUP (QUOTE (10MBDRIVER LLNS TRSERVER)))
(LOADUP (QUOTE (BSP CHAT PUPCHAT DPUPFTP)))
(LOADUP (QUOTE (LLFCOMPILE)))
(LOADUP (QUOTE (SPP COURIER NSPRINT CLEARINGHOUSE NSFILING AFONT HARDCOPY PRESS
INTERPRESS FLOPPY]
(COND
((LISTP OPTION/FILES) (* RESETVAR just in case some sub-loading wants to
"reach out" to other files)
(for X in OPTION/FILES
do [OR (FMEMB X SYSFILES)
(RESETVAR DIRECTORIES LOADUPDIRECTORIES
(DOFILESLOAD (LIST (QUOTE (SYSLOAD FROM VALUEOF LOADUPDIRECTORIES))
X]
(SMASHFILECOMS X)))
(T (HELP "BAD LOADUP OPTION" OPTION/FILES])
(ENDLOADUP
[LAMBDA NIL (* rmk: "15-Sep-84 01:29")
(* set up for NONET configuration;
sites with ethernet can load in init from other places)
(* * All records existing at this point in time have been loaded as part of the system.)
[MAPC USERRECLST (FUNCTION (LAMBDA (R)
(RECORDPRIORITY R (QUOTE SYSTEM]
(* * Global variables to be set to NIL)
(MAPC (QUOTE (DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES GREETHIST
NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN
CH.DEFAULT.ORGANIZATION ADVISEDFNS))
(FUNCTION SETTOPVAL))
(* * Global FLG's to be set to T)
[MAPC (QUOTE (UPDATEMAPFLG BUILDMAPFLG FILEPKGFLG ADDSPELLFLG DWIMFLG))
(FUNCTION (LAMBDA (X)
(SETTOPVAL X T]
(CNDIR (QUOTE {DSK}))
(* * Miscellaneous Initializations -- filedirectory search paths and LISPXHISTORY and etc)
(MAPC (QUOTE ((LISPUSERSDIRECTORIES {DSK})
(DISPLAYFONTDIRECTORIES {DSK})
(DISPLAYFONTEXTENSIONS DISPLAYFONT)
(INTERPRESSFONTDIRECTORIES {DSK})
(PRESSFONTWIDTHSFILES {DSK}FONTS.WIDTHS)
(LISPXHISTORY NIL 0 100 100)))
(FUNCTION (LAMBDA (X)
(SETTOPVAL (CAR X)
(COPY (CDR X])
)
(RPAQQ LOADUPDIRECTORIES ({ERIS}<LISPCORE>SOURCES> {ERIS}<LISPCORE>LIBRARY> {ERIS}<LISPUSERS>))
(DECLARE: DONTEVAL@LOAD DOCOPY
(SETINTERRUPT 4 (QUOTE RESET))
(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)
(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)
(ADDTOVAR NLAML RESETVAR)
(ADDTOVAR LAMA )
)
(PUTPROPS APUTDQ COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2072 3590 (GREETFILENAME 2082 . 3297) (FAULTEVAL 3299 . 3395) (FAULTAPPLY 3397 . 3495)
(ERRORX 3497 . 3588)) (3591 5057 (SMASHFILECOMS 3601 . 4136) (SMASHFILECOMSLST 4138 . 5055)) (5158
11515 (RESETRESTORE 5168 . 6209) (RESETVARS 6211 . 8810) (RESETSAVE 8812 . 10315) (RESETVAR 10317 .
11513)) (11516 15378 (LOADUP 11526 . 13934) (ENDLOADUP 13936 . 15376)))))
STOP