(FILECREATED " 6-Jun-85 00:54:16" {ERIS}<LISPCORE>LIBRARY>HASH.;19 27043
changes to: (FNS CREATEHASHFILE)
previous date: " 5-Jun-85 17:14:08" {ERIS}<LISPCORE>LIBRARY>HASH.;18)
(* Copyright (c) 1984, 1985 by Christopher Lane and Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HASHCOMS)
(RPAQQ HASHCOMS ((* * User Functions)
(FNS CLEARHASHFILES CLOSEHASHFILE COLLECTKEYS COPYHASHFILE COPYHASHITEM CREATEHASHFILE
GETHASHFILE GETHASHTEXT HASHBEFORECLOSE HASHFILEDATA HASHFILENAME HASHFILEP HASHFILEPROP
HASHFILESPLST LOOKUPHASHFILE MAPHASHFILE OPENHASHFILE PUTHASHFILE PUTHASHTEXT REHASHFILE)
(* * Internal Functions)
(FNS DELETEHASHKEY FIND1STPRIME GETHASHKEY GETPROBE GTHASHFILE HASHFILESPLST1 INSERTHASHKEY
MAKEHASHKEY REPLACEHASHKEY SETHASHSTATUS SPLITKEY)
(* * System Variables)
(INITVARS (HFGROWTHFACTOR 3)
(HASHLOADFACTOR .875)
(HASHFILEDEFAULTSIZE 512)
(HASHSCRATCHCONSCELL (CONS))
(HASHTEXTCHAR (CHARACTER (CHARCODE ↑A)))
(HASHFILERDTBL (COPYREADTABLE 'ORIG))
(HASHSCRATCHLST (CONSTANT (to 30 collect NIL)))
(HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR)))
SYSHASHFILE REHASHGAG SYSHASHFILELST)
(VARS PROBELST)
(ADDVARS (AFTERSYSOUTFORMS (CLEARHASHFILES)))
(MACROS GETHASHFILE HASHFILENAME)
(* * System Macros)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS ANYEQ CREATEKEY MODTIMES PRINTPTR PRINTSTBYTE READPTR
READSTBYTE REHASHKEY)
(* * etc.)
(RECORDS HashFile HashTextPtr HashFileEntry DoubleKey)
(CONSTANTS (HASH.HEADER.SIZE 8)
(HASH.KEY.SIZE 4))
(GLOBALVARS HFGROWTHFACTOR HASHLOADFACTOR HASHFILEDEFAULTSIZE HASHSCRATCHCONSCELL
HASHTEXTCHAR HASHSCRATCHLST HASHBITTABLE SYSHASHFILE SYSHASHFILELST
PROBELST HASHFILERDTBL MAX.INTEGER)
(* For MASTERSCOPE)
(GLOBALVARS HASH.HEADER.SIZE HASH.KEY.SIZE)
(SPECVARS REHASHGAG)
(BLOCKS (LOOKUPHASHFILEBLOCK (ENTRIES LOOKUPHASHFILE GETHASHFILE PUTHASHFILE)
LOOKUPHASHFILE GETHASHFILE PUTHASHFILE DELETEHASHKEY
GETHASHKEY GETPROBE INSERTHASHKEY MAKEHASHKEY
REPLACEHASHKEY)
(OPENHASHFILEBLOCK (ENTRIES CREATEHASHFILE OPENHASHFILE)
CREATEHASHFILE OPENHASHFILE FIND1STPRIME SETHASHSTATUS)
(MAPHASHFILEBLOCK (ENTRIES COLLECTKEYS COPYHASHFILE COPYHASHITEM
HASHFILESPLST MAPHASHFILE REHASHFILE)
(SPECVARS REHASHGAG)
COLLECTKEYS COPYHASHFILE COPYHASHITEM HASHFILESPLST
HASHFILESPLST1 MAPHASHFILE REHASHFILE SPLITKEY)))
(P (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DFOR10))
NIL)
(MOVD? 'NILL 'FORCEOUTPUT))))
(* * User Functions)
(DEFINEQ
(CLEARHASHFILES
[LAMBDA (CLOSE RELEASE) (* cdl "18-Mar-85 10:29")
(* Called after SYSOUT returns, to clean up any
spurious items. Can also be called to close all
hashfiles.)
(if CLOSE
then [while SYSHASHFILELST
do (* Do it this way, so the DREMOVE in HASHBEFORECLOSE
doesn't screw up this iteration)
(with HashFileEntry (pop SYSHASHFILELST)
(CLOSEF? FILE)
(with HashFile HASHFILE (SETQ Valid? NIL]
(* Invalidate anything that was open before the sysout)
(SETQ SYSHASHFILE NIL])
(CLOSEHASHFILE
[LAMBDA (HASHFILE REOPEN) (* cdl "18-Mar-85 08:53")
(if (SETQ HASHFILE (HASHFILEP (OR HASHFILE SYSHASHFILE)))
then (with HashFile HASHFILE (SETQ File (CLOSEF? File))
(if REOPEN
then (* This flag forces contents of file to exist on disk
if we crash, reuse hashfile datum)
(OPENHASHFILE File REOPEN NIL NIL HASHFILE)
else File])
(COLLECTKEYS
[LAMBDA (HASHFILE DOUBLE MKSTRING?) (* cdl "14-Mar-85 17:01")
(DECLARE (SPECVARS MKSTRING?))
(PROG (KEYLST)
(DECLARE (SPECVARS KEYLST))
[if DOUBLE
then (MAPHASHFILE HASHFILE [FUNCTION (LAMBDA (KEY1 KEY2)
(push KEYLST (CONS (if MKSTRING?
then (MKSTRING KEY1)
else KEY1)
(if MKSTRING?
then (MKSTRING KEY2)
else KEY2]
T)
else (MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (KEY)
(push KEYLST (if MKSTRING?
then (MKSTRING KEY)
else KEY]
(RETURN KEYLST])
(COPYHASHFILE
[LAMBDA (HASHFILE NEWNAME FN VALUETYPE LEAVEOPEN) (* cdl "18-Mar-85 09:01")
(DECLARE (SPECVARS HASHFILE FN)) (* Copy HashFile by mapping over file hashing items
into new file, slow but lisp independent)
(with HashFile (SETQ HASHFILE (GTHASHFILE HASHFILE))
(PROG ((ACCESS (HASHFILEPROP HASHFILE (QUOTE ACCESS)))
(NEWHASHFILE (CREATEHASHFILE NEWNAME (OR VALUETYPE ValueType)
ItemLength #Entries NIL ItemCopyFn)))
(DECLARE (SPECVARS NEWHASHFILE))
(if (NEQ ACCESS (QUOTE INPUT))
then (* Close and reopen the hashfile to make sure it is up
to date on the disk)
(SETQ HASHFILE (CLOSEHASHFILE HASHFILE ACCESS)))
[MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (KEY)
(COPYHASHITEM KEY HASHFILE NEWHASHFILE FN]
(RETURN (if (NOT LEAVEOPEN)
then (CLOSEHASHFILE NEWHASHFILE)
else NEWHASHFILE])
(COPYHASHITEM
[LAMBDA (KEY HASHFILE NEWHASHFILE USERFN) (* gbn " 5-Jun-85 16:55")
(* Copy single hash item from old to new hashfile,
applying userfn if supplied)
(PROG ((VALUE (GETHASHFILE KEY HASHFILE)))
(if USERFN
then (SETQ VALUE (APPLY* USERFN KEY VALUE HASHFILE NEWHASHFILE)))
(if (type? HashTextPtr VALUE)
then (with HashTextPtr VALUE (with HashFile HASHFILE (PUTHASHTEXT KEY File NEWHASHFILE
Start End)))
else (LOOKUPHASHFILE KEY VALUE NEWHASHFILE (QUOTE INSERT])
(CREATEHASHFILE
[LAMBDA (FILE VALUETYPE ITEMLENGTH #ENTRIES SMASH COPYFN)
(* gbn " 6-Jun-85 00:51")
(PROG (SIZE HASHFILE)
[SETQ SIZE (FIND1STPRIME (FIX (FTIMES (if #ENTRIES
then (MAX #ENTRIES HASHFILEDEFAULTSIZE)
else HASHFILEDEFAULTSIZE)
HFGROWTHFACTOR]
[SETQ FILE (OPENFILE FILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(PRINTPTR FILE 0)
(PRINTPTR FILE SIZE) (* Put other arguments on file for future expansion)
[BOUT FILE (SELECTQ VALUETYPE
(TEXT (CHARCODE T))
(EXPR (CHARCODE E))
(PROGN (SETQ VALUETYPE (QUOTE EXPR))
(CHARCODE E]
(BOUT FILE (SETQ ITEMLENGTH (if (NUMBERP ITEMLENGTH)
then (LOGAND ITEMLENGTH 255)
else 0)))
(bind (STREAM ←(GETSTREAM FILE (QUOTE OUTPUT))) to (ADD1 (ITIMES SIZE HASH.KEY.SIZE))
do (* Fill the KEY section with zeros)
(BOUT STREAM 0)
finally (SETQ FILE (CLOSEF STREAM))) (* Mark end of KEYS, start of DATA)
(* Close file and reopen to ensure existance)
(with HashFile (SETQ HASHFILE (if (type? HashFile SMASH)
then SMASH
else (create HashFile)))
[SETQ File (OPENFILE FILE (QUOTE BOTH)
(QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
(SETQ Size SIZE)
(SETQ #Entries 0)
(SETQ Write? T)
(SETQ ValueType VALUETYPE)
(SETQ ItemCopyFn COPYFN)
(SETQ ItemLength ITEMLENGTH))
(RETURN (SETHASHSTATUS HASHFILE])
(GETHASHFILE
[LAMBDA (KEY HASHFILE KEY2) (* cdl " 3-Aug-83 15:04")
(LOOKUPHASHFILE (CREATEKEY KEY KEY2)
NIL HASHFILE (QUOTE RETRIEVE])
(GETHASHTEXT
[LAMBDA (KEY HASHFILE DSTFIL) (* gbn " 5-Jun-85 17:03")
(PROG ((HASHTEXTPTR (GETHASHFILE KEY HASHFILE)))
(if (type? HashTextPtr HASHTEXTPTR)
then (with HashTextPtr HASHTEXTPTR (with HashFile HASHFILE
(RETURN (COPYBYTES File DSTFIL Start End])
(HASHBEFORECLOSE
[LAMBDA (FILE) (* cdl "18-Mar-85 10:27")
(* Called before a hashfile is actually closed)
(PROG ((ENTRY (ASSOC (FULLNAME FILE)
SYSHASHFILELST)))
(if ENTRY
then (with HashFileEntry ENTRY (if (EQ HASHFILE SYSHASHFILE)
then (SETQ SYSHASHFILE NIL))
(* Mark this datum defunct)
(with HashFile HASHFILE (SETQ Valid? NIL)))
(* Remove from table of open hash files)
(SETQ SYSHASHFILELST (DREMOVE ENTRY SYSHASHFILELST])
(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 "18-Mar-85 10:52")
(if [AND [OR (type? HashFile HASHFILE)
(AND HASHFILE (LITATOM HASHFILE)
(SETQ HASHFILE (FULLNAME HASHFILE))
(SETQ HASHFILE (CDR (ASSOC HASHFILE SYSHASHFILELST]
(with HashFile HASHFILE (AND Valid? (OR (NOT WRITE)
Write?]
then HASHFILE])
(HASHFILEPROP
[LAMBDA (HASHFILE PROP) (* cdl "15-Mar-85 08:50")
(with HashFile (GTHASHFILE HASHFILE)
(SELECTQ PROP
(VALUETYPE ValueType)
(ACCESS (GETFILEINFO File (QUOTE ACCESS)))
(NAME File)
(COPYFN ItemCopyFn)
(STREAM Stream)
(SIZE Size)
(#ENTRIES #Entries)
(ITEMLENGTH ItemLength)
NIL])
(HASHFILESPLST
[LAMBDA (HASHFILE XWORD) (* cdl "15-Mar-85 08:51")
(DECLARE (SPECVARS . T)) (* Just create an Interlisp generator that returns each
hash key)
(if (SETQ HASHFILE (GTHASHFILE HASHFILE))
then (GENERATOR (HASHFILESPLST1 HASHFILE XWORD])
(LOOKUPHASHFILE
[LAMBDA (KEY VALUE HASHFILE CALLTYPE KEY2) (* gbn " 5-Jun-85 16:49")
(PROG (RETVAL RETFLG (KEYVAL MAX.INTEGER)
(INDEX (CREATEKEY KEY KEY2)))
(SETQ HASHFILE (GTHASHFILE HASHFILE (ANYEQ (QUOTE (REPLACE DELETE INSERT))
CALLTYPE)))
(* Use SETN to reuse boxes in Interlisp-10)
(SETN KEYVAL (GETHASHKEY INDEX HASHFILE (EQMEMB (QUOTE INSERT)
CALLTYPE)
KEYVAL))
(COND
((MINUSP KEYVAL)
(if (EQMEMB (QUOTE INSERT)
CALLTYPE)
then (INSERTHASHKEY (SETN KEYVAL (IMINUS KEYVAL))
INDEX VALUE HASHFILE)))
(T (if (EQMEMB (QUOTE RETRIEVE)
CALLTYPE)
then (SETQ RETFLG T)
(SETQ RETVAL (READ (fetch File of HASHFILE)
HASHFILERDTBL)))
(if (EQMEMB (QUOTE REPLACE)
CALLTYPE)
then (REPLACEHASHKEY KEYVAL INDEX VALUE HASHFILE)
elseif (EQMEMB (QUOTE DELETE)
CALLTYPE)
then (DELETEHASHKEY KEYVAL HASHFILE))
(RETURN (if RETFLG
then RETVAL
elseif KEYVAL
then T])
(MAPHASHFILE
[LAMBDA (HASHFILE MAPFN DOUBLE) (* cdl "18-Mar-85 10:28")
(with HashFile (SETQ HASHFILE (GTHASHFILE HASHFILE))
(bind KEY VALUE HASHKEY (BOTH ←(IGREATERP (OR (NARGS MAPFN)
0)
(if DOUBLE
then 2
else 1)))
to Size as ADR from HASH.HEADER.SIZE by HASH.KEY.SIZE when (PROGN (SETFILEPTR File ADR)
(READSTBYTE Stream
USED))
do (SETN HASHKEY (READPTR Stream))
(SETFILEPTR File HASHKEY)
(SETQ KEY (READ File HASHFILERDTBL))
(if BOTH
then (SETQ VALUE (READ File HASHFILERDTBL)))
(if DOUBLE
then (* Two key hashing so split up key, userfn takes two
key arguments)
(with DoubleKey (SPLITKEY KEY)
(APPLY* MAPFN Key1 Key2 VALUE))
else (APPLY* MAPFN KEY VALUE])
(OPENHASHFILE
[LAMBDA (FILE ACCESS ITEMLENGTH #ENTRIES SMASH) (* cdl "18-Mar-85 09:39")
(if [OR ITEMLENGTH #ENTRIES (FMEMB ACCESS (QUOTE (DOUBLE NUMBER STRING PRINT FULLPRINT]
then (* This is really a createhashfile call, the original
hash package used openhashfile for both)
(CREATEHASHFILE FILE ACCESS ITEMLENGTH #ENTRIES SMASH)
else (PROG [(HASHFILE (CDR (ASSOC (FULLNAME FILE)
SYSHASHFILELST]
(SETQ ACCESS (SELECTQ ACCESS
((READ INPUT OLD NIL RETRIEVE)
(QUOTE INPUT))
((WRITE OUTPUT BOTH T INSERT DELETE REPLACE)
(QUOTE BOTH))
(SHOULDNT)))
(if [AND HASHFILE (EQ ACCESS (GETFILEINFO (fetch File of HASHFILE)
(QUOTE ACCESS]
then (* This is the NO-OP case)
(RETURN HASHFILE))
(CLOSEF? FILE)
[with HashFile (SETQ HASHFILE (if (type? HashFile SMASH)
then SMASH
else (create HashFile)))
[SETQ File (OPENFILE FILE ACCESS (QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
(SETQ #Entries (READPTR File))
(SETQ Size (READPTR File))
(SETQ ValueType (SELCHARQ (BIN File)
(T (QUOTE TEXT))
(E (QUOTE EXPR))
(QUOTE EXPR)))
(SETQ ItemLength (BIN File))
(SETQ Write? (EQ ACCESS (QUOTE BOTH]
(RETURN (SETHASHSTATUS HASHFILE])
(PUTHASHFILE
[LAMBDA (KEY VALUE HASHFILE KEY2) (* cdl "15-Mar-85 08:55")
(LOOKUPHASHFILE (CREATEKEY KEY KEY2)
VALUE HASHFILE (if VALUE
then (QUOTE (REPLACE INSERT))
else (QUOTE DELETE)))
VALUE])
(PUTHASHTEXT
[LAMBDA (KEY SRCFIL HASHFILE START END) (* cdl "18-Mar-85 09:43")
(SETQ HASHFILE (GTHASHFILE HASHFILE T))
(PROG (HASHTEXTPTR)
[with HashFile HASHFILE (SETFILEPTR File -1)
(with HashTextPtr (SETQ HASHTEXTPTR (create HashTextPtr
Start ←(GETEOFPTR File)))
(COPYBYTES SRCFIL File START END)
(SETQ End (GETEOFPTR File]
(RETURN (PUTHASHFILE KEY HASHTEXTPTR HASHFILE])
(REHASHFILE
[LAMBDA (HASHFILE NEWNAME VALUETYPE) (* gbn " 5-Jun-85 17:04")
(SETQ HASHFILE (GTHASHFILE HASHFILE))
(PROG [[NAME (OR NEWNAME (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(HASHFILENAME HASHFILE]
(ACCESS (HASHFILEPROP HASHFILE (QUOTE ACCESS] (* If rehashgag = T then print out old and new file)
[with HashFile HASHFILE (if REHASHGAG
then (printout NIL "Rehashing" , File " ... "))
(SETQ NAME (COPYHASHFILE HASHFILE NAME ItemCopyFn (OR VALUETYPE ValueType]
(CLOSEHASHFILE HASHFILE)
(with HashFile (OPENHASHFILE NAME ACCESS NIL NIL HASHFILE)
(if REHASHGAG
then (printout NIL File T)))
(RETURN HASHFILE])
)
(* * Internal Functions)
(DEFINEQ
(DELETEHASHKEY
[LAMBDA (HASHKEY HASHFILE) (* cdl "17-Mar-85 11:03")
(with HashFile HASHFILE (SETQ #Entries (SUB1 #Entries))
(SETFILEPTR File 0)
(PRINTPTR Stream #Entries)
(SETFILEPTR File HASHKEY)
(PRINTSTBYTE Stream DELETED)
(FORCEOUTPUT Stream])
(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 HASHKEY) (* cdl "17-Mar-85 12:23")
(with HashFile HASHFILE (bind PROBE
first (SETN HASHKEY (MAKEHASHKEY INDEX Size))
(SETFILEPTR File HASHKEY)
until (if DELOK
then (READSTBYTE Stream (FREE DELETED))
else (READSTBYTE Stream FREE))
do (SETFILEPTR File (READPTR Stream))
(if (EQUAL INDEX (READ File HASHFILERDTBL))
then (RETURN HASHKEY))
(if (NULL PROBE)
then (SETQ PROBE (GETPROBE INDEX)))
(SETN HASHKEY (REHASHKEY HASHKEY PROBE Size))
(SETFILEPTR File HASHKEY)
finally (RETURN (SETN HASHKEY (IMINUS HASHKEY])
(GETPROBE
[LAMBDA (KEY) (* cdl "15-Mar-85 09:06")
(* Get the value to probe by.
Probelst contains all the probe primes.)
(CAR (FNTH PROBELST (ADD1 (LOGAND 31 (NTHCHARCODE KEY (ADD1 (LRSH (NCHARS KEY)
1])
(GTHASHFILE
[LAMBDA (HASHFILE WRITE) (* cdl "18-Mar-85 09:55")
(if (NULL HASHFILE)
then (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)
(if (HASHFILEP HASHFILE WRITE)
then HASHFILE
elseif (type? HashFile HASHFILE)
then (OPENHASHFILE (fetch File of HASHFILE)
WRITE NIL NIL HASHFILE)
elseif (LITATOM HASHFILE)
then (OPENHASHFILE HASHFILE WRITE)
else (HELP HASHFILE "NOT A HASHFILE"])
(HASHFILESPLST1
[LAMBDA (HASHFILE XWORD) (* cdl "15-Mar-85 09:10")
(DECLARE (SPECVARS XWORD))
(MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (KEY)
(if (OR (NULL XWORD)
(STRPOS XWORD KEY 1 NIL T))
then (PRODUCE KEY])
(INSERTHASHKEY
[LAMBDA (HASHKEY INDEX VALUE HASHFILE) (* cdl "17-Mar-85 10:50")
(with HashFile HASHFILE (if (GREATERP #Entries (TIMES Size HASHLOADFACTOR))
then (REHASHFILE HASHFILE))
(SETFILEPTR File 0)
(SETQ #Entries (ADD1 #Entries))
(PRINTPTR Stream #Entries)
(REPLACEHASHKEY HASHKEY INDEX VALUE HASHFILE])
(MAKEHASHKEY
[LAMBDA (KEY RANGE) (* cdl "18-Mar-85 10:08")
(IPLUS HASH.HEADER.SIZE (ITIMES (MODTIMES (DCHCON KEY HASHSCRATCHLST)
RANGE)
HASH.KEY.SIZE])
(REPLACEHASHKEY
[LAMBDA (HASHKEY INDEX VALUE HASHFILE) (* cdl "17-Mar-85 10:48")
(with HashFile HASHFILE (SETFILEPTR File HASHKEY)
(PRINTSTBYTE Stream USED)
(PRINTPTR Stream (GETEOFPTR File))
(SETFILEPTR File -1)
(printout File .P2 INDEX , .P2 VALUE T)
(FORCEOUTPUT Stream])
(SETHASHSTATUS
[LAMBDA (HASHFILE) (* cdl "18-Mar-85 09:39")
(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 Stream (GETSTREAM File (GETFILEINFO File (QUOTE ACCESS]
(push SYSHASHFILELST (CONS File HASHFILE)))
(SETQ SYSHASHFILE HASHFILE])
(SPLITKEY
[LAMBDA (KEY) (* cdl "14-Mar-85 16:55")
(PROG ((PTR (STRPOSL HASHBITTABLE KEY)))
(RETURN (if PTR
then (FRPLNODE HASHSCRATCHCONSCELL (SUBATOM KEY 1 (SUB1 PTR))
(SUBATOM KEY (ADD1 PTR)))
else (FRPLNODE HASHSCRATCHCONSCELL KEY NIL])
)
(* * System Variables)
(RPAQ? HFGROWTHFACTOR 3)
(RPAQ? HASHLOADFACTOR .875)
(RPAQ? HASHFILEDEFAULTSIZE 512)
(RPAQ? HASHSCRATCHCONSCELL (CONS))
(RPAQ? HASHTEXTCHAR (CHARACTER (CHARCODE ↑A)))
(RPAQ? HASHFILERDTBL (COPYREADTABLE 'ORIG))
(RPAQ? HASHSCRATCHLST (CONSTANT (to 30 collect NIL)))
(RPAQ? HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR)))
(RPAQ? SYSHASHFILE NIL)
(RPAQ? REHASHGAG NIL)
(RPAQ? SYSHASHFILELST NIL)
(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))
(ADDTOVAR AFTERSYSOUTFORMS (CLEARHASHFILES))
(DECLARE: EVAL@COMPILE
[PUTPROPS GETHASHFILE MACRO (X (if (CADDR X)
then
(QUOTE IGNOREMACRO)
else
(BQUOTE (LOOKUPHASHFILE , (CAR X)
NIL , (CADR X)
(QUOTE RETRIEVE]
[PUTPROPS HASHFILENAME MACRO ((HASHFILE)
(HASHFILEPROP HASHFILE (QUOTE NAME]
)
(* * System Macros)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS ANYEQ MACRO (LAMBDA (X Y)
(for Z in X thereis (EQMEMB Z Y]
[PUTPROPS CREATEKEY MACRO (LAMBDA (KEY1 KEY2)
(if (NULL KEY2)
then KEY1 else (PACK* KEY1 HASHTEXTCHAR KEY2]
[PUTPROPS MODTIMES MACRO (LAMBDA (N RANGE)
(for I in N bind (VAL ← 1)
do
(SETQ VAL (IMOD (ITIMES VAL I)
RANGE))
finally
(RETURN VAL]
[PUTPROPS PRINTPTR MACRO
(X (BQUOTE (PROGN ,@ (for I from 2 to 0 by -1 collect
(BQUOTE (BOUT , (CAR X)
(LOGAND 255 ,
(if (ZEROP I)
then
(CADR X)
else
(BQUOTE (RSH , (CADR X)
,
(ITIMES 8 I]
[PUTPROPS PRINTSTBYTE MACRO (X (BQUOTE (BOUT , (CAR X)
,
(SELECTQ (CADR X)
((U USED)
(CONSTANT (CHARCODE U)))
((D DELETED)
(CONSTANT (CHARCODE D)))
((F FREE)
(CONSTANT (CHARCODE F)))
NIL]
[PUTPROPS READPTR MACRO (X (BQUOTE (IPLUS ,@ (for I from 2 to 0 by -1 collect
(if (ZEROP I)
then
(BQUOTE (BIN , (CAR X)))
else
(BQUOTE (LLSH (BIN , (CAR X))
,
(ITIMES 8 I]
[PUTPROPS READSTBYTE MACRO (X (if (ATOM (CADR X))
then
[BQUOTE (EQ (BIN , (CAR X))
(CHARCODE , (SELECTQ (CADR X)
(FREE (QUOTE NULL))
(USED (QUOTE U))
(DELETED (QUOTE D))
NIL]
else
(BQUOTE (SELCHARQ (BIN , (CAR X))
,@
(for Y in (MKLIST (CADR X))
collect
(SELECTQ Y (FREE (QUOTE (NULL T)))
(USED (QUOTE (U T)))
(DELETED (QUOTE (D T)))
NIL))
NIL]
[PUTPROPS REHASHKEY MACRO (LAMBDA (HKEY PROBE RANGE)
(* There is a slight conceptual glitch here in that we should
subtract off HASH.HEADER.SIZE from HKEY but it would affect
existing hashfiles and does not cause any real error due to the
IMOD)
(IPLUS HASH.HEADER.SIZE (ITIMES (IMOD (IPLUS PROBE
(IQUOTIENT HKEY
HASH.KEY.SIZE))
RANGE)
HASH.KEY.SIZE]
)
[DECLARE: EVAL@COMPILE
(ARRAYRECORD HashFile (File Stream Size #Entries ValueType ItemLength Valid? Write? ItemCopyFn))
(TYPERECORD HashTextPtr (Start . End))
(RECORD HashFileEntry (FILE . HASHFILE))
(RECORD DoubleKey (Key1 . Key2))
]
(DECLARE: EVAL@COMPILE
(RPAQQ HASH.HEADER.SIZE 8)
(RPAQQ HASH.KEY.SIZE 4)
(CONSTANTS (HASH.HEADER.SIZE 8)
(HASH.KEY.SIZE 4))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HFGROWTHFACTOR HASHLOADFACTOR HASHFILEDEFAULTSIZE HASHSCRATCHCONSCELL HASHTEXTCHAR
HASHSCRATCHLST HASHBITTABLE SYSHASHFILE SYSHASHFILELST PROBELST HASHFILERDTBL MAX.INTEGER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HASH.HEADER.SIZE HASH.KEY.SIZE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS REHASHGAG)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: LOOKUPHASHFILEBLOCK (ENTRIES LOOKUPHASHFILE GETHASHFILE PUTHASHFILE)
LOOKUPHASHFILE GETHASHFILE PUTHASHFILE DELETEHASHKEY GETHASHKEY GETPROBE INSERTHASHKEY
MAKEHASHKEY REPLACEHASHKEY)
(BLOCK: OPENHASHFILEBLOCK (ENTRIES CREATEHASHFILE OPENHASHFILE)
CREATEHASHFILE OPENHASHFILE FIND1STPRIME SETHASHSTATUS)
(BLOCK: MAPHASHFILEBLOCK (ENTRIES COLLECTKEYS COPYHASHFILE COPYHASHITEM HASHFILESPLST MAPHASHFILE
REHASHFILE)
(SPECVARS REHASHGAG)
COLLECTKEYS COPYHASHFILE COPYHASHITEM HASHFILESPLST HASHFILESPLST1 MAPHASHFILE REHASHFILE
SPLITKEY)
]
)
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DFOR10))
NIL)
(MOVD? 'NILL 'FORCEOUTPUT)
(PUTPROPS HASH COPYRIGHT ("Christopher Lane and Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2717 17154 (CLEARHASHFILES 2727 . 3542) (CLOSEHASHFILE 3544 . 4063) (COLLECTKEYS 4065
. 4798) (COPYHASHFILE 4800 . 5904) (COPYHASHITEM 5906 . 6599) (CREATEHASHFILE 6601 . 8572) (
GETHASHFILE 8574 . 8767) (GETHASHTEXT 8769 . 9133) (HASHBEFORECLOSE 9135 . 9907) (HASHFILEDATA 9909 .
10116) (HASHFILENAME 10118 . 10275) (HASHFILEP 10277 . 10723) (HASHFILEPROP 10725 . 11131) (
HASHFILESPLST 11133 . 11517) (LOOKUPHASHFILE 11519 . 12799) (MAPHASHFILE 12801 . 13809) (OPENHASHFILE
13811 . 15497) (PUTHASHFILE 15499 . 15786) (PUTHASHTEXT 15788 . 16304) (REHASHFILE 16306 . 17152)) (
17186 22207 (DELETEHASHKEY 17196 . 17528) (FIND1STPRIME 17530 . 17871) (GETHASHKEY 17873 . 18678) (
GETPROBE 18680 . 19069) (GTHASHFILE 19071 . 19959) (HASHFILESPLST1 19961 . 20280) (INSERTHASHKEY 20282
. 20681) (MAKEHASHKEY 20683 . 20918) (REPLACEHASHKEY 20920 . 21267) (SETHASHSTATUS 21269 . 21824) (
SPLITKEY 21826 . 22205)))))
STOP