TITLE GETPUT ASSOCIATION FUNCTIONS FOR MUDDLE

RELOCATABLE

.INSRT MUDDLE >

; COMPONENTS IN AN ASSOCIATION BLOCK

ITEM==0	;ITEM TO WHICH INDUCATOR APPLIES
VAL==2		;VALUE
INDIC==4	;INDICATOR
NODPNT==6		;IF NON ZERO POINTS TO CHAIN
PNTRS==7	;POINTERS NEXT (RH) AND PREV (LH)

ASOLNT==8	;NUMBER OF WORDS IN AN ASSOCIATION BLOCK

.GLOBAL ASOVEC	;POINTER TO HASH VECTOR IN TV
.GLOBAL ASOLNT,ITEM,INDIC,VAL,TMA,TFA,NODPNT,NODES,IPUTP,IGETP,PUT

MFUNCTION GETP,SUBR,[GETPROP]

	ENTRY

IGETP:	CAML	AB,[-2,,0]	;DONT SKIP IF TOO FEW
	JRST	TFA
	CAMG	AB,[-6,,0]	;SKIP IF WITHIN RANGE
	JRST	TMA
	MOVE	C,2(AB)	;GET INDICATOR TYPE
	MOVE	D,3(AB)		;AND VALUE
	PUSHJ	P,IGET	;SEE IF ASSOCIATION EXISTS
	JUMPE	B,CHFIN	;IF 0, NONE EXISTS
	MOVE	A,VAL(B)	;ELSE RETURN VALUE
	MOVE	B,VAL+1(B)
CFINIS:	JRST	FINIS

CHFIN:	CAML	AB,[-4,,0]	;IS 3RD ARG SUPPLIED?
	JRST	FINIS	;NO, RETURN FALSE
	PUSH	TP,4(AB)		;YES, EVAL IT
	PUSH	TP,5(AB)
	MCALL	1,EVAL
	JRST	FINIS


; FUNCTION TO MAKE AN ASSOCIATION

MFUNCTION PUTP,SUBR,[PUTPROP]

	ENTRY

IPUTP:	HLRE	A,AB		;GET -NUM OF A
	ASH	A,-1		;DIVIDE BY 2
	AOJGE	A,TFA	;0 OR 1 ARGS IS TOO FEW
	AOJE	A,REMAS		;TWO ARGS, REMOVE AN ASSOC
	AOJL	A,TMA		;MORE THAN 3 TOO MANY
	PUSH	P,CFINIS	;CAUSE FINIS TO BE POPPED TO

IPUT:	MOVE	C,2(AB)	;GET INDICATOR TYPE AND VALUE
	MOVE	D,3(AB)
IPUT1:	PUSHJ	P,IGET	;SEE IF THIS ONE EXISTS

	JUMPE	B,NEWASO	;JUMP IF NEED NEW ASSOCIATION BLOCK
	MOVE	C,5(AB)	;GET NEW VALUE
	MOVEM	C,VAL+1(B)	;STORE IT
	MOVE	A,4(AB)	;GET VALS TYPE
	MOVEM	A,VAL(B)
ITMRET:	MOVE	A,(AB)
	MOVE	B,1(AB)
CPOPJ:	POPJ	P,

; HERE TO CREATE A NEW ASSOCIATION

NEWASO:	MOVSI	A,TUVEC	;GET VECTOR TYPE
	SKIPE	D	;D>0 MEANS SOME EXIST IN CHAIN
	MOVSI	A,TASOC	;IN THIS CASE USE DIFFERENT TYPE
	PUSH	TP,A	;AND SAVE
	PUSH	TP,C
	PUSH	P,D	;SAVE INDICATOR
	PUSH	TP,$TFIX	;GET ARG FOR VECTOR CALL
	PUSH	TP,[ASOLNT]
	MCALL	1,UVECTOR
	MOVSI	A,400000+SASOC	;CLOBBER THE UNIFORM TYPE
	MOVEM	A,ASOLNT(B)

