<mdl.int>/putget.mid.51

   1
   2 TITLE GETPUT ASSOCIATION FUNCTIONS FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 .INSRT MUDDLE >
   7
   8 ; COMPONENTS IN AN ASSOCIATION BLOCK
   9
  10 ITEM==0 ;ITEM TO WHICH INDUCATOR APPLIES
  11 VAL==2          ;VALUE
  12 INDIC==4        ;INDICATOR
  13 NODPNT==6               ;IF NON ZERO POINTS TO CHAIN
  14 PNTRS==7        ;POINTERS NEXT (RH) AND PREV (LH)
  15
  16 ASOLNT==8       ;NUMBER OF WORDS IN AN ASSOCIATION BLOCK
  17
  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
  22
  23 MFUNCTION GETP,SUBR,[GETPROP]
  24
  25         ENTRY
  26
  27 IGETP:  PUSHJ   P,GETLI
  28         JRST    FINIS           ; NO SKIP, LOSE
  29         MOVSI   A,TLOCN
  30         HLLZ    0,VAL(B)
  31         PUSHJ   P,RMONCH        ; CHECK MONITOR
  32         MOVE    A,VAL(B)        ;ELSE RETURN VALUE
  33         MOVE    B,VAL+1(B)
  34 CFINIS: JRST    FINIS
  35
  36 ; FUNCTION TO RETURN LOCATIVE TO ASSOC
  37
  38 MFUNCTION GETPL,SUBR
  39
  40         ENTRY
  41
  42 IGETLO: PUSHJ   P,GETLI
  43         JRST    FINIS
  44         MOVSI   A,TLOCN
  45         JRST    FINIS
  46
  47 GETLI:  PUSHJ   P,2OR3          ; GET ARGS
  48         PUSHJ   P,IGETL         ;SEE IF ASSOCIATION EXISTS
  49         SKIPE   B
  50         AOS     (P)             ; WIN RETURN
  51         CAMGE   AB,[-4,,0]      ; ANY ERROR THING
  52         JUMPE   B,CHFIN         ;IF 0, NONE EXISTS
  53         POPJ    P,
  54
  55 CHFIN:  PUSH    TP,4(AB)
  56         PUSH    TP,5(AB)
  57         MCALL   1,EVAL
  58         POPJ    P,
  59
  60 ; COMPILER CALLS TO SOME OF THESE
  61
  62 CIGETP: SUBM    M,(P)           ; FIX RET ADDR
  63         PUSHJ   P,IGETL         ; GO TO INTERNAL
  64         JUMPE   B,MPOPJ
  65         MOVSI   A,TLOCN
  66 MPOPJ1: SOS     (P)             ; WINNER (SOS BECAUSE OF SUBM M,(P))
  67 MPOPJ:  SUBM    M,(P)
  68         POPJ    P,
  69
  70 CIGTPR: SUBM    M,(P)
  71         PUSHJ   P,IGETL
  72         JUMPE   B,MPOPJ
  73         MOVE    A,VAL(B)        ; GET VAL TYPE
  74         MOVE    B,VAL+1(B)
  75         JRST    MPOPJ1
  76
  77 CIPUTP: SUBM    M,(P)
  78         PUSH    TP,-1(TP)       ; SAVE VAL
  79         PUSH    TP,-1(TP)
  80         PUSHJ   P,IPUT          ; DO IT
  81         POP     TP,B
  82         POP     TP,A
  83         JRST    MPOPJ
  84
  85 CIREMA: SUBM    M,(P)
  86         PUSHJ   P,IREMAS                ; FLUSH IT
  87         JRST    MPOPJ
  88
  89 ; CHECK PUT/GET PUTPROP AND GETPROP ARGS
  90
  91 2OR3:   HLRE    0,AB
  92         ASH     0,-1            ; TO -# OF ARGS
  93         ADDI    0,2             ; AT LEAST 2
  94         JUMPG   0,TFA           ; 1 OR LESS, LOSE
  95         AOJL    0,TMA           ; 4 OR MORE, LOSE
  96         MOVE    A,(AB)          ; GET ARGS INTO ACS
  97         MOVE    B,1(AB)
  98         MOVE    C,2(AB)
  99         MOVE    D,3(AB)
 100         POPJ    P,
 101
 102 ; INTERNAL GET
 103
 104 IGET:   PUSHJ   P,IGETL         ; GET LOCATIVE
 105         JUMPE   B,CPOPJ
 106         MOVE    A,VAL(B)
 107         MOVE    B,VAL+1(B)
 108         POPJ    P,
 109
 110 ; FUNCTION TO MAKE AN ASSOCIATION
 111
 112 MFUNCTION PUTP,SUBR,[PUTPROP]
 113
 114         ENTRY
 115
 116 IPUTP:  PUSHJ   P,2OR3          ; GET ARGS
 117         JUMPN   0,REMAS         ; REMOVE AN ASSOCIATION
 118         PUSH    TP,4(AB)        ; SAVE NEW VAL
 119         PUSH    TP,5(AB)
 120         PUSHJ   P,IPUT          ; DO IT
 121         MOVE    A,(AB)          ; RETURN NEW VAL
 122         MOVE    B,1(AB)
 123         JRST    FINIS
 124
 125 REMAS:  PUSHJ   P,IREMAS
 126         JRST    FINIS
 127
 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
 131
 132         JUMPE   B,NEWASO        ;JUMP IF NEED NEW ASSOCIATION BLOCK
 133 CLOBV:  MOVE    C,-5(TP)        ; RET NEW VAL
 134         MOVE    D,-4(TP)
 135         SUB     TP,[6,,6]
 136         HLLZ    0,VAL(B)
 137         MOVSI   A,TLOCN
 138         PUSHJ   P,MONCH         ; MONITOR CHECK
 139         MOVEM   C,VAL(B)        ;STORE IT
 140         MOVEM   D,VAL+1(B)
 141 CPOPJ:  POPJ    P,
 142
 143 ; HERE TO CREATE A NEW ASSOCIATION
 144
 145 NEWASO: MOVE    B,DUMNOD+1      ; GET BALNK ASSOCIATION
 146         SETZM   DUMNOD+1        ; CAUSE NEW ONE NEXT TIME
 147
 148
 149 ;NOW SPLICE IN CHAIN
 150
 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
 154         JRST    .+2
 155
 156 PUT1:   HRRZM   B,(C)   ;STORE INTO VECTOR
 157         HRRZ    C,NODES+1
 158         HRLM    C,NODPNT(B)
 159         MOVE    D,NODPNT(C)
 160         HRRZM   B,NODPNT(C)
 161         HRRM    D,NODPNT(B)
 162         HRLM    B,NODPNT(D)
 163         MOVEI   C,-3(TP)        ;COPY ARG POINTER
 164         MOVSI   A,-4            ;AND COPY POINTER
 165
 166 PUT2:   MOVE    D,(C)   ;START COPYING
 167         MOVEM   D,@CLOBTB(A)
 168         ADDI    C,1
 169         AOBJN   A,PUT2  ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
 170
 171         JRST    CLOBV
 172
 173 ;HERE TO REMOVE AN ASSOCIATION
 174
 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
 183         SKIPE   D               ;OTHERWISE
 184         HRRM    A,PNTRS(E)      ;PATCH NEXT POINTER IN PREVIOUS
 185         HRRZ    A,NODPNT(B)     ;SEE IF MUST UNSPLICE NODE
 186         HLRZ    E,NODPNT(B)
 187         SKIPE   A
 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
 195         SETZM   PNTRS(B)
 196         MOVE    B,VAL+1(B)
 197         POPJ    P,
 198
 199
 200 ;INTERNAL GET FUNCTION CALLED BY PUT AND GET
 201 ; A AND B ARE THE ITEM
 202 ;C AND D ARE THE INDICATOR
 203
 204 IGETL:  PUSHJ   P,IGETI
 205         SUB     TP,[4,,4]       ; FLUSH CRUFT LEFT BY IGETI
 206         POPJ    P,
 207
 208 IGETI:  PUSHJ   P,LHCLR
 209         EXCH    A,C
 210         PUSHJ   P,LHCLR
 211         EXCH    C,A
 212         PUSH    TP,A
 213         PUSH    TP,B
 214         PUSH    TP,C            ;SAVE C AND D
 215         PUSH    TP,D
 216         XOR     A,B             ; BUILD HASH
 217         XOR     A,C
 218         XOR     A,D
 219         TLZ     A,400000        ; FORCE POS A
 220         HLRZ    B,ASOVEC+1      ;GET LENGTH OF HASH VECTOR
 221         MOVNS   B
 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)
 227         JRST    GFALSE
 228
 229         MOVSI   0,TASOC         ;FOR INTGOS, MAKE A TASOC
 230         MOVE    PVP,PVSTOR+1
 231         HLLZM   0,ASTO(PVP)
 232
 233 IGET1:  GETYPF  0,ITEM(A)       ;GET ITEMS TYPE
 234         MOVE    E,ITEM+1(A)
 235         CAMN    0,-3(TP)                ;COMPARE TYPES
 236         CAME    E,-2(TP)        ;AND VALUES
 237         JRST    NXTASO          ;LOSER
 238         GETYPF  0,INDIC(A)      ;MOW TRY INDICATORS
 239         MOVE    E,INDIC+1(A)
 240         CAMN    0,-1(TP)
 241         CAME    E,(TP)
 242         JRST    NXTASO
 243
 244         SKIPN   D               ;IF 1ST THEN
 245         MOVE    C,B             ;RETURN POINTER IN C
 246         MOVE    B,A             ;FOUND, RETURN ASSOCIATION
 247         MOVSI   A,TASOC
 248 IGRET:  MOVE    PVP,PVSTOR+1
 249         SETZM   ASTO(PVP)
 250         POPJ    P,
 251
 252 NXTASO: MOVEI   D,1             ;SET SWITCH
 253         MOVE    C,A             ;CYCLE
 254         HRRZ    A,PNTRS(A)      ;STEP
 255         JUMPN   A,IGET1
 256
 257         MOVSI   A,TFALSE
 258         MOVEI   B,0
 259         JRST    IGRET
 260
 261 GFALSE: MOVE    C,B     ;PRESERVE VECTOR POINTER
 262         MOVSI   A,TFALSE
 263         SETZB   B,D
 264         JRST    IGRET
 265
 266 ; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE
 267
 268 REPEAT 0,[
 269 MFUNCTION PUTN,SUBR
 270
 271         ENTRY
 272
 273         CAML    AB,[-4,,0]      ;WAS THIS A REMOVAL
 274         JRST    PUT
 275
 276         PUSHJ   P,IPUT          ;DO THE PUT
 277         SKIPE   NODPNT(C)       ;NODE CHAIN EXISTS?
 278         JRST    FINIS
 279
 280         PUSH    TP,$TASOC               ;NO, START TO BUILD
 281         PUSH    TP,C
 282         SKIPN   DUMNOD+1        ; FIX UP DUMMY?
 283         PUSHJ   P,DUMMAK
 284 CHPT:   MOVE    C,$TCHSTR
 285         MOVE    D,CHQUOTE NODE
 286         PUSHJ   P,IGETL
 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
 291         HRLM    B,NODPNT(C)
 292         SKIPE   D               ;SPLICE ONLY IF THERE IS SOMETHING THERE
 293         HRLM    C,NODPNT(D)
 294         MOVEM   C,VAL+1(B)      ;COMPLETE NODE CHAIN
 295         MOVE    A,2(AB)         ;RETURN VALUE
 296         MOVE    B,3(AB)
 297         JRST    FINIS
 298
 299 MAKNOD: PUSHJ   P,NEWASO        ;GENERATE THE NEW ASSOCIATION
 300         MOVE    A,@CHPT         ;GET UNIQUE STRING
 301         MOVEM   A,INDIC(C)              ;CLOBBER IN INDIC
 302         MOVE    A,@CHPT+1
 303         MOVEM   A,INDIC+1(C)
 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
 308         HRRM    D,NODPNT(B)
 309         SKIPE   D               ;SPLICE IF ONLY SOMETHING THERE
 310         HRLM    B,NODPNT(D)
 311         HRLM    C,NODPNT(B)
 312         MOVSI   A,TASOC         ;SET TYPE OF VAL TO ASSOCIATION
 313         MOVEM   A,VAL(B)
 314         SETZM   VAL+1(B)
 315         JRST    NODSPL  ;GO SPLICE ITEM ONTO NODE
 316 ]
 317
 318 DUMMAK: PUSH    TP,A
 319         PUSH    TP,B
 320         PUSH    TP,C
 321         PUSH    TP,D
 322         MOVEI   A,ASOLNT
 323         PUSHJ   P,IBLOCK
 324         MOVSI   A,400000+SASOC+.VECT.
 325         MOVEM   A,ASOLNT(B)     ;SET SPECIAL TYPE
 326         MOVEM   B,DUMNOD+1
 327         POP     TP,D
 328         POP     TP,C
 329         POP     TP,B
 330         POP     TP,A
 331         POPJ    P,
 332
 333 CLOBTB: SETZ    ITEM(B)
 334         SETZ    ITEM+1(B)
 335         SETZ    INDIC(B)
 336         SETZ    INDIC+1(B)
 337         SETZ    VAL(B)
 338         SETZ    VAL+1(B)
 339
 340 MFUNCTION ASSOCIATIONS,SUBR
 341
 342         ENTRY   0
 343         MOVE    B,NODES+1
 344 ASSOC1: MOVSI   A,TASOC         ; SET TYPE
 345         HRRZ    B,NODPNT(B)     ; POINT TO 1ST REAL NODE
 346         JUMPE   B,IFALSE
 347         JRST    FINIS
 348
 349 ; RETURN NEXT ASSOCIATION IN CHAIN OR FALSE
 350
 351 MFUNCTION NEXT,SUBR
 352
 353         ENTRY   1
 354
 355         GETYP   0,(AB)          ; BETTER BE ASSOC
 356         CAIE    0,TASOC
 357         JRST    WTYP1           ; LOSE
 358         MOVE    B,1(AB)         ; GET ARG
 359         JRST    ASSOC1
 360
 361 ; GET ITEM/INDICATOR/VALUE CELLS
 362
 363 MFUNCTION %ITEM,SUBR,ITEM
 364
 365         MOVEI   B,ITEM          ; OFFSET
 366         JRST    GETIT
 367
 368 MFUNCTION INDICATOR,SUBR
 369
 370         MOVEI   B,INDIC
 371         JRST    GETIT
 372
 373 MFUNCTION AVALUE,SUBR
 374
 375         MOVEI   B,VAL
 376 GETIT:  ENTRY   1
 377         GETYP   0,(AB)          ; BETTER BE ASSOC
 378         CAIE    0,TASOC
 379         JRST    WTYP1
 380         ADD     B,1(AB)         ; GET ARG
 381         MOVE    A,(B)
 382         MOVE    B,1(B)
 383         JRST    FINIS
 384
 385 LHCLR:  PUSH    P,A
 386         GETYP   A,A
 387         PUSHJ   P,NWORDT        ; DEFERRED ?
 388         SOJE    A,LHCLR2
 389         POP     P,A
 390 LHCLR1: TLZ     A,TYPMSK#<-1>
 391         POPJ    P,
 392 LHCLR2: POP     P,A
 393         HLLZS   A
 394         JRST    LHCLR1
 395
 396 END
 397 \f