2 TITLE GETPUT ASSOCIATION FUNCTIONS FOR MUDDLE
8 ; COMPONENTS IN AN ASSOCIATION BLOCK
10 ITEM==0 ;ITEM TO WHICH INDUCATOR APPLIES
13 NODPNT==6 ;IF NON ZERO POINTS TO CHAIN
14 PNTRS==7 ;POINTERS NEXT (RH) AND PREV (LH)
16 ASOLNT==8 ;NUMBER OF WORDS IN AN ASSOCIATION BLOCK
18 .GLOBAL ASOVEC ;POINTER TO HASH VECTOR IN TV
19 .GLOBAL ASOLNT,ITEM,INDIC,VAL,NODPNT,NODES,IPUTP,IGETP,PUT,IFALSE
20 .GLOBAL DUMNOD,IGETLO,IBLOCK,MONCH,RMONCH,IPUT,IGETL,IREMAS,IGET
21 .GLOBAL NWORDT,CIGETP,CIGTPR,CIPUTP,CIREMA,MPOPJ,PVSTOR,SPSTOR
23 MFUNCTION GETP,SUBR,[GETPROP]
28 JRST FINIS ; NO SKIP, LOSE
31 PUSHJ P,RMONCH ; CHECK MONITOR
32 MOVE A,VAL(B) ;ELSE RETURN VALUE
36 ; FUNCTION TO RETURN LOCATIVE TO ASSOC
47 GETLI: PUSHJ P,2OR3 ; GET ARGS
48 PUSHJ P,IGETL ;SEE IF ASSOCIATION EXISTS
51 CAMGE AB,[-4,,0] ; ANY ERROR THING
52 JUMPE B,CHFIN ;IF 0, NONE EXISTS
60 ; COMPILER CALLS TO SOME OF THESE
62 CIGETP: SUBM M,(P) ; FIX RET ADDR
63 PUSHJ P,IGETL ; GO TO INTERNAL
66 MPOPJ1: SOS (P) ; WINNER (SOS BECAUSE OF SUBM M,(P))
73 MOVE A,VAL(B) ; GET VAL TYPE
78 PUSH TP,-1(TP) ; SAVE VAL
86 PUSHJ P,IREMAS ; FLUSH IT
89 ; CHECK PUT/GET PUTPROP AND GETPROP ARGS
92 ASH 0,-1 ; TO -# OF ARGS
94 JUMPG 0,TFA ; 1 OR LESS, LOSE
95 AOJL 0,TMA ; 4 OR MORE, LOSE
96 MOVE A,(AB) ; GET ARGS INTO ACS
104 IGET: PUSHJ P,IGETL ; GET LOCATIVE
110 ; FUNCTION TO MAKE AN ASSOCIATION
112 MFUNCTION PUTP,SUBR,[PUTPROP]
116 IPUTP: PUSHJ P,2OR3 ; GET ARGS
117 JUMPN 0,REMAS ; REMOVE AN ASSOCIATION
118 PUSH TP,4(AB) ; SAVE NEW VAL
121 MOVE A,(AB) ; RETURN NEW VAL
125 REMAS: PUSHJ P,IREMAS
128 IPUT: SKIPN DUMNOD+1 ; NEW DUMMY NEDDED?
129 PUSHJ P,DUMMAK ; YES, GO MAKE ONE
130 IPUT1: PUSHJ P,IGETI ;SEE IF THIS ONE EXISTS
132 JUMPE B,NEWASO ;JUMP IF NEED NEW ASSOCIATION BLOCK
133 CLOBV: MOVE C,-5(TP) ; RET NEW VAL
138 PUSHJ P,MONCH ; MONITOR CHECK
139 MOVEM C,VAL(B) ;STORE IT
143 ; HERE TO CREATE A NEW ASSOCIATION
145 NEWASO: MOVE B,DUMNOD+1 ; GET BALNK ASSOCIATION
146 SETZM DUMNOD+1 ; CAUSE NEW ONE NEXT TIME
151 JUMPE D,PUT1 ;NO OTHERS EXISTED IN THIS BUCKET
152 HRLZM C,PNTRS(B) ;CLOBBER PREV POINTER
153 HRRM B,PNTRS(C) ;AND NEXT POINTER
156 PUT1: HRRZM B,(C) ;STORE INTO VECTOR
163 MOVEI C,-3(TP) ;COPY ARG POINTER
164 MOVSI A,-4 ;AND COPY POINTER
166 PUT2: MOVE D,(C) ;START COPYING
169 AOBJN A,PUT2 ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
173 ;HERE TO REMOVE AN ASSOCIATION
175 IREMAS: PUSHJ P,IGETL ;LOOK IT UP
176 JUMPE B,CPOPJ ;NEVER EXISTED, IGNORE
177 HRRZ A,PNTRS(B) ;NEXT POINTER
178 HLRZ E,PNTRS(B) ;PREV POINTER
179 SKIPE A ;DOES A NEXT EXIST?
180 HRLM E,PNTRS(A) ;YES CLOBBER ITS PREV POINTER
181 SKIPN D ;SKIP IF NOT FIRST IN BUCKET
182 MOVEM A,(C) ;FIRST STORE NEW ONE
184 HRRM A,PNTRS(E) ;PATCH NEXT POINTER IN PREVIOUS
185 HRRZ A,NODPNT(B) ;SEE IF MUST UNSPLICE NODE
188 HRLM E,NODPNT(A) ;SPLICE
189 JUMPE E,PUT4 ;FLUSH IF NO PREV POINTER
190 HRRZ C,NODPNT(E) ;GET PREV'S NEXT POINTER
191 CAIE C,(B) ;DOES IT POINT TO THIS NODE
192 .VALUE [ASCIZ /:
\eFATAL PUT LOSSAGE/]
193 HRRM A,NODPNT(E) ;YES, SPLICE
194 PUT4: MOVE A,VAL(B) ;RETURN VALUE
200 ;INTERNAL GET FUNCTION CALLED BY PUT AND GET
201 ; A AND B ARE THE ITEM
202 ;C AND D ARE THE INDICATOR
205 SUB TP,[4,,4] ; FLUSH CRUFT LEFT BY IGETI
214 PUSH TP,C ;SAVE C AND D
219 TLZ A,400000 ; FORCE POS A
220 HLRZ B,ASOVEC+1 ;GET LENGTH OF HASH VECTOR
222 IDIVI A,(B) ;RELATIVE BUCKET NOW IN B
223 HRLI B,(B) ;IN CASE GC OCCURS
224 ADD B,ASOVEC+1 ;POINT TO BUCKET
225 MOVEI D,0 ;SET FIRST SWITCH
226 SKIPN A,(B) ;GET CONTENTS OF BUCKET (DONT SKIP IF EMPTY)
229 MOVSI 0,TASOC ;FOR INTGOS, MAKE A TASOC
233 IGET1: GETYPF 0,ITEM(A) ;GET ITEMS TYPE
235 CAMN 0,-3(TP) ;COMPARE TYPES
236 CAME E,-2(TP) ;AND VALUES
238 GETYPF 0,INDIC(A) ;MOW TRY INDICATORS
245 MOVE C,B ;RETURN POINTER IN C
246 MOVE B,A ;FOUND, RETURN ASSOCIATION
248 IGRET: MOVE PVP,PVSTOR+1
252 NXTASO: MOVEI D,1 ;SET SWITCH
254 HRRZ A,PNTRS(A) ;STEP
261 GFALSE: MOVE C,B ;PRESERVE VECTOR POINTER
266 ; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE
273 CAML AB,[-4,,0] ;WAS THIS A REMOVAL
276 PUSHJ P,IPUT ;DO THE PUT
277 SKIPE NODPNT(C) ;NODE CHAIN EXISTS?
280 PUSH TP,$TASOC ;NO, START TO BUILD
282 SKIPN DUMNOD+1 ; FIX UP DUMMY?
287 JUMPE B,MAKNOD ;NOT FOUND, LOSE
288 NODSPL: MOVE C,(TP) ;HERE TO SPLICE IN NEW NODE
289 MOVE D,VAL+1(B) ;GET POINTER TO NODE STRING
290 HRRM D,NODPNT(C) ;CLOBBER
292 SKIPE D ;SPLICE ONLY IF THERE IS SOMETHING THERE
294 MOVEM C,VAL+1(B) ;COMPLETE NODE CHAIN
295 MOVE A,2(AB) ;RETURN VALUE
299 MAKNOD: PUSHJ P,NEWASO ;GENERATE THE NEW ASSOCIATION
300 MOVE A,@CHPT ;GET UNIQUE STRING
301 MOVEM A,INDIC(C) ;CLOBBER IN INDIC
304 MOVE B,C ;POINTER TO B
305 HRRZ C,NODES+1 ;GET POINTER TO CHAIN OF NODES
306 HRRZ D,VAL+1(C) ;SKIP DUMMY NODE
307 HRRM B,VAL+1(C) ;CLOBBER INTO CHAIN
309 SKIPE D ;SPLICE IF ONLY SOMETHING THERE
312 MOVSI A,TASOC ;SET TYPE OF VAL TO ASSOCIATION
315 JRST NODSPL ;GO SPLICE ITEM ONTO NODE
324 MOVSI A,400000+SASOC+.VECT.
325 MOVEM A,ASOLNT(B) ;SET SPECIAL TYPE
340 MFUNCTION ASSOCIATIONS,SUBR
344 ASSOC1: MOVSI A,TASOC ; SET TYPE
345 HRRZ B,NODPNT(B) ; POINT TO 1ST REAL NODE
349 ; RETURN NEXT ASSOCIATION IN CHAIN OR FALSE
355 GETYP 0,(AB) ; BETTER BE ASSOC
358 MOVE B,1(AB) ; GET ARG
361 ; GET ITEM/INDICATOR/VALUE CELLS
363 MFUNCTION %ITEM,SUBR,ITEM
365 MOVEI B,ITEM ; OFFSET
368 MFUNCTION INDICATOR,SUBR
373 MFUNCTION AVALUE,SUBR
377 GETYP 0,(AB) ; BETTER BE ASSOC
380 ADD B,1(AB) ; GET ARG
387 PUSHJ P,NWORDT ; DEFERRED ?
390 LHCLR1: TLZ A,TYPMSK#<-1>