<mdl.int>/gchack.mid.46

   1
   2 TITLE GCHACK
   3
   4 RELOCATABLE
   5
   6 .INSRT MUDDLE >
   7
   8 .GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG
   9 .GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR
  10
  11 UBIT==40000             ; BIT INDICATING VECTOR
  12 .LIST.==400000
  13
  14 ; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING
  15 ; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN
  16
  17 ; CALL --
  18 ;       A/  INSTRUCTION TO BE EXECUTED
  19 ;       PVP/    NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS
  20 ;       PUSHJ P,GCHACK
  21
  22 ; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE
  23
  24 GCHK10: PUSHJ   P,GHSTUP
  25         JRST    GCHK1
  26
  27 GCHACK: PUSHJ   P,GHSTUP        ; SETUP
  28         MOVE    B,CODTOP        ; START OFF WITH IMPURE STORAGE
  29         SUBI    B,1             ; START AT FIRST WORD
  30 LOPSTO: CAIG    B,STOSTR
  31         JRST    GCHK1
  32         HRRE    0,1(B)          ; GET INDICATOR OF MODIFICATION
  33         JUMPGE  0,LOSTO         ; JUMP IF GARBAGE
  34         PUSHJ   P,VHACK         ; VHACK
  35         JRST    LOPSTO
  36 LOSTO:  HLRZ    C,1(B)          ; BACK OF VECTOR
  37         TRZ     C,400000
  38         SUBI    B,(C)           ; SKIP OVER VECTOR
  39         JRST    LOPSTO
  40
  41 GCHK1:  MOVE    B,VECTOP        ; NO LOOP THRU GCS
  42         MOVEI   B,-2(B)
  43
  44
  45 LOOPHK: MOVE    C,SVTAB
  46         MOVEM   B,(C)
  47         EXCH    C,NXTTAB        ; SWAP LOCATIONS
  48         EXCH    C,SVTAB
  49         TLZ     B,.LIST.        ; TURN OFF LIST BIT
  50         CAMGE   B,GCSBOT        ; SEE IF DONE
  51         JRST    REHASQ          ; SEE IF ASSOCIATIONS ARE GOOD
  52         MOVE    C,(B)           ; GET ELEMENT
  53         TLNE    C,.VECT.        ; SEE IF IT IS A VECTOR
  54         JRST    VHCK            ; JUMP IF IT IS
  55 GLSTHK: GETYP   C,(B)           ; TYPE OF CURRENT PAIR
  56         MOVE    D,1(B)          ; AND ITS DATUM
  57         TLO     B,.LIST.        ; INDICATE A LIST
  58         SKIPL   (B)             ; SKIP IF MARKED
  59         XCT     A               ; APPLY INS
  60         SUBI    B,2
  61         JRST    LOOPHK
  62 VHCK:   PUSHJ   P,VHACK         ; TO VHACK
  63         JRST    LOOPHK
  64
  65 ; NOW DO THE SAME THING TO VECTOR SPACE
  66 VHACK:  HLRE    D,(B)           ; GET TYPE FROM D.W.
  67         TRZ     D,.VECT.        ; GET RID OF VECTOR INDICATION BIT
  68         HLRZ    C,1(B)          ; AND TOTAL LENGTH
  69         TRZE    C,400000        ; GET RID OF POSSIBLE MARK BIT
  70         JRST    MKHAK           ; JUMP IF MARKED
  71         SUBI    B,(C)-2         ; POINT TO START OF VECTOR
  72         PUSH    P,B
  73         SUBI    C,2             ; CHECK WINNAGE
  74         JUMPL   C,BADV          ; FATAL LOSSAGE
  75         PUSH    P,C             ; SAVE COUNT
  76         JUMPE   C,VHACK1        ; EMPTY VECTOR, FINISHED
  77
  78 ; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL
  79
  80         JUMPGE  D,UHACK         ; UNIFORM
  81         TRNE    D,377777        ; SKIP IF GENERAL
  82         JRST    SHACK           ; SPECIAL
  83
  84 ; FALL THROUGH TO GENERAL
  85
  86 GHACK1: SKIPGE  (B)             ; CHECK FOR FENCE POST
  87         JRST    VHACK1
  88         GETYP   C,(B)           ; LOOK A T 1ST ELEMENT
  89         CAIE    C,TCBLK
  90         CAIN    C,TENTRY        ; FRAME ON STACK
  91         SOJA    B,EHACK
  92         CAIE    C,TUBIND
  93         CAIN    C,TBIND         ; BINDING BLOCK
  94         JRST    BHACK
  95         CAIN    C,TGATOM        ; ATOM WITH GDECL?
  96         JRST    GDHACK
  97         MOVE    D,1(B)          ; GET DATUM
  98         XCT     A               ; USER INS
  99 GDHCK1: ADDI    B,2             ; NEXT ELEMENT
 100         SOS     (P)
 101         SOSLE   (P)             ; COUNT ELEMENTS
 102         SKIPGE  (B)             ; OR FENCE POST HIT
 103         JRST    VHACK1
 104         JRST    GHACK1
 105
 106 ; HERE TO GO OVER UVECTORS
 107
 108 UHACK:  CAMN    A,[PUSHJ P,SBSTIS]
 109         JRST    VHACK1          ; IF THIS SUBSTITUTE, DONT DO UVEC
 110         MOVEI   C,(D)           ; COPY UNIFORM TYPE
 111         JUMPE   PVP,UHACKX      ; JUMP IF NOT ONLY ATOMS
 112         ASH     C,1             ; COMPUTE SAT
 113         ADD     C,TYPVEC+1
 114         HRRZ    C,(C)
 115         ANDI    C,SATMSK        ; GOT ITS SAT
 116         CAIE    C,SCHSTR        ; COULD BE SPNAME
 117          JRST   .+3
 118         CAIE    C,SATOM         ; DON'T BOTHER IF NOT ALL ATOMS
 119          JRST   VHACK1
 120         MOVEI   C,(D)
 121 UHACKX: PUSH    P,C             ; ATFIX CLOBBERS C
 122         SUBI    B,1             ; BACK OFF
 123
 124 UHACK1: MOVE    C,(P)
 125         TLO     B,UBIT          ; TURN ON BIT INDICATING UVECTOR
 126         MOVE    D,1(B)          ; DATUM
 127         XCT     A
 128         SOSLE   -1(P)           ; COUNT DOEN
 129         AOJA    B,UHACK1
 130         TLZ     UBIT
 131         POP     P,C
 132         JRST    VHACK1
 133
 134 ; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES
 135
 136 SHACK:  ANDI    D,377777        ; KILL EXTRA CRUFT
 137         CAIN    D,SATOM
 138         JRST    ATHACK
 139         CAIE    D,STPSTK        ; STACK OR
 140         CAIN    D,SPVP          ; PROCESS
 141         JRST    GHACK1          ; TREAT LIKE GENERAL
 142         CAIN    D,SASOC         ; ASSOCATION
 143         JRST    ASHACK
 144         CAIG    D,NUMSAT        ; TEMPLATE MAYBE?
 145         JRST    BADV            ; NO CHANCE
 146         ADDI    C,(B)           ; POINT TO DOPE WORDS
 147         SUBI    D,NUMSAT+1
 148         HRLI    D,(D)
 149         ADD     D,TD.LNT+1
 150         JUMPGE  D,BADV          ; JUMP IF INVALID TEMPLATE HACKER
 151
 152         CAMN    A,[PUSHJ P,SBSTIS]
 153         JRST    VHACK1
 154
 155 TD.UPD: PUSH    P,A             ; INS TO EXECUTE
 156         XCT     (D)
 157         HLRZ    E,B             ; POSSIBLE BASIC LENGTH
 158         PUSH    P,[0]
 159         PUSH    P,E
 160         MOVEI   B,(B)           ; ISOLATE LENGTH
 161         PUSH    P,C             ; SAVE POINTER TO OBJECT
 162
 163         PUSH    P,[0]           ; HOME FOR VALUES
 164         PUSH    P,[0]           ; SLOT FOR TEMP
 165         PUSH    P,B             ; SAVE
 166         SUB     D,TD.LNT+1
 167         PUSH    P,D             ; SAVE FOR FINDING OTHER TABLES
 168         JUMPE   E,TD.UP2        ; NO REPEATING SEQ
 169         ADD     D,TD.GET+1      ; COMP LNTH OF REPEATING SEQ
 170         HLRE    D,(D)           ; D ==> - LNTH OF TEMPLATE
 171         ADDI    D,(E)           ; D ==> -LENGTH OF REP SEQ
 172         MOVNS   D
 173         HRLM    D,-5(P)         ; SAVE IT AND BASIC
 174
 175 TD.UP2: SKIPG   D,-1(P)         ; ANY LEFT?
 176         JRST    TD.UP1
 177
 178         MOVE    E,TD.GET+1
 179         ADD     E,(P)
 180         MOVE    E,(E)           ; POINTER TO VECTOR IN E
 181         MOVEM   D,-6(P)         ; SAVE ELMENT #
 182         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST
 183         SOJA    D,TD.UP3
 184
 185         MOVEI   0,(B)           ; BASIC LNT TO 0
 186         SUBI    0,(D)           ; SEE IF PAST BASIC
 187         JUMPGE  0,.-3           ; JUMP IF O.K.
 188         MOVSS   B               ; REP LNT TO RH, BASIC TO LH
 189         IDIVI   0,(B)           ; A==> -WHICH REPEATER
 190         MOVNS   A
 191         ADD     A,-5(P)         ; PLUS BASIC
 192         ADDI    A,1             ; AND FUDGE
 193         MOVEM   A,-6(P)         ; SAVE FOR PUTTER
 194         ADDI    E,-1(A)         ; POINT
 195         SOJA    D,.+2
 196
 197 TD.UP3: ADDI    E,(D)           ; POINT TO SLOT
 198         XCT     (E)             ; GET THIS ELEMENT INTO A AND B
 199         TLO     A,UBIT          ; INDICATE ITS A ANY
 200         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT
 201         MOVEM   B,-2(P)
 202         GETYP   C,A             ; TYPE TO C
 203         MOVE    D,B             ; DATUME
 204         MOVEI   B,-3(P)         ; POINTER TO HOME
 205         MOVE    A,-7(P)         ; GET INS
 206         XCT     A               ; AND DO IT
 207         MOVE    C,-4(P)         ; GET POINTER FOR UPDATE OF ELEMENT
 208         MOVE    E,TD.PUT+1
 209         SOS     D,-1(P)         ; RESTORE COUNT
 210         ADD     E,(P)
 211         MOVE    E,(E)           ; POINTER TO VECTOR IN E
 212         MOVE    B,-6(P)         ; SAVED OFFSET
 213         ADDI    E,(B)-1         ; POINT TO SLOT
 214         MOVE    A,-3(P)         ; RESTORE TYPE WORD
 215         MOVE    B,-2(P)
 216         XCT     (E)             ; SMASH IT BACK
 217         JRST    TD.LOS
 218 TD.WIN: MOVE    C,-4(P)
 219         JRST    TD.UP2
 220
 221 TD.LOS: SKIPN   GCDFLG
 222         FATAL TEMPLATE LOSSAGE
 223         JRST    TD.WIN
 224
 225 TD.UP1: MOVE    A,-7(P)         ; RESTORE INS
 226         SUB     P,[10,,10]
 227         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT
 228         JRST    VHACK1
 229
 230 ; FATAL LOSSAGE ARRIVES HERE
 231
 232 BADV:   FATAL GC SPACE IN A BAD STATE
 233
 234 ; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)
 235
 236 EHACK:  JUMPE   PVP,EHACKX
 237         ADDI    B,FRAMLN+1      ; SKIP THE FRAME
 238         JRST    GHACK1
 239
 240 EHACKX: HRRZ    D,1(B)
 241         CAILE   D,HIBOT
 242         JRST    EHCK10
 243         PUSH    P,1(B)
 244         HRL     D,(D)
 245         MOVEI   C,TVEC
 246         CAME    A,[PUSHJ P,SBSTIS]
 247         XCT     A               ; XCT SUBSTITUTE
 248         POP     P,C             ; RESTORE TYPE
 249         HLLM    C,1(B)          ; SMASH BACK
 250 EHCK10: ADDI    B,1
 251         MOVSI   D,-FRAMLN+1     ; SET UP AOBJN PNTR
 252
 253 EHACK1: HRRZ    C,ETB(D)        ; GET 1ST TYPE
 254         PUSH    P,D             ; SAVE AOBJN
 255         MOVE    D,1(B)          ; GET ITEM
 256         CAME    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT
 257         XCT     A               ; USER GOODIE
 258         POP     P,D             ; RESTORE AOBJN
 259         ADDI    B,1             ; MOVE ON
 260         SOSLE   (P)             ; ALSO COUNT IN TOTAL VECTOR
 261         AOBJN   D,EHACK1
 262         AOJA    B,GHACK1                ; AND GO ON
 263
 264 ; TABLE OF ENTRY BLOCK TYPES
 265
 266 ETB:    TTB
 267         TAB
 268         TSP
 269         TPDL
 270         TTP
 271         TWORD
 272
 273 ; HERE TO GROVEL OVER BINDING BLOCKS
 274
 275 BHACK:  MOVEI   C,TATOM         ; ALSO TREEAT AS ATOM
 276         MOVE    D,1(B)
 277         CAME    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT
 278         XCT     A
 279         PUSHJ   P,NXTGDY        ; NEXT GOODIE
 280         PUSHJ   P,NXTGDY        ; AND NEXT
 281         MOVEI   C,TSP           ; TYPE THE BACK LOCATIVE
 282         SKIPGE  D,1(B)
 283         XCT     A
 284         PUSHJ   P,BMP           ; AND NEXT
 285         PUSH    P,B
 286         HLRZ    D,-2(B)         ; DECL POINTER
 287         MOVEI   B,0             ; MAKE SURE NO CLOBBER
 288         MOVEI   C,TDECL
 289         XCT     A               ; DO THE THING BEING DONE
 290         POP     P,B
 291         HRLM    D,-2(B)         ; FIX UP IN CASE CHANGED
 292         JRST    GHACK1
 293
 294 ; HERE TO HACK ATOMS WITH GDECLS
 295
 296 GDHACK: CAMN    A,[PUSHJ P,SBSTIS]
 297         JRST    GDHCK1
 298
 299         MOVEI   C,TATOM         ; TREAT LIKE ATOM
 300         MOVE    D,1(B)
 301         XCT     A
 302         HRRZ    D,(B)           ; GET DECL
 303         JUMPE   D,GDHCK1
 304         CAIN    D,-1            ; WATCH OUT FOR MAINFEST
 305         JRST    GDHCK1
 306         PUSH    P,B             ; SAVE POINTER
 307         MOVEI   B,0
 308         MOVEI   C,TLIST
 309         XCT     A
 310         POP     P,B
 311         HRRM    D,(B)           ; RESET
 312         JRST    GDHCK1
 313
 314
 315 ; HERE TO HACK ATOMS
 316
 317 ATHACK: JUMPN   PVP,BUCKHK      ; IF ONLY CHANGING ATOMS, IGNROE OBLIST
 318         MOVEI   C,TOBLS         ; GET TYPE
 319         HRRZ    D,2(B)          ; AND DATUM
 320         JUMPE   D,BUCKHK        ; NOT ON OBLIST, SO FLUSH
 321         CAMGE   D,VECBOT
 322         MOVE    D,(D)           ; GET REAL OBLIST POINTER
 323         HRLI    D,-1
 324         CAMN    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT
 325         JRST    VHACK1
 326         PUSH    P,B
 327         MOVEI   B,0
 328         XCT     A
 329         POP     P,B
 330         HRRM    D,2(B)
 331 BUCKHK: CAMN    A,[PUSHJ P,SBSTIS]      ; DONT IF SUBSTITUTE DIFFERENT
 332         JRST    VHACK1
 333         HLRZ    D,2(B)
 334         JUMPE   D,VHACK1
 335         PUSH    P,B
 336         PUSH    P,D
 337         MOVEI   B,-1(P)         ; FAKE OUT TO MUNG STACK
 338 ;       HLRZ    B,1(D)
 339 ;       ANDI    B,377777
 340 ;       SUBI    B,2
 341 ;       HRLI    B,(B)
 342 ;       SUB     D,B             ; D NOW ATOM PNTR
 343         MOVEI   C,TATOM
 344         XCT     A
 345 ;       HLRE    B,D
 346 ;       SUB     D,B
 347         POP     P,D
 348         POP     P,B
 349         HRLM    D,2(B)
 350         JRST    VHACK1
 351
 352 ; HERE TO HACK ASSOCIATION BLOCKS
 353
 354 ASHACK: MOVEI   D,3             ; COUNT GOODIES TO MARK
 355
 356 ASHAK1: PUSH    P,D
 357         MOVE    D,1(B)
 358         GETYP   C,(B)
 359         PUSH    P,D             ; SAVE POINTER
 360         XCT     A
 361         POP     P,D             ; GET OLD BACK
 362         CAME    D,1(B)          ; CHANGED?
 363         TLO     E,400000        ; SET NON-VIRGIN FLAG
 364         POP     P,D
 365         PUSHJ   P,BMP           ; TO NEXT
 366         SOJG    D,ASHAK1
 367
 368 ; HERE  TO GOT TO NEXT VECTOR
 369
 370 VHACK1: MOVE    B,-1(P)         ; GET POINTER
 371         SUB     P,[2,,2]        ; FLUSH CRUFT
 372         SUBI    B,2             ; FIX UP PTR
 373         POPJ    P,
 374
 375 ; HERE TO SKIP OVER MARKED VECTOR
 376
 377 MKHAK:  SUBI    B,(C)           ; POINT BELOW VECTOR
 378         POPJ    P,
 379
 380 ; ROUTINE TO GET A GOODIE
 381
 382 NXTGDY: GETYP   C,(B)
 383 NXTGD1: MOVE    D,1(B)
 384         XCT     A               ; DO IT TO IT
 385 BMP:    SOS     -1(P)
 386         SOSG    -1(P)
 387         JRST    BMP1
 388         ADDI    B,2
 389         POPJ    P,
 390 BMP1:   SUB     P,[1,,1]
 391         JRST    VHACK1
 392
 393 REHASQ: JUMPL   E,REHASH        ; HASH TABLE RAPED, FIX IT
 394         POPJ    P,
 395
 396
 397 MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]
 398
 399 ;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO
 400 ;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT
 401 ;YOU ARE DOING.
 402 ;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE
 403 ;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.
 404 ;BOTH ITEMS MUST BE OF THE SAME TYPE OR
 405 ;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS
 406 ;  OF STORAGE, AND SUBSTITUTION CANT BE DONE IN
 407 ;  UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN
 408 ;  A FEW OTHER YUCKY PLACES.
 409 ;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT
 410
 411         ENTRY 2
 412
 413
 414 SBSTI1: GETYP   A,2(AB)
 415         CAIE    A,TATOM
 416         JRST    SBSTI2
 417         MOVE    B,3(AB)         ; IMPURIFY HASH BUCKET MAYBE?
 418         PUSHJ   P,IMPURI
 419         GETYP   A,(AB)          ; ATOM FOR ATOM SUBS?
 420         CAIE    A,TATOM
 421         JRST    SBSTI2          ; NO
 422         MOVE    B,3(AB)         ; SEE IF OLD GUY
 423         HLRE    A,B
 424         SUBM    B,A             ; POINT TO DOPE
 425         HRRZ    A,(A)           ; POSSIBLE TYPE CODE
 426         JUMPE   A,SBSTI2        ; NOT A TYPE, GO
 427         MOVE    B,1(AB)
 428         HLRE    C,B
 429         SUBM    B,C
 430         HRRZ    C,(C)           ; GET OTHER POSSIBLE CODE
 431         JUMPN   C,BADTYP
 432         PUSH    P,A
 433         PUSHJ   P,IMPURI        ; IMPURIFY FOR SMASH
 434         POP     P,A
 435         MOVE    B,1(AB)
 436         HLRE    C,B
 437         SUBM    B,C
 438         HRRM    A,(C)
 439
 440 SBSTI2: GETYP   A,2(AB)         ; GET TYPE OF SECOND ARG
 441         MOVE    D,A
 442         PUSHJ   P,NWORDT        ; AND STORAGE ALLOCATION
 443         MOVE    E,A
 444         GETYP   A,(AB)          ; GET TYPE OF FIRST ARG
 445         MOVE    B,A
 446         PUSHJ   P,NWORDT
 447         CAMN    B,D             ; IF TYPES SAME, DONT CHECK FOR ALLOCATION
 448         JRST    SBSTI3
 449         CAIN    E,1
 450         CAIE    A,1
 451         JRST    SBSTIL          ; LOOSE, NOT BOTH ONE WORD GOODIES
 452
 453 SBSTI3: MOVEI   C,0
 454         CAIN    D,0             ; IF GOODIE IS OF TYPE ZERO
 455         MOVEI   C,1             ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE
 456         PUSH    TP,C
 457         SUBI    E,1
 458         PUSH    TP,E            ; 1=DEFERRED TYPE ITEM, 0=ELSE
 459         PUSH    TP,C
 460         PUSH    TP,D            ; TYPE OF GOODIE
 461         PUSH    TP,C
 462         PUSH    TP,[0]
 463         CAIN    D,TLIST
 464         AOS     (TP)            ; 1=TYPE LIST, 0=ELSE
 465         PUSH    TP,C
 466         PUSH    TP,2(AB)                ; TYPE-WORD
 467         PUSH    TP,C
 468         PUSH    TP,3(AB)        ; VALUE-WORD
 469         PUSH    TP,(AB)
 470         PUSH    TP,1(AB)        ; TYPE-VALUE OF THINGS TO CHANGE INTO
 471         MOVE    A,[PUSHJ P,SBSTIR]
 472         CAME    B,D             ; IF NOT SAME TYPE, USE DIFF MUNGER
 473         MOVE    A,[PUSHJ P,SBSTIS]
 474         MOVEI   PVP,0           ; INDICATE NOT SPECIAL ATOM THING
 475         PUSHJ   P,GCHACK        ; DO-IT
 476         MOVE    A,-4(TP)
 477         MOVE    B,-2(TP)
 478         JRST    FINIS           ; GIVE THE LOOSER A HANDLE ON HIS GOODIE
 479
 480 SBSTIR: CAME    D,-2(TP)
 481         JRST    LSUB            ; THIS IS IT
 482         CAME    C,-10(TP)
 483         JRST    LSUB            ; IF ITEM CANT BE SAME CHECK FOR LISTAGE
 484         JUMPE   B,LSUB+1        ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT
 485         MOVE    0,(TP)
 486         MOVEM   0,1(B)          ; SMASH IT
 487         MOVE    0,-1(TP)        ; GET TYPE WORD
 488         SKIPE   -12(TP)         ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST
 489         MOVEM   0,(B)           ; ALSO SMASH THE TYPE WORD SLOT
 490
 491 LSUB:   SKIPN   -6(TP)          ; IF WE ARE LOOKING FOR LISTS, LOOK ON
 492         POPJ    P,              ; ELSE THATS ALL
 493         TLNN    B,.LIST.                ; SEE IF A LIST
 494         POPJ    P,              ; WELL NO LIST SMASHING THIS TIME
 495         HRRZ    0,(B)           ; GET ITS LIST POINTER
 496         CAME    0,-2(TP)
 497         POPJ    P,              ; THIS ONE DIDNT MATCH
 498         MOVE    0,(TP)          ; GET THE NEW REST OF THE LIST
 499         HRRM    0,(B)           ; AND SMASH INTO THE REST OF THE LIST
 500         POPJ    P,
 501
 502 SBSTIS: CAMN    D,-2(TP)
 503         CAME    C,-10(TP)
 504         POPJ    P,
 505         SKIPN   B               ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE
 506         POPJ    P,
 507         MOVE    0,(TP)
 508         MOVEM   0,1(B)          ; KLOBBER VALUE CELL
 509         MOVE    0,-1(TP)
 510         HLLM    0,(B)           ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE
 511         POPJ    P,
 512
 513 SBSTIL: ERRUUO  EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
 514 BADTYP: ERRUUO  EQUOTE SUBSTITUTE-TYPE-FOR-TYPE
 515
 516 GHSTUP: HRRZ    E,TYPVEC+1      ; SET UP TYPE POINTER
 517         HRLI    E,C             ; WILL HAVE TYPE CODE IN C
 518         SETOM   1(TP)           ; FENCE POST PDL
 519         PUSH    P,A
 520         MOVEI   A,(TB)
 521         PUSHJ   P,FRMUNG                ; MUNG CURRENT FRAME
 522         POP     P,A
 523         POPJ    P,
 524
 525
 526 IMPURE
 527
 528 ; LOCATION TO REMEMBER PREVIOUS VALUES
 529
 530 SVTAB:  SVLOC1
 531 NXTTAB: SVLOC2
 532
 533 SVLOC1: 0
 534 SVLOC2: 0
 535
 536 PURE
 537
 538 END
 539
 540 \f