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,NODPNT,NODES,IPUTP,IGETP,PUT,IFALSE
.GLOBAL DUMNOD,IGETLO,IBLOCK,MONCH,RMONCH,IPUT,IGETL,IREMAS,IGET
.GLOBAL NWORDT,CIGETP,CIGTPR,CIPUTP,CIREMA,MPOPJ,PVSTOR,SPSTOR

MFUNCTION GETP,SUBR,[GETPROP]

	ENTRY

IGETP:	PUSHJ	P,GETLI
	JRST	FINIS		; NO SKIP, LOSE
	MOVSI	A,TLOCN
	HLLZ	0,VAL(B)
	PUSHJ	P,RMONCH	; CHECK MONITOR
	MOVE	A,VAL(B)	;ELSE RETURN VALUE
	MOVE	B,VAL+1(B)
CFINIS:	JRST	FINIS

; FUNCTION TO RETURN LOCATIVE TO ASSOC

MFUNCTION GETPL,SUBR

	ENTRY

IGETLO:	PUSHJ	P,GETLI
	JRST	FINIS
	MOVSI	A,TLOCN
	JRST	FINIS

GETLI:	PUSHJ	P,2OR3		; GET ARGS
	PUSHJ	P,IGETL		;SEE IF ASSOCIATION EXISTS
	SKIPE	B
	AOS	(P)		; WIN RETURN
	CAMGE	AB,[-4,,0]	; ANY ERROR THING
	JUMPE	B,CHFIN		;IF 0, NONE EXISTS
	POPJ	P,

CHFIN:	PUSH	TP,4(AB)
	PUSH	TP,5(AB)
	MCALL	1,EVAL
	POPJ	P,

; COMPILER CALLS TO SOME OF THESE

CIGETP:	SUBM	M,(P)		; FIX RET ADDR
	PUSHJ	P,IGETL		; GO TO INTERNAL
	JUMPE	B,MPOPJ
	MOVSI	A,TLOCN
MPOPJ1:	SOS	(P)		; WINNER (SOS BECAUSE OF SUBM M,(P))
MPOPJ:	SUBM	M,(P)
	POPJ	P,

CIGTPR:	SUBM	M,(P)
	PUSHJ	P,IGETL
	JUMPE	B,MPOPJ
	MOVE	A,VAL(B)	; GET VAL TYPE
	MOVE	B,VAL+1(B)
	JRST	MPOPJ1

CIPUTP:	SUBM	M,(P)
	PUSH	TP,-1(TP)	; SAVE VAL
	PUSH	TP,-1(TP)
	PUSHJ	P,IPUT		; DO IT
	POP	TP,B
	POP	TP,A
	JRST	MPOPJ

CIREMA:	SUBM	M,(P)
	PUSHJ	P,IREMAS		; FLUSH IT
	JRST	MPOPJ

; CHECK PUT/GET PUTPROP AND GETPROP ARGS

2OR3:	HLRE	0,AB
	ASH	0,-1		; TO -# OF ARGS
	ADDI	0,2		; AT LEAST 2
	JUMPG	0,TFA		; 1 OR LESS, LOSE
	AOJL	0,TMA		; 4 OR MORE, LOSE
	MOVE	A,(AB)		; GET ARGS INTO ACS
	MOVE	B,1(AB)
	MOVE	C,2(AB)
	MOVE	D,3(AB)
	POPJ	P,

; INTERNAL GET

IGET:	PUSHJ	P,IGETL		; GET LOCATIVE
	JUMPE	B,CPOPJ
	MOVE	A,VAL(B)
	MOVE	B,VAL+1(B)
	POPJ	P,

; FUNCTION TO MAKE AN ASSOCIATION

MFUNCTION PUTP,SUBR,[PUTPROP]

	ENTRY

IPUTP:	PUSHJ	P,2OR3		; GET ARGS
	JUMPN	0,REMAS		; REMOVE AN ASSOCIATION
	PUSH	TP,4(AB)	; SAVE NEW VAL
	PUSH	TP,5(AB)
	PUSHJ	P,IPUT		; DO IT
	MOVE	A,(AB)		; RETURN NEW VAL
	MOVE	B,1(AB)
	JRST	FINIS

REMAS:	PUSHJ	P,IREMAS
	JRST	FINIS

IPUT:	SKIPN	DUMNOD+1	; NEW DUMMY NEDDED?
	PUSHJ	P,DUMMAK	; YES, GO MAKE ONE
IPUT1:	PUSHJ	P,IGETI		;SEE IF THIS ONE EXISTS

	JUMPE	B,NEWASO	;JUMP IF NEED NEW ASSOCIATION BLOCK
CLOBV:	MOVE	C,-5(TP)	; RET NEW VAL
	MOVE	D,-4(TP)
	SUB	TP,[6,,6]
	HLLZ	0,VAL(B)
	MOVSI	A,TLOCN
	PUSHJ	P,MONCH		; MONITOR CHECK
	MOVEM	C,VAL(B)	;STORE IT
	MOVEM	D,VAL+1(B)
CPOPJ:	POPJ	P,

; HERE TO CREATE A NEW ASSOCIATION

NEWASO:	MOVE	B,DUMNOD+1	; GET BALNK ASSOCIATION
	SETZM	DUMNOD+1	; CAUSE NEW ONE NEXT TIME


