<mdl.int>/gchack.mid.45

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