(FILECREATED "15-JUN-79 22:58:23" <LISPUSERS>SWAPHASH.;55
 12910  

     previous date: "15-JUN-79 22:55:34" <LISPUSERS>SWAPHASH.;54)


(PRETTYCOMPRINT SWAPHASHCOMS)

(RPAQQ SWAPHASHCOMS
 ((DECLARE: FIRST (ADDVARS (NOSWAPFNS SADDHASH1 SGETHASH1 SEQMEMBHASH1 SPUTHASH1 
							 SSUBHASH1 STESTHASH1 SHARRAY1)))
	(E (RESETSAVE CLISPIFYPRETTYFLG NIL))
	(DECLARE: EVAL@COMPILE DONTCOPY (PROP MACRO .LOOKUP. LH RH HIND SETLH SETRH SMAPHASH1)
		  (FILES (SYSLOAD)
			 NOBOX))
	(* These define swapped hasharrays and are masterscope-independent)
	(FNS HASHFULL NEXTPRIME SADDHASH SADDHASH1 SGETHASH SGETHASH1 SHARRAY SHARRAY1 SHASHSIZE 
	     SMAPHASH SEQMEMBHASH SEQMEMBHASH1 SPUTHASH SPUTHASH1 SSUBHASH SSUBHASH1 STESTHASH 
	     STESTHASH1)
	(GLOBALVARS SWAPHASHNLISTPTAIL SWAPHASHNULL)
	(VARS SWAPHASHNLISTPTAIL SWAPHASHNULL)))