;NOW SPLICE IN CHAIN

	JUMPE	D,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
	HRRZ	C,NODES+1
	HRLM	C,NODPNT(B)
	MOVE	D,NODPNT(C)
	HRRZM	B,NODPNT(C)
	HRRM	D,NODPNT(B)
	HRLM	B,NODPNT(D)
	MOVEI	C,-3(TP)	;COPY ARG POINTER
	MOVSI	A,-4		;AND COPY POINTER

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

	JRST	CLOBV

;HERE TO REMOVE AN ASSOCIATION

IREMAS:	PUSHJ	P,IGETL		;LOOK IT UP
	JUMPE	B,CPOPJ		;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
	CAIE	C,(B)		;DOES IT POINT TO THIS NODE
	.VALUE	[ASCIZ /:FATAL PUT LOSSAGE/]
	HRRM	A,NODPNT(E)	;YES, SPLICE
PUT4:	MOVE	A,VAL(B)		;RETURN VALUE
	SETZM	PNTRS(B)
	MOVE	B,VAL+1(B)
	POPJ	P,


;INTERNAL GET FUNCTION CALLED BY PUT AND GET
; A AND B ARE THE ITEM
;C AND D ARE THE INDICATOR

IGETL:	PUSHJ	P,IGETI
	SUB	TP,[4,,4]	; FLUSH CRUFT LEFT BY IGETI
	POPJ	P,

IGETI:	PUSHJ	P,LHCLR
	EXCH	A,C
	PUSHJ	P,LHCLR
	EXCH	C,A
	PUSH	TP,A
	PUSH	TP,B
	PUSH	TP,C		;SAVE C AND D
	PUSH	TP,D
	XOR	A,B		; BUILD HASH
	XOR	A,C
	XOR	A,D
	TLZ	A,400000	; FORCE POS A
	HLRZ	B,ASOVEC+1	;GET LENGTH OF HASH VECTOR
	MOVNS	B
	IDIVI	A,(B)		;RELATIVE BUCKET NOW IN B
	HRLI	B,(B)		;IN CASE GC OCCURS
	ADD	B,ASOVEC+1	;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
	MOVE	PVP,PVSTOR+1
	HLLZM	0,ASTO(PVP)

IGET1:	GETYPF	0,ITEM(A)	;GET ITEMS TYPE
	MOVE	E,ITEM+1(A)
	CAMN	0,-3(TP)		;COMPARE TYPES
	CAME	E,-2(TP)	;AND VALUES
	JRST	NXTASO		;LOSER
	GETYPF	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:	MOVE	PVP,PVSTOR+1
	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

REPEAT 0,[
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
	SKIPN	DUMNOD+1	; FIX UP DUMMY?
	PUSHJ	P,DUMMAK
CHPT:	MOVE	C,$TCHSTR
	MOVE	D,CHQUOTE NODE
	PUSHJ	P,IGETL
	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		;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
]

DUMMAK:	PUSH	TP,A
	PUSH	TP,B
	PUSH	TP,C
	PUSH	TP,D
	MOVEI	A,ASOLNT
	PUSHJ	P,IBLOCK
	MOVSI	A,400000+SASOC+.VECT.
	MOVEM	A,ASOLNT(B)	;SET SPECIAL TYPE
	MOVEM	B,DUMNOD+1
	POP	TP,D
	POP	TP,C
	POP	TP,B
	POP	TP,A
	POPJ	P,

CLOBTB:	SETZ	ITEM(B)
	SETZ	ITEM+1(B)
	SETZ	INDIC(B)
	SETZ	INDIC+1(B)
	SETZ	VAL(B)
	SETZ	VAL+1(B)

MFUNCTION ASSOCIATIONS,SUBR

	ENTRY	0
	MOVE	B,NODES+1
ASSOC1:	MOVSI	A,TASOC		; SET TYPE
	HRRZ	B,NODPNT(B)	; POINT TO 1ST REAL NODE
	JUMPE	B,IFALSE
	JRST	FINIS

; RETURN NEXT ASSOCIATION IN CHAIN OR FALSE

MFUNCTION NEXT,SUBR

	ENTRY	1

	GETYP	0,(AB)		; BETTER BE ASSOC
	CAIE	0,TASOC
	JRST	WTYP1		; LOSE
	MOVE	B,1(AB)		; GET ARG
	JRST	ASSOC1

; GET ITEM/INDICATOR/VALUE CELLS

MFUNCTION %ITEM,SUBR,ITEM

	MOVEI	B,ITEM		; OFFSET
	JRST	GETIT

MFUNCTION INDICATOR,SUBR

	MOVEI	B,INDIC
	JRST	GETIT

MFUNCTION AVALUE,SUBR

	MOVEI	B,VAL
GETIT:	ENTRY	1
	GETYP	0,(AB)		; BETTER BE ASSOC
	CAIE	0,TASOC
	JRST	WTYP1
	ADD	B,1(AB)		; GET ARG
	MOVE	A,(B)
	MOVE	B,1(B)
	JRST	FINIS

LHCLR:	PUSH	P,A
	GETYP	A,A
	PUSHJ	P,NWORDT	; DEFERRED ?
	SOJE	A,LHCLR2
	POP	P,A
LHCLR1:	TLZ	A,TYPMSK#<-1>
	POPJ	P,
LHCLR2:	POP	P,A
	HLLZS	A
	JRST	LHCLR1

END