(FILECREATED " 7-Nov-84 16:37:37" {ERIS}<LISPCORE>LIBRARY>HASH.;6 24200
changes to: (VARS HASHCOMS HASHFNS)
(FNS HASHFILENAME)
previous date: " 2-Sep-84 16:42:32" {ERIS}<LISPCORE>LIBRARY>HASH.;4)
(* Copyright (c) 1984 by Chris Lane and Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HASHCOMS)
(RPAQQ HASHCOMS ((FNS * HASHFNS)
(FNS DELETEHASHKEY FIND1STPRIME GETHASHKEY GETPROBE GTHASHFILE HASHFILESPLST1 INSERTHASHKEY
MAKEHASHKEY REPLACEHASHKEY SETHASHSTATUS SPLITKEY)
(FNS TESTHASH)
[VARS HASHFILEDEFAULTSIZE HASHLOADFACTOR PROBELST
(HASHSCRATCHLST (CONSTANT (for I to 30 collect NIL)))
HFGROWTHFACTOR REHASHGAG (HASHTEXTCHAR (CHARACTER 1))
(SYSHASHFILE)
(HASHFILERDTBL (COPYREADTABLE (QUOTE ORIG]
[VARS (HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR]
(ADDVARS (SYSHASHFILELST)
(AFTERSYSOUTFORMS (CLEARHASHFILES)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS HashFile)
(MACROS ANYEQ CREATEKEY GETHASHFILE HASHFILENAME MODTIMES PRINTPTR PRINTSTBYTE
READPTR READSTBYTE REHASHKEY)
(GLOBALVARS * HASHGLOBALS)
(SPECVARS REHASHGAG HASHFILERDTBL)
(BLOCKS (HASHFILEBLOCK (SPECVARS REHASHGAG HASHFILERDTBL)
(ENTRIES CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS
COPYHASHFILE COPYHASHITEM CREATEHASHFILE
GETHASHFILE HASHBEFORECLOSE HASHFILEDATA HASHFILEP
HASHFILEPROP HASHFILESPLST LOOKUPHASHFILE
MAPHASHFILE OPENHASHFILE PUTHASHFILE REHASHFILE)
CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS COPYHASHFILE
COPYHASHITEM CREATEHASHFILE DELETEHASHKEY FIND1STPRIME
GETHASHFILE GETHASHKEY GETPROBE GTHASHFILE HASHBEFORECLOSE
HASHFILEDATA HASHFILEP HASHFILEPROP HASHFILESPLST
HASHFILESPLST1 INSERTHASHKEY LOOKUPHASHFILE MAKEHASHKEY
MAPHASHFILE OPENHASHFILE PUTHASHFILE REHASHFILE
REPLACEHASHKEY SETHASHSTATUS SPLITKEY)))
(P (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DFOR10))
NIL))))
(RPAQQ HASHFNS (CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS COPYHASHFILE COPYHASHITEM CREATEHASHFILE
GETHASHFILE HASHBEFORECLOSE HASHFILEDATA HASHFILENAME HASHFILEP
HASHFILEPROP HASHFILESPLST LOOKUPHASHFILE MAPHASHFILE OPENHASHFILE
PUTHASHFILE REHASHFILE))
(DEFINEQ
(CLEARHASHFILES
[LAMBDA (CLOSE RELEASE) (* cdl "22-Aug-83 10:36")
(* Called after SYSOUT returns, to clean up any spurious
items. Can also be called to close all hashfiles.)
(COND
(CLOSE (while SYSHASHFILELST bind PAIR
do (SETQ PAIR (CAR SYSHASHFILELST)) (* Do it this way, so the DREMOVE in HASHBEFORECLOSE
doesn't screw up this iteration)
[COND
((OPENP (CAR PAIR))
(CLOSEF (CAR PAIR]
(replace Valid? of (CDR PAIR) with NIL)
(SETQ SYSHASHFILELST (CDR SYSHASHFILELST)))
(* Invalidate anything that was open before the sysout)
(SETQ SYSHASHFILE])
(CLOSEHASHFILE
[LAMBDA (HASHFILE REOPEN) (* cdl " 8-Sep-83 15:06")
(COND
((SETQ HASHFILE (HASHFILEP (OR HASHFILE SYSHASHFILE)))
(with HashFile HASHFILE (CLOSEF File)
(COND
(REOPEN (* This flag forces contents of file to exist on disk if
we crash)
(OPENHASHFILE File REOPEN))
(T File])
(COLLECTKEYS
[LAMBDA (HASHFILE DOUBLE MKSTRING?) (* cdl "24-Aug-83 16:07")
(DECLARE (SPECVARS MKSTRING?))
(PROG (KEYLST)
(DECLARE (SPECVARS KEYLST))
[COND
(DOUBLE (MAPHASHFILE HASHFILE [FUNCTION (LAMBDA (KEY1 KEY2)
(push KEYLST (CONS (COND
(MKSTRING? (MKSTRING KEY1))
(T KEY1))
(COND
(MKSTRING? (MKSTRING KEY2))
(T KEY2]
T))
(T (MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (KEY)
(push KEYLST (COND
(MKSTRING? (MKSTRING KEY))
(T KEY]
(RETURN KEYLST])
(COPYHASHFILE
[LAMBDA (HFILE NEWNAME FN VTYPE) (* cdl " 8-Sep-83 15:10")
(DECLARE (SPECVARS HFILE FN)) (* Copy HashFile by mapping over file hashing items into
new file, slow but lisp independent)
(with HashFile (SETQ HFILE (GTHASHFILE HFILE))
(PROG ((NEWHASHFILE (CREATEHASHFILE NEWNAME NIL NIL #Entries)))
(DECLARE (SPECVARS NEWHASHFILE))
[MAPHASHFILE HFILE (FUNCTION (LAMBDA (KEY)
(COPYHASHITEM KEY HFILE NEWHASHFILE FN]
(CLOSEHASHFILE NEWHASHFILE)
(RETURN NEWHASHFILE])
(COPYHASHITEM
[LAMBDA (KEY HASHFILE NEWHASHFILE USERFN) (* cdl " 8-Sep-83 15:11")
(* Copy single hash item from old to new hashfile,
applying userfn if supplied)
(COND
(USERFN (LOOKUPHASHFILE KEY (APPLY* USERFN (GETHASHFILE KEY HASHFILE)
HASHFILE NEWHASHFILE)
NEWHASHFILE
(QUOTE INSERT)))
(T (LOOKUPHASHFILE KEY (GETHASHFILE KEY HASHFILE)
NEWHASHFILE
(QUOTE INSERT])
(CREATEHASHFILE
[LAMBDA (FILE VALUETYPE ITEMLENGTH #ENTRIES SMASH) (* cdl " 8-Sep-83 15:03")
(PROG ([SIZE (FIND1STPRIME (FIX (FTIMES (OR #ENTRIES HASHFILEDEFAULTSIZE)
HFGROWTHFACTOR]
HASHFILE HFILE)
[SETQ HFILE (OPENFILE FILE (QUOTE BOTH)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(PRINTPTR HFILE 0 2)
(PRINTPTR HFILE SIZE 2)
(SETFILEPTR HFILE (ITIMES (ADD1 SIZE)
4)) (* Mark end of KEYS, start of DATA)
(BOUT HFILE 0)
[SETQ HASHFILE (COND
((type? HashFile SMASH)
SMASH)
(T (create HashFile]
(replace Size of HASHFILE with SIZE)
(replace #Entries of HASHFILE with 0)
(CLOSEF HFILE) (* Close file and reopen to ensure existance)
[SETQ HFILE (OPENFILE FILE (QUOTE BOTH)
(QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
(replace File of HASHFILE with HFILE)
(replace Write? of HASHFILE with T)
(SETHASHSTATUS HASHFILE)
(RETURN HASHFILE])
(GETHASHFILE
[LAMBDA (KEY HASHFILE KEY2) (* cdl " 3-Aug-83 15:04")
(LOOKUPHASHFILE (CREATEKEY KEY KEY2)
NIL HASHFILE (QUOTE RETRIEVE])
(HASHBEFORECLOSE
[LAMBDA (FILE) (* lmm " 2-Sep-84 16:31")
(* called before a hashfile is actually closed)
(PROG ((HASHENTRY (ASSOC (FULLNAME FILE)
SYSHASHFILELST))
HASHFILE)
(COND
((SETQ HASHFILE (CDR HASHENTRY))
(AND (EQ HASHFILE SYSHASHFILE)
(SETQ SYSHASHFILE))
(SETQ SYSHASHFILELST (DREMOVE HASHENTRY SYSHASHFILELST))
(* Remove from table of open hash files, and mark this
datum defunct)
(replace Valid? of HASHFILE with NIL])
(HASHFILEDATA
[LAMBDA (HASHFILE) (* cdl "22-Aug-83 12:12")
(with HashFile (GTHASHFILE HASHFILE)
(LIST File ValueType ItemLength #Entries])
(HASHFILENAME
[LAMBDA (HASHFILE) (* gbn " 7-Nov-84 16:34")
(HASHFILEPROP HASHFILE (QUOTE NAME])
(HASHFILEP
[LAMBDA (HASHFILE WRITE) (* cdl "23-Aug-83 08:36")
(AND [OR (type? HashFile HASHFILE)
(PROGN (* if atom is name of open file, get the associated
HashFile)
(AND HASHFILE (LITATOM HASHFILE)
(SETQ HASHFILE (CDR (OR (ASSOC HASHFILE SYSHASHFILELST)
(AND (SETQ HASHFILE (OPENP HASHFILE))
(ASSOC HASHFILE SYSHASHFILELST]
(fetch Valid? of HASHFILE)
(OR (NOT WRITE)
(fetch Write? of HASHFILE))
HASHFILE])
(HASHFILEPROP
[LAMBDA (HASHFILE PROP) (* cdl "15-Aug-83 09:37")
(with HashFile (GTHASHFILE HASHFILE)
(SELECTQ PROP
(VALUETYPE ValueType)
(ACCESS (GETFILEINFO File (QUOTE ACCESS)))
(NAME File)
(PROGN NIL])
(HASHFILESPLST
[LAMBDA (HASHFILE XWORD) (* cdl " 8-Sep-83 15:13"
)
(DECLARE (SPECVARS . T)) (* Just create an
Interlisp generator that
returns each hash key)
(COND
((SETQ HASHFILE (GTHASHFILE HASHFILE))
(GENERATOR (HASHFILESPLST1 HASHFILE XWORD])
(LOOKUPHASHFILE
[LAMBDA (KEY VALUE HASHFILE CALLTYPE KEY2) (* cdl "12-Sep-83 10:29")
(PROG ((INDEX (CREATEKEY KEY KEY2))
KEYVAL RETVAL RETFLG)
(SETQ HASHFILE (GTHASHFILE HASHFILE (ANYEQ (QUOTE (REPLACE DELETE INSERT))
CALLTYPE)))
(SETQ KEYVAL (GETHASHKEY INDEX HASHFILE (EQMEMB (QUOTE INSERT)
CALLTYPE)))
(COND
((MINUSP KEYVAL)
(COND
((EQMEMB (QUOTE INSERT)
CALLTYPE)
(INSERTHASHKEY (IMINUS KEYVAL)
INDEX VALUE HASHFILE)))
(RETURN))
(T [COND
((EQMEMB (QUOTE RETRIEVE)
CALLTYPE)
(SETQ RETFLG T)
(SETQ RETVAL (READ (fetch File of HASHFILE)
HASHFILERDTBL]
(COND
((EQMEMB (QUOTE REPLACE)
CALLTYPE)
(REPLACEHASHKEY KEYVAL INDEX VALUE HASHFILE))
((EQMEMB (QUOTE DELETE)
CALLTYPE)
(DELETEHASHKEY KEYVAL HASHFILE)))
(RETURN (COND
(RETFLG RETVAL)
(KEYVAL T])
(MAPHASHFILE
[LAMBDA (HASHFILE MAPFN DOUBLE) (* cdl " 8-Sep-83 15:16")
(with HashFile (SETQ HASHFILE (GTHASHFILE HASHFILE))
(PROG ([BOTH (IGREATERP (OR (NARGS MAPFN)
0)
(COND
(DOUBLE 2)
(T 1]
INDEX KEY HASHKEY)
(for I from 4 to (ITIMES Size 4) by 4 when (PROGN (SETFILEPTR File I)
(READSTBYTE Stream USED))
do (SETQ HASHKEY (READPTR Stream))
(SETFILEPTR File HASHKEY)
(SETQ KEY (READ File HASHFILERDTBL))
(COND
[DOUBLE (* Two key hashing so split up key, userfn takes two key
arguments)
(SETQ INDEX (SPLITKEY KEY))
(APPLY* MAPFN (CAR INDEX)
(CDR INDEX)
(COND
(BOTH (READ File HASHFILERDTBL]
(T (APPLY* MAPFN KEY (COND
(BOTH (READ File HASHFILERDTBL])
(OPENHASHFILE
[LAMBDA (FILE ACCESS ITEMLENGTH #ENTRIES SMASH) (* cdl " 9-Sep-83 16:01")
(COND
([OR ITEMLENGTH #ENTRIES (MEMB ACCESS (QUOTE (TEXT DOUBLE NUMBER STRING PRINT FULLPRINT]
(* This is really a createhashfile call, the original
hash package used openhashfile for both)
(CREATEHASHFILE FILE ACCESS ITEMLENGTH #ENTRIES))
(T (PROG (SIZE HASHFILE)
(SETQ ACCESS (SELECTQ ACCESS
((READ INPUT OLD NIL RETRIEVE)
(QUOTE INPUT))
((WRITE OUTPUT BOTH T INSERT DELETE REPLACE)
(QUOTE BOTH))
(PROGN NIL)))
(SETQ HASHFILE (CDR (ASSOC (OPENP FILE)
SYSHASHFILELST)))
(COND
([AND HASHFILE (EQUAL ACCESS (GETFILEINFO (fetch File of HASHFILE)
(QUOTE ACCESS]
(* This is the NO-OP case)
(RETURN HASHFILE)))
(CLOSEF? FILE)
[SETQ FILE (OPENFILE FILE ACCESS (QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
(SETQ #ENTRIES (READPTR FILE 2))
(SETQ SIZE (READPTR FILE 2))
[SETQ HASHFILE (COND
((type? HashFile SMASH)
SMASH)
(T (create HashFile]
(replace Size of HASHFILE with SIZE)
(replace #Entries of HASHFILE with #ENTRIES)
(replace File of HASHFILE with FILE)
(replace Write? of HASHFILE with (EQ ACCESS (QUOTE BOTH)))
(SETHASHSTATUS HASHFILE)
(RETURN HASHFILE])
(PUTHASHFILE
[LAMBDA (KEY VALUE HASHFILE KEY2) (* cdl "22-Aug-83 09:49")
[LOOKUPHASHFILE (CREATEKEY KEY KEY2)
VALUE HASHFILE (COND
(VALUE (QUOTE (REPLACE INSERT)))
(T (QUOTE DELETE]
VALUE])
(REHASHFILE
[LAMBDA (HASHFILE NEWNAME VALUETYPE) (* cdl " 8-Sep-83 15:18")
(with HashFile (SETQ HASHFILE (OR (HASHFILEP (OR HASHFILE SYSHASHFILE))
(GTHASHFILE HASHFILE)))
(PROG ([NAME (UNPACKFILENAME (OR NEWNAME (HASHFILENAME HASHFILE]
(ACCESS (HASHFILEPROP HASHFILE (QUOTE ACCESS)))
FN)
(LISTPUT NAME (QUOTE VERSION)
NIL)
(SETQ NAME (PACKFILENAME NAME))
[COND
(REHASHGAG (* If rehashgag = T then print out old and new file name
with a "." in between for every rehashed key)
(printout T "Rehashing" , File ,)
(SETQ FN (FUNCTION (LAMBDA (X)
(PROG1 X (printout T "."]
(COPYHASHFILE HASHFILE NAME FN)
(CLOSEHASHFILE HASHFILE)
(OPENHASHFILE NAME ACCESS NIL NIL HASHFILE)
(COND
(REHASHGAG (printout T , File T)))
(RETURN HASHFILE])
)
(DEFINEQ
(DELETEHASHKEY
[LAMBDA (HASHKEY HASHFILE) (* cdl "30-Aug-83 10:00")
(with HashFile HASHFILE (SETFILEPTR File HASHKEY)
(PRINTSTBYTE Stream DELETED)
(SETQ #Entries (SUB1 #Entries))
(SETFILEPTR File 0)
(PRINTPTR Stream #Entries 2])
(FIND1STPRIME
[LAMBDA (N) (* cdl "11-Aug-83 08:12")
(find P from (LOGOR N 1) by 2 suchthat (for I from 3 by 2 never (AND (ILESSP I P)
(ZEROP (IREMAINDER P I)))
repeatuntil (ILESSP P (ITIMES I I])
(GETHASHKEY
[LAMBDA (INDEX HASHFILE DELOK) (* cdl "12-Sep-83 10:24")
(with HashFile HASHFILE (bind PROBE (HASHKEY ←(MAKEHASHKEY INDEX Size)) first (SETFILEPTR File
HASHKEY)
until (COND
(DELOK (READSTBYTE Stream (FREE DELETED)))
(T (READSTBYTE Stream FREE)))
do (SETFILEPTR File (READPTR Stream))
(COND
((EQUAL INDEX (READ File HASHFILERDTBL))
(RETURN HASHKEY)))
[COND
((NULL PROBE)
(SETQ PROBE (GETPROBE INDEX]
(SETQ HASHKEY (REHASHKEY HASHKEY PROBE Size))
(SETFILEPTR File HASHKEY)
finally (RETURN (IMINUS HASHKEY])
(GETPROBE
[LAMBDA (KEY) (* cdl " 9-Sep-83 15:57"
) (* Get the value to
probe by. Probelst
contains all the probe
primes.)
(CAR (NTH PROBELST
(ADD1 (LOGAND 31
(CHCON1 (NTHCHAR
KEY
(ADD1 (LRSH (NCHARS KEY)
1])
(GTHASHFILE
[LAMBDA (HASHFILE WRITE) (* cdl "22-Aug-83 08:29")
(PROG (X)
(OR HASHFILE (SETQ HASHFILE SYSHASHFILE))
(* Return hashfile datum for HF, which is a filename or a hashfile datum. Special cases: if HASHFILE is a filename
which is not open, it is opened; if HASHFILE is an invalidated hashfile datum (because it was closed), it is
reopened; if HASHFILE is already open for read, but WRITE is set, will attempt to close and then open for write)
(RETURN (COND
((HASHFILEP HASHFILE WRITE))
((AND HASHFILE [OR (LITATOM (SETQ X HASHFILE))
(AND (type? HashFile HASHFILE)
(LITATOM (SETQ X (fetch File of HASHFILE]
(OPENHASHFILE X WRITE NIL NIL HASHFILE)))
(T (SETQ X)
(HELP HASHFILE "NOT A HASHFILE"])
(HASHFILESPLST1
[LAMBDA (HASHFILE XWORD) (* cdl "24-Aug-83 16:04"
)
(DECLARE (SPECVARS XWORD))
(MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (KEY)
(COND
[XWORD (COND
((EQ (NTHCHAR KEY 1)
XWORD)
(PRODUCE KEY]
(T (PRODUCE KEY])
(INSERTHASHKEY
[LAMBDA (HASHKEY INDEX VALUE HASHFILE) (* cdl "29-Aug-83 14:12")
(REPLACEHASHKEY HASHKEY INDEX VALUE HASHFILE)
(with HashFile HASHFILE (SETQ #Entries (ADD1 #Entries))
(SETFILEPTR File 0)
(PRINTPTR Stream #Entries 2)
(COND
((FGREATERP #Entries (FTIMES Size HASHLOADFACTOR))
(REHASHFILE HASHFILE])
(MAKEHASHKEY
[LAMBDA (KEY RANGE) (* cdl "12-Aug-83 08:57"
)
(LLSH (ADD1 (MODTIMES (DCHCON KEY HASHSCRATCHLST)
RANGE))
2])
(REPLACEHASHKEY
[LAMBDA (HASHKEY INDEX VALUE HASHFILE) (* cdl "30-Aug-83 10:00")
(with HashFile HASHFILE (SETFILEPTR File HASHKEY)
(PRINTSTBYTE Stream USED)
(PRINTPTR Stream (GETEOFPTR File))
(SETFILEPTR File -1)
(printout File .P2 INDEX , .P2 VALUE T])
(SETHASHSTATUS
[LAMBDA (HASHFILE) (* cdl "29-Aug-83 14:18")
(with HashFile HASHFILE (* Fix data structures to know about this file so they
get updated when it closes)
(WHENCLOSE File (QUOTE BEFORE)
(FUNCTION HASHBEFORECLOSE))
(SETQ Valid? T)
(SETQ ValueType (QUOTE EXPR))
[SETQ Stream (GETSTREAM File (GETFILEINFO File (QUOTE ACCESS]
(SETQ SYSHASHFILELST (CONS (CONS File HASHFILE)
SYSHASHFILELST))
(SETQ SYSHASHFILE HASHFILE])
(SPLITKEY
[LAMBDA (KEY) (* cdl " 4-Aug-83 10:06"
)
(PROG ((PTR (STRPOSL HASHBITTABLE KEY)))
(RETURN (CONS (SUBATOM KEY 1 (SUB1 PTR))
(SUBATOM KEY (ADD1 PTR])
)
(DEFINEQ
(TESTHASH
[LAMBDA (HASHFILE) (* cdl "30-Aug-83 09:54")
(PROG ((OLDGC (GCGAG NIL)))
(printout T "Inserting ..." T)
(TIME (for I to 1000 DO (PUTHASHFILE I (GENSYM)
HASHFILE)))
(printout T "Replacing ..." T)
(TIME (for I to 1000 DO (PUTHASHFILE I (GENSYM)
HASHFILE)))
(printout T "Retrieving ..." T)
(TIME (for I to 1000 DO (GETHASHFILE I HASHFILE)))
(printout T "Deleting ..." T)
(TIME (for I to 1000 DO (PUTHASHFILE I NIL HASHFILE)))
(GCGAG OLDGC])
)
(RPAQQ HASHFILEDEFAULTSIZE 512)
(RPAQQ HASHLOADFACTOR .875)
(RPAQQ PROBELST (1 3 5 7 11 11 13 17 17 19 23 23 29 29 29 31 37 37 37 41 41 43 47 47 53 53 53 59 59
59 61 67))
(RPAQ HASHSCRATCHLST (CONSTANT (for I to 30 collect NIL)))
(RPAQQ HFGROWTHFACTOR 3)
(RPAQQ REHASHGAG NIL)
(RPAQ HASHTEXTCHAR (CHARACTER 1))
(RPAQQ SYSHASHFILE NIL)
(RPAQ HASHFILERDTBL (COPYREADTABLE (QUOTE ORIG)))
(RPAQ HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR)))
(ADDTOVAR SYSHASHFILELST )
(ADDTOVAR AFTERSYSOUTFORMS (CLEARHASHFILES))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ARRAYRECORD HashFile (File Stream Size #Entries ValueType ItemLength Valid? Write?))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS ANYEQ MACRO [LAMBDA (X Y) (* cdl "22-Aug-83 08:39")
(for Z in X thereis (EQMEMB Z Y])
(PUTPROPS CREATEKEY MACRO [LAMBDA (KEY1 KEY2)
(COND
((NULL KEY2)
KEY1)
(T (PACK* KEY1 HASHTEXTCHAR KEY2])
(PUTPROPS GETHASHFILE MACRO [LAMBDA (KEY HASHFILE KEY2) (* cdl " 3-Aug-83 15:04")
(LOOKUPHASHFILE (CREATEKEY KEY KEY2)
NIL HASHFILE (QUOTE RETRIEVE])
(PUTPROPS HASHFILENAME MACRO [LAMBDA (HASHFILE) (* cdl " 2-Aug-83 10:48")
(HASHFILEPROP HASHFILE (QUOTE NAME])
(PUTPROPS MODTIMES MACRO [LAMBDA (N RANGE) (* cdl "12-Aug-83 08:54")
(for I in N bind (VAL ← 1) do (SETQ VAL (IMOD (ITIMES VAL I)
RANGE))
finally (RETURN VAL])
(PUTPROPS PRINTPTR MACRO [X (CONS (QUOTE PROGN)
(for I from (COND
((CADDR X)
(SUB1 (CADDR X)))
(T 2))
to 0 by -1
collect (LIST (QUOTE BOUT)
(CAR X)
(LIST (QUOTE LOGAND)
255
(COND
((ZEROP I)
(CADR X))
(T (LIST (QUOTE RSH)
(CADR X)
(ITIMES 8 I])
(PUTPROPS PRINTSTBYTE MACRO [X (LIST (QUOTE BOUT)
(CAR X)
(SELECTQ (CADR X)
((U USED)
(CONSTANT (CHARCODE U)))
((D DELETED)
(CONSTANT (CHARCODE D)))
((F FREE)
(CONSTANT (CHARCODE F)))
(NILL])
(PUTPROPS READPTR MACRO [X (CONS (QUOTE IPLUS)
(for I from (COND
((CADR X)
(SUB1 (CADR X)))
(T 2))
to 0 by -1 collect (COND
((ZEROP I)
(LIST (QUOTE BIN)
(CAR X)))
(T (LIST (QUOTE LLSH)
(LIST (QUOTE BIN)
(CAR X))
(ITIMES 8 I])
(PUTPROPS READSTBYTE MACRO [X (COND
[(ATOM (CADR X))
(LIST (QUOTE EQ)
(LIST (QUOTE BIN)
(CAR X))
(LIST (QUOTE CHARCODE)
(SELECTQ (CADR X)
(FREE (QUOTE NULL))
(USED (QUOTE U))
(DELETED (QUOTE D))
NIL]
(T (CONS (QUOTE SELCHARQ)
(CONS (LIST (QUOTE BIN)
(CAR X))
(APPEND (for Y in (MKLIST (CADR X))
collect (SELECTQ
Y
(FREE (QUOTE (NULL T)))
(USED (QUOTE (U T)))
(DELETED (QUOTE (D T)))
NIL))
(LIST NIL])
(PUTPROPS REHASHKEY MACRO [LAMBDA (HKEY PROBE RANGE) (* cdl "12-Aug-83 09:08")
(LLSH (ADD1 (IMOD (IPLUS PROBE (LRSH HKEY 2))
RANGE))
2])
)
(RPAQQ HASHGLOBALS (HASHBITTABLE HASHFILEARRAYSIZE HASHFILEDEFAULTSIZE HASHLOADFACTOR HASHSCRATCHLST
HASHTEXTCHAR HFGROWTHFACTOR PROBELST SYSHASHFILE SYSHASHFILELST))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HASHBITTABLE HASHFILEARRAYSIZE HASHFILEDEFAULTSIZE HASHLOADFACTOR HASHSCRATCHLST
HASHTEXTCHAR HFGROWTHFACTOR PROBELST SYSHASHFILE SYSHASHFILELST)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS REHASHGAG HASHFILERDTBL)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: HASHFILEBLOCK (SPECVARS REHASHGAG HASHFILERDTBL)
(ENTRIES CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS COPYHASHFILE COPYHASHITEM CREATEHASHFILE
GETHASHFILE HASHBEFORECLOSE HASHFILEDATA HASHFILEP HASHFILEPROP HASHFILESPLST
LOOKUPHASHFILE MAPHASHFILE OPENHASHFILE PUTHASHFILE REHASHFILE)
CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS COPYHASHFILE COPYHASHITEM CREATEHASHFILE
DELETEHASHKEY FIND1STPRIME GETHASHFILE GETHASHKEY GETPROBE GTHASHFILE HASHBEFORECLOSE
HASHFILEDATA HASHFILEP HASHFILEPROP HASHFILESPLST HASHFILESPLST1 INSERTHASHKEY LOOKUPHASHFILE
MAKEHASHKEY MAPHASHFILE OPENHASHFILE PUTHASHFILE REHASHFILE REPLACEHASHKEY SETHASHSTATUS
SPLITKEY)
]
)
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DFOR10))
NIL)
(PUTPROPS HASH COPYRIGHT ("Chris Lane and Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2323 13755 (CLEARHASHFILES 2333 . 3172) (CLOSEHASHFILE 3174 . 3595) (COLLECTKEYS 3597
. 4217) (COPYHASHFILE 4219 . 4859) (COPYHASHITEM 4861 . 5401) (CREATEHASHFILE 5403 . 6570) (
GETHASHFILE 6572 . 6761) (HASHBEFORECLOSE 6763 . 7462) (HASHFILEDATA 7464 . 7667) (HASHFILENAME 7669
. 7826) (HASHFILEP 7828 . 8411) (HASHFILEPROP 8413 . 8697) (HASHFILESPLST 8699 . 9015) (
LOOKUPHASHFILE 9017 . 9995) (MAPHASHFILE 9997 . 10899) (OPENHASHFILE 10901 . 12511) (PUTHASHFILE 12513
. 12771) (REHASHFILE 12773 . 13753)) (13756 18259 (DELETEHASHKEY 13766 . 14056) (FIND1STPRIME 14058
. 14371) (GETHASHKEY 14373 . 15089) (GETPROBE 15091 . 15445) (GTHASHFILE 15447 . 16321) (
HASHFILESPLST1 16323 . 16617) (INSERTHASHKEY 16619 . 17000) (MAKEHASHKEY 17002 . 17163) (
REPLACEHASHKEY 17165 . 17472) (SETHASHSTATUS 17474 . 18047) (SPLITKEY 18049 . 18257)) (18260 18967 (
TESTHASH 18270 . 18965)))))
STOP