sumex/gchack.mcr020

   1 TITLE GCHACK\r
   2 \r
   3 RELOCATABLE\r
   4 \r
   5 .INSRT MUDDLE >\r
   6 \r
   7 .GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT\r
   8 .GLOBAL TD.LNT,TD.GET,TD.PUT\r
   9 \r
  10 ; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING\r
  11 ; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN\r
  12 \r
  13 ; CALL --\r
  14 ;       A/  INSTRUCTION TO BE EXECUTED\r
  15 ;       PUSHJ P,GCHACK\r
  16 \r
  17 GCHACK: HRRZ    E,TYPVEC+1(TVP) ; SET UP TYPE POINTER\r
  18         HRLI    E,C             ; WILL HAVE TYPE CODE IN C\r
  19         MOVE    B,PARBOT        ; START AT PARBOT\r
  20         SETOM   1(TP)           ; FENCE POST PDL\r
  21         PUSH    P,A\r
  22         MOVEI   A,(TB)\r
  23         PUSHJ   P,FRMUNG                ; MUNG CURRENT FRAME\r
  24         POP     P,A\r
  25 \r
  26 ; FIRST HACK PAIR SPACE\r
  27 \r
  28 PHACK:  CAML    B,PARTOP                ; SKIP IF MORE PAIRS\r
  29         JRST    VHACK           ; DONE, NOW HACK VECTORS\r
  30         GETYP   C,(B)           ; TYPE OF CURRENT PAIR\r
  31         MOVE    D,1(B)          ; AND ITS DATUM\r
  32         XCT     A               ; APPLY INS\r
  33         ADDI    B,2\r
  34         JRST    PHACK\r
  35 \r
  36 ; NOW DO THE SAME THING TO VECTOR SPACE\r
  37 \r
  38 VHACK:  MOVE    B,VECTOP        ; START AT TOP, MOVE DOWN\r
  39         SUBI    B,1             ; POINT TO TOPMOST VECTOR\r
  40 VHACK2: CAMG    B,VECBOT        ; SKIP IF MORE TO DO\r
  41         JRST    REHASQ          ; SEE IF MUST REHASH\r
  42 \r
  43         HLRE    D,-1(B)         ; GET TYPE FROM D.W.\r
  44         HLRZ    C,(B)           ; AND TOTAL LENGTH\r
  45         SUBI    B,(C)-1         ; POINT TO START OF VECTOR\r
  46         PUSH    P,B\r
  47         SUBI    C,2             ; CHECK WINNAGE\r
  48         JUMPL   C,BADV          ; FATAL LOSSAGE\r
  49         PUSH    P,C             ; SAVE COUNT\r
  50         JUMPE   C,VHACK1        ; EMPTY VECTOR, FINISHED\r
  51 \r
  52 ; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL\r
  53 \r
  54         JUMPGE  D,UHACK         ; UNIFORM\r
  55         TRNE    D,377777        ; SKIP IF GENERAL\r
  56         JRST    SHACK           ; SPECIAL\r
  57 \r
  58 ; FALL THROUGH TO GENERAL\r
  59 \r
  60 GHACK1: GETYP   C,(B)           ; LOOK A T 1ST ELEMENT\r
  61         CAIE    C,TCBLK\r
  62         CAIN    C,TENTRY        ; FRAME ON STACK\r
  63         SOJA    B,EHACK\r
  64         CAIE    C,TUBIND\r
  65         CAIN    C,TBIND         ; BINDING BLOCK\r
  66         JRST    BHACK\r
  67         CAIN    C,TGATOM        ; ATOM WITH GDECL?\r
  68         JRST    GDHACK\r
  69         MOVE    D,1(B)          ; GET DATUM\r
  70         XCT     A               ; USER INS\r
  71         ADDI    B,2             ; NEXT ELEMENT\r
  72         SOS     (P)\r
  73         SOSLE   (P)             ; COUNT ELEMENTS\r
  74         SKIPGE  (B)             ; OR FENCE POST HIT\r
  75         JRST    VHACK1\r
  76         JRST    GHACK1\r
  77 \r
  78 ; HERE TO GO OVER UVECTORS\r
  79 \r
  80 UHACK:  CAMN    A,[PUSHJ P,SBSTIS]\r
  81         JRST    VHACK1          ; IF THIS SUBSTITUTE, DONT DO UVEC\r
  82         MOVEI   C,(D)           ; COPY UNIFORM TYPE\r
  83         SUBI    B,1             ; BACK OFF\r
  84 \r
  85 UHACK1: MOVE    D,1(B)          ; DATUM\r
  86         XCT     A\r
  87         SOSLE   (P)             ; COUNT DOEN\r
  88         AOJA    B,UHACK1\r
  89         JRST    VHACK1\r
  90 \r
  91 ; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES\r
  92 \r
  93 SHACK:  ANDI    D,377777        ; KILL EXTRA CRUFT\r
  94         CAIN    D,SATOM\r
  95         JRST    ATHACK\r
  96         CAIE    D,STPSTK        ; STACK OR\r
  97         CAIN    D,SPVP          ; PROCESS\r
  98         JRST    GHACK1          ; TREAT LIKE GENERAL\r
  99         CAIN    D,SASOC         ; ASSOCATION\r
 100         JRST    ASHACK\r
 101         CAIG    D,NUMSAT        ; TEMPLATE MAYBE?\r
 102         JRST    BADV            ; NO CHANCE\r
 103         ADDI    C,(B)           ; POINT TO DOPE WORDS\r
 104         SUBI    D,NUMSAT+1\r
 105         HRLI    D,(D)\r
 106         ADD     D,TD.LNT+1(TVP)\r
 107         JUMPGE  D,BADV          ; JUMP IF INVALID TEMPLATE HACKER\r
 108 \r
 109         CAMN    A,[PUSHJ P,SBSTIS]\r
 110         JRST    VHACK1\r
 111 \r
 112 TD.UPD: PUSH    P,A             ; INS TO EXECUTE\r
 113         XCT     (D)\r
 114         HLRZ    E,B             ; POSSIBLE BASIC LENGTH\r
 115         PUSH    P,[0]\r
 116         PUSH    P,E\r
 117         MOVEI   B,(B)           ; ISOLATE LENGTH\r
 118         PUSH    P,C             ; SAVE POINTER TO OBJECT\r
 119 \r
 120         PUSH    P,[0]           ; HOME FOR VALUES\r
 121         PUSH    P,[0]           ; SLOT FOR TEMP\r
 122         PUSH    P,B             ; SAVE\r
 123         SUB     D,TD.LNT+1(TVP)\r
 124         PUSH    P,D             ; SAVE FOR FINDING OTHER TABLES\r
 125         JUMPE   E,TD.UP2        ; NO REPEATING SEQ\r
 126         ADD     D,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
 127         HLRE    D,(D)           ; D ==> - LNTH OF TEMPLATE\r
 128         ADDI    D,(E)           ; D ==> -LENGTH OF REP SEQ\r
 129         MOVNS   D\r
 130         HRLM    D,-5(P)         ; SAVE IT AND BASIC\r
 131 \r
 132 TD.UP2: SKIPG   D,-1(P)         ; ANY LEFT?\r
 133         JRST    TD.UP1\r
 134 \r
 135         MOVE    E,TD.GET+1(TVP)\r
 136         ADD     E,(P)\r
 137         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
 138         MOVEM   D,-6(P)         ; SAVE ELMENT #\r
 139         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST\r
 140         SOJA    D,TD.UP3\r
 141 \r
 142         MOVEI   0,(B)           ; BASIC LNT TO 0\r
 143         SUBI    0,(D)           ; SEE IF PAST BASIC\r
 144         JUMPGE  0,.-3           ; JUMP IF O.K.\r
 145         MOVSS   B               ; REP LNT TO RH, BASIC TO LH\r
 146         IDIVI   0,(B)           ; A==> -WHICH REPEATER\r
 147         MOVNS   A\r
 148         ADD     A,-5(P)         ; PLUS BASIC\r
 149         ADDI    A,1             ; AND FUDGE\r
 150         MOVEM   A,-6(P)         ; SAVE FOR PUTTER\r
 151         ADDI    E,-1(A)         ; POINT\r
 152         SOJA    D,.+2\r
 153 \r
 154 TD.UP3: ADDI    E,(D)           ; POINT TO SLOT\r
 155         XCT     (E)             ; GET THIS ELEMENT INTO A AND B\r
 156         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT\r
 157         MOVEM   B,-2(P)\r
 158         GETYP   C,A             ; TYPE TO C\r
 159         MOVE    D,B             ; DATUME\r
 160         MOVEI   B,-3(P)         ; POINTER TO HOME\r
 161         MOVE    A,-7(P)         ; GET INS\r
 162         XCT     A               ; AND DO IT\r
 163         MOVE    C,-4(P)         ; GET POINTER FOR UPDATE OF ELEMENT\r
 164         MOVE    E,TD.PUT+1(TVP)\r
 165         SOS     D,-1(P)         ; RESTORE COUNT\r
 166         ADD     E,(P)\r
 167         MOVE    E,(E)           ; POINTER TO VECTOR IN E\r
 168         MOVE    B,-6(P)         ; SAVED OFFSET\r
 169         ADDI    E,(B)-1         ; POINT TO SLOT\r
 170         MOVE    A,-3(P)         ; RESTORE TYPE WORD\r
 171         MOVE    B,-2(P)\r
 172         XCT     (E)             ; SMASH IT BACK\r
 173         FATAL TEMPLATE LOSSAGE\r
 174         MOVE    C,-4(P)\r
 175         JRST    TD.UP2\r
 176 \r
 177 TD.UP1: MOVE    A,-7(P)         ; RESTORE INS\r
 178         SUB     P,[10,,10]\r
 179         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT\r
 180         JRST    VHACK1\r
 181 \r
 182 ; FATAL LOSSAGE ARRIVES HERE\r
 183 \r
 184 BADV:   FATAL GC SPACE IN A BAD STATE\r
 185 \r
 186 ; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)\r
 187 \r
 188 EHACK:  MOVSI   D,-FRAMLN       ; SET UP AOBJN PNTR\r
 189 \r
 190 EHACK1: HRRZ    C,ETB(D)        ; GET 1ST TYPE\r
 191         PUSH    P,D             ; SAVE AOBJN\r
 192         MOVE    D,1(B)          ; GET ITEM\r
 193         CAME    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT\r
 194         XCT     A               ; USER GOODIE\r
 195         POP     P,D             ; RESTORE AOBJN\r
 196         ADDI    B,1             ; MOVE ON\r
 197         SOSLE   (P)             ; ALSO COUNT IN TOTAL VECTOR\r
 198         AOBJN   D,EHACK1\r
 199         AOJA    B,GHACK1                ; AND GO ON\r
 200 \r
 201 ; TABLE OF ENTRY BLOCK TYPES\r
 202 \r
 203 ETB:    TSUBR\r
 204         TTB\r
 205         TAB\r
 206         TSP\r
 207         TPDL\r
 208         TTP\r
 209         TWORD\r
 210 \r
 211 ; HERE TO GROVEL OVER BINDING BLOCKS\r
 212 \r
 213 BHACK:  MOVEI   C,TATOM         ; ALSO TREEAT AS ATOM\r
 214         MOVE    D,1(B)\r
 215         CAME    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT\r
 216         XCT     A\r
 217         PUSHJ   P,NXTGDY        ; NEXT GOODIE\r
 218         PUSHJ   P,NXTGDY        ; AND NEXT\r
 219         MOVEI   C,TSP           ; TYPE THE BACK LOCATIVE\r
 220         PUSHJ   P,NXTGD1        ; AND NEXT\r
 221         PUSH    P,B\r
 222         HLRZ    D,-2(B)         ; DECL POINTER\r
 223         MOVEI   B,0             ; MAKE SURE NO CLOBBER\r
 224         MOVEI   C,TDECL\r
 225         XCT     A               ; DO THE THING BEING DONE\r
 226         POP     P,B\r
 227         HRLM    D,-2(B)         ; FIX UP IN CASE CHANGED\r
 228         JRST    GHACK1\r
 229 \r
 230 ; HERE TO HACK ATOMS WITH GDECLS\r
 231 \r
 232 GDHACK: CAMN    A,[PUSHJ P,SBSTIS]\r
 233         JRST    VHACK1\r
 234 \r
 235         MOVEI   C,TATOM         ; TREAT LIKE ATOM\r
 236         MOVE    D,1(B)\r
 237         XCT     A\r
 238         HRRZ    D,(B)           ; GET DECL\r
 239         JUMPE   D,VHACK1\r
 240         CAIN    D,-1            ; WATCH OUT FOR MAINFEST\r
 241         JRST    VHACK1\r
 242         PUSH    P,B             ; SAVE POINTER\r
 243         MOVEI   B,0\r
 244         MOVEI   C,TLIST\r
 245         XCT     A\r
 246         POP     P,B\r
 247         HRRM    D,(B)           ; RESET\r
 248         JRST    VHACK1\r
 249 \r
 250 ; HERE TO HACK ATOMS\r
 251 \r
 252 ATHACK: ADDI    B,1             ; POINT PRIOR TO OBL SLOT\r
 253         MOVEI   C,TOBLS         ; GET TYPE\r
 254         MOVE    D,1(B)          ; AND DATUM\r
 255         CAME    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT\r
 256         XCT     A\r
 257         JRST    VHACK1\r
 258 \r
 259 ; HERE TO HACK ASSOCIATION BLOCKS\r
 260 \r
 261 ASHACK: MOVEI   D,3             ; COUNT GOODIES TO MARK\r
 262 \r
 263 ASHAK1: PUSH    P,D\r
 264         MOVE    D,1(B)\r
 265         GETYP   C,(B)\r
 266         PUSH    P,D             ; SAVE POINTER\r
 267         XCT     A\r
 268         POP     P,D             ; GET OLD BACK\r
 269         CAME    D,1(B)          ; CHANGED?\r
 270         TLO     E,400000        ; SET NON-VIRGIN FLAG\r
 271         POP     P,D\r
 272         PUSHJ   P,BMP           ; TO NEXT\r
 273         SOJG    D,ASHAK1\r
 274 \r
 275 ; HERE  TO GOT TO NEXT VECTOR\r
 276 \r
 277 VHACK1: MOVE    B,-1(P)         ; GET POINTER\r
 278         SUB     P,[2,,2]        ; FLUSH CRUFT\r
 279         SOJA    B,VHACK2        ; FIXUP POINTER AND GO ON\r
 280 \r
 281 ; ROUTINE TO GET A GOODIE\r
 282 \r
 283 NXTGDY: GETYP   C,(B)\r
 284 NXTGD1: MOVE    D,1(B)\r
 285         XCT     A               ; DO IT TO IT\r
 286 BMP:    SOS     -1(P)\r
 287         SOSG    -1(P)\r
 288         JRST    BMP1\r
 289         ADDI    B,2\r
 290         POPJ    P,\r
 291 BMP1:   SUB     P,[1,,1]\r
 292         JRST    VHACK1\r
 293 \r
 294 REHASQ: JUMPL   E,REHASH        ; HASH TABLE RAPED, FIX IT\r
 295         POPJ    P,\r
 296 \r
 297 \r
 298 MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]\r
 299 \r
 300 ;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO\r
 301 ;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT\r
 302 ;YOU ARE DOING.\r
 303 ;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE\r
 304 ;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.\r
 305 ;BOTH ITEMS MUST BE OF THE SAME TYPE OR\r
 306 ;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS\r
 307 ;  OF STORAGE, AND SUBSTITUTION CANT BE DONE IN\r
 308 ;  UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN\r
 309 ;  A FEW OTHER YUCKY PLACES.\r
 310 ;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT\r
 311 \r
 312         ENTRY 2\r
 313 \r
 314 \r
 315 SBSTI1: GETYP   A,2(AB)\r
 316         CAIE    A,TATOM\r
 317         JRST    SBSTI2\r
 318         MOVE    B,3(AB)         ; IMPURIFY HASH BUCKET MAYBE?\r
 319         PUSHJ   P,IMPURI\r
 320 \r
 321 SBSTI2: GETYP   A,2(AB)         ; GET TYPE OF SECOND ARG\r
 322         MOVE    D,A\r
 323         PUSHJ   P,NWORDT        ; AND STORAGE ALLOCATION\r
 324         MOVE    E,A\r
 325         GETYP   A,(AB)          ; GET TYPE OF FIRST ARG \r
 326         MOVE    B,A\r
 327         PUSHJ   P,NWORDT\r
 328         CAMN    B,D             ; IF TYPES SAME, DONT CHECK FOR ALLOCATION\r
 329         JRST    SBSTI3\r
 330         CAIN    E,1\r
 331         CAIE    A,1\r
 332         JRST    SBSTIL          ; LOOSE, NOT BOTH ONE WORD GOODIES\r
 333 \r
 334 SBSTI3: MOVEI   C,0\r
 335         CAIN    D,0             ; IF GOODIE IS OF TYPE ZERO\r
 336         MOVEI   C,1             ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE\r
 337         PUSH    TP,C\r
 338         SUBI    E,1\r
 339         PUSH    TP,E            ; 1=DEFERRED TYPE ITEM, 0=ELSE\r
 340         PUSH    TP,C\r
 341         PUSH    TP,D            ; TYPE OF GOODIE\r
 342         PUSH    TP,C\r
 343         PUSH    TP,[0]\r
 344         CAIN    D,TLIST\r
 345         AOS     (TP)            ; 1=TYPE LIST, 0=ELSE\r
 346         PUSH    TP,C\r
 347         PUSH    TP,2(AB)                ; TYPE-WORD\r
 348         PUSH    TP,C\r
 349         PUSH    TP,3(AB)        ; VALUE-WORD\r
 350         PUSH    TP,(AB)\r
 351         PUSH    TP,1(AB)        ; TYPE-VALUE OF THINGS TO CHANGE INTO\r
 352         MOVE    A,[PUSHJ P,SBSTIR]\r
 353         CAME    B,D             ; IF NOT SAME TYPE, USE DIFF MUNGER\r
 354         MOVE    A,[PUSHJ P,SBSTIS]\r
 355         PUSHJ   P,GCHACK        ; DO-IT\r
 356         MOVE    A,-4(TP)\r
 357         MOVE    B,-2(TP)\r
 358         JRST    FINIS           ; GIVE THE LOOSER A HANDLE ON HIS GOODIE\r
 359 \r
 360 SBSTIR: CAME    D,-2(TP)\r
 361         JRST    LSUB            ; THIS IS IT\r
 362         CAME    C,-10(TP)\r
 363         JRST    LSUB            ; IF ITEM CANT BE SAME CHECK FOR LISTAGE\r
 364         JUMPE   B,LSUB+1        ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT\r
 365         MOVE    0,(TP)\r
 366         MOVEM   0,1(B)          ; SMASH IT\r
 367         MOVE    0,-1(TP)        ; GET TYPE WORD\r
 368         SKIPE   -12(TP)         ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST\r
 369         MOVEM   0,(B)           ; ALSO SMASH THE TYPE WORD SLOT\r
 370 \r
 371 LSUB:   SKIPN   -6(TP)          ; IF WE ARE LOOKING FOR LISTS, LOOK ON\r
 372         POPJ    P,              ; ELSE THATS ALL\r
 373         CAMG    B,PARTOP\r
 374         CAMGE   B,PARBOT        ; IS IT IN LIST SPACE?\r
 375         POPJ    P,              ; WELL NO LIST SMASHING THIS TIME\r
 376         HRRZ    0,(B)           ; GET ITS LIST POINTER\r
 377         CAME    0,-2(TP)\r
 378         POPJ    P,              ; THIS ONE DIDNT MATCH\r
 379         MOVE    0,(TP)          ; GET THE NEW REST OF THE LIST\r
 380         HRRM    0,(B)           ; AND SMASH INTO THE REST OF THE LIST\r
 381         POPJ    P,\r
 382 \r
 383 SBSTIS: CAMN    D,-2(TP)\r
 384         CAME    C,-10(TP)\r
 385         POPJ    P,\r
 386         SKIPN   B               ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE\r
 387         POPJ    P,\r
 388         MOVE    0,(TP)\r
 389         MOVEM   0,1(B)          ; KLOBBER VALUE CELL\r
 390         MOVE    0,-1(TP)\r
 391         HLLM    0,(B)           ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE\r
 392         POPJ    P,\r
 393 \r
 394 SBSTIL: PUSH    TP,$TATOM       ; LOSSAGE ON DIFFERENT TYPES, ONE DOUBLE WORD\r
 395         PUSH    TP,EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER\r
 396         JRST    CALER1\r
 397 \r
 398 END\r
 399 \r
 400 \f