sumex/putget.mcr047

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