(FILECREATED "23-Jan-85 11:47:50" {ERIS}<LISPCORE>LIBRARY>MAKEDATABASE.;20 12998
changes to: (FNS \MDB.CONTINUE)
previous date: "21-Jan-85 14:57:23" {ERIS}<LISPCORE>LIBRARY>MAKEDATABASE.;19)
(* Copyright (c) 1983, 1984, 1985 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)
(CONSTANTS (ANALYZED.FILES.KEY (QUOTE ANALYZED.FILES])
(DEFINEQ
(STARTMAKINGDATABASE
[LAMBDA (FILESLST OUTPUTFILENAME CONSCOUNTLIMIT MODE) (* jds "21-Jan-85 14:22")
(* * Top level entry to the Makedatabase facility. If FILESLST is not provided, it defaults to SYSFILES.
OUTPUTFILENAME defaults to {ERIS}<LISPCORE>SOURCES>SYSTEM.DATABASE. (if ALLSYSP) CONSCOUNTLIMIT defaults to 250000.0
Simply builds the database (If mode is TEXT then a STOP is written at the end of the file) and then calls
CONTINUEMAKINGDATABASE.)
(DECLARE (LOCALVARS FILESLST OUTPUTFILENAME CONSCOUNTLIMIT MODE))
(PROG (SYSP ALLSYSP)
(OR (FIXP CONSCOUNTLIMIT)
(SETQ CONSCOUNTLIMIT 250000))
(SELECTQ MODE
(NIL (SETQ MODE (QUOTE HASHFILE)))
((HASHFILE TEXT))
(ERROR "Unknown mode for STARTMAKINGDATABASE: " MODE))
(* if any of the files in FILELST are SYSFILEP then set
SYSP to T, if all of them are also set ALLSYSP)
[COND
((NULL FILESLST)
(SETQ FILESLST SYSFILES)
(SETQ ALLSYSP (SETQ SYSP T)))
((SOME FILESLST (FUNCTION \SYSFILEP))
(SETQ SYSP T)
(SETQ ALLSYSP (EVERY FILESLST (FUNCTION \SYSFILEP]
(* if there are any sysfiles, then make sure ABC is loaded. What does the (NOT (HASDEF (QUOTE \MACRO.MX)
(QUOTE MACROS))) do?)
(COND
([AND SYSP (OR [NOT (LISTP (GETP (QUOTE ABC)
(QUOTE FILEDATES]
(NOT (HASDEF (QUOTE \MACRO.MX)
(QUOTE MACROS]
(HELP "Did you know that ABC must be loaded to do this?")))
[COND
((NULL OUTPUTFILENAME)
(COND
(ALLSYSP (SETQ OUTPUTFILENAME (QUOTE {ERIS}<LISPCORE>SOURCES>SYSTEM.DATABASE)))
(T (HELP "No name"]
(SELECTQ MODE
(HASHFILE (SETDB OUTPUTFILENAME (QUOTE CREATE))
(SETQ DATABASE.OUTPUT.FILE MSHASHFILE)
(COND
((NEQ (PACKFILENAME (QUOTE VERSION)
(QUOTE NIL)
(QUOTE BODY)
MSHASHFILENAME)
(PACKFILENAME (QUOTE VERSION)
(QUOTE NIL)
(QUOTE BODY)
OUTPUTFILENAME))
(ERROR "MSHASH and MAKEDATABASE don't agree on the outputfilename"))
)
(SETDB))
(TEXT (SETQ DATABASE.OUTPUT.FILE (OPENFILE OUTPUTFILENAME (QUOTE OUTPUT)
(QUOTE NEW)))
(printout DATABASE.OUTPUT.FILE T "STOP " T)
(CLOSEF DATABASE.OUTPUT.FILE))
(NILL))
(CONTINUEMAKINGDATABASE FILESLST (SELECTQ MODE
(HASHFILE OUTPUTFILENAME)
(TEXT DATABASE.OUTPUT.FILE)
(NILL))
CONSCOUNTLIMIT MODE])
(CONTINUEMAKINGDATABASE
[LAMBDA (FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT MODE)
(* gbn "20-Jan-85 13:23")
(* * Called to add to an already existing database. Just typechecks its args and calls \MDB.CONTINUE)
(DECLARE (LOCALVARS FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT MODE))
(COND
((NULL FILESLST)
(HELP "Must specify some files to analyze"))
((NULL OUTPUTFILENAME)
(HELP "Must have a name for the database output file")))
(COND
((FIXP INCREMENTALCONSCOUNT)
(SETQ INCREMENTALCONSCOUNT (IMAX 1000 INCREMENTALCONSCOUNT)))
(T (SETQ INCREMENTALCONSCOUNT)))
(PROG ((ASSIGNDATATYPE.ASKUSERWAIT 2))
(DECLARE (SPECVARS ASSIGNDATATYPE.ASKUSERWAIT))
(\MDB.CONTINUE FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT MODE])
(\MDB.CONTINUE
[LAMBDA (FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT MODE)
(* jds "23-Jan-85 08:38")
(* * this is the fn that actually loadfroms and analyzes the files. It keeps track of why (if) it loses in
LOSEREASON. It tacks on the results of the analyis onto ROOTFILE (just the filename if it wins, otherwise the reason
and a string and such.))
(* * Called from CONTINUEMAKINGDATABASE with an already existing database file.)
(* * do I really want to (SETDB) on exit from the RESETLST ?)
(DECLARE (SPECVARS FILESLST OUTPUTFILENAME INCREMENTALCONSCOUNT MODE))
(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)
(COND
([AND SYSP (OR [NOT (LISTP (GETP (QUOTE ABC)
(QUOTE FILEDATES]
(NOT (HASDEF (QUOTE \MACRO.MX)
(QUOTE MACROS]
(HELP "Did you know that ABC must be loaded to do this?")))
(SETQ REMAINING.FILES.TO.ANALYZE FILESLST)
[RESETSAVE (SETQ DATABASE.OUTPUT.FILE (SELECTQ MODE
(HASHFILE
(SETDB OUTPUTFILENAME
(QUOTE BOTH))
(* if SETDB returns the database as its result dont
need this)
MSHASHFILE)
(TEXT (OPENFILE
OUTPUTFILENAME
(QUOTE BOTH)
(QUOTE OLD)))
(ERROR
"Bad mode in \MDB.CONTINUE: "
MODE)))
(QUOTE (PROGN (SELECTQ MODE
(HASHFILE (SETDB))
(TEXT (CLOSEF? OLDVALUE))
(ERROR "Bad mode in \MDB.CONTINUE: " MODE]
(RESETSAVE PAGE.WAIT.SECONDS 0) (* For JonL's PAGEHOLD utility)
(SELECTQ MODE
(HASHFILE)
[TEXT (SETFILEPTR DATABASE.OUTPUT.FILE
(OR (FILEPOS "STOP" DATABASE.OUTPUT.FILE
(IMAX 0 (IDIFFERENCE (GETEOFPTR
DATABASE.OUTPUT.FILE)
10)))
(HELP "File doesn't have STOP"]
(ERROR "Bad mode in \MDB.CONTINUE: " MODE))
(\MDB.CLEAROUT)
[COND
((EQ MODE (QUOTE TEXT))
(RESETSAVE (OUTPUT DATABASE.OUTPUT.FILE]
A (SETQ LOSEREASON (QUOTE LOADFROM))
(SETQ ROOTFILENAME (ROOTFILENAME (CAR FILESLST)))
[COND
([LISTP (NLSETQ (SETQ ROOTFILENAME (ROOTFILENAME
(STKAPPLY POS (FUNCTION LOADFROM)
(LIST (CAR FILESLST]
(SETQ LOSEREASON (QUOTE ANALYZE))
(COND
((LISTP (NLSETQ (ANALYZEFILES ROOTFILENAME T)))
(SETQ LOSEREASON]
(pop FILESLST)
(TCONC ROOTFILES
(COND
(LOSEREASON (CONCAT CRSTR LOSERLINE CRSTR "Failed to " LOSEREASON
"on "
ROOTFILENAME CRSTR LOSERLINE CRSTR))
(T ROOTFILENAME))) (* ROOTFILES is initialized by \MDB.CLEAROUT)
(COND
((OR (NULL FILESLST)
(AND INCREMENTALCONSCOUNT (IGEQ (CONSCOUNT)
INCREMENTALCONSCOUNT)))
(* if all the files are gone, or the cons count has been exceeded, then write out the state to this moment, then
call clearout)
(* * THE DUMPDB NEEDS TO TURN INTO A FLUSHDB also read what ron's msg said about this)
(SELECTQ MODE
(HASHFILE (* put in the hashfiledatabase the files that are being
created. then flush the db)
(PUTHASHFILE ANALYZED.FILES.KEY
(APPEND ROOTFILES (GETHASHFILE
ANALYZED.FILES.KEY
DATABASE.OUTPUT.FILE))
DATABASE.OUTPUT.FILE)
(FLUSHDB DATABASE.OUTPUT.FILE))
[TEXT (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))))]
(NILL))
(\MDB.CLEAROUT)))
(COND
(FILESLST (GO A)))
(* * WHAT DOES THIS DO? * *)
(CLOSEF NIL])
(\MDB.CLEAROUT
[LAMBDA NIL (* gbn "19-Jan-85 23:05")
(* * cleans up random state, like clisp cruft that builds up, and gc's the results)
(DECLARE (USEDFREE FILESLST ROOTFILES)
(GLOBALVARS REMAINING.FILES.TO.ANALYZE))
(SETQ REMAINING.FILES.TO.ANALYZE FILESLST) (* what does that do? Does it muck with the Masterscope
tables)
(%. ERASE) (* to get rid of the all the cached clispifications
from analyzing files)
(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) (* gbn "20-Jan-85 13:38")
(* * seems to go through printing out all the comments in the database file to outputfile.)
(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]
(* as long as there are still "(*" in the file,then go through copying from the beginning of the comment to the call
to (READDATABASE) or 500 chars, whichever is first)
(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)
(DECLARE: EVAL@COMPILE
(RPAQQ ANALYZED.FILES.KEY ANALYZED.FILES)
(CONSTANTS (ANALYZED.FILES.KEY (QUOTE ANALYZED.FILES)))
)
(PUTPROPS MAKEDATABASE COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (740 11329 (STARTMAKINGDATABASE 750 . 3623) (CONTINUEMAKINGDATABASE 3625 . 4555) (
\MDB.CONTINUE 4557 . 9738) (\MDB.CLEAROUT 9740 . 10558) (\SYSFILEP 10560 . 11327)) (11330 12545 (
PRINT.DATABASE.BANNERLINES 11340 . 12543)))))
STOP