(FILECREATED "10-MAR-83 22:58:18" <NEWLISP>LOADUP.;1 12288 changes to: (VARS LOADUPCOMS)
previous date: " 7-OCT-81 10:36:02" <LISP>LOADUP.;145)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT LOADUPCOMS)
(RPAQQ LOADUPCOMS [(FNS LOADUP LOADUPROFILE LOADUP0 LOADUP1 LOADUP2 LOADUP2A LOADUP3 ENDLOAD)
[INITVARS (LOADUPDIRECTORIES (QUOTE (NIL NEWLISP LISP]
(VARS (FNS/VARSFILE)
(LOADUPLISTFILE)
LOADUPMINFS INITMINFS)
(ADDVARS (SYSFILES))
(GLOBALVARS RECORD COMPILE.EXT MKSWAPSIZE SYSFILES FILERDTBL ADVISEDFNS BUILDMAPFLG
FILEPKGFLG DWIMFLG ADDSPELLFLG SYSLINKEDFNS LINKEDFNS LOADUPDIRECTORIES
LOADUPLISTFILE FNS/VARSFILE INITMINFS LOADUPMINFS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA LOADUP0)
(NLAML)
(LAMA])
(DEFINEQ
(LOADUP
[LAMBDA (X EXCEPTFILES CONTINUEFLG NOCOMPFLG)
(* lmm " 7-OCT-81 00:08")
(SELECTQ X
[(PARC NETLISP)
(AND (NULL FNS/VARSFILE)
(SETQ FNS/VARSFILE (QUOTE FNS-VARS)))
[MAPC LOADUPMINFS (FUNCTION (LAMBDA (X)
(MINFS (CDR X)
(CAR X]
[MAPC LOADUPMINFS (FUNCTION (LAMBDA (X)
(RECLAIM (CAR X]
(MAPC LOADUPMINFS (FUNCTION (LAMBDA (X)
(MINFS 50 (CAR X]
NIL)
(COND
((AND FNS/VARSFILE (NOT (OPENP FNS/VARSFILE)))
(OUTPUT (OUTFILE FNS/VARSFILE))
(PRIN1 (QUOTE "(SETQQ FNS/VARS (")
FNS/VARSFILE)))
[AND LOADUPLISTFILE (NOT (OPENP LOADUPLISTFILE))
(SETQ LOADUPLISTFILE (OUTPUT (OUTFILE LOADUPLISTFILE]
[SETQ ADDSPELLFLG (SETQ DWIMFLG (SETQ BUILDMAPFLG (SETQ FILEPKGFLG NIL]
(SETQQ GLOBALVARSVARS NOBIND)
(PROG (FL LOADUPROFILELST FILEDATESLST)
[SETQ LOADUPROFILELST (AND [SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR)
(SETQ FL (INFILEP (PACKFILENAME (QUOTE DIRECTORY)
DIR
(QUOTE BODY)
(QUOTE LOADUP.LISP]
(INFILE FL)
(PROG1 (READ)
(CLOSEF FL]
[SETQ FILEDATESLST (AND (INFILEP (QUOTE FILEDATES.LISP))
(INFILE (QUOTE FILEDATES.LISP))
(PROG1 (READ)
(CLOSEF (QUOTE FILEDATES.LISP]
(RETURN (LOADUPROFILE X CONTINUEFLG])
(LOADUPROFILE
[LAMBDA (X CONTINUEFLG) (* wt: "28-APR-79 12:34")
(PROG (LST)
(COND
((LISTP X)
(APPLY (QUOTE LOADUP0)
X))
((SETQ LST (ASSOC X LOADUPROFILELST)) (* entires on loaduplistfile can redefine loadup
sequences)
(MAPC (CDR LST)
(FUNCTION EVAL)))
(T (PRINT (QUOTE ?)
T)))
(RETURN X])
(LOADUP0
[NLAMBDA X
(MAPC X (FUNCTION (LAMBDA (X)
[COND
((ATOM X)
(SETQ X (LIST X]
(COND
[NOCOMPFLG (MAPC X (FUNCTION (LAMBDA (X)
(LOADUP1 (LIST X)
(NULL NOCOMPFLG]
(T (LOADUP1 X T])
(LOADUP1
[LAMBDA (FILES CFLG) (* wt: "28-APR-79 10:42")
(PROG (TEM CFILE CFL (FL (CAR FILES))
|
AFTERLOADUPFORMS)
|
(COND
|
((FMEMB FL SYSFILES)
|
(* Already processed.)
|
(RETURN))
|
((FMEMB FL EXCEPTFILES)
|
(RETURN))
|
([BOUNDP (SETQ TEM (PACK (LIST FL (QUOTE COMS]
|
(* Already loaded, but may want to clobber its FNS,
|
VARS, and BLOCKS E.G. MISC, BASIC.)
|
[RESETVARS ((MKSWAPSIZE MKSWAPSIZE))
|
(LOADUP3 (GETATOMVAL TEM)
|
NIL
|
(FUNCTION (LAMBDA (COM)
|
(MAPC [AND (EQ (CAR COM)
|
(QUOTE FNS))
|
(COND
|
((EQ (CADR COM)
|
(QUOTE *))
|
(EVAL (CADDR COM)))
|
(T (CDR COM]
|
(FUNCTION (LAMBDA (FN)
|
(AND (MKSWAPP FN (GETD FN))
|
(MKSWAP FN]
|
(GO OUT)))
|
(PRIN1 [SETQ CFL (SETQ CFILE (COND
|
(CFLG (PACKFILENAME (QUOTE NAME)
|
FL
|
(QUOTE EXTENSION)
|
COMPILE.EXT))
|
(T FL]
|
T)
|
[SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR)
|
(SETQ CFL (PACKFILENAME (QUOTE DIRECTORY)
|
DIR
|
(QUOTE BODY)
|
CFILE))
|
(COND
|
((SETQ TEM (INFILEP CFL))
|
(COND
|
(DIR (PRIN1 (QUOTE " (FROM ")
|
T)
|
(PRIN1 DIR T)
|
(PRIN1 (QUOTE ")
")
|
T))
|
(T (TERPRI T)))
|
(SETQ CFL TEM] (* This allows you to LOAD with some files in your
|
directory, some in NEWLISP's, and the rest in LISP'S.)
|
(LOAD CFL T)
|
(TERPRI T)
|
(COND
|
(AFTERLOADUPFORMS (* masintrs request. lets file specify special cleanup
|
things to do after it is loaded to release some space.)
|
[MAPC AFTERLOADUPFORMS (FUNCTION (LAMBDA (FORM)
|
(ERSETQ (EVAL FORM]
|
(SETQ AFTERLOADUPFORMS)))
|
OUT (MAPC FILES (FUNCTION LOADUP2))
|
(COND
|
(CFL (RELINK LINKEDFNS)
|
(COND
|
(LOADUPLISTFILE (TERPRI LOADUPLISTFILE)
|
(TERPRI LOADUPLISTFILE)
|
(PRINT CFL LOADUPLISTFILE)
|
(OUTPUT LOADUPLISTFILE)
|
(STORAGE NIL T)
|
(OUTPUT T])
(LOADUP2
[LAMBDA (FILE) (* wt: "23-MAY-79 11:31")
(PROG (TEM FL COMS)
(COND
((SETQ TEM (ASSOC FILE FILEDATESLST))|
(LOADUP2A FILE (CADR TEM)|
(CADDR TEM)))|
[(SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR)|
(SETQ FL (COND|
(DIR (PACKFILENAME (QUOTE DIRECTORY)|
DIR|
(QUOTE BODY)|
FILE))|
(T FILE)))|
(COND|
((SETQ FL (INFILEP FL))|
(LOADUP2A FILE FL (FILEDATE FL))|
T]|
(T (PRIN1 (QUOTE *****)
T)
(PRIN1 FILE T)
(PRIN1 (QUOTE " not found.
")
T)))
(SETQ SYSFILES (NCONC1 SYSFILES FILE))
[COND
([AND (NEQ FNS/VARSFILE T)
(LISTP (SETQ TEM (GETATOMVAL (SETQ COMS (PACK (LIST FILE (QUOTE COMS]
(AND FNS/VARSFILE (PRINT (CONS COMS TEM)
FNS/VARSFILE FILERDTBL))
(LOADUP3 TEM FNS/VARSFILE)
(SET COMS (QUOTE NOBIND]
(RETURN T])
(LOADUP2A
[LAMBDA (FILE FULLNAME FILEDATE) (* wt: "28-APR-79 10:54")
|
|
(* fullname is newest version of FILE, filedate its filedate (either obtained via function FILEDATE, or when loading
|
on alto, from FILEDATESLST) compares this date with that of the file ussd to make the compilld file which is
|
obtained from property list)
|
|
|
(PROG (TEM)
|
(COND
|
([NOT (EQUAL FILEDATE (COND
|
([STRINGP (SETQ TEM (GETPROP FILE (QUOTE FILEDATES]
|
TEM)
|
((LISTP TEM)
|
(CAAR TEM))
|
(T (RETURN]
|
(PRIN1 (QUOTE "*****date does not agree with that of ")
|
T)
|
(PRINT FULLNAME T)
|
(TERPRI T)
|
(TERPRI T])
(LOADUP3
[LAMBDA (COMS FL FN) (* wt: "26-FEB-79 18:57")
(* walks through filecoms and smashes all of the * variables. used by loadup and clearfilepkg
(in utility). if the variabe in queston is to be used and needs to be saved, it should be dumped explicitly in the
VARS commands and wrapped in a PROGN where it appears in the prettycom, e.g. (PROP MACROS *
(PROGN MACROLST)) FL argument is for loadup and is file to write the variable to)
(MAPC COMS (FUNCTION (LAMBDA (COM)
(PROG (NAME)
(AND (EQ (CADR COM)
(QUOTE *))
(LITATOM (CADDR COM))
(SETQ NAME (CADDR COM)))
(SELECTQ (CAR COM)
(COMS (LOADUP3 (COND
(NAME (GETATOMVAL NAME))
(T (CDR COM)))
FL FN))
[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
(FN (APPLY* FN COM))
(NAME (MAPC (OR (LISTP NAME)
|
(LIST NAME))
|
(FUNCTION (LAMBDA (NAME)
|
(AND FL (PRINT (CONS NAME (GETATOMVAL NAME))
|
FL FILERDTBL))
|
(SET NAME (QUOTE NOBIND])
(ENDLOAD
[LAMBDA (FLG) (* wt: "24-APR-79 01:53")
(MAPC (QUOTE (LOADUP LOADUPROFILE LOADUP0 LOADUP1 LOADUP2 LOADUP2A LOADUP3 ENDLOAD))
|
(FUNCTION PUTD))
|
(SETQ ADVISEDFNS NIL)
(SETQ SYSLINKEDFNS LINKEDFNS)
(SETQ LINKEDFNS NIL)
(COND
((AND FNS/VARSFILE (NEQ FNS/VARSFILE T))
(PRIN1 (QUOTE "))")
FNS/VARSFILE)
(PRIN1 [QUOTE (MAPC FNS/VARS (FUNCTION (LAMBDA (X)
(/SETATOMVAL (CAR X)
(CDR X]
FNS/VARSFILE)
(ENDFILE FNS/VARSFILE)))
(AND LOADUPLISTFILE (CLOSEF LOADUPLISTFILE))
(SETQQ LOADUPLISTFILE NOBIND)
(SETQQ FNS/VARSFILE NOBIND)
[AND FLG (SETQ BUILDMAPFLG (SETQ FILEPKGFLG (SETQ ADDSPELLFLG (SETQ DWIMFLG T]
(RECLAIM 1)
(MAPC (PROG1 INITMINFS (SETQQ INITMINFS NOBIND))
(FUNCTION (LAMBDA (X)
(MINFS (CDR X)
(CAR X])
)
(RPAQ? LOADUPDIRECTORIES (QUOTE (NIL NEWLISP LISP)))
(RPAQQ FNS/VARSFILE NIL)
(RPAQQ LOADUPLISTFILE NIL)
(RPAQQ LOADUPMINFS ((1 . 4737)
(4 . 156)
(8 . 18000)
(9 . 852)
(12 . 10500)
(16 . 30)
(18 . 30)
(24 . 845)
(28 . 7664)
(30 . 2775)))
(RPAQQ INITMINFS ((1 . 10000)
(4 . 512)
(8 . 10000)
(9 . 512)
(12 . 1000)
(16 . 512)
(18 . 3000)
(24 . 512)
(28 . 512)
(30 . 512)))
(ADDTOVAR SYSFILES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS RECORD COMPILE.EXT MKSWAPSIZE SYSFILES FILERDTBL ADVISEDFNS BUILDMAPFLG
FILEPKGFLG DWIMFLG ADDSPELLFLG SYSLINKEDFNS LINKEDFNS LOADUPDIRECTORIES LOADUPLISTFILE
FNS/VARSFILE INITMINFS LOADUPMINFS)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA LOADUP0)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS LOADUP COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP ((11299) (848 NIL (LOADUP 858 . 2255) (LOADUPROFILE 2257 . 2691) (LOADUP0 2693 . 2935) (
LOADUP1 2937 . 6483) (LOADUP2 6485 . 7529) (LOADUP2A 7531 . 8609) (LOADUP3 8611 . 10387) (ENDLOAD
10389 . 11298)))))
STOP