;NOW SPLICE IN CHAIN

	MOVE	C,(TP)	;RESTORE SAVED VALUE
	POP	P,E	;RESTORE SWITCH
	JUMPE	E,PUT1	;NO OTHERS EXISTED IN THIS BUCKET
	HRLZM	C,PNTRS(B)		;CLOBBER PREV POINTER
	HRRM	B,PNTRS(C)		;AND NEXT POINTER
	JRST	.+2

PUT1:	HRRZM	B,(C)	;STORE INTO VECTOR
	MOVE	C,AB	;COPY ARG POINTER
	SUB	TP,[2,,2]		;POP TP JUNK
	MOVEI	A,0	;AND COPY POINTER

PUT2:	MOVE	D,(C)	;START COPYING
	MOVEM	D,@CLOBTB(A)
	ADDI	A,1
	AOBJN	C,PUT2	;NOTE *** DEPENDS ON ORDER IN VECTOR ***

	MOVE	C,B		;RETURN  POINTER TO ASSOC. IN C
	JRST	ITMRET
	MOVE	A,2(AB)
	POPJ	P,


;HERE TO REMOVE AN ASSOCIATION

REMAS:	MOVE	C,2(AB)		;GET INDIC
	MOVE	D,3(AB)
	PUSHJ	P,IGET		;LOOK IT UP
	JUMPE	B,FINIS	;NEVER EXISTED, IGNORE
	HRRZ	A,PNTRS(B)	;NEXT POINTER
	HLRZ	E,PNTRS(B)		;PREV POINTER
	SKIPE	A		;DOES A NEXT EXIST?
	HRLM	E,PNTRS(A)	;YES CLOBBER ITS PREV POINTER
	SKIPN	D		;SKIP IF NOT FIRST IN BUCKET
	MOVEM	A,(C)		;FIRST STORE NEW ONE
	SKIPE	D		;OTHERWISE
	HRRM	A,PNTRS(E)	;PATCH NEXT POINTER IN PREVIOUS
	HRRZ	A,NODPNT(B)	;SEE IF MUST UNSPLICE NODE
	HLRZ	E,NODPNT(B)
	SKIPE	A
	HRLM	E,NODPNT(A)	;SPLICE
	JUMPE	E,PUT4		;FLUSH IF NO PREV POINTER
	HRRZ	C,NODPNT(E)	;GET PREV'S NEXT POINTER
	CAIN	C,(B)		;DOES IT POINT TO THIS NODE
	HRLM	A,NODPNT(E)	;YES, SPLICE
	GETYP	C,VAL(E)		;CHECK VAL
	HRRZ	D,VAL+1(E)
	CAIN	C,TASOC		;IS IT AN ASSOCIATION
	CAIE	D,(B)		;AND DOES IT POINT TO THIS NODE
	JRST	PUT4		;NO
	HRRZM	A,VAL+1(E)	;YES, CLOBBER
PUT4:	MOVE	A,VAL(B)		;RETURN VALUE
	SETZM	NODPNT(B)
	SETZM	PNTRS(B)
	MOVE	B,VAL+1(B)
	JRST	FINIS


;INTERNAL GET FUNCTION CALLED BY PUT AND GET
;(AB) AND 1(AB) ARE THE ITEM
;C AND D ARE THE INDICATOR

IGET:	PUSH	TP,C		;SAVE C AND D
	PUSH	TP,D
	MOVE	A,C		;BUILD UP HASH IN A
	XOR	A,D
	XOR	A,(AB)
	XOR	A,1(AB)		;NOW HAVE A HASH
	MOVMS	A
	HLRE	B,ASOVEC+1(TVP)	;GET LENGTH OF HASH VECTOR
	MOVMS	B
	IDIVI	A,(B)		;RELATIVE BUCKET NOW IN B
	HRLI	B,(B)		;IN CASE GC OCCURS
	ADD	B,ASOVEC+1(TVP)	;POINT TO BUCKET
	MOVEI	D,0		;SET FIRST SWITCH
	SKIPN	A,(B)	;GET CONTENTS OF BUCKET (DONT SKIP IF EMPTY)
	JRST	GFALSE

	MOVSI	0,TASOC		;FOR INTGOS, MAKE A TASOC
	HLLZM	0,ASTO(PVP)

