1 TITLE GETPUT ASSOCIATION FUNCTIONS FOR MUDDLE
\r
7 ; COMPONENTS IN AN ASSOCIATION BLOCK
\r
9 ITEM==0 ;ITEM TO WHICH INDUCATOR APPLIES
\r
12 NODPNT==6 ;IF NON ZERO POINTS TO CHAIN
\r
13 PNTRS==7 ;POINTERS NEXT (RH) AND PREV (LH)
\r
15 ASOLNT==8 ;NUMBER OF WORDS IN AN ASSOCIATION BLOCK
\r
17 .GLOBAL ASOVEC ;POINTER TO HASH VECTOR IN TV
\r
18 .GLOBAL ASOLNT,ITEM,INDIC,VAL,NODPNT,NODES,IPUTP,IGETP,PUT,IFALSE
\r
19 .GLOBAL DUMNOD,IGETLO,IBLOCK,MONCH,RMONCH,IPUT,IGETL,IREMAS,IGET
\r
20 .GLOBAL NWORDT,CIGETP,CIGTPR,CIPUTP,CIREMA,MPOPJ
\r
22 MFUNCTION GETP,SUBR,[GETPROP]
\r
26 IGETP: PUSHJ P,GETLI
\r
27 JRST FINIS ; NO SKIP, LOSE
\r
30 PUSHJ P,RMONCH ; CHECK MONITOR
\r
31 MOVE A,VAL(B) ;ELSE RETURN VALUE
\r
35 ; FUNCTION TO RETURN LOCATIVE TO ASSOC
\r
37 MFUNCTION GETPL,SUBR
\r
41 IGETLO: PUSHJ P,GETLI
\r
46 GETLI: PUSHJ P,2OR3 ; GET ARGS
\r
47 PUSHJ P,IGETL ;SEE IF ASSOCIATION EXISTS
\r
49 AOS (P) ; WIN RETURN
\r
50 CAMGE AB,[-4,,0] ; ANY ERROR THING
\r
51 JUMPE B,CHFIN ;IF 0, NONE EXISTS
\r
54 CHFIN: PUSH TP,4(AB)
\r
59 ; COMPILER CALLS TO SOME OF THESE
\r
61 CIGETP: SUBM M,(P) ; FIX RET ADDR
\r
62 PUSHJ P,IGETL ; GO TO INTERNAL
\r
65 MPOPJ1: SOS (P) ; WINNER (SOS BECAUSE OF SUBM M,(P))
\r
72 MOVE A,VAL(B) ; GET VAL TYPE
\r
77 PUSH TP,-1(TP) ; SAVE VAL
\r
79 PUSHJ P,IPUT ; DO IT
\r
85 PUSHJ P,IREMAS ; FLUSH IT
\r
88 ; CHECK PUT/GET PUTPROP AND GETPROP ARGS
\r
91 ASH 0,-1 ; TO -# OF ARGS
\r
92 ADDI 0,2 ; AT LEAST 2
\r
93 JUMPG 0,TFA ; 1 OR LESS, LOSE
\r
94 AOJL 0,TMA ; 4 OR MORE, LOSE
\r
95 MOVE A,(AB) ; GET ARGS INTO ACS
\r
103 IGET: PUSHJ P,IGETL ; GET LOCATIVE
\r
109 ; FUNCTION TO MAKE AN ASSOCIATION
\r
111 MFUNCTION PUTP,SUBR,[PUTPROP]
\r
115 IPUTP: PUSHJ P,2OR3 ; GET ARGS
\r
116 JUMPN 0,REMAS ; REMOVE AN ASSOCIATION
\r
117 PUSH TP,4(AB) ; SAVE NEW VAL
\r
119 PUSHJ P,IPUT ; DO IT
\r
120 MOVE A,(AB) ; RETURN NEW VAL
\r
124 REMAS: PUSHJ P,IREMAS
\r
127 IPUT: SKIPN DUMNOD+1(TVP) ; NEW DUMMY NEDDED?
\r
128 PUSHJ P,DUMMAK ; YES, GO MAKE ONE
\r
129 IPUT1: PUSHJ P,IGETI ;SEE IF THIS ONE EXISTS
\r
131 JUMPE B,NEWASO ;JUMP IF NEED NEW ASSOCIATION BLOCK
\r
132 CLOBV: MOVE C,-5(TP) ; RET NEW VAL
\r
137 PUSHJ P,MONCH ; MONITOR CHECK
\r
138 MOVEM C,VAL(B) ;STORE IT
\r
142 ; HERE TO CREATE A NEW ASSOCIATION
\r
144 NEWASO: MOVE B,DUMNOD+1(TVP) ; GET BALNK ASSOCIATION
\r
145 SETZM DUMNOD+1(TVP) ; CAUSE NEW ONE NEXT TIME
\r
148 ;NOW SPLICE IN CHAIN
\r
150 JUMPE D,PUT1 ;NO OTHERS EXISTED IN THIS BUCKET
\r
151 HRLZM C,PNTRS(B) ;CLOBBER PREV POINTER
\r
152 HRRM B,PNTRS(C) ;AND NEXT POINTER
\r
155 PUT1: HRRZM B,(C) ;STORE INTO VECTOR
\r
156 HRRZ C,NODES+1(TVP)
\r
162 MOVEI C,-3(TP) ;COPY ARG POINTER
\r
163 MOVSI A,-4 ;AND COPY POINTER
\r
165 PUT2: MOVE D,(C) ;START COPYING
\r
168 AOBJN A,PUT2 ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
\r
172 ;HERE TO REMOVE AN ASSOCIATION
\r
174 IREMAS: PUSHJ P,IGETL ;LOOK IT UP
\r
175 JUMPE B,CPOPJ ;NEVER EXISTED, IGNORE
\r
176 HRRZ A,PNTRS(B) ;NEXT POINTER
\r
177 HLRZ E,PNTRS(B) ;PREV POINTER
\r
178 SKIPE A ;DOES A NEXT EXIST?
\r
179 HRLM E,PNTRS(A) ;YES CLOBBER ITS PREV POINTER
\r
180 SKIPN D ;SKIP IF NOT FIRST IN BUCKET
\r
181 MOVEM A,(C) ;FIRST STORE NEW ONE
\r
183 HRRM A,PNTRS(E) ;PATCH NEXT POINTER IN PREVIOUS
\r
184 HRRZ A,NODPNT(B) ;SEE IF MUST UNSPLICE NODE
\r
187 HRLM E,NODPNT(A) ;SPLICE
\r
188 JUMPE E,PUT4 ;FLUSH IF NO PREV POINTER
\r
189 HRRZ C,NODPNT(E) ;GET PREV'S NEXT POINTER
\r
190 CAIE C,(B) ;DOES IT POINT TO THIS NODE
\r
191 .VALUE [ASCIZ /:
\eFATAL PUT LOSSAGE/]
\r
192 HRRM A,NODPNT(E) ;YES, SPLICE
\r
193 PUT4: MOVE A,VAL(B) ;RETURN VALUE
\r
199 ;INTERNAL GET FUNCTION CALLED BY PUT AND GET
\r
200 ; A AND B ARE THE ITEM
\r
201 ;C AND D ARE THE INDICATOR
\r
203 IGETL: PUSHJ P,IGETI
\r
204 SUB TP,[4,,4] ; FLUSH CRUFT LEFT BY IGETI
\r
207 IGETI: PUSHJ P,LHCLR
\r
213 PUSH TP,C ;SAVE C AND D
\r
215 XOR A,B ; BUILD HASH
\r
218 TLZ A,400000 ; FORCE POS A
\r
219 HLRZ B,ASOVEC+1(TVP) ;GET LENGTH OF HASH VECTOR
\r
221 IDIVI A,(B) ;RELATIVE BUCKET NOW IN B
\r
222 HRLI B,(B) ;IN CASE GC OCCURS
\r
223 ADD B,ASOVEC+1(TVP) ;POINT TO BUCKET
\r
224 MOVEI D,0 ;SET FIRST SWITCH
\r
225 SKIPN A,(B) ;GET CONTENTS OF BUCKET (DONT SKIP IF EMPTY)
\r
228 MOVSI 0,TASOC ;FOR INTGOS, MAKE A TASOC
\r
231 IGET1: GETYPF 0,ITEM(A) ;GET ITEMS TYPE
\r
234 CAMN 0,-3(TP) ;COMPARE TYPES
\r
235 CAME E,-2(TP) ;AND VALUES
\r
237 GETYPF 0,INDIC(A) ;MOW TRY INDICATORS
\r
243 SKIPN D ;IF 1ST THEN
\r
244 MOVE C,B ;RETURN POINTER IN C
\r
245 MOVE B,A ;FOUND, RETURN ASSOCIATION
\r
247 IGRET: SETZM ASTO(PVP)
\r
250 NXTASO: MOVEI D,1 ;SET SWITCH
\r
252 HRRZ A,PNTRS(A) ;STEP
\r
259 GFALSE: MOVE C,B ;PRESERVE VECTOR POINTER
\r
264 ; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE
\r
267 MFUNCTION PUTN,SUBR
\r
271 CAML AB,[-4,,0] ;WAS THIS A REMOVAL
\r
274 PUSHJ P,IPUT ;DO THE PUT
\r
275 SKIPE NODPNT(C) ;NODE CHAIN EXISTS?
\r
278 PUSH TP,$TASOC ;NO, START TO BUILD
\r
280 SKIPN DUMNOD+1(TVP) ; FIX UP DUMMY?
\r
282 CHPT: MOVE C,$TCHSTR
\r
283 MOVE D,CHQUOTE NODE
\r
285 JUMPE B,MAKNOD ;NOT FOUND, LOSE
\r
286 NODSPL: MOVE C,(TP) ;HERE TO SPLICE IN NEW NODE
\r
287 MOVE D,VAL+1(B) ;GET POINTER TO NODE STRING
\r
288 HRRM D,NODPNT(C) ;CLOBBER
\r
290 SKIPE D ;SPLICE ONLY IF THERE IS SOMETHING THERE
\r
292 MOVEM C,VAL+1(B) ;COMPLETE NODE CHAIN
\r
293 MOVE A,2(AB) ;RETURN VALUE
\r
297 MAKNOD: PUSHJ P,NEWASO ;GENERATE THE NEW ASSOCIATION
\r
298 MOVE A,@CHPT ;GET UNIQUE STRING
\r
299 MOVEM A,INDIC(C) ;CLOBBER IN INDIC
\r
302 MOVE B,C ;POINTER TO B
\r
303 HRRZ C,NODES+1(TVP) ;GET POINTER TO CHAIN OF NODES
\r
304 HRRZ D,VAL+1(C) ;SKIP DUMMY NODE
\r
305 HRRM B,VAL+1(C) ;CLOBBER INTO CHAIN
\r
307 SKIPE D ;SPLICE IF ONLY SOMETHING THERE
\r
310 MOVSI A,TASOC ;SET TYPE OF VAL TO ASSOCIATION
\r
313 JRST NODSPL ;GO SPLICE ITEM ONTO NODE
\r
322 MOVSI A,400000+SASOC+.VECT.
\r
323 MOVEM A,ASOLNT(B) ;SET SPECIAL TYPE
\r
324 MOVEM B,DUMNOD+1(TVP)
\r
338 MFUNCTION ASSOCIATIONS,SUBR
\r
341 MOVE B,NODES+1(TVP)
\r
342 ASSOC1: MOVSI A,TASOC ; SET TYPE
\r
343 HRRZ B,NODPNT(B) ; POINT TO 1ST REAL NODE
\r
347 ; RETURN NEXT ASSOCIATION IN CHAIN OR FALSE
\r
349 MFUNCTION NEXT,SUBR
\r
353 GETYP 0,(AB) ; BETTER BE ASSOC
\r
356 MOVE B,1(AB) ; GET ARG
\r
359 ; GET ITEM/INDICATOR/VALUE CELLS
\r
361 MFUNCTION %ITEM,SUBR,ITEM
\r
363 MOVEI B,ITEM ; OFFSET
\r
366 MFUNCTION INDICATOR,SUBR
\r
371 MFUNCTION AVALUE,SUBR
\r
375 GETYP 0,(AB) ; BETTER BE ASSOC
\r
378 ADD B,1(AB) ; GET ARG
\r
385 PUSHJ P,NWORDT ; DEFERRED ?
\r
388 LHCLR1: TLZ A,TYPMSK#<-1>
\r