(DECLARE: FIRST 

(ADDTOVAR NOSWAPFNS
 SADDHASH1 SGETHASH1 SEQMEMBHASH1 SPUTHASH1 SSUBHASH1 STESTHASH1 SHARRAY1)
)
(DECLARE: EVAL@COMPILE DONTCOPY 

(PUTPROPS .LOOKUP. MACRO
 [(OTHERVARS FOUND NOTFOUND BACKAGAIN REVERTFORM)
			  (PROG OTHERVARS
			        (DECLARE
 (LOCALVARS . T))
			        (ASSEMBLE
 NIL          (* NREF locations: -

						       CELL 0 -

						       CELL0 -1 -

						       LASTCELL -2 -

						       INC -3)

                                                       (* compute hash key)

				          (CQ X)
				          (JUMPE BR , ERROR)
                                                       (* get atom)

				          (HLRZ 2 , 2 (1))
                                                       (* PNAME)

				          (ANDI 1 , 777Q)
                                                       (* and low order bits of location)

				          (TSC 1 , 0 (2))
				          (MOVM 1 , 1)
				          (IMUL 1 , = 240501202405Q)
				          (IDIVI 1 , 7)
                                                       (* pick one of 7 primes)

				          (PUSHN TAB (2))
                                                       (* INC)

				          (MOVE 4 , 0 (BR))
                                                       (* 4 has size+2)

				          (IDIVI 1 , -2 (4))
                                                       (* 2 has initial probe, 4 has size+2)

				          (ADDI 2 , 2)
				          (HRLI 2 , BR)
				          (PUSHNN (4)
						  (2)
						  (2))
                                                       (* LASTCELL CELL0 CELL)

				      LP  (CQ (COND
						((EQ (LH)
						     X)
						  FOUND)
						((EQ (LH)
						     SWAPHASHNULL)
						  NOTFOUND)))
				          (JUMPE BR , ERROR)
				          (NREF (MOVE 1 , -3))
				          (NREF (ADDB 1 , 0))
                                                       (* add increment to cell)

				          (NREF (HRRZ 2 , -2))
				          (CAILE 2 , 0 (1))
				          (JRST OK)
				          (MOVE 2 , 0 (BR))
                                                       (* get size again)

				          (SUBI 1 , -2 (2))
				          (NREF (MOVEM 1 , 0))
				      OK  (NREF (MOVE 2 , -1))
				          (CAME 2 , 1)
				          (JRST LP)
				          (CQ BACKAGAIN)
				          (JUMPE BR , ERROR)
				          (JRST LP)
				      TAB (1)
				          (2)
				          (3)
				          (5)
				          (7)
				          (13Q)
				          (15Q)
				      ERROR
				          (CQ (RETEVAL (CAR (QUOTE REVERTFORM))
						       (QUOTE REVERTFORM])

(PUTPROPS LH MACRO
 [NIL (ASSEMBLE
 NIL
			          (NREF (HLRZ 1 , @ 0])

(PUTPROPS RH MACRO
 [NIL (ASSEMBLE
 NIL
			          (NREF (HRRZ 1 , @ 0])

(PUTPROPS HIND MACRO
 [NIL (LOC (ASSEMBLE
 NIL
				         (NREF (HRRZ 1 , 0))
				         (SUBI 1 , 1])

(PUTPROPS SETLH MACRO
 [(X)
		       (ASSEMBLE
 NIL
			         (CQ X)
			         (NREF (HRLM 1 , @ 0])

(PUTPROPS SETRH MACRO
 [(X)
		       (ASSEMBLE
 NIL
			         (CQ X)
			         (NREF (HRRM 1 , @ 0])

(PUTPROPS SMAPHASH1 MACRO
 [(H FORM)
			   (PROG (X Y INDEX)
			         (ASSEMBLE
 NIL
				           [CQ (VAG (SETQ INDEX (IBOX (ARRAYSIZE H]
				           (PUSHN)
				           (JRST ITERATE)
				       LP  (CQ H)
				           (PUSHP)
				           (NREF (PUSH
 PP , 0))
				           (FASTCALL FFNOPR)
                                                       (* open FNOPENR)

				           (VAR (HLRM 1 , X))
				           (VAR (HRRM 1 , Y))
				           (CQ (OR (EQ X SWAPHASHNULL)
						   (EQ Y SWAPHASHNULL)
						   FORM))
				           (CQ2 INDEX)
				           (SOS 2 , 0 (2))
				       ITERATE
				           (NREF (SOSL 1 , 0))
				           (JRST LP)
				           (POPN])

(LOAD? (QUOTE NOBOX.COM)
       (QUOTE SYSLOAD))
)





(* These define swapped hasharrays and are masterscope-independent)


(DEFINEQ

(HASHFULL

  [LAMBDA (FN)                                         (* lmm "14-JUN-79 13:19")

    (PROG (NEWH)
          (DECLARE
 (SPECVARS NEWH))
          [SETQ NEWH (SHARRAY
 (ITIMES 2 (SHASHSIZE
 H]
          (COND
	    ((SWPARRAYP NEWH)
	      [SELECTQ FN
		       (SADDHASH
                       (* If anybody is doing a SADDHASH, we assume he doesn't care about 

						       order)

				 (SMAPHASH1 H (SADDHASH
 X Y NEWH)))
		       (SMAPHASH
 H (FUNCTION (LAMBDA (V K)
				     (SPUTHASH
 K V NEWH]
	      (CLOSER (LOC H)
		      (OPENR (LOC NEWH)))
	                                               (* gadzooks! smash old handle with new!)
)
	    (T (SHOULDNT)))
          (RETAPPLY FN FN (LIST X V H])

(NEXTPRIME

  [LAMBDA (N)                                          (* lmm "12-JAN-79 10:20")

    (if
 (NOT (IGREATERP N 17))
	then
 17
      else
 (while
 [SOME (QUOTE (2 3 5 7 11 13))
			(FUNCTION (LAMBDA (D)
			    (ZEROP (IREMAINDER N D]
	      do
 (SETQ N (ADD1 N)))
	   N])

(SADDHASH

  [LAMBDA (X V H)                                      (* rmk: " 9-MAR-79 13:35")

    (SWPPOS H (FUNCTION SADDHASH1])

(SADDHASH1

  [LAMBDA NIL                                          (* rmk: "29-MAY-79 10:48")

    (.LOOKUP. (V0 TAIL)
	      (if
 (EQ (SETQ V0 (RH))
		      V)
		  then
 (RETURN)
		elseif
 (EQ V0 SWAPHASHNULL)
		  then
 (SETRH V)
		       (RETURN)
		elseif
 TAIL
		  then
 

          (* The new value was smashed over the nlistptail marker. We make the nlistp tail be the new V, and smash its cell with the nlistp 

	  marker. Thus, the new value gets "added" just before the dotted tail)



		       (SETQ V V0)
		       (SETRH SWAPHASHNLISTPTAIL)
		       (SETQ TAIL NIL)
		elseif
 (EQ V0 SWAPHASHNLISTPTAIL)
		  then
 (SETRH V)
		       (SETQ TAIL T))
	      (PROGN (SETLH X)
		     (SETRH V)
		     (RETURN))
	      (HASHFULL
 (QUOTE SADDHASH))
	      (SADDHASH
 X V H])

(SGETHASH

  [LAMBDA (X H)                                        (* rmk: " 9-MAR-79 13:35")

    (SWPPOS H (FUNCTION SGETHASH1])

(SGETHASH1

  [LAMBDA NIL                                          (* rmk: "29-MAY-79 10:51")

    (DECLARE
 (USEDFREE SWAPHASHNULL SWAPHASHNLISTPTAIL))
    (.LOOKUP. (V V0 TAIL)
	      (if
 (EQ (SETQ V0 (RH))
		      SWAPHASHNULL)
		elseif
 (EQ TAIL SWAPHASHNLISTPTAIL)
		  then
 (SETQ TAIL V0)
		elseif
 (EQ V0 SWAPHASHNLISTPTAIL)
		  then
 (SETQ TAIL SWAPHASHNLISTPTAIL)
		else
 (SETQ V (DOCOLLECT V0 V)))
	      (RETURN (ENDCOLLECT V (AND (NEQ TAIL SWAPHASHNLISTPTAIL)
					 TAIL)))
	      (RETURN (ENDCOLLECT V (AND (NEQ TAIL SWAPHASHNLISTPTAIL)
					 TAIL)))
	      (SGETHASH
 X H])

(SHARRAY

  [LAMBDA (N)                                          (* rmk: " 9-MAR-79 14:50")

    (PROG [(H (SWPARRAY (SETQ N (NEXTPRIME
 N]
          (SWPPOS H (FUNCTION SHARRAY1))
          (RETURN H])

(SHARRAY1

  [LAMBDA (ARR)                                        (* rmk: "12-JUN-79 12:08")

    (ASSEMBLE
 NIL
	      (CQ ARR)
	      (CQ2 (VAG N))
	      (ADDI 2 , 2)                             (* 2 has N+2)

	      (MOVEM 2 , 0 (1))                        (* store in 1st word of array)

	      (MOVEI 3 , 2)
	      (MOVEM 3 , 1 (1))                        (* store a 2 in 2nd word of array)

	      (VAR (HRRZ 3 , SWAPHASHNULL))
	      (HRL 3 , 3)                              (* 3 contains SWAPHASHNULL ,, SWAPHASHNULL)

	      (ADDI 2 , 0 (1))                         (* 2 contains end pointer beyond the last word)

	      (ADDI 1 , 2)                             (* 1 contains first word to smash)

	  LP  (MOVEM 3 , 0 (1))
	      (ADDI 1 , 1)
	      (CAIGE 1 , 0 (2))
	      (JRST LP])

(SHASHSIZE

  [LAMBDA (H)                                          (* rmk: "26-MAY-79 18:14")

    (PROG ((SZ 0))
          (SMAPHASH1 H (SETN SZ (ADD1 SZ)))
          (RETURN SZ])

(SMAPHASH

  [LAMBDA (H FN)                                       (* rmk: "15-JUN-79 22:55")

                                                       (* The APPLY* gets done the first time an element of X's value is 

						       found)

    (SMAPHASH1 H (AND [IEQP (fetch
 I of
 INDEX)
			    (fetch
 I of
 (SWPPOS H (FUNCTION STESTHASH1]
		      (APPLY* FN (SGETHASH
 X H)
			      X])

(SEQMEMBHASH

  [LAMBDA (X V H)                                      (* rmk: "10-JUN-79 19:55")

    (SWPPOS H (FUNCTION SEQMEMBHASH1])

(SEQMEMBHASH1

  [LAMBDA NIL                                          (* rmk: "13-JUN-79 09:09")

                                                       (* Returns T if the value for X is or contains V)

    (.LOOKUP. (V0 LSTP)
	      (if
 (EQ (SETQ V0 (RH))
		      V)
		  then
 (RETURN T)
		elseif
 (EQ V0 SWAPHASHNLISTPTAIL)
		  then
 (AND LSTP (RETURN))
		elseif
 (NEQ V0 SWAPHASHNULL)
		  then
                                 (* A true value means that we have a list.

						       Thus, we don't want to accept any non-list tail)

		       (SETQ LSTP T))
	      (RETURN)
	      (RETURN)
	      (SEQMEMBHASH
 X V H])

(SPUTHASH

  [LAMBDA (X V H)                                      (* rmk: "26-MAY-79 18:07")

    (PROG ((V1 V))
          (SWPPOS H (FUNCTION SPUTHASH1)))
    V])

(SPUTHASH1

  [LAMBDA NIL                                          (* rmk: "29-MAY-79 10:46")

    (DECLARE
 (USEDFREE SWAPHASHNULL SWAPHASHNLISTPTAIL))
    (.LOOKUP. NIL (SETRH (if
 (LISTP V1)
			     then
 (PROG1 (CAR V1)
					 (SETQ V1 (CDR V1)))
			   elseif
 V1
			     then
 (SETQ V1 (CBOX V1)) 
                                                       (* Precede the non-NIL cdr with a special code)

				  SWAPHASHNLISTPTAIL
			   else
                        (* We exhausted V1 but there might be parts of a previous value that we

						       have to wipe out.)

				SWAPHASHNULL))
	      (if
 V1
		  then
 (SETLH X)
		       (SETRH (if
 (LISTP V1)
				  then
 (PROG1 (CAR V1)
					      (SETQ V1 (CDR V1)))
				else
 (SETQ V1 (CBOX V1)) 
                                                       (* Precede the non-NIL cdr with a special code)

				     SWAPHASHNLISTPTAIL))
		else
 (RETURN))
	      (if
 V1
		  then
 (HASHFULL
 (QUOTE SPUTHASH))
		else
 (RETURN))
	      (SPUTHASH
 X V H])

(SSUBHASH

  [LAMBDA (X V H)                                      (* rmk: " 9-MAR-79 13:36")

    (SWPPOS H (FUNCTION SSUBHASH1])

(SSUBHASH1

  [LAMBDA NIL                                          (* rmk: "29-MAY-79 10:46")

    (DECLARE
 (USEDFREE SWAPHASHNULL))
    (.LOOKUP. NIL (if
 (EQ (RH)
			  V)
		      then
 (SETRH SWAPHASHNULL))
	      (RETURN)
	      (RETURN)
	      (SSUBHASH
 X V H])

(STESTHASH

  [LAMBDA (X H)                                        (* lmm "14-JUN-79 14:06")

    (AND (SWPPOS H (FUNCTION STESTHASH1))
	 T])

(STESTHASH1

  [LAMBDA NIL                                          (* rmk: "15-JUN-79 21:14")

                                                       (* Returns the first real element of the value-list, T if that element 

						       is NIL.)

    (DECLARE
 (USEDFREE SWAPHASHNULL SWAPHASHNLISTPTAIL))
    (.LOOKUP. (V)
	      (OR (EQ (SETQ V (RH))
		      SWAPHASHNULL)
		  (EQ V SWAPHASHNLISTPTAIL)
		  (PROGN (SETQ V (IBOX (HIND)))
			 (RETURN V)))
	      (RETURN)
	      (RETURN)
	      (STESTHASH
 X H])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS SWAPHASHNLISTPTAIL SWAPHASHNULL)
)

(RPAQQ SWAPHASHNLISTPTAIL
 " . ")

(RPAQQ SWAPHASHNULL
 "SHNIL")
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4940 12715 (HASHFULL 4952 . 5717) (NEXTPRIME 5721 . 6029) (SADDHASH 6033 . 6170) (
SADDHASH1 6174 . 7018) (SGETHASH 7022 . 7159) (SGETHASH1 7163 . 7796) (SHARRAY 7800 . 8015) (SHARRAY1 
8019 . 8858) (SHASHSIZE 8862 . 9052) (SMAPHASH 9056 . 9477) (SEQMEMBHASH 9481 . 9624) (SEQMEMBHASH1 
9628 . 10302) (SPUTHASH 10306 . 10479) (SPUTHASH1 10483 . 11574) (SSUBHASH 11578 . 11715) (SSUBHASH1 
11719 . 12012) (STESTHASH 12016 . 12166) (STESTHASH1 12170 . 12712)))))
STOP