MUDDLE/putget.21

   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,TMA,TFA,NODPNT,NODES,IPUTP,IGETP,PUT
  20
  21 MFUNCTION GETP,SUBR,[GETPROP]
  22
  23         ENTRY
  24
  25 IGETP:  CAML    AB,[-2,,0]      ;DONT SKIP IF TOO FEW
  26         JRST    TFA
  27         CAMG    AB,[-6,,0]      ;SKIP IF WITHIN RANGE
  28         JRST    TMA
  29         MOVE    C,2(AB) ;GET INDICATOR TYPE
  30         MOVE    D,3(AB)         ;AND VALUE
  31         PUSHJ   P,IGET  ;SEE IF ASSOCIATION EXISTS
  32         JUMPE   B,CHFIN ;IF 0, NONE EXISTS
  33         MOVE    A,VAL(B)        ;ELSE RETURN VALUE
  34         MOVE    B,VAL+1(B)
  35 CFINIS: JRST    FINIS
  36
  37 CHFIN:  CAML    AB,[-4,,0]      ;IS 3RD ARG SUPPLIED?
  38         JRST    FINIS   ;NO, RETURN FALSE
  39         PUSH    TP,4(AB)                ;YES, EVAL IT
  40         PUSH    TP,5(AB)
  41         MCALL   1,EVAL
  42         JRST    FINIS
  43
  44
  45 ; FUNCTION TO MAKE AN ASSOCIATION
  46
  47 MFUNCTION PUTP,SUBR,[PUTPROP]
  48
  49         ENTRY
  50
  51 IPUTP:  HLRE    A,AB            ;GET -NUM OF A
  52         ASH     A,-1            ;DIVIDE BY 2
  53         AOJGE   A,TFA   ;0 OR 1 ARGS IS TOO FEW
  54         AOJE    A,REMAS         ;TWO ARGS, REMOVE AN ASSOC
  55         AOJL    A,TMA           ;MORE THAN 3 TOO MANY
  56         PUSH    P,CFINIS        ;CAUSE FINIS TO BE POPPED TO
  57
  58 IPUT:   MOVE    C,2(AB) ;GET INDICATOR TYPE AND VALUE
  59         MOVE    D,3(AB)
  60 IPUT1:  PUSHJ   P,IGET  ;SEE IF THIS ONE EXISTS
  61
  62         JUMPE   B,NEWASO        ;JUMP IF NEED NEW ASSOCIATION BLOCK
  63         MOVE    C,5(AB) ;GET NEW VALUE
  64         MOVEM   C,VAL+1(B)      ;STORE IT
  65         MOVE    A,4(AB) ;GET VALS TYPE
  66         MOVEM   A,VAL(B)
  67 ITMRET: MOVE    A,(AB)
  68         MOVE    B,1(AB)
  69 CPOPJ:  POPJ    P,
  70
  71 ; HERE TO CREATE A NEW ASSOCIATION
  72
  73 NEWASO: MOVSI   A,TUVEC ;GET VECTOR TYPE
  74         SKIPE   D       ;D>0 MEANS SOME EXIST IN CHAIN
  75         MOVSI   A,TASOC ;IN THIS CASE USE DIFFERENT TYPE
  76         PUSH    TP,A    ;AND SAVE
  77         PUSH    TP,C
  78         PUSH    P,D     ;SAVE INDICATOR
  79         PUSH    TP,$TFIX        ;GET ARG FOR VECTOR CALL
  80         PUSH    TP,[ASOLNT]
  81         MCALL   1,UVECTOR
  82         MOVSI   A,400000+SASOC  ;CLOBBER THE UNIFORM TYPE
  83         MOVEM   A,ASOLNT(B)
  84
  85 ;NOW SPLICE IN CHAIN
  86
  87         MOVE    C,(TP)  ;RESTORE SAVED VALUE
  88         POP     P,E     ;RESTORE SWITCH
  89         JUMPE   E,PUT1  ;NO OTHERS EXISTED IN THIS BUCKET
  90         HRLZM   C,PNTRS(B)              ;CLOBBER PREV POINTER
  91         HRRM    B,PNTRS(C)              ;AND NEXT POINTER
  92         JRST    .+2
  93
  94 PUT1:   HRRZM   B,(C)   ;STORE INTO VECTOR
  95         MOVE    C,AB    ;COPY ARG POINTER
  96         SUB     TP,[2,,2]               ;POP TP JUNK
  97         MOVEI   A,0     ;AND COPY POINTER
  98
  99 PUT2:   MOVE    D,(C)   ;START COPYING
 100         MOVEM   D,@CLOBTB(A)
 101         ADDI    A,1
 102         AOBJN   C,PUT2  ;NOTE *** DEPENDS ON ORDER IN VECTOR ***
 103
 104         MOVE    C,B             ;RETURN  POINTER TO ASSOC. IN C
 105         JRST    ITMRET
 106         MOVE    A,2(AB)
 107         POPJ    P,
 108
 109
 110 ;HERE TO REMOVE AN ASSOCIATION
 111
 112 REMAS:  MOVE    C,2(AB)         ;GET INDIC
 113         MOVE    D,3(AB)
 114         PUSHJ   P,IGET          ;LOOK IT UP
 115         JUMPE   B,FINIS ;NEVER EXISTED, IGNORE
 116         HRRZ    A,PNTRS(B)      ;NEXT POINTER
 117         HLRZ    E,PNTRS(B)              ;PREV POINTER
 118         SKIPE   A               ;DOES A NEXT EXIST?
 119         HRLM    E,PNTRS(A)      ;YES CLOBBER ITS PREV POINTER
 120         SKIPN   D               ;SKIP IF NOT FIRST IN BUCKET
 121         MOVEM   A,(C)           ;FIRST STORE NEW ONE
 122         SKIPE   D               ;OTHERWISE
 123         HRRM    A,PNTRS(E)      ;PATCH NEXT POINTER IN PREVIOUS
 124         HRRZ    A,NODPNT(B)     ;SEE IF MUST UNSPLICE NODE
 125         HLRZ    E,NODPNT(B)
 126         SKIPE   A
 127         HRLM    E,NODPNT(A)     ;SPLICE
 128         JUMPE   E,PUT4          ;FLUSH IF NO PREV POINTER
 129         HRRZ    C,NODPNT(E)     ;GET PREV'S NEXT POINTER
 130         CAIN    C,(B)           ;DOES IT POINT TO THIS NODE
 131         HRLM    A,NODPNT(E)     ;YES, SPLICE
 132         GETYP   C,VAL(E)                ;CHECK VAL
 133         HRRZ    D,VAL+1(E)
 134         CAIN    C,TASOC         ;IS IT AN ASSOCIATION
 135         CAIE    D,(B)           ;AND DOES IT POINT TO THIS NODE
 136         JRST    PUT4            ;NO
 137         HRRZM   A,VAL+1(E)      ;YES, CLOBBER
 138 PUT4:   MOVE    A,VAL(B)                ;RETURN VALUE
 139         SETZM   NODPNT(B)
 140         SETZM   PNTRS(B)
 141         MOVE    B,VAL+1(B)
 142         JRST    FINIS
 143
 144
 145 ;INTERNAL GET FUNCTION CALLED BY PUT AND GET
 146 ;(AB) AND 1(AB) ARE THE ITEM
 147 ;C AND D ARE THE INDICATOR
 148
 149 IGET:   PUSH    TP,C            ;SAVE C AND D
 150         PUSH    TP,D
 151         MOVE    A,C             ;BUILD UP HASH IN A
 152         XOR     A,D
 153         XOR     A,(AB)
 154         XOR     A,1(AB)         ;NOW HAVE A HASH
 155         MOVMS   A
 156         HLRE    B,ASOVEC+1(TVP) ;GET LENGTH OF HASH VECTOR
 157         MOVMS   B
 158         IDIVI   A,(B)           ;RELATIVE BUCKET NOW IN B
 159         HRLI    B,(B)           ;IN CASE GC OCCURS
 160         ADD     B,ASOVEC+1(TVP) ;POINT TO BUCKET
 161         MOVEI   D,0             ;SET FIRST SWITCH
 162         SKIPN   A,(B)   ;GET CONTENTS OF BUCKET (DONT SKIP IF EMPTY)
 163         JRST    GFALSE
 164
 165         MOVSI   0,TASOC         ;FOR INTGOS, MAKE A TASOC
 166         HLLZM   0,ASTO(PVP)
 167
 168 IGET1:  INTGO           ;IN CASE CIRCULARITY EXISTS
 169         GETYPF  0,ITEM(A)       ;GET ITEMS TYPE
 170 \r       MOVE    E,ITEM+1(A)
 171         CAMN    0,(AB)          ;COMPARE TYPES
 172         CAME    E,1(AB) ;AND VALUES
 173         JRST    NXTASO          ;LOSER
 174         MOVE    0,INDIC(A)      ;MOW TRY INDICATORS
 175         MOVE    E,INDIC+1(A)
 176         CAMN    0,-1(TP)
 177         CAME    E,(TP)
 178         JRST    NXTASO
 179
 180         SKIPN   D               ;IF 1ST THEN
 181         MOVE    C,B             ;RETURN POINTER IN C
 182         MOVE    B,A             ;FOUND, RETURN ASSOCIATION
 183         MOVSI   A,TASOC
 184 IGRET:  SUB     TP,[2,,2]
 185         SETZM   ASTO(PVP)
 186         POPJ    P,
 187
 188 NXTASO: MOVEI   D,1             ;SET SWITCH
 189         MOVE    C,A             ;CYCLE
 190         HRRZ    A,PNTRS(A)      ;STEP
 191         JUMPN   A,IGET1
 192
 193         MOVSI   A,TFALSE
 194         MOVEI   B,0
 195         JRST    IGRET
 196
 197 GFALSE: MOVE    C,B     ;PRESERVE VECTOR POINTER
 198         MOVSI   A,TFALSE
 199         SETZB   B,D
 200         JRST    IGRET
 201
 202 ; FUNCTION TO DO A PUT AND ALSO ADD TO THE NODE FOR THIS GOODIE
 203
 204 MFUNCTION PUTN,SUBR
 205
 206         ENTRY
 207
 208         CAML    AB,[-4,,0]      ;WAS THIS A REMOVAL
 209         JRST    PUT
 210
 211         PUSHJ   P,IPUT          ;DO THE PUT
 212         SKIPE   NODPNT(C)       ;NODE CHAIN EXISTS?
 213         JRST    FINIS
 214
 215         PUSH    TP,$TASOC               ;NO, START TO BUILD
 216         PUSH    TP,C
 217 CHPT:   MOVE    C,$TCHSTR
 218         MOVE    D,CHQUOTE NODE
 219         PUSHJ   P,IGET
 220         JUMPE   B,MAKNOD        ;NOT FOUND, LOSE
 221 NODSPL: MOVE    C,(TP)          ;HERE TO SPLICE IN NEW NODE
 222         MOVE    D,VAL+1(B)      ;GET POINTER TO NODE STRING
 223         HRRM    D,NODPNT(C)     ;CLOBBER
 224         HRLM    B,NODPNT(C)
 225         SKIPE   D               ;SPLICE ONLY IF THERE IS SOMETHING THERE
 226         HRLM    C,NODPNT(D)
 227         MOVEM   C,VAL+1(B)      ;COMPLETE NODE CHAIN
 228         MOVE    A,2(AB)         ;RETURN VALUE
 229         MOVE    B,3(AB)
 230         JRST    FINIS
 231
 232 MAKNOD: PUSHJ   P,NEWASO        ;GENERATE THE NEW ASSOCIATION
 233         MOVE    A,@CHPT         ;GET UNIQUE STRING
 234         MOVEM   A,INDIC(C)              ;CLOBBER IN INDIC
 235         MOVE    A,@CHPT+1
 236         MOVEM   A,INDIC+1(C)
 237         MOVE    B,C             ;POINTER TO B
 238         HRRZ    C,NODES+1(TVP)          ;GET POINTER TO CHAIN OF NODES
 239         HRRZ    D,VAL+1(C)      ;SKIP DUMMY NODE
 240         HRRM    B,VAL+1(C)      ;CLOBBER INTO CHAIN
 241         HRRM    D,NODPNT(B)
 242         SKIPE   D               ;SPLICE IF ONLY SOMETHING THERE
 243         HRLM    B,NODPNT(D)
 244         HRLM    C,NODPNT(B)
 245         MOVSI   A,TASOC         ;SET TYPE OF VAL TO ASSOCIATION
 246         MOVEM   A,VAL(B)
 247         SETZM   VAL+1(B)
 248         JRST    NODSPL  ;GO SPLICE ITEM ONTO NODE
 249 CLOBTB: ITEM(B)
 250         ITEM+1(B)
 251         INDIC(B)
 252         INDIC+1(B)
 253         VAL(B)
 254         VAL+1(B)
 255
 256
 257
 258 END
 259 \f\ 3\f