--- /dev/null
+
+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
+
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff