Twenex MDL 106 files.

src/mudsys/agcmrk.mid.1

@@ -0,0 +1,14 @@
+TITLE	AGCMRK ESTABLISH AGC LOADING POINT
+
+RELOCA
+
+.GLOBAL	AGCLD
+
+XX==$.+1777
+
+.LOP ANDCM XX,1777
+
+AGCLD=.LVAL1
+
+END
+

src/mudsys/amsgc.mid.107

@@ -0,0 +1,865 @@
+TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
+
+RELOCATABLE
+
+.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
+.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
+.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
+.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
+.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
+.GLOBAL RSLENG
+
+GCST=$.
+
+LOC REALGC+RLENGC
+
+OFFS=AGCLD-$.
+OFFSET OFFS
+
+.INSRT MUDDLE >
+
+TYPNT==AB
+F==PVP
+
+
+; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR.  IT IS MUCH FASTER THAN THE COPYING
+; GARBAGE COLLECTOR BUT DOESN'T COMPACT.  IT CONSES FREE THINGS ONTO RCL AND RCLV.
+; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE 
+; GARBAGE COLLECT
+
+
+; FIRST INITIALIZE VARIABLES
+
+IAMSGC:	SETZB	M,RCL			; CLEAR OUT LIST RECYCLE AND RSUBR BASE
+	SETZM	RCLV			; CLEAR VECTOR RECYCLE
+	SETZM	MAXLEN			; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
+	SETOM	GCFLG			; A GC HAS HAPPENED
+	SETZM	TOTCNT
+	HLLZS	SQUPNT			; CLEAR OUT SQUOZE TABLE
+
+; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
+
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C			; SAVE ACS
+	MOVEI	B,[ASCIZ /MSGIN / ]	; PRINT GIN IF WINNING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+	HRRZ	C,(P)			; GET CAUSE INDICATOR
+	ADDI	B,1			; AOS TO GET REAL CAUS
+	MOVEM	B,GCCAUS
+	SKIPN	GCMONF
+	JRST	NOMON2
+	MOVE	B,MSGGCT(C)		; GET CAUSE MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON2:	HLRZ	C,(P)			; FIND OUT WHO CAUSED THE GC
+	MOVEM	C,GCCALL
+	SKIPN	GCMONF			; PRINT IF GCMON IS ON
+	JRST	NOMON3
+	MOVE	B,MSGGFT(C)		; GET POINTER TO MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON3:	SUB	P,[1,,1]
+	POP	P,B			; RESTORE ACS
+	POP	P,A
+
+; MOVE ACS INTO THE PVP
+
+	EXCH	PVP,PVSTOR+1		; GET REAL PROCESS VECTOR
+
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVEM	AC,AC!STO+1(PVP)
+	TERMIN
+
+	MOVE	0,PVSTOR+1		; GET OLD VALUE OF PVP
+	MOVEM	0,PVPSTO+1(PVP)		; SAVE PVP
+	MOVE	0,DSTORE		; SAVE D'S TYPE
+	MOVEM	0,DSTO(PVP)
+	MOVEM	PVP,PVSTOR+1
+
+; SET UP TYPNT TO POINT TO TYPE VECTOR
+
+	GETYP	E,TYPVEC		; FIRST SEE IF TYPVEC IS A VECTOR
+	CAIE	E,TVEC
+	FATAL	TYPE VECTOR NOT OF TYPE VECTOR
+	HRRZ	TYPNT,TYPVEC+1
+	HRLI	TYPNT,B			; TYPNT IS NOW TYPEVECTOR(B)
+
+; NOW SET UP GCPDL AND FENCE POST PDL'S
+
+	MOVEI	A,(TB)
+	MOVE	D,P			; SAVE P POINTER
+	PUSHJ	P,FRMUNG
+	MOVE	P,[-2000,,MRKPDL]	; SET UP MARK PDL
+	MOVEI	A,(TB)			; FIXUP TOP FRAME
+	SETOM	1(TP)			; FENCEPOST TP
+	SETOM	1(D)			; FENCEPOST P
+
+; NOW SETUP AUTO CHANNEL CLOSE
+
+	MOVEI	0,N.CHNS-1		; NUMBER OF CHANNELS
+	MOVEI	A,CHNL1			; FIRST CHANNEL SLOT
+CHNCLR:	SKIPE	1(A)			; IS IT A CHANNEL
+	SETZM	(A)			; CLEAR UP TYPE SLOT
+	ADDI	A,2
+	SOJG	0,CHNCLR
+
+; NOW DO MARK AND SWEEP PHASES
+
+	MOVSI	D,400000		; MARK BIT
+	MOVEI	B,TPVP			; GET TYPE
+	MOVE	A,PVSTOR+1		; GET VALUE OF CURRENT PROCESS VECTOR
+	PUSHJ	P,MARK
+	MOVEI	B,TPVP			; GET TYPE OF MAIN PROCESS VECTOR
+	MOVE	A,MAINPR
+	PUSHJ	P,MARK			; MARK
+	PUSHJ	P,CHNFLS		; DO CHANNEL FLUSHING
+	PUSHJ	P,STOGC			; FIX UP FROZEN WORLD
+	PUSHJ	P,SWEEP			; SWEEP WORLD
+
+; PRINT GOUT
+
+	MOVEI	B,[ASCIZ /MSGOUT /]		; PRINT OUT ENDING MESSAGE IF GCMONING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+
+; RESTORE ACS
+
+	MOVE	PVP,PVSTOR+1		; GET PVP
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVE	AC,AC!STO+1(PVP)
+	TERMIN
+
+	SKIPN	DSTORE			; CLEAR OUT TYPE IF NO TYPE THERE
+	SETZM	DSTO(PVP)
+	MOVE	PVP,PVPSTO+1(PVP)
+
+; PRINT TIME
+
+	PUSH	P,A			; SAVE ACS
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSHJ	P,CTIME			; GET CURRENT CPU TIME
+	FSBR	B,GCTIM			; COMPUTE TIME ELAPSED
+	MOVEM	B,GCTIM			; SAVE TIME AWAY
+	SKIPN	GCMONF			; PRINT IT OUT?
+	JRST	GCCONT
+	PUSHJ	P,FIXSEN
+	MOVEI	A,15			; OUTPUT CR/LF
+	PUSHJ	P,IMTYO
+	MOVEI	A,12
+	PUSHJ	P,IMTYO
+GCCONT:	POP	P,D			; RESTORE ACS
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	SETZM	GCFLG
+	SETOM	GCHAPN
+	SETOM	INTFLG
+	PUSHJ	P,RBLDM
+	JRST	FNMSGC			; DONE
+
+
+; THIS IS THE MARK PHASE
+
+; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
+; /A POINTER TO GOODIE
+; /B TYPE OF GOODIE
+; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
+
+MARK2S:
+MARK2:	HLRZ	B,(C)			; TYPE
+MARK1:	MOVE	A,1(C)			; VALUE
+MARK:	JUMPE	A,CPOPJ			; DONE IF ZERO
+	MOVEI	0,1(A)			; SEE IF PURE
+	CAML	0,PURBOT
+	JRST	CPOPJ
+	ANDI	B,TYPMSK		; FLUSH	MONITORS
+	HRLM	C,(P)
+	CAIG	B,NUMPRI		; IS A BASIC TYPE
+	JRST	@MTYTBS(B)		; TYPE DISPATCH
+	LSH	B,1			; NOW GET PRIMTYPE
+	HRRZ	B,@TYPNT		; GET PRIMTYPE
+	ANDI	B,SATMSK		; FLUSH DOWN TO SAT
+	CAIG	B,NUMSAT		; SKIP IF TEMPLATE DATA
+	JRST	@MSATBS(B)		; JUMP OFF SAT TABLE
+	JRST	TD.MK
+
+GCRET:	HLRZ	C,(P)			; GET SAVED C
+CPOPJ:	POPJ	P,
+
+; TYPE DISPATCH TABLE
+MTYTBS:
+
+OFFSET 0
+
+DUM1:
+
+IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
+[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
+[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
+[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
+[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
+[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
+[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
+[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
+[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK]
+[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
+[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
+[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
+[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
+[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
+[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
+[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
+	IRP A,B,[XX]
+		LOC DUM1+A
+		SETZ B
+		.ISTOP
+	TERMIN
+TERMIN
+
+LOC DUM1+NUMPRI+1
+
+OFFSET OFFS
+
+; SAT DISPATCH TABLE
+
+MSATBS:
+
+OFFSET 0
+
+DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
+[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+
+; ROUTINE TO MARK PAIRS
+
+PAIRMK: MOVEI	C,(A)
+PAIRM1:	CAMG	C,GCSTOP		; SEE IF IN RANGE
+	CAIGE	C,STOSTR
+	JRST	BADPTR			; FATAL ERROR
+	HLRE	B,(C)			; SKIP IF NOT MARKED
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	PUSHJ	P,MARK1			; MARK THE ITEM
+	HRRZ	C,(C)			; GET NEXT ELEMENT OF LIST
+	JUMPE	C,GCRET
+	CAML	C,PURBOT
+	JRST	GCRET
+	JRST	PAIRM1
+	
+; ROUTINE TO MARK DEFERS
+
+DEFMK:	HLRE	B,(A)
+	JUMPL	B,GCRET
+	MOVEI	C,(A)
+	IORM	D,(C)
+	PUSHJ	P,MARK1
+	JRST	GCRET
+
+; ROUTINE TO MARK POSSIBLE DEFERS DEF?
+
+DEFQMK:	GETYP	B,(A)			; GET THE TYPE OF THE OBJECT
+	LSH	B,1			; COMPUTE THE SAT
+	HRRZ	B,@TYPNT
+	ANDI	B,SATMSK
+	SKIPL	MKTBS(B)		; SKIP IF NOT DEFERED
+	JRST	PAIRMK
+	JRST	DEFMK			; GO TO DEFMK
+
+
+; ROUTINE TO MARK VECTORS
+
+VECMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B
+	MOVEI	C,1(A)			; POINT TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	B,(C)
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(B)			; GET TO BEGINNING
+VECMK1:	HLRE	B,(C)			; GET TYPE AND SKIP IF NOT DOPE WORD
+	JUMPL	B,GCRET			; DONE
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; NEXT ELEMENT
+	JRST	VECMK1
+
+; ROUTINE TO MARK UVECTORS
+
+UVMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,1(A)			; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	F,(C)			; GET LENGTH
+	JUMPL	F,GCRET
+	IORM	D,(C)			; MARK IT
+	GETYP	B,-1(C)			; GET TYPE
+	MOVEI	E,(B)			; COPY TYPE FOR SAT COMPUTATION
+	LSH	B,1
+	HRRZ	B,@TYPNT		; GET SAT
+	ANDI	B,SATMSK
+	MOVEI	B,@MSATBS(B)		; GET JUMP LOCATION
+	CAIN	B,GCRET
+	JRST	GCRET
+	SUBI	C,(F)			; POINT TO BEGINNING OF UVECTOR
+	SUBI	F,2
+	JUMPE	F,GCRET
+	PUSH	P,F			; SAVE LENGTH
+	PUSH	P,E
+UNLOOP:	MOVE	B,(P)
+	MOVE	A,1(C)			; GET VALUE POINTER
+	PUSHJ	P,MARK
+	SOSE	-1(P)			; SKIP IF NON-ZERO
+	AOJA	C,UNLOOP		; GO BACK AGAIN
+	SUB	P,[2,,2]		; CLEAN OFF STACK
+	JRST	GCRET
+
+; ROUTINE TO INDICATE A BAD POINTER
+
+BADPTR:	FATAL	POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
+	JRST	GCRET
+
+
+; ROUTINE TO MARK A TPSTACK
+
+TPMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	A,(C)
+	JUMPL	A,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(A)			; GO TO BEGINNING
+
+TPLP:	HLRE	B,(C)			; GET TYPE AND MARKING
+	JUMPL	B,GCRET			; EXIT ON FENCE-POST
+	ANDI	B,TYPMSK		; FLUSH MONITORS
+	CAIE	B,TCBLK			; CHECK FOR FRAME
+	CAIN	B,TENTRY
+	JRST	MFRAME			; MARK THE FRAME
+	CAIE	B,TUBIND		; BINDING BLOCK
+	CAIN	B,TBIND
+	JRST	MBIND
+	PUSHJ	P,MARK1			; NOTHING SPECIAL SO MARK IT
+	ADDI	C,2			; POINT TO NEXT OBJECT
+	JRST	TPLP			; MARK IT
+
+; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
+
+MFRAME:	HRROI	C,FRAMLN+FSAV-1(C)	; POINT TO FUNCTION
+	HRRZ	A,1(C)			; GET POINTER
+	CAIL	A,STOSTR		; SEE IF IN GC SPACE
+	CAMLE	A,GCSTOP
+	JRST	MFRAM1			; SKIP OVER IT, NOT IN GC-SPACE
+	HRL	A,(A)			; GET LENGTH
+	MOVEI	B,TVEC			; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
+	PUSHJ	P,MARK
+MFRAM1:	MOVE	A,PSAV-FSAV+1(C)	; MARK THE PSTACK
+	MOVEI	B,TPDL
+	PUSHJ	P,MARK
+	HRROI	C,-FSAV+1(C)		; POINT PAST FRAME
+	JRST	TPLP			; GO BACK TO START OF LOOP
+
+; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
+
+MBIND:	MOVEI	B,TATOM			; START BY MARKING THE ATOM
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; POINT TO VALUE SLOT
+	PUSHJ	P,MARK2			; MARK THE VALUE
+	ADDI	C,2			; POINT TO DECL AND PREV BINDING
+	MOVEI	B,TLIST			; MARK DECL
+	HLRZ	A,(C)
+	PUSHJ	P,MARK
+	SKIPL	A,1(C)			; SKIP IF PREVIOUS BINDING
+	JRST	NOTLCI
+	MOVEI	B,TLOCI			; GET TYPE
+	PUSHJ	P,MARK
+NOTLCI:	ADDI	C,2			; POINT PAST BINDING
+	JRST	TPLP
+
+
+PMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	IORM	D,(C)			; MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK TB POINTER
+
+TBMK:	HRRZS	A			; CHECK FOR NIL POINTER
+	SKIPN	A
+	JRST	GCRET
+	MOVE	A,TPSAV(A)		; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK AB POINTERS
+
+ABMK:	HLRE	B,A			; GET TO FRAME
+	SUB	A,B
+	MOVE	A,FRAMLN+TPSAV(A)	; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK FRAME POINTERS
+
+FRMK:	HRLZ	B,A			; GET THE TIME
+	HLRZ	F,OTBSAV(A)		; GET TIME FROM FRAME
+	CAIE	B,(F)			; SKIP IF TIMES AGREE
+	JRST	GCRET			; IGNORE POINTER IF THEY DONT
+	HRRZ	A,(C)			; GET POINTER TO PROCESS
+	SUBI	A,1			; FUDGE FOR VECTOR MARKING
+	MOVEI	B,TPVP			; TYPE WORD
+	PUSHJ	P,MARK
+	HRRZ	A,1(C)			; GET POINTER TO FRAME
+	JRST	TBMK			; MARK IT
+
+; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
+
+ARGMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; POINT PAST BLOCK
+	CAIL	A,STOSTR
+	CAMLE	A,GCSTOP		; SEE IF IN GCSPACE
+	JRST	GCRET
+	HRLZ	0,(A)			; GET TYPE
+	ANDI	0,TYPMSK		; FLUSH MONITORS
+	CAIE	0,TENTRY
+	CAIN	0,TCBLK
+	JRST	ARGMK1			; AT FRAME
+	CAIE	0,TINFO			; AT FRAME
+	JRST	GCRET			; NOT A LEGAL TYPE GO AWAY
+	HRRZ	A,1(A)			; POINTING TO FRAME
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+ARGMK1:	HRRI	A,FRAMLN(A)		; MAKE POINTER
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+
+
+; ROUTINE TO MARK GLOBAL SLOTS
+
+GATOMK:	HRRZ	B,(C)			; GET POSSIBLE GDECL
+	JUMPE	B,ATOMK			; NONE GO TO MARK ATOM
+	CAIN	B,-1			; SKIP IF NOT MANIFEST
+	JRST	ATOMK
+	PUSH	P,A			; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
+	MOVEI	C,(A)
+	MOVEI	A,(B)
+	MOVEI	B,TLIST			; TYPE WORD LIST
+	PUSHJ	P,MARK			; MARK IT
+	POP	P,A
+	JRST	ATOMK5
+
+ATOMK:
+ATOMK5:	HLRE	B,A
+	SUB	A,B			; A POINTS TO DOPE WORD
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET			; EXIT IF MARKED
+	HLRZ	B,1(A)
+	SUBI	B,3
+	HRLI	B,1(B)
+	MOVEI	C,-1(A)
+	SUB	C,B			; IN CASE WAS DW
+	IORM	D,1(A)			; MARK IT
+	HRRZ	A,2(C)			; MARK OBLIST
+	CAMG	A,VECBOT
+	JRST	NOOBL			; NO IMPURE OBLIST
+	HRLI	A,-1
+	MOVEI	B,TOBLS			; MARK THE OBLIST
+	PUSHJ	P,MARK
+NOOBL:	HLRZ	A,2(C)			; GET NEXT ATOM
+	MOVEI	B,TATOM
+	PUSHJ	P,MARK
+      	HLRZ	B,(C)			; GET VALUE SLOT
+	TRZ	B,400000		; TURN OFF MARK BIT
+	SKIPE	B			; SEE IF 0
+	CAIN	B,TUNBOUN		; SEE IF UNBOUND
+	JRST	GCRET
+	HRRZ	0,(C)			; SEE IF VECTOR OR TP POINTER
+	MOVEI	B,TVEC			; ASSUME VECTOR
+	SKIPE	0			; SKIP IF VECTOR
+	MOVEI	B,TTP			; IT IS A TP POINTER
+	PUSHJ	P,MARK1			; GO MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK BYTE AND STRING POINTERS
+
+BYTMK:	PUSHJ	P,BYTDOP		; GET TO DOPE WORD INTO A
+	HRLZ	F,-1(A)			; SEE IF SPECIAL ATOM [SPNAME]
+	ANDI	F,SATMSK		; GET SAT
+	CAIN	F,SATOM
+	JRST	ATMSET			; IT IS AN ATOM
+	IORM	D,(A)			; MARK IT
+	JRST	GCRET
+
+ATMSET:	HLRZ	B,(A)			; GET LENGTH
+	TRZ	B,400000		; TURN OFF POSSIBLE MARK BIT
+	MOVNI	B,-2(B)			; GENERATE AOBJN POINTER
+	ADDI	A,-1(B)			; GET BACK TO BEGINNING
+	HRLI	A,(B)			; PUT IN LEFT HALF
+	MOVEI	B,TATOM			; MARK AS AN ATOM
+	PUSHJ	P,MARK			; GO MARK
+	JRST	GCRET
+
+; MARK LOCID GOODIES
+
+LOCMK:	HRRZ	B,(C)			; CHECK FOR TIME
+	JUMPE	B,LOCMK1		; SKIP LEGAL CHECK FOR GLOBAL
+	HRRZ	0,2(A)			; GET OTHER TIME
+	CAIE	0,(B)			; SAME?
+	JRST	GCRET
+	MOVEI	B,TTP
+	PUSHJ	P,MARK1
+	JRST	GCRET
+LOCMK1:	MOVEI	B,TVEC			; GLOBAL
+	PUSHJ	P,MARK1			; MARK VALUE
+	JRST	GCRET
+
+; MARK ASSOCIATION BLOCK
+
+ASMK:	MOVEI	C,(A)			; SAVE POINTER TO BEGINNING OF ASSOCATION
+	ADDI	A,ASOLNT		; POINT TO DOPE WORD
+	HLRE	B,1(A)			; GET SECOND D.W.
+	JUMPL	B,GCRET			; MARKED SO LEAVE
+	IORM	D,1(A)			; MARK ASSOCATION
+	PUSHJ	P,MARK2			; MARK ITEM
+	MOVEI	C,INDIC(C)
+	PUSHJ	P,MARK2
+	MOVEI	C,VAL-INDIC(C)
+	PUSHJ	P,MARK2
+	HRRZ	A,NODPNT-VAL(C)		; GET NEXT IN CHAIN
+	JUMPN	A,ASMK			; GO MARK IT
+	JRST	GCRET
+
+; MARK OFFSETS
+
+OFFSMK:	PUSH	P,$TLIST
+	HLRZ	0,1(C)			; PICK UP LIST POINTER
+	PUSH	P,0
+	MOVEI	C,-1(P)
+	PUSHJ	P,MARK2			; MARK THE LIST
+	SUB	P,[2,,2]
+	JRST	GCRET			; AND RETURN
+
+; HERE TO MARK TEMPLATE DATA STRUCTURES
+
+TD.MK:	HLRZ	B,(A)			; GET REAL SPEC TYPE
+	ANDI	B,37777			; KILL SIGN BIT
+	MOVEI	E,-NUMSAT-1(B)		; GET REL POINTER TO TABLE
+	HRLI	E,(E)
+	ADD	E,TD.AGC+1
+	HRRZS	C,A			; FLUSH COUNT AND SAVE
+	SKIPL	E			; WITHIN BOUNDS
+	FATAL	BAD SAT IN AGC
+	SKIPL	1(A)			; SEE IF MARKED
+	JRST	GCRET			; IF MARKED LEAVE
+	IORM	D,1(A)
+
+	SKIPE	(E)
+	JRST	USRAGC
+	SUB	E,TD.AGC+1		; POINT TO LENGTH
+	ADD	E,TD.LNT+1
+	XCT	(E)			; RET # OF ELEMENTS IN B
+
+	HLRZ	D,B			; GET POSSIBLE "BASIC LENGTH" FOR RESTS
+	PUSH	P,[0]			; TEMP USED IF RESTS EXIST
+	PUSH	P,D
+	MOVEI	B,(B)			; ZAP TO ONLY LENGTH
+	PUSH	P,C			; SAVE POINTER TO TEMPLATE STRUCTURE
+	PUSH	P,B			; SAVE
+	SUB	E,TD.LNT+1
+	PUSH	P,E			; SAVE FOR FINDING OTHER TABLES
+	JUMPE	D,TD.MR2		; NO REPEATING SEQ
+	ADD	E,TD.GET+1		; COMP LNTH OF REPEATING SEQ
+	HLRE	E,(E)			; E ==> - LNTH OF TEMPLATE
+	ADDI	E,(D)			; E ==> -LENGTH OF REP SEQ
+	MOVNS	E
+	HRLM	E,-3(P)			; SAVE IT AND BASIC
+
+TD.MR2:	SKIPG	D,-1(P)			; ANY LEFT?
+	JRST	TD.MR1
+
+	MOVE	E,TD.GET+1
+	ADD	E,(P)
+	MOVE	E,(E)			; POINTER TO VECTOR IN E
+	MOVEM	D,-4(P)			; SAVE ELMENT #
+	SKIPN	B,-3(P)			; SKIP IF "RESTS" EXIST
+	SOJA	D,TD.MR3
+
+	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,-3(P)			; PLUS BASIC
+	ADDI	A,1			; AND FUDGE
+	MOVEM	A,-4(P)			; SAVE FOR PUTTER
+	ADDI	E,-1(A)			; POINT
+	SOJA	D,.+2
+
+TD.MR3:	ADDI	E,(D)			; POINT TO SLOT
+	XCT	(E)			; GET THIS ELEMENT INTO A AND B
+	JFCL				; NO-OP FOR ANY CASE
+	EXCH	A,B			; REARRANGE
+	HLRZS	B
+	MOVSI	D,400000		; RESET FOR MARK
+	PUSHJ	P,MARK			; AND MARK THIS GUY (RET FIXED POINTER IN A)
+	MOVE	C,-2(P)			; RESTORE POINTER IN CASE MUNGED
+	JRST	TD.MR2
+
+TD.MR1:	SUB	P,[5,,5]
+	JRST	GCRET
+
+USRAGC:	XCT	(E)			; MARK THE TEMPLATE
+	JRST	GCRET
+	
+
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK:	MOVEI	C,(A)			; SAVE POINTER TO GCREAD TABLE
+	HLRE	B,A			; GET TO DOPE WORD
+	SUB	A,B		
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET
+	SUBI	A,2
+	MOVE	B,ABOTN			; GET TOP OF ATOM TABLE
+	ADD	B,0			; GET BOTTOM OF ATOM TABLE
+GCRD1:	CAMG	A,B			; DON'T SKIP IF DONE
+	JRST	GCRET
+	HLRZ	C,(A)			; GET MARKING
+	TRZN	C,400000		; SKIP IF MARKED
+	JRST	GCRD3
+	MOVEI	E,(A)
+	SUBI	A,(C)			; GO BACK ONE ATOM
+	PUSH	P,B			; SAVE B
+	PUSH	P,A			; SAVE POINTER
+	MOVEI	C,-2(E)			; SET UP POINTER
+	MOVEI	B,TATOM			; GO TO MARK
+	MOVE	A,1(C)
+	PUSHJ	P,MARK
+	POP	P,A
+	POP	P,B
+	JRST	GCRD1
+GCRD3:	SUBI	A,(C)			; TO NEXT ATOM
+	JRST	GCRD1
+
+
+; ROUTINE TO FIX UP CHANNELS
+
+CHNFLS:	MOVEI	0,N.CHNS-1
+	MOVE	A,[TCHAN,,CHNL1]	; SET UP POINTER
+CHFL1:	SKIPN	B,1(A)			; GET POINTER TO CHANNEL
+	JRST	CHFL2			; NO CHANNEL LOOP TO NEXT
+	HLRE	C,B			; POINT TO DOPE WORD OF CHANNEL
+	SUBI	B,(C)
+	HLLM	A,(A)			; PUT TYPE BACK
+	SKIPL	1(B)			; SKIP IF MARKED
+	JRST	FLSCH			; FLUSH THE CHANNEL
+	MOVEI	F,1			; MARK THE CHANNEL AS GOOD
+	HRRM	F,(A)			; SMASH IT IN
+CHFL2:	ADDI	A,2
+	SOJG	0,CHFL1
+	POPJ	P,			; EXIT
+FLSCH:	HLLOS	F,(A)			; -1 INTO SLOT INDICATES LOSSAGE
+	JRST	CHFL2
+
+
+
+
+; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN:	PUSH	P,B		; SAVE TIME
+	MOVEI	B,[ASCIZ /TIME= /]
+	PUSHJ	P,MSGTYP	; PRINT OUT MESSAGE
+	POP	P,B		; RESTORE B
+	FMPRI	B,(100.0)	; CONVERT TO FIX
+	MULI	B,400
+	TSC	B,B
+	ASH	C,-163.(B)
+	MOVEI	A,1		; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+	PUSH	P,C
+	IDIVI	C,10.		; START COUNTING
+	JUMPLE	C,.+2
+	AOJA	A,.-2
+	POP	P,C
+	CAIN	A,1		; SEE IF THERE IS ONLY ONE CHARACTER
+	JRST	DOT1
+FIXOUT:	IDIVI	C,10.		; RECOVER NUMBER
+	HRLM	D,(P)
+	SKIPE	C
+	PUSHJ	P,FIXOUT
+	PUSH	P,A		; SAVE A
+	CAIN	A,2		; DECIMAL POINT HERE?
+	JRST	DOT2
+FIX1:	HLRZ	A,(P)-1		; GET NUMBER
+	ADDI	A,60		; MAKE IT A CHARACTER
+	PUSHJ	P,IMTYO		; OUT IT GOES
+	POP	P,A
+	SOJ	A,
+	POPJ	P,
+DOT1:	MOVEI	A,".		; OUTPUT DECIMAL POINT AND PADDING 0
+	PUSHJ	P,IMTYO
+	MOVEI	A,"0
+	PUSHJ	P,IMTYO
+	JRST	FIXOUT		; CONTINUE
+DOT2:	MOVEI	A,".		; OUTPUT DECIMAL POINT
+	PUSHJ	P,IMTYO
+	JRST	FIX1
+
+
+; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS.  PAIRS ARE PLACED ON THE 
+; RCL LIST, VECTORS ON THE RCLV LIST.
+
+SWEEP:	MOVE	C,GCSTOP		; GET TOP OF GC SPACE
+	SUBI	C,1			; POINT TO FIRST OBJECT
+	SETZB	E,F			; CURRENT SLOT AND CURRENT LENGTH
+LSWEEP:	CAMG	C,GCSBOT		; SKIP IF ABOVE GCSBOT
+	JRST	ESWEEP			; DONE
+	HLRE	A,-1(C)			; SEE IF LIST OR VECTOR
+	TRNE	A,UBIT			; SKIP IF LIST
+	JRST	VSWEEP			; IT IS A VECTOR
+	JUMPGE	A,LSWP1			; JUMP IF NOT MARKED
+	ANDCAM	D,-1(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS		; CONS ON CURRENT OBJECT
+	SUBI	C,2			; SKIP OVER LIST
+	JRST	LSWEEP
+LSWP1:	ADDI	F,2			; ADD TO CURRENT OBJECT COUNT
+	JUMPN	E,LSWP2			; JUMP IF CURRENT OBJECT EXISTS
+	MOVEI	E,(C)			; GET ADDRESS
+LSWP2:	SUBI	C,2
+	JRST	LSWEEP
+
+VSWEEP:	HLRE	A,(C)			; GET LENGTH
+	JUMPGE	A,VSWP1			; SKIP IF MARKED
+	ANDCAM	D,(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS
+	ANDI	A,377777		; GET LENGTH PART
+	SUBI	C,(A)			; GO PAST VECTOR
+	JRST	LSWEEP
+VSWP1:	ADDI	F,(A)			; ADD LENGTH
+	JUMPN	E,VSWP2
+	MOVEI	E,(C)			; GET NEW OBJECT LOCATION
+VSWP2:	SUBI	C,(A)			; GO BACK PAST VECTOR
+	JRST	LSWEEP
+
+ESWEEP:
+SWCONS:	JUMPE	E,CPOPJ
+	ADDM	F,TOTCNT		; HACK TOTCNT
+	CAMLE	F,MAXLEN		; SEE IF NEW MAXIMUM
+	MOVEM	F,MAXLEN
+	CAIGE	F,2			; MAKE SURE AT LEAST TWO LONG
+	FATAL	SWEEP FAILURE
+	CAIN	F,2
+	JRST	LCONS
+	SETZM	(E)
+	MOVEI	0,(E)
+	SUBI	0,-1(F)
+	SETZM	@0
+	HRLS	0
+	ADDI	0,1
+	BLT	0,-2(E)
+	HRRZ	0,RCLV			; GET VECTOR RECYCLE
+	HRRM	0,(E)			; SMASH INTO LINKING SLOT
+	HRRZM	E,RCLV			; NEW RECYCLE SLOT
+	HRLM	F,(E)
+	MOVSI	F,UBIT
+	MOVEM	F,-1(E)
+	SETZB	E,F
+	POPJ	P,			; DONE
+LCONS:	SETZM	(E)
+	SUBI	E,1
+	HRRZ	0,RCL			; GET RECYCLE LIST
+	HRRZM	0,(E)			; SMASH IN
+	HRRZM	E,RCL
+	SETZB	E,F
+	POPJ	P,
+
+
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT:	[ASCIZ /USER CALLED- /]
+	[ASCIZ /FREE STORAGE- /]
+	[ASCIZ /TP-STACK- /]
+	[ASCIZ /TOP-LEVEL LOCALS- /]
+	[ASCIZ /GLOBAL VALUES- /]
+	[ASCIZ /TYPES- /]
+	[ASCIZ /STATIONARY IMPURE STORAGE- /]
+	[ASCIZ /P-STACK /]
+	[ASCIZ /BOTH STACKS BLOWN- /]
+	[ASCIZ /PURE STORAGE- /]
+	[ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT:	SPBLOK 100
+EGCPAT:	-1
+
+MSGGFT:	[ASCIZ /GC-READ /]
+	[ASCIZ /BLOAT /]
+	[ASCIZ /GROW /]
+	[ASCIZ /LIST /]
+	[ASCIZ /VECTOR /]
+	[ASCIZ /SET /]
+	[ASCIZ /SETG /]
+	[ASCIZ /FREEZE /]
+	[ASCIZ /PURE-PAGE LOADER /]
+	[ASCIZ /GC /]
+	[ASCIZ /INTERRUPT-HANDLER /]
+	[ASCIZ /NEWTYPE /]	
+	[ASCIZ /PURIFY /]
+
+CONSTANTS
+
+HERE
+
+CONSTANTS
+
+OFFSET 0
+
+ZZ==$.+1777
+
+.LOP ANDCM ZZ 1777
+
+ZZ1==.LVAL1
+
+LOC ZZ1
+
+OFFSET OFFS
+
+MRKPDL==.-1
+
+ENDGC:
+
+OFFSET 0
+
+ZZ2==ENDGC-AGCLD
+
+.LOP <ASH @> ZZ2 <,-10.>
+SLENGC==.LVAL1
+.LOP <ASH @> SLENGC <10.>
+RSLENG==.LVAL1
+LOC GCST
+
+.LPUR=$.
+
+END

src/mudsys/amsgc.mid.108

@@ -0,0 +1,886 @@
+TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
+
+RELOCATABLE
+
+.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
+.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
+.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
+.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
+.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
+.GLOBAL RSLENG
+
+GCST=$.
+
+LOC REALGC+RLENGC
+
+OFFS=AGCLD-$.
+OFFSET OFFS
+
+.INSRT MUDDLE >
+
+TYPNT==AB
+F==PVP
+
+
+; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR.  IT IS MUCH FASTER THAN THE COPYING
+; GARBAGE COLLECTOR BUT DOESN'T COMPACT.  IT CONSES FREE THINGS ONTO RCL AND RCLV.
+; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE 
+; GARBAGE COLLECT
+
+
+; FIRST INITIALIZE VARIABLES
+
+IAMSGC:	SETZB	M,RCL			; CLEAR OUT LIST RECYCLE AND RSUBR BASE
+	SETZM	RCLV			; CLEAR VECTOR RECYCLE
+	SETZM	MAXLEN			; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
+	SETOM	GCFLG			; A GC HAS HAPPENED
+	SETZM	TOTCNT
+	HLLZS	SQUPNT			; CLEAR OUT SQUOZE TABLE
+
+; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
+
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C			; SAVE ACS
+	MOVEI	B,[ASCIZ /MSGIN / ]	; PRINT GIN IF WINNING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+	HRRZ	C,(P)			; GET CAUSE INDICATOR
+	ADDI	B,1			; AOS TO GET REAL CAUS
+	MOVEM	B,GCCAUS
+	SKIPN	GCMONF
+	JRST	NOMON2
+	MOVE	B,MSGGCT(C)		; GET CAUSE MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON2:	HLRZ	C,(P)			; FIND OUT WHO CAUSED THE GC
+	MOVEM	C,GCCALL
+	SKIPN	GCMONF			; PRINT IF GCMON IS ON
+	JRST	NOMON3
+	MOVE	B,MSGGFT(C)		; GET POINTER TO MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON3:	SUB	P,[1,,1]
+	POP	P,B			; RESTORE ACS
+	POP	P,A
+
+; MOVE ACS INTO THE PVP
+
+	EXCH	PVP,PVSTOR+1		; GET REAL PROCESS VECTOR
+
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVEM	AC,AC!STO+1(PVP)
+	TERMIN
+
+	MOVE	0,PVSTOR+1		; GET OLD VALUE OF PVP
+	MOVEM	0,PVPSTO+1(PVP)		; SAVE PVP
+	MOVE	0,DSTORE		; SAVE D'S TYPE
+	MOVEM	0,DSTO(PVP)
+	MOVEM	PVP,PVSTOR+1
+
+; SET UP TYPNT TO POINT TO TYPE VECTOR
+
+	GETYP	E,TYPVEC		; FIRST SEE IF TYPVEC IS A VECTOR
+	CAIE	E,TVEC
+	FATAL	TYPE VECTOR NOT OF TYPE VECTOR
+	HRRZ	TYPNT,TYPVEC+1
+	HRLI	TYPNT,B			; TYPNT IS NOW TYPEVECTOR(B)
+
+; NOW SET UP GCPDL AND FENCE POST PDL'S
+
+	MOVEI	A,(TB)
+	MOVE	D,P			; SAVE P POINTER
+	PUSHJ	P,FRMUNG
+	MOVE	P,[-2000,,MRKPDL]	; SET UP MARK PDL
+	MOVEI	A,(TB)			; FIXUP TOP FRAME
+	SETOM	1(TP)			; FENCEPOST TP
+	SETOM	1(D)			; FENCEPOST P
+
+; NOW SETUP AUTO CHANNEL CLOSE
+
+	MOVEI	0,N.CHNS-1		; NUMBER OF CHANNELS
+	MOVEI	A,CHNL1			; FIRST CHANNEL SLOT
+CHNCLR:	SKIPE	1(A)			; IS IT A CHANNEL
+	SETZM	(A)			; CLEAR UP TYPE SLOT
+	ADDI	A,2
+	SOJG	0,CHNCLR
+
+; NOW DO MARK AND SWEEP PHASES
+
+	MOVSI	D,400000		; MARK BIT
+	MOVEI	B,TPVP			; GET TYPE
+	MOVE	A,PVSTOR+1		; GET VALUE OF CURRENT PROCESS VECTOR
+	PUSHJ	P,MARK
+	MOVEI	B,TPVP			; GET TYPE OF MAIN PROCESS VECTOR
+	MOVE	A,MAINPR
+	PUSHJ	P,MARK			; MARK
+	PUSHJ	P,CHNFLS		; DO CHANNEL FLUSHING
+	PUSHJ	P,CHFIX
+	PUSHJ	P,STOGC			; FIX UP FROZEN WORLD
+	PUSHJ	P,SWEEP			; SWEEP WORLD
+
+; PRINT GOUT
+
+	MOVEI	B,[ASCIZ /MSGOUT /]		; PRINT OUT ENDING MESSAGE IF GCMONING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+
+; RESTORE ACS
+
+	MOVE	PVP,PVSTOR+1		; GET PVP
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVE	AC,AC!STO+1(PVP)
+	TERMIN
+
+	SKIPN	DSTORE			; CLEAR OUT TYPE IF NO TYPE THERE
+	SETZM	DSTO(PVP)
+	MOVE	PVP,PVPSTO+1(PVP)
+
+; PRINT TIME
+
+	PUSH	P,A			; SAVE ACS
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSHJ	P,CTIME			; GET CURRENT CPU TIME
+	FSBR	B,GCTIM			; COMPUTE TIME ELAPSED
+	MOVEM	B,GCTIM			; SAVE TIME AWAY
+	SKIPN	GCMONF			; PRINT IT OUT?
+	JRST	GCCONT
+	PUSHJ	P,FIXSEN
+	MOVEI	A,15			; OUTPUT CR/LF
+	PUSHJ	P,IMTYO
+	MOVEI	A,12
+	PUSHJ	P,IMTYO
+GCCONT:	POP	P,D			; RESTORE ACS
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	SETZM	GCFLG
+	SETOM	GCHAPN
+	SETOM	INTFLG
+	PUSHJ	P,RBLDM
+	JRST	FNMSGC			; DONE
+
+
+; THIS IS THE MARK PHASE
+
+; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
+; /A POINTER TO GOODIE
+; /B TYPE OF GOODIE
+; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
+
+MARK2S:
+MARK2:	HLRZ	B,(C)			; TYPE
+MARK1:	MOVE	A,1(C)			; VALUE
+MARK:	JUMPE	A,CPOPJ			; DONE IF ZERO
+	MOVEI	0,1(A)			; SEE IF PURE
+	CAML	0,PURBOT
+	JRST	CPOPJ
+	ANDI	B,TYPMSK		; FLUSH	MONITORS
+	HRLM	C,(P)
+	CAIG	B,NUMPRI		; IS A BASIC TYPE
+	JRST	@MTYTBS(B)		; TYPE DISPATCH
+	LSH	B,1			; NOW GET PRIMTYPE
+	HRRZ	B,@TYPNT		; GET PRIMTYPE
+	ANDI	B,SATMSK		; FLUSH DOWN TO SAT
+	CAIG	B,NUMSAT		; SKIP IF TEMPLATE DATA
+	JRST	@MSATBS(B)		; JUMP OFF SAT TABLE
+	JRST	TD.MK
+
+GCRET:	HLRZ	C,(P)			; GET SAVED C
+CPOPJ:	POPJ	P,
+
+; TYPE DISPATCH TABLE
+MTYTBS:
+
+OFFSET 0
+
+DUM1:
+
+IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
+[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
+[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
+[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
+[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
+[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
+[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
+[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
+[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK]
+[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
+[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
+[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
+[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
+[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
+[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
+[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
+	IRP A,B,[XX]
+		LOC DUM1+A
+		SETZ B
+		.ISTOP
+	TERMIN
+TERMIN
+
+LOC DUM1+NUMPRI+1
+
+OFFSET OFFS
+
+; SAT DISPATCH TABLE
+
+MSATBS:
+
+OFFSET 0
+
+DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
+[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+
+; ROUTINE TO MARK PAIRS
+
+PAIRMK: MOVEI	C,(A)
+PAIRM1:	CAMG	C,GCSTOP		; SEE IF IN RANGE
+	CAIGE	C,STOSTR
+	JRST	BADPTR			; FATAL ERROR
+	HLRE	B,(C)			; SKIP IF NOT MARKED
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	PUSHJ	P,MARK1			; MARK THE ITEM
+	HRRZ	C,(C)			; GET NEXT ELEMENT OF LIST
+	JUMPE	C,GCRET
+	CAML	C,PURBOT
+	JRST	GCRET
+	JRST	PAIRM1
+	
+; ROUTINE TO MARK DEFERS
+
+DEFMK:	HLRE	B,(A)
+	JUMPL	B,GCRET
+	MOVEI	C,(A)
+	IORM	D,(C)
+	PUSHJ	P,MARK1
+	JRST	GCRET
+
+; ROUTINE TO MARK POSSIBLE DEFERS DEF?
+
+DEFQMK:	GETYP	B,(A)			; GET THE TYPE OF THE OBJECT
+	LSH	B,1			; COMPUTE THE SAT
+	HRRZ	B,@TYPNT
+	ANDI	B,SATMSK
+	SKIPL	MKTBS(B)		; SKIP IF NOT DEFERED
+	JRST	PAIRMK
+	JRST	DEFMK			; GO TO DEFMK
+
+
+; ROUTINE TO MARK VECTORS
+
+VECMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B
+	MOVEI	C,1(A)			; POINT TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	B,(C)
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(B)			; GET TO BEGINNING
+VECMK1:	HLRE	B,(C)			; GET TYPE AND SKIP IF NOT DOPE WORD
+	JUMPL	B,GCRET			; DONE
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; NEXT ELEMENT
+	JRST	VECMK1
+
+; ROUTINE TO MARK UVECTORS
+
+UVMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,1(A)			; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	F,(C)			; GET LENGTH
+	JUMPL	F,GCRET
+	IORM	D,(C)			; MARK IT
+	GETYP	B,-1(C)			; GET TYPE
+	MOVEI	E,(B)			; COPY TYPE FOR SAT COMPUTATION
+	LSH	B,1
+	HRRZ	B,@TYPNT		; GET SAT
+	ANDI	B,SATMSK
+	MOVEI	B,@MSATBS(B)		; GET JUMP LOCATION
+	CAIN	B,GCRET
+	JRST	GCRET
+	SUBI	C,(F)			; POINT TO BEGINNING OF UVECTOR
+	SUBI	F,2
+	JUMPE	F,GCRET
+	PUSH	P,F			; SAVE LENGTH
+	PUSH	P,E
+UNLOOP:	MOVE	B,(P)
+	MOVE	A,1(C)			; GET VALUE POINTER
+	PUSHJ	P,MARK
+	SOSE	-1(P)			; SKIP IF NON-ZERO
+	AOJA	C,UNLOOP		; GO BACK AGAIN
+	SUB	P,[2,,2]		; CLEAN OFF STACK
+	JRST	GCRET
+
+; ROUTINE TO INDICATE A BAD POINTER
+
+BADPTR:	FATAL	POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
+	JRST	GCRET
+
+
+; ROUTINE TO MARK A TPSTACK
+
+TPMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	A,(C)
+	JUMPL	A,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(A)			; GO TO BEGINNING
+
+TPLP:	HLRE	B,(C)			; GET TYPE AND MARKING
+	JUMPL	B,GCRET			; EXIT ON FENCE-POST
+	ANDI	B,TYPMSK		; FLUSH MONITORS
+	CAIE	B,TCBLK			; CHECK FOR FRAME
+	CAIN	B,TENTRY
+	JRST	MFRAME			; MARK THE FRAME
+	CAIE	B,TUBIND		; BINDING BLOCK
+	CAIN	B,TBIND
+	JRST	MBIND
+	PUSHJ	P,MARK1			; NOTHING SPECIAL SO MARK IT
+	ADDI	C,2			; POINT TO NEXT OBJECT
+	JRST	TPLP			; MARK IT
+
+; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
+
+MFRAME:	HRROI	C,FRAMLN+FSAV-1(C)	; POINT TO FUNCTION
+	HRRZ	A,1(C)			; GET POINTER
+	CAIL	A,STOSTR		; SEE IF IN GC SPACE
+	CAMLE	A,GCSTOP
+	JRST	MFRAM1			; SKIP OVER IT, NOT IN GC-SPACE
+	HRL	A,(A)			; GET LENGTH
+	MOVEI	B,TVEC			; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
+	PUSHJ	P,MARK
+MFRAM1:	MOVE	A,PSAV-FSAV+1(C)	; MARK THE PSTACK
+	MOVEI	B,TPDL
+	PUSHJ	P,MARK
+	HRROI	C,-FSAV+1(C)		; POINT PAST FRAME
+	JRST	TPLP			; GO BACK TO START OF LOOP
+
+; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
+
+MBIND:	MOVEI	B,TATOM			; START BY MARKING THE ATOM
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; POINT TO VALUE SLOT
+	PUSHJ	P,MARK2			; MARK THE VALUE
+	ADDI	C,2			; POINT TO DECL AND PREV BINDING
+	MOVEI	B,TLIST			; MARK DECL
+	HLRZ	A,(C)
+	PUSHJ	P,MARK
+	SKIPL	A,1(C)			; SKIP IF PREVIOUS BINDING
+	JRST	NOTLCI
+	MOVEI	B,TLOCI			; GET TYPE
+	PUSHJ	P,MARK
+NOTLCI:	ADDI	C,2			; POINT PAST BINDING
+	JRST	TPLP
+
+
+PMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	IORM	D,(C)			; MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK TB POINTER
+
+TBMK:	HRRZS	A			; CHECK FOR NIL POINTER
+	SKIPN	A
+	JRST	GCRET
+	MOVE	A,TPSAV(A)		; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK AB POINTERS
+
+ABMK:	HLRE	B,A			; GET TO FRAME
+	SUB	A,B
+	MOVE	A,FRAMLN+TPSAV(A)	; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK FRAME POINTERS
+
+FRMK:	HRLZ	B,A			; GET THE TIME
+	HLRZ	F,OTBSAV(A)		; GET TIME FROM FRAME
+	CAIE	B,(F)			; SKIP IF TIMES AGREE
+	JRST	GCRET			; IGNORE POINTER IF THEY DONT
+	HRRZ	A,(C)			; GET POINTER TO PROCESS
+	SUBI	A,1			; FUDGE FOR VECTOR MARKING
+	MOVEI	B,TPVP			; TYPE WORD
+	PUSHJ	P,MARK
+	HRRZ	A,1(C)			; GET POINTER TO FRAME
+	JRST	TBMK			; MARK IT
+
+; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
+
+ARGMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; POINT PAST BLOCK
+	CAIL	A,STOSTR
+	CAMLE	A,GCSTOP		; SEE IF IN GCSPACE
+	JRST	GCRET
+	HRLZ	0,(A)			; GET TYPE
+	ANDI	0,TYPMSK		; FLUSH MONITORS
+	CAIE	0,TENTRY
+	CAIN	0,TCBLK
+	JRST	ARGMK1			; AT FRAME
+	CAIE	0,TINFO			; AT FRAME
+	JRST	GCRET			; NOT A LEGAL TYPE GO AWAY
+	HRRZ	A,1(A)			; POINTING TO FRAME
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+ARGMK1:	HRRI	A,FRAMLN(A)		; MAKE POINTER
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+
+
+; ROUTINE TO MARK GLOBAL SLOTS
+
+GATOMK:	HRRZ	B,(C)			; GET POSSIBLE GDECL
+	JUMPE	B,ATOMK			; NONE GO TO MARK ATOM
+	CAIN	B,-1			; SKIP IF NOT MANIFEST
+	JRST	ATOMK
+	PUSH	P,A			; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
+	MOVEI	C,(A)
+	MOVEI	A,(B)
+	MOVEI	B,TLIST			; TYPE WORD LIST
+	PUSHJ	P,MARK			; MARK IT
+	POP	P,A
+	JRST	ATOMK5
+
+ATOMK:
+ATOMK5:	HLRE	B,A
+	SUB	A,B			; A POINTS TO DOPE WORD
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET			; EXIT IF MARKED
+	HLRZ	B,1(A)
+	SUBI	B,3
+	HRLI	B,1(B)
+	MOVEI	C,-1(A)
+	SUB	C,B			; IN CASE WAS DW
+	IORM	D,1(A)			; MARK IT
+	HRRZ	A,2(C)			; MARK OBLIST
+	CAMG	A,VECBOT
+	JRST	NOOBL			; NO IMPURE OBLIST
+	HRLI	A,-1
+	MOVEI	B,TOBLS			; MARK THE OBLIST
+	PUSHJ	P,MARK
+NOOBL:	HLRZ	A,2(C)			; GET NEXT ATOM
+	MOVEI	B,TATOM
+	PUSHJ	P,MARK
+      	HLRZ	B,(C)			; GET VALUE SLOT
+	TRZ	B,400000		; TURN OFF MARK BIT
+	SKIPE	B			; SEE IF 0
+	CAIN	B,TUNBOUN		; SEE IF UNBOUND
+	JRST	GCRET
+	HRRZ	0,(C)			; SEE IF VECTOR OR TP POINTER
+	MOVEI	B,TVEC			; ASSUME VECTOR
+	SKIPE	0			; SKIP IF VECTOR
+	MOVEI	B,TTP			; IT IS A TP POINTER
+	PUSHJ	P,MARK1			; GO MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK BYTE AND STRING POINTERS
+
+BYTMK:	PUSHJ	P,BYTDOP		; GET TO DOPE WORD INTO A
+	HRLZ	F,-1(A)			; SEE IF SPECIAL ATOM [SPNAME]
+	ANDI	F,SATMSK		; GET SAT
+	CAIN	F,SATOM
+	JRST	ATMSET			; IT IS AN ATOM
+	IORM	D,(A)			; MARK IT
+	JRST	GCRET
+
+ATMSET:	HLRZ	B,(A)			; GET LENGTH
+	TRZ	B,400000		; TURN OFF POSSIBLE MARK BIT
+	MOVNI	B,-2(B)			; GENERATE AOBJN POINTER
+	ADDI	A,-1(B)			; GET BACK TO BEGINNING
+	HRLI	A,(B)			; PUT IN LEFT HALF
+	MOVEI	B,TATOM			; MARK AS AN ATOM
+	PUSHJ	P,MARK			; GO MARK
+	JRST	GCRET
+
+; MARK LOCID GOODIES
+
+LOCMK:	HRRZ	B,(C)			; CHECK FOR TIME
+	JUMPE	B,LOCMK1		; SKIP LEGAL CHECK FOR GLOBAL
+	HRRZ	0,2(A)			; GET OTHER TIME
+	CAIE	0,(B)			; SAME?
+	JRST	GCRET
+	MOVEI	B,TTP
+	PUSHJ	P,MARK1
+	JRST	GCRET
+LOCMK1:	MOVEI	B,TVEC			; GLOBAL
+	PUSHJ	P,MARK1			; MARK VALUE
+	JRST	GCRET
+
+; MARK ASSOCIATION BLOCK
+
+ASMK:	MOVEI	C,(A)			; SAVE POINTER TO BEGINNING OF ASSOCATION
+	ADDI	A,ASOLNT		; POINT TO DOPE WORD
+	HLRE	B,1(A)			; GET SECOND D.W.
+	JUMPL	B,GCRET			; MARKED SO LEAVE
+	IORM	D,1(A)			; MARK ASSOCATION
+	PUSHJ	P,MARK2			; MARK ITEM
+	MOVEI	C,INDIC(C)
+	PUSHJ	P,MARK2
+	MOVEI	C,VAL-INDIC(C)
+	PUSHJ	P,MARK2
+	HRRZ	A,NODPNT-VAL(C)		; GET NEXT IN CHAIN
+	JUMPN	A,ASMK			; GO MARK IT
+	JRST	GCRET
+
+; MARK OFFSETS
+
+OFFSMK:	PUSH	P,$TLIST
+	HLRZ	0,1(C)			; PICK UP LIST POINTER
+	PUSH	P,0
+	MOVEI	C,-1(P)
+	PUSHJ	P,MARK2			; MARK THE LIST
+	SUB	P,[2,,2]
+	JRST	GCRET			; AND RETURN
+
+; HERE TO MARK TEMPLATE DATA STRUCTURES
+
+TD.MK:	HLRZ	B,(A)			; GET REAL SPEC TYPE
+	ANDI	B,37777			; KILL SIGN BIT
+	MOVEI	E,-NUMSAT-1(B)		; GET REL POINTER TO TABLE
+	HRLI	E,(E)
+	ADD	E,TD.AGC+1
+	HRRZS	C,A			; FLUSH COUNT AND SAVE
+	SKIPL	E			; WITHIN BOUNDS
+	FATAL	BAD SAT IN AGC
+	SKIPL	1(A)			; SEE IF MARKED
+	JRST	GCRET			; IF MARKED LEAVE
+	IORM	D,1(A)
+
+	SKIPE	(E)
+	JRST	USRAGC
+	SUB	E,TD.AGC+1		; POINT TO LENGTH
+	ADD	E,TD.LNT+1
+	XCT	(E)			; RET # OF ELEMENTS IN B
+
+	HLRZ	D,B			; GET POSSIBLE "BASIC LENGTH" FOR RESTS
+	PUSH	P,[0]			; TEMP USED IF RESTS EXIST
+	PUSH	P,D
+	MOVEI	B,(B)			; ZAP TO ONLY LENGTH
+	PUSH	P,C			; SAVE POINTER TO TEMPLATE STRUCTURE
+	PUSH	P,B			; SAVE
+	SUB	E,TD.LNT+1
+	PUSH	P,E			; SAVE FOR FINDING OTHER TABLES
+	JUMPE	D,TD.MR2		; NO REPEATING SEQ
+	ADD	E,TD.GET+1		; COMP LNTH OF REPEATING SEQ
+	HLRE	E,(E)			; E ==> - LNTH OF TEMPLATE
+	ADDI	E,(D)			; E ==> -LENGTH OF REP SEQ
+	MOVNS	E
+	HRLM	E,-3(P)			; SAVE IT AND BASIC
+
+TD.MR2:	SKIPG	D,-1(P)			; ANY LEFT?
+	JRST	TD.MR1
+
+	MOVE	E,TD.GET+1
+	ADD	E,(P)
+	MOVE	E,(E)			; POINTER TO VECTOR IN E
+	MOVEM	D,-4(P)			; SAVE ELMENT #
+	SKIPN	B,-3(P)			; SKIP IF "RESTS" EXIST
+	SOJA	D,TD.MR3
+
+	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,-3(P)			; PLUS BASIC
+	ADDI	A,1			; AND FUDGE
+	MOVEM	A,-4(P)			; SAVE FOR PUTTER
+	ADDI	E,-1(A)			; POINT
+	SOJA	D,.+2
+
+TD.MR3:	ADDI	E,(D)			; POINT TO SLOT
+	XCT	(E)			; GET THIS ELEMENT INTO A AND B
+	JFCL				; NO-OP FOR ANY CASE
+	EXCH	A,B			; REARRANGE
+	HLRZS	B
+	MOVSI	D,400000		; RESET FOR MARK
+	PUSHJ	P,MARK			; AND MARK THIS GUY (RET FIXED POINTER IN A)
+	MOVE	C,-2(P)			; RESTORE POINTER IN CASE MUNGED
+	JRST	TD.MR2
+
+TD.MR1:	SUB	P,[5,,5]
+	JRST	GCRET
+
+USRAGC:	XCT	(E)			; MARK THE TEMPLATE
+	JRST	GCRET
+	
+
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK:	MOVEI	C,(A)			; SAVE POINTER TO GCREAD TABLE
+	HLRE	B,A			; GET TO DOPE WORD
+	SUB	A,B		
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET
+	SUBI	A,2
+	MOVE	B,ABOTN			; GET TOP OF ATOM TABLE
+	ADD	B,0			; GET BOTTOM OF ATOM TABLE
+GCRD1:	CAMG	A,B			; DON'T SKIP IF DONE
+	JRST	GCRET
+	HLRZ	C,(A)			; GET MARKING
+	TRZN	C,400000		; SKIP IF MARKED
+	JRST	GCRD3
+	MOVEI	E,(A)
+	SUBI	A,(C)			; GO BACK ONE ATOM
+	PUSH	P,B			; SAVE B
+	PUSH	P,A			; SAVE POINTER
+	MOVEI	C,-2(E)			; SET UP POINTER
+	MOVEI	B,TATOM			; GO TO MARK
+	MOVE	A,1(C)
+	PUSHJ	P,MARK
+	POP	P,A
+	POP	P,B
+	JRST	GCRD1
+GCRD3:	SUBI	A,(C)			; TO NEXT ATOM
+	JRST	GCRD1
+
+
+; ROUTINE TO FIX UP CHANNELS
+
+CHNFLS:	MOVEI	0,N.CHNS-1
+	MOVEI	A,,CHNL1		; SET UP POINTER
+CHFL1:	SKIPN	B,1(A)			; GET POINTER TO CHANNEL
+	JRST	CHFL2			; NO CHANNEL LOOP TO NEXT
+	HLRE	C,B			; POINT TO DOPE WORD OF CHANNEL
+	SUBI	B,(C)
+	MOVEI	F,TCHAN
+	HRLM	F,(A)			; PUT TYPE BACK
+	SKIPL	1(B)			; SKIP IF MARKED
+	JRST	FLSCH			; FLUSH THE CHANNEL
+	MOVEI	F,1			; MARK THE CHANNEL AS GOOD
+	HRRM	F,(A)			; SMASH IT IN
+CHFL2:	ADDI	A,2
+	SOJG	0,CHFL1
+	POPJ	P,			; EXIT
+FLSCH:	HLLOS	F,(A)			; -1 INTO SLOT INDICATES LOSSAGE
+	JRST	CHFL2
+
+
+; THIS ROUTINE MARKS ALL THE CHANNELS
+
+CHFIX:	MOVEI	0,N.CHNS-1
+	MOVEI	A,CHNL1		; SLOTS
+
+DHNFL2:	SKIPN	1(A)
+	JRST	DHNFL1
+	PUSH	P,0		; SAVE 0
+	PUSH	P,A		; SAVE A
+	MOVEI	C,(A)
+	MOVE	A,1(A)
+	MOVEI	B,TCHAN
+	PUSHJ	P,MARK
+	POP	P,A		; RESTORE A
+	POP	P,0		; RESTORE
+DHNFL1:	ADDI	A,2
+	SOJG	0,DHNFL2
+	POPJ	P,
+
+
+
+; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN:	PUSH	P,B		; SAVE TIME
+	MOVEI	B,[ASCIZ /TIME= /]
+	PUSHJ	P,MSGTYP	; PRINT OUT MESSAGE
+	POP	P,B		; RESTORE B
+	FMPRI	B,(100.0)	; CONVERT TO FIX
+	MULI	B,400
+	TSC	B,B
+	ASH	C,-163.(B)
+	MOVEI	A,1		; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+	PUSH	P,C
+	IDIVI	C,10.		; START COUNTING
+	JUMPLE	C,.+2
+	AOJA	A,.-2
+	POP	P,C
+	CAIN	A,1		; SEE IF THERE IS ONLY ONE CHARACTER
+	JRST	DOT1
+FIXOUT:	IDIVI	C,10.		; RECOVER NUMBER
+	HRLM	D,(P)
+	SKIPE	C
+	PUSHJ	P,FIXOUT
+	PUSH	P,A		; SAVE A
+	CAIN	A,2		; DECIMAL POINT HERE?
+	JRST	DOT2
+FIX1:	HLRZ	A,(P)-1		; GET NUMBER
+	ADDI	A,60		; MAKE IT A CHARACTER
+	PUSHJ	P,IMTYO		; OUT IT GOES
+	POP	P,A
+	SOJ	A,
+	POPJ	P,
+DOT1:	MOVEI	A,".		; OUTPUT DECIMAL POINT AND PADDING 0
+	PUSHJ	P,IMTYO
+	MOVEI	A,"0
+	PUSHJ	P,IMTYO
+	JRST	FIXOUT		; CONTINUE
+DOT2:	MOVEI	A,".		; OUTPUT DECIMAL POINT
+	PUSHJ	P,IMTYO
+	JRST	FIX1
+
+
+; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS.  PAIRS ARE PLACED ON THE 
+; RCL LIST, VECTORS ON THE RCLV LIST.
+
+SWEEP:	MOVE	C,GCSTOP		; GET TOP OF GC SPACE
+	SUBI	C,1			; POINT TO FIRST OBJECT
+	SETZB	E,F			; CURRENT SLOT AND CURRENT LENGTH
+LSWEEP:	CAMG	C,GCSBOT		; SKIP IF ABOVE GCSBOT
+	JRST	ESWEEP			; DONE
+	HLRE	A,-1(C)			; SEE IF LIST OR VECTOR
+	TRNE	A,UBIT			; SKIP IF LIST
+	JRST	VSWEEP			; IT IS A VECTOR
+	JUMPGE	A,LSWP1			; JUMP IF NOT MARKED
+	ANDCAM	D,-1(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS		; CONS ON CURRENT OBJECT
+	SUBI	C,2			; SKIP OVER LIST
+	JRST	LSWEEP
+LSWP1:	ADDI	F,2			; ADD TO CURRENT OBJECT COUNT
+	JUMPN	E,LSWP2			; JUMP IF CURRENT OBJECT EXISTS
+	MOVEI	E,(C)			; GET ADDRESS
+LSWP2:	SUBI	C,2
+	JRST	LSWEEP
+
+VSWEEP:	HLRE	A,(C)			; GET LENGTH
+	JUMPGE	A,VSWP1			; SKIP IF MARKED
+	ANDCAM	D,(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS
+	ANDI	A,377777		; GET LENGTH PART
+	SUBI	C,(A)			; GO PAST VECTOR
+	JRST	LSWEEP
+VSWP1:	ADDI	F,(A)			; ADD LENGTH
+	JUMPN	E,VSWP2
+	MOVEI	E,(C)			; GET NEW OBJECT LOCATION
+VSWP2:	SUBI	C,(A)			; GO BACK PAST VECTOR
+	JRST	LSWEEP
+
+ESWEEP:
+SWCONS:	JUMPE	E,CPOPJ
+	ADDM	F,TOTCNT		; HACK TOTCNT
+	CAMLE	F,MAXLEN		; SEE IF NEW MAXIMUM
+	MOVEM	F,MAXLEN
+	CAIGE	F,2			; MAKE SURE AT LEAST TWO LONG
+	FATAL	SWEEP FAILURE
+	CAIN	F,2
+	JRST	LCONS
+	SETZM	(E)
+	MOVEI	0,(E)
+	SUBI	0,-1(F)
+	SETZM	@0
+	HRLS	0
+	ADDI	0,1
+	BLT	0,-2(E)
+	HRRZ	0,RCLV			; GET VECTOR RECYCLE
+	HRRM	0,(E)			; SMASH INTO LINKING SLOT
+	HRRZM	E,RCLV			; NEW RECYCLE SLOT
+	HRLM	F,(E)
+	MOVSI	F,UBIT
+	MOVEM	F,-1(E)
+	SETZB	E,F
+	POPJ	P,			; DONE
+LCONS:	SETZM	(E)
+	SUBI	E,1
+	HRRZ	0,RCL			; GET RECYCLE LIST
+	HRRZM	0,(E)			; SMASH IN
+	HRRZM	E,RCL
+	SETZB	E,F
+	POPJ	P,
+
+
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT:	[ASCIZ /USER CALLED- /]
+	[ASCIZ /FREE STORAGE- /]
+	[ASCIZ /TP-STACK- /]
+	[ASCIZ /TOP-LEVEL LOCALS- /]
+	[ASCIZ /GLOBAL VALUES- /]
+	[ASCIZ /TYPES- /]
+	[ASCIZ /STATIONARY IMPURE STORAGE- /]
+	[ASCIZ /P-STACK /]
+	[ASCIZ /BOTH STACKS BLOWN- /]
+	[ASCIZ /PURE STORAGE- /]
+	[ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT:	SPBLOK 100
+EGCPAT:	-1
+
+MSGGFT:	[ASCIZ /GC-READ /]
+	[ASCIZ /BLOAT /]
+	[ASCIZ /GROW /]
+	[ASCIZ /LIST /]
+	[ASCIZ /VECTOR /]
+	[ASCIZ /SET /]
+	[ASCIZ /SETG /]
+	[ASCIZ /FREEZE /]
+	[ASCIZ /PURE-PAGE LOADER /]
+	[ASCIZ /GC /]
+	[ASCIZ /INTERRUPT-HANDLER /]
+	[ASCIZ /NEWTYPE /]	
+	[ASCIZ /PURIFY /]
+
+CONSTANTS
+
+HERE
+
+CONSTANTS
+
+OFFSET 0
+
+ZZ==$.+1777
+
+.LOP ANDCM ZZ 1777
+
+ZZ1==.LVAL1
+
+LOC ZZ1
+
+OFFSET OFFS
+
+MRKPDL==.-1
+
+ENDGC:
+
+OFFSET 0
+
+ZZ2==ENDGC-AGCLD
+
+.LOP <ASH @> ZZ2 <,-10.>
+SLENGC==.LVAL1
+.LOP <ASH @> SLENGC <10.>
+RSLENG==.LVAL1
+LOC GCST
+
+.LPUR=$.
+
+END

src/mudsys/amsgc.mid.109

@@ -0,0 +1,886 @@
+TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
+
+RELOCATABLE
+
+.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
+.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
+.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
+.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
+.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
+.GLOBAL RSLENG
+
+GCST=$.
+
+LOC REALGC+RLENGC
+
+OFFS=AGCLD-$.
+OFFSET OFFS
+
+.INSRT MUDDLE >
+
+TYPNT==AB
+F==PVP
+
+
+; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR.  IT IS MUCH FASTER THAN THE COPYING
+; GARBAGE COLLECTOR BUT DOESN'T COMPACT.  IT CONSES FREE THINGS ONTO RCL AND RCLV.
+; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE 
+; GARBAGE COLLECT
+
+
+; FIRST INITIALIZE VARIABLES
+
+IAMSGC:	SETZB	M,RCL			; CLEAR OUT LIST RECYCLE AND RSUBR BASE
+	SETZM	RCLV			; CLEAR VECTOR RECYCLE
+	SETZM	MAXLEN			; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
+	SETOM	GCFLG			; A GC HAS HAPPENED
+	SETZM	TOTCNT
+	HLLZS	SQUPNT			; CLEAR OUT SQUOZE TABLE
+
+; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
+
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C			; SAVE ACS
+	MOVEI	B,[ASCIZ /MSGIN / ]	; PRINT GIN IF WINNING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+	HRRZ	C,(P)			; GET CAUSE INDICATOR
+	ADDI	B,1			; AOS TO GET REAL CAUS
+	MOVEM	B,GCCAUS
+	SKIPN	GCMONF
+	JRST	NOMON2
+	MOVE	B,MSGGCT(C)		; GET CAUSE MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON2:	HLRZ	C,(P)			; FIND OUT WHO CAUSED THE GC
+	MOVEM	C,GCCALL
+	SKIPN	GCMONF			; PRINT IF GCMON IS ON
+	JRST	NOMON3
+	MOVE	B,MSGGFT(C)		; GET POINTER TO MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON3:	SUB	P,[1,,1]
+	POP	P,B			; RESTORE ACS
+	POP	P,A
+
+; MOVE ACS INTO THE PVP
+
+	EXCH	PVP,PVSTOR+1		; GET REAL PROCESS VECTOR
+
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVEM	AC,AC!STO+1(PVP)
+	TERMIN
+
+	MOVE	0,PVSTOR+1		; GET OLD VALUE OF PVP
+	MOVEM	0,PVPSTO+1(PVP)		; SAVE PVP
+	MOVE	0,DSTORE		; SAVE D'S TYPE
+	MOVEM	0,DSTO(PVP)
+	MOVEM	PVP,PVSTOR+1
+
+; SET UP TYPNT TO POINT TO TYPE VECTOR
+
+	GETYP	E,TYPVEC		; FIRST SEE IF TYPVEC IS A VECTOR
+	CAIE	E,TVEC
+	FATAL	TYPE VECTOR NOT OF TYPE VECTOR
+	HRRZ	TYPNT,TYPVEC+1
+	HRLI	TYPNT,B			; TYPNT IS NOW TYPEVECTOR(B)
+
+; NOW SET UP GCPDL AND FENCE POST PDL'S
+
+	MOVEI	A,(TB)
+	MOVE	D,P			; SAVE P POINTER
+	PUSHJ	P,FRMUNG
+	MOVE	P,[-2000,,MRKPDL]	; SET UP MARK PDL
+	MOVEI	A,(TB)			; FIXUP TOP FRAME
+	SETOM	1(TP)			; FENCEPOST TP
+	SETOM	1(D)			; FENCEPOST P
+
+; NOW SETUP AUTO CHANNEL CLOSE
+
+	MOVEI	0,N.CHNS-1		; NUMBER OF CHANNELS
+	MOVEI	A,CHNL1			; FIRST CHANNEL SLOT
+CHNCLR:	SKIPE	1(A)			; IS IT A CHANNEL
+	SETZM	(A)			; CLEAR UP TYPE SLOT
+	ADDI	A,2
+	SOJG	0,CHNCLR
+
+; NOW DO MARK AND SWEEP PHASES
+
+	MOVSI	D,400000		; MARK BIT
+	MOVEI	B,TPVP			; GET TYPE
+	MOVE	A,PVSTOR+1		; GET VALUE OF CURRENT PROCESS VECTOR
+	PUSHJ	P,MARK
+	MOVEI	B,TPVP			; GET TYPE OF MAIN PROCESS VECTOR
+	MOVE	A,MAINPR
+	PUSHJ	P,MARK			; MARK
+	PUSHJ	P,CHNFLS		; DO CHANNEL FLUSHING
+	PUSHJ	P,CHFIX
+	PUSHJ	P,STOGC			; FIX UP FROZEN WORLD
+	PUSHJ	P,SWEEP			; SWEEP WORLD
+
+; PRINT GOUT
+
+	MOVEI	B,[ASCIZ /MSGOUT /]		; PRINT OUT ENDING MESSAGE IF GCMONING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+
+; RESTORE ACS
+
+	MOVE	PVP,PVSTOR+1		; GET PVP
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVE	AC,AC!STO+1(PVP)
+	TERMIN
+
+	SKIPN	DSTORE			; CLEAR OUT TYPE IF NO TYPE THERE
+	SETZM	DSTO(PVP)
+	MOVE	PVP,PVPSTO+1(PVP)
+
+; PRINT TIME
+
+	PUSH	P,A			; SAVE ACS
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSHJ	P,CTIME			; GET CURRENT CPU TIME
+	FSBR	B,GCTIM			; COMPUTE TIME ELAPSED
+	MOVEM	B,GCTIM			; SAVE TIME AWAY
+	SKIPN	GCMONF			; PRINT IT OUT?
+	JRST	GCCONT
+	PUSHJ	P,FIXSEN
+	MOVEI	A,15			; OUTPUT CR/LF
+	PUSHJ	P,IMTYO
+	MOVEI	A,12
+	PUSHJ	P,IMTYO
+GCCONT:	POP	P,D			; RESTORE ACS
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	SETZM	GCFLG
+	SETOM	GCHAPN
+	SETOM	INTFLG
+	PUSHJ	P,RBLDM
+	JRST	FNMSGC			; DONE
+
+
+; THIS IS THE MARK PHASE
+
+; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
+; /A POINTER TO GOODIE
+; /B TYPE OF GOODIE
+; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
+
+MARK2S:
+MARK2:	HLRZ	B,(C)			; TYPE
+MARK1:	MOVE	A,1(C)			; VALUE
+MARK:	JUMPE	A,CPOPJ			; DONE IF ZERO
+	MOVEI	0,1(A)			; SEE IF PURE
+	CAML	0,PURBOT
+	JRST	CPOPJ
+	ANDI	B,TYPMSK		; FLUSH	MONITORS
+	HRLM	C,(P)
+	CAIG	B,NUMPRI		; IS A BASIC TYPE
+	JRST	@MTYTBS(B)		; TYPE DISPATCH
+	LSH	B,1			; NOW GET PRIMTYPE
+	HRRZ	B,@TYPNT		; GET PRIMTYPE
+	ANDI	B,SATMSK		; FLUSH DOWN TO SAT
+	CAIG	B,NUMSAT		; SKIP IF TEMPLATE DATA
+	JRST	@MSATBS(B)		; JUMP OFF SAT TABLE
+	JRST	TD.MK
+
+GCRET:	HLRZ	C,(P)			; GET SAVED C
+CPOPJ:	POPJ	P,
+
+; TYPE DISPATCH TABLE
+MTYTBS:
+
+OFFSET 0
+
+DUM1:
+
+IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
+[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
+[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
+[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
+[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
+[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
+[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
+[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
+[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK]
+[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
+[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
+[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
+[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
+[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
+[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
+[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
+	IRP A,B,[XX]
+		LOC DUM1+A
+		SETZ B
+		.ISTOP
+	TERMIN
+TERMIN
+
+LOC DUM1+NUMPRI+1
+
+OFFSET OFFS
+
+; SAT DISPATCH TABLE
+
+MSATBS:
+
+OFFSET 0
+
+DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
+[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+
+; ROUTINE TO MARK PAIRS
+
+PAIRMK: MOVEI	C,(A)
+PAIRM1:	CAMG	C,GCSTOP		; SEE IF IN RANGE
+	CAIGE	C,STOSTR
+	JRST	BADPTR			; FATAL ERROR
+	HLRE	B,(C)			; SKIP IF NOT MARKED
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	PUSHJ	P,MARK1			; MARK THE ITEM
+	HRRZ	C,(C)			; GET NEXT ELEMENT OF LIST
+	JUMPE	C,GCRET
+	CAML	C,PURBOT
+	JRST	GCRET
+	JRST	PAIRM1
+	
+; ROUTINE TO MARK DEFERS
+
+DEFMK:	HLRE	B,(A)
+	JUMPL	B,GCRET
+	MOVEI	C,(A)
+	IORM	D,(C)
+	PUSHJ	P,MARK1
+	JRST	GCRET
+
+; ROUTINE TO MARK POSSIBLE DEFERS DEF?
+
+DEFQMK:	GETYP	B,(A)			; GET THE TYPE OF THE OBJECT
+	LSH	B,1			; COMPUTE THE SAT
+	HRRZ	B,@TYPNT
+	ANDI	B,SATMSK
+	SKIPL	MKTBS(B)		; SKIP IF NOT DEFERED
+	JRST	PAIRMK
+	JRST	DEFMK			; GO TO DEFMK
+
+
+; ROUTINE TO MARK VECTORS
+
+VECMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B
+	MOVEI	C,1(A)			; POINT TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	B,(C)
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(B)			; GET TO BEGINNING
+VECMK1:	HLRE	B,(C)			; GET TYPE AND SKIP IF NOT DOPE WORD
+	JUMPL	B,GCRET			; DONE
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; NEXT ELEMENT
+	JRST	VECMK1
+
+; ROUTINE TO MARK UVECTORS
+
+UVMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,1(A)			; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	F,(C)			; GET LENGTH
+	JUMPL	F,GCRET
+	IORM	D,(C)			; MARK IT
+	GETYP	B,-1(C)			; GET TYPE
+	MOVEI	E,(B)			; COPY TYPE FOR SAT COMPUTATION
+	LSH	B,1
+	HRRZ	B,@TYPNT		; GET SAT
+	ANDI	B,SATMSK
+	MOVEI	B,@MSATBS(B)		; GET JUMP LOCATION
+	CAIN	B,GCRET
+	JRST	GCRET
+	SUBI	C,(F)			; POINT TO BEGINNING OF UVECTOR
+	SUBI	F,2
+	JUMPE	F,GCRET
+	PUSH	P,F			; SAVE LENGTH
+	PUSH	P,E
+UNLOOP:	MOVE	B,(P)
+	MOVE	A,1(C)			; GET VALUE POINTER
+	PUSHJ	P,MARK
+	SOSE	-1(P)			; SKIP IF NON-ZERO
+	AOJA	C,UNLOOP		; GO BACK AGAIN
+	SUB	P,[2,,2]		; CLEAN OFF STACK
+	JRST	GCRET
+
+; ROUTINE TO INDICATE A BAD POINTER
+
+BADPTR:	FATAL	POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
+	JRST	GCRET
+
+
+; ROUTINE TO MARK A TPSTACK
+
+TPMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	A,(C)
+	JUMPL	A,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(A)			; GO TO BEGINNING
+
+TPLP:	HLRE	B,(C)			; GET TYPE AND MARKING
+	JUMPL	B,GCRET			; EXIT ON FENCE-POST
+	ANDI	B,TYPMSK		; FLUSH MONITORS
+	CAIE	B,TCBLK			; CHECK FOR FRAME
+	CAIN	B,TENTRY
+	JRST	MFRAME			; MARK THE FRAME
+	CAIE	B,TUBIND		; BINDING BLOCK
+	CAIN	B,TBIND
+	JRST	MBIND
+	PUSHJ	P,MARK1			; NOTHING SPECIAL SO MARK IT
+	ADDI	C,2			; POINT TO NEXT OBJECT
+	JRST	TPLP			; MARK IT
+
+; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
+
+MFRAME:	HRROI	C,FRAMLN+FSAV-1(C)	; POINT TO FUNCTION
+	HRRZ	A,1(C)			; GET POINTER
+	CAIL	A,STOSTR		; SEE IF IN GC SPACE
+	CAMLE	A,GCSTOP
+	JRST	MFRAM1			; SKIP OVER IT, NOT IN GC-SPACE
+	HRL	A,(A)			; GET LENGTH
+	MOVEI	B,TVEC			; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
+	PUSHJ	P,MARK
+MFRAM1:	MOVE	A,PSAV-FSAV+1(C)	; MARK THE PSTACK
+	MOVEI	B,TPDL
+	PUSHJ	P,MARK
+	HRROI	C,-FSAV+1(C)		; POINT PAST FRAME
+	JRST	TPLP			; GO BACK TO START OF LOOP
+
+; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
+
+MBIND:	MOVEI	B,TATOM			; START BY MARKING THE ATOM
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; POINT TO VALUE SLOT
+	PUSHJ	P,MARK2			; MARK THE VALUE
+	ADDI	C,2			; POINT TO DECL AND PREV BINDING
+	MOVEI	B,TLIST			; MARK DECL
+	HLRZ	A,(C)
+	PUSHJ	P,MARK
+	SKIPL	A,1(C)			; SKIP IF PREVIOUS BINDING
+	JRST	NOTLCI
+	MOVEI	B,TLOCI			; GET TYPE
+	PUSHJ	P,MARK
+NOTLCI:	ADDI	C,2			; POINT PAST BINDING
+	JRST	TPLP
+
+
+PMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	IORM	D,(C)			; MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK TB POINTER
+
+TBMK:	HRRZS	A			; CHECK FOR NIL POINTER
+	SKIPN	A
+	JRST	GCRET
+	MOVE	A,TPSAV(A)		; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK AB POINTERS
+
+ABMK:	HLRE	B,A			; GET TO FRAME
+	SUB	A,B
+	MOVE	A,FRAMLN+TPSAV(A)	; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK FRAME POINTERS
+
+FRMK:	HRLZ	B,A			; GET THE TIME
+	HLRZ	F,OTBSAV(A)		; GET TIME FROM FRAME
+	CAIE	B,(F)			; SKIP IF TIMES AGREE
+	JRST	GCRET			; IGNORE POINTER IF THEY DONT
+	HRRZ	A,(C)			; GET POINTER TO PROCESS
+	SUBI	A,1			; FUDGE FOR VECTOR MARKING
+	MOVEI	B,TPVP			; TYPE WORD
+	PUSHJ	P,MARK
+	HRRZ	A,1(C)			; GET POINTER TO FRAME
+	JRST	TBMK			; MARK IT
+
+; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
+
+ARGMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; POINT PAST BLOCK
+	CAIL	A,STOSTR
+	CAMLE	A,GCSTOP		; SEE IF IN GCSPACE
+	JRST	GCRET
+	HRLZ	0,(A)			; GET TYPE
+	ANDI	0,TYPMSK		; FLUSH MONITORS
+	CAIE	0,TENTRY
+	CAIN	0,TCBLK
+	JRST	ARGMK1			; AT FRAME
+	CAIE	0,TINFO			; AT FRAME
+	JRST	GCRET			; NOT A LEGAL TYPE GO AWAY
+	HRRZ	A,1(A)			; POINTING TO FRAME
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+ARGMK1:	HRRI	A,FRAMLN(A)		; MAKE POINTER
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+
+
+; ROUTINE TO MARK GLOBAL SLOTS
+
+GATOMK:	HRRZ	B,(C)			; GET POSSIBLE GDECL
+	JUMPE	B,ATOMK			; NONE GO TO MARK ATOM
+	CAIN	B,-1			; SKIP IF NOT MANIFEST
+	JRST	ATOMK
+	PUSH	P,A			; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
+	MOVEI	C,(A)
+	MOVEI	A,(B)
+	MOVEI	B,TLIST			; TYPE WORD LIST
+	PUSHJ	P,MARK			; MARK IT
+	POP	P,A
+	JRST	ATOMK5
+
+ATOMK:
+ATOMK5:	HLRE	B,A
+	SUB	A,B			; A POINTS TO DOPE WORD
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET			; EXIT IF MARKED
+	HLRZ	B,1(A)
+	SUBI	B,3
+	HRLI	B,1(B)
+	MOVEI	C,-1(A)
+	SUB	C,B			; IN CASE WAS DW
+	IORM	D,1(A)			; MARK IT
+	HRRZ	A,2(C)			; MARK OBLIST
+	CAMG	A,VECBOT
+	JRST	NOOBL			; NO IMPURE OBLIST
+	HRLI	A,-1
+	MOVEI	B,TOBLS			; MARK THE OBLIST
+	PUSHJ	P,MARK
+NOOBL:	HLRZ	A,2(C)			; GET NEXT ATOM
+	MOVEI	B,TATOM
+	PUSHJ	P,MARK
+      	HLRZ	B,(C)			; GET VALUE SLOT
+	TRZ	B,400000		; TURN OFF MARK BIT
+	SKIPE	B			; SEE IF 0
+	CAIN	B,TUNBOUN		; SEE IF UNBOUND
+	JRST	GCRET
+	HRRZ	0,(C)			; SEE IF VECTOR OR TP POINTER
+	MOVEI	B,TVEC			; ASSUME VECTOR
+	SKIPE	0			; SKIP IF VECTOR
+	MOVEI	B,TTP			; IT IS A TP POINTER
+	PUSHJ	P,MARK1			; GO MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK BYTE AND STRING POINTERS
+
+BYTMK:	PUSHJ	P,BYTDOP		; GET TO DOPE WORD INTO A
+	HRLZ	F,-1(A)			; SEE IF SPECIAL ATOM [SPNAME]
+	ANDI	F,SATMSK		; GET SAT
+	CAIN	F,SATOM
+	JRST	ATMSET			; IT IS AN ATOM
+	IORM	D,(A)			; MARK IT
+	JRST	GCRET
+
+ATMSET:	HLRZ	B,(A)			; GET LENGTH
+	TRZ	B,400000		; TURN OFF POSSIBLE MARK BIT
+	MOVNI	B,-2(B)			; GENERATE AOBJN POINTER
+	ADDI	A,-1(B)			; GET BACK TO BEGINNING
+	HRLI	A,(B)			; PUT IN LEFT HALF
+	MOVEI	B,TATOM			; MARK AS AN ATOM
+	PUSHJ	P,MARK			; GO MARK
+	JRST	GCRET
+
+; MARK LOCID GOODIES
+
+LOCMK:	HRRZ	B,(C)			; CHECK FOR TIME
+	JUMPE	B,LOCMK1		; SKIP LEGAL CHECK FOR GLOBAL
+	HRRZ	0,2(A)			; GET OTHER TIME
+	CAIE	0,(B)			; SAME?
+	JRST	GCRET
+	MOVEI	B,TTP
+	PUSHJ	P,MARK1
+	JRST	GCRET
+LOCMK1:	MOVEI	B,TVEC			; GLOBAL
+	PUSHJ	P,MARK1			; MARK VALUE
+	JRST	GCRET
+
+; MARK ASSOCIATION BLOCK
+
+ASMK:	MOVEI	C,(A)			; SAVE POINTER TO BEGINNING OF ASSOCATION
+	ADDI	A,ASOLNT		; POINT TO DOPE WORD
+	HLRE	B,1(A)			; GET SECOND D.W.
+	JUMPL	B,GCRET			; MARKED SO LEAVE
+	IORM	D,1(A)			; MARK ASSOCATION
+	PUSHJ	P,MARK2			; MARK ITEM
+	MOVEI	C,INDIC(C)
+	PUSHJ	P,MARK2
+	MOVEI	C,VAL-INDIC(C)
+	PUSHJ	P,MARK2
+	HRRZ	A,NODPNT-VAL(C)		; GET NEXT IN CHAIN
+	JUMPN	A,ASMK			; GO MARK IT
+	JRST	GCRET
+
+; MARK OFFSETS
+
+OFFSMK:	PUSH	P,$TLIST
+	HLRZ	0,1(C)			; PICK UP LIST POINTER
+	PUSH	P,0
+	MOVEI	C,-1(P)
+	PUSHJ	P,MARK2			; MARK THE LIST
+	SUB	P,[2,,2]
+	JRST	GCRET			; AND RETURN
+
+; HERE TO MARK TEMPLATE DATA STRUCTURES
+
+TD.MK:	HLRZ	B,(A)			; GET REAL SPEC TYPE
+	ANDI	B,37777			; KILL SIGN BIT
+	MOVEI	E,-NUMSAT-1(B)		; GET REL POINTER TO TABLE
+	HRLI	E,(E)
+	ADD	E,TD.AGC+1
+	HRRZS	C,A			; FLUSH COUNT AND SAVE
+	SKIPL	E			; WITHIN BOUNDS
+	FATAL	BAD SAT IN AGC
+	SKIPL	1(A)			; SEE IF MARKED
+	JRST	GCRET			; IF MARKED LEAVE
+	IORM	D,1(A)
+
+	SKIPE	(E)
+	JRST	USRAGC
+	SUB	E,TD.AGC+1		; POINT TO LENGTH
+	ADD	E,TD.LNT+1
+	XCT	(E)			; RET # OF ELEMENTS IN B
+
+	HLRZ	D,B			; GET POSSIBLE "BASIC LENGTH" FOR RESTS
+	PUSH	P,[0]			; TEMP USED IF RESTS EXIST
+	PUSH	P,D
+	MOVEI	B,(B)			; ZAP TO ONLY LENGTH
+	PUSH	P,C			; SAVE POINTER TO TEMPLATE STRUCTURE
+	PUSH	P,B			; SAVE
+	SUB	E,TD.LNT+1
+	PUSH	P,E			; SAVE FOR FINDING OTHER TABLES
+	JUMPE	D,TD.MR2		; NO REPEATING SEQ
+	ADD	E,TD.GET+1		; COMP LNTH OF REPEATING SEQ
+	HLRE	E,(E)			; E ==> - LNTH OF TEMPLATE
+	ADDI	E,(D)			; E ==> -LENGTH OF REP SEQ
+	MOVNS	E
+	HRLM	E,-3(P)			; SAVE IT AND BASIC
+
+TD.MR2:	SKIPG	D,-1(P)			; ANY LEFT?
+	JRST	TD.MR1
+
+	MOVE	E,TD.GET+1
+	ADD	E,(P)
+	MOVE	E,(E)			; POINTER TO VECTOR IN E
+	MOVEM	D,-4(P)			; SAVE ELMENT #
+	SKIPN	B,-3(P)			; SKIP IF "RESTS" EXIST
+	SOJA	D,TD.MR3
+
+	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,-3(P)			; PLUS BASIC
+	ADDI	A,1			; AND FUDGE
+	MOVEM	A,-4(P)			; SAVE FOR PUTTER
+	ADDI	E,-1(A)			; POINT
+	SOJA	D,.+2
+
+TD.MR3:	ADDI	E,(D)			; POINT TO SLOT
+	XCT	(E)			; GET THIS ELEMENT INTO A AND B
+	JFCL				; NO-OP FOR ANY CASE
+	EXCH	A,B			; REARRANGE
+	HLRZS	B
+	MOVSI	D,400000		; RESET FOR MARK
+	PUSHJ	P,MARK			; AND MARK THIS GUY (RET FIXED POINTER IN A)
+	MOVE	C,-2(P)			; RESTORE POINTER IN CASE MUNGED
+	JRST	TD.MR2
+
+TD.MR1:	SUB	P,[5,,5]
+	JRST	GCRET
+
+USRAGC:	XCT	(E)			; MARK THE TEMPLATE
+	JRST	GCRET
+	
+
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK:	MOVEI	C,(A)			; SAVE POINTER TO GCREAD TABLE
+	HLRE	B,A			; GET TO DOPE WORD
+	SUB	A,B		
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET
+	SUBI	A,2
+	MOVE	B,ABOTN			; GET TOP OF ATOM TABLE
+	ADD	B,0			; GET BOTTOM OF ATOM TABLE
+GCRD1:	CAMG	A,B			; DON'T SKIP IF DONE
+	JRST	GCRET
+	HLRZ	C,(A)			; GET MARKING
+	TRZN	C,400000		; SKIP IF MARKED
+	JRST	GCRD3
+	MOVEI	E,(A)
+	SUBI	A,(C)			; GO BACK ONE ATOM
+	PUSH	P,B			; SAVE B
+	PUSH	P,A			; SAVE POINTER
+	MOVEI	C,-2(E)			; SET UP POINTER
+	MOVEI	B,TATOM			; GO TO MARK
+	MOVE	A,1(C)
+	PUSHJ	P,MARK
+	POP	P,A
+	POP	P,B
+	JRST	GCRD1
+GCRD3:	SUBI	A,(C)			; TO NEXT ATOM
+	JRST	GCRD1
+
+
+; ROUTINE TO FIX UP CHANNELS
+
+CHNFLS:	MOVEI	0,N.CHNS-1
+	MOVEI	A,,CHNL1		; SET UP POINTER
+CHFL1:	SKIPN	B,1(A)			; GET POINTER TO CHANNEL
+	JRST	CHFL2			; NO CHANNEL LOOP TO NEXT
+	HLRE	C,B			; POINT TO DOPE WORD OF CHANNEL
+	SUBI	B,(C)
+	MOVEI	F,TCHAN
+	HRLM	F,(A)			; PUT TYPE BACK
+	SKIPL	1(B)			; SKIP IF MARKED
+	JRST	FLSCH			; FLUSH THE CHANNEL
+	MOVEI	F,1			; MARK THE CHANNEL AS GOOD
+	HRRM	F,(A)			; SMASH IT IN
+CHFL2:	ADDI	A,2
+	SOJG	0,CHFL1
+	POPJ	P,			; EXIT
+FLSCH:	HLLOS	F,(A)			; -1 INTO SLOT INDICATES LOSSAGE
+	JRST	CHFL2
+
+
+; THIS ROUTINE MARKS ALL THE CHANNELS
+
+CHFIX:	MOVEI	0,N.CHNS-1
+	MOVEI	A,CHNL1		; SLOTS
+
+DHNFL2:	SKIPN	1(A)
+	JRST	DHNFL1
+	PUSH	P,0		; SAVE 0
+	PUSH	P,A		; SAVE A
+	MOVEI	C,(A)
+	MOVE	A,1(A)
+	MOVEI	B,TCHAN
+	PUSHJ	P,MARK
+	POP	P,A		; RESTORE A
+	POP	P,0		; RESTORE
+DHNFL1:	ADDI	A,2
+	SOJG	0,DHNFL2
+	POPJ	P,
+
+
+
+; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN:	PUSH	P,B		; SAVE TIME
+	MOVEI	B,[ASCIZ /TIME= /]
+	PUSHJ	P,MSGTYP	; PRINT OUT MESSAGE
+	POP	P,B		; RESTORE B
+	FMPRI	B,(100.0)	; CONVERT TO FIX
+	MULI	B,400
+	TSC	B,B
+	ASH	C,-163.(B)
+	MOVEI	A,1		; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+	PUSH	P,C
+	IDIVI	C,10.		; START COUNTING
+	JUMPLE	C,.+2
+	AOJA	A,.-2
+	POP	P,C
+	CAIN	A,1		; SEE IF THERE IS ONLY ONE CHARACTER
+	JRST	DOT1
+FIXOUT:	IDIVI	C,10.		; RECOVER NUMBER
+	HRLM	D,(P)
+	SKIPE	C
+	PUSHJ	P,FIXOUT
+	PUSH	P,A		; SAVE A
+	CAIN	A,2		; DECIMAL POINT HERE?
+	JRST	DOT2
+FIX1:	HLRZ	A,(P)-1		; GET NUMBER
+	ADDI	A,60		; MAKE IT A CHARACTER
+	PUSHJ	P,IMTYO		; OUT IT GOES
+	POP	P,A
+	SOJ	A,
+	POPJ	P,
+DOT1:	MOVEI	A,".		; OUTPUT DECIMAL POINT AND PADDING 0
+	PUSHJ	P,IMTYO
+	MOVEI	A,"0
+	PUSHJ	P,IMTYO
+	JRST	FIXOUT		; CONTINUE
+DOT2:	MOVEI	A,".		; OUTPUT DECIMAL POINT
+	PUSHJ	P,IMTYO
+	JRST	FIX1
+
+
+; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS.  PAIRS ARE PLACED ON THE 
+; RCL LIST, VECTORS ON THE RCLV LIST.
+
+SWEEP:	MOVE	C,GCSTOP		; GET TOP OF GC SPACE
+	SUBI	C,1			; POINT TO FIRST OBJECT
+	SETZB	E,F			; CURRENT SLOT AND CURRENT LENGTH
+LSWEEP:	CAMG	C,GCSBOT		; SKIP IF ABOVE GCSBOT
+	JRST	ESWEEP			; DONE
+	HLRE	A,-1(C)			; SEE IF LIST OR VECTOR
+	TRNE	A,UBIT			; SKIP IF LIST
+	JRST	VSWEEP			; IT IS A VECTOR
+	JUMPGE	A,LSWP1			; JUMP IF NOT MARKED
+	ANDCAM	D,-1(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS		; CONS ON CURRENT OBJECT
+	SUBI	C,2			; SKIP OVER LIST
+	JRST	LSWEEP
+LSWP1:	ADDI	F,2			; ADD TO CURRENT OBJECT COUNT
+	JUMPN	E,LSWP2			; JUMP IF CURRENT OBJECT EXISTS
+	MOVEI	E,(C)			; GET ADDRESS
+LSWP2:	SUBI	C,2
+	JRST	LSWEEP
+
+VSWEEP:	HLRE	A,(C)			; GET LENGTH
+	JUMPGE	A,VSWP1			; SKIP IF MARKED
+	ANDCAM	D,(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS
+	ANDI	A,377777		; GET LENGTH PART
+	SUBI	C,(A)			; GO PAST VECTOR
+	JRST	LSWEEP
+VSWP1:	ADDI	F,(A)			; ADD LENGTH
+	JUMPN	E,VSWP2
+	MOVEI	E,(C)			; GET NEW OBJECT LOCATION
+VSWP2:	SUBI	C,(A)			; GO BACK PAST VECTOR
+	JRST	LSWEEP
+
+ESWEEP:
+SWCONS:	JUMPE	E,CPOPJ
+	ADDM	F,TOTCNT		; HACK TOTCNT
+	CAMLE	F,MAXLEN		; SEE IF NEW MAXIMUM
+	MOVEM	F,MAXLEN
+	CAIGE	F,2			; MAKE SURE AT LEAST TWO LONG
+	FATAL	SWEEP FAILURE
+	CAIN	F,2
+	JRST	LCONS
+	SETZM	(E)
+	MOVEI	0,(E)
+	SUBI	0,-1(F)
+	SETZM	@0
+	HRLS	0
+	ADDI	0,1
+	BLT	0,-2(E)
+	HRRZ	0,RCLV			; GET VECTOR RECYCLE
+	HRRM	0,(E)			; SMASH INTO LINKING SLOT
+	HRRZM	E,RCLV			; NEW RECYCLE SLOT
+	HRLM	F,(E)
+	MOVSI	F,UBIT
+	MOVEM	F,-1(E)
+	SETZB	E,F
+	POPJ	P,			; DONE
+LCONS:	SETZM	(E)
+	SUBI	E,1
+	HRRZ	0,RCL			; GET RECYCLE LIST
+	HRRZM	0,(E)			; SMASH IN
+	HRRZM	E,RCL
+	SETZB	E,F
+	POPJ	P,
+
+
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT:	[ASCIZ /USER CALLED- /]
+	[ASCIZ /FREE STORAGE- /]
+	[ASCIZ /TP-STACK- /]
+	[ASCIZ /TOP-LEVEL LOCALS- /]
+	[ASCIZ /GLOBAL VALUES- /]
+	[ASCIZ /TYPES- /]
+	[ASCIZ /STATIONARY IMPURE STORAGE- /]
+	[ASCIZ /P-STACK /]
+	[ASCIZ /BOTH STACKS BLOWN- /]
+	[ASCIZ /PURE STORAGE- /]
+	[ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT:	SPBLOK 100
+EGCPAT:	-1
+
+MSGGFT:	[ASCIZ /GC-READ /]
+	[ASCIZ /BLOAT /]
+	[ASCIZ /GROW /]
+	[ASCIZ /LIST /]
+	[ASCIZ /VECTOR /]
+	[ASCIZ /SET /]
+	[ASCIZ /SETG /]
+	[ASCIZ /FREEZE /]
+	[ASCIZ /PURE-PAGE LOADER /]
+	[ASCIZ /GC /]
+	[ASCIZ /INTERRUPT-HANDLER /]
+	[ASCIZ /NEWTYPE /]	
+	[ASCIZ /PURIFY /]
+
+CONSTANTS
+
+HERE
+
+CONSTANTS
+
+OFFSET 0
+
+ZZ==$.+1777
+
+.LOP ANDCM ZZ 1777
+
+ZZ1==.LVAL1
+
+LOC ZZ1
+
+OFFSET OFFS
+
+MRKPDL==.-1
+
+ENDGC:
+
+OFFSET 0
+
+ZZ2==ENDGC-AGCLD
+
+.LOP <ASH @> ZZ2 <,-10.>
+SLENGC==.LVAL1
+.LOP <ASH @> SLENGC <10.>
+RSLENG==.LVAL1
+LOC GCST
+
+.LPUR=$.
+
+END

src/mudsys/amsgc.mid.110

@@ -0,0 +1,887 @@
+TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
+
+RELOCATABLE
+
+.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
+.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
+.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
+.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
+.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
+.GLOBAL RSLENG
+
+GCST=$.
+
+LOC REALGC+RLENGC
+
+OFFS=AGCLD-$.
+OFFSET OFFS
+
+.INSRT MUDDLE >
+
+TYPNT==AB
+F==PVP
+
+
+; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR.  IT IS MUCH FASTER THAN THE COPYING
+; GARBAGE COLLECTOR BUT DOESN'T COMPACT.  IT CONSES FREE THINGS ONTO RCL AND RCLV.
+; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE 
+; GARBAGE COLLECT
+
+
+; FIRST INITIALIZE VARIABLES
+
+IAMSGC:	SETZB	M,RCL			; CLEAR OUT LIST RECYCLE AND RSUBR BASE
+	SETZM	RCLV			; CLEAR VECTOR RECYCLE
+	SETZM	MAXLEN			; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
+	SETOM	GCFLG			; A GC HAS HAPPENED
+	SETZM	TOTCNT
+	HLLZS	SQUPNT			; CLEAR OUT SQUOZE TABLE
+
+; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
+
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C			; SAVE ACS
+	MOVEI	B,[ASCIZ /MSGIN / ]	; PRINT GIN IF WINNING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+	HRRZ	C,(P)			; GET CAUSE INDICATOR
+	ADDI	B,1			; AOS TO GET REAL CAUS
+	MOVEM	B,GCCAUS
+	SKIPN	GCMONF
+	JRST	NOMON2
+	MOVE	B,MSGGCT(C)		; GET CAUSE MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON2:	HLRZ	C,(P)			; FIND OUT WHO CAUSED THE GC
+	MOVEM	C,GCCALL
+	SKIPN	GCMONF			; PRINT IF GCMON IS ON
+	JRST	NOMON3
+	MOVE	B,MSGGFT(C)		; GET POINTER TO MESSAGE
+	PUSHJ	P,MSGTYP
+NOMON3:	SUB	P,[1,,1]
+	POP	P,B			; RESTORE ACS
+	POP	P,A
+
+; MOVE ACS INTO THE PVP
+
+	EXCH	PVP,PVSTOR+1		; GET REAL PROCESS VECTOR
+
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVEM	AC,AC!STO+1(PVP)
+	TERMIN
+
+	MOVE	0,PVSTOR+1		; GET OLD VALUE OF PVP
+	MOVEM	0,PVPSTO+1(PVP)		; SAVE PVP
+	MOVE	0,DSTORE		; SAVE D'S TYPE
+	MOVEM	0,DSTO(PVP)
+	MOVEM	PVP,PVSTOR+1
+
+; SET UP TYPNT TO POINT TO TYPE VECTOR
+
+	GETYP	E,TYPVEC		; FIRST SEE IF TYPVEC IS A VECTOR
+	CAIE	E,TVEC
+	FATAL	TYPE VECTOR NOT OF TYPE VECTOR
+	HRRZ	TYPNT,TYPVEC+1
+	HRLI	TYPNT,B			; TYPNT IS NOW TYPEVECTOR(B)
+
+; NOW SET UP GCPDL AND FENCE POST PDL'S
+
+	MOVEI	A,(TB)
+	MOVE	D,P			; SAVE P POINTER
+	PUSHJ	P,FRMUNG
+	MOVE	P,[-2000,,MRKPDL]	; SET UP MARK PDL
+	MOVEI	A,(TB)			; FIXUP TOP FRAME
+	SETOM	1(TP)			; FENCEPOST TP
+	SETOM	1(D)			; FENCEPOST P
+
+; NOW SETUP AUTO CHANNEL CLOSE
+
+	MOVEI	0,N.CHNS-1		; NUMBER OF CHANNELS
+	MOVEI	A,CHNL1			; FIRST CHANNEL SLOT
+CHNCLR:	SKIPE	1(A)			; IS IT A CHANNEL
+	SETZM	(A)			; CLEAR UP TYPE SLOT
+	ADDI	A,2
+	SOJG	0,CHNCLR
+
+; NOW DO MARK AND SWEEP PHASES
+
+	MOVSI	D,400000		; MARK BIT
+	MOVEI	B,TPVP			; GET TYPE
+	MOVE	A,PVSTOR+1		; GET VALUE OF CURRENT PROCESS VECTOR
+	PUSHJ	P,MARK
+	MOVEI	B,TPVP			; GET TYPE OF MAIN PROCESS VECTOR
+	MOVE	A,MAINPR
+	PUSHJ	P,MARK			; MARK
+	PUSHJ	P,CHNFLS		; DO CHANNEL FLUSHING
+	PUSHJ	P,CHFIX
+	PUSHJ	P,STOGC			; FIX UP FROZEN WORLD
+	PUSHJ	P,SWEEP			; SWEEP WORLD
+
+; PRINT GOUT
+
+	MOVEI	B,[ASCIZ /MSGOUT /]		; PRINT OUT ENDING MESSAGE IF GCMONING
+	SKIPE	GCMONF
+	PUSHJ	P,MSGTYP
+
+; RESTORE ACS
+
+	MOVE	PVP,PVSTOR+1		; GET PVP
+	IRP	AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
+	MOVE	AC,AC!STO+1(PVP)
+	TERMIN
+
+	SKIPN	DSTORE			; CLEAR OUT TYPE IF NO TYPE THERE
+	SETZM	DSTO(PVP)
+	MOVE	PVP,PVPSTO+1(PVP)
+
+; PRINT TIME
+
+	PUSH	P,A			; SAVE ACS
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSHJ	P,CTIME			; GET CURRENT CPU TIME
+	FSBR	B,GCTIM			; COMPUTE TIME ELAPSED
+	MOVEM	B,GCTIM			; SAVE TIME AWAY
+	SKIPN	GCMONF			; PRINT IT OUT?
+	JRST	GCCONT
+	PUSHJ	P,FIXSEN
+	MOVEI	A,15			; OUTPUT CR/LF
+	PUSHJ	P,IMTYO
+	MOVEI	A,12
+	PUSHJ	P,IMTYO
+GCCONT:	POP	P,D			; RESTORE ACS
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	SETZM	GCFLG
+	SETOM	GCHAPN
+	SETOM	INTFLG
+	PUSHJ	P,RBLDM
+	JRST	FNMSGC			; DONE
+
+
+; THIS IS THE MARK PHASE
+
+; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
+; /A POINTER TO GOODIE
+; /B TYPE OF GOODIE
+; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
+
+MARK2S:
+MARK2:	HLRZ	B,(C)			; TYPE
+MARK1:	MOVE	A,1(C)			; VALUE
+MARK:	JUMPE	A,CPOPJ			; DONE IF ZERO
+	MOVEI	0,1(A)			; SEE IF PURE
+	CAML	0,PURBOT
+	JRST	CPOPJ
+	ANDI	B,TYPMSK		; FLUSH	MONITORS
+	HRLM	C,(P)
+	CAIG	B,NUMPRI		; IS A BASIC TYPE
+	JRST	@MTYTBS(B)		; TYPE DISPATCH
+	LSH	B,1			; NOW GET PRIMTYPE
+	HRRZ	B,@TYPNT		; GET PRIMTYPE
+	ANDI	B,SATMSK		; FLUSH DOWN TO SAT
+	CAIG	B,NUMSAT		; SKIP IF TEMPLATE DATA
+	JRST	@MSATBS(B)		; JUMP OFF SAT TABLE
+	JRST	TD.MK
+
+GCRET:	HLRZ	C,(P)			; GET SAVED C
+CPOPJ:	POPJ	P,
+
+; TYPE DISPATCH TABLE
+MTYTBS:
+
+OFFSET 0
+
+DUM1:
+
+IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
+[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
+[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
+[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
+[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
+[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
+[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
+[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
+[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK]
+[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
+[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
+[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
+[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
+[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
+[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
+[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
+	IRP A,B,[XX]
+		LOC DUM1+A
+		SETZ B
+		.ISTOP
+	TERMIN
+TERMIN
+
+LOC DUM1+NUMPRI+1
+
+OFFSET OFFS
+
+; SAT DISPATCH TABLE
+
+MSATBS:
+
+OFFSET 0
+
+DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
+[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+
+; ROUTINE TO MARK PAIRS
+
+PAIRMK: MOVEI	C,(A)
+PAIRM1:	CAMG	C,GCSTOP		; SEE IF IN RANGE
+	CAIGE	C,STOSTR
+	JRST	BADPTR			; FATAL ERROR
+	HLRE	B,(C)			; SKIP IF NOT MARKED
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	PUSHJ	P,MARK1			; MARK THE ITEM
+	HRRZ	C,(C)			; GET NEXT ELEMENT OF LIST
+	JUMPE	C,GCRET
+	CAML	C,PURBOT
+	JRST	GCRET
+	JRST	PAIRM1
+	
+; ROUTINE TO MARK DEFERS
+
+DEFMK:	HLRE	B,(A)
+	JUMPL	B,GCRET
+	MOVEI	C,(A)
+	IORM	D,(C)
+	PUSHJ	P,MARK1
+	JRST	GCRET
+
+; ROUTINE TO MARK POSSIBLE DEFERS DEF?
+
+DEFQMK:	GETYP	B,(A)			; GET THE TYPE OF THE OBJECT
+	LSH	B,1			; COMPUTE THE SAT
+	HRRZ	B,@TYPNT
+	ANDI	B,SATMSK
+	SKIPL	MKTBS(B)		; SKIP IF NOT DEFERED
+	JRST	PAIRMK
+	JRST	DEFMK			; GO TO DEFMK
+
+
+; ROUTINE TO MARK VECTORS
+
+VECMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B
+	MOVEI	C,1(A)			; POINT TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	B,(C)
+	JUMPL	B,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(B)			; GET TO BEGINNING
+VECMK1:	HLRE	B,(C)			; GET TYPE AND SKIP IF NOT DOPE WORD
+	JUMPL	B,GCRET			; DONE
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; NEXT ELEMENT
+	JRST	VECMK1
+
+; ROUTINE TO MARK UVECTORS
+
+UVMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,1(A)			; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	F,(C)			; GET LENGTH
+	JUMPL	F,GCRET
+	IORM	D,(C)			; MARK IT
+	GETYP	B,-1(C)			; GET TYPE
+	MOVEI	E,(B)			; COPY TYPE FOR SAT COMPUTATION
+	LSH	B,1
+	HRRZ	B,@TYPNT		; GET SAT
+	ANDI	B,SATMSK
+	MOVEI	B,@MSATBS(B)		; GET JUMP LOCATION
+	CAIN	B,GCRET
+	JRST	GCRET
+	SUBI	C,(F)			; POINT TO BEGINNING OF UVECTOR
+	SUBI	F,2
+	JUMPE	F,GCRET
+	PUSH	P,F			; SAVE LENGTH
+	PUSH	P,E
+UNLOOP:	MOVE	B,(P)
+	MOVE	A,1(C)			; GET VALUE POINTER
+	PUSHJ	P,MARK
+	SOSE	-1(P)			; SKIP IF NON-ZERO
+	AOJA	C,UNLOOP		; GO BACK AGAIN
+	SUB	P,[2,,2]		; CLEAN OFF STACK
+	JRST	GCRET
+
+; ROUTINE TO INDICATE A BAD POINTER
+
+BADPTR:	FATAL	POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
+	JRST	GCRET
+
+
+; ROUTINE TO MARK A TPSTACK
+
+TPMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	HLRE	A,(C)
+	JUMPL	A,GCRET
+	IORM	D,(C)			; MARK IT
+	SUBI	C,-1(A)			; GO TO BEGINNING
+
+TPLP:	HLRE	B,(C)			; GET TYPE AND MARKING
+	JUMPL	B,GCRET			; EXIT ON FENCE-POST
+	ANDI	B,TYPMSK		; FLUSH MONITORS
+	CAIE	B,TCBLK			; CHECK FOR FRAME
+	CAIN	B,TENTRY
+	JRST	MFRAME			; MARK THE FRAME
+	CAIE	B,TUBIND		; BINDING BLOCK
+	CAIN	B,TBIND
+	JRST	MBIND
+	PUSHJ	P,MARK1			; NOTHING SPECIAL SO MARK IT
+	ADDI	C,2			; POINT TO NEXT OBJECT
+	JRST	TPLP			; MARK IT
+
+; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
+
+MFRAME:	HRROI	C,FRAMLN+FSAV-1(C)	; POINT TO FUNCTION
+	HRRZ	A,1(C)			; GET POINTER
+	CAIL	A,STOSTR		; SEE IF IN GC SPACE
+	CAMLE	A,GCSTOP
+	JRST	MFRAM1			; SKIP OVER IT, NOT IN GC-SPACE
+	HRL	A,(A)			; GET LENGTH
+	MOVEI	B,TVEC			; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
+	PUSHJ	P,MARK
+MFRAM1:	MOVE	A,PSAV-FSAV+1(C)	; MARK THE PSTACK
+	MOVEI	B,TPDL
+	PUSHJ	P,MARK
+	HRROI	C,-FSAV+1(C)		; POINT PAST FRAME
+	JRST	TPLP			; GO BACK TO START OF LOOP
+
+; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
+
+MBIND:	MOVEI	B,TATOM			; START BY MARKING THE ATOM
+	PUSHJ	P,MARK1			; MARK IT
+	ADDI	C,2			; POINT TO VALUE SLOT
+	PUSHJ	P,MARK2			; MARK THE VALUE
+	ADDI	C,2			; POINT TO DECL AND PREV BINDING
+	MOVEI	B,TLIST			; MARK DECL
+	HLRZ	A,(C)
+	PUSHJ	P,MARK
+	SKIPL	A,1(C)			; SKIP IF PREVIOUS BINDING
+	JRST	NOTLCI
+	MOVEI	B,TLOCI			; GET TYPE
+	PUSHJ	P,MARK
+NOTLCI:	ADDI	C,2			; POINT PAST BINDING
+	JRST	TPLP
+
+
+PMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; A POINTS TO FIRST DOPE WORD
+	MOVEI	C,PDLBUF+1(A)		; C POINTS TO SECOND DOPE WORD
+	CAIL	C,STOSTR		; CHECK FOR IN RANGE
+	CAMLE	C,GCSTOP
+	JRST	BADPTR
+	IORM	D,(C)			; MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK TB POINTER
+
+TBMK:	HRRZS	A			; CHECK FOR NIL POINTER
+	SKIPN	A
+	JRST	GCRET
+	MOVE	A,TPSAV(A)		; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK AB POINTERS
+
+ABMK:	HLRE	B,A			; GET TO FRAME
+	SUB	A,B
+	MOVE	A,FRAMLN+TPSAV(A)	; GET A TP POINTER
+	MOVEI	B,TTP			; TYPE WORD
+	PUSHJ	P,MARK
+	JRST	GCRET
+
+; ROUTINE TO MARK FRAME POINTERS
+
+FRMK:	HRLZ	B,A			; GET THE TIME
+	HLRZ	F,OTBSAV(A)		; GET TIME FROM FRAME
+	CAIE	B,(F)			; SKIP IF TIMES AGREE
+	JRST	GCRET			; IGNORE POINTER IF THEY DONT
+	HRRZ	A,(C)			; GET POINTER TO PROCESS
+	SUBI	A,1			; FUDGE FOR VECTOR MARKING
+	MOVEI	B,TPVP			; TYPE WORD
+	PUSHJ	P,MARK
+	HRRZ	A,1(C)			; GET POINTER TO FRAME
+	JRST	TBMK			; MARK IT
+
+; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
+
+ARGMK:	HLRE	B,A			; GET LENGTH
+	SUB	A,B			; POINT PAST BLOCK
+	CAIL	A,STOSTR
+	CAMLE	A,GCSTOP		; SEE IF IN GCSPACE
+	JRST	GCRET
+	HRLZ	0,(A)			; GET TYPE
+	ANDI	0,TYPMSK		; FLUSH MONITORS
+	CAIE	0,TENTRY
+	CAIN	0,TCBLK
+	JRST	ARGMK1			; AT FRAME
+	CAIE	0,TINFO			; AT FRAME
+	JRST	GCRET			; NOT A LEGAL TYPE GO AWAY
+	HRRZ	A,1(A)			; POINTING TO FRAME
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+ARGMK1:	HRRI	A,FRAMLN(A)		; MAKE POINTER
+	HRL	A,(C)			; GET TIME
+	JRST	TBMK
+
+
+; ROUTINE TO MARK GLOBAL SLOTS
+
+GATOMK:	HRRZ	B,(C)			; GET POSSIBLE GDECL
+	JUMPE	B,ATOMK			; NONE GO TO MARK ATOM
+	CAIN	B,-1			; SKIP IF NOT MANIFEST
+	JRST	ATOMK
+	PUSH	P,A			; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
+	MOVEI	C,(A)
+	MOVEI	A,(B)
+	MOVEI	B,TLIST			; TYPE WORD LIST
+	PUSHJ	P,MARK			; MARK IT
+	POP	P,A
+	JRST	ATOMK5
+
+ATOMK:
+ATOMK5:	HLRE	B,A
+	SUB	A,B			; A POINTS TO DOPE WORD
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET			; EXIT IF MARKED
+	HLRZ	B,1(A)
+	SUBI	B,3
+	HRLI	B,1(B)
+	MOVEI	C,-1(A)
+	SUB	C,B			; IN CASE WAS DW
+	IORM	D,1(A)			; MARK IT
+	HRRZ	A,2(C)			; MARK OBLIST
+	CAMG	A,VECBOT
+	JRST	NOOBL			; NO IMPURE OBLIST
+	HRLI	A,-1
+	MOVEI	B,TOBLS			; MARK THE OBLIST
+	PUSHJ	P,MARK
+NOOBL:	HLRZ	A,2(C)			; GET NEXT ATOM
+	MOVEI	B,TATOM
+	PUSHJ	P,MARK
+      	HLRZ	B,(C)			; GET VALUE SLOT
+	TRZ	B,400000		; TURN OFF MARK BIT
+	SKIPE	B			; SEE IF 0
+	CAIN	B,TUNBOUN		; SEE IF UNBOUND
+	JRST	GCRET
+	HRRZ	0,(C)			; SEE IF VECTOR OR TP POINTER
+	MOVEI	B,TVEC			; ASSUME VECTOR
+	SKIPE	0			; SKIP IF VECTOR
+	MOVEI	B,TTP			; IT IS A TP POINTER
+	PUSHJ	P,MARK1			; GO MARK IT
+	JRST	GCRET
+
+; ROUTINE TO MARK BYTE AND STRING POINTERS
+
+BYTMK:	PUSHJ	P,BYTDOP		; GET TO DOPE WORD INTO A
+	HRLZ	F,-1(A)			; SEE IF SPECIAL ATOM [SPNAME]
+	ANDI	F,SATMSK		; GET SAT
+	CAIN	F,SATOM
+	JRST	ATMSET			; IT IS AN ATOM
+	IORM	D,(A)			; MARK IT
+	JRST	GCRET
+
+ATMSET:	HLRZ	B,(A)			; GET LENGTH
+	TRZ	B,400000		; TURN OFF POSSIBLE MARK BIT
+	MOVNI	B,-2(B)			; GENERATE AOBJN POINTER
+	ADDI	A,-1(B)			; GET BACK TO BEGINNING
+	HRLI	A,(B)			; PUT IN LEFT HALF
+	MOVEI	B,TATOM			; MARK AS AN ATOM
+	PUSHJ	P,MARK			; GO MARK
+	JRST	GCRET
+
+; MARK LOCID GOODIES
+
+LOCMK:	HRRZ	B,(C)			; CHECK FOR TIME
+	JUMPE	B,LOCMK1		; SKIP LEGAL CHECK FOR GLOBAL
+	HRRZ	0,2(A)			; GET OTHER TIME
+	CAIE	0,(B)			; SAME?
+	JRST	GCRET
+	MOVEI	B,TTP
+	PUSHJ	P,MARK1
+	JRST	GCRET
+LOCMK1:	MOVEI	B,TVEC			; GLOBAL
+	PUSHJ	P,MARK1			; MARK VALUE
+	JRST	GCRET
+
+; MARK ASSOCIATION BLOCK
+
+ASMK:	MOVEI	C,(A)			; SAVE POINTER TO BEGINNING OF ASSOCATION
+	ADDI	A,ASOLNT		; POINT TO DOPE WORD
+	HLRE	B,1(A)			; GET SECOND D.W.
+	JUMPL	B,GCRET			; MARKED SO LEAVE
+	IORM	D,1(A)			; MARK ASSOCATION
+	PUSHJ	P,MARK2			; MARK ITEM
+	MOVEI	C,INDIC(C)
+	PUSHJ	P,MARK2
+	MOVEI	C,VAL-INDIC(C)
+	PUSHJ	P,MARK2
+	HRRZ	A,NODPNT-VAL(C)		; GET NEXT IN CHAIN
+	JUMPN	A,ASMK			; GO MARK IT
+	JRST	GCRET
+
+; MARK OFFSETS
+
+OFFSMK:	PUSH	P,$TLIST
+	HLRZ	0,1(C)			; PICK UP LIST POINTER
+	PUSH	P,0
+	MOVEI	C,-1(P)
+	PUSHJ	P,MARK2			; MARK THE LIST
+	SUB	P,[2,,2]
+	JRST	GCRET			; AND RETURN
+
+; HERE TO MARK TEMPLATE DATA STRUCTURES
+
+TD.MK:	HLRZ	B,(A)			; GET REAL SPEC TYPE
+	ANDI	B,37777			; KILL SIGN BIT
+	MOVEI	E,-NUMSAT-1(B)		; GET REL POINTER TO TABLE
+	HRLI	E,(E)
+	ADD	E,TD.AGC+1
+	HRRZS	C,A			; FLUSH COUNT AND SAVE
+	SKIPL	E			; WITHIN BOUNDS
+	FATAL	BAD SAT IN AGC
+	SKIPL	1(A)			; SEE IF MARKED
+	JRST	GCRET			; IF MARKED LEAVE
+	IORM	D,1(A)
+
+	SKIPE	(E)
+	JRST	USRAGC
+	SUB	E,TD.AGC+1		; POINT TO LENGTH
+	ADD	E,TD.LNT+1
+	XCT	(E)			; RET # OF ELEMENTS IN B
+
+	HLRZ	D,B			; GET POSSIBLE "BASIC LENGTH" FOR RESTS
+	PUSH	P,[0]			; TEMP USED IF RESTS EXIST
+	PUSH	P,D
+	MOVEI	B,(B)			; ZAP TO ONLY LENGTH
+	PUSH	P,C			; SAVE POINTER TO TEMPLATE STRUCTURE
+	PUSH	P,B			; SAVE
+	SUB	E,TD.LNT+1
+	PUSH	P,E			; SAVE FOR FINDING OTHER TABLES
+	JUMPE	D,TD.MR2		; NO REPEATING SEQ
+	ADD	E,TD.GET+1		; COMP LNTH OF REPEATING SEQ
+	HLRE	E,(E)			; E ==> - LNTH OF TEMPLATE
+	ADDI	E,(D)			; E ==> -LENGTH OF REP SEQ
+	MOVNS	E
+	HRLM	E,-3(P)			; SAVE IT AND BASIC
+
+TD.MR2:	SKIPG	D,-1(P)			; ANY LEFT?
+	JRST	TD.MR1
+
+	MOVE	E,TD.GET+1
+	ADD	E,(P)
+	MOVE	E,(E)			; POINTER TO VECTOR IN E
+	MOVEM	D,-4(P)			; SAVE ELMENT #
+	SKIPN	B,-3(P)			; SKIP IF "RESTS" EXIST
+	SOJA	D,TD.MR3
+
+	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,-3(P)			; PLUS BASIC
+	ADDI	A,1			; AND FUDGE
+	MOVEM	A,-4(P)			; SAVE FOR PUTTER
+	ADDI	E,-1(A)			; POINT
+	SOJA	D,.+2
+
+TD.MR3:	ADDI	E,(D)			; POINT TO SLOT
+	XCT	(E)			; GET THIS ELEMENT INTO A AND B
+	JFCL				; NO-OP FOR ANY CASE
+	EXCH	A,B			; REARRANGE
+	HLRZS	B
+	MOVSI	D,400000		; RESET FOR MARK
+	PUSHJ	P,MARK			; AND MARK THIS GUY (RET FIXED POINTER IN A)
+	MOVE	C,-2(P)			; RESTORE POINTER IN CASE MUNGED
+	JRST	TD.MR2
+
+TD.MR1:	SUB	P,[5,,5]
+	JRST	GCRET
+
+USRAGC:	XCT	(E)			; MARK THE TEMPLATE
+	JRST	GCRET
+	
+
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK:	MOVEI	C,(A)			; SAVE POINTER TO GCREAD TABLE
+	HLRE	B,A			; GET TO DOPE WORD
+	SUB	A,B		
+	SKIPGE	1(A)			; SKIP IF NOT MARKED
+	JRST	GCRET
+	IORM	D,1(A)			; MARK THE CHOMPER!!!
+	SUBI	A,2
+	MOVE	B,ABOTN			; GET TOP OF ATOM TABLE
+	ADD	B,0			; GET BOTTOM OF ATOM TABLE
+GCRD1:	CAMG	A,B			; DON'T SKIP IF DONE
+	JRST	GCRET
+	HLRZ	C,(A)			; GET MARKING
+	TRZN	C,400000		; SKIP IF MARKED
+	JRST	GCRD3
+	MOVEI	E,(A)
+	SUBI	A,(C)			; GO BACK ONE ATOM
+	PUSH	P,B			; SAVE B
+	PUSH	P,A			; SAVE POINTER
+	MOVEI	C,-2(E)			; SET UP POINTER
+	MOVEI	B,TATOM			; GO TO MARK
+	MOVE	A,1(C)
+	PUSHJ	P,MARK
+	POP	P,A
+	POP	P,B
+	JRST	GCRD1
+GCRD3:	SUBI	A,(C)			; TO NEXT ATOM
+	JRST	GCRD1
+
+
+; ROUTINE TO FIX UP CHANNELS
+
+CHNFLS:	MOVEI	0,N.CHNS-1
+	MOVEI	A,,CHNL1		; SET UP POINTER
+CHFL1:	SKIPN	B,1(A)			; GET POINTER TO CHANNEL
+	JRST	CHFL2			; NO CHANNEL LOOP TO NEXT
+	HLRE	C,B			; POINT TO DOPE WORD OF CHANNEL
+	SUBI	B,(C)
+	MOVEI	F,TCHAN
+	HRLM	F,(A)			; PUT TYPE BACK
+	SKIPL	1(B)			; SKIP IF MARKED
+	JRST	FLSCH			; FLUSH THE CHANNEL
+	MOVEI	F,1			; MARK THE CHANNEL AS GOOD
+	HRRM	F,(A)			; SMASH IT IN
+CHFL2:	ADDI	A,2
+	SOJG	0,CHFL1
+	POPJ	P,			; EXIT
+FLSCH:	HLLOS	F,(A)			; -1 INTO SLOT INDICATES LOSSAGE
+	JRST	CHFL2
+
+
+; THIS ROUTINE MARKS ALL THE CHANNELS
+
+CHFIX:	MOVEI	0,N.CHNS-1
+	MOVEI	A,CHNL1		; SLOTS
+
+DHNFL2:	SKIPN	1(A)
+	JRST	DHNFL1
+	PUSH	P,0		; SAVE 0
+	PUSH	P,A		; SAVE A
+	MOVEI	C,(A)
+	MOVE	A,1(A)
+	MOVEI	B,TCHAN
+	PUSHJ	P,MARK
+	POP	P,A		; RESTORE A
+	POP	P,0		; RESTORE
+DHNFL1:	ADDI	A,2
+	SOJG	0,DHNFL2
+	POPJ	P,
+
+
+
+; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN:	PUSH	P,B		; SAVE TIME
+	MOVEI	B,[ASCIZ /TIME= /]
+	PUSHJ	P,MSGTYP	; PRINT OUT MESSAGE
+	POP	P,B		; RESTORE B
+	FMPRI	B,(100.0)	; CONVERT TO FIX
+	MULI	B,400
+	TSC	B,B
+	ASH	C,-163.(B)
+	MOVEI	A,1		; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+	PUSH	P,C
+	IDIVI	C,10.		; START COUNTING
+	JUMPLE	C,.+2
+	AOJA	A,.-2
+	POP	P,C
+	CAIN	A,1		; SEE IF THERE IS ONLY ONE CHARACTER
+	JRST	DOT1
+FIXOUT:	IDIVI	C,10.		; RECOVER NUMBER
+	HRLM	D,(P)
+	SKIPE	C
+	PUSHJ	P,FIXOUT
+	PUSH	P,A		; SAVE A
+	CAIN	A,2		; DECIMAL POINT HERE?
+	JRST	DOT2
+FIX1:	HLRZ	A,(P)-1		; GET NUMBER
+	ADDI	A,60		; MAKE IT A CHARACTER
+	PUSHJ	P,IMTYO		; OUT IT GOES
+	POP	P,A
+	SOJ	A,
+	POPJ	P,
+DOT1:	MOVEI	A,".		; OUTPUT DECIMAL POINT AND PADDING 0
+	PUSHJ	P,IMTYO
+	MOVEI	A,"0
+	PUSHJ	P,IMTYO
+	JRST	FIXOUT		; CONTINUE
+DOT2:	MOVEI	A,".		; OUTPUT DECIMAL POINT
+	PUSHJ	P,IMTYO
+	JRST	FIX1
+
+
+; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS.  PAIRS ARE PLACED ON THE 
+; RCL LIST, VECTORS ON THE RCLV LIST.
+
+SWEEP:	MOVE	C,GCSTOP		; GET TOP OF GC SPACE
+	SUBI	C,1			; POINT TO FIRST OBJECT
+	SETZB	E,F			; CURRENT SLOT AND CURRENT LENGTH
+LSWEEP:	CAMG	C,GCSBOT		; SKIP IF ABOVE GCSBOT
+	JRST	ESWEEP			; DONE
+	HLRE	A,-1(C)			; SEE IF LIST OR VECTOR
+	TRNE	A,UBIT			; SKIP IF LIST
+	JRST	VSWEEP			; IT IS A VECTOR
+	JUMPGE	A,LSWP1			; JUMP IF NOT MARKED
+	ANDCAM	D,-1(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS		; CONS ON CURRENT OBJECT
+	SUBI	C,2			; SKIP OVER LIST
+	JRST	LSWEEP
+LSWP1:	ADDI	F,2			; ADD TO CURRENT OBJECT COUNT
+	JUMPN	E,LSWP2			; JUMP IF CURRENT OBJECT EXISTS
+	MOVEI	E,(C)			; GET ADDRESS
+LSWP2:	SUBI	C,2
+	JRST	LSWEEP
+
+VSWEEP:	HLRE	A,(C)			; GET LENGTH
+	JUMPGE	A,VSWP1			; SKIP IF MARKED
+	ANDCAM	D,(C)			; TURN OFF MARK BIT
+	PUSHJ	P,SWCONS
+	ANDI	A,377777		; GET LENGTH PART
+	SUBI	C,(A)			; GO PAST VECTOR
+	JRST	LSWEEP
+VSWP1:	ADDI	F,(A)			; ADD LENGTH
+	JUMPN	E,VSWP2
+	MOVEI	E,(C)			; GET NEW OBJECT LOCATION
+VSWP2:	SUBI	C,(A)			; GO BACK PAST VECTOR
+	JRST	LSWEEP
+
+ESWEEP:
+SWCONS:	JUMPE	E,CPOPJ
+	ADDM	F,TOTCNT		; HACK TOTCNT
+	CAMLE	F,MAXLEN		; SEE IF NEW MAXIMUM
+	MOVEM	F,MAXLEN
+	CAIGE	F,2			; MAKE SURE AT LEAST TWO LONG
+	FATAL	SWEEP FAILURE
+	CAIN	F,2
+	JRST	LCONS
+	SETZM	(E)
+	MOVEI	0,(E)
+	SUBI	0,-1(F)
+	SETZM	@0
+	HRLS	0
+	ADDI	0,1
+	BLT	0,-2(E)
+	HRRZ	0,RCLV			; GET VECTOR RECYCLE
+	HRRM	0,(E)			; SMASH INTO LINKING SLOT
+	HRRZM	E,RCLV			; NEW RECYCLE SLOT
+	HRLM	F,(E)
+	MOVSI	F,UBIT
+	MOVEM	F,-1(E)
+	SETZB	E,F
+	POPJ	P,			; DONE
+LCONS:	SETZM	(E)
+	SUBI	E,1
+	HRRZ	0,RCL			; GET RECYCLE LIST
+	HRRZM	0,(E)			; SMASH IN
+	HRRZM	E,RCL
+	SETZB	E,F
+	POPJ	P,
+
+
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT:	[ASCIZ /USER CALLED- /]
+	[ASCIZ /FREE STORAGE- /]
+	[ASCIZ /TP-STACK- /]
+	[ASCIZ /TOP-LEVEL LOCALS- /]
+	[ASCIZ /GLOBAL VALUES- /]
+	[ASCIZ /TYPES- /]
+	[ASCIZ /STATIONARY IMPURE STORAGE- /]
+	[ASCIZ /P-STACK /]
+	[ASCIZ /BOTH STACKS BLOWN- /]
+	[ASCIZ /PURE STORAGE- /]
+	[ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT:	SPBLOK 100
+EGCPAT:	-1
+
+MSGGFT:	[ASCIZ /GC-READ /]
+	[ASCIZ /BLOAT /]
+	[ASCIZ /GROW /]
+	[ASCIZ /LIST /]
+	[ASCIZ /VECTOR /]
+	[ASCIZ /SET /]
+	[ASCIZ /SETG /]
+	[ASCIZ /FREEZE /]
+	[ASCIZ /PURE-PAGE LOADER /]
+	[ASCIZ /GC /]
+	[ASCIZ /INTERRUPT-HANDLER /]
+	[ASCIZ /NEWTYPE /]	
+	[ASCIZ /PURIFY /]
+
+CONSTANTS
+
+HERE
+
+CONSTANTS
+
+OFFSET 0
+
+ZZ==$.+1777
+
+.LOP ANDCM ZZ 1777
+
+ZZ1==.LVAL1
+
+LOC ZZ1
+
+OFFSET OFFS
+
+MRKPDL==.-1
+
+ENDGC:
+
+OFFSET 0
+
+ZZ2==ENDGC-AGCLD
+
+.LOP <ASH @> ZZ2 <,-10.>
+SLENGC==.LVAL1
+.LOP <ASH @> SLENGC <10.>
+RSLENG==.LVAL1
+LOC GCST
+
+.LPUR=$.
+
+END

src/mudsys/arith.mid.94

@@ -0,0 +1,856 @@
+TITLE ARITHMETIC PRIMITIVES FOR MUDDLE
+
+.GLOBAL HI,RLOW,CPLUS,CMINUS,CTIMES,CDIVID,CFIX,CFLOAT
+.GLOBAL CLQ,CGQ,CLEQ,CGEQ,C1Q,C0Q,CMAX,CMIN,CABS,CMOD,CCOS,CSIN,CATAN,CLOG
+.GLOBAL CEXP,CSQRT,CTIME,CORB,CXORB,CANDB,CEQVB,CRAND,CLSH,CROT,
+.GLOBAL SAT,BFLOAT,FLGSET
+
+;BKD
+
+;DEFINES MUDDLE PRIMITIVES:   FIX,FLOAT,ATAN,IEXP,LOG,
+;	G?,L?,0?,1?,+,-,*,/,MAX,MIN,ABS,SIN,COS,SQRT,RANDOM,
+;	TIME,SORT.
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+O=0
+
+
+DEFINE	TYP1
+	(AB) TERMIN
+DEFINE VAL1
+	(AB)+1 TERMIN
+
+DEFINE	TYP2
+	(AB)+2 TERMIN
+DEFINE	VAL2
+	(AB)+3 TERMIN
+
+DEFINE	TYP3
+	(AB)+4 TERMIN
+DEFINE	VAL3
+	(AB)+5 TERMIN
+
+DEFINE	TYPN
+	(D) TERMIN
+DEFINE	VALN
+	(D)+1 TERMIN
+
+
+YES:	MOVSI	A,TATOM		;RETURN PATH FOR 'TRUE'
+	MOVE	B,IMQUOTE T
+	AOS	(P)
+	POPJ	P,
+
+NO:	MOVSI	A,TFALSE	;RETURN PATH FOR 'FALSE'
+	MOVEI	B,NIL
+	POPJ	P,
+
+;ERROR RETURNS AND OTHER UTILITY ROUTINES
+
+OVRFLW==10
+OVRFLD:	ERRUUO	EQUOTE OVERFLOW
+
+CARGCH:	GETYP	0,A		; GET TYPE
+	CAIN	0,TFLOAT
+	POPJ	P,
+	JSP	A,BFLOAT
+	POPJ	P,
+
+ARGCHK:			;CHECK FOR SINGLE FIXED OR FLOATING
+			;ARGUMENT IF FIXED CONVERT TO FLOATING
+			;RETURN FLOATING ARGRUMENT IN B ALWAYS
+	ENTRY	1
+	GETYP	C,TYP1	
+	MOVE	B,VAL1
+	CAIN	C,TFLOAT	;FLOATING?
+	POPJ	P,		;YES, RETURN
+	CAIE	C,TFIX		;FIXED?
+	JRST	WTYP1		;NO, ERROR
+	JSP	A,BFLOAT	;YES, CONVERT TO FLOATING AND RETURN
+	POPJ	P,
+
+OUTRNG:	ERRUUO	EQUOTE ARGUMENT-OUT-OF-RANGE
+
+NSQRT:	ERRUUO	EQUOTE NEGATIVE-ARGUMENT
+
+DEFINE MFLOAT AC
+	IDIVI	AC,400000
+	FSC	AC+1,233
+	FSC	AC,254
+	FADR	AC,AC+1
+	TERMIN
+
+BFLOAT:	MFLOAT 	B
+	JRST	(A)
+
+OFLOAT:	MFLOAT	O
+	JRST	(C)
+
+BFIX:	MULI	B,400
+	TSC	B,B
+	ASH	C,(B)-243
+	MOVE	B,C
+	JRST	(A)
+
+;DISPATCH TABLES USED TO CONTROL THE FLOW OF THE VARIOUS PRIMITIVES
+
+TABLE2:	SETZ	NO		;TABLE2 (0)
+TABLE3:	SETZ	YES		;TABLE2 (1)  &  TABLE3 (0)
+	SETZ	NO		;TABLE2 (2)
+	SETZ	YES
+	SETZ	NO
+
+TABLE4:	SETZ	NO
+	SETZ	NO
+	SETZ	YES
+	SETZ	YES
+
+
+
+FUNC:	JSP	A,BFIX
+	JSP	A,BFLOAT
+	SUB	B,VALN
+	IDIV	B,VALN
+	ADD	B,VALN
+	IMUL	B,VALN
+	JSP	C,SWITCH
+	JSP	C,SWITCH
+
+
+
+FLFUNC==.-2
+	FSBR	B,O
+	FDVR	B,O
+	FADR	B,O
+	FMPR	B,O
+	JSP	C,FLSWCH
+	JSP	C,FLSWCH
+
+DEFVAL==.-2
+	0
+	1
+	0
+	1
+	377777,,-1
+	400000,,1
+
+DEFTYP==.-2
+	TFIX,,
+	TFIX,,
+	TFIX,,
+	TFIX,,
+	TFLOAT,,
+	TFLOAT,,
+;PRIMITIVES FLOAT AND FIX
+
+IMFUNCTION	FIX,SUBR
+
+	ENTRY	1
+
+	JSP	C,FXFL
+	MOVE	B,1(AB)
+	CAIE	A,TFIX
+	JSP	A,BFIX
+	MOVSI	A,TFIX
+	JRST	FINIS
+
+IMFUNCTION	FLOAT,SUBR
+
+	ENTRY	1
+
+	JSP	C,FXFL
+	MOVE	B,1(AB)
+	CAIE	A,TFLOAT
+	JSP	A,BFLOAT
+	MOVSI	A,TFLOAT
+	JRST	FINIS
+
+CFIX:	GETYP	0,A
+	CAIN	0,TFIX
+	POPJ	P,
+	JSP	A,BFIX
+	MOVSI	A,TFIX
+	POPJ	P,
+
+CFLOAT:	GETYP	0,A
+	CAIN	0,TFLOAT
+	POPJ	P,
+	JSP	A,BFLOAT
+	MOVSI	A,TFLOAT
+	POPJ	P,
+
+FXFL:	GETYP	A,(AB)
+	CAIE	A,TFIX
+	CAIN	A,TFLOAT
+	JRST	(C)
+	JRST	WTYP1
+
+
+MFUNCTION	ABS,SUBR
+	ENTRY	1
+	GETYP	A,TYP1
+	CAIE	A,TFIX
+	CAIN	A,TFLOAT
+	JRST	MOVIT
+	JRST	WTYP1
+MOVIT:	MOVM	B,VAL1		;GET ABSOLUTE VALUE OF ARGUMENT
+AFINIS:	HRLZS	A		;MOVE TYPE CODE INTO LEFT HALF
+	JRST	FINIS
+
+
+
+MFUNCTION	MOD,SUBR
+	ENTRY	2
+	GETYP	A,TYP1
+	CAIE	A,TFIX		;FIRST ARG FIXED ?
+	JRST	WTYP1
+	GETYP	A,TYP2
+	CAIE	A,TFIX		;SECOND ARG FIXED ?
+	JRST	WTYP2
+	MOVE	A,VAL1
+	IDIV	A,VAL2		;FORM QUOTIENT & REMAINDER
+	JUMPGE	B,.+2		;Only return positive remainders
+	ADD	B,VAL2
+	MOVSI	A,TFIX
+	JRST	FINIS
+;PRIMITIVES PLUS, DIFFERENCE, TIMES, DIVIDE, MIN, AND MAX
+
+MFUNCTION	MIN,SUBR
+	
+	ENTRY
+
+	MOVEI	E,6
+	JRST	GOPT
+
+IMFUNCTION	MAX,SUBR
+
+	ENTRY
+
+	MOVEI	E,7
+	JRST	GOPT
+
+MFUNCTION	DIVIDE,SUBR,[/]
+
+	ENTRY
+
+	MOVEI	E,3
+	JRST	GOPT
+
+MFUNCTION	DIFFERENCE,SUBR,[-]
+
+	ENTRY
+
+	MOVEI	E,2
+	JRST	GOPT
+
+IMFUNCTION	TIMES,SUBR,[*]
+
+	ENTRY
+
+	MOVEI	E,5
+	JRST	GOPT
+
+MFUNCTION	PLUS,SUBR,[+]
+
+	ENTRY
+
+	MOVEI	E,4
+
+GOPT:	MOVE	D,AB		;ARGUMENT POINTER
+	HLRE	A,AB
+	MOVMS	A
+	ASH	A,-1
+	PUSHJ	P,CARITH
+	JRST	FINIS
+
+; BUILD COMPILER ENTRIES TO THESE ROUTINES
+
+IRP NAME,,[CMINUS,CDIVID,CPLUS,CTIMES,CMIN,CMAX]CODE,,[2,3,4,5,6,7]
+
+NAME:	MOVEI	E,CODE
+	JRST	CARIT1
+TERMIN
+
+CARIT1:	MOVEI	D,(A)
+	ASH	D,1		; TIMES 2
+	HRLI	D,(D)
+	SUBM	TP,D		; POINT TO ARGS
+	PUSH	TP,$TTP
+	AOBJN	D,.+1
+	PUSH	TP,D
+	PUSHJ	P,CARITH
+	MOVE	TP,(TP)
+	SUB	TP,[1,,1]
+	POPJ	P,
+
+CARITH:	MOVE	B,DEFVAL(E)	; GET VAL
+	JFCL	OVRFLW,.+1
+	MOVEI	0,TFIX		; FIX UNTIL CHANGE
+	JUMPN	A,ARITH0	; AT LEAST ONE ARG
+	MOVE	A,DEFTYP(E)
+	POPJ	P,
+
+ARITH0:	SOJE	A,ARITH1	; FALL IN WITH ONE ARG
+	MOVE	B,1(D)
+	GETYP	C,(D)		; TYPE OF 1ST ARG
+	ADD	D,[2,,2]	; GO TO NEXT
+	CAIN	C,TFLOAT
+	JRST	ARITH3
+	CAIN	C,TFIX
+	JRST	ARITH1
+	JRST	WRONGT
+
+ARITH1:	GETYP	C,0(D)		; GET NEXT TYPE
+	CAIE	C,TFIX
+	JRST	ARITH2		; TO FLOAT LOOP
+	XCT	FUNC(E)		; DO IT
+	ADD	D,[2,,2]
+	SOJG	A,ARITH1	; KEEP ADDING OR WHATEVER
+	SKIPE	OVFLG
+	JFCL	OVRFLW,OVRFLD
+	MOVSI	A,TFIX
+	POPJ	P,
+
+ARITH3:	GETYP	C,0(D)
+	MOVE	0,1(D)		; GET ARG
+	CAIE	C,TFIX
+	JRST	ARITH4
+	PUSH	P,A
+	JSP	C,OFLOAT	; FLOAT IT
+	POP	P,A
+	JRST	ARITH5
+ARITH4:	CAIE	C,TFLOAT
+	JRST	WRONGT
+	JRST	ARITH5
+
+ARITH2:	CAIE	C,TFLOAT	; FLOATER?
+	JRST	WRONGT
+	PUSH	P,A
+	JSP	A,BFLOAT
+	POP	P,A
+	MOVE	0,1(D)
+
+ARITH5:	XCT	FLFUNC(E)
+	ADD	D,[2,,2]
+	SOJG	A,ARITH3
+
+	SKIPE	OVFLG
+	JFCL	OVRFLW,OVRFLD
+	MOVSI	A,TFLOAT
+	POPJ	P,
+
+SWITCH:	XCT	COMPAR(E)	;FOR MAX & MIN TESTING
+	MOVE	B,VALN
+	JRST	(C)
+COMPAR==.-6
+	CAMLE	B,VALN
+	CAMGE	B,VALN
+
+
+
+FLSWCH:	XCT	FLCMPR(E)
+	MOVE	B,O
+	JRST	(C)
+FLCMPR==.-6
+	CAMLE	B,O
+	CAMGE	B,O
+;PRIMITIVES ONEP AND ZEROP
+
+MFUNCTION	ONEP,SUBR,[1?]
+	MOVEI	E,1
+	JRST	JOIN
+
+MFUNCTION	ZEROP,SUBR,[0?]
+	MOVEI	E,
+
+JOIN:	ENTRY 1
+	GETYP	A,TYP1
+	CAIN	A,TFIX	;fixed ?
+	JRST	TESTFX
+	CAIE	A,TFLOAT	;floating ?
+	JRST	WTYP1
+	MOVE	B,VAL1
+	CAMN	B,NUMBR(E)	;equal to correct value ?
+	JRST	YES1
+	JRST	NO1
+
+TESTFX:	CAMN	E,VAL1	;equal to correct value ?
+	JRST	YES1
+
+NO1:	MOVSI	A,TFALSE
+	MOVEI	B,0
+	JRST	FINIS
+
+YES1:	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS
+
+NUMBR:	0	;FLOATING PT  ZERO
+	201400,,0	;FLOATING PT ONE
+;PRIMITIVES LESSP AND GREATERP
+
+MFUNCTION	LEQP,SUBR,[L=?]
+	MOVEI	E,3
+	JRST	ARGS
+
+MFUNCTION	GEQP,SUBR,[G=?]
+	MOVEI	E,2
+	JRST	ARGS
+
+
+MFUNCTION	LESSP,SUBR,[L?]
+	MOVEI	E,1
+	JRST	ARGS
+
+MFUNCTION	GREATERP,SUBR,[G?]
+	MOVEI	E,0
+
+ARGS:	ENTRY 2
+	MOVE	B,VAL1
+	MOVE	A,TYP1
+	GETYP	0,A
+	PUSHJ	P,CMPTYP
+	JRST	WTYP1
+	MOVE	D,VAL2
+	MOVE	C,TYP2
+	GETYP	0,C
+	PUSHJ	P,CMPTYP
+	JRST	WTYP2
+	PUSHJ	P,ACOMPS
+	JFCL
+	JRST	FINIS
+
+; COMPILERS ENTRIES TO THESE GUYS
+
+IRP NAME,,[CGQ,CLQ,CGEQ,CLEQ]COD,,[0,1,2,3]
+
+NAME:	MOVEI	E,COD
+	JRST	ACOMPS
+TERMIN
+
+ACOMPS:	GETYP	A,A
+	GETYP	0,C
+	CAIE	0,(A)
+	JRST	COMPD		; COMPARING FIX AND FLOAT
+TEST:	CAMN	B,D
+	JRST	@TABLE4(E)
+	CAMG	B,D
+	JRST	@TABLE2(E)
+	JRST	@TABLE3(E)
+
+CMPTYP:	CAIE	0,TFIX
+	CAIN	0,TFLOAT
+	AOS	(P)
+	POPJ	P,
+COMPD:	EXCH	B,D
+	CAIN	A,TFLOAT
+	JSP	A,BFLOAT
+	EXCH	B,D
+	CAIN	0,TFLOAT
+	JSP	A,BFLOAT
+COMPF:	JRST	TEST
+
+MFUNCTION RANDOM,SUBR
+	ENTRY
+	HLRE	A,AB
+	CAMGE	A,[-4]		;At most two arguments to random to set seeds
+	JRST	TMA
+	JRST	RANDGO(A)
+	MOVE	B,VAL2		;Set second seed
+	MOVEM	B,RLOW
+	MOVE	A,VAL1		;Set first seed
+	MOVEM	A,RHI
+RANDGO:	PUSHJ	P,CRAND
+	JRST	FINIS
+
+CRAND:	MOVE	A,RHI
+	MOVE	B,RLOW
+	MOVEM	A,RLOW		;Update Low seed
+	LSHC	A,-1		;Shift both right one bit
+	XORB	B,RHI		;Generate output and update High seed
+	MOVSI	A,TFIX
+	POPJ	P,
+
+
+MFUNCTION SQRT,SUBR
+	PUSHJ	P,ARGCHK
+	JUMPL	B,NSQRT
+	PUSHJ	P,ISQRT
+	JRST	FINIS
+
+ISQRT:	MOVE	A,B
+	ASH	B,-1
+	FSC	B,100
+SQ2:	MOVE	C,B	;NEWTON'S METHOD, SPECINER'S HACK.
+	FDVRM	A,B
+	FADRM	C,B
+	FSC	B,-1
+	CAME	C,B
+	JRST	SQ2
+	MOVSI	A,TFLOAT
+	POPJ	P,
+
+MFUNCTION COS,SUBR
+	PUSHJ	P,ARGCHK
+	FADR	B,[1.570796326]		;COS(X)=SIN (X+PI/2)
+	PUSHJ	P,.SIN
+	MOVSI	A,TFLOAT
+	JRST	FINIS
+
+MFUNCTION SIN,SUBR
+	PUSHJ	P,ARGCHK
+	PUSHJ	P,.SIN
+	MOVSI	A,TFLOAT
+	JRST	FINIS
+
+.SIN:	MOVM	A,B
+	CAMG	A,[.0001]
+	POPJ	P,		;GOSPER'S RECURSIVE SIN.
+	FDVR	B,[-3.0]	;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3)
+	PUSHJ	P,.SIN
+	FSC	A,1
+	FMPR	A,A
+	FADR	A,[-3.0]
+	FMPRB	A,B
+	POPJ	P,
+
+CSQRT:	PUSHJ	P,CARGCH
+	JUMPL	B,NSQRT
+	JRST	ISQRT
+
+CSIN:	PUSHJ	P,CARGCH
+CSIN1:	PUSHJ	P,.SIN
+	MOVSI	A,TFLOAT
+	POPJ	P,
+
+CCOS:	PUSHJ	P,CARGCH
+	FADR	B,[1.570796326]
+	JRST	CSIN1
+MFUNCTION	LOG,SUBR
+	PUSHJ	P,ARGCHK	;LEAVES ARGUMENT IN B
+	PUSHJ	P,ILOG
+	JRST	FINIS
+
+CLOG:	PUSHJ	P,CARGCH
+
+ILOG:	JUMPLE	B,OUTRNG
+	LDB	D,[331100,,B]	;GRAB EXPONENT
+	SUBI	D,201		;REMOVE BIAS
+	TLZ	B,777000	;SET EXPONENT
+	TLO	B,201000	; TO 1
+	MOVE	A,B
+	FSBR	A,RT2
+	FADR	B,RT2
+	FDVB	A,B
+	FMPR	B,B
+	MOVE	C,[0.434259751]
+	FMPR	C,B
+	FADR	C,[0.576584342]
+	FMPR	C,B
+	FADR	C,[0.961800762]
+	FMPR	C,B
+	FADR	C,[2.88539007]
+	FMPR	C,A
+	FADR	C,[0.5]
+	MOVE	B,D
+	FSC	B,233
+	FADR	B,C
+	FMPR	B,[0.693147180]	;LOG E OF 2
+	MOVSI	A,TFLOAT
+	POPJ	P,
+
+RT2:	1.41421356
+MFUNCTION	ATAN,SUBR
+	PUSHJ	P,ARGCHK
+	PUSHJ	P,IATAN
+	JRST	FINIS
+
+CATAN:	PUSHJ	P,CARGCH
+
+IATAN:	PUSH	P,B
+	MOVM	D,B
+	CAMG	D,[0.4^-8]	;SMALL ENOUGH SO ATAN(X)=X?
+	JRST	ATAN3		;YES
+	CAML	D,[7.0^7]	;LARGE ENOUGH SO THAT ATAN(X)=PI/2?
+	JRST	ATAN1		;YES
+	MOVN	C,[1.0]
+	CAMLE	D,[1.0]		;IS ABS(X)<1.0?
+	FDVM	C,D		;NO,SCALE IT DOWN
+	MOVE	B,D
+	FMPR	B,B
+	MOVE	C,[1.44863154]
+	FADR	C,B
+	MOVE	A,[-0.264768620]
+	FDVM	A,C
+	FADR	C,B
+	FADR	C,[3.31633543]
+	MOVE	A,[-7.10676005]
+	FDVM	A,C
+	FADR	C,B
+	FADR	C,[6.76213924]
+	MOVE	B,[3.70925626]
+	FDVR	B,C
+	FADR	B,[0.174655439]
+	FMPR	B,D
+	JUMPG	D,ATAN2		;WAS ARG SCALED?
+	FADR	B,PI2		;YES,  ATAN(X)=PI/2-ATAN(1/X)
+	JRST	ATAN2
+ATAN1:	MOVE	B,PI2
+ATAN2:	SKIPGE	(P)		;WAS INPUT NEGATIVE?
+	MOVNS	B		;YES,COMPLEMENT
+ATAN3:	MOVSI	A,TFLOAT	
+	SUB	P,[1,,1]
+	POPJ	P,
+
+PI2:	1.57079632
+MFUNCTION	IEXP,SUBR,[EXP]	
+	PUSHJ	P,ARGCHK	;LEAVE FLOATING POINT ARG IN B
+	PUSHJ	P,IIEXP
+	JRST	FINIS
+
+CEXP:	PUSHJ	P,CARGCH
+
+IIEXP:	PUSH	P,B
+	MOVM	A,B
+	SETZM	B
+	FMPR	A,[0.434294481]	;LOG BASE 10 OF E
+	MOVE	D,[1.0]
+	CAMG	A,D
+	JRST	RATEX
+	MULI	A,400
+	ASHC	B,-243(A)
+	CAILE	B,43
+	JRST	OUTRNG
+	CAILE	B,7
+	JRST	EXPR2
+EXPR1:	FMPR	D,FLOAP1(B)
+	LDB	A,[103300,,C]	
+	SKIPE	A
+	TLO	A,177000
+	FADR	A,A
+RATEX:	MOVEI	B,7
+	SETZM	C
+RATEY:	FADR	C,COEF2-1(B)
+	FMPR	C,A
+	SOJN	B,RATEY
+	FADR	C,[1.0]	
+	FMPR	C,C
+	FMPR	D,C
+	MOVE	B,[1.0]
+	SKIPL	(P)		;SKIP IF INPUT NEGATIVE
+	SKIPN	B,D
+	FDVR	B,D
+	MOVSI	A,TFLOAT
+	SUB	P,[1,,1]
+	POPJ	P,
+
+EXPR2:	LDB	E,[030300,,B]	
+	ANDI	B,7
+	MOVE	D,FLOAP1(E)
+	FMPR	D,D		;TO THE 8TH POWER
+	FMPR	D,D
+	FMPR	D,D
+	JRST	EXPR1
+
+COEF2:	1.15129278
+	0.662730884
+	0.254393575
+	0.0729517367
+	0.0174211199
+	2.55491796^-3
+	9.3264267^-4
+
+FLOAP1:	1.0
+	10.0
+	100.0
+	1000.0
+	10000.0
+	100000.0
+	1000000.0
+	10000000.0
+
+;LSH AND ROT (ERB WOULD BE PLEASED) PDL 2/22/79
+
+MFUNCTION %LSH,SUBR,LSH
+	ENTRY	2
+	MOVE	C,[LSH B,(A)]
+	JRST	LSHROT
+
+MFUNCTION %ROT,SUBR,ROT
+	ENTRY	2
+	MOVE	C,[ROT B,(A)]
+LSHROT:	GETYP	A,(AB)
+	PUSHJ	P,SAT
+	CAIE	A,S1WORD
+	 JRST	WRONGT
+	GETYP	A,2(AB)
+	CAIE	A,TFIX
+	 JRST	WTYP2
+	MOVE	A,3(AB)
+	MOVE	B,1(AB)
+	XCT	C
+	MOVE	A,$TWORD
+       	JRST	FINIS
+
+;BITWISE BOOLEAN FUNCTIONS
+
+MFUNCTION %ANDB,SUBR,ANDB
+	ENTRY
+	HRREI	B,-1		;START ANDING WITH ALL ONES
+	MOVE	D,[AND B,A]	;LOGICAL INSTRUCTION
+	JRST	LOGFUN		;DO THE OPERATION
+
+MFUNCTION %ORB,SUBR,ORB
+	ENTRY
+	MOVEI	B,0
+	MOVE	D,[IOR B,A]
+	JRST	LOGFUN
+
+MFUNCTION %XORB,SUBR,XORB
+	ENTRY
+	MOVEI	B,0
+	MOVE	D,[XOR B,A]
+	JRST	LOGFUN
+
+MFUNCTION %EQVB,SUBR,EQVB
+	ENTRY
+	HRREI	B,-1
+	MOVE	D,[EQV B,A]
+
+LOGFUN:	JUMPGE	AB,ZROARG
+LOGTYP:	GETYP	A,(AB)		;GRAB THE TYPE
+	PUSHJ	P,SAT		;STORAGE ALLOCATION TYPE
+	CAIE	A,S1WORD
+	JRST	WRONGT		;WRONG TYPE...LOSE
+	MOVE	A,1(AB)		;LOAD ARG INTO A
+	XCT	D		;DO THE LOGICAL OPERATION
+	AOBJP	AB,.+2		;ADD ONE TO BOTH HALVES
+	AOBJN	AB,LOGTYP	;ADD AGAIN AND LOOP IF NEEDED
+
+ZROARG:	MOVE	A,$TWORD
+	JRST	FINIS
+REPEAT 0,[
+;routine to sort lists or vectors of either fixed point or floating numbers
+;the components are interchanged repeatedly to acheive the sort
+;first arg:	the structure to be sorted
+;if no second arg sort in descending order
+;second arg:	if false then sort in ascending order
+;		else sort in descending order
+
+MFUNCTION	SORT,SUBR
+	ENTRY 
+	HLRZ	A,AB
+	CAIGE	A,-4		;Only two arguments allowed
+	JRST	TMA
+	MOVE	O,DESCEND	;Set up "O" to test for descending order as default condition
+	CAIE	A,-4		;Optional second argument?
+	JRST	.+4
+	GETYP	B,TYP2		;See if it is other than false
+	CAIN	B,TFALSE
+	MOVE	O,ASCEND	;Set up "O" to test for ascending order
+	GETYP	A,TYP1		;CHECK TYPE OF FIRST ARGUMENT
+	CAIN	A,TLIST
+	JRST	LSORT
+	CAIN	A,TVEC
+	JRST	VSORT
+	JRST	WTYP1
+
+
+
+
+GOBACK:	MOVE	A,TYP1		;RETURN THE SORTED ARGUMENT AS VALUE
+	MOVE	B,VAL1
+	JRST	FINIS
+
+DESCEND:	CAMG	C,(A)+1
+ASCEND:		CAML	C,(A)+1
+;ROUTINE TO SORT LISTS IN NUMERICAL ORDER
+
+LSORT:	MOVE	A,VAL1
+	JUMPE	A,GOBACK	;EMPTY LIST?
+	HLRZ	B,(A)		;TYPE OF FIRST COMPONENT
+	CAIE	B,TFIX
+	CAIN	B,TFLOAT
+	SKIPA
+	JRST	WRONGT
+	MOVEI	E,0		;FOR COUNT OF LENGTH OF LIST
+LCOUNT:	JUMPE	A,LLSORT	;REACHED END OF LIST?
+	MOVE	A,(A)		;NEXT COMPONENT
+	TLZ	A,(B)		;SAME TYPE AS FIRST COMPONENT?
+	TLNE	A,-1
+	JRST	WRONGT
+	AOJA	E,LCOUNT	;INCREMENT COUNT AND CONTINUE
+
+LLSORT:	SOJE	E,GOBACK	;FINISHED WITH SORTING?
+	HRRZ	A,VAL1		;START THIS LOOP OF SORTING AT THE BEGINNING
+	MOVEM	E,(P)+1		;Save the iteration depth
+CLSORT:	HRRZ	B,(A)		;NEXT COMPONENT
+	MOVE	C,(B)+1		;ITS VALUE
+	XCT	O		;ARE THESE TWO COMPONENTS IN ORDER?
+	JRST	.+4
+	MOVE	D,(A)+1		;INTERCHANGE THEM
+	MOVEM	D,(B)+1
+	MOVEM	C,(A)+1
+	MOVE	A,B		;MAKE THE COMPONENT IN "B" THE CURRENT ONE
+	SOJG	E,CLSORT
+	MOVE	E,(P)+1		;Restore the iteration depth
+	JRST	LLSORT
+;ROUTINE TO SORT VECTORS IN NUMERICAL ORDER
+
+VSORT:	HLRE	D,VAL1		;GET COUNT FIELD OF VECTOR
+	IDIV	D,[-2]		;LENGTH
+	JUMPE	D,GOBACK	;EMPTY VECTOR?
+	MOVE	E,D		;SAVE LENGTH IN "E"
+	HRRZ	A,VAL1		;POINTER TO VECTOR
+	MOVE	B,(A)		;TYPE OF FIRST COMPONENT
+	CAME	B,$TFIX
+	CAMN	B,$TFLOAT
+	SKIPA
+	JRST	WRONGT
+	SOJLE	D,GOBACK	;IF ONLY ONE COMPONENT THEN FINISHED
+VCOUNT:	ADDI	A,2		;CHECK NEXT COMPONENT
+	CAME	B,(A)		;SAME TYPE AS FIRST COMPONENT?
+	JRST	WRONGT
+	SOJG	D,VCOUNT	;CONTINUE WITH NEXT COMPONENT
+
+VVSORT:	SOJE	E,GOBACK	;FINISHED SORTING?
+	HRRZ	A,VAL1		;START THIS LOOP OF SORTING AT THE BEGINNING
+	MOVEM	E,(P)+1		;Save the iteration depth
+CVSORT:	MOVE	C,(A)+3		;VALUE OF NEXT COMPONENT
+	XCT	O		;ARE THESE TWO COMPONENTS IN ORDER?
+	JRST	.+4
+	MOVE	D,(A)+1		;INTERCHANGE THEM
+	MOVEM	D,(A)+3
+	MOVEM	C,(A)+1
+	ADDI	A,2		;UPDATE THE CURRENT COMPONENT
+	SOJG	E,CVSORT
+	MOVE	E,(P)+1		;Restore the iteration depth
+	JRST	VVSORT
+]
+
+MFUNCTION OVERFLOW,SUBR
+
+	ENTRY
+
+	MOVEI	E,OVFLG
+	JRST	FLGSET
+	
+
+MFUNCTION TIME,SUBR
+	ENTRY
+	PUSHJ	P,CTIME
+	JRST	FINIS
+
+IMPURE
+
+RHI:	267762113337
+RLOW:	155256071112
+OVFLG:	-1
+PURE
+
+
+END
+

src/mudsys/assem.all.7

@@ -0,0 +1,115 @@
+LOGIN CLRt
+CONN INT:
+MIDAS
+AGC BIN_AGC MID
+RESET MIDAS
+MIDAS
+AGCMRK BIN_AGCMRK MID
+RESET MIDAS
+MIDAS
+AMSGC BIN_AMSGC MID
+RESET MIDAS
+MIDAS
+ARITH BIN_ARITH MID
+RESET MIDAS
+MIDAS
+ATOMHK BIN_ATOMHK MID
+RESET MIDAS
+MIDAS
+BUFMOD BIN_BUFMOD MID
+RESET MIDAS
+MIDAS
+CORE BIN_CORE MID
+RESET MIDAS
+MIDAS
+CREATE BIN_CREATE MID
+RESET MIDAS
+MIDAS
+DECL BIN_DECL MID
+RESET MIDAS
+MIDAS
+EVAL BIN_EVAL MID
+RESET MIDAS
+MIDAS
+FOPEN BIN_FOPEN MID
+RESET MIDAS
+MIDAS
+GCHACK BIN_GCHACK MID
+RESET MIDAS
+MIDAS
+INITM BIN_INITM MID
+RESET MIDAS
+MIDAS
+INTERR BIN_INTERR MID
+RESET MIDAS
+MIDAS
+IPC BIN_IPC MID
+RESET MIDAS
+MIDAS
+LDGC BIN_LDGC MID
+RESET MIDAS
+MIDAS
+MAIN BIN_MAIN MID
+RESET MIDAS
+MIDAS
+MAPPUR BIN_MAPPUR MID
+RESET MIDAS
+MIDAS
+MAPS BIN_MAPS MID
+RESET MIDAS
+MIDAS
+MUDEX BIN_MUDEX MID
+RESET MIDAS
+MIDAS
+MUDITS BIN_MUDITS MID
+RESET MIDAS
+MIDAS
+MUDSQU BIN_MUDSQU MID
+RESET MIDAS
+MIDAS
+NFREE BIN_NFREE MID
+RESET MIDAS
+MIDAS
+PRIMIT BIN_PRIMIT MID
+RESET MIDAS
+MIDAS
+PRINT BIN_PRINT MID
+RESET MIDAS
+MIDAS
+PURE BIN_PURE MID
+RESET MIDAS
+MIDAS
+PUTGET BIN_PUTGET MID
+RESET MIDAS
+MIDAS
+PXCORE BIN_PXCORE MID
+RESET MIDAS
+MIDAS
+READCH BIN_READCH MID
+RESET MIDAS
+MIDAS
+READER BIN_READER MID
+RESET MIDAS
+MIDAS
+SAVE BIN_SAVE MID
+RESET MIDAS
+MIDAS
+SPECS BIN_SPECS MID
+RESET MIDAS
+MIDAS
+STBUIL BIN_STBUIL MID
+RESET MIDAS
+MIDAS
+STENEX BIN_STENEX MID
+RESET MIDAS
+MIDAS
+TMUDV BIN_TMUDV MID
+RESET MIDAS
+MIDAS
+TXPURE BIN_TXPURE MID
+RESET MIDAS
+MIDAS
+UTILIT BIN_UTILIT MID
+RESET MIDAS
+MIDAS
+UUOH BIN_UUOH MID

src/mudsys/bufmod.mid.4

@@ -0,0 +1,18 @@
+TITLE BUFMOD BUFFER MODULE
+
+RELOCA
+
+; HERE TO DEFINE MUDDLES BUFFER SPACE
+
+.GLOBAL STRBUF,STRPAG
+
+HERE==$.+1777
+
+.LOP ANDCM HERE 1777
+
+STRBUF==.LVAL1
+.LOP <ASH @> STRBUF <,-10.>
+STRPAG==.LVAL1
+
+END
+

src/mudsys/chess.script.1

@@ -0,0 +1,171 @@
+%% 30 December 1980 23:47:54
+Type ? for help.
+White to move: p-k4
+Black to move: pb
+1.   ... P-K4   ; (1.0 85%)
+White to move: p-q3
+2.   ... P-Q4   ; (1.7 93%)
+White to move: n-kb4
+; Impossible
+White to move: n-kb3
+; T-reject B-Q3
+3.   ... N-QB3   ; (3.8 91%)
+White to move: b-k2
+4.   ... P-Q5   ; (3.0 94%)
+White to move: o-o
+; T-reject N-QN5
+5.   ... B-Q3   ; (6.9 94%)
+White to move: p-qb3
+; Foo!
+6.   ... PxP   ; (3.0 91%)
+White to move: nxp(qb3)
+; T-reject N-Q5
+7.   ... B-QN5   ; (8.3 88%)
+White to move: b-n5
+8.   ... N-KB3   ; (3.4 91%)
+White to move: p-qr3
+9.   ... B-QB4   ; (5.1 95%)
+White to move: p-qn4
+10.   ... B-QN3   ; (5.4 92%)
+White to move: q-r4
+11.   ... O-O   ; (4.4 92%)
+White to move: p-n5
+; T-reject N-Q5 N-QR4 N-QN1 ...
+; Foo!
+12.   ... N-Q5   ; (11.6 90%)
+White to move: r-k1
+; Ambiguous
+White to move: r(b1)-k1
+13.   ... NxB+   ; (3.9 94%)
+White to move: rxn
+14.   ... QxP   ; (4.6 77%)
+White to move: q-b2
+15.   ... Q-Q3   ; (6.3 87%)
+White to move: r-q1
+; T-reject QxP
+16.   ... Q-QB4   ; (9.5 91%)
+White to move: r(k2)-q2
+; T-reject QxP(QR6)
+17.   ... B-QR4   ; (7.0 92%)
+White to move: r-q8
+18.   ... QxN   ; (6.1 95%)
+White to move: qxq
+19.   ... BxQ   ; (3.5 92%)
+White to move: b-k3
+20.   ... NxP   ; (5.4 90%)
+White to move: nxp
+21.   ... BxN   ; (4.5 91%)
+White to move: p-b3
+22.   ... N-QB6   ; (4.6 95%)
+White to move: r-q2
+; Ambiguous
+White to move: r(q1)-q2
+; T-reject NxP
+; M-reject RxR
+23.   ... NxP   ; (6.3 86%)
+White to move: b-b5
+; M-reject RxR
+24.   ... B-Q3   ; (19.7 91%)
+White to move: bxb
+25.   ... RxR   ; (2.8 92%)
+White to move: u
+Black to move: u
+White to move: rxr
+Black to move: pb
+25.   ... BxR   ; (1.6 95%)
+White to move: bxb
+26.   ... KxB   ; (2.2 94%)
+White to move: r-q8
+27.   ... K-K2   ; (0.0 92%)
+White to move: r-r8
+28.   ... NxP   ; (1.6 94%)
+White to move: rxp
+29.   ... P-KN4   ; (3.2 91%)
+White to move: r-r6
+30.   ... R-QN1   ; (1.9 90%)
+White to move: k-b2
+31.   ... K-Q2   ; (3.2 89%)
+White to move: r-b6
+; Ambiguous
+White to move: r-kb6
+32.   ... K-K2   ; (1.6 93%)
+White to move: r-b5
+33.   ... BxR   ; (1.4 96%)
+White to move: u
+Black to move: u
+White to move: r-r6
+; Ambiguous
+White to move: r-kr6
+Black to move: pb
+33.   ... K-Q2   ; (3.2 95%)
+White to move: k-k3
+34.   ... P-QB4   ; (5.0 91%)
+White to move: k-q3
+35.   ... K-QB2   ; (1.8 88%)
+White to move: k-b3
+36.   ... P-QB5   ; (2.2 87%)
+White to move: k-n4
+; T-reject N-QN8 N-QB7+
+; Foo!
+37.   ... N-QN8   ; (3.2 88%)
+White to move: kxp
+38.   ... P-QN4+   ; (1.8 96%)
+White to move: k-n4
+; T-reject K-QN2 R-QR1
+39.   ... P-KB4   ; (3.4 92%)
+White to move: r-kn6
+40.   ... P-KN5   ; (2.0 76%)
+White to move: pxp
+41.   ... PxP   ; (1.8 95%)
+White to move: r-n7
+42.   ... K-QN3   ; (1.2 96%)
+White to move: r-b7
+; Ambiguous
+White to move: r-kb7
+43.   ... R-QR1   ; (2.3 95%)
+White to move: r-b1
+44.   ... N-Q7   ; (2.4 85%)
+White to move: r-q1
+45.   ... N-K5   ; (3.7 72%)
+White to move: p-r3
+46.   ... PxP   ; (2.7 95%)
+White to move: pxp
+47.   ... BxP   ; (2.5 90%)
+White to move: r-q3
+48.   ... N-KB7   ; (4.4 87%)
+White to move: rq-6
+; Move what??
+White to move: r-q6
+; T-reject K-QB2 K-QN2
+; Foo!
+49.   ... K-QB2   ; (2.2 85%)
+White to move: r-kr6
+50.   ... P-QR3   ; (2.3 92%)
+White to move: r-r7
+51.   ... K-QN3   ; (1.4 95%)
+White to move: r-kb7
+52.   ... N-K5   ; (5.0 93%)
+White to move: r-b5
+53.   ... BxR   ; (2.0 92%)
+White to move: u
+Black to move: u
+White to move: r-b4
+Black to move: pb
+53.   ... N-Q7   ; (4.6 95%)
+White to move: r-b6
+54.   ... K-QN2   ; (1.3 88%)
+White to move: k-r5
+55.   ... N-K5   ; (2.9 94%)
+White to move: r-b7
+56.   ... K-QB3   ; (1.0 95%)
+White to move: r-r7
+; Ambiguous
+White to move: r-kr7
+57.   ... N-KN4   ; (2.8 93%)
+White to move: r-r5
+; T-reject N-KB6 N-K5 N-K3 ...
+; Foo!
+58.   ... R-KN1   ; (4.4 85%)
+White to move: kxp
+59.   ... R-QR1+   ; (0.7 8%)
+;  Checkmate.

src/mudsys/const.mid.5

@@ -0,0 +1,26 @@
+TITLE CONSTS
+
+RELOCA
+
+DEFINE C%MAKE A,B
+	.GLOBAL A
+	
+	IRP LH,RH,[B]
+		A==[LH,,RH]
+		.ISTOP
+		TERMIM
+TERMIN
+TERMIN
+
+IRP X,,[[C%11,1,1],[C%22,2,2],[C%33,3,3],[C%44,4,4],[C%55,5,5],[C%66,6,6]
+[C%0,0,0],[C%1,0,1],[C%2,0,2],[C%3,0,3],[C%M1,-1,-1],[C%M2,-1,-2]
+[C%M10,-1,0],[C%M20,-2,0],[C%M30,-3,0],[C%M40,-4,0],[C%M60,-6,0]]
+
+	IRP A,B,[X]
+	C%MAKE A,[B]
+	.ISTOP
+	TERMIN
+
+TERMIN
+TERMIN
+END

src/mudsys/core.mid.13

@@ -0,0 +1,145 @@
+TITLE CORE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+SYSQ
+
+IF1,[
+IFE ITS,.INSRT STENEX >
+]
+
+.GLOBAL P.CORE,P.TOP,PHIBOT,PURBOT,FRETOP,SQKIL,GCFLG,KILBUF
+.GLOBAL MULTSG
+
+; .CORE AND .SUSET [.RMEMT,,---] FOR PAGED ENVIRONMENT
+
+IFN ITS,[
+
+P.CORE:	PUSH	P,0
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSH	P,E
+	SKIPN	GCFLG
+	 PUSHJ	P,SQKIL
+	MOVE	A,-4(P)
+	ASH	A,10.		; CHECK IT
+	CAMLE	A,PURBOT	; A CAML HERE IS OBSERVED TO LOSE
+	 FATAL	BAD ARG TO GET CORE
+	MOVE	A,-4(P)		; RESTORE A
+	HRRZ	B,P.TOP		; GET FIRST ADDRESS ABOVE TOP
+	ASH	B,-10.		; TO BLOCKS
+	CAIG	A,(B)		; SKIP IF GROWING
+	 JRST	P.COR1
+	SUBM	B,A		; A/ -NUMBER OF BLOCKS TO GET
+	HRLI	B,(A)		; AOBJN TO BLOCKS
+
+	.CALL	P.CORU		; TRY
+	 JRST	POPBJ		; LOSE
+	MOVE	A,B
+P.COR2:	ASH	B,10.		; TO WORDS
+	MOVEM	B,P.TOP		; NEW TOP
+POPBJ1:	AOS	-6(P)		; SKIP RETURN ON SUCCESS
+POPBJ:	POP	P,E
+	POP	P,D
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	POP	P,0
+	POPJ	P,
+
+; HERE TO CORE DOWN
+
+P.COR1:	SUBM	A,B
+	JUMPE	B,POPBJ1	; SUCCESS, YOU ALREADY HAVE WHAT YOU WANT
+	HRLI	A,(B)
+	MOVEI	B,(A)
+	.CALL	P.CORD
+	 JRST	POPBJ
+	JRST	P.COR2
+
+P.CORU:	SETZ
+	SIXBIT /CORBLK/
+	1000,,100000
+	1000,,-1
+	B
+	401000,,400001
+
+P.CORD:	SETZ
+	SIXBIT /CORBLK/
+	1000,,0
+	1000,,-1
+	SETZ A
+]
+
+IFE ITS,[
+
+MFORK==400000
+
+P.CORE:	JRST	@[.+1]
+       	ASH	A,10.		; CHECK IT
+	CAMLE	A,PURBOT
+	 FATAL	BAD ARG TO GET CORE
+	ASH	A,-9.		; TO PAGES
+	PUSH	P,D
+	PUSH	P,A
+	SKIPN	GCFLG
+	 PUSHJ	P,SQK
+	SETOM	A		; FLUSH PAGES
+	HRRZ	B,P.TOP		; GET P.TOP
+	ASH	B,-9.		; TO PAGES
+	CAMLE	B,(P)
+	 SOJA	B,P.CORD	; CORING DOWN
+	HRLI	B,MFORK		; SET UP FORK POINTER
+P.COR2:	HRRZ	D,B
+	CAML	D,(P)		; SEE IF DONE
+	 JRST	P.COR1
+	PMAP			; MAP OUT PAGE
+	ADDI	B,1		; NEXT PAGE
+	JRST	P.COR2		; LOOP BACK
+P.COR1:	POP	P,A		; RESTORE NEW P.TOP
+	POP	P,D
+	ASH	A,9.		; TO WORDS
+	MOVEM	A,P.TOP
+	AOS	(P)
+POPJA:	ASH	A,-10.
+	SKIPN	MULTSG
+	 POPJ	P,
+	POP	P,21
+	SETZM	20
+	JRST	5,20
+
+P.CORD:	HRLI	B,400000
+	PMAP
+	MOVEI	D,-1(B)
+	CAMLE	D,(P)
+	 SOJA	B,.-3
+	JRST	P.COR1
+
+SQK:	PUSH	P,0
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSH	P,E
+	PUSHJ	P,SQKIL
+	POP	P,E
+	POP	P,D
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	POP	P,0
+	POPJ	P,
+
+]
+
+IMPURE
+
+P.TOP==FRETOP
+
+PURE
+
+END

src/mudsys/create.mid.40

@@ -0,0 +1,376 @@
+
+TITLE PROCESS-HACKER FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+.GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC,SWAP,MAINPR,PROCHK,NOTRES
+.GLOBAL PSTAT,LSTRES,TOPLEV,MAINPR,1STEPR,INCONS
+.GLOBAL TBINIT,APLQ,PVSTOR,SPSTOR
+
+MFUNCTION PROCESS,SUBR
+
+	ENTRY 1
+	GETYP	A,(AB)		;GET TYPE OF ARG
+				;MUST BE SOME APPLIABLE TYPE
+	PUSHJ	P,APLQ
+	JRST	NAPT		;NO, ERROR - NON-APPLIABLE TYPE
+OKFUN:
+
+	MOVEI	A,TPLNT/2	;SMALL STACK PARAMETERS
+	MOVEI	B,PLNT/2
+	PUSHJ	P,ICR		;CREATE A NEW PROCESS
+	MOVE	C,TPSTO+1(B)	;GET ITS SRTACK
+	PUSH	C,[TENTRY,,TOPLEV]
+	PUSH	C,[1,,0]	;TIME
+	PUSH	C,[0]
+	PUSH	C,SPSTO(B)
+	PUSH	C,PSTO+1(B)
+	MOVE	D,C
+	ADD	D,[3,,3]
+	PUSH	C,D		;SAVED STACK POINTER
+	PUSH	C,[SUICID]
+	MOVEM	C,TPSTO+1(B)	;STORE NEW TP
+	HRRI	D,1(C)		;MAKE A TB
+	HRLI	D,400002	;WITH A TIME
+	MOVEM	D,TBINIT+1(B)
+	MOVEM	D,TBSTO+1(B)	;SAVE ALSO FOR SIMULATED START
+	MOVE	C,(AB)		;STORE ARG
+	MOVEM	C,RESFUN(B)	;INTO PV
+	MOVE	C,1(AB)
+	MOVEM	C,RESFUN+1(B)
+	MOVEI	0,RUNABL
+	MOVEM	0,PSTAT+1(B)
+	JRST FINIS
+
+REPEAT 0,[
+MFUNCTION	RETPROC,SUBR
+; WHO KNOWS WHAT THIS SHOULD REALLY DO
+;PROBABLY, JUST AN EXIT
+;FOR NOW, PRINT OUT AN ERROR MESSAGE
+	ERRUUO	EQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS
+
+
+
+
+
+
+
+MFUNCTION RESUME,FSUBR
+;RESUME IS CALLED WITH TWO ARGS
+;THE FIRST IS A PROCESS FORM OF THE PROCESS TO BE RESUMED
+;THE SECOND IS A FUNCTION TO BE CALLED WHEN THIS PROCESS
+;    (THE PARENT) IS ITSELF RESUMED
+;IF THE FUNCTION IS NOT GIVEN SOME STANDARD FUNCTION IS
+;PLUGGED IN
+;
+; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE
+
+	ENTRY	1
+	HRRZ	C,@1(AB)		;GET CDR ADDRESS
+	JUMPE	C,NOFUN		;IF NO SECOND ARG, SUPPLY STANDARD
+	HLLZ	A,(C)		;GET CDR TYPE
+	CAME	A,$TATOM		;ATOMIC?
+	JRST	RES2		;NO, MUST EVAL TO GET FUNCTION
+	MOVE	B,1(C)		;YES
+	PUSHJ	P,IGVAL		;TRY TO GET GLOBAL VALUE
+	CAMN	A,$TUNBOUND	;GLOBALLY UNBOUND?
+	JRST	LFUN		;YES, TRY FOR LOCAL VALUE
+RES1:	MOVE	PVP,PVSTOR+1
+	MOVEM	A,RESFUN(PVP)	;STORE IN THIS PROCESS
+	MOVEM	B,RESFUN+1(PVP)
+
+	HRRZ	C,1(AB)		;GET CAR ADDRESS
+	PUSH	TP,(C)		;PUSH PROCESS FORM
+	PUSH	TP,1(C)
+	JSP	E,CHKARG	;CHECK FOR DEFERED TYPE
+				;INSERT CHECKS FOR PROCESS FORM
+	MCALL	1,EVAL		;EVAL PROCESS FORM WHICH WILL SWITCH
+				; PROCESSES
+	JRST	FINIS
+
+RES2:	PUSH	TP,(C)		;PUSH FUNCTION ARG
+	PUSH	TP,1(C)
+	JSP	E,CHKARG	;CHECK FOR DEFERED
+	MCALL	1,EVAL		;EVAL TO GET FUNCTION
+	JRST	RES1
+
+LFUN:	HRRZ	C,1(AB)		;GET CDR ADDRESS
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	MCALL	1,VALUE	;GET LOCAL VALUE OF ATOM FOR FUNCTION
+	JRST	RES1
+
+NOFUN:	MOVSI	A,TUNBOUND	;MAKE RESUME FUNCTION UNBOUND
+	JRST	RES1
+]
+
+; PROCHK - SETUP LAST RESUMER SLOT
+
+PROCHK:	MOVE	PVP,PVSTOR+1
+	CAME	B,MAINPR	; MAIN PROCESS?
+	MOVEM	PVP,LSTRES+1(B)
+	POPJ	P,
+
+; THIS FUNCTION RESUMES A PROCESS, CALLED WITH ONE OR TWO ARGS
+; THE FIRST IS A VALUE TO RETURN TO THE OTHER PROCESS OR PASS TO ITS
+;	RESFUN
+; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES)
+
+
+MFUNCTION RESUME,SUBR
+
+	ENTRY
+	JUMPGE	AB,TFA
+	CAMGE	AB,[-4,,0]
+	JRST	TMA
+	CAMGE	AB,[-2,,0]
+	JRST	CHPROC		; VALIDITY CHECK ON PROC
+	MOVE	PVP,PVSTOR+1
+	SKIPN	B,LSTRES+1(PVP)	; ANY RESUMERS?
+	JRST	NORES		; NO, COMPLAIN
+GOTPRO:	MOVE	C,AB
+	CAMN	B,PVSTOR+1	; DO THEY DIFFER?
+	JRST	RETARG
+	MOVE	A,PSTAT+1(B)	; CHECK STATE
+	CAIE	A,RUNABL	; MUST BE RUNABL
+	CAIN	A,RESMBL	; OR RESUMABLE
+	JRST	RESUM1
+NOTRES:
+NOTRUN:	ERRUUO	EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE
+
+RESUM1:	PUSHJ	P,PROCHK	; FIX LISTS UP
+	MOVEI	A,RESMBL	; GET NEW STATE
+	MOVE	D,B		; FOR SWAP
+STRTN:	JSP	C,SWAP		; SWAP THEM
+	MOVEM	A,PSTAT+1(E)	; CLOBBER OTHER STATE
+	MOVE	PVP,PVSTOR+1
+	MOVE	A,PSTAT+1(PVP)	; DECIDE HOW TO PROCEED
+	MOVEI	0,RUNING
+	MOVEM	0,PSTAT+1(PVP)	; NEW STATE
+	MOVE	C,ABSTO+1(E)	; OLD ARGS
+	CAIE	A,RESMBL
+	JRST	DORUN		; THEY DO RUN RUN, THEY DO RUN RUN
+RETARG:	MOVE	A,(C)
+	MOVE	B,1(C)		; RETURN
+	JRST	FINIS
+
+DORUN:	PUSH	TP,RESFUN(PVP)
+	PUSH	TP,RESFUN+1(PVP)
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	MCALL	2,APPLY
+	PUSH	TP,A		; CALL SUICIDE WITH THESE ARGS
+	PUSH	TP,B
+	MCALL	1,SUICID	; IF IT RETURNS, KILL IT
+	JRST	FINIS
+
+CHPROC:	GETYP	A,2(AB)
+	CAIE	A,TPVP
+	JRST	WTYP2
+	MOVE	B,3(AB)
+	JRST	GOTPRO
+
+NORES:	ERRUUO	EQUOTE NO-PROCESS-TO-RESUME
+
+; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT
+
+MFUNCTION SUICIDE,SUBR
+
+	ENTRY
+
+	JUMPGE	AB,TFA
+	HLRE	A,AB
+	ASH	A,-1	; DIV BY 2
+	AOJE	A,NOPROC	; NO PROCESS GIVEN
+	AOJL	A,TMA
+	GETYP	A,2(AB)	; MAKE SURE OF PROCESS
+	CAIE	A,TPVP
+	JRST	WTYP2
+	MOVE	C,3(AB)
+	JRST	SUIC2
+
+NOPROC:	MOVE	PVP,PVSTOR+1
+	SKIPN	C,LSTRES+1(PVP)
+	MOVE	C,MAINPR	; IF NOT DEFAULT TO MAIN
+SUIC2:	CAMN	C,PVP		; DONT SUICIDE TO SELF
+	JRST	SUSELF
+	MOVE	B,PSTAT+1(C)
+	CAIE	B,RUNABL
+	CAIN	B,RESMBL
+	JRST	.+2
+	JRST	NOTRUN
+	MOVE	B,C
+	PUSHJ	P,PROCHK
+	MOVE	D,B		; RESTORE NEWPROCESS
+	MOVEI	A,DEAD
+	JRST	STRTN
+
+SUSELF:	ERRUUO	EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF
+
+
+MFUNCTION RESER,SUBR,RESUMER
+
+	ENTRY
+	MOVE	B,PVSTOR+1
+	JUMPGE	AB,GTLAST
+	CAMGE	AB,[-2,,0]
+	JRST	TMA
+
+	GETYP	A,(AB)	; CHECK FOR PROCESS
+	CAIE	A,TPVP
+	JRST	WTYP1
+	MOVE	B,1(AB)	; GET PROCESS
+GTLAST:	MOVSI	A,TFALSE	; ASSUME NONE
+	SKIPN	B,LSTRES+1(B)	; GET IT IF IT EXISTS
+	JRST	FINIS
+	MOVSI	A,TPVP		; GET TYPE
+	JRST	FINIS
+
+; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK
+
+MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ
+
+	ENTRY	2
+
+	GETYP	A,2(AB)		; 2D ARG MUST BE PROCESS
+	CAIE	A,TPVP
+	JRST	WTYP2
+
+	MOVE	B,3(AB)		; GET PROCESS
+	CAMN	B,PVSTOR+1	; SKIP IF NOT ME
+	JRST	BREAKM
+	MOVE	A,PSTAT+1(B)	; CHECK STATE
+	CAIE	A,RESMBL	; BEST BE RESUMEABLE
+	JRST	NOTRUN
+	MOVE	C,TBSTO+1(B)	; GET SAVE ACS TO BUILD UP A DUMMY FRAME
+	MOVE	D,TPSTO+1(B)	; STACK POINTER
+	MOVE	E,SPSTO+1(B)	; FIX UP OLD FRAME
+	MOVEM	E,SPSAV(C)
+	MOVEI	E,CALLEV	; FUNNY PC
+	MOVEM	E,PCSAV(C)
+	MOVE	E,PSTO+1(B)	; SET UP P,PP AND TP SAVES
+	MOVEM	E,PSAV(C)
+	PUSH	D,[0]		; ALLOCATES SOME SLOTS
+	PUSH	D,[0]
+	PUSH	D,(AB)		; NOW THAT WHIC IS TO BE EVALLED
+	PUSH	D,1(AB)
+	MOVEM	D,TPSAV(C)
+	HRRI	E,-1(D)		; BUILD UP ARG POINTER
+	HRLI	E,-2
+	PUSH	D,[TENTRY,,BREAKE]
+	PUSH	D,C		; OLD TB
+	PUSH	D,E		; NEW ARG POINTER
+REPEAT 4,PUSH	D,[0]		; OTHER SLOTS
+	MOVEM	D,TPSTO+1(B)
+	MOVEI	C,(D)		; BUILD NEW AB
+	AOBJN	C,.+1
+	MOVEM	C,TBSTO+1(B)	; STORE IT
+	MOVE	A,2(AB)		; RETURN PROCESS
+	MOVE	B,3(AB)
+	JRST	FINIS
+
+MQUOTE BREAKER
+
+BREAKE:	
+CALLEV:	MOVEM	A,-3(TP)	; HERE TO EVAL THE GOODIE (SAVE REAL RESULT)
+	MOVEM	B,-2(TP)
+	MCALL	1,EVAL
+	POP	TP,B
+	POP	TP,A
+	JRST	FINIS
+
+BREAKM:	ERRUUO	EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE
+
+; FUNCTION TOP PUT PROCESS IN 1 STEP MODE
+
+MFUNCTION 1STEP,SUBR
+	PUSHJ	P,1PROC
+	MOVE	PVP,PVSTOR+1
+	MOVEM	PVP,1STEPR+1(B)	; CLOBBER TARGET PROCESS
+	JRST	FINIS
+
+; FUNCTION TO UNDO ABOVE
+
+MFUNCTION %%FREE,SUBR,FREE-RUN
+	PUSHJ	P,1PROC
+	MOVE	PVP,PVSTOR+1
+	CAME	PVP,1STEPR+1(B)
+	JRST	FNDBND
+	SETZM	1STEPR+1(B)
+	JRST	FINIS
+
+FNDBND:	SKIPE	1STEPR+1(B)	; DOES IT HAVE ANY 1STEPPER?
+	JRST	NOTMIN		; YES, COMPLAIN
+	MOVE	D,B		; COPY PROCESS
+	ADD	D,[1STEPR,,1STEPR]	; POINTER FOR SEARCH
+	HRRZ	C,SPSTO+1(B)	; GET THIS BINDING STACK
+
+FNDLP:	GETYP	0,(C)		; IS THIS A TBVL?
+	CAIN	0,TBVL
+	CAME	D,1(C)		; SKIP IF THIS IS SAVED 1STEP SLOT
+	JRST	FNDNXT
+	SKIPN	3(C)		; IS IT SAVING A REAL 1STEPPER?
+	JRST	FNDNXT
+	MOVE	PVP,PVSTOR+1
+	CAME	PVP,3(C)	; IS IT ME?
+	JRST	NOTMIN
+	SETZM	3(C)		; CLEAR OUT SAVED 1STEPPER
+	JRST	FINIS
+FNDNXT:	HRRZ	C,(C)		; NEXT BINDING
+	JUMPN	C,FNDLP
+
+NOTMIN:	MOVE	C,$TCHSTR
+	MOVE	D,CHQUOTE NOT-YOUR-1STEPEE
+	PUSHJ	P,INCONS
+	MOVSI	A,TFALSE
+	JRST	FINIS
+
+1PROC:	ENTRY	1
+	GETYP	A,(AB)
+	CAIE	A,TPVP
+	JRST	WTYP1
+	MOVE	B,1(AB)
+	MOVE	A,(AB)
+	POPJ	P,
+
+; FUNCTION TO RETRUN THE MAIN PROCESS
+
+MFUNCTION MAIN%%,SUBR,MAIN
+	ENTRY	0
+
+	MOVE	B,MAINPR
+MAIN1:	MOVSI	A,TPVP
+	JRST	FINIS
+
+; FUNCTION TO RETURN THE CURRENT PROCESS
+
+MFUNCTION ME,SUBR
+	ENTRY	0
+
+	MOVE	B,PVSTOR+1
+	JRST	MAIN1
+
+; FUNCTION TO RETURN THE STATE OF A PROCESS
+
+MFUNCTION STATE,SUBR
+	ENTRY	1
+	GETYP	A,(AB)
+	CAIE	A,TPVP
+	JRST	WTYP1
+	MOVE	A,1(AB)		; GET PROCESS
+	MOVE	A,PSTAT+1(A)
+	MOVE	B,@STATES(A)	; GET STATE
+	MOVSI	A,TATOM
+	JRST	FINIS
+
+STATES:
+	IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED]
+	MQUOTE A
+	TERMIN
+
+
+
+END
+

src/mudsys/first.cmd.2

@@ -0,0 +1,84 @@
+CONN INT:
+DEL MDLXXX.*.*
+DELVER
+YY*.*.*
+EXP
+DEL MDL:MDLXXX.*.*
+DEL MDL:*.SAV00.*
+EXP MDL:
+STINK
+MMUD105.STINK@MMDLXXX.EXEYRESET .
+
+NDDT
+;YMDLXXX.EXE
+;UMDLXXX.EXE
+;OMDLXXX.SYMBOLS
+
+INTFCNK
+NAME1K
+BUFRINK
+PROCIDK
+IOIN2K
+ITEMK
+NILK
+TYPVECK
+INAMEK
+ECHOK
+CHANNOK
+VALK
+CHRCNTK
+0STOK
+TYPBOTK
+ERASCHK
+DIRECTK
+INDICK
+INTFCNK
+KILLCHK
+TTICHNK
+ASTOK
+BRKCHK
+NODPNTK
+ESCAPK
+BSTOK
+TTOCHNK
+SYSCHRK
+BRFCHRK
+CSTOK
+ROOTK
+ASOLNTK
+BRFCH2K
+BYTPTRK
+INITIAK
+DSTOK
+ESTOK
+INTOBLK
+PVPSTOK
+ERROBLK
+MUDOBLK
+TVPSTOK
+ABSTOK
+INTNUMK
+STATUSK
+INTVECK
+QUEUESK
+TBSTOK
+CHNL1K
+.LIST.K
+GCPDLK
+CONADJK
+T.CHANK
+N.CHNSK
+SLENGCK
+LENGCK
+SECLENK
+;WMDLXXX.SYMBOLS
+;H
+RESET .
+NDDT
+;YMDLXXX.EXE
+;OMDLXXX.SYMBOLS
+NSEGS/3
+MASK1/700541,,2007
+;UMDLXXX.EXE
+;H
+LOGOUT

src/mudsys/gcgdgl.mud.1

@@ -0,0 +1,186 @@
+
+<PACKAGE "GC-GRLOAD">
+
+<ENTRY GC-GROUP-LOAD GC-GROUP-DUMP>
+
+<USE "EDIT">
+
+<COND (<G? ,MUDDLE 100> <SETG TNM1 "ETMP"> <SETG TNM2 "MUDT">)
+      (ELSE <SETG TNM1 "_ETMP_"> <SETG TNM2 ">">)>
+
+<SETG VCOMP
+      <FORM COND
+	    (<FORM N==? ,MUDDLE <FORM GVAL MUDDLE>>
+	     <FORM ERROR RSUBR-CANT-RUN-IN-THIS-VERSION-OF-MUDDLE!-ERRORS>)>>
+
+<DEFINE GC-GROUP-LOAD (STR
+		       "OPTIONAL" NAM
+		       "AUX" (CHN <OPEN "READB" .STR>) FSP (REDEFINE T))
+	#DECL ((REDEFINE) <SPECIAL ANY>)
+	<PROG ()
+	      <COND (<NOT <TYPE? .CHN CHANNEL>> <RETURN .CHN>)>
+	      <COND (<NOT <ASSIGNED? NAM>>
+		     <SET NAM
+			  <PARSE <MAPF ,STRING
+				       <FUNCTION (C) <MAPRET !"\\ .C>>
+				       <7 .CHN>>>>)>
+				      ;"To hack ugly file names. (TT, 75/10/07)"
+	      <PUT .NAM
+		   CHANNEL
+		   <SET FSP <LIST <7 .CHN> <8 .CHN> <9 .CHN> <10 .CHN>>>>
+	      <EVAL <GC-READ .CHN>>
+	      <CLOSE .CHN>
+	      .NAM>>
+
+<DEFINE GC-GROUP-DUMP (STR
+		       "OPTIONAL" NM (BKILLER T)
+		       "AUX" (CHN <CHANNEL "PRINTB" .STR>)
+			     (NAM
+			      <COND (<ASSIGNED? NM> .NM)
+				    (ELSE <PARSE <7 .CHN>>)>)
+			     (OC
+			      <OPEN "PRINTB" ,TNM1 ,TNM2 <9 .CHN> <10 .CHN>>)
+			     (FIXERS ()) FUNC BKS TEM TT HOLDANY GRP FIXES)
+   #DECL ((CHN) CHANNEL (NAM) ATOM (OC) <OR CHANNEL FALSE> (FIXERS) LIST)
+   <PROG ()
+     <COND (<NOT .OC> <RETURN .OC>)>
+     <COND (<OR <NOT <ASSIGNED? .NAM>> <NOT <TYPE? ..NAM LIST>>>
+	    <CLOSE .OC>
+	    <RETURN #FALSE ("Not a valid group name")>)>
+     <SET GRP ..NAM>
+     <SET FIXERS
+	  (<FORM PUT .NAM BLOCK <FORM UNGET <UNGET <GET .NAM BLOCK '.OBLIST>>>>
+	   !.FIXERS)>
+     <MAPR <>
+      <FUNCTION (OBP "AUX" (OB <1 .OBP>)) 
+	 <COND (<SET TEM <GET <FORM QUOTE .OBP> COMMENT>>
+		<SET FIXERS
+		     (<FORM PUT <FORM QUOTE .OBP> COMMENT .TEM> !.FIXERS)>)>
+	 <COND (<SET TEM <GET .OBP BLOCK>>
+		<SET FIXERS
+		     (<FORM PUT
+			    <FORM QUOTE .OBP>
+			    BLOCK
+			    <FORM UNGET <UNGET .TEM>>>
+		      !.FIXERS)>)>
+	 <COND
+	  (<AND <TYPE? .OB FORM> <NOT <EMPTY? .OB>>>
+	   <COND
+	    (<OR <==? <SET TEM <1 .OB>> DEFINE> <==? .TEM DEFMAC>>
+	     <COND
+	      (<AND
+		.BKILLER				   ;"Breakpoint killer"
+		<G? <LENGTH .OB> 1>
+		<SET BKS
+		     <GETPROP
+		      <AND <GASSIGNED? <SET FUNC <GET <2 .OB> VALUE '<2
+								      .OB>>>>
+			   <GLOC .FUNC>>
+		      BREAKS>>>
+	       <PUTPROP <GLOC .FUNC> BREAKS>
+	       <REPEAT ()
+		       <COND (<EMPTY? .BKS> <RETURN>)>
+		       <COND (<TYPE? <SET HOLDANY <IN <1 .BKS>>> BREAK>
+			      <SETLOC <1 .BKS> <2 .HOLDANY>>)>
+		       <SET BKS <REST .BKS>>>)>
+	     <SET TEM <COMMENT-ON .OB>>
+	     <COND (<NOT <EMPTY? .TEM>>
+		    <PUTREST <REST .TEM <- <LENGTH .TEM> 1>> .FIXERS>
+		    <SET FIXERS .TEM>)>)
+	    (<AND <==? .TEM SETG>
+		  <==? <LENGTH .OB> 3>
+		  <TYPE? <SET NM <GET <2 .OB> VALUE '<2 .OB>>> ATOM>
+		  <OR <TYPE? <SET TEM <3 .OB>> RSUBR>
+		      <AND <GASSIGNED? .NM> <TYPE? <SET TEM ,.NM> RSUBR>>>
+		  <==? .NM <2 .TEM>>>
+	     <COND (<AND <TYPE? <1 .TEM> CODE> <SET FIXES <GET .TEM RSUBR>>>
+		    <SET FIXERS
+			 (<FORM FIXIT <FORM QUOTE .TEM> .FIXES> !.FIXERS)>)
+		   (<TYPE? <1 .TEM> CODE>
+		    <PRINC 
+"Warning:  RSUBR lacks fixups, only use in same MUDDLE version.  ">
+		    <PRIN1 .NM>
+		    <CRLF>
+		    <SET FIXERS (,VCOMP !.FIXERS)>)>
+	     <COND (<NOT <EMPTY? <SET TT <ANON-SRCH .TEM>>>>
+		    <PUTREST <REST .TT <- <LENGTH .TT> 1>> .FIXERS>
+		    <SET FIXERS .TT>)>
+	     <COND (<TYPE? <SET TT <1 .TEM>> PCODE>
+		    <SET FIXERS
+			 (<FORM PUT
+				<FORM QUOTE .TEM>
+				1
+				<PARSE <REST <UNPARSE .TT>>>>
+			  !.FIXERS)>)>)>)>>
+      .GRP>
+     <GC-DUMP (<FORM MAPF
+		     <>
+		     <FORM GVAL EVAL>
+		     <FORM SET .NAM <FORM QUOTE .GRP>>>
+	       .FIXERS)
+	      .OC>
+     <RENAME .OC .STR>
+     <CLOSE .OC>
+     .NAM>>
+
+<DEFINE COMMENT-ON (OB "AUX" (L ()) TEM TT) 
+   <COND
+    (<NOT <MONAD? .OB>>
+     <MAPR <>
+	   <FUNCTION (OBP) 
+		   <COND (<SET TEM <GET .OBP COMMENT>>
+			  <SET L
+			       (<FORM PUT <FORM QUOTE .OBP> COMMENT .TEM>
+				!.L)>)>
+		   <COND (<NOT <EMPTY? <SET TEM <COMMENT-ON <1 .OBP>>>>>
+			  <PUTREST <REST .TEM <- <LENGTH .TEM> 1>> .L>
+			  <SET L .TEM>)>>
+	   <REST .OB>>
+     <COND (<SET TEM <GET <1 .OB> COMMENT>>
+	    <SET L (<FORM PUT <FORM QUOTE <1 .OB>> COMMENT .TEM> !.L)>)>
+     <COND (<OR <SET TEM <GET <SET TT .OB> COMMENT>>
+		<SET TEM <GET <SET TT <REST .OB 0>> COMMENT>>>
+	    <SET L (<FORM PUT <FORM QUOTE .TT> COMMENT .TEM> !.L)>)>)
+    (<SET TEM <GET .OB COMMENT>> <SET L (.TEM)>)>
+   .L>
+
+<DEFINE ANON-SRCH (R "AUX" (L ()) TEM) 
+   #DECL ((R) <PRIMTYPE VECTOR> (L) LIST)
+   <MAPR <>
+    <FUNCTION (THP "AUX" (THING <1 .THP>)) 
+	    <COND (<AND <TYPE? .THING RSUBR>
+			<G? <LENGTH .THING> 1>
+			<TYPE? <SET TEM <2 .THING>> ATOM>
+			<OR <NOT <GASSIGNED? .TEM>> <N==? ,.TEM .THING>>>
+		   <COND (<AND <TYPE? <1 .THING> CODE>
+			       <SET TEM <GET .THING RSUBR>>>
+			  <SET L (<FORM FIXIT <FORM QUOTE .THING> .TEM> !.L)>)
+			 (<TYPE? <1 .THING> CODE>
+			  <PRINC 
+"Warning:  RSUBR lacks fixups, only use in same MUDDLE version.  ">
+			  <PRIN1 <2 .THING>>
+			  <CRLF>)>)>
+	    <COND (<AND <TYPE? .THING RSUBR> <TYPE? <1 .THING> PCODE>>
+		   <SET L
+			(<FORM PUT
+			       <FORM QUOTE .THING>
+			       1
+			       <PARSE <REST <UNPARSE <1 .THING>>>>>
+			 !.L)>)>
+	    <COND (<TYPE? .THING LOCD LOCR TYPE-W TYPE-C>
+		   <SET L
+			(<FORM PUT
+			       <FORM QUOTE .THP>
+			       1
+			       <PARSE <REST <UNPARSE .THING>>>>
+			 !.L)>
+		   <COND (<TYPE? .THING LOCD>
+			  <PUT .THP 1 LOCD>)>)>>
+    .R>
+   .L>
+
+<DEFINE UNGET (O)
+	<MAPF ,LIST <FUNCTION (X) <GET .X OBLIST>> .O>>
+
+<ENDPACKAGE>
+

src/mudsys/gchack.mid.45

@@ -0,0 +1,538 @@
+
+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,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
+
+

src/mudsys/gchack.mid.46

@@ -0,0 +1,540 @@
+
+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
+
+

src/mudsys/ipc.mid.19

@@ -0,0 +1,815 @@
+TITLE IPC -- IPC COMMUNICATIONS HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+; N. RYAN   October 1973
+
+.INSRT MUDDLE >
+
+;THIS PROGRAM HAS ENTRIES  SEND, SEND-WAIT, IPC-OFF,
+;		 AND IPC-HANDLER.
+
+;THESE HANDLE THE IPC DEVICE.
+
+;SEND AND SEND-WAIT SEND OUT A MESSAGE ON THE IPC DEVICE.
+;THEY TAKE 6 ARGUMENTS, THE FIRST THREE OF WHICH ARE NECESSARY
+
+;	SEND (<HISNAME1> <HISNAME2> <MESSAGE> <MESSAGE-TYPE> <MYNAME1> <MYNAME2>)
+
+;	<HISNAME1> -- STRING USED AS SIXBIT FOR NAME 1
+;	<HISNAME2> -- STRING USED AS SIXBIT FOR NAME 2
+;	<MESSAGE>  -- THE MESSAGE TO SEND, EITHER A STRING OR A UVECTOR OF TYPE WORD
+;	<TYPE>	   -- THE TYPECODE TO SEND, A FIXED NUMBER, DEFAULT 0
+;	<MYNAME1>  -- STRING USED AS SIXBIT FOR MY NAME 1
+;	<MYNAME2>  -- STRING USED AS SIXBIT FOR MY NAME 2
+
+;	SEND 	-- TRIES TO SEND IMMEDIATELY, ELSE RETURNS FALSE WITH MESSAGE
+;	SEND-WAIT -- HANGS UNTIL MESSAGE CAN BE SENT
+
+;	IPC-OFF -- NO ARGUMENTS, CLOSES ALL IPC-RECEIVE CHANNELS
+
+;	IPC-ON  -- OPENS AN IPC RECEIVE CHANNEL
+;		   IT TAKES 2 OPTIONAL ARGS WHICH ARE THE NAMES TO LISTEN ON,
+;			THE DEFAULT IS UNAME, JNAME
+
+
+
+; DEFINITIONS FOR STRUCTURE OF IPC BUFFER
+
+BUFL==200.			;LENGTH OF IPC BUFFER
+BUFHED==3			;LENGTH OF BUFFER HEADER
+CONT==400000			;LEFT HALF BIT INDICATING THIS IS CONTINUATION
+INCOMP==200000		;LEFT HALF BIT INDICATING MESSAGE COMPLETE
+ASCIMS==100000		;LEFT HALF BIT INDICATING THIS IS PACKED ASCII MESSAGE
+MESHED==2			;LENGTH OF CRUFT AT FRONT OF FIRST MESSAGE
+MAXMES==20000.		;MAXIMUM LENGTH IN WORDS OF MESSAGES MUDDLE WILL LIKE
+
+
+.GLOBAL STRTO6,SAT,IBLOCK,MOPEN,MCLOSE,GFALS,TTOCHN,INCONS,MASK2,INTHLD
+.GLOBAL IPCS1,IBLOCK,IPCGOT,DIRQ,GIBLOK,6TOCHS,CAFRE,CAFRET,IPCBLS,PVSTOR,SPSTOR
+
+; DEFINITIONS OF BITS IN THE OPEN BLOCK FOR IPC DEVICE
+
+RFROMA==1			;READ FROM ANY
+RFROMS==2			;READ FROM SPECIFIC
+SANDH==4			;SEND AND HANG
+SIMM==10			;SEND IMMEDIATE
+USEUJ==20			;USE MY UNAME, JNAME
+
+
+;BUFFERFORMAT:	HISNAME1
+;		HISNAME2
+;		COUNT
+;		BITS,,LENGTH
+;		TYPE
+
+;WHERE ASCII MESSAGES CONSIST OF A COUNT FOLLOWED BY CHARS
+;THE LENGTH IS THE LENGTH OF THE TYPE WORD PLUS ALL THE BODIES
+
+
+
+; THE FOLLOWING IS THE HANDLER WHICH WILL NORMALLY BE PUT ON THE
+; IPC INTERRUPT AND SO SERVE AS THE DEFAULT HANDLER FOR IPC RECEIVES
+; WHICH ARE NOT CAUGHT BY THE USER AND SERVICED IN SOME OTHER MANNER
+
+; NOTE THAT AS AN EXPERIMENT, MESSAGE WHICH ARE ASCII STRINGS WITH TYPE-CODE 1
+; ARE CONSIDERED AS EXECUTE COMMANDS.  THEY ARE FIRST PRINTED OUT,
+; THEN THEY ARE PARSED AND THAT RESULT IS EVALED.
+; ALL MESSAGES OF OTHER TYPES ARE CONSIDERED MERELY AS MESSAGES TO BE
+; PRINTED OUT WITH AN INDICATING OF WHO THEY ARE FROM
+
+; THE ARGS WHICH THIS SUBROUTINE IS CALLED WITH BY INTERRUPT ARE
+; <MESSAGE> <TYPE> <HIS NAME 1> <HIS NAME 2> <MY NAME 1> <MY NAME 2>
+; WHERE THE LAST TWO ARE OPTIONAL AND ONLY GIVEN IF THE SOCKET WAS NOT
+; LISTENING ON THE DEFAULT UNAME,JNAME COMBINATION.
+
+
+MFUNCTION	IPCH,SUBR,[IPC-HANDLER]
+
+	ENTRY
+
+	PUSH	P,[0]			;SAVE A SLOT FOR LATTER USE
+	HLRE	0,AB			;CHECK THE NUMBER OF ARGS WE GOT
+	CAMLE	0,[-8.]			;NEED AT LEAST 4 ARGS
+	JRST	WNA
+	GETYP	E,(AB)			;CHECK TYPE OF FIRST ARG
+	CAIN	E,TCHSTR		;IS IT A CHARACTER STRING
+	JRST	.+3
+	CAIE	E,TUVEC			;IF NOT IT MUST BE A UVECTOR
+	JRST	WTYP1			;IF NEITHER THEN WE HAVE A LOOSER
+	GETYP	A,2(AB)			;GET TYPE OF MESSAGE TYPE, SHOULD BE A FIX
+	CAIE	A,TFIX
+	JRST	WTYP2			;IF NOT FIX COMPLAIN
+	GETYP	A,4(AB)
+	CAIE	A,TCHSTR		;HIS NAME 1 SHOULD BE CHAR STRING
+	JRST	WTYP
+	GETYP	A,6(AB)
+	CAIE	A,TCHSTR
+	JRST	WTYP			;HIS NAME 2 SHOULD BE CHAR STRING
+	CAML	0,[-8.]			;SEE IF WE HAVE 4 OR 6 ARGS
+	JRST	IPCH1			;WE ONLY HAD 4 ARGS
+	CAME	0,[-12.]		;THEN WE MUST HAVE EXACTLY 6 ARGS
+	JRST	WNA
+	GETYP	A,(AB)8.
+	CAIE	A,TCHSTR
+	JRST	WTYP			;CHECK TO SEE THE MY NAME 1 IS STRING
+	GETYP	A,10.(AB)
+	CAIE	A,TCHSTR
+	JRST	WTYP			;CHECK TO SEE THAT MY NAME 2 IS STRING
+
+IPCH1:	PUSH	TP,$TCHAN
+	PUSH	TP,TTOCHN+1	;PUSH ON TTY OUTPUT CHANNEL TO CALL TERPRI
+	MCALL	1,TERPRI
+	PUSH	TP,$TCHSTR
+	PUSH	TP,CHQUOTE [IPC MESSAGE FROM ]
+	PUSH	TP,$TCHAN
+	PUSH	TP,TTOCHN+1
+	MCALL	2,PRINC			;PRINT OUT BLURB TO TELL LOOSER WHATS HAPPENING
+	PUSH	TP,4(AB)
+	PUSH	TP,5(AB)		;OUTPUT HIS NAME 1
+	PUSHJ	P,TO			;JUMP OUT OUTPUTTER OVER TTY OUTPUT CHANNEL
+	PUSHJ	P,STO			;JUMP TO SPACE OUTPUTTER OVER TTY OUTPUT CHANNEL
+	PUSH	TP,6(AB)
+	PUSH	TP,7(AB)		;OUTPUT NAME 2
+	PUSHJ	P,TO
+	MOVE	E,3(AB)			;MESSAGE TYPE
+	JUMPE	E,IPCH3			;IF MESSAGE TYPE 0 DO NOTHING ABOUT IT
+	CAIE	E,1			;IF 1 SEE IF THIS IS EXECUTE MESSAGE
+	JRST	IPCH2			;IF NOT TELL LOOSER ABOUT THIS MESSAGE TYPE
+	GETYP	0,(AB)
+	CAIE	0,TCHSTR		;SEE IF WE HAVE STRING
+	JRST	IPCH2			;IF NOT THIS CANT BE EXECUTE MESSAGE
+	AOS	(P)			;SET FLAG TO INDICATE EXECUTE MESSAGE
+	PUSH	TP,$TCHSTR
+	PUSH	TP,CHQUOTE [     EXECUTE]
+	PUSHJ	P,TO			;TELL THE LOOSER HE IS GETTING WHAT HE DESERVES
+	JRST	IPCH3
+IPCH2:	PUSH	TP,$TCHSTR
+	PUSH	TP,CHQUOTE [     TYPE ]
+	PUSHJ	P,TO
+	PUSH	TP,2(AB)
+	PUSH	TP,3(AB)		;PUSH ON THE MESSAGE TYPE
+	PUSHJ	P,TO
+IPCH3:	HLRE	0,AB
+	CAME	0,[-12.]		;SEE IF WE HAVE 6 ARGS AND SO MUST TELL HIM WHO MESS IS FOR
+	JRST	IPCH4			;IF NOT DONT WORRY
+	PUSH	TP,$TCHSTR
+	PUSH	TP,CHQUOTE [     TO ]
+	PUSHJ	P,TO
+	PUSH	TP,8.(AB)
+	PUSH	TP,9.(AB)		;PUSH ON MY NAME 1
+	PUSHJ	P,TO
+	PUSHJ	P,STO			;LEAVE SPACE BETWEEN NAMES
+	PUSH	TP,10.(AB)		;PUSH ON MY NAME 2
+	PUSH	TP,11.(AB)
+	PUSHJ	P,TO
+IPCH4:	PUSH	TP,(AB)			;PUSH ON THE ACTUAL GOODIE
+	PUSH	TP,1(AB)
+	PUSH	TP,$TCHAN
+	PUSH	TP,TTOCHN+1
+	MCALL	2,PRINT			;AND PRINT IT OUT
+	SKIPN	(P)			;TEST TO SEE IF WE MUST EXECUTE THIS BAG BITTER
+	JRST	IPCHND
+	PUSH	TP,(AB)
+	PUSH	TP,1(AB)
+	MCALL	1,PARSE			;PARSE HIS CRUFT
+	PUSH	TP,A
+	PUSH	TP,B
+	MCALL	1,EVAL			;THEN EVAL THE RESULT
+IPCHND:	PUSH	TP,$TCHAN
+	PUSH	TP,TTOCHN+1
+	MCALL	1,TERPRI
+	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS			;TO RETURN WITH SOMETHING NICE
+
+STO:	PUSH	TP,$TCHSTR		;CROCK TO OUTPUT A SPACE ON THE TTY OUTPUT CHANNEL
+	PUSH	TP,CHQUOTE [ ]
+TO:	PUSH	TP,$TCHAN
+	PUSH	TP,TTOCHN+1
+
+	MCALL	2,PRINC
+	POPJ	P,			;GO BACK TO WHAT WE WERE DOING
+
+
+;THESE ARE THE FUNCTIONS TO ACTUALLY STUFF GOODIES OUT
+;OVER THE IPC DEVICE
+;DESCRIPTION OF CALLING ARGS TO THEM IS AT THE
+;FIRST OF THE FILE
+
+MFUNCTION	SEND,SUBR
+
+	ENTRY
+
+	PUSH	P,[0]			;FLAG TO INDICATE DONT WAIT
+	JRST	CASND
+
+MFUNCTION	SENDW,SUBR,[SEND-WAIT]
+
+	ENTRY
+
+	PUSH	P,[1]			;FLAG TO INDICATE WAITING
+
+CASND:	HLRE	0,AB
+	CAMG	0,[-6]			;NEED AT LEAST 3 ARGS
+	CAMGE	0,[-12.]		;AND NOT MORE THAN 6 ARGS
+	JRST	WNA
+	MOVE	A,(AB)
+	MOVE	B,1(AB)
+	PUSHJ	P,STRTO6		;POOF FIRST ARG TO SIXBIT
+	MOVE	A,2(AB)
+	MOVE	B,3(AB)
+	PUSHJ	P,STRTO6		;POOF SECOND ARG TO SIXBIT
+	GETYP	0,4(AB)
+	CAIN	0,TCHSTR
+	JRST	CASND1			;IF FIRST ARG IS STRING, NO PROBLEMS
+	CAIE	0,TSTORAGE
+	CAIN	0,TUVEC
+	JRST	.+2
+	JRST	WTYP3			;ELSE MUST BE OF TYPE STORAGE OR UVEC
+	MOVE	B,5(AB)
+	HLRE	C,B			;GET COUNT FIELD
+	SUBI	B,(C)			;AND ADD THAT AMOUNT TO FIND DOPE WORD
+	GETYP	A,(B)			;GET TYPE WORD OUT OF DOPE
+	PUSHJ	P,SAT			;GET ITS STORAGE TYPE
+	CAIE	A,S1WORD
+	JRST	WTYP3			;CRUFT MUST BE OF TYPE WORD
+CASND1:	PUSH	TP,4(AB)
+	PUSH	TP,5(AB)		;SAVE THE STRUCTURE AROUND TO REST OFF AS WE SEND
+	PUSH	P,[0]			;SLOT FOR THIS MESSAGE TYPE, DEFAULT 0
+	HLRE	0,AB
+	CAMLE	0,[-8.]			;IF 4 OR MORE ARGS GET THE MESS TYPE
+	JRST	CASND2
+	GETYP	0,6(AB)			;CHECK TO SEE THAT TYPE IS A FIX
+	CAIE	0,TFIX
+	JRST	WTYP
+	MOVE	0,7(AB)
+	MOVEM	0,(P)			;SMASH IN THE SLOT RESERVED FOR TYPE
+CASND2:	HLRE	0,AB
+	CAMN	0,[-10.]		;IF WE HAVE FIVE ARGS WE ARE A GLOBAL LOOSER NEED 4 OR 6
+	JRST	WNA
+	CAMGE	0,[-8.]			;IF WE HAVE 4 OR LESS DONT WORRY 
+	JRST	.+4			;GO GET LAST TO ARGS
+	PUSH	P,[0]			;NO SIXBIT OF FROM
+	PUSH	P,[0]			;SO SAVE SLOTS ANYWAY
+	JRST	CASND3			;GO WORRY ABOUT SENDING NOW
+	MOVE	A,8.(AB)
+	MOVE	B,9.(AB)
+	PUSHJ	P,STRTO6		;CONVERT MY NAME1 TO SIXBIT
+	MOVE	A,10.(AB)
+	MOVE	B,11.(AB)		;CONVERT MY NAME 2 TO SIXBIT
+	PUSHJ	P,STRTO6
+
+CASND3:	GETYP	0,-1(TP)
+	CAIE	0,TCHSTR		;IS THIS A CHAR STRING
+	JRST	.+5
+	HRRZ	A,-1(TP)		;IF SO GET COUNT
+	ADDI	A,9.
+	IDIVI	A,5			;IF SO ROUND UP AND ADD ONE
+	JRST	.+3
+	HLRE	A,(TP)
+	MOVN	A,A			;IF A VECTOR GET THE WORD COUNT
+	PUSH	P,A			;SAVE COUNT OF WORDS
+	CAILE	A,MAXMES
+	JRST	TOBIGR			;MESS OVER SIZE LIKED BY MUDDLE
+	CAILE	A,BUFL-MESHED		;HOW BIG A BUFFER DO WE NEED?
+	MOVEI	A,BUFL-MESHED		;IF TOO BIG WE USE DEFAULT MAX SIZE, ELSE LESS
+	ADDI	A,MESHED+BUFHED		;PLUS ROOM FOR MESSAGE AND SYSTEM HEADERS
+	PUSHJ	P,IBLOCK
+	PUSH	TP,A
+	PUSH	TP,B			;GET BUFFER OF RIGHT SIZE AND SAVE ON STACK
+	PUSH	TP,A
+	PUSH	TP,B			;SAVE ANOTHER COPY WHICH WILL BE RESTED AT TIMES
+	MOVE	C,-5(P)			;GET HIS NAME 1
+	MOVEM	C,(B)			;AND STUFF IN RIGHT PLACE
+	MOVE	C,-4(P)
+	MOVEM	C,1(B)			;STUFF HIS NAME 2
+	MOVE	C,-3(P)
+	MOVEM	C,4(B)			;STUFF MESSAGE TYPE CODE WORD
+	GETYP	0,-5(TP)		;IS THIS STRING OR UVECTOR?
+	CAIE	0,TCHSTR
+	JRST	CASND4
+	MOVE	C,(P)			;GET LENGTH OF CHAR STRING TO SEND
+	ADDI	C,1
+	MOVEM	C,3(B)			;STORE IN LENGTH FIELD IN MESS HEADER
+	SOS	(P)			;DECREMENT FOR COUNT WORD
+	HRRZ	C,-5(TP)		;GET THE CHARACTER COUNT
+	MOVEM	C,5(B)			;STORE IN CORRECT SLOT IN MESSAGE
+	MOVE	D,[6,,6]		;OFFSET FOR INITIAL HEADER ON ASCII MESSAGES
+	ADDM	D,(TP)			;OFFSET BUF PTR 2 BY THIS AMOUNT
+	JRST	CASND5
+CASND4:	MOVE	C,(P)			;GET COUNT OF MESSAGE
+	ADDI	C,1			;EXTRA FOR TYPE WORD
+	MOVEM	C,3(B)			;STORE IN SLOT FOR COUNT OF WHOLE MESSAGE
+	MOVE	D,[5,,5]		;OFFSET FOR INITIAL HEADER ON UVECTOR MESSAGES
+	ADDM	D,(TP)			;OFFSET BUF PTR 2 BY THIS AMOUNT
+CASND5:	PUSHJ	P,STUFBF		;GO FILL UP THE BUFFER WITH GARBAGE
+	MOVN	0,A			;GET NEGATIVE THE COUNT OF WORDS STUFFED
+	ADDM	0,(P)			;THAT MANY LESS WORDS REMAINING TO BE DONE
+	HRRZ	C,-2(TP)		;GET A POINTER TO THE "UNRESTED" BUFFER
+	HRRZ	D,(TP)			;GET A POINTER TO THE "RESTED" BUFFER
+	SUB	D,C			;FIND OUT HOW MUCH WAS RESTED OFF
+	ADD	D,A			;ADD TO THAT THE COUNT OF WORDS STUFFED THIS TIME
+	SUBI	D,BUFHED		;LESS THE SYSTEM CONSTANT HEADER THAT DOENT COUNT
+	MOVEM	D,2(C)			;STORE IN THE BUFFER IN CORRECT SLOT
+	PUSHJ	P,CASIOT		;GO DO THE "IOT"--ACTUALLY AN OPEN
+	MOVE	C,-2(TP)
+	HRLZI	E,CONT			;THE "THIS IS A CONTINUATION" BIT
+	IORM	E,3(C)			;TURN BIT ON IN FUTURE MESSAGES
+	ADD	C,[4,,4]		;REST OFF THE SHORTER HEADER FOR THE REST OF MESSAGES
+	MOVEM	C,(TP)			;STORE THIS IN THE "RESTED" BUFFER SLOT
+	SKIPLE	(P)			;IS THERE MORE TO DO?
+	JRST	CASND5
+	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST 	FINIS			;RETURN HIM SOMETHING NICE
+
+TOBIGR:	ERRUUO	EQUOTE MESSAGE-TOO-BIG
+
+
+STUFBF:	MOVE	C,-2(TP)			;ROUTINE TO FILL UP BUFFER WITH GOODIES
+	HRLZI	E,INCOMP+ASCIMS
+	ANDCAM	E,3(C)				;CLEAR THE INCOMPLETE AND ASCII FLAGS IF SET
+	HLRE	B,(TP)				;GET THE BUFFER LENGTH
+	MOVN	B,B				;MAKE IT A POSITIVE NUMBER
+	CAML	B,-1(P)				;SEE IF THE WHOLE MESSAGE WILL FIT
+	JRST	.+4				;IT WILL ALL FIT
+	HRLZI	0,INCOMP			;THE INCOMPLETE FLAG
+	IORM	0,3(C)				;SET IT
+	JRST	.+2
+	MOVE	B,-1(P)				;ELSE THE WHOLE MESSAGE FITS
+	GETYP	0,-5(TP)
+	CAIN	0,TCHSTR
+	JRST	STUFAS
+	HRLZ	D,-4(TP)			;SET UP TO BLT UVECTOR
+	HRR	D,(TP)
+	HRRZ	E,(TP)
+	ADDI	E,(B)-1				;SET UP BLT POINTERS
+	SKIPLE	B				;IN CASE ZERO LENGTH UVECTOR
+	BLT	D,(E)				;BBBBLLLLLLLLLLLLLLLLLLTTTT?
+	MOVE	A,B				;MOVE COUNT OF WORDS DONE INTO A
+	HRL	B,B
+	ADDM	B,-4(TP)			;REST OFF THIS MUCH OF GOODIE FOR NEXT TIME
+	POPJ	P,
+STUFAS:	HRLZI	0,ASCIMS
+	IORM	0,3(C)				;TURN ON THE ASCII BIT IN THE MESSAGE
+	MOVE	A,B				;MOVE COUNT OF NUMBER OF WORDS INTO A
+	IMULI	B,5				;GET CHAR COUNT IN B
+	HRRZ	C,-5(TP)			;COMPARE THIS WITH COUNT FIELD IN STRING
+	MOVE	D,B
+	SUB	D,C				;SEE HOW MANY EXTRA BLANKS AT END OF MESS
+	JUMPGE	D,.+3
+	MOVEI	D,0				;NO EXTRA SPACES TO PAD
+	MOVE	C,B				;NOT EXTRA SPACES, DO 5*WORD CHARS
+	MOVN	E,C
+	ADDM	E,-5(TP)			;FIX UP COUNT IN ASCII
+	HRLZI	E,440700			;GET A IDPB PTR INTO THE BUFFER
+	HRR	E,(TP)				;POINT TO RIGHT PLACE IN BUFFER
+	JUMPLE	C,.+4				;ARE WE DONE MOVING CHARS?
+	ILDB	0,-4(TP)			;LOAD A BYTE FROM STRING
+	IDPB	0,E				;STUFF IN BUFFER
+	SOJG	C,.-2				;REPEAT THE LOOP
+	JUMPLE	D,.+4				;SEE IF WE NEED TO FILL OUT WITH NULLS
+	MOVEI	0,0
+	IDPB	0,E				;STUFF A NULL IN RIGHT SPOT IN BUFFER
+	SOJG	D,.-1
+	POPJ	P,
+
+CASIOT:	HRRZI	A,(SIXBIT /IPC/)		;FIX UP OPEN BLOCK IN THE AC'S
+	MOVE	B,-2(TP)			;HOWS THAT FOR SNAZZY?
+	MOVE	C,-3(P)				;MY NAME 1
+	MOVE	D,-2(P)				;MY NAME 2
+	JUMPN	C,.+3
+	JUMPN	D,.+2
+	TLO	A,USEUJ				;IF BOTH ARE ZERO THEN USE DEFAULT UNAME,JNAME
+	SKIPN	-7(P)				;SEE IF SEND AND HANG FLAG IS SET
+	JRST	.+3
+	TLO	A,SANDH				;SET SEND AND HANG FLAG
+	JRST	.+3
+	TLO	A,SIMM				;ELSE WE MUST BE SENDING IMMEDIATE
+	AOS	-7(P)				;IF THERE IS MORE TO DO, IT MUST BE IN HANG MODE
+	MOVSI	0,TUVEC
+	MOVE	PVP,PVSTOR+1
+	MOVEM	0,BSTO(PVP)			;IN CASE WE ARE INTERRUPTED OUT WE WANT TO WIN
+	SETZM	E				;FLAG USED TO INDICATE NO SKIPPAGE
+	ENABLE
+	.OPEN	0,A				;WELL, THATS ALL THERE IS TO IT.
+	AOS	E				;IF WE DONT SKIP WE HAVE PROBLEMS
+	DISABLE
+	MOVE	PVP,PVSTOR+1
+	SETZM	BSTO(PVP)			;FIX UP THE SLOT IN PVP
+	SKIPN	E				;SEE IF WE LOST
+	POPJ	P,				;IF NOT WE ARE THROUGH WITH THIS PART
+	.STATUS	0,A				;FIND OUT REASON FOR LOSSAGE
+	MOVEI	B,0
+	PUSHJ	P,GFALS				;MAKE A FALSE WITH THAT REASON
+	JRST	FINIS				;GIVE THE MAGIC FALSE BACK TO THE LOOSER
+
+
+MFUNCTION	DEMSIG,SUBR
+
+	ENTRY 1
+
+	MOVE	A,(AB)
+	MOVE	B,1(AB)
+	PUSHJ	P,STRTO6		;GET THE SIXBIT REPRESENTATION
+	MOVE	A,[SETZ]		;FIX UP THE BLOCK IN THE AC'S
+	MOVE	B,[SIXBIT /DEMSIG/]
+	MOVE	C,[SETZ	(P)]		;THE SIXBIT IS ON TOP OF P STACK
+	.CALL	A
+	JRST	RFALS			;DIDNT WIN WITH DEMON SIGNAL
+RTRUE:	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS
+
+RFALS:	MOVSI	A,TFALSE
+	MOVEI	B,0
+	JRST	FINIS			;FALSE INDICATING LACK OF WINNAGE
+
+
+MFUNCTION	IPCON,SUBR,[IPC-ON]
+
+	ENTRY
+
+	PUSH	P,[USEUJ,,0]		;FLAG FOR WHETHER OR NOT TO USE DEFAULT
+	HLRZ	0,AB
+	JUMPE	0,IPCON1		;NO ARGS ARE FINE
+	CAIE	0,-4			;ELSE MUST HAVE 2 ARGS
+	JRST	WNA
+	SETZM	(P)			;CLEAR OUR FLAG
+	MOVE	A,(AB)
+	MOVE	B,1(AB)
+	PUSHJ	P,STRTO6		;GET SIXBIT OF OUR FIRST ARG
+	MOVE	A,2(AB)
+	MOVE	B,3(AB)
+	PUSHJ	P,STRTO6		;GET SIXBIT OF OUR SECOND ARG
+	JRST	IPCON2
+IPCON1:	PUSH	P,[0]			;SAVE SLOT ON STACK FOR EVENNESS
+	PUSH	P,[0]
+IPCON2:	MOVEI	A,BUFL+BUFHED
+	PUSHJ	P,CAFRE			;GET A BUFFER OF RIGHT LENGTH TO READ INTO
+	PUSH	P,A			;AND SAVE IT AROUND SO WE DONT LOOSE
+	MOVEI	0,BUFL
+	MOVEM	0,2(A)			;FILL COUNT IN THE BUFFER SLOT
+	MOVEI	A,5
+	PUSHJ	P,IBLOCK		;GET A BLOCK OF STORE FOR THE OPEN BLOCK
+	PUSH	TP,$TUVEC
+	PUSH	TP,B			;SAVE CRUFT ON TP
+	TLO	0,RFROMA		;SET THE READ FROM ANY FLAG
+	IOR	0,-3(P)			;FIX FOR DEFAULT UNAME,JNAME IF FLAG INDICATES
+	MOVEM	0,(B)			;MAKE OPEN BLOCK
+	MOVE	0,[SIXBIT /IPC/]
+	MOVEM	0,1(B)
+	MOVE	0,-2(P)
+	MOVEM	0,3(B)			;MY NAME 1
+	MOVE	0,-1(P)
+	MOVEM	0,4(B)			;MY NAME 2 IF NOT USING DEFAULT
+	MOVE	0,(P)
+	MOVEM	0,2(B)			;PTR TO THE WIRED BUFFER FOR STUFFING CRUFT
+	MOVE	A,B
+	PUSHJ	P,MOPEN			;GO DO THE OPEN
+	JRST	IPCON3			;OPEN FAILED, FIND OUT WHY
+	PUSH	P,A			;SAVE THE CHANNEL NUMBER
+	MOVEI	E,1
+	LSH	E,(A)			;SET INTERRUPT BITS RIGHT
+	IORM	E,MASK2
+	.SUSET	[.SMSK2,,MASK2]
+	MOVE	C,-1(TP)
+	MOVE	D,(TP)			;GET THE OPEN BLOCK UVECTOR
+	PUSHJ	P,INCONS		;THROW INTO PAIR SPACE
+	POP	P,C			;GET THE CHANNEL #
+	SUBI	C,1
+	IMULI	C,2
+	MOVEM	B,IPCS1+1(C)		;STUFF PTR TO OPEN BLOCK INTO SLOT IN TVP
+	JRST	RTRUE			;WE WON, GO LET LUSER KNOW IT.
+IPCON3:	PUSH	P,A			;WE LOST, LETS FIND OUT WHY
+	MOVE	A,BUFL+BUFHED
+	MOVE	B,-1(P)			;LETS FREE UP OUR WIRED DOWN BUFFER TO BE CLEAN
+	PUSHJ	P,CAFRET
+	POP	P,A			;GET THE CHANNEL # BACK
+	JUMPL	A,NFCHN			;NO FREE CHANNELS?
+	MOVE	B,[.STATUS A]		;MAKE A CALL TO STATUS TO FIND REASON
+	LSH	A,23.			;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
+	IOR	B,A			;FIX UP .STATUS
+	XCT	B
+	MOVEI	B,0
+	PUSHJ	P,GFALS
+	JRST	FINIS			;RETURN A LOOSE WITH REASON FOR LOOSAGE
+
+NFCHN:	ERRUUO	EQUOTE NO-ITS-CHANNELS-FREE
+
+
+MFUNCTION	IPCOFF,SUBR,[IPC-OFF]
+
+	ENTRY	0
+
+	PUSH	TP,$TVEC
+	MOVE	0,[IPCS1,,IPCS1]
+	PUSH	TP,0			;SAVE OUR PLACE IN RUNNING THROUGH SLOTS
+	PUSH	P,[1]			;COUNTER OF CHANNEL NUMBER
+
+IPCOF1:	MOVE	A,(TP)			;GET FIRST GOODIE
+	SKIPN	B,1(A)			;GET THE POINTER TO LIST
+	JRST	IPCOF2
+	SETZM	1(A)			;ZERO OUT SLOT TO BE CLEAN
+	MOVE	B,1(B)			;GET CAR OF LIST, PTR TO OPEN BLOCK
+	MOVE	C,(P)			;GET THE ACTUAL CHANNEL NUMBER
+	MOVEI	E,1			;TURN OFF INTERRUPT
+	LSH	E,(C)
+	ANDCAM	E,MASK2
+	.SUSET	[.SMSK2,,MASK2]
+	MOVE	A,C
+	PUSHJ	P,MCLOSE		;CLOSE THIS CHANNEL
+	JFCL
+	MOVEI	A,BUFL+BUFHED		;LENGTH OF WIRED STORE TO FREE UP
+	MOVE	B,1(B)			;GET THE POINTER TO WIRED STORE
+	PUSHJ	P,CAFRET			;FREE ALREADY
+IPCOF2:	MOVE	0,[2,,2]
+	ADDM	0,(TP)			;REST TO NEXT SLOT
+	AOS	D,(P)			;NEXT CHANNEL
+	CAIG	D,15.			;ARE WE THROUGH
+	JRST	IPCOF1
+	JRST	RTRUE			;RETURN HIM A TRUE FOR NICENESS
+
+
+IPCGOT:	MOVEI	D,IPCS1+1
+	ADDI	D,(B)
+	ADDI	D,(B)
+	SKIPN	D,-74.(D)	;GET THE GOODIE LIST FOR CHANNEL WE INTERRUPTED ON
+	JRST	DIRQ		;MIX UP MAYBE, LET HIM WORRY ABOUT IT
+	PUSH	P,B		;SAVE THE CHAN #
+	PUSH	TP,$TLIST
+	PUSH	TP,D		;SAVE GOODIE LIST
+	MOVE	E,1(D)		;GET PTR TO OPEN BLOCK
+	PUSH	P,2(E)		;SAVE PTR TO WIRED BUFFER
+	MOVE	E,2(E)
+	MOVE	0,3(E)		;GET THE MAGIC BITS FOR THIS MESSAGE
+	TLNE	0,CONT		;IS THIS MESSAGE A CONTINUATION?
+	JRST	IGCON		;YES
+	MOVEI	A,10.		;NO
+	PUSHJ	P,GIBLOK	;GET A BLOCK FOR FUNNY MESSAGE VECTOR
+	PUSH	TP,$TVEC
+	PUSH	TP,B		;SAVE THE BLOCK FOR FUNNY MESSAGE VECTOR
+	MOVE	E,(P)		;GET PTR TO WIRED BUFFER
+	MOVE	0,3(E)		;GET THE MAGIC BITS AGAIN
+	HRRZ	A,0		;GET THE LENGTH IN WORDS OF THIS THE WHOLE MESSAGE HE HAS
+	SUBI	A,1		;MINUS ONE FOR THE TYPE WORD WHICH IS COUNTED
+	TLNE	0,ASCIMS	;IS THIS ASCII?
+	SUBI	A,1		;IF YES THEN MUST SUB 1 MORE FOR ASCII CHAR COUNT
+	CAILE	A,MAXMES	;IS THIS BIGGER THAN MUDDLE BLESSES?
+	JRST	TBGMS		;IF SO THEN CLEAN UP AND FORGET ABOUT THE LOOSER
+	PUSHJ	P,IBLOCK
+	MOVE	E,(P)
+	MOVE	D,(TP)
+	MOVE	0,(E)		;GET HIS NAME 1 OUT OF MESSAGE
+	MOVEM	0,5(D)		;STORE INTO SLOT IN FUNNY MESSAGE VECTOR
+	MOVE	0,1(E)		;GET HIS NAME 2 OUT OF MESSAGE
+	MOVEM	0,7(D)
+	MOVE	0,4(E)		;GET THE MESSAGE TYPE WORD
+	MOVEM	0,9(D)		;STORE INTO SLOT IN MESSAGE VECTOR
+	MOVSI	0,TFIX
+	MOVE	0,4(D)
+	MOVE	0,6(D)
+	MOVE	0,8(D)
+	MOVE	0,3(E)		;GET THE MESSAGE BITS
+	TLNE	0,ASCIMS	;IS IT ASCII?
+	JRST	IG1		;YES
+	MOVSI	0,TUVEC
+	MOVEM	0,(D)
+	MOVEM	0,2(D)
+	MOVEM	B,1(D)
+	MOVEM	B,3(D)		;STORE MESSAGE BLANK TWICE, THE SECOND TO REST THROUGH
+	HLRE	E,B
+	SUBM	B,E
+	MOVSI	0,TFIX
+	MOVEM	0,(E)		;SET NICE TYPE TO PRINT GOODER
+	JRST	IGBLT
+IG1:	MOVSI	0,TUVEC
+	MOVEM	0,2(D)
+	MOVEM	B,3(D)		;STORE MESSAGE BLANK AS UVECTOR TO REST THROUGH
+	HLRE	A,B
+	HRLI	B,010700	;MAKE THE ILDB PTR
+	SUBI	B,1
+	MOVEM	B,1(D)		;AND STORE IN THE SLOT
+	IMUL	A,[-5]		;MAX CHAR COUNT FOR STRING
+	MOVE	B,5(E)		;GET THE ACTUAL CHARACTER COUNT HE CLAIMED
+	MOVE	C,A
+	SUB	C,B		;FIND DIFFERENCE BETWEEN MAX AND CLAIMED
+	JUMPL	C,.+2		;IF COUNT TOO BIG, MUST DO BEST POSSIBLE AND USE MAX COUNT
+	CAILE	C,4		;NO MORE THAN FOUR EXTRA CHARS IMPLIES GOODNESS
+	MOVE	B,A		;IF LOSSAGE, THEN USE MAX COUNT INSTEAD OF HIS CLAIM
+	HRLI	B,TCHSTR	;MAKE THIS A CHAR STRING TYPE WORD
+	MOVEM	B,(D)		;AND FIX MESSAGE BLANK # 1 TO BE THE BLESSED STRING
+	JRST	IGBLT		;BLT THE MESSAGE INTO THE BLANK
+
+IGCON:	MOVE	D,(TP)		;GET THE IPC SLOT LIST
+	MOVE	E,(P)		;GET A PTR TO THE MESSAGE BUFFER
+	HRRZ	C,(D)		;CDR THE IPC SLOT LIST TO POINT TO FIRST MESSAGE VECTOR
+IGCON1:	JUMPE	C,IGCONL	;IF NIL, THEN ABANDON ALL HOPE
+	MOVE	B,1(C)		;LOOK AT THE VECTOR
+	MOVE	0,5(B)		;HIS NAME 1 FOR THIS BLOCK
+	CAME	0,(E)		;COMPARE WITH HIS NAME 1 IN THIS MESSAGE
+	JRST	IGCON2		;IMMEDIATE FAILURE, TRY THE NEXT IN THE LIST
+	MOVE	0,7(B)		;SEE IF HIS NAME 2 ALSO MATCHES
+	CAME	0,1(E)		;WELL, DOES IT MATCH?
+	JRST	IGCON2		;NO, TRY THE NEXT ONE
+	PUSH	TP,$TVEC	;WE GOT IT
+	PUSH	TP,1(C)		;SAVE THIS MESSAGE BLOCK ON TP FOR LATER BLTING
+	HRRZ	C,(C)		;CDR TO REST OF LIST
+	HRRM	C,(D)		;AND SPLICE IT RIGHT OUT OF THE LIST, NEAT HUH?
+	JRST	IGBLT		;GO BLT TO OUR HEART'S CONTENT
+IGCON2:	HRRZ	D,(D)		;REST OUR FOLLOW UP POINTER
+	HRRZ	C,(C)		;REST OUR ACTUAL TEST POINTER
+	JRST	IGCON1		;TRY AGAIN
+
+IGCONL:	MOVE	A,(TP)
+	MOVE	A,1(A)		;GET PTR TO OPEN BLOCK
+	MOVE	B,-1(P)
+	SUBI	B,36.		;GET CHANNEL NUMBER
+	HLL	B,(A)
+	MOVE	C,(P)		;GET THE WIRED BUFFER
+	SUB	P,[2,,2]	;WE LOST SO CLEAN UP STACKS
+	SUB	TP,[2,,2]
+ROPNL:	SETZM	(C)		;REOPEN CHANNEL SO NOT PERMANENTLY CROGGLED
+	SETZM	1(C)		;ZERO OUT THE HIS NAME SLOTS
+	MOVEI	0,BUFL
+	MOVEM	0,2(C)		;RESET THE LENGTH FIELD IN WIRED BUF
+	DOTCAL	OPEN,[B,1(A),2(A),3(A),4(A)]
+	FATAL CANT REOPEN IPC CHN
+	JRST	DIRQ		;LEFT IN NICE STATE AFTER LOOSAGE
+
+TBGMS:	MOVE	A,-2(TP)
+	MOVE	A,1(A)		;GET OPEN BLOCK
+	MOVE	B,-1(P)
+	SUBI	B,36.		;CHANNEL #
+	HLL	B,(A)
+	MOVE	C,(P)		;WIRED BUFFER
+	SUB	P,[2,,2]	;CLEAN UP STACKS
+	SUB	TP,[4,,4]
+	JRST	ROPNL		;REOPEN SO NEXT GUY CAN WIN
+
+
+
+IGBLT:	MOVE	E,(TP)		;POINTER TO MESSAGE VECTOR
+	MOVE	E,3(E)		;GET VECTOR (MAYBE STRING IN DISGUISE) TO BLT IN
+	MOVE	D,(P)		;GET THE WIRED BUFFER
+	MOVEI	C,4(D)		;GET A POINTER TO THE REST OF THE WIRED BUF
+	MOVEI	0,BUFL-1	;KLUDGE TO IGNORE ONE EXTRA WORD OF BITS
+	SUB	0,2(D)		;GET LENGTH OF GOODIE GOT
+	MOVE	A,3(D)		;GET THE RANDOM MESSAGE BITS
+	TLNE	A,CONT		;TEST FOR CONTINUED MESSAGE
+	JRST	.+7		;IF SO THEN NO NEED TO WORRY
+	SOS	0
+	AOS	C		;FIX UP FOR ONE LESS WORD TO WORRY WITH
+	TLNN	A,ASCIMS	;TEST FOR ASCII MESSAGE
+	JRST	.+3		;IF NOT THEN NO WORRY
+	SOS	0
+	AOS	C		;FIX UP FOR YET 1 FEWER WORD
+	HLRE	A,E
+	MOVM	A,A		;GET LENGTH OF VECTOR TO BLT INTO
+	CAILE	0,(A)		;CHECK TO SEE WE DONT HAVE TOO MUCH
+	MOVE	0,A		;IF WE HAVE TOO MUCH, CHOP OFF--HA, HA, HA
+	MOVEI	B,-1(E)
+	ADD	B,0		;B POINTS TO LAST WORD TO BLT INTO
+	HRL	C,E		;BLT POINTER
+	MOVSS	C		;NDR CANT REMEMBER HOW TO BLT POINTER
+	BLT	C,(B)		;VIOLA
+	HRL	0,0
+	MOVE	E,(TP)		;GET BACK POINTER TO MESSAGE VECTOR
+	ADDM	0,3(E)		;REST OFF TO KEEP TRACK OF INCOMPLETE MESSAGE
+	MOVE	A,3(D)		;GET THE RANDOM MESSAGE BITS BACK
+	TLNE	A,INCOMP	;MESSAGE COMPLETE?
+	JRST	IGHALF		;INCOMPLETE
+	JRST	IGMES		;COMPLETE
+
+IGHALF:	MOVE	C,-1(TP)	;GOT TO SPLICE MESSAGE VECTOR BACK IN
+	MOVE	D,(TP)
+	PUSHJ	P,INCONS	;STICK INTO PAIR SPACE
+	HRRZ	E,-2(TP)	;PTR TO LIST
+	HRRZ	D,(E)		;CDR OF LIST
+	HRRM	D,(B)		;MAKE SPLICE
+	HRRM	B,(E)		;THAT IT
+	MOVE	B,1(E)		;POINT TO OPEN BLOCK
+	MOVE	0,-1(P)		;GET CHAN #
+	SUBI	0,36.
+	HLL	0,(B)
+	MOVE	E,(P)		;GET THE WIRED BUF
+	MOVEI	D,BUFL
+	MOVEM	D,2(E)		;REFIX THE WIRED BUF
+	SETZM	(E)
+	SETZM	1(E)
+	DOTCAL	OPEN,[0,1(B),2(B),3(B),4(B)]
+	FATAL CANT REOPEN IPC CHN
+	SUB	P,[2,,2]
+	SUB	TP,[4,,4]	;CLEAN OURSELVES
+	JRST	DIRQ		;THATS ALL THERE IS TO IT
+
+IGMES:	HRRZ	E,-2(TP)	;PTR TO OUR KLUDGE LIST
+	MOVE	B,1(E)		;PTR TO OPEN BLOCK
+	MOVE	0,-1(P)		;CHANNEL #
+	SUBI	0,36.
+	HLL	0.(B)
+	MOVE	D,(P)		;GET THE WIRED BUF
+	MOVEI	C,BUFL
+	MOVEM	C,2(D)
+	SETZM	(D)
+	SETZM	1(D)		;BLESS WIRED BUF FOR REOPENING
+	DOTCAL	OPEN,[0,1(B),2(B),3(B),4(B)]
+	FATAL CANT REOPEN IPC CHN
+	MOVE	E,(TP)		;GET THE MESSAGE VECTOR (ALIAS GOODIE BLOCK)
+	SUB	P,[2,,2]	;BLESS OUR P STACK
+	PUSH	P,5(E)		;SAVE SIXBIT HIS NAME 1
+	PUSH	P,7(E)		;SAVE SIXBIT HIS NAME 2
+	SUB	TP,[4,,4]	;BLESS THE TP STACK
+	PUSH	TP,$TCHSTR
+	PUSH	TP,CHQUOTE IPC
+	PUSH	TP,(E)		;STUFF STUFF ON TO CALL INTERRUPT
+	PUSH	TP,1(E)		;THAT IS THE ACTUAL MESSAGE
+	MOVE	0,9(E)
+	CAMN	0,[400000,,0]
+	 JRST	IGUG
+IGUGN:	PUSH	P,3(B)		;GET MY NAME 1 OUT OF OPEN BLOCK
+	PUSH	P,4(B)		;GET MY NAME 2 OUT OF OPEN BLOCK
+	MOVE	0,(B)		;GET SOME OF THE RANDOM OPEN FLAGS
+	TLNE	0,USEUJ
+	SETZ	-1(P)		;MAKE SURE WE HAVE INDICATOR IF THIS IS TO UNAME,JNAME
+	PUSH	TP,$TFIX
+	PUSH	TP,9(E)		;SAVE THE MESSAGE TYPE
+	MOVE	A,-3(P)		;HIS NAME 1
+	PUSHJ	P,6TOCHS
+	PUSH	TP,A
+	PUSH	TP,B		;GIVE HIM NICE CHAR STRING OF ALL THE NAMES
+	MOVE	A,-2(P)
+	PUSHJ	P,6TOCHS
+	PUSH	TP,A
+	PUSH	TP,B		;NICE CHAR STRING OF HIS NAME 2
+	SKIPN	A,-1(P)		;ISE THIS DEFAULT UNAME, JNAME
+	JRST	IGFOUR		;ONLY FOUR ARGS TO THE IPC INTERRUPT
+	PUSHJ	P,6TOCHS
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVE	A,(P)
+	PUSHJ	P,6TOCHS
+	PUSH	TP,A
+	PUSH	TP,B		;GIVE HIM CHAR STRINGS OF MY NAME 1 AND 2 IF NOT DEFAULT
+	MOVEI	E,7		;FOR ACALL INDICATING 6 ARGS TO THE IPC INTERRUPT HANDLER
+	JRST	.+2		;SKIP OVER FIX FOR ONLY 4 ARGS TO IPC INTERRUPT
+IGFOUR:	MOVEI	E,5
+	SUB	P,[4,,4]	;CLEAN UP OUR WHOLE WORLD
+	ACALL	E,INTERR	;THATS IT FOLKS, THE REAL THING
+	JRST	DIRQ
+
+IGUG:	.SUSET	[.RMARPC,,0]
+	CAMN	0,[-1]
+	 JRST	IGUGN		; DISABLED, SO GO AWAY
+	SETZM	INTHLD		; RE-ENABLEE INTERRUPTS
+	SUB	P,[2,,2]
+	MCALL	1,PARSE
+	SUB	TP,[2,,2]	;FLUSH OFF STRING "IPC"
+	PUSH	TP,A
+	PUSH	TP,B
+	MCALL	1,EVAL
+	JRST	DIRQ
+
+
+IPCBLS:	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSH	P,E			;PARANOIA STRIKES AGAIN
+	PUSH	P,0
+	MOVEI	E,0			;CRETIN ASSEMBLER
+	.SUSET	[.SMARPC,,E]
+	MOVEI	E,IPCS1			;BLESSES ALL CURRENTLY OPEN IPC CHANNELS
+	MOVEI	0,1
+IPCBL1:	SKIPN	B,1(E)
+	JRST	IPCBL2
+	HLLZS	(B)			;CLEAR OUT ANY PARTIAL BUFFER WE MAY HAVE
+	HRRZ	B,1(B)			;GET A POINTER TO THE OPEN BLOCK
+	MOVE	A,0			;GET THE CHANNEL NUMBER
+	HLL	A,(B)
+	MOVE	C,2(B)			;GET A POINTER TO THE BUFFER	
+	MOVEI	D,BUFL			;TO FIX UP THE BUFFER
+	MOVEM	D,2(C)			;FIX LENGTH UP RIGHT
+	SETZM	(C)
+	SETZM	1(C)			;FIX UP THE READ FROM FIELDS
+	DOTCAL	OPEN,[A,1(B),2(B),3(B),4(B)]
+	FATAL IPC DEVICE LOST
+IPCBL2:	ADDI	E,2
+	ADDI	0,1
+	CAIG	0,15.
+	JRST	IPCBL1			;IF ANY MORE GO BLESS THEM
+
+	POP	P,0
+	POP	P,E
+	POP	P,D
+	POP	P,C
+	POP	P,B
+	POP	P,A
+	POPJ	P,
+
+
+
+
+END
+

src/mudsys/ldgc.mid.100

@@ -0,0 +1,504 @@
+TITLE LOADGC MODULE TO LOAD THE GARBAGE COLLECTOR
+
+RELOCA
+
+.INSRT MUDDLE >
+SYSQ
+IFE ITS,[
+.INSRT STENEX >
+XJRST==JRST 5,
+]
+IFN ITS,	PGSZ==10.
+IFE ITS,	PGSZ==9.
+
+; ROUTINES TO GET THE GC DO PDL OVERFLOWS IN GC AND ALLOCATE SPECIAL
+; BUFFERS.
+
+; IMPORTANT VARAIBLES
+
+.GLOBAL	PAGEGC			; STARTING PAGE OF GARBAGE COLLECTOR (PAGES)
+.GLOBAL	LENGC			; LENGTH OF GARBAGE COLLECTOR (PAGES)
+.GLOBAL SLENGC			; LENGTH OF MARK/SWEEP GARBAGE COLLECTOR
+.GLOBAL	MRKPDL			; STARTING LOCATION OF MARK PDL (WORDS)
+.GLOBAL	STRBUF			; START OF BUFFER LOCATIONS (WORDS)
+.GLOBAL SWAPGC			; WHICH GARBAGE COLLECTOR TO LOAD
+
+.GLOBAL MARK2G			; GENERAL MARKING ROUTINE FOR TEMPLATE STUFF
+.GLOBAL MARK2A,MARK2S		; SPECIFIC MARKERS IN SGC/AGC
+.GLOBAL SECLEN			; LENGTH OF SECTION GC GUY
+.GLOBAL MULTSG
+.GLOBAL SECBLK,DECBLK,GCDEBU,DEBUGC,NDEBUG
+.GLOBAL	FRETOP,PURBOT,PURTOP,GCPDL,LPUR,STRPAG,CKPUR,INPLOD,GETPAG,CURPLN,SGCLBK,PGCNT
+.GLOBAL	LODGC,CKFILE,SLEEPR,KILGC,GETBUF,KILBUF,GPDLOV,GCDIR,INTDIR,GCLDBK
+.GLOBAL OPBLK,SJFNS,IJFNS,OPSYS,IJFNS1,RBLDM,ILDBLK,TILDBL
+.GLOBAL TMTNXS,C%1
+
+IFN ITS,[
+IMAPCH==0			; INTERNAL MAPPING CHANNEL
+MAPCHN==1000,,IMAPCH		; CORBLK CHANNEL
+FME==1000,,-1			; BITS FOR CURRENT JOB
+FLS==1000,,0			; BITS TO FLUSH A PAGE
+RDTP==1000,,200000		; BITS TO MAP IN IN READ-ONLY
+WRTP==1000,,100000
+CRJB==1000,,400001		; BITS TO ALLOCATE CORE
+CWRITE==1000,,4000
+]
+IFE ITS,[
+MFORK==400000
+CTREAD==100000		; READ BIT
+CTEXEC==20000		; EXECUTE BIT
+CTWRIT==40000		; WRITE BIT
+CTCW==400		; COPY ON WRITE
+SGJF==1			; USE SHORT JFN (LH FLAG)
+OLDF==100000		; REQUIRE OLD (EXISTING FILE) (LH FLAG)
+FREAD==200000		; READ BIT FOR OPENF
+FEXEC==40000		; EXEC BIT FOR OPENF
+FTHAW==2000
+]
+; GENERAL MARK ROUTINE FOR TEMPLATE STUFF.  GOES TO RIGHT PLACE IN
+; WHICHEVER GC'ER WE'RE USING AT THE MOMENT
+MARK2G:	SKIPN	SWAPGC
+	 JRST	MARK2A	; INTO AGC
+	JRST	MARK2S	; INTO SGC
+
+; ROUTINE TO LOAD THE GARBAGE COLLECTOR
+
+LODGC:
+IFN ITS,[
+      	MOVEI	0,GCLDBK
+	SKIPE	SWAPGC			; SKIP IF SWAPPED GARBAGE COLLECTOR 
+	MOVEI	0,SGCLBK
+	MOVEM	0,OPBLK
+
+
+	.SUSET	[.RSNAM,,SAVSNM]	; SAVE OLD SNAME
+	.SUSET	[.SSNAM,,GCDIR]		; SET SNAME TO APP DIR
+	.OPEN	IMAPCH,@OPBLK		; OPEN CHANNEL TO FILE
+	PUSHJ	P,CKFILE		; SEE IF REALLY LOSING
+	HRLZI	A,-LENGC+3
+	SKIPE	SWAPGC
+	HRLZI	A,-SLENGC
+	MOVE	B,A			; B WILL CONTAIN PTR TO CORE
+	HRRI	B,PAGEGC
+	DOTCAL	CORBLK,[[RDTP],[FME],B,[MAPCHN],A]
+	PUSHJ	P,SLEEPR
+	HRLI	B,-1
+	SKIPN	SWAPGC			; IF SWAP 1 PAGE FOR CORBLK ELSE 3
+	HRLI	B,-3
+GETIT:	DOTCAL	CORBLK,[[WRTP],[FME],B,[CRJB]]
+	PUSHJ	P,SLEEPR
+	.CLOSE	IMAPCH,
+	MOVEI	A,LENGC			; SMASH PAGECOUNT
+	SKIPE	SWAPGC
+	MOVEI	A,SLENGC+1		; PSTACK
+	MOVEM	A,PGCNT
+	POPJ	P,
+
+; SEE WHY OPEN FAILED
+
+CKFILE:	.STATUS	IMAPCH,0		; GET STATUS BITS INTO 0
+	HRLZS	0
+	ANDI	0,77			; AND OF EXTRANEOUS BITS
+	CAIN	0,4			; SKIP IF NOT FNF
+	FATAL	CANT OPEN AGC FILE
+
+SLEEPR:	MOVEI	0,1			; SLEEP FOR A WHILE
+	.SLEEP	
+	SOS	(P)			; TRY AGAIN
+	SOS	(P)
+	POPJ	P,			; BYE
+]
+
+IFE ITS,[
+	HRRZ	A,IJFNS1
+	SKIPN	MULTSG
+	HLRZ	A,IJFNS
+	SKIPE	SWAPGC
+	HLRZ	A,IJFNS1
+	JUMPN	A,GOTJFN
+	
+; HERE TO GET GC JFNS
+; GET STRING NAME OF MDL INTERPRETER FILE
+	HRRZ	A,IJFNS			; INTERPRETER JFN
+	MOVE	B,A			; SET UP FOR JFNS
+	PUSHJ	P,TMTNXS		; MAKES A STRING ON P STACK
+	MOVE	D,E			; SAVED VALUE OF P STACK
+	HRROI	A,1(E)			; STRING FOR RESULT
+	MOVE	C,[211000,,1]		; GET "DEV:<DIR>NM1" FROM JFNS
+	JFNS
+	MOVE	C,A			; SAVE TO REUSE FOR ".SGC"
+; GET JFN TO AGC FILE
+	MOVEI	B,[ASCIZ /.AGC/]
+	SKIPN	MULTSG
+	 JRST	.+4
+	MOVEI	B,[ASCIZ /.DEC/]
+	SKIPN	GCDEBU	
+	 MOVEI	B,[ASCIZ /.SEC/]
+	SKIPE	SWAPGC
+	MOVEI	B,[ASCIZ /.SGC/]
+	HRLI	B,440700
+	ILDB	B
+	IDPB	A
+	JUMPN	.-2			; COPY ".AGC" INTO STRING
+	HRROI	B,1(E)			; GTJFN STRING
+	MOVSI	A,SGJF+OLDF		; GTJFN CONTROL BITSS
+	GTJFN
+	 FATAL	AGC GARBAGE COLLECTOR IS MISSING
+	SKIPN	SWAPGC
+	 JRST	.+3
+	HRLM	A,IJFNS1
+	JRST	JFNIN
+	SKIPE	MULTSG
+	 HRRM	A,IJFNS1
+	SKIPN	MULTSG
+	 HRLM	A,IJFNS
+JFNIN:	MOVE	B,[440000,,FREAD+FEXEC]
+	OPENF
+	 FATAL	CANT OPEN AGC FILE
+	MOVE	P,E
+GOTJFN:
+	MOVEI	D,SECLEN+SECLEN-2
+	SKIPN	MULTSG
+	MOVEI	D,LENGC+LENGC-6		; # OF TENEX PAGES TO GET IT
+	SKIPE	SWAPGC
+	MOVEI	D,SLENGC+SLENGC
+	MOVSI	A,(A)			; JFN TO LH
+	MOVE	B,[MFORK,,PAGEGC+PAGEGC]
+	MOVSI	C,CTREAD+CTEXEC
+
+LDLP:	PMAP
+	ADDI	A,1
+	ADDI	B,1
+	SOJG	D,LDLP
+
+	MOVEI	C,0
+	MOVEI	D,6		; THESE PAGES WILL BE THE GC PDL
+	SKIPN	MULTSG
+	SKIPE	SWAPGC
+	MOVEI	D,2		; PDL BUT NO FRONT OR WINDOW
+	MOVNI	A,1
+
+LDLP1:	PMAP
+	ADDI	B,1
+	SOJG	D,LDLP1
+
+	MOVEI	A,SECLEN+1
+	SKIPN	MULTSG
+	MOVEI	A,LENGC		; SMASH PAGECOUNT
+	SKIPE	SWAPGC
+        MOVEI	A,SLENGC+1
+	MOVEM	A,PGCNT
+	POPJ	P,
+
+;ROUTINE TO "SLEEP" FOR A WHILE ON 10X/20X  HA HA
+SLEEPR:	SOS	(P)
+	POPJ	P,
+]
+
+; ROUTINE TO LOAD THE INTERPRETER
+; C=>LENGTH OF PAGES
+; D=>START OF PAGES
+
+LODINT:
+IFN ITS,[
+	.SUSET	[.RSNAME,,SAVSNM]
+LODIN1:	.IOPUS	IMAPCH,
+	.SUSET	[.SSNAM,,INTDIR]
+	.OPEN	IMAPCH,ILDBLK		; OPEN FILE TO INTERPRETER BLOCK
+	PUSHJ	P,CKFILE
+	HLRE	B,TP			; MAKE SURE BIG ENOUGJ
+	MOVNS	B			; SEE IF WE WIN
+	CAIGE	B,400			; SKIP IF WINNING
+	FATAL	NO ROOM FOR PAGE MAP
+	MOVSI	A,-400
+	HRRI	A,1(TP)
+	.ACCES	IMAPCH,C%1
+	.IOT	IMAPCH,A		; GET IN PAGE MAP
+	MOVEI	A,1			; INITIALIZE FILE PAGE COUNT
+	MOVEI	B,0			; CORE PAGE COUNT
+	MOVEI	E,1(TP)
+LOPFND:	HRRZ	0,(E)
+	JUMPE	0,NOPAG			; IF 0 FORGET IT
+	ADDI	A,1			; AOS FILE MAP
+NOPAG:	ADDI	B,1			; AOS PAGE MAP
+	CAIE	B,(D)			; SKIP IF DONE
+	AOJA	E,LOPFND
+	MOVNI	0,(C)			; GET PAGE-COUNT
+	HRL	A,0			; BUILD FILE PAGE POINTER
+	HRL	B,0			; BUILD	CORE PAGE POINTER
+	DOTCAL	CORBLK,[[RDTP],[FME],B,[MAPCHN],A]
+	PUSHJ	P,SLEEPR		; GO TO SLEEP FOR A WHILE
+	.CLOSE	IMAPCH,
+	.IOPOP	IMAPCH,
+	.SUSET	[.SSNAM,,SAVSNM]
+	POPJ	P,			; DONE
+]
+IFE ITS,[
+	HRRZ	E,IJFNS
+	MOVEI	A,(E)			; FIND OUT LENGTH OF MAP
+	MOVEI	B,0
+	SFPTR
+	FATAL	CANNOT RESET FILE POINTER
+	MOVEI	A,(E)
+	BIN				; GET LENGTH WORD
+	MOVEI	A,(B)			; ISOLATE SIZE OF MAP
+	HLRZ	0,B
+	HLRE	B,TP			; MUST BE SPACE FOR CRUFT
+	MOVNS	B
+	CAIGE	B,(A)			; ROOM?
+	FATAL	NO ROOM FOR PAGE MAP (GULP)
+	PUSH	P,C			; SAVE # PAGES WANTED
+	MOVN	C,A
+	MOVEI	A,(E)			; READY TO READ IN MAP
+	MOVEI	B,1(TP)			; ONTO TP STACK
+	HRLI	B,444400
+	SIN				; SNARF IT IN
+
+	MOVEI	A,1(TP)
+	CAIE	0,1000			; CHECK FOR TENEX
+	JRST	TOPS20
+	LDB	0,[221100,,(A)]		; GET FORK PAGE
+	CAIE	0,(D)			; GOT IT?
+	AOJA	A,.-2
+	HRRZ	A,(A)
+	JRST	GOTPG
+
+TOPS21:	ADDI	A,2
+TOPS20:	HRRZ	0,1(A)			; GET PAGE IN PROCESS
+	LDB	B,[331100,,1(A)]	; GET REPT COUNT
+	ADD	B,0			; LAST PAGE  IN BLOCK
+	CAIG	0,(D)
+	CAIGE	B,(D)			; WITHIN RANGE?
+	JRST	TOPS21
+	SUBM	D,0
+	HRRZ	A,(A)
+	ADD	A,0
+
+GOTPG:	HRLI	A,(E)
+	MOVEI	B,(D)
+	HRLI	B,MFORK
+	MOVSI	C,CTREAD+CTEXEC		; BITS
+	POP	P,D			; PAGES
+	ASH	D,1			; FOR TENEX
+
+MPLP:	PMAP
+	ADDI	A,1
+	ADDI	B,1
+	SOJG	D,MPLP			; MAP-EM IN
+
+	POPJ	P,
+]
+
+; ROUTINE TO MAP IN OVER GARBAGE COLLECTOR EXPLICITLY
+
+KILGC:
+IFN ITS,[
+	MOVEI	D,PAGEGC
+	MOVE	C,PGCNT
+	JRST	LODIN1
+]
+IFE ITS,[
+	MOVEI	D,PAGEGC+PAGEGC
+	MOVE	C,PGCNT
+	JRST	LODINT
+]
+
+; ROUTINE TO TRY TO ALLOCATE A BUFFER
+; 1) IT FIRSTS LOOKS BETWEEN FRETOP AND PURBOT
+; 2) LOOKS AT THE INTERPRETER
+; A=>NUMBER OF BUFFER PAGES (CURRENTLY ALWAYS 1)
+; B=>BUFFER
+; BUFFER SAVED IN BUFPTR
+
+GETBUF:	ASH	A,10.			; CONVERT TO WORDS
+	MOVE	B,PURBOT		; LOOK FOR ROOM IN GCS
+	SUB	B,FRETOP
+	CAMGE	B,A			; SKIP IF WINNING
+	JRST	NOBUF1
+	MOVE	B,FRETOP		; BUFFER IN B
+	MOVEM	B,BUFPTR		; SAVE BUFFER
+	ASH	A,-10.			; TO PAGES
+	MOVEM	A,BUFLT			; LENGTH OF BUFFER
+	POPJ	P,
+NOBUF1:	ASH	A,-10.			; BACK TO WORDS
+	SKIPE	INPLOD			; SKIP IF NOT IN MAPPUR
+	JRST	INTBUF
+	PUSH	P,A
+	PUSH	P,E
+	JSP	E,CKPUR
+	POP	P,E
+	POP	P,A
+	MOVE	B,PURTOP
+	SUB	B,PURBOT
+	SUB	B,CURPLN
+	ASH	B,-10.			; CALCULATE AVAILABLE ROOM
+	CAIGE	B,(A)			; SEE IF ENOUGH
+	JRST	INTBUF			; LOSE LOSE GET BUFFER FROM INTERPRETER
+IFE ITS,	ASH	A,1		; TENEX PAGES
+	PUSH	P,C
+	PUSH	P,D
+	PUSH	P,E
+	PUSHJ	P,GETPAG		; GET THOSE PAGES
+	FATAL	GETPAG FAILED
+	POP	P,E
+	POP	P,D
+	POP	P,C
+IFE ITS,	ASH	A,-1
+	JRST	GETBUF			; TRY AGAIN
+INTBUF:	MOVEM	A,BUFLT
+IFN ITS,[
+	MOVNS	A			; NEGATE
+	HRLZS	A			; SWAP
+	HRRI	A,STRPAG		; AOBJN TO PAGE
+	MOVE	B,A
+	DOTCAL	CORBLK,[[FLS],[FME],A]
+	FATAL	CANT FLUSH PAGE
+	DOTCAL	CORBLK,[[WRTP],[FME],B,[CRJB]]
+	PUSHJ	P,SLEEPR
+]
+
+IFE ITS,[
+	PUSH	P,C
+	MOVEI	C,(A)		; PAGES TO FLUSH
+	ASH	C,1
+	MOVNI	A,1			; FLUSH PAGES
+	MOVE	B,[MFORK,,STRPAG+STRPAG]	; WHICH ONES
+FLSLP:	PMAP
+	ADDI	B,1
+	SOJG	C,FLSLP
+	POP	P,C
+]
+	MOVEI	B,STRBUF		; START OF BUFFER
+	MOVEM	B,BUFPTR		; SAVE IN BUFPTR
+	PUSHJ	P,RBLDM
+	POPJ	P,
+
+; ROUTINE TO FLUSH A BUFFER WHEN DONE WITH IT
+
+KILBUF:	SKIPN	B,BUFPTR		; SEE IF BUFPTR EXISTS
+	POPJ	P,
+IFE ITS,	JRST	@[.+1]		; RUN IN SECTION 0
+	CAIL	B,HIBOT			; SKIP IF NOT PART OF INTERPRETER
+	JRST	HIBUF			; INTERPRETER
+IFN ITS,[
+	ASH	B,-10.
+	MOVN	A,BUFLT			; GET LENGTH
+	HRLI	B,(A)			; BUILD PAGE AOBJN
+	DOTCAL	CORBLK,[[FLS],[FME],B]
+	FATAL	CANT FLUSH PAGES
+]
+IFE ITS,[
+	ASH	B,-9.			; TO PAGES
+	HRLI	B,MFORK
+	MOVNI	A,1
+	MOVE	D,BUFLT
+	LSH	D,1			; TO TENEX PAGES
+	PUSH	P,C			; SAVE C
+	MOVEI	C,0			; C CONTAINS SOME FLAGS
+
+FLSLP1:	PMAP
+	ADDI	B,1
+	SOJG	D,FLSLP1
+
+	POP	P,C			; RESTORE C
+]
+
+FLEXIT:	SETZM	BUFPTR
+	SETZM	BUFLT
+IFE ITS,[
+	PUSH	P,A
+	HLRZ	A,SJFNS
+	JUMPE	A,.+3
+	CLOSF
+	 JFCL
+	SETZM	SJFNS
+	POP	P,A
+	SKIPN	MULTSG
+	 POPJ	P,
+	POP	P,21
+	SETZM	20
+	XJRST	20
+]
+IFN ITS,[
+	POPJ	P,
+]
+HIBUF:	MOVE	C,BUFLT
+	MOVE	D,BUFPTR
+IFN ITS,	ASH	D,-10.
+IFE ITS,	ASH	D,-9.
+	PUSHJ	P,LODINT
+	JRST	FLEXIT
+
+; HERE TO HANDLE GC PDL OVERFLOW. ROUTINE USES A,B AND ASSUMES GCPDL IS THE PDL
+
+GPDLOV:	HRRZ	A,PGCNT			; # OF PAGES TO A
+	ADDI	A,PAGEGC		; SEE IF ROOM
+	ASH	A,10.			; TO WORDS
+	CAIL	A,LPUR			; HAVE WE LOST
+	FATAL	NO ROOM FOR GCPDL
+IFN ITS,[
+	ASH	A,-10.			; GET PAGE NUMBER
+	AOS	PGCNT			; AOS
+	DOTCAL	CORBLK,[[FLS],[FME],A]
+	FATAL	CANT FLUSH PAGE
+	DOTCAL	CORBLK,[[WRTP],[FME],A,[CRJB]]
+	PUSHJ	P,SLEEPR
+]
+IFE ITS,[
+	ASH	A,-9.
+	AOS	PGCNT
+	MOVE	B,A
+	MOVNI	A,1
+	HRLI	B,MFORK
+	PUSH	P,C			; BETTER HAVE A PDL HERE
+	MOVEI 	C,0
+	PMAP
+	ADDI	B,1
+	PMAP
+	POP	P,C
+	
+]
+	HRRI	A,-2000			; SMASH PDL
+	HRLM	A,GCPDL
+	POPJ	P,			; EXIT
+
+IFN ITS,[
+
+
+GCDIR:	SIXBIT /MUDSAV/
+INTDIR:	SIXBIT /MUDSAV/
+GCLDBK:	SIXBIT /  &DSK/
+	SIXBIT /AGC/
+	0			; FILLED IN BY INITM
+
+SGCLBK:	SIXBIT /  &DSK/
+	SIXBIT /SGC/
+	0
+
+ILDBLK:	SIXBIT /  &DSK/
+	SIXBIT /TS/
+	0			; FILLED IN BY INITM
+]
+
+
+NDEBUG:	SETZM	GCDEBU
+	CAIA
+DEBUGC:	SETOM	GCDEBU
+	HRRZ	A,IJFNS1	; GET GC JFN
+	SKIPE	A
+	CLOSF
+	JFCL
+	POPJ	P,
+
+IMPURE
+GCDEBU:	0
+BUFPTR:	0			; POINTER TO CURRENTLY ACTIVE BUFFER (WORD)
+BUFLT:	0			; LENGTH OF CURRENTLY ACTIVE BUFFER (PAGES)
+PGCNT:	0			; # OF PAGES OF MAPPED OUT INTERPRETER
+SAVSNM:	0
+OPBLK:	0			; BLOCK USED FOR OPEN
+
+PURE
+
+END
+

src/mudsys/maps.mid.29

@@ -0,0 +1,247 @@
+
+TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+.GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY
+.GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW,DSTORE,PVSTOR,TVSTOR
+
+; PSTACK OFFSETS
+
+INCNT==0	; INNER LOOP COUNT
+LISTNO==-1	; ARG NUMBER BEING HACKED
+ARGCNT==-2	; FINAL ARG COUNTER
+NARGS==-3	; NUMBER OF STRUCTURES
+NTHRST==-4	; 0=> MAP REST, OTHERWISE MAP FIRST
+
+; MAP THE "CAR" OF EACH LIST
+
+IMFUNCTION MAPF,SUBR
+
+	PUSH	P,.		; PUSH NON-ZERO
+	JRST	MAP1
+
+; MAP THE "CDR" OF EACH LIST
+
+IMFUNCTION MAPR,SUBR
+
+	PUSH	P,[0]
+
+MAP1:	ENTRY
+	HLRE	C,AB		; HOW MANY ARGS
+	ASH	C,-1		; TO # OF PAIRS
+	ADDI	C,2		; AT LEAST 3
+	JUMPG	C,TFA		; NOT ENOUGH
+	GETYP	A,(AB)		; TYPE OF CONSTRUCTOR
+	CAIN	A,TFALSE	; ANY CONSING NEEDE?
+	JRST	MAP2		; NO, SKIP CHECK
+	PUSHJ	P,APLQ		; CHECK IF APPLICABLE
+	JRST	NAPT		; NO, ERROR
+MAP2:	MOVNS	C		; POS NO. OF ARGS (-3)
+	PUSH	P,C		; SAVE IT
+	PUSH	TP,[TATOM,,-1]	; ALL **GFP** INSTRUCTIONS ARE TO DO WITH MAPRET
+	PUSH	TP,IMQUOTE LMAP,[LMAP ]INTRUP
+	PUSHJ	P,FRMSTK	; **GFP**
+	PUSH	TP,[0]		; **GFP**
+	PUSH	TP,[0]		; **GFP**
+	PUSHJ	P,SPECBIND	; **GFP**
+	MOVE	C,(P)		; RESTORE COUNT OF ARGS
+	MOVE	A,AB		; COPY ARG POINTER
+	MOVSI	0,TAB		; CLOBBER A'S TYPE
+	MOVE	PVP,PVSTOR+1
+	MOVEM	0,ASTO(PVP)
+	JUMPE	C,ARGSDN		; NOA ARGS?
+
+ARGLP:	INTGO			; STACK MAY OVERFLOW
+	PUSH	TP,4(A)		; SKIP FCNS
+	PUSH	TP,5(A)
+	ADD	A,[2,,2]
+	SOJG	C,ARGLP		; ALL UP ON STACK
+
+; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR
+
+ARGSDN:	PUSH	TP,(AB)		; CONSTRUCTOR
+	PUSH	TP,1(AB)
+	MOVE	PVP,PVSTOR+1
+	SETZM	ASTO(PVP)
+	PUSH	P,[-1]		; FUNNY TEMPS
+	PUSH	P,[0]
+	PUSH	P,[0]
+
+; OUTER LOOP CDRING  EACH STRUCTURE
+
+OUTRLP:	SETZM	LISTNO(P)	; START AT 0TH LIST
+	MOVE	0,NARGS(P)	; TOTAL # OF STRUCS
+	MOVEM	0,INCNT(P)	; AS COUNTER IN INNER LOOP
+	PUSH	TP,2(AB)	; PUSH THE APPLIER
+	PUSH	TP,3(AB)
+
+; INNER LOOP, CONS UP EACH APPLICATION
+
+INRLP:	INTGO
+	SOSGE	INCNT(P)
+	JRST	INRLP2
+	MOVEI	E,2		; READY TO BUMP LISTNO
+	ADDB	E,LISTNO(P)	; CURRENT STORED AND IN C
+	ADDI	E,(TB)4		; POINT TO A STRUCTURE
+	MOVE	A,(E)		; PICK IT UP
+	MOVE	B,1(E)		; AND VAL
+	PUSHJ	P,TYPSEG	; SETUP TO REST IT ETC.
+	MOVE	E,LISTNO(P)
+	ADDI	E,4(TB)
+	SKIPL	ARGCNT(P)	; DONT INCR THE 1ST TIME
+	XCT	INCR1(C)	; INCREMENT THE LOSER
+	MOVE	0,DSTORE	; UPDATE THE LIST
+	MOVEM	0,(E)
+	MOVEM	D,1(E)		; CLOBBER AWAY
+	PUSH	TP,DSTORE	; FOR REST CASE
+	PUSH	TP,D
+	PUSHJ	P,NXTLM		; SKIP IF GOT ONE, ELSE DONT
+	JRST	DONEIT		; FINISHED
+	SETZM	DSTORE
+	SKIPN	NTHRST(P)	; SKIP IF MAP REST
+	JRST	INRLP1
+	MOVEM	A,-1(TP)	; IUSE AS ARG
+	MOVEM	B,(TP)
+INRLP1:	JRST	INRLP		; MORE, GO DO THEM
+
+
+; ALL ARGS PUSHED, APPLY USER FCN
+
+INRLP2:	SKIPGE	ARGCNT(P)	; UN NEGATE ARGCNT
+	SETZM	ARGCNT(P)
+	MOVE	A,NARGS(P)	; GET # OF ARGS
+	ADDI	A,1
+	ACALL	A,MAPPLY	; APPLY THE BAG BITER
+
+	GETYP	0,(AB)		; GET TYPE OF CONSTRUCTOR
+	CAIN	0,TFALSE	; SKIP IF ONE IS THERE
+	JRST	OUTRL1
+	PUSH	TP,A
+	PUSH	TP,B
+	AOS	ARGCNT(P)
+	JRST	OUTRLP
+
+OUTRL1:	MOVEM	A,-1(TP)	; SAVE PARTIAL VALUE
+	MOVEM	B,(TP)
+	JRST	OUTRLP
+
+; HERE IF ALL FINISHED
+
+DONEIT:	HRLS	C,LISTNO(P)	; HOW MANY DONE
+	SUB	TP,[2,,2]	; FLUSH SAVED VAL
+	SUB	TP,C		; FLUSH TUPLE OF CRUFT
+DONEI1:	SKIPGE	ARGCNT(P)
+	SETZM	ARGCNT(P)	; IN CASE STILL NEGATIVE
+	SETZM	DSTORE		; UNSCREW
+	GETYP	0,(AB)		; ANY CONSTRUCTOR
+	CAIN	0,TFALSE
+	JRST	MFINIS		; NO, LEAVE
+	AOS	D,ARGCNT(P)	; IF NO ARGS
+	ACALL	D,APPLY		; APPLY IT
+
+	JRST	FINIS
+
+; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE ()
+
+MFINIS:	POP	TP,B
+	POP	TP,A
+	JRST	FINIS
+
+; **GFP** FROM HERE TO THE END
+
+MFUNCTION MAPLEAVE,SUBR
+
+	ENTRY
+
+	CAMGE	AB,[-3,,0]
+	JRST	TMA
+	MOVE	B,IMQUOTE LMAP,[LMAP ]INTRUP 
+	PUSHJ	P,ILVAL
+	GETYP	0,A
+	CAIE	0,TFRAME	; MAKE SURE WINNER
+	JRST	NOTM
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)	; POINT TO FRAME POINTER
+	PUSHJ	P,CHFSWP
+	PUSHJ	P,CHUNW
+	JUMPL	C,MAPL1		; RET VAL SUPPLIED
+	MOVSI	A,TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS
+
+MAPL1:	MOVE	A,(C)
+	MOVE	B,1(C)
+	JRST	FINIS
+
+MFUNCTION MAPSTOP,SUBR
+
+	ENTRY
+
+	PUSH	P,[1]
+	JRST	MAPREC
+
+MFUNCTION MAPRET,SUBR
+
+	ENTRY
+
+	PUSH	P,[0]
+MAPREC:	MOVE	B,IMQUOTE LMAP,[LMAP ]INTRUP
+	PUSHJ	P,ILVAL		; GET VALUE
+	GETYP	0,A		; FRAME?
+	CAIE	0,TFRAME
+	JRST	NOTM
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)
+	POP	P,0		; RET/STOP SWITCH
+	JUMPN	0,MAPRC1	; JUMP IF STOP
+	PUSHJ	P,CHFSWP	; CHECK IT OUT (AND MAYBE SWAP)
+	PUSH	P,[NLOCR]
+	JRST	MAPRC2
+MAPRC1:	PUSHJ	P,CHFSWP
+	PUSH	P,[NLOCR1]
+MAPRC2:	HRRZ	E,SPSAV(B)	; UNBIND BEFORE RETURN
+	PUSH	TP,$TAB
+	PUSH	TP,C
+	ADDI	E,1		; FUDGE FOR UNBINDER
+	PUSHJ	P,SSPEC1	; UNBINDER
+	HLRE	D,(TP)		; FIND NUMBER
+	JUMPE	D,MAPRE1	; SKIP IF NONE TO MOVE
+	MOVNS	E,D		; AND PLUS IT
+	HRLI	E,(E)		; COMPUTE NEW TP
+	ADD	E,TPSAV(B)	; NEW TP
+	HRRZ	C,TPSAV(B)	; GET OLD TOP
+	MOVEM	E,TPSAV(B)
+	HRL	C,(TP)		; AND NEW BOT
+	ADDI	C,1
+	BLT	C,(E)		; BRING IT ALL DOWN
+MAPRE1:	ASH	D,-1		; NO OF ARGS
+	HRRI	TB,(B)		; PREPARE TO FINIS
+	MOVSI	A,TFIX
+	MOVEI	B,(D)
+	POP	P,0		; GET PC TO GO TO
+	MOVEM	0,PCSAV(TB)
+	JRST	CONTIN		; BACK TO MAPPER
+
+NLOCR1:	TDZA	A,A		; ZER SW
+NLOCR:	MOVEI	A,1
+	GETYP	0,(AB)		; CHECK IF BUILDING
+	CAIN	0,TFALSE
+	JRST	FLUSHM		; REMOVE GOODIES
+	ADDM	B,ARGCNT(P)	; BUMP ARG COUNTER
+NLOCR2:	JUMPE	A,DONEI1
+	JRST	OUTRLP
+
+FLUSHM:	ASH	B,1		; FLUSH GOODIES DROPPED
+	HRLI	B,(B)
+	SUB	TP,B
+	JRST	NLOCR2
+
+NOTM:	ERRUUO	EQUOTE NOT-IN-MAP-FUNCTION
+
+END
+