Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "10-APR-82 14:07:45" <LISPUSERS>MSHASH.;195 39763
changes to: UPDATEDB
previous date: "10-APR-82 10:44:16" <LISPUSERS>MSHASH.;193)
(PRETTYCOMPRINT MSHASHCOMS)
(RPAQQ MSHASHCOMS ((VARS MSHFNS)
[DECLARE: FIRST (P * (MAPCAR MSHFNS (FUNCTION (LAMBDA (X)
(LIST (QUOTE MOVD?)
(KWOTE (CADR X))
(KWOTE (CADDR X]
(FNS * (MAPCAR MSHFNS (FUNCTION CAR)))
(DECLARE: DONTCOPY (RECORDS HFTABLE))
(FNS LOCALFNP MSKEY FORWARDTABLE MSVAL NEXTHASHKEY STOREHASHVALUE GETHASHTABLE)
(VARS (MSHASHSCRATCHSTRING (CONCAT MACSCRATCHSTRING)))
(GLOBALVARS MSHASHSCRATCHSTRING)
(ADDVARS (MSHASHFILE)
(MSHASHFILENAME)
(MSREADONLYFLG)
(NEXTHASHKEY)
(MSFILETABLE))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
NOBOX)
(PROP MACRO BOGUSVAL BOGUSVALP))
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
HASH)
(LOCALVARS . T)
(FNS ANALYZEFILES BUILDDB COPYDB FLUSHDB EQLST HFGETARGS MSFILECHECK MSFILES
RESTOREDB SETDB UPDATECONTAINS UPDATEDB)
(ADDVARS (ANALYZEUSERFNS HFGETARGS))))
(RPAQQ MSHFNS ((HFGETTABLE GETTABLE OLDHASHGETTABLE)
(HFMAKETABLE MAKETABLE OLDHASHMAKETABLE)
(HFMAPTABLE MAPTABLE OLDHASHMAPTABLE)
(HFTESTTABLE TESTTABLE OLDHASHTESTTABLE)
(HFEQMEMBTABLE EQMEMBTABLE OLDHASHEQMEMBTABLE)
(HFSTORETABLE STORETABLE OLDHASHSTORETABLE)
(HFPUTTABLE PUTTABLE OLDHASHPUTTABLE)
(HFADDTABLE ADDTABLE OLDHASHADDTABLE)
(HFSUBTABLE SUBTABLE OLDHASHSUBTABLE)))
(DECLARE: FIRST
(MOVD? (QUOTE GETTABLE)
(QUOTE OLDHASHGETTABLE))
(MOVD? (QUOTE MAKETABLE)
(QUOTE OLDHASHMAKETABLE))
(MOVD? (QUOTE MAPTABLE)
(QUOTE OLDHASHMAPTABLE))
(MOVD? (QUOTE TESTTABLE)
(QUOTE OLDHASHTESTTABLE))
(MOVD? (QUOTE EQMEMBTABLE)
(QUOTE OLDHASHEQMEMBTABLE))
(MOVD? (QUOTE STORETABLE)
(QUOTE OLDHASHSTORETABLE))
(MOVD? (QUOTE PUTTABLE)
(QUOTE OLDHASHPUTTABLE))
(MOVD? (QUOTE ADDTABLE)
(QUOTE OLDHASHADDTABLE))
(MOVD? (QUOTE SUBTABLE)
(QUOTE OLDHASHSUBTABLE))
)
(DEFINEQ
(HFGETTABLE
[LAMBDA (KEY TABLE) (* lmm " 9-APR-81 21:31")
(DECLARE (USEDFREE MSHASHFILE MSHASHFILENAME FILERDTBL))
(COND
[(type? HFTABLE TABLE)
(PROG ((LOCALV (OLDHASHGETTABLE KEY (fetch LOCALARRAY of TABLE)))
FILEV)
(COND
[(OR (NULL LOCALV)
(fetch INVFLG of TABLE))
(COND
((SETQ FILEV (GETHASHFILE (MSKEY TABLE KEY)
MSHASHFILE))
(SETFILEPTR MSHASHFILENAME (CAR FILEV))
(SETQ FILEV (READ MSHASHFILENAME FILERDTBL]
((BOGUSVALP LOCALV)
(SETQ LOCALV)))
(RETURN (COND
((NULL (fetch INVFLG of TABLE))
(OR LOCALV FILEV))
(T (SETQ TABLE (FORWARDTABLE TABLE))
(SUBSET (COND
((AND LOCALV FILEV)
(UNION LOCALV FILEV))
(T (OR LOCALV FILEV)))
(FUNCTION (LAMBDA (X)
(HFEQMEMBTABLE X KEY TABLE T]
(T (OLDHASHGETTABLE KEY TABLE])
(HFMAKETABLE
[LAMBDA (N NAME INVFLG) (* lmm " 7-APR-81 22:55"
) |
(COND |
[MSHASHFILE |
(create HFTABLE |
LOCALARRAY _(OLDHASHMAKETABLE N) |
NAME _ NAME |
INVFLG _ INVFLG |
KEY _(CONCAT |
[CHARACTER (COND |
([SETQ TEMP |
(LOOKUPHASHFILE |
(CONCAT (COND |
(INVFLG "do!") |
(T "by!")) |
NAME) |
(CONS NEXTHASHKEY 0) |
MSHASHFILE |
(COND |
(MSREADONLYFLG (QUOTE RETRIEVE))|
(T (QUOTE (RETRIEVE INSERT] |
(CAR TEMP)) |
((NOT MSREADONLYFLG) |
(* key got written by |
LOOKUPHASHFILE) |
(NEXTHASHKEY)) |
(T (HELP |
"CAN'T SET UP READ-ONLY DATABASE FILE"] |
(QUOTE !] |
(T (OLDHASHMAKETABLE N])
(HFMAPTABLE
[LAMBDA (TABLE MFN) (* lmm "11-APR-81 14:46")
(DECLARE (SPECVARS TABLE MFN)
(USEDFREE MSHASHFILE MSHASHFILENAME FILERDTBL))
(COND
[(type? HFTABLE TABLE)
(PROG ((HA (fetch LOCALARRAY of TABLE))
TMP)
(DECLARE (SPECVARS HA))
(* The function is named MFN so as not to conflict with the name of the fn
argument in the old mapper.)
[COND
[(fetch INVFLG of TABLE)
(OLDHASHMAPTABLE HA (FUNCTION (LAMBDA (VAL ITEM)
(AND (SETQ VAL (HFGETTABLE ITEM TABLE))
(APPLY* MFN VAL ITEM]
(T (OLDHASHMAPTABLE HA (FUNCTION (LAMBDA (VAL ITEM)
(OR (BOGUSVALP VAL)
(APPLY* MFN VAL ITEM]
(COND
((SETQ TMP (GETHASHFILE (MSKEY TABLE (QUOTE **ALLKEYS**))
MSHASHFILE))
(SETFILEPTR MSHASHFILENAME (CAR TMP))
(MAPC (READ MSHASHFILENAME FILERDTBL)
(FUNCTION (LAMBDA (ITEM VAL)
(AND (NOT (OLDHASHTESTTABLE ITEM HA))
(SETQ VAL (HFGETTABLE ITEM TABLE))
(APPLY* MFN VAL ITEM]
(T (* Don't worry about bogus values)
(OLDHASHMAPTABLE TABLE MFN])
(HFTESTTABLE
[LAMBDA (KEY TABLE) (* lmm "29-APR-81 14:09")
(COND
[(type? HFTABLE TABLE)
(PROG (LOCALV FILEV FORWARD)
[RETURN (COND
[(OLDHASHTESTTABLE KEY (fetch LOCALARRAY of TABLE))
(COND
((fetch INVFLG of TABLE)
(SETQ FORWARD (FORWARDTABLE TABLE))
(for X in (OLDHASHGETTABLE KEY (fetch LOCALARRAY of TABLE))
when (HFEQMEMBTABLE X KEY FORWARD T) do (RETURN T)
finally (GO SCN2)))
(T (NOT (OLDHASHEQMEMBTABLE KEY (BOGUSVAL)
(fetch LOCALARRAY of TABLE]
((NOT (fetch INVFLG of TABLE))
(LOOKUPHASHFILE (MSKEY TABLE KEY)
NIL MSHASHFILE NIL))
(T (GO SCAN]
SCAN(SETQ FORWARD (FORWARDTABLE TABLE))
SCN2(RETURN (COND
((SETQ FILEV (GETHASHFILE (MSKEY TABLE KEY)
MSHASHFILE))
(SETFILEPTR MSHASHFILENAME (CAR FILEV))
(for X in (READ MSHASHFILENAME FILERDTBL)
when (HFEQMEMBTABLE X KEY FORWARD T) do (RETURN T]
(T (OLDHASHTESTTABLE KEY TABLE])
(HFEQMEMBTABLE
[LAMBDA (KEY VALUE TABLE FLG) (* lmm " 9-APR-81 21:31")
(* Checks whether VALUE is a member of the TABLE entry defined by KEY. If so, value is the file position of VALUE in
the entry if the entry is on the hashfile. If the entry is in the local database, the value will be non-NIL.)
(DECLARE (USEDFREE MSHASHFILE MSHASHFILENAME))
(COND
[(type? HFTABLE TABLE)
[COND
((fetch INVFLG of TABLE)
(swap KEY VALUE)
(SETQ TABLE (FORWARDTABLE TABLE]
(COND
((OLDHASHTESTTABLE KEY (fetch LOCALARRAY of TABLE))
(OLDHASHEQMEMBTABLE KEY VALUE (fetch LOCALARRAY of TABLE)))
(FLG T)
(T (AND (SETQ KEY (GETHASHFILE (MSKEY TABLE KEY)
MSHASHFILE))
(FILEPOS (MSVAL VALUE)
MSHASHFILENAME
(CAR KEY)
(CDR KEY))
T]
(T (OLDHASHEQMEMBTABLE KEY VALUE TABLE])
(HFSTORETABLE
[LAMBDA (KEY TABLST VALUE) (* lmm "10-APR-81 09:13")
(COND
[(type? HFTABLE (CADR TABLST))
(OLDHASHPUTTABLE KEY (OR VALUE (BOGUSVAL))
(fetch LOCALARRAY of (CADR TABLST)))
(COND
((CDDR TABLST)
(OR (type? HFTABLE (CDDR TABLST))
(SHOULDNT))
(PROG [(HA (fetch LOCALARRAY of (CDDR TABLST]
(for V inside VALUE do (OLDHASHADDTABLE V KEY HA]
(T (OLDHASHSTORETABLE KEY TABLST VALUE])
(HFPUTTABLE
[LAMBDA (KEY VALUE TABLE) (* rmk: "13-MAY-81 22:46")
(DECLARE (USEDFREE MSHASHFILENAME MSHASHFILE FILERDTBL))
(COND
((type? HFTABLE TABLE)
(* COND (MSREADONLYFLG (OLDHASHPUTTABLE KEY (OR VALUE (BOGUSVAL)) (fetch LOCALARRAY of TABLE))) (T (SETFILEPTR MSHASHFILENAME -1)
(STOREHASHVALUE KEY VALUE TABLE) (* Remove the value from the local database once the remote value is established)
(OLDHASHPUTTABLE KEY NIL (fetch LOCALARRAY of TABLE)) VALUE))
(OLDHASHPUTTABLE KEY (OR VALUE (BOGUSVAL))
(fetch LOCALARRAY of TABLE)))
(T (OLDHASHPUTTABLE KEY (OR VALUE (BOGUSVAL))
TABLE])
(HFADDTABLE
[LAMBDA (KEY VALUE TABLE) (* lmm " 7-APR-81 22:54")
(COND
((type? HFTABLE TABLE)
(* COND ((OLDHASHTESTTABLE KEY (fetch LOCALARRAY of TABLE)) (COND ((OLDHASHEQMEMBTABLE KEY (BOGUSVAL)
(fetch LOCALARRAY of TABLE)) (COND (MSREADONLYFLG (OLDHASHPUTTABLE KEY (LIST VALUE) (fetch LOCALARRAY of TABLE)))
(T (SETFILEPTR MSHASHFILENAME -1) (PUTHASHFILE (MSKEY TABLE KEY) (CBOX (IBOX (GETFILEPTR MSHASHFILENAME))
(PROGN (PRIN3 "( " MSHASHFILENAME) (PRIN4 VALUE MSHASHFILENAME FILERDTBL) (PRIN3 " )" MSHASHFILENAME)
(IBOX (GETFILEPTR MSHASHFILENAME)))) MSHASHFILE) (OLDHASHPUTTABLE KEY NIL (fetch LOCALARRAY of TABLE)))))
(MSREADONLYFLG (OLDHASHADDTABLE KEY VALUE (fetch LOCALARRAY of TABLE))) (T (* Must now copy old value out to the
file. This case doesn't occur if we flush the local database whenever we open the file for write)
(SETFILEPTR MSHASHFILENAME -1) (PUTHASHFILE (MSKEY TABLE KEY) (CBOX (IBOX (GETFILEPTR MSHASHFILENAME))
(PROGN (PRIN3 "( " MSHASHFILENAME) (PROG ((OLDV (OLDHASHGETTABLE KEY (fetch LOCALARRAY of TABLE))))
(COND ((NOT (FMEMB VALUE OLDV)) (PRIN4 VALUE MSHASHFILENAME FILERDTBL) (PRIN3 " " MSHASHFILENAME)))
(for V in OLDV do (PRIN4 V MSHASHFILENAME FILERDTBL) (PRIN3 " " MSHASHFILENAME))) (PRIN3 ")" MSHASHFILENAME)
(IBOX (GETFILEPTR MSHASHFILENAME)))) MSHASHFILE) (OLDHASHPUTTABLE KEY NIL (fetch LOCALARRAY of TABLE)))))
(T (PROG ((HVAL (GETHASHFILE (MSKEY TABLE KEY) MSHASHFILENAME))) (COND ((AND HVAL (FILEPOS (MSVAL VALUE)
MSHASHFILENAME (CAR HVAL) (CDR HVAL))) (RETURN))) (COND (MSREADONLYFLG (* There is no local value)
(OLDHASHPUTTABLE KEY (CONS VALUE (COND (HVAL (SETFILEPTR MSHASHFILENAME (CAR HVAL)) (READ MSHASHFILENAME FILERDTBL))
)) (CAR TABLE))) (T (* We simply add on the file) (SETFILEPTR MSHASHFILENAME -1) (PUTHASHFILE (MSKEY TABLE KEY)
(CBOX (IBOX (GETFILEPTR MSHASHFILENAME)) (PROGN (PRIN3 "( " MSHASHFILENAME) (PRIN4 VALUE MSHASHFILENAME FILERDTBL)
(COND (HVAL (COPYBYTES MSHASHFILENAME MSHASHFILENAME (IBOX (ADD1 (CAR HVAL))) (CDR HVAL))) (T
(PRIN3 " )" MSHASHFILENAME))) (IBOX (GETFILEPTR MSHASHFILENAME)))) MSHASHFILE))))))
(SHOULDNT))
(T (OLDHASHADDTABLE KEY VALUE TABLE])
(HFSUBTABLE
[LAMBDA (KEY VALUE TABLE) (* lmm " 7-APR-81 22:55")
(COND
((type? HFTABLE TABLE)
(* COND ((OLDHASHTESTTABLE KEY (fetch LOCALARRAY of TABLE)) (COND (MSREADONLYFLG (OLDHASHSUBTABLE KEY VALUE
(fetch LOCALARRAY of TABLE)) (COND ((NOT (OLDHASHTESTTABLE KEY (fetch LOCALARRAY of TABLE)))
(* Stick in the bogus value if that emptied it.) (OLDHASHPUTTABLE KEY (BOGUSVAL) (fetch LOCALARRAY of TABLE)))))
(T (* Copy the new value out to the file. This case doesn't arise if the local database is flushed with a writeable
file.) (PROG ((OLDV (OLDHASHGETTABLE KEY (fetch LOCALARRAY of TABLE)))) (COND ((AND (EQ (CAR OLDV) VALUE)
(NULL (CDR OLDV))) (PUTHASHFILE (MSKEY TABLE KEY) NIL MSHASHFILENAME) (RETURN))) (SETFILEPTR MSHASHFILENAME -1)
(PUTHASHFILE (MSKEY TABLE KEY) (CBOX (IBOX (GETFILEPTR MSHASHFILENAME)) (PROGN (PRIN3 "( " MSHASHFILENAME)
(for V in OLDV unless (EQ V VALUE) do (PRIN4 V MSHASHFILENAME FILERDTBL) (PRIN3 " " MSHASHFILENAME))
(PRIN3 ")" MSHASHFILENAME) (IBOX (GETFILEPTR MSHASHFILENAME)))) MSHASHFILE)) (OLDHASHPUTTABLE KEY NIL
(fetch LOCALARRAY of TABLE))))) (T (PROG (FIRST NC (HVAL (GETHASHFILE (MSKEY TABLE KEY) MSHASHFILENAME)))
(COND (HVAL (SETFILEPTR MSHASHFILENAME (IBOX (ADD1 (CAR HVAL)))) (COND ((OR (SETQ FIRST (EQ VALUE
(RATOM MSHASHFILENAME FILERDTBL))) (FILEPOS (MSVAL VALUE) MSHASHFILENAME NIL (CDR HVAL))) (COND
(MSREADONLYFLG (* There is no local value) (OLDHASHPUTTABLE KEY (OR (DREMOVE VALUE (PROGN (SETFILEPTR MSHASHFILENAME
(CAR HVAL)) (READ MSHASHFILENAME FILERDTBL))) (BOGUSVAL)) (fetch LOCALARRAY of TABLE))) (T (COND
(FIRST (* VALUE was the first element of the file expression. If it is also the last, we can remove the whole hash
entry.) (SETQ FIRST (IBOX (GETFILEPTR MSHASHFILENAME))) (RATOM MSHASHFILENAME FILERDTBL) (COND
((IEQP (CDR HVAL) (GETFILEPTR MSHASHFILENAME)) (* This was the first and only key) (PUTHASHFILE
(MSKEY TABLE KEY) NIL MSHASHFILE) (RETURN)) (T (SETQ NC (NCHARS VALUE T FILERDTBL)) (SETFILEPTR MSHASHFILENAME
(IDIFFERENCE FIRST NC))))) (T (SETQ NC (ADD1 (NCHARS VALUE T FILERDTBL))))) (* We simply erase on the file)
(RPTQ NC (PRIN3 " " MSHASHFILENAME)))))))))))
(SHOULDNT))
(T (OLDHASHSUBTABLE KEY VALUE TABLE])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(TYPERECORD HFTABLE (NAME LOCALARRAY KEY INVFLG))
]
)
(DEFINEQ
(LOCALFNP
[LAMBDA (FN) (* lmm "11-APR-81 20:59")
(* T if FN is KNOWN in the local database)
(for TAB in (QUOTE (CALL REF NOBIND)) when (AND (OLDHASHTESTTABLE
FN
(COND
([type? HFTABLE (SETQ TAB
(CADR (ASSOC TAB MSDATABASELST]
(SETQ TAB (fetch LOCALARRAY of TAB)))
(T TAB)))
(NOT (OLDHASHEQMEMBTABLE FN (BOGUSVAL)
TAB)))
do (RETURN T])
(MSKEY
[LAMBDA (TABLE KEY) (* lmm " 9-APR-81 22:01")
(OR (type? HFTABLE TABLE)
(SHOULDNT))
(RPLSTRING MSHASHSCRATCHSTRING 1 (fetch KEY of TABLE))
(RPLSTRING MSHASHSCRATCHSTRING 3 KEY)
(SUBSTRING MSHASHSCRATCHSTRING 1 (IPLUS 2 (NCHARS KEY))
(CONSTANT (CONCAT])
(FORWARDTABLE
[LAMBDA (TABLE) (* lmm " 7-APR-81 21:56")
(for X in MSDATABASELST when (EQ (CAR X)
(fetch NAME of TABLE))
do (RETURN (CADR X)) finally (SELECTQ (fetch NAME of TABLE)
(HELP])
(MSVAL
[LAMBDA (VAL) (* rmk: " 1-JUN-79 14:04")
(* Produces a string with all the escapes needed for searching with FILEPOS for
PRIN2-pnames)
(DECLARE (USEDFREE MSHASHSCRATCHSTRING FILERDTBL))
(RPLSTRING MSHASHSCRATCHSTRING 1 " ")
(for I C from 1 while (SETQ C (NTHCHAR VAL I T FILERDTBL)) do (RPLSTRING MSHASHSCRATCHSTRING
(ADD1 I)
C)
finally (RPLSTRING MSHASHSCRATCHSTRING (ADD1 I)
" ")
(RETURN (SUBSTRING MSHASHSCRATCHSTRING 1 (ADD1 I)
(CONSTANT (CONCAT])
(NEXTHASHKEY
[LAMBDA NIL (* lmm " 7-APR-81 22:57")
(PROG1 NEXTHASHKEY (PUTHASHFILE (QUOTE NEXTHASHKEY)
(CONS (add NEXTHASHKEY 1)
0)
MSHASHFILE])
(STOREHASHVALUE
[LAMBDA (KEY VALUE TABLE) (* lmm "11-APR-81 15:14")
(SETFILEPTR MSHASHFILENAME -1)
(PUTHASHFILE (MSKEY TABLE KEY)
[AND VALUE (CBOX (IBOX (GETFILEPTR MSHASHFILENAME))
(PROGN (COND
((LISTP VALUE)
(PRIN3 "( " MSHASHFILENAME)
[for V on VALUE do (PRIN4 (CAR V)
MSHASHFILENAME FILERDTBL)
(PRIN3 " " MSHASHFILENAME)
finally (COND
(V (PRIN3 ". " MSHASHFILENAME)
(PRIN4 V MSHASHFILENAME FILERDTBL)
(PRIN3 " " MSHASHFILENAME]
(* Don't use SPACES to avoid line positioning)
(PRIN3 ")" MSHASHFILENAME))
(T (PRIN3 " " MSHASHFILENAME)
(* The leading space is for the EQMEMB predicate)
(PRIN4 VALUE MSHASHFILENAME FILERDTBL)
(PRIN3 " " MSHASHFILENAME)))
(IBOX (GETFILEPTR MSHASHFILENAME]
MSHASHFILE)
VALUE])
(GETHASHTABLE
[LAMBDA (KEY TABLE)
(AND (SETQ KEY (GETHASHFILE (MSKEY TABLE KEY)
MSHASHFILE))
(PROGN (SETFILEPTR MSHASHFILENAME (CAR KEY))
(READ MSHASHFILENAME FILERDTBL])
)
(RPAQ MSHASHSCRATCHSTRING (CONCAT MACSCRATCHSTRING))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS MSHASHSCRATCHSTRING)
)
(ADDTOVAR MSHASHFILE )
(ADDTOVAR MSHASHFILENAME )
(ADDTOVAR MSREADONLYFLG )
(ADDTOVAR NEXTHASHKEY )
(ADDTOVAR MSFILETABLE )
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
NOBOX)
(PUTPROPS BOGUSVAL MACRO (NIL (QUOTE **BOGUSVALUE**)))
(PUTPROPS BOGUSVALP MACRO ((X)
(EQ X (QUOTE **BOGUSVALUE**))))
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
HASH)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(ANALYZEFILES
[LAMBDA (FILES EVENIFVALID) (* lmm "15-APR-81 12:04")
(* Reanalyzes functions on the files inside FILES, and enters the files' dates in the masterscope file-table.
-
Each file-specification can be a list of the form (file . fns), where fns=T => all, fns=NIL => none, and otherwise
fns is a list of fns to be examined. A litatom file-specification is interpreted as (file . T). If n -
if fns=T and EVENIFVALID=NIL, attempt to load a .DATABASE file.)
(for X FILE N D FNS ALLFNS inside FILES collect (COND
((LISTP X)
(SETQ FILE (CAR X))
(SETQ FNS (CDR X)))
(T (SETQ FILE X)
(SETQ FNS T)))
(SETQ N (NAMEFIELD FILE))
(COND
((CDR (LISTP FILES))
(printout T T .P2 FILE T)))
[COND
((NOT (MEMB N FILELST))
(RESETVARS ((LOADDBFLG (QUOTE NO)))
(SETQ FILE (LOADFROM FILE)))
(* In case there's some spelling correction)
(SETQ N (NAMEFIELD FILE]
[SETQ D (CAR (GETPROP N (QUOTE FILEDATES]
(COND
([OR EVENIFVALID (NEQ FNS T)
(NOT (AND (GETD (QUOTE LOADDB))
(LOADDB (CDR D]
(SETQ ALLFNS (FILEFNSLST N))
(* RESETLST so temporary state is flushed, in particular, the file that
masterscope opens.)
(RESETLST (for F in (COND
((EQ FNS T)
ALLFNS)
(T FNS))
do (UPDATEFN F T)))
(UPDATECONTAINS N ALLFNS)
(STORETABLE N MSFILETABLE D)))
(COND
((CDR (LISTP FILES))
(TERPRI T)))
(CDR D])
(BUILDDB
[LAMBDA (NAME FILES) (* rmk: "16-APR-80 08:57")
(* For creating a database and adding files to it. If NAME and FILES are both NIL, will make a new version of the
current database)
(DECLARE (GLOBALVARS MSHASHFILENAME))
(OR NAME (SETQ NAME MSHASHFILENAME)
(ERROR "No database file name"))
[COND
((NULL FILES)
(SETDB NAME)
(SETQ FILES (MSFILES]
(SETDB NAME (QUOTE CREATE))
(SETQ FILES (for F inside FILES collect (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
F)))
(ANALYZEFILES FILES T)
(SETDB NAME])
(COPYDB
[LAMBDA (OLDFILE NEWFILE LEAVEOPEN)
(* rmk: "14-NOV-79 19:38")
(* Copies the ms database on OLDFILE to NEWFILE, compressing out old space)
(DECLARE (SPECVARS OLDFILE NEWFILE))
[SETQ OLDFILE (INFILEP (COND
(OLDFILE (PACKFILENAME (QUOTE BODY)
OLDFILE
(QUOTE EXTENSION)
(QUOTE HASHDATABASE)))
(T MSHASHFILENAME]
[SETQ NEWFILE (OUTFILEP (COND
(NEWFILE (PACKFILENAME (QUOTE BODY)
NEWFILE
(QUOTE EXTENSION)
(QUOTE HASHDATABASE)))
(T (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
OLDFILE]
(COPYHASHFILE OLDFILE NEWFILE [FUNCTION (LAMBDA (VAL)
(SETFILEPTR NEWFILE -1)
(COND
((IEQP (CDR VAL)
0)
(* This is a nexthashkey entry)
VAL)
(T (CBOX (IBOX (GETFILEPTR NEWFILE))
(PROGN (COPYBYTES OLDFILE NEWFILE (CAR VAL)
(CDR VAL))
(IBOX (GETFILEPTR NEWFILE]
NIL LEAVEOPEN])
(FLUSHDB
[LAMBDA NIL (* lmm "18-APR-81 10:54")
(DECLARE (SPECVARS . T))
(AND MSHASHFILENAME (NOT MSREADONLYFLG)
(for X in MSDATABASELST bind LA KEYS FILEV TABLE
do [COND
((type? HFTABLE (SETQ TABLE (CDDR X)))
(SETQ KEYS NIL)
(SETQ REMKEYS NIL)
[OLDHASHMAPTABLE (SETQ LA (fetch LOCALARRAY of TABLE))
(FUNCTION (LAMBDA (VAL ITEM)
(COND
((STOREHASHVALUE ITEM (HFGETTABLE ITEM TABLE)
TABLE)
(push KEYS ITEM))
(T (push REMKEYS ITEM)))
(OLDHASHPUTTABLE ITEM NIL LA]
(AND (OR KEYS REMKEYS)
(STOREHASHVALUE (QUOTE **ALLKEYS**)
(UNION KEYS (LDIFFERENCE (GETHASHTABLE (QUOTE **ALLKEYS**)
TABLE)
REMKEYS))
TABLE]
(COND
((type? HFTABLE (SETQ TABLE (CADR X)))
(SETQ KEYS NIL)
(SETQ REMKEYS NIL)
[OLDHASHMAPTABLE (SETQ LA (fetch LOCALARRAY of TABLE))
(FUNCTION (LAMBDA (VAL ITEM)
(COND
((BOGUSVALP VAL)
(SETQ VAL)))
(COND
(VAL (push KEYS ITEM))
(T (push REMKEYS ITEM)))
(OR (EQLST VAL (GETHASHTABLE ITEM TABLE))
(STOREHASHVALUE ITEM VAL TABLE))
(OLDHASHPUTTABLE ITEM NIL LA]
(COND
((OR KEYS REMKEYS)
(SETQ KEYS (UNION (COND
((SETQ FILEV (GETHASHFILE (MSKEY TABLE (QUOTE **ALLKEYS**))
MSHASHFILE))
(SETFILEPTR MSHASHFILENAME (CAR FILEV))
(LDIFFERENCE (SETQ FILEV (READ MSHASHFILENAME FILERDTBL))
REMKEYS)))
KEYS))
(OR (EQLST FILEV KEYS)
(STOREHASHVALUE (QUOTE **ALLKEYS**)
KEYS TABLE])
(EQLST
[LAMBDA (L1 L2) (* lmm "15-APR-81 12:03")
(for X in L1 when (NOT (FMEMB X L2)) do (RETURN) finally (RETURN (for X in L2
when (NOT (FMEMB X L1))
do (RETURN)
finally (RETURN T])
(HFGETARGS
[LAMBDA (NAME DEF DATA) (* rmk: " 1-JUN-81 23:37")
(* An analyze userfn that collects the argument list for the ARG table)
(DECLARE (GLOBALVARS MSHASHFILENAME))
[if MSHASHFILENAME
then (* NLSETQ cause ARGLIST could cause an error)
(NLSETQ (RPLACD (FASSOC 'ARG DATA)
(OR (ARGLIST DEF)
T]
DATA])
(MSFILECHECK
[LAMBDA (FILES) (* lmm " 7-APR-81 23:05")
(* Returns alist containing the fullnames of files inside FILES which were known to the database and no longer exist
(keyed under DELETED) or whose latest version is not known to the database (keyed under CHANGED). If FILES=T, checks
the files known to the database. If FILES=NIL, uses filelst)
[COND
((EQ FILES T)
(SETQ FILES (MSFILES)))
(FILES)
(T (SETQ FILES (SORT (for F in FILELST collect (CDAR (GETPROP F (QUOTE FILEDATES]
(for FL NF CHANGED DELETED inside FILES do (COND
[(SETQ NF (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FL)))
(COND
([NEQ NF (CDR (GETTABLE (NAMEFIELD FL)
(CADR MSFILETABLE]
(push CHANGED NF]
([SETQ FL (CDR (GETTABLE (NAMEFIELD FL)
(CADR MSFILETABLE]
(push DELETED FL)))
(* The file disappeared if NF=NIL--return the previously known name)
finally (RETURN (NCONC [COND
(DELETED (LIST (CONS (QUOTE DELETED)
(DREVERSE DELETED]
(COND
(CHANGED (LIST (CONS (QUOTE CHANGED)
(DREVERSE CHANGED])
(MSFILES
[LAMBDA NIL (* lmm " 7-APR-81 23:05")
(* Returns a list of the files known to the current ms database.)
(DECLARE (USEDFREE MSFILETABLE))
(PROG (VAL)
(DECLARE (SPECVARS VAL))
[MAPTABLE (CADR MSFILETABLE)
(FUNCTION (LAMBDA (DATE FILE)
(push VAL (CDR DATE]
(RETURN (SORT VAL])
(RESTOREDB
[LAMBDA (FILE WRITEDATE OLDFILES)
(* lmm "10-APR-81 09:40")
(* Re-opens a (new version of a) previously opened database file. Used as a status function for the mshashfile.
OLDFILES is a list of fullnames of files that were on FILELST and known to the database when the sysout was made.)
(PROG NIL
(AFTERCLOSE FILE)
(SETQ FILE (SETDB (OR (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FILE))
(RETURN (PROGN (SETDB)
NIL)))
(QUOTE RESTORE)))
[COND
([NOT (IEQP WRITEDATE (GETFILEINFO FILE (QUOTE IWRITEDATE]
(for OLDF FLG NEWF in OLDFILES unless (EQ [SETQ NEWF (CDR (GETTABLE (CAR OLDF)
(CADR MSFILETABLE]
(CDR OLDF))
do (* If NEWF=NIL, the file was removed from the database.
Perhaps we should mark all its in-core functions as needing reanalysis)
(COND
((NULL FLG)
(printout T T
"***WARNING: The database has been updated. Information about files
that you currently have loaded has changed:"
T)
(SETQ FLG T)))
(COND
[(CDR OLDF)
(printout T T .P2 (CDR OLDF)
" has been ")
(COND
(NEWF (printout T "replaced by " .P2 NEWF))
(T (printout T "deleted"]
(T (printout T T .P2 NEWF " has been added")))
finally (COND
(FLG (printout T T T
"You might want to LOADFROM or REANALYZE those files."
T]
(RETURN T])
(SETDB
[LAMBDA (FILE MODE) (* lmm "12-APR-81 16:00")
(* * Sets FILE to be the current masterscope hashfile, open for write if MODE is T or BOTH, new file if MODE=CREATE,
restores old database if MODE=RESTORE. If FILE is NIL, closes any such file which is currently open.
If FILE is T, simply changes the write-mode of the current file)
(DECLARE (USEDFREE MSHASHFILE MSHASHFILENAME MSREADONLYFLG NEXTHASHKEY MSDBEMPTY MSFILETABLE
FILELST MSDATABASELST))
(* MSDBEMPTY is a masterscope variable)
(PROG [CLOSEDFILE (RESTOREFLG (EQ MODE (QUOTE RESTORE]
[COND
((AND MSHASHFILE (HASHFILEP MSHASHFILE))
(OR (EQ MODE (QUOTE NOFLUSH))
(FLUSHDB))
(SETQ CLOSEDFILE (CLOSEHASHFILE MSHASHFILE]
[COND
[(EQ FILE T) (* Reopen the old file with a new access mode)
(COND
(CLOSEDFILE (SETQ MSHASHFILE (OPENHASHFILE CLOSEDFILE MODE]
(FILE (SETQ FILE (PACKFILENAME (QUOTE BODY)
FILE
(QUOTE EXTENSION)
(QUOTE HASHDATABASE)))
(COND
(RESTOREFLG (* Don't want to wipe out old local database;
use previous read mode.)
(SETQ MODE (NOT MSREADONLYFLG)))
(T (%. ERASE)))
[SETQ MSHASHFILE (COND
((EQ MODE (QUOTE CREATE))
(SETQ MODE T)
(SETQ MSDBEMPTY T)
(CREATEHASHFILE FILE (QUOTE 2NUMBERS)))
(T (OPENHASHFILE FILE MODE]
(COND
[(SETQ NEXTHASHKEY (GETHASHFILE (QUOTE NEXTHASHKEY)
MSHASHFILE))
(* Copy the shared)
(SETQ NEXTHASHKEY (IPLUS (CAR NEXTHASHKEY]
(T (SETQ NEXTHASHKEY (CONSTANT (CHCON1 (QUOTE A]
(RETURN (COND
(MSHASHFILE [COND
((NULL CLOSEDFILE)
(* Set up the hashfile functions the first time a database is open.
That way non-users don't pay.)
(MAPC MSHFNS (FUNCTION (LAMBDA (X)
(MOVD (CAR X)
(CADR X]
[WHENCLOSE (HASHFILENAME MSHASHFILE)
(QUOTE STATUS)
[FUNCTION (LAMBDA (FILE)
(LIST (QUOTE RESTOREDB)
FILE
(GETFILEINFO FILE (QUOTE IWRITEDATE))
(for F in FILELST
collect
(* The CDR is NIL for files not in the database)
(CONS F (CDR (HFGETTABLE
F
(CADR MSFILETABLE]
(QUOTE CLOSEALL)
(QUOTE NO)
(QUOTE EOF)
(QUOTE NILL)
(QUOTE AFTER)
(FUNCTION (LAMBDA (F)
(SETQ MSHASHFILENAME NIL)
(SETQ MSHASHFILE NIL]
(SETQ MSHASHFILENAME (HASHFILENAME MSHASHFILE))
(SETQ MSREADONLYFLG (SELECTQ MODE
((INPUT NIL)
T)
NIL))
(COND
((AND (NEQ FILE T)
(NOT RESTOREFLG))
(COND
((NULL MSDATABASELST)
(%. WHO CALLS FUM)))
(* Gets the database initialized, even though MSINIT isn't an entry.)
))
MSHASHFILENAME)
(CLOSEDFILE (%. ERASE)
(* If we're closing up, need to make masterscope think the database went away, or it will still try to do lookups on
random occasions, such as a record redeclaration)
CLOSEDFILE])
(UPDATECONTAINS
[LAMBDA (FILE NEWFNS KEEPFLG) (* lmm "11-MAY-81 22:12")
(* Makes sure that the database is aware of which functions have disappeared, and who contains what.
FILE is just the namefield. KEEPFLG is T hhen called from DUMPDB. We then are more cautious about destroying
information about this function, cause it might have been moved to another file.)
(PROG (UPDATEFNS (TBL (ASSOC (QUOTE CONTAINS)
MSDATABASELST))
OLDFNS)
(DECLARE (SPECVARS UPDATEFNS))
(SETQ OLDFNS (GETTABLE FILE (CADR TBL)))
(COND
((AND (NOT KEEPFLG)
(SETQ UPDATEFNS (LDIFFERENCE OLDFNS NEWFNS)))
(%. ERASE IN UPDATEFNS)))
[for FN in OLDFNS when (NOT (FMEMB FN NEWFNS))
do (* Keep a single file, not a list, cause the analyzed definition is from only one
file.)
(for CONTAINER inside (GETTABLE FN (CDDR TBL))
do (STORETABLE CONTAINER TBL (REMOVE FN (GETTABLE CONTAINER (CADR TBL]
(STORETABLE FILE TBL NEWFNS])
(UPDATEDB
[LAMBDA (ADDFILES DELETEFILES ADDONLY NOGCFLG) (* rmk: "10-APR-82 14:07")
(* Copies the current masterscope hash-file into a scratch file, then information about files inside DELETEFILES
(and erases function information for functions only on those files), then loads the .DATABASE files for the files in
ADDFILES. The copy is so that this function will execute even though someone else is reading the current database.
The database is copied to a scratch file, then renamed to be a newer version of the previous database, which is
deleted. This allows others to use the old database while the copying is going on. If an earlier version of the
scratch file exists, it means that someone else is currently updating (there version disappears when the complete
successfully or logout), so we wait for them to finish.)
(* Doesn't look for out-of-date files if ADDONLY. -
If ADDFILES is a FIXP, it is the maximum number of files to be analyzed, as a precaution against running out of
space when updating large databases. Repeated calls on UPDATEDB with a low ADDFILES should get through.
-
If NOGCFLG, the database is copied without compacting, which is considerably faster, though the resulting file is
much larger. It may be fastest to do a number of updates with a small ADDFILES and NOGCFLG, then do a final one with
compacting.)
(COND
((NOT MSHASHFILENAME)
(ERROR "No current hash-database file")))
(RESETLST (PROG (SCRATCH CHECKEDFILES DBFILES NFILES NADDFILES (NHF (LIST NIL))
(OLDMSN MSHASHFILENAME))
[RESETSAVE (PROGN NHF)
(QUOTE (PROGN (CLOSEF? (CAR OLDVALUE))
(AND RESETSTATE (DELFILE (CAR OLDVALUE]
[SETQ NHF (CAR (RPLACA NHF (CLOSEF (OPENFILE (SETQ SCRATCH
(PACKFILENAME (QUOTE DIRECTORY)
(FILENAMEFIELD
OLDMSN
(QUOTE DIRECTORY))
(QUOTE NAME)
(QUOTE
NEWHASHDATABASE)
(QUOTE EXTENSION)
(QUOTE SCRATCH)
(QUOTE TEMPORARY)
(QUOTE S)))
(QUOTE OUTPUT)
(QUOTE NEW]
(* The CONS cell holds the name for resetsaves, but we
don't need it below)
(* PACKFILENAME produces version -1 for ;S on TOPS20)
[COND
((EQ (SYSTEMTYPE)
(QUOTE TOPS20))
(SETQ SCRATCH (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
SCRATCH]
[bind OLDV RPT_1 until [EQ NHF (SETQ OLDV (FULLNAME SCRATCH (QUOTE OLDEST]
do (DISMISS 2000)
(COND
((NULL RPT))
((EQ RPT 5)
(printout T T (GETFILEINFO OLDV (QUOTE AUTHOR))
" seems to be updating the database right now." T
"I'm waiting for him to finish."
T T)
(SETQ RPT NIL))
(T (add RPT 1]
(* If there is a version earlier than the one we got, someone else must have it, and we must wait until he gets rid
of it (by deleting it))
[COND
((NULL ADDONLY) (* Do this first, so user can break MSFILECHECK to
modify things without having to wait for the copy to
complete.)
(SETQ CHECKEDFILES (MSFILECHECK T]
[RESETSAVE (SETDB)
(QUOTE (PROGN (SETDB (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
OLDVALUE]
(* Leave this sysout with the latest version of the
current database open--hopefully, the new one.)
(COND
((FIXP ADDFILES)
(SETQ NFILES ADDFILES) (* Limit on number of files to analyze is coded in
ADDFILES; necessary as an antidote to storage-full)
(SETQ ADDFILES NIL)))
(SETQ ADDFILES (NCONC (CDR (FASSOC (QUOTE CHANGED)
CHECKEDFILES))
(MKLIST ADDFILES)))
(SETQ ADDFILES (for F in ADDFILES unless (bind (NAMEF _(NAMEFIELD F))
thereis DF in DELETEFILES
suchthat (EQ NAMEF (NAMEFIELD DF)))
collect F))
(SETQ NADDFILES (LENGTH ADDFILES))
(COND
((IGREATERP NADDFILES 0)
(printout T T NADDFILES " files to be updated:" 5 .PARA2 5 0 ADDFILES)))
(COND
(NOGCFLG (OR (GETD (QUOTE COPYFILE))
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
COPYFILE))
(COPYFILE OLDMSN NHF)
(* Currently, COPYFILE on 10 closes the file and uses EXEC copy command, which correctly handles hashfile holes.
However, the file comes back closed, so we re-open it to be consistent with the LEAVEOPEN logic.)
(OPENHASHFILE NHF (QUOTE BOTH)))
(T (COPYDB OLDMSN NHF T)))
(* Must leave the new file left open--otherwise, the user might lose access to it before he has started to load in
the .DATABASE files)
(SETDB NHF T)
(for F inside DELETEFILES do (SETQ F (NAMEFIELD F))
(UPDATECONTAINS F)
(STORETABLE F MSFILETABLE NIL))
(for F NAMEF in (CDR (FASSOC (QUOTE DELETED)
CHECKEDFILES))
eachtime (SETQ NAMEF (NAMEFIELD F))
when [AND (for DF inside DELETEFILES never (EQ NAMEF (NAMEFIELD DF)))
(EQ (QUOTE Y)
(ASKUSER DWIMWAIT (QUOTE Y)
(LIST (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
F)
"no longer exists. Shall I remove it from the database"]
do (UPDATECONTAINS NAMEF)
(STORETABLE NAMEF MSFILETABLE NIL))
[for F DBF in ADDFILES as I to (OR NFILES NADDFILES)
do (printout T T T .P2 F T)
(COND
((SETQ DBF (LOADDB (FINDFILE F)))
(push DBFILES DBF))
(T (ANALYZEFILES F T]
(SETDB)
(* This closes the file, but other updaters are still locked out cause they go for a new version and then trip over
our old one.)
[COND
((SETQ NHF (RENAMEFILE NHF (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
OLDMSN)))
(bind F (OLDV _(FILENAMEFIELD OLDMSN (QUOTE VERSION)))
(STEM _(PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
OLDMSN))
while (AND (SETQ F (FULLNAME STEM (QUOTE OLDEST)))
(IGEQ OLDV (FILENAMEFIELD F (QUOTE VERSION)))
(DELFILE F)))
(* Success: We delete the old hash file and all the .DATABASE files we loaded, plus any earlier versions.
DELFILE will return NIL if we don't have deletion rights.)
(for DBF in DBFILES do (* Don't delete dbfiles newer than the one we just read)
(bind F (OLDV _(FILENAMEFIELD DBF (QUOTE VERSION)))
(STEM _(PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
DBF))
while (AND (SETQ F (FULLNAME STEM (QUOTE OLDEST)))
(IGEQ OLDV (FILENAMEFIELD F
(QUOTE VERSION)
))
(DELFILE F]
(* Now others can get in to read or update.)
(IF (AND NFILES (IGREATERP NADDFILES NFILES))
THEN (PRINTOUT T T (IDIFFERENCE NADDFILES NFILES)
" files still to be updated." T))
(RETURN NHF])
)
(ADDTOVAR ANALYZEUSERFNS HFGETARGS)
(DECLARE: DONTCOPY
(FILEMAP (NIL (2230 13620 (HFGETTABLE 2242 . 3209) (HFMAKETABLE 3213 . 4333) (HFMAPTABLE 4337 . 5562)
(HFTESTTABLE 5566 . 6684) (HFEQMEMBTABLE 6688 . 7624) (HFSTORETABLE 7628 . 8127) (HFPUTTABLE 8131 .
8845) (HFADDTABLE 8849 . 11194) (HFSUBTABLE 11198 . 13617)) (13731 16969 (LOCALFNP 13743 . 14277) (
MSKEY 14281 . 14607) (FORWARDTABLE 14611 . 14896) (MSVAL 14900 . 15540) (NEXTHASHKEY 15544 . 15755) (
STOREHASHVALUE 15759 . 16765) (GETHASHTABLE 16769 . 16966)) (17643 39696 (ANALYZEFILES 17655 . 19472)
(BUILDDB 19476 . 20150) (COPYDB 20154 . 21287) (FLUSHDB 21291 . 23061) (EQLST 23065 . 23350) (
HFGETARGS 23354 . 23855) (MSFILECHECK 23859 . 25213) (MSFILES 25217 . 25637) (RESTOREDB 25641 . 27303)
(SETDB 27307 . 30736) (UPDATECONTAINS 30740 . 31858) (UPDATEDB 31862 . 39693)))))
STOP