(FILECREATED " 4-Dec-84 21:54:41" {ERIS}<LISPCORE>LIBRARY>MAKEDATABASE.;15 8801
changes to: (VARS MAKEDATABASECOMS)
(FNS PRINT.DATABASE.BANNERLINES \MDB.CONTINUE)
previous date: " 3-Dec-84 21:39:26" {ERIS}<LISPCORE>LIBRARY>MAKEDATABASE.;13)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MAKEDATABASECOMS)
(RPAQQ MAKEDATABASECOMS ((FNS STARTMAKINGDATABASE CONTINUEMAKINGDATABASE \MDB.CONTINUE \MDB.CLEAROUT
\SYSFILEP)
(FNS PRINT.DATABASE.BANNERLINES)
(VARS (DATABASE.OUTPUT.FILE)
(REMAINING.FILES.TO.ANALYZE))
(GLOBALVARS DATABASE.OUTPUT.FILE REMAINING.FILES.TO.ANALYZE)
(FILES (SYSLOAD FROM LISPUSERS)
PAGEHOLD)))
(DEFINEQ
(STARTMAKINGDATABASE
(LAMBDA (FILESLST OUTPUTFILENAME CONSCOUNTLIMIT) (* JonL " 1-Dec-84 23:44")
(DECLARE (LOCALVARS FILESLST OUTPUTFILENAME CONSCOUNTLIMIT))
(PROG (SYSP ALLSYSP)
(if (NULL FILESLST)
then (SETQ FILESLST SYSFILES)
(SETQ ALLSYSP (SETQ SYSP T))
(OR (FIXP CONSCOUNTLIMIT)
(SETQ CONSCOUNTLIMIT 250000))
elseif (SOME FILESLST (FUNCTION \SYSFILEP))
then (SETQ SYSP T)
(SETQ ALLSYSP (EVERY FILESLST (FUNCTION \SYSFILEP))))
(if (AND SYSP (OR (NOT (LISTP (GETP (QUOTE ABC)
(QUOTE FILEDATES))))
(NOT (HASDEF (QUOTE \MACRO.MX)
(QUOTE MACROS)))))
then (HELP "Did you know that ABC must be loaded to do this?"))
(if (NULL OUTPUTFILENAME)
then (if ALLSYSP
then (SETQ OUTPUTFILENAME (QUOTE {ERIS}<LISPCORE>SOURCES>SYSTEM.DATABASE))
else (HELP "No name")))
(SETQ DATABASE.OUTPUT.FILE (OPENFILE OUTPUTFILENAME (QUOTE OUTPUT)
(QUOTE NEW)))
(printout DATABASE.OUTPUT.FILE T "STOP " T)
(CLOSEF DATABASE.OUTPUT.FILE)
(CONTINUEMAKINGDATABASE FILESLST DATABASE.OUTPUT.FILE CONSCOUNTLIMIT))))
(CONTINUEMAKINGDATABASE
(LAMBDA (FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT) (* JonL " 3-Dec-84 20:28")
(DECLARE (LOCALVARS FILESLST OUTPUTFILENAME CONSCOUNTLIMIT))
(if (NULL FILESLST)
then (HELP "Must specify some files to analyze")
elseif (NULL OUTPUTFILENAME)
then (HELP "Must have a name for the database output file"))
(if (FIXP INCREMENTALCONSCOUNT)
then (SETQ INCREMENTALCONSCOUNT (IMAX 1000 INCREMENTALCONSCOUNT))
else (SETQ INCREMENTALCONSCOUNT))
(PROG ((ASSIGNDATATYPE.ASKUSERWAIT 2))
(DECLARE (SPECVARS ASSIGNDATATYPE.ASKUSERWAIT))
(\MDB.CONTINUE FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT))))
(\MDB.CONTINUE
[LAMBDA (FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT) (* JonL.pa " 4-Dec-84 21:54")
(DECLARE (SPECVARS FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT))
(PROG ((POS (STKNTH -1 (QUOTE \MDB.CONTINUE)))
ROOTFILENAME ROOTFILES LOSEREASON)
(DECLARE (GLOBALVARS REMAINING.FILES.TO.ANALYZE)
(SPECVARS ROOTFILENAME ROOTFILES POS))
(RESETLST (PROG ((SYSP (SOME FILESLST (FUNCTION \SYSFILEP)))
(ALLSYSP (EVERY FILESLST (FUNCTION \SYSFILEP)))
[LOSERLINE (CONSTANT (ALLOCSTRING 64 (CHARCODE #]
[CRSTR (CONSTANT (MKSTRING (CHARACTER (CHARCODE CR]
I F TEM)
(if [AND SYSP (OR [NOT (LISTP (GETP (QUOTE ABC)
(QUOTE FILEDATES]
(NOT (HASDEF (QUOTE \MACRO.MX)
(QUOTE MACROS]
then (HELP "Did you know that ABC must be loaded to do this?"))
(SETQ REMAINING.FILES.TO.ANALYZE FILESLST)
[RESETSAVE (SETQ DATABASE.OUTPUT.FILE (OPENFILE OUTPUTFILENAME
(QUOTE BOTH)
(QUOTE OLD)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(RESETSAVE PAGE.WAIT.SECONDS 0) (* For JonL's PAGEHOLD utility)
(SETFILEPTR (PROG1 DATABASE.OUTPUT.FILE
(* Comment PPLossage))
(OR (FILEPOS "STOP" DATABASE.OUTPUT.FILE
(IMAX 0 (IDIFFERENCE (GETEOFPTR
DATABASE.OUTPUT.FILE)
10)))
(HELP "File doesn't have STOP")))
(\MDB.CLEAROUT)
(RESETSAVE (OUTPUT DATABASE.OUTPUT.FILE))
A (SETQ LOSEREASON (QUOTE LOADFROM))
(SETQ ROOTFILENAME (ROOTFILENAME (CAR FILESLST)))
(if [LISTP (NLSETQ (SETQ ROOTFILENAME (ROOTFILENAME
(STKAPPLY POS (FUNCTION LOADFROM)
(LIST (CAR FILESLST]
then (SETQ LOSEREASON (QUOTE ANALYZE))
(if [LISTP (NLSETQ (STKEVAL POS (SUBST ROOTFILENAME (QUOTE F)
(QUOTE (%. ANALYZE ON
(QUOTE F]
then (SETQ LOSEREASON)))
(pop FILESLST)
(TCONC ROOTFILES
(if LOSEREASON
then (CONCAT CRSTR LOSERLINE CRSTR "Failed to " LOSEREASON "on "
ROOTFILENAME CRSTR LOSERLINE CRSTR)
else ROOTFILENAME)) (* ROOTFILES is initialized by \MDB.CLEAROUT)
(if (OR (NULL FILESLST)
(AND INCREMENTALCONSCOUNT (IGEQ (CONSCOUNT)
INCREMENTALCONSCOUNT)))
then (UNINTERRUPTABLY
(TERPRI)
(TERPRI)
(PRIN1 "(* files analyzed: ")
[MAPC (CAR ROOTFILES)
(FUNCTION (LAMBDA (X)
(PRIN2 X)
(SPACES 1]
(PRIN1 " )")
(TERPRI)
(DUMPDATABASE)
(TERPRI)
(SETFILEPTR NIL (PROG1 (GETFILEPTR NIL)
(printout NIL T T "STOP " T))))
(\MDB.CLEAROUT))
(if FILESLST
then (GO A))
(CLOSEF NIL])
(\MDB.CLEAROUT
(LAMBDA NIL (* JonL " 3-Oct-84 03:54")
(DECLARE (USEDFREE FILESLST ROOTFILES)
(GLOBALVARS REMAINING.FILES.TO.ANALYZE))
(SETQ REMAINING.FILES.TO.ANALYZE FILESLST)
(%. ERASE)
(CLRHASH CLISPARRAY)
(FRPTQ 10 (RECLAIM))
(SETQ ROOTFILES (LIST NIL)) (* Initialization for a TCONC pointer)
(CONSCOUNT 0)))
(\SYSFILEP
(LAMBDA (X) (* JonL "22-Nov-84 20:05")
((LAMBDA (RF LUD)
(OR (FMEMB RF SYSFILES)
(AND (FMEMB (CAR (OR (SETQ LUD (if (AND (BOUNDP (QUOTE MAKESYSNAME))
(NOT (NULL MAKESYSNAME))
(NEQ MAKESYSNAME (QUOTE LISPCORE)))
then (LIST (PACK* (QUOTE {ERIS}<LISP>)
MAKESYSNAME
(QUOTE >LIBRARY>)))))
(QUOTE ({ERIS}<LISPCORE>LIBRARY>))))
LISPUSERSDIRECTORIES)
(RESETVAR DIRECTORIES (APPEND (QUOTE ({ERIS}<LISPCORE>SOURCES>))
LUD
(QUOTE ({ERIS}<LISPCORE>LIBRARY>)))
(FINDFILE RF)))))
(ROOTFILENAME X))))
)
(DEFINEQ
(PRINT.DATABASE.BANNERLINES
[LAMBDA (DATABASEFILE OUTPUTFILE) (* JonL.pa " 4-Dec-84 21:45")
(OR OUTPUTFILE (SETQ OUTPUTFILE T))
(RESETLST [if (OPENP DATABASEFILE (QUOTE INPUT))
then (RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
(SETQ DATABASEFILE (GETSTREAM DATABASEFILE (QUOTE INPUT)))
(GETFILEPTR DATABASEFILE)))
else (RESETSAVE (SETQ DATABASEFILE (OPENSTREAM DATABASEFILE (QUOTE INPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(bind (START ← 1) while (SETQ START (FFILEPOS "
(* " DATABASEFILE START -1)) do (COPYCHARS DATABASEFILE OUTPUTFILE START
(SETQ START (SUB1 (OR (FIXP (FILEPOS "(READATABASE)"
DATABASEFILE START
(IPLUS START 500)))
(IPLUS START 500])
)
(RPAQQ DATABASE.OUTPUT.FILE NIL)
(RPAQQ REMAINING.FILES.TO.ANALYZE NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DATABASE.OUTPUT.FILE REMAINING.FILES.TO.ANALYZE)
)
(FILESLOAD (SYSLOAD FROM LISPUSERS)
PAGEHOLD)
(PUTPROPS MAKEDATABASE COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (733 7565 (STARTMAKINGDATABASE 743 . 2133) (CONTINUEMAKINGDATABASE 2135 . 2892) (
\MDB.CONTINUE 2894 . 6312) (\MDB.CLEAROUT 6314 . 6794) (\SYSFILEP 6796 . 7563)) (7566 8483 (
PRINT.DATABASE.BANNERLINES 7576 . 8481)))))
STOP