mirror of
https://github.com/PDP-10/its.git
synced 2026-01-23 19:07:45 +00:00
MIDAS and Muddle source get version numbers (as in the 1973 Muddle source); the build files don't.
540 lines
12 KiB
Plaintext
540 lines
12 KiB
Plaintext
|
||
TITLE GCHACK
|
||
|
||
RELOCATABLE
|
||
|
||
.INSRT MUDDLE >
|
||
|
||
.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG
|
||
.GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR
|
||
|
||
UBIT==40000 ; BIT INDICATING VECTOR
|
||
.LIST.==400000
|
||
|
||
; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING
|
||
; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN
|
||
|
||
; CALL --
|
||
; A/ INSTRUCTION TO BE EXECUTED
|
||
; PVP/ NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS
|
||
; PUSHJ P,GCHACK
|
||
|
||
; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE
|
||
|
||
GCHK10: PUSHJ P,GHSTUP
|
||
JRST GCHK1
|
||
|
||
GCHACK: PUSHJ P,GHSTUP ; SETUP
|
||
MOVE B,CODTOP ; START OFF WITH IMPURE STORAGE
|
||
SUBI B,1 ; START AT FIRST WORD
|
||
LOPSTO: CAIG B,STOSTR
|
||
JRST GCHK1
|
||
HRRE 0,1(B) ; GET INDICATOR OF MODIFICATION
|
||
JUMPGE 0,LOSTO ; JUMP IF GARBAGE
|
||
PUSHJ P,VHACK ; VHACK
|
||
JRST LOPSTO
|
||
LOSTO: HLRZ C,1(B) ; BACK OF VECTOR
|
||
TRZ C,400000
|
||
SUBI B,(C) ; SKIP OVER VECTOR
|
||
JRST LOPSTO
|
||
|
||
GCHK1: MOVE B,VECTOP ; NO LOOP THRU GCS
|
||
MOVEI B,-2(B)
|
||
|
||
|
||
LOOPHK: MOVE C,SVTAB
|
||
MOVEM B,(C)
|
||
EXCH C,NXTTAB ; SWAP LOCATIONS
|
||
EXCH C,SVTAB
|
||
TLZ B,.LIST. ; TURN OFF LIST BIT
|
||
CAMGE B,GCSBOT ; SEE IF DONE
|
||
JRST REHASQ ; SEE IF ASSOCIATIONS ARE GOOD
|
||
MOVE C,(B) ; GET ELEMENT
|
||
TLNE C,.VECT. ; SEE IF IT IS A VECTOR
|
||
JRST VHCK ; JUMP IF IT IS
|
||
GLSTHK: GETYP C,(B) ; TYPE OF CURRENT PAIR
|
||
MOVE D,1(B) ; AND ITS DATUM
|
||
TLO B,.LIST. ; INDICATE A LIST
|
||
SKIPL (B) ; SKIP IF MARKED
|
||
XCT A ; APPLY INS
|
||
SUBI B,2
|
||
JRST LOOPHK
|
||
VHCK: PUSHJ P,VHACK ; TO VHACK
|
||
JRST LOOPHK
|
||
|
||
; NOW DO THE SAME THING TO VECTOR SPACE
|
||
VHACK: HLRE D,(B) ; GET TYPE FROM D.W.
|
||
TRZ D,.VECT. ; GET RID OF VECTOR INDICATION BIT
|
||
HLRZ C,1(B) ; AND TOTAL LENGTH
|
||
TRZE C,400000 ; GET RID OF POSSIBLE MARK BIT
|
||
JRST MKHAK ; JUMP IF MARKED
|
||
SUBI B,(C)-2 ; POINT TO START OF VECTOR
|
||
PUSH P,B
|
||
SUBI C,2 ; CHECK WINNAGE
|
||
JUMPL C,BADV ; FATAL LOSSAGE
|
||
PUSH P,C ; SAVE COUNT
|
||
JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED
|
||
|
||
; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL
|
||
|
||
JUMPGE D,UHACK ; UNIFORM
|
||
TRNE D,377777 ; SKIP IF GENERAL
|
||
JRST SHACK ; SPECIAL
|
||
|
||
; FALL THROUGH TO GENERAL
|
||
|
||
GHACK1: SKIPGE (B) ; CHECK FOR FENCE POST
|
||
JRST VHACK1
|
||
GETYP C,(B) ; LOOK A T 1ST ELEMENT
|
||
CAIE C,TCBLK
|
||
CAIN C,TENTRY ; FRAME ON STACK
|
||
SOJA B,EHACK
|
||
CAIE C,TUBIND
|
||
CAIN C,TBIND ; BINDING BLOCK
|
||
JRST BHACK
|
||
CAIN C,TGATOM ; ATOM WITH GDECL?
|
||
JRST GDHACK
|
||
MOVE D,1(B) ; GET DATUM
|
||
XCT A ; USER INS
|
||
GDHCK1: ADDI B,2 ; NEXT ELEMENT
|
||
SOS (P)
|
||
SOSLE (P) ; COUNT ELEMENTS
|
||
SKIPGE (B) ; OR FENCE POST HIT
|
||
JRST VHACK1
|
||
JRST GHACK1
|
||
|
||
; HERE TO GO OVER UVECTORS
|
||
|
||
UHACK: CAMN A,[PUSHJ P,SBSTIS]
|
||
JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC
|
||
MOVEI C,(D) ; COPY UNIFORM TYPE
|
||
JUMPE PVP,UHACKX ; JUMP IF NOT ONLY ATOMS
|
||
ASH C,1 ; COMPUTE SAT
|
||
ADD C,TYPVEC+1
|
||
HRRZ C,(C)
|
||
ANDI C,SATMSK ; GOT ITS SAT
|
||
CAIE C,SCHSTR ; COULD BE SPNAME
|
||
JRST .+3
|
||
CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS
|
||
JRST VHACK1
|
||
MOVEI C,(D)
|
||
UHACKX: PUSH P,C ; ATFIX CLOBBERS C
|
||
SUBI B,1 ; BACK OFF
|
||
|
||
UHACK1: MOVE C,(P)
|
||
TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR
|
||
MOVE D,1(B) ; DATUM
|
||
XCT A
|
||
SOSLE -1(P) ; COUNT DOEN
|
||
AOJA B,UHACK1
|
||
TLZ UBIT
|
||
POP P,C
|
||
JRST VHACK1
|
||
|
||
; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES
|
||
|
||
SHACK: ANDI D,377777 ; KILL EXTRA CRUFT
|
||
CAIN D,SATOM
|
||
JRST ATHACK
|
||
CAIE D,STPSTK ; STACK OR
|
||
CAIN D,SPVP ; PROCESS
|
||
JRST GHACK1 ; TREAT LIKE GENERAL
|
||
CAIN D,SASOC ; ASSOCATION
|
||
JRST ASHACK
|
||
CAIG D,NUMSAT ; TEMPLATE MAYBE?
|
||
JRST BADV ; NO CHANCE
|
||
ADDI C,(B) ; POINT TO DOPE WORDS
|
||
SUBI D,NUMSAT+1
|
||
HRLI D,(D)
|
||
ADD D,TD.LNT+1
|
||
JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER
|
||
|
||
CAMN A,[PUSHJ P,SBSTIS]
|
||
JRST VHACK1
|
||
|
||
TD.UPD: PUSH P,A ; INS TO EXECUTE
|
||
XCT (D)
|
||
HLRZ E,B ; POSSIBLE BASIC LENGTH
|
||
PUSH P,[0]
|
||
PUSH P,E
|
||
MOVEI B,(B) ; ISOLATE LENGTH
|
||
PUSH P,C ; SAVE POINTER TO OBJECT
|
||
|
||
PUSH P,[0] ; HOME FOR VALUES
|
||
PUSH P,[0] ; SLOT FOR TEMP
|
||
PUSH P,B ; SAVE
|
||
SUB D,TD.LNT+1
|
||
PUSH P,D ; SAVE FOR FINDING OTHER TABLES
|
||
JUMPE E,TD.UP2 ; NO REPEATING SEQ
|
||
ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ
|
||
HLRE D,(D) ; D ==> - LNTH OF TEMPLATE
|
||
ADDI D,(E) ; D ==> -LENGTH OF REP SEQ
|
||
MOVNS D
|
||
HRLM D,-5(P) ; SAVE IT AND BASIC
|
||
|
||
TD.UP2: SKIPG D,-1(P) ; ANY LEFT?
|
||
JRST TD.UP1
|
||
|
||
MOVE E,TD.GET+1
|
||
ADD E,(P)
|
||
MOVE E,(E) ; POINTER TO VECTOR IN E
|
||
MOVEM D,-6(P) ; SAVE ELMENT #
|
||
SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST
|
||
SOJA D,TD.UP3
|
||
|
||
MOVEI 0,(B) ; BASIC LNT TO 0
|
||
SUBI 0,(D) ; SEE IF PAST BASIC
|
||
JUMPGE 0,.-3 ; JUMP IF O.K.
|
||
MOVSS B ; REP LNT TO RH, BASIC TO LH
|
||
IDIVI 0,(B) ; A==> -WHICH REPEATER
|
||
MOVNS A
|
||
ADD A,-5(P) ; PLUS BASIC
|
||
ADDI A,1 ; AND FUDGE
|
||
MOVEM A,-6(P) ; SAVE FOR PUTTER
|
||
ADDI E,-1(A) ; POINT
|
||
SOJA D,.+2
|
||
|
||
TD.UP3: ADDI E,(D) ; POINT TO SLOT
|
||
XCT (E) ; GET THIS ELEMENT INTO A AND B
|
||
TLO A,UBIT ; INDICATE ITS A ANY
|
||
MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT
|
||
MOVEM B,-2(P)
|
||
GETYP C,A ; TYPE TO C
|
||
MOVE D,B ; DATUME
|
||
MOVEI B,-3(P) ; POINTER TO HOME
|
||
MOVE A,-7(P) ; GET INS
|
||
XCT A ; AND DO IT
|
||
MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT
|
||
MOVE E,TD.PUT+1
|
||
SOS D,-1(P) ; RESTORE COUNT
|
||
ADD E,(P)
|
||
MOVE E,(E) ; POINTER TO VECTOR IN E
|
||
MOVE B,-6(P) ; SAVED OFFSET
|
||
ADDI E,(B)-1 ; POINT TO SLOT
|
||
MOVE A,-3(P) ; RESTORE TYPE WORD
|
||
MOVE B,-2(P)
|
||
XCT (E) ; SMASH IT BACK
|
||
JRST TD.LOS
|
||
TD.WIN: MOVE C,-4(P)
|
||
JRST TD.UP2
|
||
|
||
TD.LOS: SKIPN GCDFLG
|
||
FATAL TEMPLATE LOSSAGE
|
||
JRST TD.WIN
|
||
|
||
TD.UP1: MOVE A,-7(P) ; RESTORE INS
|
||
SUB P,[10,,10]
|
||
MOVSI D,400000 ; RESTORE MARK/UNMARK BIT
|
||
JRST VHACK1
|
||
|
||
; FATAL LOSSAGE ARRIVES HERE
|
||
|
||
BADV: FATAL GC SPACE IN A BAD STATE
|
||
|
||
; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS)
|
||
|
||
EHACK: JUMPE PVP,EHACKX
|
||
ADDI B,FRAMLN+1 ; SKIP THE FRAME
|
||
JRST GHACK1
|
||
|
||
EHACKX: HRRZ D,1(B)
|
||
CAILE D,HIBOT
|
||
JRST EHCK10
|
||
PUSH P,1(B)
|
||
HRL D,(D)
|
||
MOVEI C,TVEC
|
||
CAME A,[PUSHJ P,SBSTIS]
|
||
XCT A ; XCT SUBSTITUTE
|
||
POP P,C ; RESTORE TYPE
|
||
HLLM C,1(B) ; SMASH BACK
|
||
EHCK10: ADDI B,1
|
||
MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR
|
||
|
||
EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE
|
||
PUSH P,D ; SAVE AOBJN
|
||
MOVE D,1(B) ; GET ITEM
|
||
CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
|
||
XCT A ; USER GOODIE
|
||
POP P,D ; RESTORE AOBJN
|
||
ADDI B,1 ; MOVE ON
|
||
SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR
|
||
AOBJN D,EHACK1
|
||
AOJA B,GHACK1 ; AND GO ON
|
||
|
||
; TABLE OF ENTRY BLOCK TYPES
|
||
|
||
ETB: TTB
|
||
TAB
|
||
TSP
|
||
TPDL
|
||
TTP
|
||
TWORD
|
||
|
||
; HERE TO GROVEL OVER BINDING BLOCKS
|
||
|
||
BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM
|
||
MOVE D,1(B)
|
||
CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
|
||
XCT A
|
||
PUSHJ P,NXTGDY ; NEXT GOODIE
|
||
PUSHJ P,NXTGDY ; AND NEXT
|
||
MOVEI C,TSP ; TYPE THE BACK LOCATIVE
|
||
SKIPGE D,1(B)
|
||
XCT A
|
||
PUSHJ P,BMP ; AND NEXT
|
||
PUSH P,B
|
||
HLRZ D,-2(B) ; DECL POINTER
|
||
MOVEI B,0 ; MAKE SURE NO CLOBBER
|
||
MOVEI C,TDECL
|
||
XCT A ; DO THE THING BEING DONE
|
||
POP P,B
|
||
HRLM D,-2(B) ; FIX UP IN CASE CHANGED
|
||
JRST GHACK1
|
||
|
||
; HERE TO HACK ATOMS WITH GDECLS
|
||
|
||
GDHACK: CAMN A,[PUSHJ P,SBSTIS]
|
||
JRST GDHCK1
|
||
|
||
MOVEI C,TATOM ; TREAT LIKE ATOM
|
||
MOVE D,1(B)
|
||
XCT A
|
||
HRRZ D,(B) ; GET DECL
|
||
JUMPE D,GDHCK1
|
||
CAIN D,-1 ; WATCH OUT FOR MAINFEST
|
||
JRST GDHCK1
|
||
PUSH P,B ; SAVE POINTER
|
||
MOVEI B,0
|
||
MOVEI C,TLIST
|
||
XCT A
|
||
POP P,B
|
||
HRRM D,(B) ; RESET
|
||
JRST GDHCK1
|
||
|
||
|
||
; HERE TO HACK ATOMS
|
||
|
||
ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST
|
||
MOVEI C,TOBLS ; GET TYPE
|
||
HRRZ D,2(B) ; AND DATUM
|
||
JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH
|
||
CAMGE D,VECBOT
|
||
MOVE D,(D) ; GET REAL OBLIST POINTER
|
||
HRLI D,-1
|
||
CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
|
||
JRST VHACK1
|
||
PUSH P,B
|
||
MOVEI B,0
|
||
XCT A
|
||
POP P,B
|
||
HRRM D,2(B)
|
||
BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT
|
||
JRST VHACK1
|
||
HLRZ D,2(B)
|
||
JUMPE D,VHACK1
|
||
PUSH P,B
|
||
PUSH P,D
|
||
MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK
|
||
; HLRZ B,1(D)
|
||
; ANDI B,377777
|
||
; SUBI B,2
|
||
; HRLI B,(B)
|
||
; SUB D,B ; D NOW ATOM PNTR
|
||
MOVEI C,TATOM
|
||
XCT A
|
||
; HLRE B,D
|
||
; SUB D,B
|
||
POP P,D
|
||
POP P,B
|
||
HRLM D,2(B)
|
||
JRST VHACK1
|
||
|
||
; HERE TO HACK ASSOCIATION BLOCKS
|
||
|
||
ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK
|
||
|
||
ASHAK1: PUSH P,D
|
||
MOVE D,1(B)
|
||
GETYP C,(B)
|
||
PUSH P,D ; SAVE POINTER
|
||
XCT A
|
||
POP P,D ; GET OLD BACK
|
||
CAME D,1(B) ; CHANGED?
|
||
TLO E,400000 ; SET NON-VIRGIN FLAG
|
||
POP P,D
|
||
PUSHJ P,BMP ; TO NEXT
|
||
SOJG D,ASHAK1
|
||
|
||
; HERE TO GOT TO NEXT VECTOR
|
||
|
||
VHACK1: MOVE B,-1(P) ; GET POINTER
|
||
SUB P,[2,,2] ; FLUSH CRUFT
|
||
SUBI B,2 ; FIX UP PTR
|
||
POPJ P,
|
||
|
||
; HERE TO SKIP OVER MARKED VECTOR
|
||
|
||
MKHAK: SUBI B,(C) ; POINT BELOW VECTOR
|
||
POPJ P,
|
||
|
||
; ROUTINE TO GET A GOODIE
|
||
|
||
NXTGDY: GETYP C,(B)
|
||
NXTGD1: MOVE D,1(B)
|
||
XCT A ; DO IT TO IT
|
||
BMP: SOS -1(P)
|
||
SOSG -1(P)
|
||
JRST BMP1
|
||
ADDI B,2
|
||
POPJ P,
|
||
BMP1: SUB P,[1,,1]
|
||
JRST VHACK1
|
||
|
||
REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT
|
||
POPJ P,
|
||
|
||
|
||
MFUNCTION SUBSTI,SUBR,[SUBSTITUTE]
|
||
|
||
;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO
|
||
;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT
|
||
;YOU ARE DOING.
|
||
;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE
|
||
;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA.
|
||
;BOTH ITEMS MUST BE OF THE SAME TYPE OR
|
||
;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS
|
||
; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN
|
||
; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN
|
||
; A FEW OTHER YUCKY PLACES.
|
||
;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT
|
||
|
||
ENTRY 2
|
||
|
||
|
||
SBSTI1: GETYP A,2(AB)
|
||
CAIE A,TATOM
|
||
JRST SBSTI2
|
||
MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE?
|
||
PUSHJ P,IMPURI
|
||
GETYP A,(AB) ; ATOM FOR ATOM SUBS?
|
||
CAIE A,TATOM
|
||
JRST SBSTI2 ; NO
|
||
MOVE B,3(AB) ; SEE IF OLD GUY
|
||
HLRE A,B
|
||
SUBM B,A ; POINT TO DOPE
|
||
HRRZ A,(A) ; POSSIBLE TYPE CODE
|
||
JUMPE A,SBSTI2 ; NOT A TYPE, GO
|
||
MOVE B,1(AB)
|
||
HLRE C,B
|
||
SUBM B,C
|
||
HRRZ C,(C) ; GET OTHER POSSIBLE CODE
|
||
JUMPN C,BADTYP
|
||
PUSH P,A
|
||
PUSHJ P,IMPURI ; IMPURIFY FOR SMASH
|
||
POP P,A
|
||
MOVE B,1(AB)
|
||
HLRE C,B
|
||
SUBM B,C
|
||
HRRM A,(C)
|
||
|
||
SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG
|
||
MOVE D,A
|
||
PUSHJ P,NWORDT ; AND STORAGE ALLOCATION
|
||
MOVE E,A
|
||
GETYP A,(AB) ; GET TYPE OF FIRST ARG
|
||
MOVE B,A
|
||
PUSHJ P,NWORDT
|
||
CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION
|
||
JRST SBSTI3
|
||
CAIN E,1
|
||
CAIE A,1
|
||
JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES
|
||
|
||
SBSTI3: MOVEI C,0
|
||
CAIN D,0 ; IF GOODIE IS OF TYPE ZERO
|
||
MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE
|
||
PUSH TP,C
|
||
SUBI E,1
|
||
PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE
|
||
PUSH TP,C
|
||
PUSH TP,D ; TYPE OF GOODIE
|
||
PUSH TP,C
|
||
PUSH TP,[0]
|
||
CAIN D,TLIST
|
||
AOS (TP) ; 1=TYPE LIST, 0=ELSE
|
||
PUSH TP,C
|
||
PUSH TP,2(AB) ; TYPE-WORD
|
||
PUSH TP,C
|
||
PUSH TP,3(AB) ; VALUE-WORD
|
||
PUSH TP,(AB)
|
||
PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO
|
||
MOVE A,[PUSHJ P,SBSTIR]
|
||
CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER
|
||
MOVE A,[PUSHJ P,SBSTIS]
|
||
MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING
|
||
PUSHJ P,GCHACK ; DO-IT
|
||
MOVE A,-4(TP)
|
||
MOVE B,-2(TP)
|
||
JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE
|
||
|
||
SBSTIR: CAME D,-2(TP)
|
||
JRST LSUB ; THIS IS IT
|
||
CAME C,-10(TP)
|
||
JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE
|
||
JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT
|
||
MOVE 0,(TP)
|
||
MOVEM 0,1(B) ; SMASH IT
|
||
MOVE 0,-1(TP) ; GET TYPE WORD
|
||
SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST
|
||
MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT
|
||
|
||
LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON
|
||
POPJ P, ; ELSE THATS ALL
|
||
TLNN B,.LIST. ; SEE IF A LIST
|
||
POPJ P, ; WELL NO LIST SMASHING THIS TIME
|
||
HRRZ 0,(B) ; GET ITS LIST POINTER
|
||
CAME 0,-2(TP)
|
||
POPJ P, ; THIS ONE DIDNT MATCH
|
||
MOVE 0,(TP) ; GET THE NEW REST OF THE LIST
|
||
HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST
|
||
POPJ P,
|
||
|
||
SBSTIS: CAMN D,-2(TP)
|
||
CAME C,-10(TP)
|
||
POPJ P,
|
||
SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE
|
||
POPJ P,
|
||
MOVE 0,(TP)
|
||
MOVEM 0,1(B) ; KLOBBER VALUE CELL
|
||
MOVE 0,-1(TP)
|
||
HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE
|
||
POPJ P,
|
||
|
||
SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
|
||
BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE
|
||
|
||
GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER
|
||
HRLI E,C ; WILL HAVE TYPE CODE IN C
|
||
SETOM 1(TP) ; FENCE POST PDL
|
||
PUSH P,A
|
||
MOVEI A,(TB)
|
||
PUSHJ P,FRMUNG ; MUNG CURRENT FRAME
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
|
||
IMPURE
|
||
|
||
; LOCATION TO REMEMBER PREVIOUS VALUES
|
||
|
||
SVTAB: SVLOC1
|
||
NXTTAB: SVLOC2
|
||
|
||
SVLOC1: 0
|
||
SVLOC2: 0
|
||
|
||
PURE
|
||
|
||
END
|
||
|
||
|