X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=sumex%2Fgchack.mcr020;fp=sumex%2Fgchack.mcr020;h=35a41237587e4e8d86ac24a45737c85f5807440b;hp=0000000000000000000000000000000000000000;hb=1c973408824dee4a587c040bc8075cd1bf047ba3;hpb=a3df309bdd1ea54242d39e62403548d1e4845f8e

diff --git a/sumex/gchack.mcr020 b/sumex/gchack.mcr020
new file mode 100644
index 0000000..35a4123
--- /dev/null
+++ b/sumex/gchack.mcr020
@@ -0,0 +1,400 @@
+TITLE GCHACK
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT
+.GLOBAL TD.LNT,TD.GET,TD.PUT
+
+; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING
+; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN
+
+; CALL --
+;	A/  INSTRUCTION TO BE EXECUTED
+;	PUSHJ P,GCHACK
+
+GCHACK:	HRRZ	E,TYPVEC+1(TVP)	; SET UP TYPE POINTER
+	HRLI	E,C		; WILL HAVE TYPE CODE IN C
+	MOVE	B,PARBOT	; START AT PARBOT
+	SETOM	1(TP)		; FENCE POST PDL
+	PUSH	P,A
+	MOVEI	A,(TB)
+	PUSHJ	P,FRMUNG		; MUNG CURRENT FRAME
+	POP	P,A
+
+; FIRST HACK PAIR SPACE
+
+PHACK:	CAML	B,PARTOP		; SKIP IF MORE PAIRS
+	JRST	VHACK		; DONE, NOW HACK VECTORS
+	GETYP	C,(B)		; TYPE OF CURRENT PAIR
+	MOVE	D,1(B)		; AND ITS DATUM
+	XCT	A		; APPLY INS
+	ADDI	B,2
+	JRST	PHACK
+
+; NOW DO THE SAME THING TO VECTOR SPACE
+
+VHACK:	MOVE	B,VECTOP	; START AT TOP, MOVE DOWN
+	SUBI	B,1		; POINT TO TOPMOST VECTOR
+VHACK2:	CAMG	B,VECBOT	; SKIP IF MORE TO DO
+	JRST	REHASQ		; SEE IF MUST REHASH
+
+	HLRE	D,-1(B)		; GET TYPE FROM D.W.
+	HLRZ	C,(B)		; AND TOTAL LENGTH
+	SUBI	B,(C)-1		; 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:	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
+	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
+	SUBI	B,1		; BACK OFF
+
+UHACK1:	MOVE	D,1(B)		; DATUM
+	XCT	A
+	SOSLE	(P)		; COUNT DOEN
+	AOJA	B,UHACK1
+	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(TVP)
+	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(TVP)
+	PUSH	P,D		; SAVE FOR FINDING OTHER TABLES
+	JUMPE	E,TD.UP2	; NO REPEATING SEQ
+	ADD	D,TD.GET+1(TVP)	; 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(TVP)
+	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
+	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(TVP)
+	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
+	FATAL TEMPLATE LOSSAGE
+	MOVE	C,-4(P)
+	JRST	TD.UP2
+
+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:	MOVSI	D,-FRAMLN	; 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:	TSUBR
+	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
+	PUSHJ	P,NXTGD1	; 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	VHACK1
+
+	MOVEI	C,TATOM		; TREAT LIKE ATOM
+	MOVE	D,1(B)
+	XCT	A
+	HRRZ	D,(B)		; GET DECL
+	JUMPE	D,VHACK1
+	CAIN	D,-1		; WATCH OUT FOR MAINFEST
+	JRST	VHACK1
+	PUSH	P,B		; SAVE POINTER
+	MOVEI	B,0
+	MOVEI	C,TLIST
+	XCT	A
+	POP	P,B
+	HRRM	D,(B)		; RESET
+	JRST	VHACK1
+
+; HERE TO HACK ATOMS
+
+ATHACK:	ADDI	B,1		; POINT PRIOR TO OBL SLOT
+	MOVEI	C,TOBLS		; GET TYPE
+	MOVE	D,1(B)		; AND DATUM
+	CAME	A,[PUSHJ P,SBSTIS]	; DONT IF SUBSTITUTE DIFFERENT
+	XCT	A
+	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
+	SOJA	B,VHACK2	; FIXUP POINTER AND GO ON
+
+; 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
+
+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]
+	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
+	CAMG	B,PARTOP
+	CAMGE	B,PARBOT	; IS IT IN LIST SPACE?
+	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:	PUSH	TP,$TATOM	; LOSSAGE ON DIFFERENT TYPES, ONE DOUBLE WORD
+	PUSH	TP,EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER
+	JRST	CALER1
+
+END
+
+
\ No newline at end of file