(FILECREATED "24-Sep-86 12:31:44" {ERIS}<LISPCORE>LIBRARY>HASH.;24 35334
changes to: (FNS LOOKUPHASHFILE MAPHASHFILE GETHASHKEY)
(VARS HASHCOMS)
(MACROS PRINTPTR PRINTSTBYTE READPTR READSTBYTE)
(OPTIMIZERS GETHASHFILE)
previous date: "30-May-86 10:32:52" {ERIS}<LISPCORE>LIBRARY>HASH.;21)
(* Copyright (c) 1984, 1985, 1986 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 (QUOTE ORIG)))
(HASHSCRATCHLST (CONSTANT (to 40 collect NIL)))
(HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR)))
(REHASHGAG T)
SYSHASHFILE SYSHASHFILELST)
(VARS PROBELST HASHACCESSTYPES)
(ADDVARS (AFTERSYSOUTFORMS (CLEARHASHFILES)))
(OPTIMIZERS GETHASHFILE HASHFILENAME)
(* * System Macros)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS ANYEQ CREATEKEY 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
HASHACCESSTYPES 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 (MOVD? (QUOTE NILL)
(QUOTE FORCEOUTPUT)))
(PROP FILETYPE HASH)))
(* * User Functions)
(DEFINEQ
(CLEARHASHFILES
[LAMBDA (CLOSE RELEASE) (* cdl "21-May-86 19:55")
(* 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)
(with HashFile HASHFILE (CLOSEF? Stream)
(SETQ Valid? NIL]
(* Invalidate anything that was open
before the sysout)
(SETQ SYSHASHFILE NIL])
(CLOSEHASHFILE
[LAMBDA (HASHFILE REOPEN) (* cdl "21-May-86 08:18")
(if (SETQ HASHFILE (HASHFILEP (OR HASHFILE SYSHASHFILE)))
then (with HashFile HASHFILE (SETQ File (CLOSEF? Stream))
(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) (* cdl "21-May-86 08:18")
(* 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 Stream
NEWHASHFILE Start End)))
else (LOOKUPHASHFILE KEY VALUE NEWHASHFILE (QUOTE INSERT])
(CREATEHASHFILE
[LAMBDA (FILE VALUETYPE ITEMLENGTH #ENTRIES SMASH COPYFN) (* cdl "21-May-86 09:32")
(PROG (STREAM SIZE HASHFILE)
[SETQ SIZE (FIND1STPRIME (FIX (FTIMES (if #ENTRIES
then (MAX #ENTRIES HASHFILEDEFAULTSIZE)
else HASHFILEDEFAULTSIZE)
HFGROWTHFACTOR]
[SETQ STREAM (OPENSTREAM FILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(PRINTPTR STREAM 0)
(PRINTPTR STREAM SIZE) (* Put other arguments on file for
future expansion)
[BOUT STREAM (SELECTQ VALUETYPE
(TEXT (CHARCODE T))
(EXPR (CHARCODE E))
(PROGN (SETQ VALUETYPE (QUOTE EXPR))
(CHARCODE E]
(BOUT STREAM (SETQ ITEMLENGTH (if (NUMBERP ITEMLENGTH)
then (LOGAND ITEMLENGTH 255)
else 0))) (* Fill the KEY section with zeros and
mark end of KEYS, start of DATA)
(to (ADD1 (ITIMES SIZE HASH.KEY.SIZE)) do (BOUT STREAM 0))
(* Close file and reopen to ensure
existance)
[SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(SETQ FILE (CLOSEF (with STREAM STREAM FULLNAME))))
(PROGN (SETQ FILE (CLOSEF STREAM]
(with HashFile (SETQ HASHFILE (if (type? HashFile SMASH)
then SMASH
else (create HashFile)))
[SETQ ByteStream (OPENSTREAM FILE (QUOTE BOTH)
(QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
[SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(SETQ File (SETQ Stream (with STREAM ByteStream FULLNAME))))
(SETQ File (FULLNAME (SETQ Stream ByteStream]
(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) (* cdl "21-May-86 08:19")
(PROG ((HASHTEXTPTR (GETHASHFILE KEY HASHFILE)))
(if (type? HashTextPtr HASHTEXTPTR)
then (with HashTextPtr HASHTEXTPTR (with HashFile HASHFILE
(RETURN (COPYBYTES Stream 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 VALUE) (* cdl "21-May-86 09:43")
(with HashFile (GTHASHFILE HASHFILE)
(SELECTQ PROP
(VALUETYPE ValueType)
(ACCESS (GETFILEINFO Stream (QUOTE ACCESS)))
(NAME File)
(COPYFN (PROG1 ItemCopyFn (if VALUE
then (SETQ ItemCopyFn VALUE))))
(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) (* Pavel "24-Sep-86 12:31")
(PROG (RETVAL RETFLG (KEYVAL MAX.INTEGER)
(INDEX (CREATEKEY KEY KEY2)))
(SETQ HASHFILE (GTHASHFILE HASHFILE (ANYEQ (QUOTE (REPLACE DELETE INSERT))
CALLTYPE)))
(SETQ KEYVAL (GETHASHKEY INDEX HASHFILE (EQMEMB (QUOTE INSERT)
CALLTYPE)
KEYVAL))
(COND
((MINUSP KEYVAL)
(if (EQMEMB (QUOTE INSERT)
CALLTYPE)
then (INSERTHASHKEY (SETQ KEYVAL (IMINUS KEYVAL))
INDEX VALUE HASHFILE)))
(T (if (EQMEMB (QUOTE RETRIEVE)
CALLTYPE)
then (SETQ RETFLG T)
(SETQ RETVAL (READ (fetch Stream 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) (* Pavel "24-Sep-86 12:30")
(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 Stream ADR)
(READSTBYTE ByteStream (QUOTE USED)))
do (SETQ HASHKEY (READPTR ByteStream))
(SETFILEPTR Stream HASHKEY)
(SETQ KEY (READ Stream HASHFILERDTBL))
(if BOTH
then (SETQ VALUE (READ Stream 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 "21-May-86 11:30")
[SETQ ACCESS (for ENTRY in HASHACCESSTYPES thereis (MEMB ACCESS ENTRY)
finally (RETURN (CAR ENTRY]
(if (OR ITEMLENGTH #ENTRIES (EQ ACCESS (QUOTE CREATE)))
then (* This is really a createhashfile
call, the original hash package used
openhashfile for both)
(CREATEHASHFILE FILE NIL ITEMLENGTH #ENTRIES SMASH)
else (PROG [(HASHFILE (CDR (ASSOC (FULLNAME FILE)
SYSHASHFILELST]
[if HASHFILE
then (with HashFile HASHFILE (if (EQ ACCESS (GETFILEINFO Stream (QUOTE ACCESS)))
then (* This is the NO-OP case)
(RETURN HASHFILE]
[with HashFile (SETQ HASHFILE (if (type? HashFile SMASH)
then SMASH
else (create HashFile)))
[SETQ ByteStream (OPENSTREAM FILE ACCESS (QUOTE OLD)
8
(QUOTE ((TYPE BINARY]
(SETQ #Entries (READPTR ByteStream))
(SETQ Size (READPTR ByteStream))
(SETQ ValueType (SELCHARQ (BIN ByteStream)
(T (QUOTE TEXT))
(E (QUOTE EXPR))
(QUOTE EXPR)))
(SETQ ItemLength (BIN ByteStream))
(SETQ Write? (EQ ACCESS (QUOTE BOTH)))
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(SETQ File (SETQ Stream (with STREAM ByteStream FULLNAME))))
(SETQ File (FULLNAME (SETQ Stream ByteStream]
(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 "21-May-86 08:54")
(SETQ HASHFILE (GTHASHFILE HASHFILE T))
(PROG (HASHTEXTPTR)
[with HashFile HASHFILE (SETFILEPTR Stream -1)
(with HashTextPtr (SETQ HASHTEXTPTR (create HashTextPtr
Start ← (GETEOFPTR Stream)))
(COPYBYTES SRCFIL Stream START END)
(SETQ End (GETEOFPTR Stream]
(RETURN (PUTHASHFILE KEY HASHTEXTPTR HASHFILE])
(REHASHFILE
[LAMBDA (HASHFILE NEWNAME VALUETYPE) (* cdl "21-May-86 08:23")
(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 (NOT 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 (NOT REHASHGAG)
then (printout NIL File T)))
(RETURN HASHFILE])
)
(* * Internal Functions)
(DEFINEQ
(DELETEHASHKEY
[LAMBDA (HASHKEY HASHFILE) (* cdl "21-May-86 19:57")
(with HashFile HASHFILE (SETFILEPTR Stream 0)
(PRINTPTR ByteStream (SETQ #Entries (SUB1 #Entries)))
(SETFILEPTR Stream HASHKEY)
(PRINTSTBYTE ByteStream (QUOTE 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) (* Pavel "24-Sep-86 12:30")
(with HashFile HASHFILE (bind PROBE DELETED? first (SETQ HASHKEY (MAKEHASHKEY INDEX Size))
(SETFILEPTR Stream HASHKEY)
until (SELCHARQ (BIN ByteStream)
(D (SETQ DELETED? T)
DELOK?)
(NULL (QUOTE FREE))
NIL)
do (if DELETED?
then (SETQ DELETED? NIL)
else (SETFILEPTR Stream (READPTR ByteStream))
(if (EQUAL INDEX (READ Stream HASHFILERDTBL))
then (RETURN HASHKEY)))
(if (NULL PROBE)
then (SETQ PROBE (GETPROBE INDEX)))
(SETQ HASHKEY (REHASHKEY HASHKEY PROBE Size))
(SETFILEPTR Stream HASHKEY) finally (RETURN (SETQ 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 "21-May-86 09:33")
(with HashFile HASHFILE (if (GREATERP #Entries (TIMES Size HASHLOADFACTOR))
then (REHASHFILE HASHFILE))
(SETFILEPTR Stream 0)
(SETQ #Entries (ADD1 #Entries))
(PRINTPTR ByteStream #Entries)
(REPLACEHASHKEY HASHKEY INDEX VALUE HASHFILE])
(MAKEHASHKEY
[LAMBDA (KEY RANGE) (* cdl "21-May-86 11:28")
(IPLUS HASH.HEADER.SIZE (ITIMES (for CHARCODE in (DCHCON KEY HASHSCRATCHLST)
bind (INDEX ← 1) do (SETQ INDEX (IMOD (ITIMES INDEX CHARCODE)
RANGE))
finally (RETURN INDEX))
HASH.KEY.SIZE])
(REPLACEHASHKEY
[LAMBDA (HASHKEY INDEX VALUE HASHFILE) (* cdl "21-May-86 19:58")
(with HashFile HASHFILE (SETFILEPTR Stream HASHKEY)
(PRINTSTBYTE ByteStream (QUOTE USED))
(PRINTPTR ByteStream (GETEOFPTR Stream))
(SETFILEPTR Stream -1)
(printout Stream .P2 INDEX , .P2 VALUE T)
(FORCEOUTPUT Stream])
(SETHASHSTATUS
[LAMBDA (HASHFILE) (* cdl "21-May-86 09:13")
(with HashFile HASHFILE (* Fix data structures to know about
this file so they get updated when it
closes)
(WHENCLOSE Stream (QUOTE BEFORE)
(FUNCTION HASHBEFORECLOSE))
(SETQ Valid? T)
(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 (QUOTE ORIG)))
(RPAQ? HASHSCRATCHLST (CONSTANT (to 40 collect NIL)))
(RPAQ? HASHBITTABLE (MAKEBITTABLE (LIST HASHTEXTCHAR)))
(RPAQ? REHASHGAG T)
(RPAQ? SYSHASHFILE 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))
(RPAQQ HASHACCESSTYPES ((INPUT READ OLD NIL RETRIEVE)
(BOTH WRITE OUTPUT T INSERT DELETE REPLACE)
(CREATE DOUBLE NUMBER STRING PRINT FULLPRINT)))
(ADDTOVAR AFTERSYSOUTFORMS (CLEARHASHFILES))
(DEFOPTIMIZER GETHASHFILE (&REST X) (if (CADDR X)
then (QUOTE IGNOREMACRO)
else (BQUOTE (LOOKUPHASHFILE (\, (CAR X))
NIL
(\, (CADR X))
(QUOTE RETRIEVE)))))
(DEFOPTIMIZER HASHFILENAME (HASHFILE) (BQUOTE (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
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 (CADR X))
((U USED)
(CHARCODE U))
((D DELETED)
(CHARCODE D))
((F FREE)
(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 (BQUOTE (EQ (BIN (\, (CAR X)))
(CHARCODE (\, (SELECTQ (CADR (CADR X))
(FREE (QUOTE NULL))
(USED (QUOTE U))
(DELETED (QUOTE D))
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
ByteStream))
(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 HASHACCESSTYPES 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)
]
)
(MOVD? (QUOTE NILL)
(QUOTE FORCEOUTPUT))
(PUTPROPS HASH FILETYPE COMPILE-FILE)
(PUTPROPS HASH COPYRIGHT ("Christopher Lane and Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3430 22536 (CLEARHASHFILES 3440 . 4706) (CLOSEHASHFILE 4708 . 5402) (COLLECTKEYS 5404
. 6668) (COPYHASHFILE 6670 . 8091) (COPYHASHITEM 8093 . 8976) (CREATEHASHFILE 8978 . 11808) (
GETHASHFILE 11810 . 12008) (GETHASHTEXT 12010 . 12417) (HASHBEFORECLOSE 12419 . 13401) (HASHFILEDATA
13403 . 13617) (HASHFILENAME 13619 . 13776) (HASHFILEP 13778 . 14278) (HASHFILEPROP 14280 . 14868) (
HASHFILESPLST 14870 . 15303) (LOOKUPHASHFILE 15305 . 16874) (MAPHASHFILE 16876 . 18234) (OPENHASHFILE
18236 . 20578) (PUTHASHFILE 20580 . 20906) (PUTHASHTEXT 20908 . 21491) (REHASHFILE 21493 . 22534)) (
22568 29052 (DELETEHASHKEY 22578 . 22930) (FIND1STPRIME 22932 . 23377) (GETHASHKEY 23379 . 24765) (
GETPROBE 24767 . 25299) (GTHASHFILE 25301 . 26283) (HASHFILESPLST1 26285 . 26691) (INSERTHASHKEY 26693
. 27138) (MAKEHASHKEY 27140 . 27652) (REPLACEHASHKEY 27654 . 28044) (SETHASHSTATUS 28046 . 28648) (
SPLITKEY 28650 . 29050)))))
STOP