(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