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