Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "29-APR-81 20:27:35" <LISPUSERS>DATABASEFNS.;73 11987
changes to: DBFILE DBFILE1 LOAD LOADFROM MAKEFILE DUMPDB LOADDB MAKEDB
previous date: "12-APR-81 16:02:21" <LISPUSERS>DATABASEFNS.;72
)
(* copyright (c) 1981 Xerox Corporation)
(PRETTYCOMPRINT DATABASEFNSCOMS)
(RPAQQ DATABASEFNSCOMS [(* Does automatic Masterscope database maintenance)
[DECLARE: FIRST (P (VIRGINFN (QUOTE LOAD)
T)
(MOVD? (QUOTE LOAD)
(QUOTE OLDLOAD))
(VIRGINFN (QUOTE LOADFROM)
T)
(MOVD? (QUOTE LOADFROM)
(QUOTE OLDLOADFROM))
(VIRGINFN (QUOTE MAKEFILE)
T)
(MOVD? (QUOTE MAKEFILE)
(QUOTE OLDMAKEFILE]
(FNS DBFILE DBFILE1 LOAD LOADFROM MAKEFILE)
(ADDVARS (LINKEDFNS OLDLOAD))
(P (RELINK (QUOTE MAKEFILES)))
(FNS DUMPDB LOADDB MAKEDB)
(PROP PROPTYPE DATABASE)
[VARS (LOADDBFLG (COND ((EQ (EVALV (QUOTE LOADDBFLG))
(QUOTE NOBIND))
(QUOTE ASK))
(T LOADDBFLG)))
(SAVEDBFLG (COND ((EQ (EVALV (QUOTE SAVEDBFLG))
(QUOTE NOBIND))
(QUOTE ASK))
(T SAVEDBFLG]
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
(* To permit MSHASH interface)
(ADDVARS (MSHASHFILENAME))
(LOCALVARS . T)
(BLOCKS (LOADDB LOADDB DBFILE DBFILE1 (NOLINKFNS . T)))
(DECLARE: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
[DECLARE: DONTEVAL@LOAD DONTCOPY
(* Does automatic Masterscope database maintenance) ]
(DECLARE: FIRST
(VIRGINFN (QUOTE LOAD)
T)
(MOVD? (QUOTE LOAD)
(QUOTE OLDLOAD))
(VIRGINFN (QUOTE LOADFROM)
T)
(MOVD? (QUOTE LOADFROM)
(QUOTE OLDLOADFROM))
(VIRGINFN (QUOTE MAKEFILE)
T)
(MOVD? (QUOTE MAKEFILE)
(QUOTE OLDMAKEFILE))
)
(DEFINEQ
(DBFILE
[LAMBDA (FILE ASKFLAG) (* lmm "29-APR-81 20:27")
(* Finds a database file that corresponds to the contents of FILE. Looks in directory of FILE, and also in the
directory that file originally came from, if it was copied. Returns NIL if no database file is found, else
(fulldbfilename . filedates), where filedates identifies the name under which the file that the database corresponds
to is currently known. -
If FILE doesn't have a version, tries to get database for version in core, or most recent version if it hasn't been
loaded)
(DECLARE (GLOBALVARS COMPILE.EXT FILERDTBL))
[COND
((NULL FILE)
(SETQ FILE (INPUT)))
((EQ (FILENAMEFIELD FILE (QUOTE EXTENSION))
COMPILE.EXT) (* Map compiled file into symbolic name)
(SETQ FILE (PACKFILENAME (QUOTE EXTENSION)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILE]
(PROG [(FILEDATES (COND
[(AND (NULL (FILENAMEFIELD FILE (QUOTE VERSION)))
(CAR (GETPROP (NAMEFIELD FILE)
(QUOTE FILEDATES]
([SETQ FILE (COND
(ASKFLAG (INFILEP FILE))
(T (FINDFILE FILE]
(CONS (FILEDATE FILE)
FILE]
(AND FILEDATES (RETURN (DBFILE1 FILE FILEDATES])
(DBFILE1
[LAMBDA (F FILEDATES) (* lmm "29-APR-81 20:27")
(* Searches databases based on F to find one that matches FILEDATES.
Returns (dbfilename . filedates) if successful.)
(DECLARE (GLOBALVARS FILERDTBL))
(for DBF in (FILDIR (PACKFILENAME (QUOTE EXTENSION)
(QUOTE DATABASE)
(QUOTE VERSION)
(QUOTE *)
(QUOTE BODY)
F))
do [RESETSAVE (SETQ DBF (OPENFILE DBF (QUOTE INPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(* a (* The close is done in the LOADDB RESETLST, except when a candidate file
isn't correct))
(SKREAD DBF) (* Skip LOAD error message)
(COND
((STREQUAL (CAR FILEDATES)
(CAR (READ DBF FILERDTBL)))
(RETURN (CONS DBF FILEDATES)))
(T (CLOSEF DBF])
(LOAD
[LAMBDA (FILE LDFLG PRINTFLG) (* lmm "29-APR-81 20:27")
(SETQ FILE (OLDLOAD FILE LDFLG PRINTFLG))
(COND
((NEQ LDFLG (QUOTE SYSLOAD))
(LOADDB FILE T)))
FILE])
(LOADFROM
[LAMBDA (FILE FNS LDFLG) (* lmm "29-APR-81 20:27")
(SETQ FILE (OLDLOADFROM FILE FNS LDFLG))
(LOADDB FILE T)
FILE])
(MAKEFILE
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
(* lmm "29-APR-81 20:27")
(SETQ FILE (OLDMAKEFILE FILE OPTIONS REPRINTFNS SOURCEFILE))
(DUMPDB FILE T)
FILE])
)
(ADDTOVAR LINKEDFNS OLDLOAD)
(RELINK (QUOTE MAKEFILES))
(DEFINEQ
(DUMPDB
[LAMBDA (FILE PROPFLG) (* lmm "29-APR-81 20:27")
(* Dumps a Masterscope database for functions in FILE. Checks the DATABASE property if PROPFLG=T which is how the
MAKEFILE advice calls it. A user-level call would default PROPFLG to NIL.)
(* The FILE check is because MAKEFILE returns a list when it doesn't understand
the options)
(DECLARE (GLOBALVARS MSHASHFILENAME MSFILETABLE SAVEDBFLG))
(AND FILE (LITATOM FILE)
(PROG (DBFILE (FL (NAMEFIELD FILE))
FNS
(FFNS (FILEFNSLST FILE)))
(COND
(FFNS)
((TESTTABLE FL (CADR MSFILETABLE))
(* Always dump if this is a known file)
(SETQ PROPFLG NIL))
(T (COND
(PROPFLG (/REMPROP FL (QUOTE DATABASE)))
(T (printout T T FILE " has no functions." T)))
(RETURN)))
(SETQ FNS FFNS)
(COND
((OR (NULL PROPFLG)
(EQ (GETPROP FL (QUOTE DATABASE))
(QUOTE YES))
(EQ SAVEDBFLG (QUOTE YES))
(TESTTABLE FL (CADR MSFILETABLE)))
(* If MSHASH is loaded, only dump functions in the local database)
[COND
(MSHASHFILENAME (SETQ FNS (for FN in FNS when (PROGN (UPDATEFN FN)
(LOCALFNP FN))
collect FN]
[RESETLST [RESETSAVE (SETQ DBFILE (OPENFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE DATABASE)
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILE)
(QUOTE OUTPUT)
(QUOTE NEW)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(AND RESETSTATE (DELFILE OLDVALUE]
(RESETSAVE (OUTPUT DBFILE))
(PRIN1
"(PROGN (PRIN1 %"Use LOADDB to load database files!
%" T) (ERROR!))
")
[STORETABLE FL MSFILETABLE (PRINT (CAR (GETPROP FL (QUOTE FILEDATES]
(COND
(MSHASHFILENAME (UPDATECONTAINS FL FFNS T)))
(* T flag means that the function won't be erased--it might still be interesting)
(printout NIL "FNS " .P2 FFNS T)
(* So the database file knows which functions are on the file)
(COND
(FNS (DUMPDATABASE FNS))
(T (printout NIL "STOP" T]
[COND
(PROPFLG (PRINT DBFILE T))
(T (/PUT FL (QUOTE DATABASE)
(QUOTE YES]
(* Take future note of the databae on a user call)
(RETURN DBFILE])
(LOADDB
[LAMBDA (FILE ASKFLAG) (* lmm "29-APR-81 20:27")
(* Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case
from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a
database file of the appropriate name really exists.)
(DECLARE (GLOBALVARS MSHASHFILENAME MSFILETABLE MSARGTABLE DWIMWAIT FILERDTBL LOADDBFLG))
(RESETLST (PROG (TEM NEWFNS FORFILE (NF (NAMEFIELD FILE))
(DBFILE (DBFILE FILE ASKFLAG)))
(COND
(DBFILE (SETQ FORFILE (CDR DBFILE))
(SETQ DBFILE (CAR DBFILE)))
(T (COND
((NULL ASKFLAG)
(printout T "no database file found for " NF T)))
(RETURN)))
(COND
([COND
[ASKFLAG (SELECTQ (GETPROP NF (QUOTE DATABASE))
(YES T)
(NO NIL)
(SELECTQ LOADDBFLG
(YES (/PUT NF (QUOTE DATABASE)
(QUOTE YES)))
(NO (/PUT NF (QUOTE DATABASE)
(QUOTE NO))
NIL)
(OR (TESTTABLE NF (CADR MSFILETABLE))
(COND
((EQ (ASKUSER DWIMWAIT (QUOTE Y)
(LIST "load database for" NF)
)
(QUOTE Y))
(/PUT NF (QUOTE DATABASE)
(QUOTE YES)))
(T (/PUT NF (QUOTE DATABASE)
(QUOTE NO))
NIL]
(T (/PUT NF (QUOTE DATABASE)
(QUOTE YES]
(LISPXPRINT DBFILE T)
(* DBFILE was opened in DBFILE)
(RESETSAVE (INPUT DBFILE))
[COND
((EQ (SETQ TEM (READ NIL FILERDTBL))
(QUOTE FNS))
(SETQ NEWFNS (READ NIL FILERDTBL))
(COND
((EQ (SETQ TEM (READ NIL FILERDTBL))
(QUOTE ARGS))
[COND
[MSHASHFILENAME (bind F while (SETQ F (READ NIL FILERDTBL))
do (STORETABLE F MSARGTABLE (READ NIL FILERDTBL]
(T (while (READ NIL FILERDTBL]
(SETQ TEM (READ NIL FILERDTBL]
(COND
((OR (EQ (CAR (LISTP TEM))
(QUOTE READATABASE))
(EQ TEM (QUOTE STOP)))
(COND
((NEQ TEM (QUOTE STOP))
(* It must be (READATABASE))
(READATABASE)))
(COND
(MSHASHFILENAME (UPDATECONTAINS NF NEWFNS)))
(STORETABLE NF MSFILETABLE FORFILE)
(* This is done whether or not there is a hashfile.)
(UPDATEFILES)
(* Mark any edited fns as needing to be reanalyzed.)
(for FN in (CDR (GETP NF (QUOTE FILE)))
when (OR (EXPRP FN)
(GETP FN (QUOTE EXPR)))
do (MSMARKCHANGED FN)))
(T (printout T T DBFILE " is not a database file!" T)
(* So that value of LOADDB is NIL)
(SETQ DBFILE NIL)))
(RETURN DBFILE])
(MAKEDB
[LAMBDA (F) (* DECLARATIONS: UNDOABLE)
(* lmm "29-APR-81 20:27")
(DECLARE (GLOBALVARS SAVEDBFLG MSFILETABLE DWIMWAIT))
(SETQ F (NAMEFIELD F))
(* The extension is stripped off for purposes of the DATABASE. This maps compiled files into the root name, but
means that we can't have multiple-extension files with different database status)
(COND
((INFILECOMS? T (QUOTE FNS)
(FILECOMS F))
(OR (FMEMB (GETPROP F (QUOTE DATABASE))
(QUOTE (YES NO)))
(FMEMB SAVEDBFLG (QUOTE (YES NO)))
(TESTTABLE F (CADR MSFILETABLE))
(/PUT F (QUOTE DATABASE)
(COND
((EQ (QUOTE Y)
(ASKUSER DWIMWAIT (QUOTE N)
"Do you want a Masterscope Database for this file? "))
(QUOTE YES))
(T (QUOTE NO])
)
(PUTPROPS DATABASE PROPTYPE IGNORE)
(RPAQ LOADDBFLG (COND ((EQ (EVALV (QUOTE LOADDBFLG))
(QUOTE NOBIND))
(QUOTE ASK))
(T LOADDBFLG)))
(RPAQ SAVEDBFLG (COND ((EQ (EVALV (QUOTE SAVEDBFLG))
(QUOTE NOBIND))
(QUOTE ASK))
(T SAVEDBFLG)))
(ADDTOVAR MAKEFILEFORMS (MAKEDB FILE))
[DECLARE: DONTEVAL@LOAD DONTCOPY
(* To permit MSHASH interface) ]
(ADDTOVAR MSHASHFILENAME )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: LOADDB LOADDB DBFILE DBFILE1 (NOLINKFNS . T))
]
(DECLARE: EVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1811 4685 (DBFILE 1823 . 3140) (DBFILE1 3144 . 4073) (LOAD 4077 . 4282) (LOADFROM 4286
. 4448) (MAKEFILE 4452 . 4682)) (4751 11271 (DUMPDB 4763 . 7399) (LOADDB 7403 . 10389) (MAKEDB 10393 .
11268)))))
STOP