X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=sumex%2Fputget.mcr047;fp=sumex%2Fputget.mcr047;h=53f08c9381c36471ec84011c3fc55d2e0303be2a;hp=0000000000000000000000000000000000000000;hb=1c973408824dee4a587c040bc8075cd1bf047ba3;hpb=a3df309bdd1ea54242d39e62403548d1e4845f8e

diff --git a/sumex/putget.mcr047 b/sumex/putget.mcr047
new file mode 100644
index 0000000..53f08c9
--- /dev/null
+++ b/sumex/putget.mcr047
@@ -0,0 +1,395 @@
+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
+
+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(TVP)	; 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(TVP)	; GET BALNK ASSOCIATION
+	SETZM	DUMNOD+1(TVP)	; 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(TVP)
+	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(TVP)	;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(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:	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:	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(TVP)	; 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(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
+]
+
+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(TVP)
+	POP	TP,D
+	POP	TP,C
+	POP	TP,B
+	POP	TP,A
+	POPJ	P,
+
+CLOBTB:	ITEM(B)
+	ITEM+1(B)
+	INDIC(B)
+	INDIC+1(B)
+	VAL(B)
+	VAL+1(B)
+
+MFUNCTION ASSOCIATIONS,SUBR
+
+	ENTRY	0
+	MOVE	B,NODES+1(TVP)
+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
+