Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(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