IGET1:	INTGO		;IN CASE CIRCULARITY EXISTS
	GETYPF	0,ITEM(A)	;GET ITEMS TYPE

	MOVE	E,ITEM+1(A)
	CAMN	0,(AB)		;COMPARE TYPES
	CAME	E,1(AB)	;AND VALUES
	JRST	NXTASO		;LOSER
	MOVE	0,INDIC(A)	;MOW TRY INDICATORS
	MOVE	E,INDIC+1(A)
	CAMN	0,-1(TP)
	CAME	E,(TP)
	JRST	NXTASO

	SKIPN	D		;IF 1ST THEN
	MOVE	C,B		;RETURN POINTER IN C
	MOVE	B,A		;FOUND, RETURN ASSOCIATION
	MOVSI	A,TASOC
IGRET:	SUB	TP,[2,,2]
	SETZM	ASTO(PVP)
	POPJ	P,

NXTASO:	MOVEI	D,1		;SET SWITCH
	MOVE	C,A		;CYCLE
	HRRZ	A,PNTRS(A)	;STEP
	JUMPN	A,IGET1

	MOVSI	A,TFALSE
	MOVEI	B,0
	JRST	IGRET

GFALSE:	MOVE	C,B	;PRESERVE VECTOR POINTER
	MOVSI	A,TFALSE
	SETZB	B,D
	JRST	IGRET

; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE

MFUNCTION PUTN,SUBR

	ENTRY

	CAML	AB,[-4,,0]	;WAS THIS A REMOVAL
	JRST	PUT

	PUSHJ	P,IPUT		;DO THE PUT
	SKIPE	NODPNT(C)	;NODE CHAIN EXISTS?
	JRST	FINIS

	PUSH	TP,$TASOC		;NO, START TO BUILD
	PUSH	TP,C
CHPT:	MOVE	C,$TCHSTR
	MOVE	D,CHQUOTE NODE
	PUSHJ	P,IGET
	JUMPE	B,MAKNOD	;NOT FOUND, LOSE
NODSPL:	MOVE	C,(TP)		;HERE TO SPLICE IN NEW NODE
	MOVE	D,VAL+1(B)	;GET POINTER TO NODE STRING
	HRRM	D,NODPNT(C)	;CLOBBER
	HRLM	B,NODPNT(C)
	SKIPE	D		;SPLICE ONLY IF THERE IS SOMETHING THERE
	HRLM	C,NODPNT(D)
	MOVEM	C,VAL+1(B)	;COMPLETE NODE CHAIN
	MOVE	A,2(AB)		;RETURN VALUE
	MOVE	B,3(AB)
	JRST	FINIS

MAKNOD:	PUSHJ	P,NEWASO	;GENERATE THE NEW ASSOCIATION
	MOVE	A,@CHPT		;GET UNIQUE STRING
	MOVEM	A,INDIC(C)		;CLOBBER IN INDIC
	MOVE	A,@CHPT+1
	MOVEM	A,INDIC+1(C)
	MOVE	B,C		;POINTER TO B
	HRRZ	C,NODES+1(TVP)		;GET POINTER TO CHAIN OF NODES
	HRRZ	D,VAL+1(C)	;SKIP DUMMY NODE
	HRRM	B,VAL+1(C)	;CLOBBER INTO CHAIN
	HRRM	D,NODPNT(B)
	SKIPE	D		;SPLICE IF ONLY SOMETHING THERE
	HRLM	B,NODPNT(D)
	HRLM	C,NODPNT(B)
	MOVSI	A,TASOC		;SET TYPE OF VAL TO ASSOCIATION
	MOVEM	A,VAL(B)
	SETZM	VAL+1(B)
	JRST	NODSPL	;GO SPLICE ITEM ONTO NODE
CLOBTB:	ITEM(B)
	ITEM+1(B)
	INDIC(B)
	INDIC+1(B)
	VAL(B)
	VAL+1(B)



END