Remove old versions of source files.

src/mudsys/amsgc.mid.107

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

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

@@ -1,886 +0,0 @@
-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/gchack.mid.45

@@ -1,538 +0,0 @@
-
-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/mudits.mcr130.1

@@ -1,566 +0,0 @@
-
-TITLE MUDITS -- ITS  DEPENDANT MUDDLE CODE
-
-RELOCATABLE
-
-.INSRT MUDDLE >
-
-
-.GLOBAL %SSNAM,%RSNAM,%KILLM,%LOGOU,%SLEEP,%VALRE,NOTTY,DEMFLG,MSGTYP
-.GLOBAL %UNAM,%JNAM,%XUNA,%XJNA,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%GCJB1,%VALFI
-.GLOBAL	%GCJOB,%SHWND,%GETIP,%INFMP
-.GLOBAL GCHN,WNDP,FRNP,FRONT,MESSAG,INITFL,6TOCHS,SGSNAM,MTYO,PGINT,WHOAMI
-.GLOBAL %TOPLQ,IPCINI,IPCBLS,%HANG,CTIME,BFLOAT,GCRSET,%MPINT,%GBINT,%SAVIN
-.GLOBAL %MPIN,%MPINX,%CLSMP,%CLSM1,%MPIN1,%IMSAV,%IMSV1,%PURIF,PSHGCF
-.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%SAVRP,%RSTRP,%CWINF,%FDBUF,BUFGC,P.TOP,P.CORE
-.GLOBAL PURBOT,SQUPNT,GETSQU,DIR,%LDRDO,%MPRDO,%IFMP2,SQBLK,SQDIR
-.GLOBAL CERR1,CERR2,CERR3,COMPERR,CALER,CALER1,SQLOD,SQKIL,SLEEPR,GETBUF,KILBUF
-
-
-
-GCHN==0
-CWTP==1000,,4000
-RDTP==1000,,200000
-WRTP==1000,,100000
-GCHI==1000,,GCHN
-CRJB==1000,,400001
-FME==1000,,-1
-FLS==1000,,
-
-%RSTRP:
-%OPGFX:
-%SAVRP:	POPJ	P,
-
-
-SQLOD:	MOVEI	A,1			; NUMBER OF PAGES OF BUFFER
-	PUSHJ	P,GETBUF
-	HRRM	B,SQUPNT
-	ASH	B,-10.		; TO PAGES
-	.SUSET	[.RSNAM,,A]		; OPEN FILE TO SQUOZE TABLE
-	.SUSET	[.SSNAM,,SQDIR]		; SET SNAME
-	.OPEN	GCHN,SQBLK
-	FATAL SQUOZE TABLE NON EXISTANT
-	.SUSET [.SSNAM,,A]
-	MOVEI	A,0
-	DOTCAL	CORBLK,[[RDTP],[FME],B,[GCHI],A]
-	PUSHJ	P,SLEEPR
-	.CLOSE	GCHN,
-	MOVE	A,B			; GET B
-	ASH	A,10.
-	POPJ	P,
-
-SQKIL:	PUSHJ	P,KILBUF
-	HLLZS	SQUPNT
-	POPJ	P,
-
-GETSQU:	HRRZ	0,SQUPNT
-	JUMPN	0,ATSQ10
-	JRST	SQLOD
-ATSQ10:	POPJ	P,
-
-
-CTIME:	.SUSET	[.RRUNT,,B]		; Get user's run time in 4.069 microsecond units
-	IDIVI	B,400000
-	FSC	C,233
-	FSC	B,254
-	FADR	B,C
-	FDVR	B,[250000.00]		; Change to units of seconds
-	MOVSI	A,TFLOAT
-	POPJ	P,
-
-; SET THE SNAME GLOBALLY
-
-%SSNAM:	.SUSET	[.SSNAM,,A]
-	POPJ	P,
-
-; READ THE GLOBAL SNAME
-
-%RSNAM:	.SUSET	[.RSNAM,,A]
-	POPJ	P,
-
-; KILL THE CURRENT JOB/LOGOUT
-
-%LOGOU:
-%KILLM:	.LOGOUT	1,
-	POPJ	P,
-
-; PASS STRING TO SUPERIOR (MONITOR?)
-
-%VALRE:	.VALUE	(A)
-	POPJ	P,
-
-; DO 'KILL'
-%VALFI:	.BREAK	16,(A)
-	POPJ	P,
-
-; GO TO SLEEP A WHILE
-
-%SLEEP:	.SLEEP	A,
-	POPJ	P,
-
-; HANG FOREVER
-
-%HANG:	SKIP
-	.HANG
-
-; READ JNAME
-
-%RJNAM:	.SUSET	[.RJNAM,,%JNAM]
-	MOVE	A,%JNAM
-	POPJ	P,
-
-; READ XJNAME
-
-%RXJNA:	.SUSET	[.RXJNA,,%XJNA]
-	MOVE	A,%XJNA
-	POPJ	P,
-
-; READ UNAME
-
-%RUNAM:	.SUSET	[.RUNAM,,%UNAM]
-	MOVE	A,%UNAM
-	POPJ	P,
-
-; READ XUNAME
-
-%RXUNA:	.SUSET	[.RXUNA,,%XUNA]
-	MOVE	A,%XUNA
-	POPJ	P,
-
-; HERE TO SEE IF WE ARE A TOP LEVEL JOB
-
-%TOPLQ:	PUSH	P,A
-	.SUSET	[.RSUPPR,,A]	; READ SUPERIOR
-	SKIPGE	A		; SKIP IF IT EXISTS
-	 AOS	-1(P)		; CAUSE SKIP RET
-	POP	P,A
-	POPJ	P,
-
-; ERRORS IN COMPILED CODE MAY END UP HERE
-
-CERR1:	MOVE	A,EQUOTE NTH-BY-A-NEGATIVE-NUMBER
-	.SUSET	[.RJPC,,B]
-	JRST	CERR
-
-CERR2:	MOVE	A,EQUOTE NTH-REST-PUT-OUT-OF-RANGE
-	.SUSET	[.RJPC,,B]
-	JRST	CERR
-
-CERR3:	MOVE	A,EQUOTE UVECTOR-PUT-TYPE-VIOLATION
-	.SUSET	[.RJPC,,B]
-
-COMPERR:
-	MOVE	A,EQUOTE ERROR-IN-COMPILED-CODE
-	.SUSET	[.RJPC,,B]
-
-CERR:	PUSH	TP,$TATOM
-	PUSH	TP,A
-	PUSH	TP,$TWORD
-	PUSH	TP,B
-	MOVEI	A,2
-	JRST	CALER
-
-; GET AN INFERIOR FOR THE GARBAGE COLLECTOR
-%GCJB1:
-%GCJOB:	PUSH	P,A
-	PUSH	P,D
-	MOVEI	0,(SIXBIT /USR/)
-	MOVEI	A,0		; USE SAME UNAME
-	MOVSI	B,(SIXBIT /AGC/)	; IDENTIFY
-
-; ROUTINE TO SEE WHETHER MAPCHN IS ALREADY OPEN
-
-	.STATUS	GCHN,D
-	ANDI	D,77
-	MOVEM	D,PSHGCF
-	POP	P,D
-	SKIPN	PSHGCF		; SKIP IF OPEN
-	JRST	TRYOPN
-	.IOPUSH	GCHN		; PUSH THE CHANNEL
-	MOVSI	B,(SIXBIT /AGE/)
-
-TRYOPN:	HRLI	0,7		; READ BLOCK OUTPUT
-	.OPEN	GCHN,0		; TRY IT
-	JRST	.+2
-	JRST	GCJB1		; OK, GET A PAGE
-
-	HRLI	0,6
-	.OPEN	GCHN,0		; AND TRY AGAIN
-	AOJA	B,TRYOPN	; TRY A NEW NAME
-
-	.UCLOSE	GCHN,		; FLUSH JOB
-	.CLOSE	GCHN,		; AND CHANNEL
-
-	AOJA	B,TRYOPN
-
-GCJB1:	HRLI	0,6		; REOPEN IN READ
-	.OPEN GCHN,0
-	FATAL CAN'T REOPEN INFERIOR IN READ
-	POP	P,A		; RET PAGE TO MAP AS 1ST
-	MOVEI	B,FRNP		; SET UP FRONTEIR
-	PUSHJ	P,%GETIP		; GET IT THERE
-	PUSHJ	P,%SHWND
-	POPJ	P,
-
-; HERE TO WAIT A WHILE FOR CORE
-
-
-
-; HERE TO GET A PAGE FOR THE INFERIOR
-
-%GETIP:	DOTCAL	CORBLK,[[WRTP],[GCHI],A,[CRJB]]
-	PUSHJ	P,SLEEPR
-	POPJ	P,
-
-; HERE TO PURIFY A STRUCTURE
-
-%PURIF:	DOTCAL	CORBLK,[[RDTP],[FME],A,[FME],A]
-	FATAL UNABLE TO PURIFY STRUCTURE
-	POPJ	P,
-
-; HERE TO SHARE WINDOW
-
-%SHWND:	DOTCAL	CORBLK,[[WRTP],[FME],B,[GCHI],A]
-	FATAL CANT SHARE INFERIOR PAGE
-	POPJ	P,
-
-; HERE TO CAUSE INFERIOR TO HOLD ONTO PURE CORE BEING FLUSHED
-
-%MPINT:	PUSH	P,B
-	MOVE	B,A		; COPY PAGE POINTER
-	DOTCAL	CORBLK,[[RDTP],[GCHI],A,[FME],B]
-	FATAL CANT CAUSE INFERIOR TO SHARE ME
-	POP	P,B
-	POPJ	P,
-
-; HERE TO GET BACK WHAT INFERIOR NOW HAS
-
-%GBINT:	PUSH	P,B
-	MOVE	B,A
-	DOTCAL	CORBLK,[[RDTP],[FME],A,[GCHI],B]
-	FATAL CANT GET STUFF BACK
-	POP	P,B
-	POPJ	P,
-
-; HERE TO MAP FROM AN INFERIOR TO A NEW BLOCK IN CORE
-
-%MPINX:
-%MPIN1:	PUSH	P,B
-	EXCH	A,B
-	DOTCAL	CORBLK,[[WRTP],[FME],A,[CRJB]]
-	PUSHJ	P,SLEEPR
-	POP	P,A
-
-; HERE TO MAP FROM THE INFERIOR TO THE CORE IMAGE
-
-%MPIN:	DOTCAL	CORBLK,[[WRTP],[FME],A,[GCHI],B]
-	FATAL CANT GET INFERIOR CORE BACK
-	POPJ	P,
-
-; HERE TO PROTECT CORE IMAGE
-
-%SAVIN:	PUSH	P,A
-	MOVEI	0,(SIXBIT /USR/)
-	MOVEI	A,0		; USE SAME UNAME
-	MOVSI	B,(SIXBIT /AGD/)	; IDENTIFY
-
-TRYOP1:	HRLI	0,7		; WRITE BLOCK OUTPUT
-	.OPEN	GCHN,0		; TRY IT
-	JRST	.+2
-	JRST	GCJB2		; OK, GET A PAGE
-
-	HRLI	0,6		; CHANGE TO READ OPEN
-	.OPEN	GCHN,0		; AND TRY AGAIN
-	AOJA	B,TRYOP1	; TRY A NEW NAME
-
-	.UCLOSE	GCHN,		; FLUSH JOB
-	.CLOSE	GCHN,		; AND CHANNEL
-
-	AOJA	B,TRYOP1
-
-GCJB2:	MOVEM	B,SAVNAM
-	POP	P,A
-%IMSAV:	HRRZ	0,A		; SEE IF 0
-	CAIE	0,0
-	JRST	IMSAV1
-	ADD	A,[1,,1]	; TO NEXT PAGE
-	.ACCESS	GCHN,[20]		; ACCESS IN INF
-	PUSH	P,B
-	PUSH	P,A
-	MOVEI	A,0
-	PUSHJ	P,%GETIP	; GET AROUND SYSTEM LOSSAGE CONCERNING THE FIRST PAGE
-	MOVE	B,[-1760,,20]	; IOT INTO INFERIOR
-	.IOT	GCHN,B
-	POP	P,A
-	POP	P,B
-IMSAV1:	MOVE	M,A
-	DOTCAL	CORBLK,[[WRTP],[GCHI],A,[FME],A]
-	FATAL UNABLE TO PROTECT CORE IMAGE
-IMSAV2:
-; MAKE CORE IMAGE READ ONLY
-
-	MOVE	A,M		; RESTORE A
-	DOTCAL	CORBLK,[[RDTP],[FME],A,[FME],A]
-	FATAL	CORBLK FAILED
-	POPJ	P,
-
-; MAP A PAGE INTO AGD INFERIOR IN READ ONLY MODE
-; PAGE NUMBER IS IN A
-
-%MPRDO:	DOTCAL	CORBLK,[[RDTP],[GCHI],A,[FME],A]
-	FATAL	CORBLK FAILED
-	POPJ	P,
-
-
-; HERE TO FIND A BUFFER PAGE FOR C/W HACK
-
-%FDBUF:	HRRZ	A,PURBOT
-	SUB	A,P.TOP		; CALCULATE ROOM FOR PROSPECTIVE BUFFER
-	CAIG	A,2000		; SEE IF ROOM
-	JRST	FDBUF1
-	MOVE	A,P.TOP		; START OF BUFFER
-	HRRM	A,BUFGC
-	POPJ	P,
-FDBUF1:	SETOM	BUFGC		; INDICATE NO BUFFER FOUND
-	POPJ	P,
-
-; HERE TO SIMULATE COPY ON WRITE. THIS ROUTINE TAKES A SOURCE PAGE IN A
-; AND A BUFFER PAGE IN B
-
-%CWINF:	PUSH	P,A		; SAVE SOURCE ADDRESS
-	PUSH	P,B		; SAVE BUFFER ADDRESS
-	ASH	B,-10.		; TO PAGES
-	ASH	A,-10.
-	DOTCAL	CORBLK,[[RDTP],[FME],B,[FME],A]
-	FATAL COPY-WRITE CORBLK FAILED
-	DOTCAL	CORBLK,[[WRTP],[FME],A,[CRJB]]
-	PUSHJ	P,SLEEPR	
-	HRLZ	A,(P)		; GET START OF BUFFER
-	HRR	A,-1(P)	; GET START OF SOURCE PAGE
-	EXCH	B,-1(P)		; GET BEGINNING OF SOURCE PAGE
-	BLT	A,1777(B)
-	MOVE	B,-1(P)
-	DOTCAL	CORBLK,[[FLS],[FME],B]
-	FATAL CANT FLUSH BUFFER
-	SUB	P,[2,,2]	; CLEAN OFF STACK
-	POPJ	P,		; EXIT
-
-
-
-; HERE TO PROTECT MUDDLES PURE SPACE
-%IMSV1:	MOVE	M,A
-	PUSHJ	P,%MPINT
-	POPJ	P,
-
-; HERE TO CLOSE THE IMAGE SAVING INFERIOR WITHOUT KILLING IT
-
-%CLSJB:	.CLOSE	GCHN,
-	POPJ	P,
-
-; HERE TO OPEN AGD INFERIOR IN ORDER TO RESTORE CORE-IMAGE
-
-%IFMP1:	.IOPUSH	GCHN		; PUSH CURRENT CONTENTS OF CHANNEL
-	PUSH	P,A		; SAVE AC'S
-	PUSH	P,B
-	MOVEI	0,(SIXBIT /USR/)
-	MOVEI	A,0
-	MOVE	B,SAVNAM
-	HRLI	0,6
-	.OPEN	GCHN,0
-	FATAL AGD INFERIOR LOST
-	POP	P,A
-	POP	P,B
-	POPJ	P,
-
-; HERE TO MAP IN A PURE PAGE FROM THE AGD INFERIOR
-
-%LDRDO:	DOTCAL	CORBLK,[[RDTP],[FME],A,[GCHI],A]
-	FATAL CORBLK FAILED
-	POPJ	P,
-
-
-
-; HERE TO MAP IN FROM AGD INFERIOR AND KILL CORE IMAGE AS WELL
-; A HAS SOURCE PAGES AND B DESTINATION PAGES
-
-%IFMP2:	PUSHJ	P,%INFMP
-	.IOPOP	GCHN
-	POPJ	P,
-
-;HERE TO KILL AN IMAGE SAVING INFERIOR
-%KILJB:	.IOPUSH	GCHN
-	PUSH	P,0
-	PUSH	P,B
-	PUSH	P,C
-	PUSH	P,A
-	MOVEI	0,(SIXBIT /USR/)
-	MOVE	B,SAVNAM
-	HRLI	0,6
-	MOVEI	A,0
-	.OPEN	GCHN,0
-	FATAL AGD INFERIOR LOST
-CKPGU:	HRRZ	A,(P)
-	DOTCAL	CORTYP,[A,,[2000,,B]]
-	FATAL CORBLK TO UNPURE PAGES FAILED
-	JUMPL	B,PGW
-	DOTCAL	CORBLK,[[WRTP],[FME],A,[GCHI],A]
-	FATAL	CORBLK TO UNPURE PAGES FAILED
-PGW:	POP	P,A
-	ADD	A,[1,,1]
-	SKIPL	A
-	JRST	KILIT
-	PUSH	P,A		; REPUSH A
-	JRST	CKPGU
-KILIT:	.UCLOS	GCHN,
-	.CLOSE	GCHN,
-	POP	P,C
-	POP	P,B
-	POP	P,0
-	.IOPOP	GCHN
-	POPJ	P,
-
-; HERE TO MAP INFERIOR BACK AND KILL SAME
-
-%INFMP:	PUSHJ	P,%MPIN		; MAP IN IMAGE
-	.UCLOSE	GCHN,
-	.CLOSE	GCHN,
-	SKIPE	PSHGCF		; SKIP IF CHANNEL IS NOT PUSHED
-	JRST	INFMPX
-	POPJ	P,
-INFMPX:	.IOPOP	GCHN		; HAVE MORE THAN ONE GC-INF OPEN IOPOP
-	SETZM	PSHGCF
-	POPJ	P,
-
-
-; USED TO MAP INFERIOR CONTAINING CORE IMAGE BACK IN AND KILL SAVE
-
-%CLSMP:	PUSHJ	P,%GBINT
-%CLSM1:	.UCLOSE	GCHN,
-	.CLOSE	GCHN,
-	POPJ	P,
-
-; HACK TO PRINT MESSAGE OF INTEREST TO USER
-
-MESOUT:	MOVSI	A,(JFCL)
-	MOVEM	A,MESSAG	; DO ONLY ONCE
-	MOVE	A,P.TOP
-	ADDI	A,1777		; MAKE SURE ON PAGE BOUNDRY
-	ASH	A,-10.		; TO PAGES
-	MOVE	B,VECTOP	; GET VECTOR
-	ADDI	B,1777		; PAGE AND ROUND
-	ANDCMI	B,1777
-	MOVEM	B,P.TOP
-	PUSHJ	P,P.CORE	; GET CORE
-	JFCL
-	SETZB	SP,FRM		; HACK TO AVOID LOSSAGE WITH GARBAGE IN SP FIRST TIME
-	PUSHJ	P,PGINT		; INITIALIZE PAGE MAP
-	PUSHJ	P,GCRSET
-	PUSHJ	P,%RSNAM	; GET SAVED SNAME
-	PUSH	P,A		; SAVE IT
-	SKIPE	NOTTY		; HAVE A TTY?
-	JRST	RESNM		; NO, SKIP THIS STUFF
-	MOVE	A,[SIXBIT /MUDSYS/]
-	PUSHJ	P,%SSNAM
-	MOVEI	A,(SIXBIT /DSK/)
-	SKIPN	B,WHOAMI
-	MOVE	B,[SIXBIT /MUDDLE/]
-	MOVE	C,[SIXBIT /MESSAG/]
-	.OPEN	0,A
-	JRST	RESNM
-MESSI:	.IOT	0,A		; READ A CHAR
-	JUMPL	A,MESCLS	; DONE, QUIT
-	CAIE	A,14		; DONT TYPE FF
-	PUSHJ	P,MTYO		; AND TYPE IT OUT
-	JRST	MESSI		; UNTIL DONE
-
-MESCLS:	.CLOSE	0,
-
-RESNM:	POP	P,A		; GET SAVED SNAME BACK
-	PUSHJ	P,%SSNAM	; AND SET IT BACK
-RESNM1:	POPJ	P,
-
-MUDINT:	MOVSI	0,(JFCL)	; CLOBBER MUDDLE INIT SWITCH
-	MOVEM	0,INITFL
-	PUSHJ	P,%RSNAM	; GET SNAME
-	CAMN	A,[-1]		; NO SNAME ?
-	MOVE	A,[SIXBIT /MUDSUB/]	; FOR DEMONS AND THE LIKE
-	PUSHJ	P,6TOCHS	; TO STRING
-	PUSH	TP,$TATOM
-	PUSH	TP,IMQUOTE SNM
-	PUSH	TP,A
-	PUSH	TP,B
-	MCALL	2,SETG
-	PUSHJ	P,SGSNAM	; SET TO GLOBAL
-	MOVE	E,A		; SAVE IN E
-	MOVEI	A,(SIXBIT /DSK/)
-	MOVE	C,[SIXBIT /INIT/]
-	SKIPN	B,WHOAMI	; SKIP IF NOT A STRAIGHT MUDDLE
-	JRST	STMUDL
-
-	.OPEN	0,A
-	SKIPA	D,E
-	JRST	MUDIN1
-
-	CAMN	D,[SIXBIT /MUDSUB/]
-	POPJ	P,
-	.SUSET	[.SSNAM,,[SIXBIT /MUDSUB/]]
-MUDIN2:	.OPEN	0,A
-	POPJ	P,
-MUDIN1:	.CLOSE	0,
-	PUSH	TP,$TCHSTR	; ATTEMPT TO LOAD A MUDDLE INIT FILE
-	PUSH	TP,CHQUOTE READ
-	MOVE	A,B
-	PUSHJ	P,6TOCHS
-	PUSH	TP,A
-	PUSH	TP,B
-	PUSH	TP,$TCHSTR
-	PUSH	TP,CHQUOTE INIT
-	PUSH	TP,$TCHSTR
-	PUSH	TP,CHQUOTE DSK
-	.SUSET	[.RSNAM,,A]	; USE SNAME AROUND
-	PUSHJ	P,6TOCHS
-	PUSH	TP,A
-	PUSH	TP,B
-	MCALL	5,FOPEN
-	GETYP	0,A
-	CAIE	0,TCHAN		; DID THE CHANNEL OPEN ?
-	POPJ	P,		; NO, RETURN
-	PUSH	TP,A
-	PUSH	TP,B
-	MOVEI	B,INITSTR	; TELL USER WHAT'S HAPPENING
-	SKIPE	WHOAMI
-	JRST	.+3
-	SKIPN	NOTTY
-	PUSHJ	P,MSGTYP
-	MCALL	1,MLOAD
-	POPJ	P,
-
-
-; BLOCK TO OPEN SQUOZE TABLE
-
-SQDIR:	SIXBIT /MUDSAV/
-
-SQBLK:	SIXBIT /  &DSK/
-	SIXBIT /SQUOZE/
-	SIXBIT /TABLE/
-
-STMUDL:	MOVE	B,[SIXBIT /MUDDLE/]
-	JRST	MUDIN2
-
-IPCINI:	PUSHJ	P,IPCBLS
-
-INITSTR:	ASCIZ /MUDDLE INIT/
-
-IMPURE
-SAVNAM:	0		; SAVED AGD INFERIOR NAME
-DEMFLG:	0
-
-
-MESSAG:	PUSHJ	P,MESOUT	; MESSAGE SWITCH
-
-INITFL:	PUSHJ	P,MUDINT	; MUDDLE INIT SWITCH
-
-PURE
-
-END
-

src/mudsys/mudsqu.mcr025.1

@@ -1,138 +0,0 @@
-
-TITLE SQUOZE TABLE HANDLER FOR MUDDLE
-
-RELOCATABLE
-
-.INSRT MUDDLE >
-
-.GLOBAL SQUPNT,ATOSQ,SQUTOA,GETSQU,CSQUTA,MPOPJ,SAT,SQUKIL,SQKIL
-
-; ROUTINE TO KILL FIXUP TABLE SOMETIMES
-
-SQUKIL:	PUSH	P,0			; SAVE ACS
-	HRRZ	0,SQUPNT		; SEE IF IN INTERPRETER
-	CAIG	0,HIBOT
-	JRST	POPJ0
-	PUSH	P,A
-	PUSH	P,B
-	PUSH	P,C
-	PUSH	P,D
-	PUSH	P,E
-	PUSHJ	P,SQKIL			; KILL THE BUFFER AND RESTORE INTERPRETER
-	POP	P,E
-	POP	P,D
-	POP	P,C			; RESTORE AC'S
-	POP	P,B
-	POP	P,A
-POPJ0:	POP	P,0
-	POPJ	P,
-
-
-; POINTER TO TABLE FILLED IN BY INITM
-
-; SUBR TO INTERFACE TO MUDDLE SQUOZE TABLE.
-; IT TAKES AN ARGUMENT OF PRIMTYPE WORD AND RETURNS A FIX GIVING THE
-; LOCATION IF IT IS IN THE SQUOZE TABLE AND OTHERWISE RETURNS FALSE
-
-	MFUNCTION SQUOTA,SUBR
-	ENTRY 1
-
-	GETYP	A,(AB)
-	PUSHJ	P,SAT		; GET SAT OF ARGUMENT
-	CAIE	A,S1WORD	; BETTER BE OF PRIMTYPE WORD
-	JRST	WTYP1
-	MOVE	A,1(AB)		; GET ARGUMENT INTO A
-	PUSHJ	P,CSQUTA
-	JFCL
-	JRST	FINIS
-
-
-; COMPILER ENTRY TAKES ARGUMENT IN A
-
-CSQUTA:	SUBM	M,(P)		; RELATAVIZE P
-	MOVE	E,A		; ARG TO SQUOTA
-	TLZ	E,740000	; FLUSH EXTRA BITS FOR LOOKUP
-	PUSHJ	P,SQUTOA
-	JRST	GTFALS
-	SOS	(P)		; AND SKIP RETURN
-	PUSHJ	P,SQUKIL
-	MOVSI	A,TFIX		; RETURN FIX
-	MOVE	B,E
-	JRST	MPOPJ
-GTFALS:	PUSHJ	P,SQUKIL
-	MOVE	A,$TFALSE
-	MOVEI	B,0
-	JRST	MPOPJ		; RETURN A FALSE
-
-
-; GIVEN LOCN OF SUBR RET SQUO NAME ARG AND VAL IN E
-
-ATOSQ:	PUSH	P,B
-	PUSH	P,A
-	PUSHJ	P,GETSQU
-	MOVE	A,SQUPNT	; GET TABLE POINTER
-	MOVE	B,[2,,2]
-	CAMN	E,1(A)
-	JRST	ATOSQ1
-	ADD	A,B
-	JUMPL	A,.-3
-POPABJ:	PUSH	P,E			; SAVE RESULT
-	PUSHJ	P,SQUKIL
-	POP	P,E
-	POP	P,B
-	POP	P,A
-	POPJ	P,
-
-ATOSQ1:	MOVE	E,(A)
-	AOS	-2(P)
-	JRST	POPABJ
-
-; BINARY SEARCH FOR SQUOZE SYMBOL ARG IN E
-
-SQUTOA:	PUSH	P,A
-	PUSH	P,B
-	PUSH	P,C
-	PUSH	P,E
-	PUSHJ	P,GETSQU
-	POP	P,E
-
-	MOVE	A,SQUPNT		; POINTER TO TABLE
-	HLRE	B,SQUPNT
-	MOVNS	B
-	HRLI	B,(B)		; B IS CURRENT OFFSET
-
-UP:	ASH	B,-1		; HALVE TABLE
-	AND	B,[-2,,-2]	; FORCE DIVIS BY 2
-	MOVE	C,A		; COPY POINTER
-	JUMPLE	B,LSTHLV	; CANT GET SMALLER
-	ADD	C,B
-	CAMLE	E,(C)		; SKIP IF EITHER FOUND OR IN TOP
-	MOVE	A,C		; POINT TO SECOND HALF
-	CAMN	E,(C)		; SKIP IF NOT FOUND
-	JRST	WON
-	CAML	E,(C)		; SKIP IF IN TOP HALF
-	JRST	UP
-	HLLZS	C		; FIX UP OINTER
-	SUB	A,C
-	JRST	UP
-
-WON:	MOVE	E,1(C)		; RET VAL IN E
-	AOS	-3(P)		; SKIP RET
-WON1:	POP	P,C
-	POP	P,B
-	POP	P,A
-	POPJ	P,
-
-LSTHLV:	CAMN	E,(C)		; LINEAR SERCH REST
-	JRST	WON
-	ADD	C,[2,,2]
-	JUMPL	C,.-3
-	JRST	WON1		; ALL GONE, LOSE
-
-
-IMPURE
-SQUPNT:	0
-
-PURE
-END
-

src/mudsys/nfree.mcr052.1

@@ -1,276 +0,0 @@
-
-TITLE MODIFIED AFREE FOR MUDDLE
-
-RELOCATABLE
-
-.INSRT MUDDLE >
-
-.GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1
-.GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP
-.GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR
-MFUNCTION FREEZE,SUBR
-
-	ENTRY	1
-
-	GETYP	A,(AB)		; get type of it
-	PUSH	TP,(AB)		; save a copy
-	PUSH	TP,1(AB)
-	PUSH	P,[0]		; flag for tupel freeze
-	PUSHJ	P,SAT		; to SAT
-	MOVEI	B,0		; final type
-	CAIN	A,SNWORD	; check valid types
-	MOVSI	B,TUVEC		; use UVECTOR
-	CAIN	A,S2NWOR
-	MOVSI	B,TVEC
-	CAIN	A,SARGS
-	MOVSI	B,TVEC
-	CAIN	A,SCHSTR
-	MOVSI	B,TCHSTR
-	CAIN	A,SBYTE
-	MOVEI	B,TBYTE
-	JUMPE	B,WTYP1
-	PUSH	P,B		; save final type
-	CAMN	B,$TBYTE
-	JRST	.+3
-	CAME	B,$TCHSTR	; special chars hack
-	JRST	OK.FR
-	HRR	B,(AB)		; fixup count
-	MOVEM	B,(P)
-
-	MOVEI	C,(TB)		; point to it
-	PUSHJ	P,BYTDOP	; A==> points to dope word
-	HRRO	B,1(TB)
-	SUBI	A,1(B)		; A==> length of block
-	TLC	B,-1(A)
-	MOVEM	B,1(TB)		; and save
-	MOVSI	0,TUVEC
-	MOVEM	0,(TB)
-
-OK.FR:	HLRE	A,1(TB)		; get length
-	MOVNS	A
-	PUSH	P,A
-	ADDI	A,2
-	PUSHJ	P,CAFREE	; get storage
-	HRLZ	B,1(TB)		; set up to BLT
-	HRRI	B,(A)
-	POP	P,C
-	ADDI	C,(A)		; compute end
-	BLT	B,(C)
-	HLLOS	1(C)		; INDICATION IN RELOCATION FIELD THAT ITS NOT GARBAGE
-	MOVEI	B,(A)
-	HLL	B,1(AB)
-	POP	P,A
-	JRST	FINIS
-
-		
-CAFRE:	PUSH	P,A
-	HRRZ	E,STOLST+1
-	SETZB	C,D
-	PUSHJ	P,ICONS		; get list element
-	PUSH	TP,$TLIST	; and save
-	PUSH	TP,B
-	MOVE	A,(P)		; restore length
-	ADDI	A,2		; 2 more for dope words
-	PUSHJ	P,CAFREE	; get the core and dope words
-	POP	P,B		; restore count
-	MOVNS	B		; build AOBJN pointer
-	MOVSI	B,(B)
-	HRRI	B,(A)
-	MOVE	C,(TP)
-	MOVEM	B,1(C)		; save on list
-	MOVSI	0,TSTORA	; and type
-	HLLM	0,(C)
-	HRRZM	C,STOLST+1	; and save as new list
-	SUB	TP,[2,,2]
-	POPJ	P,
-	
-CAFRE1:	PUSH	P,A
-	ADDI	A,2
-	PUSHJ	P,CAFREE
-	HRROI	B,(A)		; pointer to B
-	POP	P,A		; length back
-	TLC	B,-1(A)
-	POPJ	P,
-
-CAFREE:	IRP	AC,,[B,C,D,E]
-	PUSH	P,AC
-	TERMIN
-	SKIPG	A		; make sure arg is a winner
-	FATAL BAD CALL TO CAFREE
-	MOVSI	A,(A)		; count to left half for search
-	MOVEI	B,FLIST		; get first pointer
-	HRRZ	C,(B)		; c points to next block
-CLOOP:	CAMG	A,(C)		; skip if not big enough
-	JRST	CONLIS		; found one
-	MOVEI	D,(B)		; save in case fall out
-	MOVEI	B,(C)		; point to new previous
-	HRRZ	C,(C)		; next block
-	JUMPN	C,CLOOP		; go on through loop
-	HLRZ	E,A		; count to E
-	CAMGE	E,STORIC	; skip if a area or more
-	MOVE	E,STORIC	; else use a whole area
-	MOVE	C,PARBOT	; foun out if any funny space
-	SUB	C,CODTOP	; amount around to C
-	EXCH	B,D
-	CAMLE	C,E		; skip if must GC
-	JRST	CHAVIT		; already have it
-	SUBI	E,-1(C)		; get needed from agc
-	MOVEM	E,PARNEW	; funny arg to AGC
-	PUSH	P,A
-	MOVE	C,[7,,6]	; SET UP AGC INDICATORS
-	SKIPE	GPURFL		; DONT GC IF IN DUMPER
-	JRST	PURGC
-	PUSHJ	P,AGC		; collect that garbage
-	SETZM	PARNEW		; dont do it again
-	POP	P,A
-
-; Make sure pointers still good after GC
-
-	MOVEI	B,FLIST
-	HRRZ	D,(B)
-
-	HRRZ	E,(D)		; next pointer
-	JUMPE	E,.+4		; end of list ok
-	MOVEI	B,(D)
-	MOVEI	D,(E)
-	JRST	.-4		; look at next
-
-CHAVIT:	MOVE	E,PARBOT	; find amount obtained
-	SUBI	E,1		; dont use a real pair
-	MOVEI	C,(E)		; for reset of CODTOP
-	SUB	E,CODTOP
-	EXCH	C,CODTOP	; store it back
-	CAIE	B,(C)		; did we simply grow the last block?
-	JRST	CSPLIC		; no, splice it in
-	HLRZ	C,(B)		; length of old guy
-	ADDI	C,(E)		; total length
-	ADDI	B,(E)		; point to new last dope word
-	HRLZM	C,(B)		; clobber final length in
-	HRRM	B,(D)		; and splice into free list
-	MOVEI	C,(B)		; reset acs for reentry into loop
-	MOVEI	B,(D)
-	JRST	CLOOP
-
-; Here to splice new core onto end of list.
-
-CSPLIC:	MOVE	C,CODTOP	; point to end of new block
-	HRLZM	E,(C)		; store length of new block in dope words
-	HRRM	C,(D)		; D is old previous, link it up
-	MOVEI	B,(D)		; and reset B for reentry into loop
-	JRST	CLOOP
-
-; here if an appropriate block is on the list
-
-CONLIS:	HLRZS	A		; count back to a rh
-	HLRZ	D,(C)		; length of proposed block to D
-	CAIN	A,(D)		; skip if they are different
-	JRST	CEASY		; just splice it out
-	MOVEI	B,(C)		; point to block to be chopped up
-	SUBI	B,-1(D)		; point to beginning of same
-	SUBI	D,(A)		; amount of block to be left to D
-	HRLM	D,(C)		; and fix up dope words
-	ADDI	B,-1(A)		; point to end of same
-	HRLZM	A,(B)
-	HRRM	B,(B)		; for GC benefit
-
-CFREET:	CAIE	A,1		; if more than 1
-	SETZM	-1(B)		; make tasteful dope worda
-	SUBI	B,-1(A)
-	MOVEI	A,(B)
-ACRST:	IRP	AC,,[E,D,C,B]
-	POP	P,AC
-	TERMIN
-	POPJ	P,
-
-PURGC:	SUB	P,[1,,1]	; CLEAN OFF STACK
-	SETOM	GCDANG		; INDICATE GC SHOULD HAVE OCCURED
-	JRST	ACRST
-
-CEASY:	MOVEI	D,(C)		; point to block to return
-	HRRZ	C,(C)		; point to next of same
-	HRRM	C,(B)		; smash its previous
-	MOVEI	B,(D)		; point to block with B
-	HRRM	B,(B)		; for GC benefit
-	JRST	CFREET
-
-CAFRET:	HRROI	B,(B)		; prepare to search list
-	TLC	B,-1(A)		; by making an AOBJN pointer
-	HRRZ	C,STOLST+1	; start of list
-	MOVEI	D,STOLST+1
-
-CAFRTL:	JUMPE	C,CPOPJ		; not founc
-	CAME	B,1(C)		; this it?
-	JRST	CAFRT1
-	HRRZ	C,(C)		; yes splice it out
-	HRRM	C,(D)		; smash it
-CPOPJ:	POPJ	P,		; dont do anything now
-
-CAFRT1:	MOVEI	D,(C)
-	HRRZ	C,(C)
-	JRST	CAFRTL
-
-; Here from GC to collect all unused blocks into free list
-
-STOGC:	SETZB	C,E		; zero current length and pointer
-	MOVE	A,CODTOP	; get high end of free space
-
-STOGCL:	CAIG	A,STOSTR	; end?
-	JRST	STOGCE		; yes, cleanup and leave
-
-	HLRZ	0,(A)		; get length
-	ANDI	0,377777
-	SKIPGE	(A)		; skip if a not used block
-	JRST	STOGC1		; jump if marked
-
-; HERE TO SEE WHETHER AN UNMARKED ITEM IS AN ATOM. IF IT IS IT IS NOT GARBAGE
-; AND IT IS PRESERVED WITH ITS VALUE CELLS FLUSHED
-
-	HLRZ	0,-1(A)		; GET TYPE OF FIRST D.W.
-	ANDI	0,TYPMSK	; FLUSH MONITORS
-	CAIE	0,SATOM
-	JRST	STOGC5		; NOT AN ATOM COLLECT THE GARBAGE
-	PUSH	P,A		; SAVE PTR TO D.W.
-	HLRZ	0,(A)
-	SUB	A,0		; POINT TO JUST BEFORE ATOM
-	SETZM	1(A)		; ZERO VALUE CELLS
-	SETZM	2(A)
-	POP	P,A		; RESTORE A
-	JRST	STOGC1
-
-STOGC5:	HLRZ	0,(A)
-	JUMPE	C,STOGC3	; jump if no block under construction
-	ADD	C,0		; else add this length to current
-	JRST	STOGC4
-
-STOGC3:	MOVEI	B,(A)		; save pointer
-	MOVE	C,0		; init length
-
-STOGC4:	SUB	A,0		; point to next block
-	JRST	STOGCL
-
-STOGC1:	HLLOS	(A)		; -1 IS INDICATOR OF FREE SLOT
-	ANDCAM	D,(A)		; kill mark bit
-	JUMPE	C,STOGC4	; if no block under cons, dont fix
-	HRLM	C,(B)		; store total block length
-	HRRM	E,(B)		; next pointer hooked in
-	MOVEI	E,(B)		; new next pointer
-	MOVEI	C,0
-	JRST	STOGC4
-
-STOGCE:	JUMPE	C,STGCE1	; jump if no current block
-	HRLM	C,(B)		; smash in count
-	HRRM	E,(B)		; smash in next pointer
-	MOVEI	E,(B)		; and setup E
-
-STGCE1:	HRRZM	E,FLIST+1	; final link up
-	POPJ	P,
-
-IMPURE
-
-FLIST:	.+1
-	ISTOST
-
-PURE
-
-END
-

src/mudsys/save.mid.169

@@ -1,774 +0,0 @@
-TITLE SAVE AND RESTORE STATE OF A MUDDLE
-
-RELOCATABLE
-
-.INSRT DSK:MUDDLE >
-
-SYSQ
-
-UNTAST==0
-IFE ITS,[
-IF1,[
-.INSRT STENEX >
-EXPUNGE SAVE
-]
-]
-.GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
-.GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
-.GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
-.GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
-.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT
-
-FME==1000,,-1
-FLS==1000,,
-MFORK==400000
-
-MFUNCTION FSAVE,SUBR
-
-	ENTRY
-
-	JRST	SAVE1
-
-MFUNCTION SAVE,SUBR
-
-	ENTRY
-SAVE1:	PUSHJ	P,SQKIL
-IFE ITS,[
-	SKIPE	MULTSG
-	 PUSHJ	P,NOMULT
-]
-	PUSH	P,.
-	PUSH	P,[0]		; GC OR NOT?
-IFE ITS,[
-	MOVE	B,[400600,,]
-	MOVE	C,[440000,,100000]
-]
-	PUSHJ	P,GTFNM		; GET THE FILE NAME ONTO P
-	 JRST	.+2
-	JRST	SAVEON
-	JUMPGE	AB,TMA		; TOO MUCH STRING
-	GETYP	0,(AB)		; WHAT IS ARG
-	CAMGE	AB,[-3,,0]	; NOT TOO MANY
-	JRST	TMA
-	CAIN	0,TFALSE
-IFN ITS,	SETOM	-6(P)		; GC FLAG
-IFE ITS,	SETOM	(P)
-SAVEON:
-IFN ITS,[
-	MOVSI	A,7		; IMAGE BLOCK OUT
-	MOVEM	A,-4(P)		; DIRECTION
-	PUSH	P,A
-	PUSH	P,-4(P)		; DEVICE
-	PUSH	P,[SIXBIT /_MUDS_/]
-	PUSH	P,[SIXBIT />/]
-	PUSH	P,-4(P)		; SNAME
-	MOVEI	A,-4(P)		; POINT TO BLOCK
-	PUSHJ	P,MOPEN		; ATTEMPT TO OPEN
-	JRST	CANTOP
-	SUB	P,[5,,5]	; FLUSH OPEN BLOCK
-	PUSH	P,-6(P)		; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
-]
-	EXCH	A,(P)		; CHAN TO STACK GC TO A
-	JUMPL	A,NOGC
-	PUSH	TP,$TFIX		; CAUSE HAIRY GC TO OCCUR
-	PUSH	TP,[0]
-	PUSH	TP,$TATOM
-	PUSH	TP,IMQUOTE T
-	MCALL	2,GC
-NOGC:	PUSHJ	P,PURCLN
-
-; NOW GET VERSION OF MUDDLE FOR COMPARISON
-
-	MOVE	A,MUDSTR+2	; GET #
-	MOVEI	B,177		; CHANGE ALL RUBOUT CHARACTERS
-	MOVEI	C,40		; ----- TO SPACES
-	PUSHJ	P,HACKV
-
-	PUSHJ	P,WRDOUT
-	MOVE	A,P.TOP		; GET TOP OF CORD
-	PUSHJ	P,WRDOUT
-	MOVEI	A,0		; WRITE ZERO IF FAST
-IFN ITS,	SKIPE	-8(P)	; -6 --> -8 TAA
-IFE ITS,	SKIPE	-1(P)
-	PUSHJ	P,WRDOUT
-	MOVE	A,VECTOP	; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
-	PUSHJ	P,WRDOUT
-
-IFN ITS,[
-	SETZB	A,B		; FIRST, ALL INTS OFF
-	.SETM2	A,
-
-; IF FAST SAVE JUMP OFF HERE
-
-	SKIPE	-6(P)
-	JRST	FSAVE1
-
-]
-
-IFE ITS,[
-	MOVEI	A,400000	; FOR THIS PROCESS
-	DIR			; TURN OFF INT SYSTEM
-
-; IF FAST, LEAVE HERE
-
-	SKIPE	-1(P)
-	JRST	FSAVE1
-
-; NOW DUMP OUT GC SPACE
-
-]
-IFN ITS,[
-
-DMPDN2:	SETZB	A,B		; SET UP RENAME WHILE OPEN ETC.
-	MOVE	E,-1(P)
-	MOVE	D,-2(P)
-	LDB	C,[270400,,0]	; GET CHANNEL
-	.FDELE	A		; RENAME IT
-	FATAL SAVE RENAME FAILED
-	XOR	0,[<.IOT A>#<.CLOSE>]	; CHANGE TO A CLOSE
-	XCT	0
-
-	MOVE	A,MASK1		; TURN INTS BACK ON
-	MOVE	B,MASK2
-	.SETM2	A,
-]
-
-IFE ITS,[
-
-DMPDN2:	MOVE	A,0
-	CLOSF
-	FATAL CANT CLOSE SAVE FILE
-	CIS			; CLEAR IT SYSTEM
-	MOVEI	A,400000
-	EIR			; AND RE-ENABLE
-]
-
-SDONE:	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE SAVED
-	JRST	FINIS
-
-; SCAN FOR MANY OCCURENCES OF THE SAME THING
-
-
-; HERE TO WRITE OUT FAST SAVE FILE
-
-FSAVE1:
-IFN UNTAST,[
-	PUSHJ	P,PUCHK
-]
-	MOVE	A,PARTOP	; DONT WRITE OUT "HOLE"
-	ADDI	A,1777
-	ANDCMI	A,1777
-	MOVEI	E,(A)
-	PUSHJ	P,WRDOUT
-	MOVE	0,(P)		; CHANNEL TO 0
-IFN ITS,[
-	ASH	0,23.		; TO AC FIELS
-	IOR	0,[.IOT A]
-	MOVEI	A,5		; START AT WORD 5
-]
-IFE ITS,[
-	MOVE	A,[-<P-E>,,E]
-	PUSH	P,(A)
-	AOBJN	A,.-1
-	MOVE	A,0
-	MOVE	B,P		; WRITE OUT P FOR WIINAGE
-	BOUT
-	MOVE	B,[444400,,20]
-	MOVNI	C,20-6
-	SOUT			; MAKE PAGE BOUNDARIES WIN
-	MOVEI	A,20		; START AT 20
-]
-	MOVEI	B,(E)		; PARTOP TO B
-	PUSHJ	P,FOUT		; WRITE OUT UP TO PAIR TOP
-	PUSHJ	P,PUROUT
-	SUB	P,[1,,1]	; CLEAN OFF STACK
-	JRST	DMPDN2
-
-IFN ITS,[
-FOUT:	MOVEI	D,(A)		; SAVE START
-	SUB	A,B		; COMPUTE LH OF IOT PNTR
-	MOVSI	A,(A)
-	SKIPL	A		; IF + MEANS GROSS CORE SIZE
-	MOVSI	A,400000	; USE BIGGEST
-	HRRI	A,(D)
-	XCT	0		; ZAP, OUT IT GOES
-	CAMGE	A,B		; SKIP IF ALL WENT
-	JRST	FOUT		; DO THE REST
-	POPJ	P,		; GO CLOSE FILE
-]
-IFE ITS,[
-FOUT:	MOVEI	C,(A)
-	SUBI	C,(B)		; # OF BYTES TP C
-	MOVEI	B,(A)		; START TO B
-	HRLI	B,444400
-	MOVE	A,0
-	SOUT			; WRITE IT OUT
-	POPJ	P,
-]
-	
-
-; HERE TO ATTEMPT TO RESTORE A SAVED STATE
-
-MFUNCTION RESTORE,SUBR
-
-	ENTRY
-	PUSHJ	P,SQKIL
-IFE ITS,[
-	MOVE	B,[100600,,]
-	MOVE	C,[440000,,240000]
-]
-	PUSHJ	P,GTFNM
-	JRST	TMA
-IFN ITS,[
-	MOVSI	A,6		; READ/IMAGE/BLOCK
-	MOVEM	A,-4(P)
-	MOVEI	A,-4(P)
-	PUSHJ	P,MOPEN		; OPEN THE LOSER
-	JRST	FNF
-	SUB	P,[6,,6]	; REMOVE OPEN BLOCK
-
-	PUSH	P,A		; SAVE CHANNEL
-	PUSHJ	P,SGSNAM	; SAVE SNAME IN SYSTEM
-]
-IFE ITS,	PUSH	P,A		; SAVE JFN
-	PUSHJ	P,CKVRS		; CHECK THE VERSION NUMBER
-
-IFN ITS,	MCALL	0,IPCOFF	; CLOSE ALL IPC CHANS
-	PUSHJ	P,CLOSAL	; CLOSE CHANNELS
-IFN ITS,[
-	SETZB	A,B		; KILL ALL POSSIBLE INTERRUPTION
-	.SETM2	A,
-	DOTCAL	UNLOCK,[[1000,,-1]]
-	 .VALUE			; UNLOCK LOCKS
-]
-IFE ITS,[
-	MOVEI	A,400000	; DISABLE INTS
-	DIR			; INTS OFF
-
-	HLRZ	A,IJFNS		; CLOSE AGC
-	CLOSF
-	 JFCL
-	HRRZ	A,IJFNS		; CLOSE INTERPRETER
-	CLOSF
-	 JFCL
-	HLRZ	A,IJFNS1	; CLOSE SGC
-	CLOSF
-	 JFCL
-
-	HRRZ	A,IJFNS1
-	CLOSF
-	 JFCL
-
-	SETZM	IJFNS
-	SETZM	IJFNS1
-]
-	PUSHJ	P,PURCLN	; DONT KEEP PURE SHAREDNESS
-
-	POP	P,E
-IFE ITS,[
-	SKIPLE	A,SFRK		; IF WE HAVE AN INFERIOR, KILL IT
-	 KFORK
-]
-	MOVE	A,E
-FSTART:	MOVE	P,GCPDL
-	PUSH	P,A
-IFN ITS,[
-	MOVE	0,[1-PHIBOT,,1]
-	DOTCAL	CORBLK,[[FLS],[FME],0]
-	FATAL CANT FLUSH PURE PAGES
-]
-	PUSHJ	P,WRDIN		; GET P.TOP
-	ASH	A,-10.
-	MOVE	E,A
-	PUSHJ	P,WRDIN		; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
-	JUMPE	A,FASTR
-
-IFE ITS,[
-FASTR1:	MOVEI	A,P-1
-	MOVEI	B,P-1-E
-	POP	P,(A)
-	SUBI	A,1
-	SOJG	B,.-2
-]
-
-IFN ITS,[
-FASTR1:
-]
-IFN ITS,	MOVEM	E,NOTTY		; SAVE TTY FLAG
-IFE ITS,[
-	MOVEM	E,DEMFLG
-	PUSHJ	P,GETJS
-	HRRZS	IJFNS
-	SETZM	IJFNS1
-]
-	PUSHJ	P,PURCLN	; IN CASE RESTORED THING HAD PURE STUFF
-	PUSHJ	P,INTINT	; USE NEW INTRRRUPTS
-
-IFN ITS,[
-	.SUSET	[.RSNAM,,A]
-	PUSH	P,A
-]
-
-; NOW CYCLE THROUGH CHANNELS
-	MOVE	C,[-N.CHNS*2,,CHNL1]	; POINT TO REAL CHANNELS SLOTS
-	PUSH	TP,$TVEC
-	PUSH	TP,C
-	PUSH	P,[N.CHNS]
-
-CHNLP:	HRRZ	A,(C)		; SEE IF NEW VALUE
-	JUMPN	A,NXTCHN
-	SKIPN	B,1(C)		; GET CHANNEL
-	JRST	NXTCHN
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLOS
-	MOVE	C,(TP)		; GET POINTER
-NXTCHN:	ADD	C,[2,,2]	; AND BUMP
-	MOVEM	C,(TP)
-	SOSE	(P)
-	JRST	CHNLP
-
-	SKIPN	C,CHNL0+1	; ANY PSUEDO CHANNELS
-	JRST	RDONE		; NO, JUST GO AWAY
-	MOVSI	A,TLIST		; YES, REOPEN THEM
-	MOVEM	A,(TP)-1
-CHNLP1:	MOVEM	C,(TP)		; SAVE POINTER
-	SKIPE	B,(C)+1		; GET CHANNEL
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLO1
-	MOVE	C,(TP)		; GOBBLE POINTER
-	HRRZ	C,(C)		; REST LIST OF PSUEDO CHANNELS
-	JUMPN	C,CHNLP1
-
-RDONE:	MOVE	A,VECTOP
-	CAMN	A,P.TOP
-	JRST	NOCOR
-	SETZM	(A)
-	HRLS	A
-	ADDI	A,1		; SET UP BLT POINTER
-	MOVE	B,P.TOP
-	BLT	A,-1(B)		; TO THE TOP OF THE WORLD
-NOCOR:	SUB	TP,[2,,2]
-	SUB	P,[1,,1]
-	PUSHJ	P,TTYOPE
-IFN ITS,[
-	PUSHJ	P,IPCBLS	;BLESS ALL THE IPC CHANNELS
-	PUSHJ	P,SGSNAM	; GET SNAME
-	SKIPN	A
-	MOVE	A,(P)		; GET OLD SNAME
-	SUB	P,[1,,1]
-	PUSHJ	P,6TOCHS	; TO STRING
-]
-IFE ITS,[
-	PUSHJ	P,SGSNMQ	; SKIPS IF SNAME IS NON-NIL
-	 PUSHJ	P,%RSNAM	;  ELSE GETS "REAL" SNAME
-	PUSH	TP,A
-	PUSH	TP,B
-	MCALL	1,SNAME
-	SETOM	SFRK
-]
-	PUSHJ	P,%RUNAM
-	PUSHJ	P,%RJNAM
-	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE RESTORED
-	JRST	FINIS
-
-IFE ITS,[
-;SKIPS IF THERE IS AN SNAME, RETURNING IT
-SGSNMQ:	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIE	0,TCHSTR
-	 JRST	CPOPJ
-	HRRZ	0,A
-	JUMPE	CPOPJ
-	JRST	CPOPJ1
-]
-
-FASTR:
-IFN ITS,[
-	PUSHJ	P,WRDIN
-	ADDI	A,1777
-	ANDCMI	A,1777		; ROUND AND TO PAGE BOUNDRY
-	ASH	A,-10.		; TO PAGES
-	MOVNS	A
-	MOVSI	A,(A)		; TO PAGE AOBJN
-	MOVE	C,A		; COPY OF POINTER
-	MOVE	0,NOTTY		; SAVE NOTTY FLAG AROUND
-	MOVE	D,(P)		; CHANNEL
-	DOTCAL	CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
-	FATAL	CORBLK ON RESTORE LOSSAGE
-	PUSHJ	P,PURIN		; GET PURIFIED STRUCTURE
-	MOVSI	A,(D)		; GET CHANNLEL BACK
-	ASH	A,5
-	MOVEI	B,E		; WHERE TO STRAT IN FILE
-	IOR	A,[.ACCESS B]
-	XCT	A		; ACCESS TO RIGHT ACS
-	XOR	A,[<.IOT B>#<.ACCESS B>]
-	MOVE	B,[D-P-1,,E]
-	XCT	A		; GET ACS
-	MOVE	E,0		; NO TTY FLAG BACK
-	XOR	A,[<.IOT B>#<.CLOSE>]
-	XCT	A
-	MOVE	A,GCSTOP	; GET CORE AND FOOL P.CORE
-	ADDI	A,1777
-	ANDCMI	A,1777
-	EXCH	A,P.TOP			; GET P.TOP
-	ASH	A,-10.		; TO PAGES
-	PUSHJ	P,P.CORE
-	PUSHJ	P,NOCORE
-	JRST	FASTR1
-]
-
-IFE ITS,[
-FASTR:	POP	P,A		; JFN TO A
-	BIN			; CORE TOP TO B
-	MOVE	E,B		; SAVE
-	BIN			; PARTOP
-	MOVE	D,B
-	BIN			; SAVED P
-	MOVE	P,B
-	MOVE	0,DEMFLG	; SAVE DEMFLG FLAG AROUND
-	HRL	E,C		; SAVE VECTOP
-	MOVSI	A,(A)		; JFN TO LH
-	MOVSI	B,400000	; FOR ME
-	MOVSI	C,120400	; FLAGS
-	ASH	D,-9.		; PAGES TO D
-	PMAP
-	ADDI	A,1
-	ADDI	B,1
-	SOJG	D,.-3
-
-	PUSHJ	P,PURIN
-
-	HLRZS	A
-	CLOSF
-	JFCL
-	MOVE	E,0		; DEMFLG TO E
-	JRST	FASTR1
-]
-
-; HERE TO GROCK FILE NAME FROM ARGS
-
-GTFNM:
-IFN ITS,[
-	PUSH	P,[0]		; DIRECTION
-	PUSH	TP,$TPDL
-	PUSH	TP,P
-	IRP A,,[DSK,MUDDLE,SAVE]
-	PUSH	P,[SIXBIT /A/]
-	TERMIN
-	PUSHJ	P,SGSNAM	; GET SNAME
-	PUSH	P,A		; SAVE SNAME
-	JUMPGE	AB,GTFNM1
-	PUSHJ	P,RGPRS		; PARSE THESE ARGS
-	JRST	.+2
-GTFNM1:	AOS	-5(P)		; SKIP RETURN
-	MOVE	A,(P)		; GET SNAME
-	.SUSET	[.SSNAM,,A]
-	MOVE	A,-5(P)		; GET RET ADDR
-	SUB	TP,[2,,2]
-	JRST	(A)
-
-; HERE TO OUTPUT 1 WORD
-
-WRDOUT:	PUSH	P,B
-	PUSH	P,A
-	HRROI	B,(P)		; POINT AT C(A)
-	MOVE	A,-3(P)		; CHANNEL
-	PUSHJ	P,MIOT		 ;WRITE IT
-POPJB:	POP	P,A
-	POP	P,B
-	POPJ	P,
-
-; HERE TO READ 1 WORD
-WRDIN==WRDOUT
-]
-IFE ITS,[
-	PUSH	P,C
-	PUSH	P,B
-	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIN	0,TUNBOU
-	 JRST	GTFNM0
-	TRNN	A,-1		;ANY LENGTH?
-	 PUSHJ	P,%RSNAM	;IF <SNAME> IS "", GET REAL ONE
-	PUSHJ	P,ADDNUL
-	 SKIPA
-GTFNM0:	MOVEI	B,0
-	PUSH	P,[377777,,377777]
-	PUSH	P,[-1,,[ASCIZ /DSK/]]
-	PUSH	P,B
-	PUSH	P,[-1,,[ASCIZ /MUDDLE/]]
-	PUSH	P,[-1,,[ASCIZ /SAVE/]]
-	PUSH	P,[0]
-	PUSH	P,[0]
-	PUSH	P,[77]		; USE AN OBSCURE JFN IF POSSIBLE
-	MOVE	A,(AB)
-	MOVE	B,1(AB)
-	PUSHJ	P,ADDNUL
-	MOVEI	A,-10(P)
-	GTJFN
-	JRST	FNF
-	SUB	P,[9.,,9.]
-	POP	P,B
-	OPENF
-	JRST	FNF
-	ADD	AB,[2,,2]
-	SKIPL	AB
-CPOPJ1:	AOS	(P)
-CPOPJ:	POPJ	P,
-
-WRDIN:	PUSH	P,B
-	MOVE	A,-2(P)		; JFN TO A
-	BIN
-	MOVE	A,B
-	POP	P,B
-	POPJ	P,
-
-WRDOUT:	PUSH	P,B
-	MOVE	B,-2(P)
-	EXCH	A,B
-	BOUT
-	EXCH	A,B
-	POP	P,B
-	POPJ	P,
-]
-
-
-;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
-HACKV:	PUSH	P,D
-	PUSH	P,E
-	MOVE	D,[440700,,A]
-	MOVEI	E,5
-HACKV1:	ILDB	0,D
-	CAIN	0,(B)		; MATCH ?
-	DPB	C,D		; YES, CLOBBER
-	SOJG	E,HACKV1
-	POP	P,E
-	POP	P,D
-	POPJ	P,
-
-
-CANTOP:	ERRUUO	EQUOTE CANT-OPEN-OUTPUT-FILE
-
-FNF:	ERRUUO	EQUOTE FILE-NOT-FOUND
-
-BADVRS:	ERRUUO	EQUOTE MUDDLE-VERSIONS-DIFFER
-
-
-CHNLO1:	MOVE	C,(TP)
-	SETZM	1(C)
-	JRST	CHNLO2
-
-CHNLOS:	MOVE	C,(TP)
-	SETZM	(C)-1
-CHNLO2:	MOVEI	B,[ASCIZ /
-CHANNEL-NOT-RESTORED
-/]
-	JRST	MSGTYP"
-
-
-NOCORE:	PUSH	P,A
-	PUSH	P,B
-	MOVEI	B,[ASCIZ /
-WAIT, CORE NOT YET HERE
-/]
-	PUSHJ	P,MSGTYP"
-	MOVE	A,-1(P)		; RESTORE BLOCKS NEEDED
-	MOVEI	B,1
-	.SLEEP	B,
-	PUSHJ	P,P.CORE
-	JRST	.-4
-	MOVEI	B,[ASCIZ /
-CORE ARRIVED
-/]
-	PUSHJ	P,MSGTYP
-	POP	P,B
-	POP	P,A
-	POPJ	P,
-
-IFN UNTAST,[
-PUCHK:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PURCH1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JFCL
-	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURCH1
-	POPJ	P,
-]
-
-; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
-; INTO A SAVE FILE.
-
-PUROUT:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PUROU2:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JRST	INCPUT
-	PUSH	P,A		; SAVE A
-	ASH	A,10.		; TO WORDS
-	HRLI	A,-2000		; MAKE UP AOBJN PTR FOR IOT
-	MOVE	B,-2(P)		; RESTORE CHN #
-IFN ITS,[
-	DOTCAL	IOT,[B,A]
-	FATAL	SAVE--IOT FAILED
-]
-IFE ITS,[
-	PUSH	P,C		; SAVE C
-	MOVE	B,A		; SET UP BYTE POINTER
-	MOVE	A,0		; CHANNEL TO A
-	HRLI	B,444400	; SET UP BYTE POINTER
-	MOVNI	C,2000
-	SOUT			; OUT IT GOES
-	POP	P,C
-]
-
-	POP	P,A		; RESTORE PAGE #
-INCPUT:	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PUROU2
-	POPJ	P,
-
-
-IFN UNTAST,[
-
-CHKPGJ:	TDZA	0,0
-]
-CHKPGI:
-IFN UNTAST,[
-	MOVEI	0,1
-]
-	PUSH	P,A		; SAVE IT
-	IDIVI	A,16.		; FIND ENTRY IN PMAP TABLE
-	MOVE	C,PMAPB(A)	; GET WORD CONTAINING ENTRY
-	HRLZI	D,400000	; SET UP TEST WORD
-	IMULI	B,2
-	MOVNS	B
-	LSH	D,(B)		; GET TO CHECK PAIR
-	LSH	D,-1		; TO BIT INDICATING SAVE
-	TDON	C,D		; SKIP IF PAGE CONTAINS P.S
-	JRST	PUROU1
-	POP	P,A
-	AOS	(P)		; SKIP ITS A WINNER
-IFN UNTAST,[
-	JUMPN	0,.+4
-	LSH	D,1
-	TDNN	C,D
-	AOS	(P)
-]	POPJ	P,		; EXIT
-PUROU1:
-IFN UNTAST,[
-	JUMPE	0,CHKPG2
-IFN ITS,[
-	PUSH	P,A
-	DOTCAL	CORTYP,[A,[2000,,A],[2000,,0]]
-	FATAL DOTCAL FAILURE
-	SKIPN	A
-	MOVEI	0,0
-	POP	P,A
-	JUMPGE	0,CHKPG2
-]
-IFE ITS,[
-	PUSH	P,A
-	PUSH	P,B
-	LSH	A,1
-	HRLI	A,400000
-	RPACS
-	MOVE	0,B
-	POP	P,B
-	POP	P,A
-	TLC	0,150400
-	TRNE	0,150400
-	JRST	CHKPG2
-]
-	LSH	D,1
-	TDO	C,D
-	MOVEM	C,PMAPB(A)
-	AOS	-1(P)
-CHKPG2:]
-	POP	P,A
-	POPJ	P,
-
-
-; ROUTINE TO READ IN PURE STRUCTURE PAGES
-
-IFN ITS,[
-PURIN:	PUSH	P,D		; SAVE CHANNEL #
-	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO WORDS
-PURIN1:
-IFN UNTAST,	PUSHJ	P,CHKPGJ	; SEE IF PURE PAGE EXISTS
-IFE UNTAST,	PUSHJ	P,CHKPGI	; SEE IF PURE PAGE EXISTS
-	JRST	NXPGPN
-IFN UNTAST,[
-	SKIPA	D,[200000]
-	MOVEI	D,[104000]
-	MOVSI	0,(D)
-]
-	PUSH	P,A		; SAVE A
-	MOVE	D,-1(P)		; RESTORE CHANNEL #
-	HRLI	A,-1		; SET UP AOBJN POINTER FOR DOTCAL
-IFN UNTAST,[
-	DOTCAL	CORBLK,[0,[1000,,-1],A,D]
-]
-IFE UNTAST,[
-	DOTCAL	CORBLK,[[1000,,200000],[1000,,-1],A,D]
-]
-	FATAL SAVE--CORBLK FAILED
-	POP	P,A		; RESTORE A
-NXPGPN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,D		; RESTORE CHANNEL
-	POPJ	P,
-]
-IFE ITS,[
-PURIN:	PUSH	P,A		; SAVE CHANNEL
-	MOVEI	E,HIBOT		; TOP OF SCAN
-	ASH	E,-10.
-	MOVE	A,PURBOT	; BOTTOM OF SCAN
-	ASH	A,-10.		; TO PAGES
-PURIN1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS NEEDED
-	JRST	NXTPGN
-	SKIPA	C,[120000]
-	MOVEI	C,120400
-	PUSH	P,A
-	MOVE	B,A		; COPY TO B
-	ASH	B,1		; FOR TEXEX PAGES
-	HRLI	B,MFORK		; SET UP ARGS TO PMAP
-	MOVSI	C,(C)
-	MOVE	A,-1(P)		; GET FILE POINTER
-	PMAP			; IN IT COMES
-	ADDI	B,1		; INCREMENT B
-	ADDI	A,1		; AND A
-	PMAP			; SECOND HALF OF ITS PAGE
-	ADDI	A,1
-	MOVEM	A,-1(P)		; SAVE FILE PAGE
-	POP	P,A
-NXTPGN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,A		; RESTOR CHANNEL
-	POPJ	P,		;EXIT
-]
-CKVRS:	PUSH	P,-1(P)
-	PUSHJ	P,WRDIN		; READ MUDDLE VERSION
-	MOVEI	B,40		; CHANGE ALL SPACES
-	MOVEI	C,177		; ----- TO RUBOUT CHARACTERS
-	PUSHJ	P,HACKV
-	CAME	A,MUDSTR+2	; AGREE ?
-	JRST	BADVRS
-	SUB	P,[1,,1]	; POP OFF CHANNEL #
-	POPJ	P,
-
-
-END
-

src/mudsys/save.mid.174

@@ -1,790 +0,0 @@
-TITLE SAVE AND RESTORE STATE OF A MUDDLE
-
-RELOCATABLE
-
-.INSRT DSK:MUDDLE >
-
-SYSQ
-
-
-UNTAST==0
-IFE ITS,[
-IF1,[
-.INSRT STENEX >
-EXPUNGE SAVE
-]
-]
-.GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
-.GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
-.GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
-.GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
-.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT,THIBOT
-.GLOBAL MAPJFN,DIRCHN
-
-FME==1000,,-1
-FLS==1000,,
-MFORK==400000
-
-MFUNCTION FSAVE,SUBR
-
-	ENTRY
-
-	JRST	SAVE1
-
-MFUNCTION SAVE,SUBR
-
-	ENTRY
-SAVE1:	PUSHJ	P,SQKIL
-IFE ITS,[
-	SKIPE	MULTSG
-	 PUSHJ	P,NOMULT
-]
-	PUSH	P,.
-	PUSH	P,[0]		; GC OR NOT?
-IFE ITS,[
-	MOVE	B,[400600,,]
-	MOVE	C,[440000,,100000]
-]
-	PUSHJ	P,GTFNM		; GET THE FILE NAME ONTO P
-	 JRST	.+2
-	JRST	SAVEON
-	JUMPGE	AB,TMA		; TOO MUCH STRING
-	GETYP	0,(AB)		; WHAT IS ARG
-	CAMGE	AB,[-3,,0]	; NOT TOO MANY
-	JRST	TMA
-	CAIN	0,TFALSE
-IFN ITS,	SETOM	-6(P)		; GC FLAG
-IFE ITS,	SETOM	(P)
-SAVEON:
-IFN ITS,[
-	MOVSI	A,7		; IMAGE BLOCK OUT
-	MOVEM	A,-4(P)		; DIRECTION
-	PUSH	P,A
-	PUSH	P,-4(P)		; DEVICE
-	PUSH	P,[SIXBIT /_MUDS_/]
-	PUSH	P,[SIXBIT />/]
-	PUSH	P,-4(P)		; SNAME
-	MOVEI	A,-4(P)		; POINT TO BLOCK
-	PUSHJ	P,MOPEN		; ATTEMPT TO OPEN
-	JRST	CANTOP
-	SUB	P,[5,,5]	; FLUSH OPEN BLOCK
-	PUSH	P,-6(P)		; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
-]
-	EXCH	A,(P)		; CHAN TO STACK GC TO A
-	JUMPL	A,NOGC
-	PUSH	TP,$TFIX		; CAUSE HAIRY GC TO OCCUR
-	PUSH	TP,[0]
-	PUSH	TP,$TATOM
-	PUSH	TP,IMQUOTE T
-	MCALL	2,GC
-NOGC:	PUSHJ	P,PURCLN
-
-; NOW GET VERSION OF MUDDLE FOR COMPARISON
-
-	MOVE	A,MUDSTR+2	; GET #
-	MOVEI	B,177		; CHANGE ALL RUBOUT CHARACTERS
-	MOVEI	C,40		; ----- TO SPACES
-	PUSHJ	P,HACKV
-
-	PUSHJ	P,WRDOUT
-	MOVE	A,P.TOP		; GET TOP OF CORD
-	PUSHJ	P,WRDOUT
-	MOVEI	A,0		; WRITE ZERO IF FAST
-IFN ITS,	SKIPE	-8(P)	; -6 --> -8 TAA
-IFE ITS,	SKIPE	-1(P)
-	PUSHJ	P,WRDOUT
-	MOVE	A,VECTOP	; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
-	PUSHJ	P,WRDOUT
-
-IFN ITS,[
-	SETZB	A,B		; FIRST, ALL INTS OFF
-	.SETM2	A,
-
-; IF FAST SAVE JUMP OFF HERE
-
-	SKIPE	-6(P)
-	JRST	FSAVE1
-
-]
-
-IFE ITS,[
-	MOVEI	A,400000	; FOR THIS PROCESS
-	DIR			; TURN OFF INT SYSTEM
-
-; IF FAST, LEAVE HERE
-
-	SKIPE	-1(P)
-	JRST	FSAVE1
-
-; NOW DUMP OUT GC SPACE
-
-]
-IFN ITS,[
-
-DMPDN2:	SETZB	A,B		; SET UP RENAME WHILE OPEN ETC.
-	MOVE	E,-1(P)
-	MOVE	D,-2(P)
-	LDB	C,[270400,,0]	; GET CHANNEL
-	.FDELE	A		; RENAME IT
-	FATAL SAVE RENAME FAILED
-	XOR	0,[<.IOT A>#<.CLOSE>]	; CHANGE TO A CLOSE
-	XCT	0
-
-	MOVE	A,MASK1		; TURN INTS BACK ON
-	MOVE	B,MASK2
-	.SETM2	A,
-]
-
-IFE ITS,[
-
-DMPDN2:	MOVE	A,0
-	CLOSF
-	FATAL CANT CLOSE SAVE FILE
-	CIS			; CLEAR IT SYSTEM
-	MOVEI	A,400000
-	EIR			; AND RE-ENABLE
-]
-
-SDONE:	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE SAVED
-	JRST	FINIS
-
-; SCAN FOR MANY OCCURENCES OF THE SAME THING
-
-
-; HERE TO WRITE OUT FAST SAVE FILE
-
-FSAVE1:
-IFN UNTAST,[
-	PUSHJ	P,PUCHK
-]
-	MOVE	A,PARTOP	; DONT WRITE OUT "HOLE"
-	ADDI	A,1777
-	ANDCMI	A,1777
-	MOVEI	E,(A)
-	PUSHJ	P,WRDOUT
-	MOVE	0,(P)		; CHANNEL TO 0
-IFN ITS,[
-	ASH	0,23.		; TO AC FIELS
-	IOR	0,[.IOT A]
-	MOVEI	A,5		; START AT WORD 5
-]
-IFE ITS,[
-	MOVE	A,[-<P-E>,,E]
-	PUSH	P,(A)
-	AOBJN	A,.-1
-	MOVE	A,0
-	MOVE	B,P		; WRITE OUT P FOR WIINAGE
-	BOUT
-	MOVE	B,[444400,,20]
-	MOVNI	C,20-6
-	SOUT			; MAKE PAGE BOUNDARIES WIN
-	MOVEI	A,20		; START AT 20
-]
-	MOVEI	B,(E)		; PARTOP TO B
-	PUSHJ	P,FOUT		; WRITE OUT UP TO PAIR TOP
-	PUSHJ	P,PUROUT
-	SUB	P,[1,,1]	; CLEAN OFF STACK
-	JRST	DMPDN2
-
-IFN ITS,[
-FOUT:	MOVEI	D,(A)		; SAVE START
-	SUB	A,B		; COMPUTE LH OF IOT PNTR
-	MOVSI	A,(A)
-	SKIPL	A		; IF + MEANS GROSS CORE SIZE
-	MOVSI	A,400000	; USE BIGGEST
-	HRRI	A,(D)
-	XCT	0		; ZAP, OUT IT GOES
-	CAMGE	A,B		; SKIP IF ALL WENT
-	JRST	FOUT		; DO THE REST
-	POPJ	P,		; GO CLOSE FILE
-]
-IFE ITS,[
-FOUT:	MOVEI	C,(A)
-	SUBI	C,(B)		; # OF BYTES TP C
-	MOVEI	B,(A)		; START TO B
-	HRLI	B,444400
-	MOVE	A,0
-	SOUT			; WRITE IT OUT
-	POPJ	P,
-]
-	
-
-; HERE TO ATTEMPT TO RESTORE A SAVED STATE
-
-MFUNCTION RESTORE,SUBR
-
-	ENTRY
-	PUSHJ	P,SQKIL
-IFE ITS,[
-	MOVE	B,[100600,,]
-	MOVE	C,[440000,,240000]
-]
-	PUSHJ	P,GTFNM
-	JRST	TMA
-IFN ITS,[
-	MOVSI	A,6		; READ/IMAGE/BLOCK
-	MOVEM	A,-4(P)
-	MOVEI	A,-4(P)
-	PUSHJ	P,MOPEN		; OPEN THE LOSER
-	JRST	FNF
-	SUB	P,[6,,6]	; REMOVE OPEN BLOCK
-
-	PUSH	P,A		; SAVE CHANNEL
-	PUSHJ	P,SGSNAM	; SAVE SNAME IN SYSTEM
-]
-IFE ITS,	PUSH	P,A		; SAVE JFN
-	PUSHJ	P,CKVRS		; CHECK THE VERSION NUMBER
-
-IFN ITS,	MCALL	0,IPCOFF	; CLOSE ALL IPC CHANS
-	PUSHJ	P,CLOSAL	; CLOSE CHANNELS
-IFN ITS,[
-	SETZB	A,B		; KILL ALL POSSIBLE INTERRUPTION
-	.SETM2	A,
-	DOTCAL	UNLOCK,[[1000,,-1]]
-	 .VALUE			; UNLOCK LOCKS
-]
-IFE ITS,[
-	MOVEI	A,400000	; DISABLE INTS
-	DIR			; INTS OFF
-
-; LOOP TO CLOSE ALL RANDOM JFNS
-
-	MOVE	E,[-JFNLNT,,JFNTBL]
-
-JFNLP:	HRRZ	A,@(E)
-	SKIPE	A
-	 CLOSF
-	  JFCL
-	HLRZ	A,@(E)
-	SKIPE	A
-	 CLOSF
-	  JFCL
-	SETZM	@(E)
-	AOBJN	E,JFNLP
-
-]
-	PUSHJ	P,PURCLN	; DONT KEEP PURE SHAREDNESS
-
-	POP	P,E
-IFE ITS,[
-	MOVEI	C,0
-	MOVNI	A,1
-	MOVE	B,[MFORK,,1]
-	MOVEI	D,THIBOT-1
-	PMAP
-	ADDI	B,1
-	SOJG	D,.-2
-	SKIPLE	A,SFRK		; IF WE HAVE AN INFERIOR, KILL IT
-	 KFORK
-]
-	MOVE	A,E
-FSTART:	MOVE	P,GCPDL
-	PUSH	P,A
-IFN ITS,[
-	MOVE	0,[1-PHIBOT,,1]
-	DOTCAL	CORBLK,[[FLS],[FME],0]
-	FATAL CANT FLUSH PURE PAGES
-]
-	PUSHJ	P,WRDIN		; GET P.TOP
-	ASH	A,-10.
-	MOVE	E,A
-	PUSHJ	P,WRDIN		; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
-	JUMPE	A,FASTR
-
-IFE ITS,[
-FASTR1:	MOVEI	A,P-1
-	MOVEI	B,P-1-E
-	POP	P,(A)
-	SUBI	A,1
-	SOJG	B,.-2
-]
-
-IFN ITS,[
-FASTR1:
-]
-IFN ITS,	MOVEM	E,NOTTY		; SAVE TTY FLAG
-IFE ITS,[
-	MOVEM	E,DEMFLG
-	PUSHJ	P,GETJS
-	HRRZS	IJFNS
-	SETZM	IJFNS1
-]
-	PUSHJ	P,PURCLN	; IN CASE RESTORED THING HAD PURE STUFF
-	PUSHJ	P,INTINT	; USE NEW INTRRRUPTS
-
-IFN ITS,[
-	.SUSET	[.RSNAM,,A]
-	PUSH	P,A
-]
-
-; NOW CYCLE THROUGH CHANNELS
-	MOVE	C,[-N.CHNS*2,,CHNL1]	; POINT TO REAL CHANNELS SLOTS
-	PUSH	TP,$TVEC
-	PUSH	TP,C
-	PUSH	P,[N.CHNS]
-
-CHNLP:	HRRZ	A,(C)		; SEE IF NEW VALUE
-	JUMPN	A,NXTCHN
-	SKIPN	B,1(C)		; GET CHANNEL
-	JRST	NXTCHN
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLOS
-	MOVE	C,(TP)		; GET POINTER
-NXTCHN:	ADD	C,[2,,2]	; AND BUMP
-	MOVEM	C,(TP)
-	SOSE	(P)
-	JRST	CHNLP
-
-	SKIPN	C,CHNL0+1	; ANY PSUEDO CHANNELS
-	JRST	RDONE		; NO, JUST GO AWAY
-	MOVSI	A,TLIST		; YES, REOPEN THEM
-	MOVEM	A,(TP)-1
-CHNLP1:	MOVEM	C,(TP)		; SAVE POINTER
-	SKIPE	B,(C)+1		; GET CHANNEL
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLO1
-	MOVE	C,(TP)		; GOBBLE POINTER
-	HRRZ	C,(C)		; REST LIST OF PSUEDO CHANNELS
-	JUMPN	C,CHNLP1
-
-RDONE:	MOVE	A,VECTOP
-	CAMN	A,P.TOP
-	JRST	NOCOR
-	SETZM	(A)
-	HRLS	A
-	ADDI	A,1		; SET UP BLT POINTER
-	MOVE	B,P.TOP
-	BLT	A,-1(B)		; TO THE TOP OF THE WORLD
-NOCOR:	SUB	TP,[2,,2]
-	SUB	P,[1,,1]
-	PUSHJ	P,TTYOPE
-IFN ITS,[
-	PUSHJ	P,IPCBLS	;BLESS ALL THE IPC CHANNELS
-	PUSHJ	P,SGSNAM	; GET SNAME
-	SKIPN	A
-	MOVE	A,(P)		; GET OLD SNAME
-	SUB	P,[1,,1]
-	PUSHJ	P,6TOCHS	; TO STRING
-]
-IFE ITS,[
-	PUSHJ	P,SGSNMQ	; SKIPS IF SNAME IS NON-NIL
-	 PUSHJ	P,%RSNAM	;  ELSE GETS "REAL" SNAME
-	PUSH	TP,A
-	PUSH	TP,B
-	MCALL	1,SNAME
-	SETOM	SFRK
-]
-	PUSHJ	P,%RUNAM
-	PUSHJ	P,%RJNAM
-	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE RESTORED
-	JRST	FINIS
-
-IFE ITS,[
-;SKIPS IF THERE IS AN SNAME, RETURNING IT
-SGSNMQ:	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIE	0,TCHSTR
-	 JRST	CPOPJ
-	HRRZ	0,A
-	JUMPE	CPOPJ
-	JRST	CPOPJ1
-]
-
-FASTR:
-IFN ITS,[
-	PUSHJ	P,WRDIN
-	ADDI	A,1777
-	ANDCMI	A,1777		; ROUND AND TO PAGE BOUNDRY
-	ASH	A,-10.		; TO PAGES
-	MOVNS	A
-	MOVSI	A,(A)		; TO PAGE AOBJN
-	MOVE	C,A		; COPY OF POINTER
-	MOVE	0,NOTTY		; SAVE NOTTY FLAG AROUND
-	MOVE	D,(P)		; CHANNEL
-	DOTCAL	CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
-	FATAL	CORBLK ON RESTORE LOSSAGE
-	PUSHJ	P,PURIN		; GET PURIFIED STRUCTURE
-	MOVSI	A,(D)		; GET CHANNLEL BACK
-	ASH	A,5
-	MOVEI	B,E		; WHERE TO STRAT IN FILE
-	IOR	A,[.ACCESS B]
-	XCT	A		; ACCESS TO RIGHT ACS
-	XOR	A,[<.IOT B>#<.ACCESS B>]
-	MOVE	B,[D-P-1,,E]
-	XCT	A		; GET ACS
-	MOVE	E,0		; NO TTY FLAG BACK
-	XOR	A,[<.IOT B>#<.CLOSE>]
-	XCT	A
-	MOVE	A,GCSTOP	; GET CORE AND FOOL P.CORE
-	ADDI	A,1777
-	ANDCMI	A,1777
-	EXCH	A,P.TOP			; GET P.TOP
-	ASH	A,-10.		; TO PAGES
-	PUSHJ	P,P.CORE
-	PUSHJ	P,NOCORE
-	JRST	FASTR1
-]
-
-IFE ITS,[
-FASTR:	POP	P,A		; JFN TO A
-	BIN			; CORE TOP TO B
-	MOVE	E,B		; SAVE
-	BIN			; PARTOP
-	MOVE	D,B
-	BIN			; SAVED P
-	MOVE	P,B
-	MOVE	0,DEMFLG	; SAVE DEMFLG FLAG AROUND
-	HRL	E,C		; SAVE VECTOP
-	MOVSI	A,(A)		; JFN TO LH
-	MOVSI	B,400000	; FOR ME
-	MOVSI	C,120400	; FLAGS
-	ASH	D,-9.		; PAGES TO D
-	PMAP
-	ADDI	A,1
-	ADDI	B,1
-	SOJG	D,.-3
-
-	PUSHJ	P,PURIN
-
-	HLRZS	A
-	CLOSF
-	JFCL
-	MOVE	E,0		; DEMFLG TO E
-	JRST	FASTR1
-]
-
-; HERE TO GROCK FILE NAME FROM ARGS
-
-GTFNM:
-IFN ITS,[
-	PUSH	P,[0]		; DIRECTION
-	PUSH	TP,$TPDL
-	PUSH	TP,P
-	IRP A,,[DSK,MUDDLE,SAVE]
-	PUSH	P,[SIXBIT /A/]
-	TERMIN
-	PUSHJ	P,SGSNAM	; GET SNAME
-	PUSH	P,A		; SAVE SNAME
-	JUMPGE	AB,GTFNM1
-	PUSHJ	P,RGPRS		; PARSE THESE ARGS
-	JRST	.+2
-GTFNM1:	AOS	-5(P)		; SKIP RETURN
-	MOVE	A,(P)		; GET SNAME
-	.SUSET	[.SSNAM,,A]
-	MOVE	A,-5(P)		; GET RET ADDR
-	SUB	TP,[2,,2]
-	JRST	(A)
-
-; HERE TO OUTPUT 1 WORD
-
-WRDOUT:	PUSH	P,B
-	PUSH	P,A
-	HRROI	B,(P)		; POINT AT C(A)
-	MOVE	A,-3(P)		; CHANNEL
-	PUSHJ	P,MIOT		 ;WRITE IT
-POPJB:	POP	P,A
-	POP	P,B
-	POPJ	P,
-
-; HERE TO READ 1 WORD
-WRDIN==WRDOUT
-]
-IFE ITS,[
-	PUSH	P,C
-	PUSH	P,B
-	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIN	0,TUNBOU
-	 JRST	GTFNM0
-	TRNN	A,-1		;ANY LENGTH?
-	 PUSHJ	P,%RSNAM	;IF <SNAME> IS "", GET REAL ONE
-	PUSHJ	P,ADDNUL
-	 SKIPA
-GTFNM0:	MOVEI	B,0
-	PUSH	P,[377777,,377777]
-	PUSH	P,[-1,,[ASCIZ /DSK/]]
-	PUSH	P,B
-	PUSH	P,[-1,,[ASCIZ /MUDDLE/]]
-	PUSH	P,[-1,,[ASCIZ /SAVE/]]
-	PUSH	P,[0]
-	PUSH	P,[0]
-	PUSH	P,[77]		; USE AN OBSCURE JFN IF POSSIBLE
-	MOVE	A,(AB)
-	MOVE	B,1(AB)
-	PUSHJ	P,ADDNUL
-	MOVEI	A,-10(P)
-	GTJFN
-	JRST	FNF
-	SUB	P,[9.,,9.]
-	POP	P,B
-	OPENF
-	JRST	FNF
-	ADD	AB,[2,,2]
-	SKIPL	AB
-CPOPJ1:	AOS	(P)
-CPOPJ:	POPJ	P,
-
-WRDIN:	PUSH	P,B
-	MOVE	A,-2(P)		; JFN TO A
-	BIN
-	MOVE	A,B
-	POP	P,B
-	POPJ	P,
-
-WRDOUT:	PUSH	P,B
-	MOVE	B,-2(P)
-	EXCH	A,B
-	BOUT
-	EXCH	A,B
-	POP	P,B
-	POPJ	P,
-]
-
-
-;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
-HACKV:	PUSH	P,D
-	PUSH	P,E
-	MOVE	D,[440700,,A]
-	MOVEI	E,5
-HACKV1:	ILDB	0,D
-	CAIN	0,(B)		; MATCH ?
-	DPB	C,D		; YES, CLOBBER
-	SOJG	E,HACKV1
-	POP	P,E
-	POP	P,D
-	POPJ	P,
-
-
-CANTOP:	ERRUUO	EQUOTE CANT-OPEN-OUTPUT-FILE
-
-FNF:	ERRUUO	EQUOTE FILE-NOT-FOUND
-
-BADVRS:	ERRUUO	EQUOTE MUDDLE-VERSIONS-DIFFER
-
-
-CHNLO1:	MOVE	C,(TP)
-	SETZM	1(C)
-	JRST	CHNLO2
-
-CHNLOS:	MOVE	C,(TP)
-	SETZM	(C)-1
-CHNLO2:	MOVEI	B,[ASCIZ /
-CHANNEL-NOT-RESTORED
-/]
-	JRST	MSGTYP"
-
-IFN ITS,[
-NOCORE:	PUSH	P,A
-	PUSH	P,B
-	MOVEI	B,[ASCIZ /
-WAIT, CORE NOT YET HERE
-/]
-	PUSHJ	P,MSGTYP"
-	MOVE	A,-1(P)		; RESTORE BLOCKS NEEDED
-	MOVEI	B,1
-	.SLEEP	B,
-	PUSHJ	P,P.CORE
-	JRST	.-4
-	MOVEI	B,[ASCIZ /
-CORE ARRIVED
-/]
-	PUSHJ	P,MSGTYP
-	POP	P,B
-	POP	P,A
-	POPJ	P,
-]
-IFN UNTAST,[
-PUCHK:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PURCH1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JFCL
-	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURCH1
-	POPJ	P,
-]
-
-; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
-; INTO A SAVE FILE.
-
-PUROUT:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PUROU2:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JRST	INCPUT
-	PUSH	P,A		; SAVE A
-	ASH	A,10.		; TO WORDS
-	HRLI	A,-2000		; MAKE UP AOBJN PTR FOR IOT
-	MOVE	B,-2(P)		; RESTORE CHN #
-IFN ITS,[
-	DOTCAL	IOT,[B,A]
-	FATAL	SAVE--IOT FAILED
-]
-IFE ITS,[
-	PUSH	P,C		; SAVE C
-	MOVE	B,A		; SET UP BYTE POINTER
-	MOVE	A,0		; CHANNEL TO A
-	HRLI	B,444400	; SET UP BYTE POINTER
-	MOVNI	C,2000
-	SOUT			; OUT IT GOES
-	POP	P,C
-]
-
-	POP	P,A		; RESTORE PAGE #
-INCPUT:	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PUROU2
-	POPJ	P,
-
-
-IFN UNTAST,[
-
-CHKPGJ:	TDZA	0,0
-]
-CHKPGI:
-IFN UNTAST,[
-	MOVEI	0,1
-]
-	PUSH	P,A		; SAVE IT
-	IDIVI	A,16.		; FIND ENTRY IN PMAP TABLE
-	MOVE	C,PMAPB(A)	; GET WORD CONTAINING ENTRY
-	HRLZI	D,400000	; SET UP TEST WORD
-	IMULI	B,2
-	MOVNS	B
-	LSH	D,(B)		; GET TO CHECK PAIR
-	LSH	D,-1		; TO BIT INDICATING SAVE
-	TDON	C,D		; SKIP IF PAGE CONTAINS P.S
-	JRST	PUROU1
-	POP	P,A
-	AOS	(P)		; SKIP ITS A WINNER
-IFN UNTAST,[
-	JUMPN	0,.+4
-	LSH	D,1
-	TDNN	C,D
-	AOS	(P)
-]	POPJ	P,		; EXIT
-PUROU1:
-IFN UNTAST,[
-	JUMPE	0,CHKPG2
-IFN ITS,[
-	PUSH	P,A
-	DOTCAL	CORTYP,[A,[2000,,A],[2000,,0]]
-	FATAL DOTCAL FAILURE
-	SKIPN	A
-	MOVEI	0,0
-	POP	P,A
-	JUMPGE	0,CHKPG2
-]
-IFE ITS,[
-	PUSH	P,A
-	PUSH	P,B
-	LSH	A,1
-	HRLI	A,400000
-	RPACS
-	MOVE	0,B
-	POP	P,B
-	POP	P,A
-	TLC	0,150400
-	TRNE	0,150400
-	JRST	CHKPG2
-]
-	LSH	D,1
-	TDO	C,D
-	MOVEM	C,PMAPB(A)
-	AOS	-1(P)
-CHKPG2:]
-	POP	P,A
-	POPJ	P,
-
-
-; ROUTINE TO READ IN PURE STRUCTURE PAGES
-
-IFN ITS,[
-PURIN:	PUSH	P,D		; SAVE CHANNEL #
-	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO WORDS
-PURIN1:
-IFN UNTAST,	PUSHJ	P,CHKPGJ	; SEE IF PURE PAGE EXISTS
-IFE UNTAST,	PUSHJ	P,CHKPGI	; SEE IF PURE PAGE EXISTS
-	JRST	NXPGPN
-IFN UNTAST,[
-	SKIPA	D,[200000]
-	MOVEI	D,[104000]
-	MOVSI	0,(D)
-]
-	PUSH	P,A		; SAVE A
-	MOVE	D,-1(P)		; RESTORE CHANNEL #
-	HRLI	A,-1		; SET UP AOBJN POINTER FOR DOTCAL
-IFN UNTAST,[
-	DOTCAL	CORBLK,[0,[1000,,-1],A,D]
-]
-IFE UNTAST,[
-	DOTCAL	CORBLK,[[1000,,200000],[1000,,-1],A,D]
-]
-	FATAL SAVE--CORBLK FAILED
-	POP	P,A		; RESTORE A
-NXPGPN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,D		; RESTORE CHANNEL
-	POPJ	P,
-]
-IFE ITS,[
-PURIN:	PUSH	P,A		; SAVE CHANNEL
-	MOVEI	E,HIBOT		; TOP OF SCAN
-	ASH	E,-10.
-	MOVE	A,PURBOT	; BOTTOM OF SCAN
-	ASH	A,-10.		; TO PAGES
-PURIN1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS NEEDED
-	JRST	NXTPGN
-	SKIPA	C,[120000]
-	MOVEI	C,120400
-	PUSH	P,A
-	MOVE	B,A		; COPY TO B
-	ASH	B,1		; FOR TEXEX PAGES
-	HRLI	B,MFORK		; SET UP ARGS TO PMAP
-	MOVSI	C,(C)
-	MOVE	A,-1(P)		; GET FILE POINTER
-	PMAP			; IN IT COMES
-	ADDI	B,1		; INCREMENT B
-	ADDI	A,1		; AND A
-	PMAP			; SECOND HALF OF ITS PAGE
-	ADDI	A,1
-	MOVEM	A,-1(P)		; SAVE FILE PAGE
-	POP	P,A
-NXTPGN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,A		; RESTOR CHANNEL
-	POPJ	P,		;EXIT
-]
-CKVRS:	PUSH	P,-1(P)
-	PUSHJ	P,WRDIN		; READ MUDDLE VERSION
-	MOVEI	B,40		; CHANGE ALL SPACES
-	MOVEI	C,177		; ----- TO RUBOUT CHARACTERS
-	PUSHJ	P,HACKV
-	CAME	A,MUDSTR+2	; AGREE ?
-	JRST	BADVRS
-	SUB	P,[1,,1]	; POP OFF CHANNEL #
-	POPJ	P,
-
-IFE ITS,[
-JFNTBL:	SETZ	IJFNS
-	SETZ	IJFNS1
-	SETZ	MAPJFN
-	SETZ	DIRCHN
-
-JFNLNT==.-JFNTBL
-]
-END
-
-

src/mudsys/save.mid.175

@@ -1,792 +0,0 @@
-TITLE SAVE AND RESTORE STATE OF A MUDDLE
-
-RELOCATABLE
-
-.INSRT DSK:MUDDLE >
-
-SYSQ
-
-
-UNTAST==0
-IFE ITS,[
-IF1,[
-.INSRT STENEX >
-EXPUNGE SAVE
-]
-]
-.GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
-.GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
-.GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
-.GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
-.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT,THIBOT
-.GLOBAL MAPJFN,DIRCHN
-
-FME==1000,,-1
-FLS==1000,,
-MFORK==400000
-
-MFUNCTION FSAVE,SUBR
-
-	ENTRY
-
-	JRST	SAVE1
-
-MFUNCTION SAVE,SUBR
-
-	ENTRY
-SAVE1:	PUSHJ	P,SQKIL
-IFE ITS,[
-	SKIPE	MULTSG
-	 PUSHJ	P,NOMULT
-]
-	PUSH	P,.
-	PUSH	P,[0]		; GC OR NOT?
-IFE ITS,[
-	MOVE	B,[400600,,]
-	MOVE	C,[440000,,100000]
-]
-	PUSHJ	P,GTFNM		; GET THE FILE NAME ONTO P
-	 JRST	.+2
-	JRST	SAVEON
-	JUMPGE	AB,TMA		; TOO MUCH STRING
-	GETYP	0,(AB)		; WHAT IS ARG
-	CAMGE	AB,[-3,,0]	; NOT TOO MANY
-	JRST	TMA
-	CAIN	0,TFALSE
-IFN ITS,	SETOM	-6(P)		; GC FLAG
-IFE ITS,	SETOM	(P)
-SAVEON:
-IFN ITS,[
-	MOVSI	A,7		; IMAGE BLOCK OUT
-	MOVEM	A,-4(P)		; DIRECTION
-	PUSH	P,A
-	PUSH	P,-4(P)		; DEVICE
-	PUSH	P,[SIXBIT /_MUDS_/]
-	PUSH	P,[SIXBIT />/]
-	PUSH	P,-4(P)		; SNAME
-	MOVEI	A,-4(P)		; POINT TO BLOCK
-	PUSHJ	P,MOPEN		; ATTEMPT TO OPEN
-	JRST	CANTOP
-	SUB	P,[5,,5]	; FLUSH OPEN BLOCK
-	PUSH	P,-6(P)		; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
-]
-	EXCH	A,(P)		; CHAN TO STACK GC TO A
-	JUMPL	A,NOGC
-	PUSH	TP,$TFIX		; CAUSE HAIRY GC TO OCCUR
-	PUSH	TP,[0]
-	PUSH	TP,$TATOM
-	PUSH	TP,IMQUOTE T
-	MCALL	2,GC
-NOGC:	PUSHJ	P,PURCLN
-
-; NOW GET VERSION OF MUDDLE FOR COMPARISON
-
-	MOVE	A,MUDSTR+2	; GET #
-	MOVEI	B,177		; CHANGE ALL RUBOUT CHARACTERS
-	MOVEI	C,40		; ----- TO SPACES
-	PUSHJ	P,HACKV
-
-	PUSHJ	P,WRDOUT
-	MOVE	A,P.TOP		; GET TOP OF CORD
-	PUSHJ	P,WRDOUT
-	MOVEI	A,0		; WRITE ZERO IF FAST
-IFN ITS,	SKIPE	-8(P)	; -6 --> -8 TAA
-IFE ITS,	SKIPE	-1(P)
-	PUSHJ	P,WRDOUT
-	MOVE	A,VECTOP	; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
-	PUSHJ	P,WRDOUT
-
-IFN ITS,[
-	SETZB	A,B		; FIRST, ALL INTS OFF
-	.SETM2	A,
-
-; IF FAST SAVE JUMP OFF HERE
-
-	SKIPE	-6(P)
-	JRST	FSAVE1
-
-]
-
-IFE ITS,[
-	MOVEI	A,400000	; FOR THIS PROCESS
-	DIR			; TURN OFF INT SYSTEM
-
-; IF FAST, LEAVE HERE
-
-	SKIPE	-1(P)
-	JRST	FSAVE1
-
-; NOW DUMP OUT GC SPACE
-
-]
-IFN ITS,[
-
-DMPDN2:	SETZB	A,B		; SET UP RENAME WHILE OPEN ETC.
-	MOVE	E,-1(P)
-	MOVE	D,-2(P)
-	LDB	C,[270400,,0]	; GET CHANNEL
-	.FDELE	A		; RENAME IT
-	FATAL SAVE RENAME FAILED
-	XOR	0,[<.IOT A>#<.CLOSE>]	; CHANGE TO A CLOSE
-	XCT	0
-
-	MOVE	A,MASK1		; TURN INTS BACK ON
-	MOVE	B,MASK2
-	.SETM2	A,
-]
-
-IFE ITS,[
-
-DMPDN2:	MOVE	A,0
-	CLOSF
-	FATAL CANT CLOSE SAVE FILE
-	CIS			; CLEAR IT SYSTEM
-	MOVEI	A,400000
-	EIR			; AND RE-ENABLE
-]
-
-SDONE:	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE SAVED
-	JRST	FINIS
-
-; SCAN FOR MANY OCCURENCES OF THE SAME THING
-
-
-; HERE TO WRITE OUT FAST SAVE FILE
-
-FSAVE1:
-IFN UNTAST,[
-	PUSHJ	P,PUCHK
-]
-	MOVE	A,PARTOP	; DONT WRITE OUT "HOLE"
-	ADDI	A,1777
-	ANDCMI	A,1777
-	MOVEI	E,(A)
-	PUSHJ	P,WRDOUT
-	MOVE	0,(P)		; CHANNEL TO 0
-IFN ITS,[
-	ASH	0,23.		; TO AC FIELS
-	IOR	0,[.IOT A]
-	MOVEI	A,5		; START AT WORD 5
-]
-IFE ITS,[
-	MOVE	A,[-<P-E>,,E]
-	PUSH	P,(A)
-	AOBJN	A,.-1
-	MOVE	A,0
-	MOVE	B,P		; WRITE OUT P FOR WIINAGE
-	BOUT
-	MOVE	B,[444400,,20]
-	MOVNI	C,20-6
-	SOUT			; MAKE PAGE BOUNDARIES WIN
-	MOVEI	A,20		; START AT 20
-]
-	MOVEI	B,(E)		; PARTOP TO B
-	PUSHJ	P,FOUT		; WRITE OUT UP TO PAIR TOP
-	PUSHJ	P,PUROUT
-	SUB	P,[1,,1]	; CLEAN OFF STACK
-	JRST	DMPDN2
-
-IFN ITS,[
-FOUT:	MOVEI	D,(A)		; SAVE START
-	SUB	A,B		; COMPUTE LH OF IOT PNTR
-	MOVSI	A,(A)
-	SKIPL	A		; IF + MEANS GROSS CORE SIZE
-	MOVSI	A,400000	; USE BIGGEST
-	HRRI	A,(D)
-	XCT	0		; ZAP, OUT IT GOES
-	CAMGE	A,B		; SKIP IF ALL WENT
-	JRST	FOUT		; DO THE REST
-	POPJ	P,		; GO CLOSE FILE
-]
-IFE ITS,[
-FOUT:	MOVEI	C,(A)
-	SUBI	C,(B)		; # OF BYTES TP C
-	MOVEI	B,(A)		; START TO B
-	HRLI	B,444400
-	MOVE	A,0
-	SOUT			; WRITE IT OUT
-	POPJ	P,
-]
-	
-
-; HERE TO ATTEMPT TO RESTORE A SAVED STATE
-
-MFUNCTION RESTORE,SUBR
-
-	ENTRY
-	PUSHJ	P,SQKIL
-IFE ITS,[
-	MOVE	B,[100600,,]
-	MOVE	C,[440000,,240000]
-]
-	PUSHJ	P,GTFNM
-	JRST	TMA
-IFN ITS,[
-	MOVSI	A,6		; READ/IMAGE/BLOCK
-	MOVEM	A,-4(P)
-	MOVEI	A,-4(P)
-	PUSHJ	P,MOPEN		; OPEN THE LOSER
-	JRST	FNF
-	SUB	P,[6,,6]	; REMOVE OPEN BLOCK
-
-	PUSH	P,A		; SAVE CHANNEL
-	PUSHJ	P,SGSNAM	; SAVE SNAME IN SYSTEM
-]
-IFE ITS,	PUSH	P,A		; SAVE JFN
-	PUSHJ	P,CKVRS		; CHECK THE VERSION NUMBER
-
-IFN ITS,	MCALL	0,IPCOFF	; CLOSE ALL IPC CHANS
-	PUSHJ	P,CLOSAL	; CLOSE CHANNELS
-IFN ITS,[
-	SETZB	A,B		; KILL ALL POSSIBLE INTERRUPTION
-	.SETM2	A,
-	DOTCAL	UNLOCK,[[1000,,-1]]
-	 .VALUE			; UNLOCK LOCKS
-]
-IFE ITS,[
-	MOVEI	A,400000	; DISABLE INTS
-	DIR			; INTS OFF
-
-; LOOP TO CLOSE ALL RANDOM JFNS
-
-	MOVE	E,[-JFNLNT,,JFNTBL]
-
-JFNLP:	HRRZ	A,@(E)
-	SKIPE	A
-	 CLOSF
-	  JFCL
-	HLRZ	A,@(E)
-	SKIPE	A
-	 CLOSF
-	  JFCL
-	SETZM	@(E)
-	AOBJN	E,JFNLP
-
-]
-	PUSHJ	P,PURCLN	; DONT KEEP PURE SHAREDNESS
-
-	POP	P,E
-IFE ITS,[
-	MOVEI	C,0
-	MOVNI	A,1
-	MOVE	B,[MFORK,,1]
-	MOVEI	D,THIBOT-1
-	PMAP
-	ADDI	B,1
-	SOJG	D,.-2
-	SKIPLE	A,SFRK		; IF WE HAVE AN INFERIOR, KILL IT
-	 KFORK
-]
-	MOVE	A,E
-FSTART:	MOVE	P,GCPDL
-	PUSH	P,A
-IFN ITS,[
-	MOVE	0,[1-PHIBOT,,1]
-	DOTCAL	CORBLK,[[FLS],[FME],0]
-	FATAL CANT FLUSH PURE PAGES
-]
-	PUSHJ	P,WRDIN		; GET P.TOP
-	ASH	A,-10.
-	MOVE	E,A
-	PUSHJ	P,WRDIN		; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
-	JUMPE	A,FASTR
-
-IFE ITS,[
-FASTR1:	MOVEI	A,P-1
-	MOVEI	B,P-1-E
-	POP	P,(A)
-	SUBI	A,1
-	SOJG	B,.-2
-]
-
-IFN ITS,[
-FASTR1:
-]
-IFN ITS,	MOVEM	E,NOTTY		; SAVE TTY FLAG
-IFE ITS,[
-	MOVEM	E,DEMFLG
-	PUSHJ	P,GETJS
-	HRRZS	IJFNS
-	SETZM	IJFNS1
-]
-	PUSHJ	P,PURCLN	; IN CASE RESTORED THING HAD PURE STUFF
-	PUSHJ	P,INTINT	; USE NEW INTRRRUPTS
-
-IFN ITS,[
-	.SUSET	[.RSNAM,,A]
-	PUSH	P,A
-]
-
-; NOW CYCLE THROUGH CHANNELS
-	MOVE	C,[-N.CHNS*2,,CHNL1]	; POINT TO REAL CHANNELS SLOTS
-	PUSH	TP,$TVEC
-	PUSH	TP,C
-	PUSH	P,[N.CHNS]
-
-CHNLP:	HRRE	A,(C)		; SEE IF NEW VALUE
-	JUMPL	A,NXTCHN
-	SKIPN	B,1(C)		; GET CHANNEL
-	JRST	NXTCHN
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLOS
-	MOVE	C,(TP)		; GET POINTER
-NXTCHN:	ADD	C,[2,,2]	; AND BUMP
-	MOVEM	C,(TP)
-	SOSE	(P)
-	JRST	CHNLP
-
-	SKIPN	C,CHNL0+1	; ANY PSUEDO CHANNELS
-	JRST	RDONE		; NO, JUST GO AWAY
-	MOVSI	A,TLIST		; YES, REOPEN THEM
-	MOVEM	A,(TP)-1
-CHNLP1:	MOVEM	C,(TP)		; SAVE POINTER
-	SKIPE	B,(C)+1		; GET CHANNEL
-	PUSHJ	P,REOPN
-	PUSHJ	P,CHNLO1
-	MOVE	C,(TP)		; GOBBLE POINTER
-	HRRZ	C,(C)		; REST LIST OF PSUEDO CHANNELS
-	JUMPN	C,CHNLP1
-
-RDONE:	MOVE	A,VECTOP
-	CAMN	A,P.TOP
-	JRST	NOCOR
-	SETZM	(A)
-	HRLS	A
-	ADDI	A,1		; SET UP BLT POINTER
-	MOVE	B,P.TOP
-	BLT	A,-1(B)		; TO THE TOP OF THE WORLD
-NOCOR:	SUB	TP,[2,,2]
-	SUB	P,[1,,1]
-	PUSHJ	P,TTYOPE
-IFN ITS,[
-	PUSHJ	P,IPCBLS	;BLESS ALL THE IPC CHANNELS
-	PUSHJ	P,SGSNAM	; GET SNAME
-	SKIPN	A
-	MOVE	A,(P)		; GET OLD SNAME
-	SUB	P,[1,,1]
-	PUSHJ	P,6TOCHS	; TO STRING
-]
-IFE ITS,[
-	PUSHJ	P,SGSNMQ	; SKIPS IF SNAME IS NON-NIL
-	 PUSHJ	P,%RSNAM	;  ELSE GETS "REAL" SNAME
-	PUSH	TP,A
-	PUSH	TP,B
-	MCALL	1,SNAME
-	SETOM	SFRK
-]
-	PUSHJ	P,%RUNAM
-	PUSHJ	P,%RJNAM
-	MOVE	A,$TCHSTR
-	MOVE	B,CHQUOTE RESTORED
-	JRST	FINIS
-
-IFE ITS,[
-;SKIPS IF THERE IS AN SNAME, RETURNING IT
-SGSNMQ:	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIE	0,TCHSTR
-	 JRST	CPOPJ
-	HRRZ	0,A
-	JUMPE	CPOPJ
-	JRST	CPOPJ1
-]
-
-FASTR:
-IFN ITS,[
-	PUSHJ	P,WRDIN
-	ADDI	A,1777
-	ANDCMI	A,1777		; ROUND AND TO PAGE BOUNDRY
-	ASH	A,-10.		; TO PAGES
-	MOVNS	A
-	MOVSI	A,(A)		; TO PAGE AOBJN
-	MOVE	C,A		; COPY OF POINTER
-	MOVE	0,NOTTY		; SAVE NOTTY FLAG AROUND
-	MOVE	D,(P)		; CHANNEL
-	DOTCAL	CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
-	FATAL	CORBLK ON RESTORE LOSSAGE
-	PUSHJ	P,PURIN		; GET PURIFIED STRUCTURE
-	MOVSI	A,(D)		; GET CHANNLEL BACK
-	ASH	A,5
-	MOVEI	B,E		; WHERE TO STRAT IN FILE
-	IOR	A,[.ACCESS B]
-	XCT	A		; ACCESS TO RIGHT ACS
-	XOR	A,[<.IOT B>#<.ACCESS B>]
-	MOVE	B,[D-P-1,,E]
-	XCT	A		; GET ACS
-	MOVE	E,0		; NO TTY FLAG BACK
-	XOR	A,[<.IOT B>#<.CLOSE>]
-	XCT	A
-	MOVE	A,GCSTOP	; GET CORE AND FOOL P.CORE
-	ADDI	A,1777
-	ANDCMI	A,1777
-	EXCH	A,P.TOP			; GET P.TOP
-	ASH	A,-10.		; TO PAGES
-	PUSHJ	P,P.CORE
-	PUSHJ	P,NOCORE
-	JRST	FASTR1
-]
-
-IFE ITS,[
-FASTR:	POP	P,A		; JFN TO A
-	BIN			; CORE TOP TO B
-	MOVE	E,B		; SAVE
-	BIN			; PARTOP
-	MOVE	D,B
-	BIN			; SAVED P
-	MOVE	P,B
-	MOVE	0,DEMFLG	; SAVE DEMFLG FLAG AROUND
-	HRL	E,C		; SAVE VECTOP
-	MOVSI	A,(A)		; JFN TO LH
-	MOVSI	B,400000	; FOR ME
-	MOVSI	C,120400	; FLAGS
-	ASH	D,-9.		; PAGES TO D
-	PMAP
-	ADDI	A,1
-	ADDI	B,1
-	SOJG	D,.-3
-
-	PUSHJ	P,PURIN
-
-	HLRZS	A
-	CLOSF
-	JFCL
-	MOVE	E,0		; DEMFLG TO E
-	JRST	FASTR1
-]
-
-; HERE TO GROCK FILE NAME FROM ARGS
-
-GTFNM:
-IFN ITS,[
-	PUSH	P,[0]		; DIRECTION
-	PUSH	TP,$TPDL
-	PUSH	TP,P
-	IRP A,,[DSK,MUDDLE,SAVE]
-	PUSH	P,[SIXBIT /A/]
-	TERMIN
-	PUSHJ	P,SGSNAM	; GET SNAME
-	PUSH	P,A		; SAVE SNAME
-	JUMPGE	AB,GTFNM1
-	PUSHJ	P,RGPRS		; PARSE THESE ARGS
-	JRST	.+2
-GTFNM1:	AOS	-5(P)		; SKIP RETURN
-	MOVE	A,(P)		; GET SNAME
-	.SUSET	[.SSNAM,,A]
-	MOVE	A,-5(P)		; GET RET ADDR
-	SUB	TP,[2,,2]
-	JRST	(A)
-
-; HERE TO OUTPUT 1 WORD
-
-WRDOUT:	PUSH	P,B
-	PUSH	P,A
-	HRROI	B,(P)		; POINT AT C(A)
-	MOVE	A,-3(P)		; CHANNEL
-	PUSHJ	P,MIOT		 ;WRITE IT
-POPJB:	POP	P,A
-	POP	P,B
-	POPJ	P,
-
-; HERE TO READ 1 WORD
-WRDIN==WRDOUT
-]
-IFE ITS,[
-	PUSH	P,C
-	PUSH	P,B
-	MOVE	B,IMQUOTE SNM
-	PUSHJ	P,IDVAL1
-	GETYP	0,A
-	CAIN	0,TUNBOU
-	 JRST	GTFNM0
-	TRNN	A,-1		;ANY LENGTH?
-	 PUSHJ	P,%RSNAM	;IF <SNAME> IS "", GET REAL ONE
-	PUSHJ	P,ADDNUL
-	 SKIPA
-GTFNM0:	MOVEI	B,0
-	PUSH	P,[377777,,377777]
-	PUSH	P,[-1,,[ASCIZ /DSK/]]
-	PUSH	P,B
-	PUSH	P,[-1,,[ASCIZ /MUDDLE/]]
-	PUSH	P,[-1,,[ASCIZ /SAVE/]]
-	PUSH	P,[0]
-	PUSH	P,[0]
-	PUSH	P,[77]		; USE AN OBSCURE JFN IF POSSIBLE
-	MOVE	A,(AB)
-	MOVE	B,1(AB)
-	PUSHJ	P,ADDNUL
-	MOVEI	A,-10(P)
-	GTJFN
-	JRST	FNF
-	SUB	P,[9.,,9.]
-	POP	P,B
-	OPENF
-	JRST	FNF
-	ADD	AB,[2,,2]
-	SKIPL	AB
-CPOPJ1:	AOS	(P)
-CPOPJ:	POPJ	P,
-
-WRDIN:	PUSH	P,B
-	MOVE	A,-2(P)		; JFN TO A
-	BIN
-	MOVE	A,B
-	POP	P,B
-	POPJ	P,
-
-WRDOUT:	PUSH	P,B
-	MOVE	B,-2(P)
-	EXCH	A,B
-	BOUT
-	EXCH	A,B
-	POP	P,B
-	POPJ	P,
-]
-
-
-;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
-HACKV:	PUSH	P,D
-	PUSH	P,E
-	MOVE	D,[440700,,A]
-	MOVEI	E,5
-HACKV1:	ILDB	0,D
-	CAIN	0,(B)		; MATCH ?
-	DPB	C,D		; YES, CLOBBER
-	SOJG	E,HACKV1
-	POP	P,E
-	POP	P,D
-	POPJ	P,
-
-
-CANTOP:	ERRUUO	EQUOTE CANT-OPEN-OUTPUT-FILE
-
-FNF:	ERRUUO	EQUOTE FILE-NOT-FOUND
-
-BADVRS:	ERRUUO	EQUOTE MUDDLE-VERSIONS-DIFFER
-
-
-CHNLO1:	MOVE	C,(TP)
-	SETZM	1(C)
-	JRST	CHNLO2
-
-CHNLOS:	MOVE	C,(TP)
-	MOVE	B,1(C)
-	SETZM	1(B)			; CLOBBER CHANNEL #
-	SETZM	1(C)
-CHNLO2:	MOVEI	B,[ASCIZ /
-CHANNEL-NOT-RESTORED
-/]
-	JRST	MSGTYP"
-
-IFN ITS,[
-NOCORE:	PUSH	P,A
-	PUSH	P,B
-	MOVEI	B,[ASCIZ /
-WAIT, CORE NOT YET HERE
-/]
-	PUSHJ	P,MSGTYP"
-	MOVE	A,-1(P)		; RESTORE BLOCKS NEEDED
-	MOVEI	B,1
-	.SLEEP	B,
-	PUSHJ	P,P.CORE
-	JRST	.-4
-	MOVEI	B,[ASCIZ /
-CORE ARRIVED
-/]
-	PUSHJ	P,MSGTYP
-	POP	P,B
-	POP	P,A
-	POPJ	P,
-]
-IFN UNTAST,[
-PUCHK:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PURCH1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JFCL
-	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURCH1
-	POPJ	P,
-]
-
-; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
-; INTO A SAVE FILE.
-
-PUROUT:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO PAGES
-PUROU2:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
-	JRST	INCPUT
-	PUSH	P,A		; SAVE A
-	ASH	A,10.		; TO WORDS
-	HRLI	A,-2000		; MAKE UP AOBJN PTR FOR IOT
-	MOVE	B,-2(P)		; RESTORE CHN #
-IFN ITS,[
-	DOTCAL	IOT,[B,A]
-	FATAL	SAVE--IOT FAILED
-]
-IFE ITS,[
-	PUSH	P,C		; SAVE C
-	MOVE	B,A		; SET UP BYTE POINTER
-	MOVE	A,0		; CHANNEL TO A
-	HRLI	B,444400	; SET UP BYTE POINTER
-	MOVNI	C,2000
-	SOUT			; OUT IT GOES
-	POP	P,C
-]
-
-	POP	P,A		; RESTORE PAGE #
-INCPUT:	ADDI	A,1		; INCREMENT PAGE COUNTER
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PUROU2
-	POPJ	P,
-
-
-IFN UNTAST,[
-
-CHKPGJ:	TDZA	0,0
-]
-CHKPGI:
-IFN UNTAST,[
-	MOVEI	0,1
-]
-	PUSH	P,A		; SAVE IT
-	IDIVI	A,16.		; FIND ENTRY IN PMAP TABLE
-	MOVE	C,PMAPB(A)	; GET WORD CONTAINING ENTRY
-	HRLZI	D,400000	; SET UP TEST WORD
-	IMULI	B,2
-	MOVNS	B
-	LSH	D,(B)		; GET TO CHECK PAIR
-	LSH	D,-1		; TO BIT INDICATING SAVE
-	TDON	C,D		; SKIP IF PAGE CONTAINS P.S
-	JRST	PUROU1
-	POP	P,A
-	AOS	(P)		; SKIP ITS A WINNER
-IFN UNTAST,[
-	JUMPN	0,.+4
-	LSH	D,1
-	TDNN	C,D
-	AOS	(P)
-]	POPJ	P,		; EXIT
-PUROU1:
-IFN UNTAST,[
-	JUMPE	0,CHKPG2
-IFN ITS,[
-	PUSH	P,A
-	DOTCAL	CORTYP,[A,[2000,,A],[2000,,0]]
-	FATAL DOTCAL FAILURE
-	SKIPN	A
-	MOVEI	0,0
-	POP	P,A
-	JUMPGE	0,CHKPG2
-]
-IFE ITS,[
-	PUSH	P,A
-	PUSH	P,B
-	LSH	A,1
-	HRLI	A,400000
-	RPACS
-	MOVE	0,B
-	POP	P,B
-	POP	P,A
-	TLC	0,150400
-	TRNE	0,150400
-	JRST	CHKPG2
-]
-	LSH	D,1
-	TDO	C,D
-	MOVEM	C,PMAPB(A)
-	AOS	-1(P)
-CHKPG2:]
-	POP	P,A
-	POPJ	P,
-
-
-; ROUTINE TO READ IN PURE STRUCTURE PAGES
-
-IFN ITS,[
-PURIN:	PUSH	P,D		; SAVE CHANNEL #
-	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
-	ASH	E,-10.		; TO PAGES
-	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
-	ASH	A,-10.		; TO WORDS
-PURIN1:
-IFN UNTAST,	PUSHJ	P,CHKPGJ	; SEE IF PURE PAGE EXISTS
-IFE UNTAST,	PUSHJ	P,CHKPGI	; SEE IF PURE PAGE EXISTS
-	JRST	NXPGPN
-IFN UNTAST,[
-	SKIPA	D,[200000]
-	MOVEI	D,[104000]
-	MOVSI	0,(D)
-]
-	PUSH	P,A		; SAVE A
-	MOVE	D,-1(P)		; RESTORE CHANNEL #
-	HRLI	A,-1		; SET UP AOBJN POINTER FOR DOTCAL
-IFN UNTAST,[
-	DOTCAL	CORBLK,[0,[1000,,-1],A,D]
-]
-IFE UNTAST,[
-	DOTCAL	CORBLK,[[1000,,200000],[1000,,-1],A,D]
-]
-	FATAL SAVE--CORBLK FAILED
-	POP	P,A		; RESTORE A
-NXPGPN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,D		; RESTORE CHANNEL
-	POPJ	P,
-]
-IFE ITS,[
-PURIN:	PUSH	P,A		; SAVE CHANNEL
-	MOVEI	E,HIBOT		; TOP OF SCAN
-	ASH	E,-10.
-	MOVE	A,PURBOT	; BOTTOM OF SCAN
-	ASH	A,-10.		; TO PAGES
-PURIN1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS NEEDED
-	JRST	NXTPGN
-	SKIPA	C,[120000]
-	MOVEI	C,120400
-	PUSH	P,A
-	MOVE	B,A		; COPY TO B
-	ASH	B,1		; FOR TEXEX PAGES
-	HRLI	B,MFORK		; SET UP ARGS TO PMAP
-	MOVSI	C,(C)
-	MOVE	A,-1(P)		; GET FILE POINTER
-	PMAP			; IN IT COMES
-	ADDI	B,1		; INCREMENT B
-	ADDI	A,1		; AND A
-	PMAP			; SECOND HALF OF ITS PAGE
-	ADDI	A,1
-	MOVEM	A,-1(P)		; SAVE FILE PAGE
-	POP	P,A
-NXTPGN:	ADDI	A,1
-	CAMG	A,E		; SKIP IF DONE
-	JRST	PURIN1
-	POP	P,A		; RESTOR CHANNEL
-	POPJ	P,		;EXIT
-]
-CKVRS:	PUSH	P,-1(P)
-	PUSHJ	P,WRDIN		; READ MUDDLE VERSION
-	MOVEI	B,40		; CHANGE ALL SPACES
-	MOVEI	C,177		; ----- TO RUBOUT CHARACTERS
-	PUSHJ	P,HACKV
-	CAME	A,MUDSTR+2	; AGREE ?
-	JRST	BADVRS
-	SUB	P,[1,,1]	; POP OFF CHANNEL #
-	POPJ	P,
-
-IFE ITS,[
-JFNTBL:	SETZ	IJFNS
-	SETZ	IJFNS1
-	SETZ	MAPJFN
-	SETZ	DIRCHN
-
-JFNLNT==.-JFNTBL
-]
-END
-
-

src/mudsys/specs.mid.110

@@ -1,345 +0,0 @@
-TITLE SPECS FOR MUDDLE
-
-RELOCA
-
-MAIN==1
-.GLOBAL TYPVLC,PBASE,TYPBOT,MAINPR,PTIME,IDPROC,ROOT,TTICHN,TTOCHN,TYPVEC
-.GLOBAL %UNAM,%JNAM,NOTTY,GCHAPN,INTHLD,PURBOT,PURTOP,N.CHNS,SPCCHK,CURFCN
-.GLOBAL TD.GET,TD.PUT,TD.LNT,NOSHUF,GLOTOP,RSTACK,RCYCHN,START,TVSTRT,REALTV
-.GLOBAL IJFNS,IJFNS1,SJFNS,OPSYS,HASHTB,MULTSG,PURBTB,NSEGS
-
-.INSRT MUDDLE >
-
-SYSQ
-
-CONSTANTS
-
-IFN ITS,[
-	N.CHNS==16.
-	FATINS==.VALUE
-]
-IFE ITS,[
-	N.CHNS==102
-]
-
-IMPURE
-
-LOC100:		JRST START
-IFN ITS,[
-%UNAM:		0		; HOLDS UNAME
-%JNAM:		0		; HOLDS JNAME
-OPSYS:		-1		; MINUS ONE (-1) IF ITS
-RLTSAV:		-1		; SAVED ARG TO REALTIMER
-]
-IFE ITS,[
-IJFNS:		0		; AGCS JFN,,MUDDLE'S JFN
-IJFNS1:		0		; SGCS JFN
-SJFNS:		0		; SQUOZE JFN,,SAVE JFN
-OPSYS:		0		; ZERO IF TOPS20, ONE IF TENEX
-MULTSG:		0		; NON-ZERO MEANS TRYING TO USE MULTI SEG STUFF
-NSEGS:		MAXSEG
-PURBTB:		REPEAT MAXSEG,HIBOT
-]
-IDPROC:		0		; ENVIRONMENT NUMBER GENERATOR
-PTIME:		0		; UNIQUE NUMBER FOR PROCID AND ENVIRONMENTS
-OBLNT":		13.		; LENGTH OF DEFAULT OBLISTS (SMALL)
-PARTOP":
-GCSTOP":
-VECTOP":	VECLOC		; TOP OF CURRENT GARBAGE COLLECTED SPACE
-GCSBOT":
-PARBOT":
-VECBOT":	PARBASE		; BOTTOM OF GARBAGE COLLECTED SPACE
-FRETOP":	120000
-CODBOT:		0		; ABSOLUTE BOTTOM OF CODE
-CODTOP":	PARBASE		; TOP OF IMPURE CODE (INCLUDING "STORAGE")
-HITOP:		0		; TOP OF INTERPRETER PURE CORE
-GCSNEW":
-PARNEW":
-VECNEW":	0		; LOCATION FOR OFFSET BETWWEN OLD GCSTOP AND NEW GCSTOP
-INTFLG:		0		; INTERRUPT PENDING FLAG
-MAINPR:		0		; HOLDS POINTER TO THE MAIN PROCESS
-NOTTY:		0		; NON-ZERO==> THIS MUDDLE HAS NO TTY
-GCHAPN:		0		; NON-ZERO A GC HAS HAPPENED RECENTLY
-INTHLD:		0		; NON-ZERO INTERRUPTS CANT HAPPEN
-PURBOT:		HIBOT		; BOTTOM OF DYNAMICALLY ALLOCATED PURE
-PURTOP:		HIBOT		; TOP OF DYNAMICALLY ALLOCATED PURE
-SPCCHK:		SETZ		; SPECIAL/UNSPECIAL CHECKING?
-NOSHUF:		0		; FLAG TO BUILD A NON MOVING HI SEG
-
-;PAGE MAP USAGE TABLE FOR MUDDLE
-;EACH PAGE IS REPRESENTED BY ONE BIT IN THE TABLE
-;IF BIT = 0 THEN PAGE IS FREE OTHERWISE BUSY
-;FOR PAGE n USE BIT (n MOD 32.) IN WORD PMAP+n/32.
-PMAPB":	525252,,525252	;SECTION 0 -- BELONGS TO AGC
-	525252,,525252
-	525252,,525252	;SECTION 1 -- BELONGS TO AGC
-	525252,,525252
-	525252,,525252	;SECTION 2 -- BELONGS TO AGC
-	525252,,525252
-	525252,,525252	;SECTION 3 -- BELONGS TO AGC
-	525252,,525252
-	525252,,525252	;SECTION 4 -- BELONGS TO AGC
-	525252,,525252
-	525252,,525252	;SECTION 5 -- BELONGS TO AGC (DEPENDS ON HIBOT)
-	525252,,525252
-	525252,,525252	;SECTION 6 -- START OF PURE CORE (FILLED IN BY INITM)
-	525252,,525252
-	525252,,525252	
-	525252,,525252
-
-NINT==72.	; NUMBER OF POSSIBLE ITS INTERRUPTS
-NASOCS==159.	; LENGTH OF ASSOCIATION VECTOR
-PDLBUF==100	; EXTRA INSURENCE PDL
-ASOLNT==10	; LENGTH OF ASSOCIATION BLOCKS
-
-
-.GLOBAL PATCH,TBINIT,LERR,LPROG,PIDSTO,PROCID,PTIME,GCPDL,INTFLG,WTYP1,WTYP2
-.GLOBAL PAT,PDLBUF,INTINT,PARNEW,GCPVP,START,SWAP,ICR,SPBASE,TPBASE,GLOBAS,GLOBSP,TPBAS
-.GLOBAL	GCSBOT,GCSTOP,FRETOP,GCSNEW,TD.AGC,SPSTOR,PVSTOR
-.GLOBAL TOPLEVEL,INTNUM,INTVEC,INTOBL,ASOVEC,ERROBL,MAINPR,RESFUN,.BLOCK,ASOLNT,NODES
-.GLOBAL WRONGT,TTYOPE,OPEN,CLOSE,IOT,ILVAL,MESS,FACTI,REFVEC,MUDOBL,INITIA
-.GLOBAL LSTRES,BINDID,DUMNOD,PSTAT,1STEPR,IDPROC,EVATYP,APLTYP,PRNTYP,PURVEC,STOLST
-
-TVSTRT==1400			; THIS SHOULD BE LARGE ENOUGH SO THAT WE HAVE ENOUGH
-				; ROOM FOR INITAL FREE STORAGE
-	
-
-VECTGO
-TVBASE":	BLOCK	TVLNT
-	GENERAL
-	TVLNT+2,,0
-TVLOC==TVBASE
-
-
-
-;INITIAL TYPE TABLE
-
-TYPVLC":
-	BLOCK	2*NUMPRI+2
-	GENERAL
-	2*NUMPRI+2+2,,0
-
-TYPTP==.-2			; POINT TO TOP OF TYPES
-
-; INITIAL SYMBOL TABEL FOR RSUBRS
-
-SQULOC==.
-SQUTBL:	BLOCK	2*NSUBRS
-	TWORD,,0
-	2*NSUBRS+2,,0
-
-INTVCL:	BLOCK	2*NINT
-	TLIST,,0
-	2*NINT+2,,0
-
-NODLST:	TTP,,0
-	0
-	TASOC,,0
-	BLOCK	ASOLNT-3
-	GENERAL+<SASOC,,0>
-	ASOLNT+2,,0
-
-NODDUM:	BLOCK	ASOLNT
-	GENERAL+<SASOC,,0>
-	ASOLNT+2,,0
-
-
-
-ASOVCL:	BLOCK	NASOCS
-	TASOC,,0
-	NASOCS+2,,0
-
-
-
-;THESE ENTRIES MUST NOT MOVE DURING INITILAIZATION
-
-ADDTV TVEC,[-2*NUMPRI-2,,TYPVLC]
-TYPVEC==TVOFF+TVSTRT-1
-
-ADDTV TVEC,[-2*NUMPRI-2,,TYPVLC]
-TYPBOT==TVOFF+TVSTRT-1			; POINT TO CURRENT TOP OF TYPE VECTORS
-
-;ENTRY FOR ROOT,TTICHN,TTOCHN
-
-ADDTV TCHAN,0
-TTICHN==TVOFF+TVSTRT-1
-
-ADDTV TCHAN,0
-TTOCHN==TVOFF+TVSTRT-1
-
-ADDTV TOBLS,0
-ROOT==TVOFF+TVSTRT-1
-ADDTV TOBLS,0
-INITIA==TVOFF+TVSTRT-1
-ADDTV TOBLS,0
-INTOBL==TVOFF+TVSTRT-1
-ADDTV TOBLS,0
-ERROBL==TVOFF+TVSTRT-1
-ADDTV TOBLS,0
-MUDOBL==TVOFF+TVSTRT-1
-ADDTV TVEC,0
-GRAPHS==TVOFF+TVSTRT-1
-ADDTV TFIX,0
-INTNUM==TVOFF+TVSTRT-1
-ADDTV TVEC,[-2*NINT,,INTVCL]
-INTVEC==TVOFF+TVSTRT-1
-ADDTV TUVEC,[-NASOCS,,ASOVCL]
-ASOVEC==TVOFF+TVSTRT-1
-ADDTV TSP,0
-SPSTOR==TVOFF+TVSTRT-1
-ADDTV TPVP,0
-PVSTOR==TVOFF+TVSTRT-1
-ADDTV TUVEC,0
-HASHTB==TVOFF+TVSTRT-1
-ADDTV TLIST,0
-CHNL0"==TVOFF+TVSTRT-1		;LIST FOR CURRENTLY OPEN PSUEDO CHANNELS
-
-
-IFN ITS,[
-DEFINE ADDCHN N
-	ADDTV TCHAN,0
-	CHNL!N==TVOFF+TVSTRT-1
-	.GLOBAL CHNL!N
-	TERMIN
-
-REPEAT 15.,ADDCHN \.RPCNT+1
-	
-DEFINE ADDIPC N
-	ADDTV TLIST,0
-	IPCS!N==TVOFF+TVSTRT-1
-	.GLOBAL	IPCS!N
-	TERMIN
-
-REPEAT 15.,ADDIPC \.RPCNT+1
-]
-
-IFE ITS,[
-ADDTV TCHAN,0
-CHNL1==TVOFF+TVSTRT-1
-.GLOBAL CHNL1
-REPEAT N.CHNS-1,[ADDTV TCHAN,0
-]
-]
-
-ADDTV TASOC,[-ASOLNT,,NODLST]
-NODES==TVOFF+TVSTRT-1
-
-ADDTV TASOC,[-ASOLNT,,NODDUM]
-DUMNOD==TVOFF+TVSTRT-1
-
-ADDTV TVEC,0
-EVATYP==TVOFF+TVSTRT-1
-
-ADDTV TVEC,0
-APLTYP==TVOFF+TVSTRT-1
-
-ADDTV TVEC,0
-PRNTYP==TVOFF+TVSTRT-1
-
-; SLOTS ASSOCIATED WITH TEMPLATE DATA STRUCTURES
-
-ADDTV TUVEC,0
-TD.GET==TVOFF+TVSTRT-1
-
-ADDTV TUVEC,0
-TD.PUT==TVOFF+TVSTRT-1
-
-ADDTV TUVEC,0
-TD.AGC==TVOFF+TVSTRT-1
-
-ADDTV TUVEC,0
-TD.LNT==TVOFF+TVSTRT-1
-
-ADDTV TUVEC,0
-TD.PTY==TVOFF+TVSTRT-1
-
-ADDTV TCHAN,0
-RCYCHN==TVOFF+TVSTRT-1
-
-
-;GLOBAL SPECIAL PDL
-
-GSP:	BLOCK	GSPLNT
-	GENERAL
-	GSPLNT+2,,0
-
-ADDTV TVEC,[-GSPLNT,,GSP]
-GLOBASE==TVOFF+TVSTRT-1
-GLOB==.-2
-ADDTV TVEC,GLOB
-GLOBSP==TVOFF+TVSTRT-1	;ENTRY FOR CURRENT POINTER TO GLOBAL SP
-
-; POINTER VECTOR TO PURE SHARED RSUBRS
-
-PURV:	BLOCK	3*20.		; ENOUGH FOR 20 SUCH (INITIALLY)
-	0
-	3*20.+2,,0
-
-ADDTV TUVEC,[-3*20.,,PURV]
-PURVEC==TVOFF+TVSTRT-1
-
-ADDTV TLIST,0
-STOLST==TVOFF+TVSTRT-1
-
-ADDTV TVEC,GLOB
-GLOTOP==TVOFF+TVSTRT-1
-
-;PROCESS VECTOR FOR GARBAGE COLLECTOR PROCESS
-
-GCPVP:	BLOCK	PVLNT*2
-	GENERAL
-	PVLNT*2+2,,0
-
-
-VECRET
-
-PURE
-
-;INITIAL PROCESS VECTOR
-
-PVBASE":	BLOCK	PVLNT*2
-	GENERAL
-	PVLNT*2+2,,0
-PVLOC==PVBASE
-
-
-;ENTRY FOR PROCESS I.D.
-
-	ADDPV	TFIX,1,PROCID
-;THE FOLLOWING IRP MAKES SPACE FO9 SAVED ACS
-
-ZZZ==.
-
-IRP A,,[0,A,B,C,D,E,PVP,TVP,FRM,AB,TB,TP,SP,M,R,P]B,,[0
-0,0,0,0,0,0,0,TTP,TAB,TTB,TTP,0,TCODE,TRSUBR,TPDL]
-
-LOC PVLOC+2*A
-A!STO==.-PVBASE
-B,,0
-0
-TERMIN
-
-PVLOC==PVLOC+16.*2
-LOC ZZZ
-
-
-ADDPV TTB,0,TBINIT
-ADDPV TTP,0,TPBASE
-ADDPV TSP,0,SPBASE
-ADDPV TPDL,0,PBASE
-ADDPV 0,0,RESFUN
-ADDPV TLIST,0,.BLOCK
-ADDPV TLIST,0,MESS
-ADDPV TACT,0,FACTI
-ADDPV TPVP,0,LSTRES
-ADDPV TFIX,0,BINDID
-ADDPV TFIX,1,PSTAT
-ADDPV TPVP,0,1STEPR
-ADDPV TSP,0,CURFCN
-ADDPV TTVP,0,REALTV
-
-
-
-IMPURE
-
-END

src/mudsys/tmudv.mid.1

@@ -1,50 +0,0 @@
-TITLE VCREATE MCR001 C. REEVE (CLR)
-
-RELOCA
-
-.INSRT MUDDLE >
-
-.GLOBAL VCREATE,MUDSTR
-
-DEBUG:	MOVE	E,[440600,,[SIXBIT /EXPERIMENTAL/]]
-	MOVEI	0,12.
-	JRST	STUFF
-
-VCREATE:	.SUSET	[.SSNAM,,[SIXBIT /MUDSYS/]]
-	.OPEN	0,OP%
-	.VALUE
-	MOVEI	0,0	; SET 0 TO DO THE .RCHST
-	.RCHST	0
-	.CLOSE	0
-	.FDELE	DB%
-	.VALUE
-	MOVE	E,[440600,,B]
-	MOVEI	0,6
-STUFF:	MOVE	D,[440700,,MUDSTR+2]
-STUFF1:	ILDB	A,E		; GET A CHAR
-	CAIN	A,0		;SUPRESS SPACES
-	MOVEI	A,137		;RUBOUT'S DON'T TYPE OUT
-	ADDI	A,40		; TO ASCII
-	IDPB	A,D		; STORE
-	SOJN	0,STUFF1
-	SETZM	34
-	SETZM	35
-	SETZM	36
-	.VALUE
-
-OP%:	1,,(SIXBIT /DSK/)
-	SIXBIT /TMUD%/
-	SIXBIT />/
-
-DB%:	(SIXBIT /DSK/)
-	SIXBIT /TMUD%/
-	SIXBIT /</
-	0
-	0
-
-CONSTANTS
-
-EDB:
-
-	END
-

src/mudsys/utilit.mid.103

@@ -1,829 +0,0 @@
-TITLE	UTILITY FUNCTIONS FOR MUDDLE
-
-RELOCATABLE
-
-.INSRT MUDDLE >
-
-SYSQ
-
-IFE ITS,[
-.INSRT STENEX >
-XJRST==JRST 5,
-]
-
-.GLOBAL GODUMP,IPURIF,EGCDUM,EPURIF,LODGC,KILGC,CALER,RBLDM,CPOPJ,C1POPJ,INQAGC,FRETOP
-.GLOBAL SAT,PGFIND,PGGIVE,PGTAKE,PINIT,ERRKIL,CKPUR,GCSET,MKTBS,PFLG,NPWRIT,GETNUM
-.GLOBAL AGC,AAGC,%CLSM1,%SHWND,IBLOCK,FINAGC,PGINT,CPOPJ1,REHASH,FRMUNG,MAXLEN,TOTCNT
-.GLOBAL NWORDT,NWORDS,MSGTYP,IMTYO,MULTSG,MULTI,NOMULT,GCDEBU
-.GLOBAL	PURCOR,INCORF,BADCHN,INTHLD,%MPIN1,WNDP,WIND,ACCESS,PURTOP,GCPDL,CTIME,P.CORE
-.GLOBAL IAGC,IAAGC,TYPVEC,PURBOT,PURTOP,MOVPUR,PURVEC,PMAPB,CURPLN,RFRETP,NOWFRE,FREMIN
-.GLOBAL MAXFRE,TPGROW,PDLBUF,CTPMX,PGROW,PDLBUF,CPMX,SAVM,NOWP,NOWTP,MPOPJ,GCFLG,GCDOWN
-.GLOBAL GCTIM,NOSHUF,P.TOP,GETPAG,ITEM,INDIC,ASOVEC,ASOLNT,GETBUF,KILBUF,PAT,PATEND
-.GLOBAL PATCH,DSTORE,PVSTOR,SPSTOR,SQKIL,IAMSGC,FNMSGC,RNUMSP,NUMSWP,SWAPGC,SAGC,GCSTOP
-.GLOBAL ISECGC
-.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
-.GLOBAL C%M20,C%M30,C%M40,C%M60
-
-FPAG==2000
-
-; GC-DUMP TAKES AN OBJECT AND MAPS IT INTO A FILE DIRECTLY USING THE GARBAGE
-; COLLECTOR.  ALL OBJECTS HAVE RELATIVIZED POINTERS AND WILL BE SET UP UPON
-; READIN (USING GC-READ).
-; IT TAKES TWO ARGUMENTS. THE FIRST IS THE OBJECT THE SECOND MUST BE A "PRINTB"
-; CHANNEL.
-
-MFUNCTION GCDUMP,SUBR,[GC-DUMP]
-
-	ENTRY
-
-IFE ITS,[
-	PUSH	P,MULTSG
-	SKIPE	MULTSG			; MUST RUN I 0 SEXTION MODE
-	 PUSHJ	P,NOMULT
-]
-	MOVE	PVP,PVSTOR+1
-	IRP	AC,,[FRM,P,R,M,TP,TB,AB]
-	MOVEM	AC,AC!STO"+1(PVP)
-	TERMIN
-
-	SETZM	PURCOR
-	SETZM	INCORF			; SET UP PARAMS
-	CAML	AB,C%M20		; CHECK ARGS
-	 JRST	TFA
-	CAMG	AB,C%M60
-	 JRST	TMA
-	GETYP	A,2(AB)			; SEE WHETHER THE CHANNEL IS A WINNER
-	CAIN	A,TFALSE		; SKIP IF NOT FALSE
-	 JRST	UVEARG
-	CAIE	A,TCHAN
-	 JRST	WTYP2			; ITS NOT A CHANNEL. COMPLAIN
-	MOVE	B,3(AB)			; CHECK BITS IN CHANNEL
-	HRRZ	C,-2(B)
-	TRC	C,C.PRIN+C.OPN+C.BIN
-	TRNE	C,C.PRIN+C.OPN+C.BIN
-	 JRST	BADCHN
-	PUSH	P,1(B)			; SAVE CHANNEL NUMBER
-	CAMGE	AB,C%M40		; SEE IF THIRD ARG WAS SNUCK IN
-	 JRST	TMA
-	JRST	IGCDUM
-
-UVEARG:	SETOM	INCORF			; SET UP FLAG INDICATING UVECTOR
-	CAML	AB,C%M40			; SEE IF THIRD ARG
-	 JRST	IGCDUM
-	GETYP	A,5(AB)
-	CAIE	A,TFALSE
-	 SETOM	PURCOR
-IGCDUM:	SETZM	SWAPGC
-	PUSHJ	P,LODGC				; GET THE GARBAGE COLLECTOR
-	SETOM	INTHLD
-	JRST	GODUMP
-
-EGCDUM:	PUSH	P,A				; SAVE LENGTH
-	PUSHJ	P,KILGC				; KILL THE GARBAGE COLLECTOR
-	POP	P,A
-	SETZM	INTHLD
-	SKIPN	INCORF				; SKIP IF TO UVECTOR
-	JRST	OUTFIL
-	SKIPN	PURCOR				; SKIP IF PURE UVECTOR
-	JRST	BLTGCD
-
-; ROUTINE TO CREATE A UVECTOR IN PURE STORAGE CONTAINING GC-DUMPED
-; OBJECTS.
-
-	ADDI	A,1777				; ROUND
-	ANDCMI	A,1777
-	ASH	A,-10.				; TO BLOCKS
-	PUSH	P,A				; SAVE IT
-TRAGN:	PUSHJ	P,PGFIND			; TRY TO GET PAGES
-	JUMPL	B,GCDPLS			; LOSSAGE?
-	POP	P,A				; GET # OF PAGES
-	PUSH	P,B				; SAVE B
-	MOVNS	A				; BUILD AOBJN POINTER
-	HRLZS	A
-	ADDI	A,FPAG/2000			; START
-	HLL	B,A				; SAME # OF PAGES
-	PUSHJ	P,%MPIN1
-	POP	P,B				; RESTORE # OF FIRST PAGE
-	ASH	B,10.				; TO ADDRESS
-	POP	P,A				; RESTORE LENGTH IN WORDS
-	MOVNI	A,-2(A)				; BUILD AOBJN
-	HRL	B,A
-	MOVE	A,$TUVEC			; TYPE WORD
-	JRST	DONDUM				; FINISH
-
-; HERE WHEN EFFORTS TO GE PURE STORAGE FAIL.
-
-GCDPLS:	MOVE	A,(P)				; GET # OF PAGES
-	ASH	A,10.				; TO WORDS
-	ADDI	A,1777
-	ANDCMI	A,1777				; ROUND AND TO PAGE
-	MOVEM	A,GCDOWN
-	MOVE	C,[13.,,9.]			; CAUSE INDICATOR
-	PUSHJ	P,AGC				; CAUSE AGC TO HAPPEN
-	MOVE	A,(P)				; GET # OF PAGES
-	JRST	TRAGN				; TRY AGAIN
-
-; HERE TO TRANSFER FROM INFERIOR TO THE FILE
-OUTFIL:	PUSH	P,A				; SAVE LENGTH OF FILE
-	PUSHJ	P,SETBUF
-	MOVE	A,(P)
-	ANDCMI	A,1777
-	ASH	A,-10.				; TO PAGES
-	MOVNS	A				; SET UP AOBJN POINTER
-	HRLZS	A
-	ADDI	A,1				; STARTS ON PAGE ONE
-	MOVE	C,-1(P)				; GET ITS CHANNEL #
-	MOVE	B,BUFP				; WINDOW PAGE
-	JUMPGE	A,DPGC5
-IFN ITS,[
-DPGC3:	MOVE	D,BUFL
-	HRLI	D,-2000				; SET UP BUFFER IOT POINTER
-	PUSHJ	P,%SHWND			; SHARE INF PAGE AND WINDOW
-	DOTCAL	IOT,[C,D]
-	FATAL GCDUMP-- IOT FAILED
-	AOBJN	A,DPGC3
-]
-IFE ITS,[
-DPGC3:	MOVE	B,BUFP
-	PUSHJ	P,%SHWND
-	PUSH	P,A				; SAVE A
-	PUSH	P,C				; SAVE C
-	MOVE	A,C				; CHANNEL INTO A
-	MOVE	B,BUFL				; SET UP BYTE POINTER
-	HRLI	B,444400
-	MOVNI	C,2000
-	SOUT					; OUT IT GOES
-	POP	P,C
-	POP	P,A				; RESTORE A
-	AOBJN	A,DPGC3
-]
-
-DPGC5:	MOVE	D,(P)				; CALCULATE AMOUNT LEFT TO SEND OUT
-	MOVE	0,D
-	ANDCMI	D,1777				; TO PAGE BOUNDRY
-	SUB	D,0				; SET UP AOBJN PTR FOR OUTPUT
-IFN ITS,[
-	HRLZS	D
-	ADD	D,BUFL
-	MOVE	B,BUFP				; SHARE WINDOW
-	PUSHJ	P,%SHWND
-	DOTCAL	IOT,[C,D]
-	FATAL	GCDUMP-- IOT FAILED
-]
-IFE ITS,[
-	MOVE	B,BUFP				; SET UP WINDOW
-	PUSHJ	P,%SHWND
-	MOVE	A,C				; CHANNEL TO A
-	MOVE	C,D
-	MOVE	B,BUFL				; SET UP BYTE POINTER
-	HRLI	B,444400
-	SOUT
-]	POP	P,D
-	MOVE	B,3(AB)				; GET CHANNEL
-	ADDM	D,ACCESS(B)
-
-	PUSHJ	P,KILBUF
-	MOVE	A,(AB)				; RETURN WHAT IS GIVEN
-	MOVE	B,1(AB)
-DONDUM:	PUSH	TP,A				; SAVE RETURNS
-	PUSH	TP,B
-	PUSHJ	P,%CLSM1
-	SUB	P,C%11
-IFE ITS,[
-	POP	P,MULTSG
-	SKIPE	MULTSG
-	 PUSHJ	P,MULTI
-]
-	POP	TP,B
-	POP	TP,A
-	JRST	FINIS
-
-
-; HERE TO BLT INTO A UVECTOR IN GCS
-
-BLTGCD:	PUSH	P,A				; SAVE # OF WORDS
-	PUSHJ	P,SETBUF
-	MOVE	A,(P)
-	PUSHJ	P,IBLOCK			; GET THE UVECTOR
-	PUSH	TP,A				; SAVE POINTER TO IT
-	PUSH	TP,B
-	MOVE	C,(P)				; GET # OF WORDS
-	ASH	C,-10.				; TO PAGES
-	PUSH	P,C				; SAVE C
-	MOVNS	C
-	HRLZS	C
-	ADDI	C,FPAG/2000
-	MOVE	B,BUFP				; WINDOW ACTS AS A BUFFER
-	HRRZ	D,(TP)				; GET PTR TO START OF UVECTOR
-	JUMPGE	C,DUNBLT			; IF < 1 BLOCK
-LOPBLT:	MOVEI	A,(C)				; GET A BLOCK
-	PUSHJ	P,%SHWND
-	MOVS	A,BUFL				; SET UP TO BLT INTO UVECTOR
-	HRRI	A,(D)
-	BLT	A,1777(D)			; IN COMES ONE BLOCK
-	ADDI	D,2000				; INCREMENT D
-	AOBJN	C,LOPBLT			; LOOP
-DUNBLT:	MOVEI	A,(C)				; SHARE LAST PAGE
-	PUSHJ	P,%SHWND
-	MOVS	A,BUFL				; SET UP BLT
-	HRRI	A,(D)
-	MOVE	C,-1(P)				; GET TOTAL # OF WORDS
-	MOVE	0,(P)
-	ASH	0,10.
-	SUB	C,0				; CALCULATE # LEFT TO GO
-	ADDI	D,-1(C)				; END OF UVECTOR
-	BLT	A,(D)
-	SUB	P,C%22			; CLEAN OFF STACK
-	PUSHJ	P,KILBUF
-	POP	TP,B
-	POP	TP,A
-	JRST	DONDUM				; DONE
-
-SETBUF:	MOVEI	A,1
-	PUSHJ	P,GETBUF
-	MOVEM	B,BUFL
-	ASH	B,-10.
-	MOVEM	B,BUFP
-	POPJ	P,
-
-
-; LITTLE ROUTINES USED ALL OVER THE PLACE
-
-MSGTYP: HRLI	B,440700	;MAKE BYTE POINTER
-MSGTY1:	ILDB	A,B		;GET NEXT CHARACTER
-	JUMPE	A,CPOPJ		;NULL ENDS STRING
-	CAIE	A,177		; DONT PRINT RUBOUTS
-	PUSHJ	P,IMTYO
-	JRST	MSGTY1		;AND GET NEXT CHARACTER
-CPOPJ:	POPJ	P,
-
-
-; ROUTINE TO PURIFY A STRUCTURE AND FREEZE ATOMS POINTED TO BY IT.
-; TAKES ONE ARGUMENT, THE ITEM TO PURIFY
-
-MFUNCTION PURIF,SUBR,[PURIFY]
-
-	ENTRY
-
-	JUMPGE	AB,TFA			; CHECK # OF ARGS
-
-IFE ITS,[
-	PUSH	P,MULTSG
-	SKIPE	MULTSG			; MUST RUN I 0 SEXTION MODE
-	 PUSHJ	P,NOMULT
-]
-	MOVE	C,AB
-	PUSH	P,C%0				; SLOT TO SEE IF WINNER
-PURMO1:	HRRZ	0,1(C)
-	CAML	0,PURTOP
-	JRST	PURMON				; CHECK FOR PURENESS
-	GETYP	A,(C)				; SEE IF ITS MONAD
-	PUSHJ	P,SAT
-	ANDI	A,SATMSK
-	CAIE	A,S1WORD
-	CAIN	A,SLOCR
-	JRST	PURMON
-	CAIN	A,SATOM
-	JRST	PURMON
-	SKIPE	1(C)				; SKIP IF EMPTY
-	SETOM	(P)
-PURMON:	ADD	C,C%22			; INC AND GO
-	JUMPL	C,PURMO1
-	POP	P,A				; GET MARKING
-	JUMPN	A,PURCON
-NPF:	MOVE	A,(AB)				; FINISH IF MONAD
-	MOVE	B,1(AB)
-IFE ITS,[
-	POP	P,MULTSG
-	SKIPE	MULTSG
-	 PUSHJ	P,MULTI
-]
-	JRST	FINIS
-
-PURCON:	SETZM	SWAPGC
-	PUSHJ	P,LODGC				; LOAD THE GARBAGE COLLECTOR
-	SETOM	INTHLD
-	SETOM	NPWRIT
-	JRST	IPURIF
-
-EPURIF:	PUSHJ	P,KILGC
-	SETZM	INTHLD
-	SETZM	NPWRIT
-IFE ITS,[
-	SKIPN	MULTSG
-	 JRST	NPF
-	POP	P,B
-	HRRI	B,NPF
-	MOVEI	A,0
-	XJRST	A
-]
-IFN ITS,[
-	JRST	NPF
-]
-
-
-
-; ROUTINE TO DO A SPECIAL GARBAGE COLLECT, CALLED FOR FREE STORAGE GARBAGE
-;	COLLECTS
-; AND CAN RUN A MARK/SWEEP GARBAGE COLLECT
-
-SAGC:
-IFE ITS,[
-	JRST	@[.+1]			; RETURN WITH US NOW TO THE THRILLING
-					; DAYS OF SEGMENT 0
-]
-	SOSL	NUMSWP			; GET NUMBER OF SWEEP GARBAGE COLLECTS
-	JRST	MSGC			; TRY MARK/SWEEP
-	MOVE	RNUMSP			; MOVE IN RNUMSWP
-	MOVEM	NUMSWP			; SMASH IT IN
-	JRST	GOGC
-MSGC:	SKIPN	PGROW			; CHECK FOR STACK OVERFLOW
-	SKIPE	TPGROW
-	JRST	AGC			; IF SO CAUSE REAL GARBAGE COLLECT
-	PUSH	P,C
-	PUSH	P,D
-	PUSH	P,E
-	SETOM	SWAPGC			; LOAD MARK SWEEP VERSION
-	PUSHJ	P,AGC1			; CAUSE GARBAGE COLLECT
-	HRRZ	0,MAXLEN		; SEE IF REQUEST SATISFIED
-	CAMGE	0,GETNUM
-	JRST	LOSE1
-	MOVE	C,FREMIN		; GET FREMIN
-	SUB	C,TOTCNT		; CALCULATE NEEDED
-	SUB	C,FRETOP
-	ADD	C,GCSTOP
-	JUMPL	C,DONE1
-	JSP	E,CKPUR			; GO CHECK FOR SOME STUFF
-	MOVE	D,PURBOT
-IFE ITS,	ANDCMI	D,1777		; MAKE LIKE AN ITS PAGE
-	SUB	D,CURPLN		; CALCULATE PURENESS
-	SUB	D,P.TOP
-	CAIG	D,(C)			; SEE IF PURENESS EXISTS
-	JRST	LOSE1
-	PUSH	P,A
-	ADD	C,GCSTOP
-	MOVEI	A,1777(C)
-	ASH	A,-10.
-	PUSHJ	P,P.CORE
-	FATAL	P.CORE FAILED
-	HRRZ	0,GCSTOP
-	SETZM	@0
-	HRLS	0
-	ADDI	0,1
-	HRRZ	A,FRETOP
-	BLT	0,-1(A)
-	POP	P,A
-DONE1:	POP	P,E
-	POP	P,D
-	POP	P,C
-IFN ITS,	POPJ	P,
-IFE ITS,[
-	SKIPN	MULTSG
-	 POPJ	P,
-	SETZM	20
-	POP	P,21			; BACK TO CALLING SEGMENT
-	XJRST	20	
-]
-LOSE1:	POP	P,E
-	POP	P,D
-	POP	P,C
-GOGC:	
-	
-
-AGC:
-IFE ITS,[
-	SKIPE	MULTSG
-	 SKIPE	GCDEBU
-	  JRST	@[SEC1]
-	XJRST	.+1
-		0
-		FSEG,,SEC1
-SEC1:
-]
-	 MOVE	0,RNUMSP
-	MOVEM	0,NUMSWP
-	SETZM	SWAPGC
-AGC1:	SKIPE	NPWRIT
-	JRST	IAGC
-	EXCH	P,GCPDL
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,SQKIL
-	PUSHJ	P,CTIME
-	MOVEM	B,GCTIM
-	PUSHJ	P,LODGC				; LOAD GC
-	PUSHJ	P,RSAC				; RESTORE ACS
-	EXCH	P,GCPDL
-	SKIPE	SWAPGC
-	JRST	IAMSGC
-	SKIPN	MULTSG
-	JRST	IAGC
-	JRST	ISECGC
-
-AAGC:	SETZM	SWAPGC
-	EXCH	P,GCPDL
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,LODGC				; LOAD GC
-	PUSHJ	P,RSAC				; RESTORE ACS
-	EXCH	P,GCPDL
-	JRST	IAAGC
-
-FNMSGC:
-FINAGC:	SKIPE	NPWRIT
-	JRST	FINAGG
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,KILGC
-	PUSHJ	P,RSAC
-FINAGG:
-IFN ITS,	POPJ	P,
-IFE ITS,[
-	SKIPN	MULTSG
-	 POPJ	P,
-	SETZM	20
-	POP	P,21			; BACK TO CALLING SEGMENT
-	XJRST	20	
-]
-
-; ROUTINE TO SAVE THE ACS
-
-SVAC:	EXCH	0,(P)
-	PUSH	P,A
-	PUSH	P,B
-	PUSH	P,C
-	PUSH	P,D
-	PUSH	P,E
-	JRST	@0
-
-; ROUTINE TO RESTORE THE ACS
-
-RSAC:	POP	P,0
-	POP	P,E
-	POP	P,D
-	POP	P,C
-	POP	P,B
-	POP	P,A
-	EXCH	0,(P)
-	POPJ	P,
-
-
-
-
-; INTERNAL FUNCTION TO GET STRAGE ALLOCATION TYPE
-; GETS THE TYPE CODE IN A AND RETURNS SAT IN A.
-
-SAT:	LSH	A,1				; TIMES 2 TO REF VECTOR
-	HRLS	A  				; TO BOTH HALVES TO HACK AOBJN
-						;	POINTER
-	ADD	A,TYPVEC+1			; ACCESS THE VECTOR
-	HRR	A,(A)				; GET PROBABLE SAT
-	JUMPL	A,.+2				; DID WE REALLY HAVE A VALID
-						;	TYPE
-	MOVEI	A,0				; NO RETURN 0
-	ANDI	A,SATMSK
-	POPJ	P,  				; AND RETURN
-
-; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
-; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B
-; RETURN -1 IN REG B IF NONE FOUND
-
-PGFIND:
-	JUMPLE	A,FPLOSS
-	CAILE	A,256.
-	JRST	FPLOSS
-
-	PUSHJ	P,PGFND1			; SEE IF ALREADY ENOUGH
-	SKIPN	NOSHUF				; CAN'T MOVE PURNESS
-	SKIPL	B				; SKIP IF LOST
-	POPJ	P,
-
-	SUBM	M,(P)
-	PUSH	P,E
-	PUSH	P,C
-	PUSH	P,D
-PGFLO4:	MOVE	C,PURBOT			; CHECK IF ROOM AT ALL
-						; 	(NOTE POTENTIAL FOR INFINITE LOOP)
-	SUB	C,P.TOP				; TOTAL SPACE
-	MOVEI	D,(C)				; COPY FOR CONVERSION TO PAGES
-	ASH	D,-10.
-	CAIGE	D,(A)				; SKIP IF COULD WIN
-	JRST	PGFLO1
-
-	MOVNS	A				; MOVE PURE AREA DOWN "A" PAGES
-	PUSHJ	P,MOVPUR
-	MOVE	B,PURTOP			; GET FIRST PAGE ALLOCATED
-	ASH	B,-10.				; TO PAGE #
-PGFLOS:	POP	P,D
-	POP	P,C
-	POP	P,E
-	PUSHJ	P,RBLDM				; GET A NEW VALUE FOR M
-	JRST	MPOPJ
-
-; HERE TO SHUFFLE PURE SPACE TO TRY TO FIND PAGES
-
-PGFLO1:	SKIPE	GCFLG				; SKIP IF NOT IN GC
-	JRST	PGFLO5				; WE LOST
-	MOVE	C,PURTOP
-	SUB	C,P.TOP
-	HRRZ	D,FSAV(TB)			; ARE WE IN A PURE RSUBR?
-	CAIL	D,HIBOT				; ARE WE AN RSUBR AT ALL?
-	JRST	PGFLO2
-	GETYP	E,(R)				; SEE IF PCODE
-	CAIE	E,TPCODE
-	JRST	PGFLO2
-	HLRZ	D,1(R)				; GET OFFSET TO PURVEC
-	ADD	D,PURVEC+1
-	HRROS	2(D)				; MUNG AGE
-	HLRE	D,1(D)				; GET LENGTH
-	ADD	C,D
-PGFLO2:	ASH	C,-10.
-	CAILE	A,(C)
-	JRST	PGFLO3
-	PUSH	P,A
-IFE ITS,	ASH	A,1			; TENEX PAGES ARE HALF SIZE
-	PUSHJ	P,GETPAG			; SHUFFLE THEM AROUND
-	FATAL	PURE SPACE LOSING
-	POP	P,A
-	JRST	PGFLO4
-
-; HERE TO CAUSE AGC IF PAGES ARE NOT AVAILABLE EVEN AFTER MAPPING OUT THE WORLD
-
-
-PGFLO3:	PUSH	P,A				; ASK GC FOR SPACE
-	ASH	A,10.
-	MOVEM	A,GCDOWN			; REQUEST THOSE PAGES
-	MOVE	C,[8.,,9.]
-	PUSHJ	P,AGC				; GO GARBAGE COLLECT
-	POP	P,A
-	JRST	PGFLO4				; GO BACK TO POTENTIAL LOOP
-
-	
-PGFLO5:	SETOM	B				; -1 TO B
-	JRST	PGFLOS				; INDICATE LOSSAGE
-
-PGFND1:	PUSH	P,E
-	PUSH	P,D
-	PUSH	P,C
-	PUSH	P,C%M1		; POSSIBLE CONTENTS FOR REG B
-	PUSH	P,A		; SAVE LENGTH OF BLOCK DESIRED FOR LATER USE
-	SETZB	B,C		; INITIAL SECTION AND PAGE NUMBERS
-	MOVEI	0,0		; COUNT OF PAGES ALREADY FOUND
-	PUSHJ	P,PINIT
-PLOOP:	TDNE	E,D		; FREE PAGE ?
-	JRST	NOTFRE		; NO
-	JUMPN	0,NFIRST	; FIRST FREE PAGE OF A BLOCK ?
-	MOVEI	A,(B)		; YES SAVE ADDRESS OF PAGE IN REG A
-	IMULI	A,16.
-	ASH	C,-1		; BACK TO PAGES
-	ADDI	A,(C)
-	ASH	C,1		; FIX IT TO WHAT IT WAS
-NFIRST:	ADDI	0,1
-	CAML	0,(P)		; TEST IF ENOUGH PAGES HAVE BEEN FOUND
-	JRST	PWIN		; YES, FINISHED
-	SKIPA	
-NOTFRE:	MOVEI	0,0		; RESET COUNT
-	PUSHJ	P,PNEXT	; NEXT PAGE
-	JRST	PLOSE		; NONE--LOSE RETURNING -1 IN REG B
-	JRST	PLOOP
-
-PWIN:	MOVEI	B,(A)		; GET WINNING ADDRESS
-	MOVEM	B,(P)-1		; RETURN ADDRESS OF WINNING PAGE
-	MOVE	A,(P)		; RELOAD LENGTH OF BLOCK OF PAGES
-	MOVE	0,[TDO E,D]	; INST TO SET "BUSY" BITS
-	JRST	ITAKE
-
-; CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
-; THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B
-PGGIVE:	MOVE	0,[TDZ E,D]	; INST TO SET "FREE" BITS
-	SKIPA
-PGTAKE:	MOVE	0,[TDO E,D]	; INST TO SET "BUSY" BITS
-	JUMPLE	A,FPLOSS
-	CAIL	B,0
-	CAILE	B,255.
-	JRST	FPLOSS
-	PUSH	P,E
-	PUSH	P,D
-	PUSH	P,C
-	PUSH	P,B
-	PUSH	P,A
-ITAKE:	IDIVI	B,16.
-	PUSHJ	P,PINIT
-	SUBI	A,1
-RTL:	XCT	0		; SET APPROPRIATE BIT
-	PUSHJ	P,PNEXT	; NEXT PAGE'S BIT
-	JUMPG	A,FPLOSS	; TOO MANY ?
-	SOJGE	A,RTL
-	MOVEM	E,PMAPB(B)	; REPLACE BIT MASK
-PLOSE:	POP	P,A
-	POP	P,B
-	POP	P,C
-	POP	P,D
-	POP	P,E
-	POPJ	P,
-
-
-PINIT:	MOVE	E,PMAPB(B)	; GET BITS FOR THIS SECTION
-	HRLZI	D,400000	; BIT MASK
-	IMULI	C,2
-	MOVNS	C
-	LSH	D,(C)		; SHIFT TO APPROPRIATE BIT POSITION
-	MOVNS	C
-	POPJ	P,
-
-PNEXT:	AOS	(P)		; FOR SKIP RETURN ON EXPECTED SUCCESS
-	LSH	D,-2		; CONSIDER NEXT PAGE
-	CAIL	C,30.		; FINISHED WITH THIS SECTION ?
-	JRST	PNEXT1
-	AOS	C
-	AOJA	C,CPOPJ		; NO, INCREMENT AND CONTINUE
-PNEXT1:	MOVEM	E,PMAPB(B)	; REPLACE BIT MASK
-	SETZ	C,
-	CAIGE	B,15.		; LAST SECTION ?
-	AOJA	B,PINIT		; NO, INCREMENT AND CONTINUE
-	SOS	(P)		; YES, UNDO SKIP RETURN
-	POPJ	P,
-
-FPLOSS:	FATAL PAGE LOSSAGE
-
-PGINT:	MOVEI	B,HIBOT		; INITIALIZE MUDDLE'S PAGE MAP TABLE
-	IDIVI	B,2000		; FIRST PAGE OF PURE CODE
-	MOVE	C,HITOP
-	IDIVI	C,2000
-	MOVEI	A,(C)+1
-	SUBI	A,(B)		; NUMBER OF SUCH PAGES
-	PUSHJ	P,PGTAKE	; MARK THESE PAGES AS TAKEN
-	POPJ	P,
-
-
-
-
-ERRKIL:	PUSH	P,A
-	PUSHJ	P,KILGC		; KILL THE GARBAGE COLLECTOR
-	POP	P,A
-	JRST	CALER
-
-; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU
-
-CKPUR:	HRRZ	A,FSAV(TB)	; GET NAME OF CURRENT GOODIE
-	SETZM	CURPLN		; CLEAR FOR NONE
-	CAIL	A,HIBOT		; IF LESS THAN TOP OF PURE ASSUME RSUBR
-	JRST	(E)
-	GETYP	0,(A)		; SEE IF PURE
-	CAIE	0,TPCODE	; SKIP IF IT IS
-	JRST	NPRSUB
-NRSB2:	HLRZ	B,1(A)		; GET SLOT INDICATION
-	ADD	B,PURVEC+1	; POINT TO SLOT
-	HRROS	2(B)		; MUNG AGE
-	HLRE	A,1(B)		; - LENGTH TO A
-	TRZ	A,777
-	MOVNM	A,CURPLN	; AND STORE
-	JRST	(E)
-NPRSUB:	SKIPGE	B,1(R)		; SEE IF PURE RSUBR
-	JRST	(E)
-	MOVE	A,R
-	JRST	NRSB2
-	
-; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE
-; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY
-; THEIR MUDDLE.
-
-GCSET:	MOVE	A,RFRETP	; COMPUTE FREE SPACE AVAILABLE
-	SUB	A,PARTOP
-	MOVEM	A,NOWFRE
-	CAMLE	A,MAXFRE
-	MOVEM	A,MAXFRE	; MODIFY MAXIMUM
-	HLRE	A,TP		; FIND THE DOPE WORD OF THE TP STACK
-	MOVNS	A
-	ADDI	A,1(TP)		; CLOSE TO DOPE WORD
-	CAME	A,TPGROW
-	ADDI	A,PDLBUF	; NOW AT REAL DOPE WORD
-	HLRZ	B,(A)		; GET LENGTH OF TP-STACK
-	MOVEM	B,NOWTP
-	CAMLE	B,CTPMX		; SEE IF THIS IS THE BIGGEST TP
-	MOVEM	B,CTPMX
-	HLRE	B,P		; FIND DOPE WORD OF P-STACK
-	MOVNS	B
-	ADDI	B,1(P)		; CLOSE TO IT
-	CAME	B,PGROW		; SEE IF THE STACK IS BLOWN
-	ADDI	B,PDLBUF	; POINTING TO IT
-	HLRZ	A,(B)		; GET IN LENGTH
-	MOVEM	A,NOWP
-	CAMLE	A,CPMX		; SEE IF WE HAVE THE BIGGEST P STACK
-	MOVEM	A,CPMX
-	POPJ	P,		; EXIT
-
-RBLDM:	JUMPGE	R,CPOPJ
-	SKIPGE	M,1(R)		; SKIP IF FUNNY
-	JRST	RBLDM1
-
-	HLRS	M
-	ADD	M,PURVEC+1
-	HLLM	TB,2(M)
-	SKIPL	M,1(M)
-	JRST	RBLDM1
-	PUSH	P,0
-	HRRZ	0,1(R)
-	ADD	M,0
-	POP	P,0
-RBLDM1:	SKIPN	SAVM		; SKIP IF FUNNY (M)
-	POPJ	P,		; EXIT
-	MOVEM	M,SAVM
-	MOVEI	M,0
-	POPJ	P,
-CPOPJ1:
-C1POPJ:	AOS	(P)
-	POPJ	P,
-
-
-
-; THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE
-FRMUNG:	MOVEM	D,PSAV(A)
-	MOVE	SP,SPSTOR+1
-	MOVEM	SP,SPSAV(A)
-	MOVEM	TP,TPSAV(A)	; SAVE FOR MARKING
-	POPJ	P,
-
-
-; SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
-
-REHASH:	MOVE	D,ASOVEC+1	; GET POINTER TO VECTOR
-	MOVEI	E,(D)
-	PUSH	P,E		; PUSH A POINTER
-	HLRE	A,D		; GET -LENGTH
-	MOVMS	A		; AND PLUSIFY
-	PUSH	P,A		; PUSH IT ALSO
-
-REH3:	HRRZ	C,(D)		; POINT TO FIRST BUCKKET
-	HLRZS	(D)		; MAKE SURE NEW POINTER IS IN RH
-	JUMPLE	C,REH1		; BUCKET EMPTY, QUIT
-
-REH2:	MOVEI	E,(C)		; MAKE A COPY OF THE POINTER
-	MOVE	A,ITEM(C)	; START HASHING
-	TLZ	A,TYPMSK#777777	; KILL MONITORS
-	XOR	A,ITEM+1(C)
-	MOVE	0,INDIC(C)
-	TLZ	0,TYPMSK#777777
-	XOR	A,0
-	XOR	A,INDIC+1(C)
-	TLZ	A,400000	; MAKE SURE FINAL HASH IS +
-	IDIV	A,(P)		; DIVIDE BY TOTAL LENGTH
-	ADD	B,-1(P)		; POINT TO WINNING BUCKET
-
-	MOVE	C,[002200,,(B)]	; BYTE POINTER TO RH
-	CAILE	B,(D)		; IF PAST CURRENT POINT
-	MOVE	C,[222200,,(B)]	; USE LH
-	LDB	A,C		; GET OLD VALUE
-	DPB	E,C		; STORE NEW VALUE
-	HRRZ	B,ASOLNT-1(E)	; GET NEXT POINTER
-	HRRZM	A,ASOLNT-1(E)	; AND CLOBBER IN NEW NEXT
-	SKIPE	A		; SKKIP IF NOTHING PREVIOUSLY IN BUCKET
-	HRLM	E,ASOLNT-1(A)	; OTHERWISE CLOBBER
-	SKIPE	C,B		; SKIP IF END OF CHAIN
-	JRST	REH2
-REH1:	AOBJN	D,REH3
-
-	SUB	P,C%22	; FLUSH THE JUNK
-	POPJ	P,
-
-;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
-
-NWORDT:	PUSHJ	P,SAT		;GET STORAGE ALLOC TYPE
-NWORDS:	CAIG	A,NUMSAT	; TEMPLATE?
-	SKIPL	MKTBS(A)	;-ENTRY IN TABLE MEANS 2 NEEDED
-	SKIPA	A,C%1		;NEED ONLY 1
-	MOVEI	A,2		;NEED 2
-	POPJ	P,
-
-.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
-.GLOBAL LOCMK,BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,OFFSMK
-
-; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
-
-DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
-[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
-[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
-[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
-[SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]
-[SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
-
-IMPURE
-
-DSTORE:	0			; USED FOR MAPFS AND SEGMENTS
-BUFL:	0			; BUFFER PAGE (WORDS)
-BUFP:	0			; BUFFER PAGE (PAGES)
-NPWRIT:	0			; INDICATION OF PURIFY
-RNUMSP:	0			; NUMBER OF MARK/SWEEP GARBAGE
-				; COLLECTS TO REAL GARBAGE COLLECT
-NUMSWP:	0			; NUMBER MARK SWEEP GARBAGE COLLECTS TO GO
-SWAPGC:	0			; FLAG INDICATING WHETHER TO LOAD SWAP
-				;	GC OR NOT
-TOTCNT:	0			; TOTAL COUNT
-
-PURE
-
-PAT:
-PATCH:
-
-BLOCK 400
-PATEND:
-
-END
-

src/mudsys/utilit.mid.104

@@ -1,830 +0,0 @@
-TITLE	UTILITY FUNCTIONS FOR MUDDLE
-
-RELOCATABLE
-
-.INSRT MUDDLE >
-
-SYSQ
-
-IFE ITS,[
-.INSRT STENEX >
-XJRST==JRST 5,
-]
-
-.GLOBAL GODUMP,IPURIF,EGCDUM,EPURIF,LODGC,KILGC,CALER,RBLDM,CPOPJ,C1POPJ,INQAGC,FRETOP
-.GLOBAL SAT,PGFIND,PGGIVE,PGTAKE,PINIT,ERRKIL,CKPUR,GCSET,MKTBS,PFLG,NPWRIT,GETNUM
-.GLOBAL AGC,AAGC,%CLSM1,%SHWND,IBLOCK,FINAGC,PGINT,CPOPJ1,REHASH,FRMUNG,MAXLEN,TOTCNT
-.GLOBAL NWORDT,NWORDS,MSGTYP,IMTYO,MULTSG,MULTI,NOMULT,GCDEBU
-.GLOBAL	PURCOR,INCORF,BADCHN,INTHLD,%MPIN1,WNDP,WIND,ACCESS,PURTOP,GCPDL,CTIME,P.CORE
-.GLOBAL IAGC,IAAGC,TYPVEC,PURBOT,PURTOP,MOVPUR,PURVEC,PMAPB,CURPLN,RFRETP,NOWFRE,FREMIN
-.GLOBAL MAXFRE,TPGROW,PDLBUF,CTPMX,PGROW,PDLBUF,CPMX,SAVM,NOWP,NOWTP,MPOPJ,GCFLG,GCDOWN
-.GLOBAL GCTIM,NOSHUF,P.TOP,GETPAG,ITEM,INDIC,ASOVEC,ASOLNT,GETBUF,KILBUF,PAT,PATEND
-.GLOBAL PATCH,DSTORE,PVSTOR,SPSTOR,SQKIL,IAMSGC,FNMSGC,RNUMSP,NUMSWP,SWAPGC,SAGC,GCSTOP
-.GLOBAL ISECGC
-.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
-.GLOBAL C%M20,C%M30,C%M40,C%M60
-
-FPAG==2000
-
-; GC-DUMP TAKES AN OBJECT AND MAPS IT INTO A FILE DIRECTLY USING THE GARBAGE
-; COLLECTOR.  ALL OBJECTS HAVE RELATIVIZED POINTERS AND WILL BE SET UP UPON
-; READIN (USING GC-READ).
-; IT TAKES TWO ARGUMENTS. THE FIRST IS THE OBJECT THE SECOND MUST BE A "PRINTB"
-; CHANNEL.
-
-MFUNCTION GCDUMP,SUBR,[GC-DUMP]
-
-	ENTRY
-
-IFE ITS,[
-	PUSH	P,MULTSG
-	SKIPE	MULTSG			; MUST RUN I 0 SEXTION MODE
-	 PUSHJ	P,NOMULT
-]
-	MOVE	PVP,PVSTOR+1
-	IRP	AC,,[FRM,P,R,M,TP,TB,AB]
-	MOVEM	AC,AC!STO"+1(PVP)
-	TERMIN
-
-	SETZM	PURCOR
-	SETZM	INCORF			; SET UP PARAMS
-	CAML	AB,C%M20		; CHECK ARGS
-	 JRST	TFA
-	CAMG	AB,C%M60
-	 JRST	TMA
-	GETYP	A,2(AB)			; SEE WHETHER THE CHANNEL IS A WINNER
-	CAIN	A,TFALSE		; SKIP IF NOT FALSE
-	 JRST	UVEARG
-	CAIE	A,TCHAN
-	 JRST	WTYP2			; ITS NOT A CHANNEL. COMPLAIN
-	MOVE	B,3(AB)			; CHECK BITS IN CHANNEL
-	HRRZ	C,-2(B)
-	TRC	C,C.PRIN+C.OPN+C.BIN
-	TRNE	C,C.PRIN+C.OPN+C.BIN
-	 JRST	BADCHN
-	PUSH	P,1(B)			; SAVE CHANNEL NUMBER
-	CAMGE	AB,C%M40		; SEE IF THIRD ARG WAS SNUCK IN
-	 JRST	TMA
-	JRST	IGCDUM
-
-UVEARG:	SETOM	INCORF			; SET UP FLAG INDICATING UVECTOR
-	CAML	AB,C%M40			; SEE IF THIRD ARG
-	 JRST	IGCDUM
-	GETYP	A,5(AB)
-	CAIE	A,TFALSE
-	 SETOM	PURCOR
-IGCDUM:	SETZM	SWAPGC
-	PUSHJ	P,LODGC				; GET THE GARBAGE COLLECTOR
-	SETOM	INTHLD
-	JRST	GODUMP
-
-EGCDUM:	PUSH	P,A				; SAVE LENGTH
-	PUSHJ	P,KILGC				; KILL THE GARBAGE COLLECTOR
-	POP	P,A
-	SETZM	INTHLD
-	SKIPN	INCORF				; SKIP IF TO UVECTOR
-	JRST	OUTFIL
-	SKIPN	PURCOR				; SKIP IF PURE UVECTOR
-	JRST	BLTGCD
-
-; ROUTINE TO CREATE A UVECTOR IN PURE STORAGE CONTAINING GC-DUMPED
-; OBJECTS.
-
-	ADDI	A,1777				; ROUND
-	ANDCMI	A,1777
-	ASH	A,-10.				; TO BLOCKS
-	PUSH	P,A				; SAVE IT
-TRAGN:	PUSHJ	P,PGFIND			; TRY TO GET PAGES
-	JUMPL	B,GCDPLS			; LOSSAGE?
-	POP	P,A				; GET # OF PAGES
-	PUSH	P,B				; SAVE B
-	MOVNS	A				; BUILD AOBJN POINTER
-	HRLZS	A
-	ADDI	A,FPAG/2000			; START
-	HLL	B,A				; SAME # OF PAGES
-	PUSHJ	P,%MPIN1
-	POP	P,B				; RESTORE # OF FIRST PAGE
-	ASH	B,10.				; TO ADDRESS
-	POP	P,A				; RESTORE LENGTH IN WORDS
-	MOVNI	A,-2(A)				; BUILD AOBJN
-	HRL	B,A
-	MOVE	A,$TUVEC			; TYPE WORD
-	JRST	DONDUM				; FINISH
-
-; HERE WHEN EFFORTS TO GE PURE STORAGE FAIL.
-
-GCDPLS:	MOVE	A,(P)				; GET # OF PAGES
-	ASH	A,10.				; TO WORDS
-	ADDI	A,1777
-	ANDCMI	A,1777				; ROUND AND TO PAGE
-	MOVEM	A,GCDOWN
-	MOVE	C,[13.,,9.]			; CAUSE INDICATOR
-	PUSHJ	P,AGC				; CAUSE AGC TO HAPPEN
-	MOVE	A,(P)				; GET # OF PAGES
-	JRST	TRAGN				; TRY AGAIN
-
-; HERE TO TRANSFER FROM INFERIOR TO THE FILE
-OUTFIL:	PUSH	P,A				; SAVE LENGTH OF FILE
-	PUSHJ	P,SETBUF
-	MOVE	A,(P)
-	ANDCMI	A,1777
-	ASH	A,-10.				; TO PAGES
-	MOVNS	A				; SET UP AOBJN POINTER
-	HRLZS	A
-	ADDI	A,1				; STARTS ON PAGE ONE
-	MOVE	C,-1(P)				; GET ITS CHANNEL #
-	MOVE	B,BUFP				; WINDOW PAGE
-	JUMPGE	A,DPGC5
-IFN ITS,[
-DPGC3:	MOVE	D,BUFL
-	HRLI	D,-2000				; SET UP BUFFER IOT POINTER
-	PUSHJ	P,%SHWND			; SHARE INF PAGE AND WINDOW
-	DOTCAL	IOT,[C,D]
-	FATAL GCDUMP-- IOT FAILED
-	AOBJN	A,DPGC3
-]
-IFE ITS,[
-DPGC3:	MOVE	B,BUFP
-	PUSHJ	P,%SHWND
-	PUSH	P,A				; SAVE A
-	PUSH	P,C				; SAVE C
-	MOVE	A,C				; CHANNEL INTO A
-	MOVE	B,BUFL				; SET UP BYTE POINTER
-	HRLI	B,444400
-	MOVNI	C,2000
-	SOUT					; OUT IT GOES
-	POP	P,C
-	POP	P,A				; RESTORE A
-	AOBJN	A,DPGC3
-]
-
-DPGC5:	MOVE	D,(P)				; CALCULATE AMOUNT LEFT TO SEND OUT
-	MOVE	0,D
-	ANDCMI	D,1777				; TO PAGE BOUNDRY
-	SUB	D,0				; SET UP AOBJN PTR FOR OUTPUT
-IFN ITS,[
-	HRLZS	D
-	ADD	D,BUFL
-	MOVE	B,BUFP				; SHARE WINDOW
-	PUSHJ	P,%SHWND
-	DOTCAL	IOT,[C,D]
-	FATAL	GCDUMP-- IOT FAILED
-]
-IFE ITS,[
-	MOVE	B,BUFP				; SET UP WINDOW
-	PUSHJ	P,%SHWND
-	MOVE	A,C				; CHANNEL TO A
-	MOVE	C,D
-	MOVE	B,BUFL				; SET UP BYTE POINTER
-	HRLI	B,444400
-	SOUT
-]	POP	P,D
-	MOVE	B,3(AB)				; GET CHANNEL
-	ADDM	D,ACCESS(B)
-
-	PUSHJ	P,KILBUF
-	MOVE	A,(AB)				; RETURN WHAT IS GIVEN
-	MOVE	B,1(AB)
-DONDUM:	PUSH	TP,A				; SAVE RETURNS
-	PUSH	TP,B
-	PUSHJ	P,%CLSM1
-	SUB	P,C%11
-IFE ITS,[
-	POP	P,MULTSG
-	SKIPE	MULTSG
-	 PUSHJ	P,MULTI
-]
-	POP	TP,B
-	POP	TP,A
-	JRST	FINIS
-
-
-; HERE TO BLT INTO A UVECTOR IN GCS
-
-BLTGCD:	PUSH	P,A				; SAVE # OF WORDS
-	PUSHJ	P,SETBUF
-	MOVE	A,(P)
-	PUSHJ	P,IBLOCK			; GET THE UVECTOR
-	PUSH	TP,A				; SAVE POINTER TO IT
-	PUSH	TP,B
-	MOVE	C,(P)				; GET # OF WORDS
-	ASH	C,-10.				; TO PAGES
-	PUSH	P,C				; SAVE C
-	MOVNS	C
-	HRLZS	C
-	ADDI	C,FPAG/2000
-	MOVE	B,BUFP				; WINDOW ACTS AS A BUFFER
-	HRRZ	D,(TP)				; GET PTR TO START OF UVECTOR
-	JUMPGE	C,DUNBLT			; IF < 1 BLOCK
-LOPBLT:	MOVEI	A,(C)				; GET A BLOCK
-	PUSHJ	P,%SHWND
-	MOVS	A,BUFL				; SET UP TO BLT INTO UVECTOR
-	HRRI	A,(D)
-	BLT	A,1777(D)			; IN COMES ONE BLOCK
-	ADDI	D,2000				; INCREMENT D
-	AOBJN	C,LOPBLT			; LOOP
-DUNBLT:	MOVEI	A,(C)				; SHARE LAST PAGE
-	PUSHJ	P,%SHWND
-	MOVS	A,BUFL				; SET UP BLT
-	HRRI	A,(D)
-	MOVE	C,-1(P)				; GET TOTAL # OF WORDS
-	MOVE	0,(P)
-	ASH	0,10.
-	SUB	C,0				; CALCULATE # LEFT TO GO
-	ADDI	D,-1(C)				; END OF UVECTOR
-	BLT	A,(D)
-	SUB	P,C%22			; CLEAN OFF STACK
-	PUSHJ	P,KILBUF
-	POP	TP,B
-	POP	TP,A
-	JRST	DONDUM				; DONE
-
-SETBUF:	MOVEI	A,1
-	PUSHJ	P,GETBUF
-	MOVEM	B,BUFL
-	ASH	B,-10.
-	MOVEM	B,BUFP
-	POPJ	P,
-
-
-; LITTLE ROUTINES USED ALL OVER THE PLACE
-
-MSGTYP: HRLI	B,440700	;MAKE BYTE POINTER
-MSGTY1:	ILDB	A,B		;GET NEXT CHARACTER
-	JUMPE	A,CPOPJ		;NULL ENDS STRING
-	CAIE	A,177		; DONT PRINT RUBOUTS
-	PUSHJ	P,IMTYO
-	JRST	MSGTY1		;AND GET NEXT CHARACTER
-CPOPJ:	POPJ	P,
-
-
-; ROUTINE TO PURIFY A STRUCTURE AND FREEZE ATOMS POINTED TO BY IT.
-; TAKES ONE ARGUMENT, THE ITEM TO PURIFY
-
-MFUNCTION PURIF,SUBR,[PURIFY]
-
-	ENTRY
-
-	JUMPGE	AB,TFA			; CHECK # OF ARGS
-
-IFE ITS,[
-	PUSH	P,MULTSG
-	SKIPE	MULTSG			; MUST RUN I 0 SEXTION MODE
-	 PUSHJ	P,NOMULT
-]
-	MOVE	C,AB
-	PUSH	P,C%0				; SLOT TO SEE IF WINNER
-PURMO1:	HRRZ	0,1(C)
-	CAML	0,PURTOP
-	JRST	PURMON				; CHECK FOR PURENESS
-	GETYP	A,(C)				; SEE IF ITS MONAD
-	PUSHJ	P,SAT
-	ANDI	A,SATMSK
-	CAIE	A,S1WORD
-	CAIN	A,SLOCR
-	JRST	PURMON
-	CAIN	A,SATOM
-	JRST	PURMON
-	SKIPE	1(C)				; SKIP IF EMPTY
-	SETOM	(P)
-PURMON:	ADD	C,C%22			; INC AND GO
-	JUMPL	C,PURMO1
-	POP	P,A				; GET MARKING
-	JUMPN	A,PURCON
-NPF:	MOVE	A,(AB)				; FINISH IF MONAD
-	MOVE	B,1(AB)
-IFE ITS,[
-	POP	P,MULTSG
-	SKIPE	MULTSG
-	 PUSHJ	P,MULTI
-]
-	JRST	FINIS
-
-PURCON:	SETZM	SWAPGC
-	PUSHJ	P,LODGC				; LOAD THE GARBAGE COLLECTOR
-	SETOM	INTHLD
-	SETOM	NPWRIT
-	JRST	IPURIF
-
-EPURIF:	PUSHJ	P,KILGC
-	SETZM	INTHLD
-	SETZM	NPWRIT
-IFE ITS,[
-	SKIPN	MULTSG
-	 JRST	NPF
-	POP	P,B
-	HRRI	B,NPF
-	MOVEI	A,0
-	XJRST	A
-]
-IFN ITS,[
-	JRST	NPF
-]
-
-
-
-; ROUTINE TO DO A SPECIAL GARBAGE COLLECT, CALLED FOR FREE STORAGE GARBAGE
-;	COLLECTS
-; AND CAN RUN A MARK/SWEEP GARBAGE COLLECT
-
-SAGC:
-IFE ITS,[
-	JRST	@[.+1]			; RETURN WITH US NOW TO THE THRILLING
-					; DAYS OF SEGMENT 0
-]
-	SOSL	NUMSWP			; GET NUMBER OF SWEEP GARBAGE COLLECTS
-	JRST	MSGC			; TRY MARK/SWEEP
-	MOVE	RNUMSP			; MOVE IN RNUMSWP
-	MOVEM	NUMSWP			; SMASH IT IN
-	JRST	GOGC
-MSGC:	SKIPN	PGROW			; CHECK FOR STACK OVERFLOW
-	SKIPE	TPGROW
-	JRST	AGC			; IF SO CAUSE REAL GARBAGE COLLECT
-	PUSH	P,C
-	PUSH	P,D
-	PUSH	P,E
-	SETOM	SWAPGC			; LOAD MARK SWEEP VERSION
-	PUSHJ	P,AGC1			; CAUSE GARBAGE COLLECT
-	HRRZ	0,MAXLEN		; SEE IF REQUEST SATISFIED
-	CAMGE	0,GETNUM
-	JRST	LOSE1
-	MOVE	C,FREMIN		; GET FREMIN
-	SUB	C,TOTCNT		; CALCULATE NEEDED
-	SUB	C,FRETOP
-	ADD	C,GCSTOP
-	JUMPL	C,DONE1
-	JSP	E,CKPUR			; GO CHECK FOR SOME STUFF
-	MOVE	D,PURBOT
-IFE ITS,	ANDCMI	D,1777		; MAKE LIKE AN ITS PAGE
-	SUB	D,CURPLN		; CALCULATE PURENESS
-	SUB	D,P.TOP
-	CAIG	D,(C)			; SEE IF PURENESS EXISTS
-	JRST	LOSE1
-	PUSH	P,A
-	ADD	C,GCSTOP
-	MOVEI	A,1777(C)
-	ASH	A,-10.
-	PUSHJ	P,P.CORE
-	FATAL	P.CORE FAILED
-	HRRZ	0,GCSTOP
-	SETZM	@0
-	HRLS	0
-	ADDI	0,1
-	HRRZ	A,FRETOP
-	BLT	0,-1(A)
-	PUSHJ	P,RBLDM
-	POP	P,A
-DONE1:	POP	P,E
-	POP	P,D
-	POP	P,C
-IFN ITS,	POPJ	P,
-IFE ITS,[
-	SKIPN	MULTSG
-	 POPJ	P,
-	SETZM	20
-	POP	P,21			; BACK TO CALLING SEGMENT
-	XJRST	20	
-]
-LOSE1:	POP	P,E
-	POP	P,D
-	POP	P,C
-GOGC:	
-	
-
-AGC:
-IFE ITS,[
-	SKIPE	MULTSG
-	 SKIPE	GCDEBU
-	  JRST	@[SEC1]
-	XJRST	.+1
-		0
-		FSEG,,SEC1
-SEC1:
-]
-	 MOVE	0,RNUMSP
-	MOVEM	0,NUMSWP
-	SETZM	SWAPGC
-AGC1:	SKIPE	NPWRIT
-	JRST	IAGC
-	EXCH	P,GCPDL
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,SQKIL
-	PUSHJ	P,CTIME
-	MOVEM	B,GCTIM
-	PUSHJ	P,LODGC				; LOAD GC
-	PUSHJ	P,RSAC				; RESTORE ACS
-	EXCH	P,GCPDL
-	SKIPE	SWAPGC
-	JRST	IAMSGC
-	SKIPN	MULTSG
-	JRST	IAGC
-	JRST	ISECGC
-
-AAGC:	SETZM	SWAPGC
-	EXCH	P,GCPDL
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,LODGC				; LOAD GC
-	PUSHJ	P,RSAC				; RESTORE ACS
-	EXCH	P,GCPDL
-	JRST	IAAGC
-
-FNMSGC:
-FINAGC:	SKIPE	NPWRIT
-	JRST	FINAGG
-	PUSHJ	P,SVAC				; SAVE ACS
-	PUSHJ	P,KILGC
-	PUSHJ	P,RSAC
-FINAGG:
-IFN ITS,	POPJ	P,
-IFE ITS,[
-	SKIPN	MULTSG
-	 POPJ	P,
-	SETZM	20
-	POP	P,21			; BACK TO CALLING SEGMENT
-	XJRST	20	
-]
-
-; ROUTINE TO SAVE THE ACS
-
-SVAC:	EXCH	0,(P)
-	PUSH	P,A
-	PUSH	P,B
-	PUSH	P,C
-	PUSH	P,D
-	PUSH	P,E
-	JRST	@0
-
-; ROUTINE TO RESTORE THE ACS
-
-RSAC:	POP	P,0
-	POP	P,E
-	POP	P,D
-	POP	P,C
-	POP	P,B
-	POP	P,A
-	EXCH	0,(P)
-	POPJ	P,
-
-
-
-
-; INTERNAL FUNCTION TO GET STRAGE ALLOCATION TYPE
-; GETS THE TYPE CODE IN A AND RETURNS SAT IN A.
-
-SAT:	LSH	A,1				; TIMES 2 TO REF VECTOR
-	HRLS	A  				; TO BOTH HALVES TO HACK AOBJN
-						;	POINTER
-	ADD	A,TYPVEC+1			; ACCESS THE VECTOR
-	HRR	A,(A)				; GET PROBABLE SAT
-	JUMPL	A,.+2				; DID WE REALLY HAVE A VALID
-						;	TYPE
-	MOVEI	A,0				; NO RETURN 0
-	ANDI	A,SATMSK
-	POPJ	P,  				; AND RETURN
-
-; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
-; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B
-; RETURN -1 IN REG B IF NONE FOUND
-
-PGFIND:
-	JUMPLE	A,FPLOSS
-	CAILE	A,256.
-	JRST	FPLOSS
-
-	PUSHJ	P,PGFND1			; SEE IF ALREADY ENOUGH
-	SKIPN	NOSHUF				; CAN'T MOVE PURNESS
-	SKIPL	B				; SKIP IF LOST
-	POPJ	P,
-
-	SUBM	M,(P)
-	PUSH	P,E
-	PUSH	P,C
-	PUSH	P,D
-PGFLO4:	MOVE	C,PURBOT			; CHECK IF ROOM AT ALL
-						; 	(NOTE POTENTIAL FOR INFINITE LOOP)
-	SUB	C,P.TOP				; TOTAL SPACE
-	MOVEI	D,(C)				; COPY FOR CONVERSION TO PAGES
-	ASH	D,-10.
-	CAIGE	D,(A)				; SKIP IF COULD WIN
-	JRST	PGFLO1
-
-	MOVNS	A				; MOVE PURE AREA DOWN "A" PAGES
-	PUSHJ	P,MOVPUR
-	MOVE	B,PURTOP			; GET FIRST PAGE ALLOCATED
-	ASH	B,-10.				; TO PAGE #
-PGFLOS:	POP	P,D
-	POP	P,C
-	POP	P,E
-	PUSHJ	P,RBLDM				; GET A NEW VALUE FOR M
-	JRST	MPOPJ
-
-; HERE TO SHUFFLE PURE SPACE TO TRY TO FIND PAGES
-
-PGFLO1:	SKIPE	GCFLG				; SKIP IF NOT IN GC
-	JRST	PGFLO5				; WE LOST
-	MOVE	C,PURTOP
-	SUB	C,P.TOP
-	HRRZ	D,FSAV(TB)			; ARE WE IN A PURE RSUBR?
-	CAIL	D,HIBOT				; ARE WE AN RSUBR AT ALL?
-	JRST	PGFLO2
-	GETYP	E,(R)				; SEE IF PCODE
-	CAIE	E,TPCODE
-	JRST	PGFLO2
-	HLRZ	D,1(R)				; GET OFFSET TO PURVEC
-	ADD	D,PURVEC+1
-	HRROS	2(D)				; MUNG AGE
-	HLRE	D,1(D)				; GET LENGTH
-	ADD	C,D
-PGFLO2:	ASH	C,-10.
-	CAILE	A,(C)
-	JRST	PGFLO3
-	PUSH	P,A
-IFE ITS,	ASH	A,1			; TENEX PAGES ARE HALF SIZE
-	PUSHJ	P,GETPAG			; SHUFFLE THEM AROUND
-	FATAL	PURE SPACE LOSING
-	POP	P,A
-	JRST	PGFLO4
-
-; HERE TO CAUSE AGC IF PAGES ARE NOT AVAILABLE EVEN AFTER MAPPING OUT THE WORLD
-
-
-PGFLO3:	PUSH	P,A				; ASK GC FOR SPACE
-	ASH	A,10.
-	MOVEM	A,GCDOWN			; REQUEST THOSE PAGES
-	MOVE	C,[8.,,9.]
-	PUSHJ	P,AGC				; GO GARBAGE COLLECT
-	POP	P,A
-	JRST	PGFLO4				; GO BACK TO POTENTIAL LOOP
-
-	
-PGFLO5:	SETOM	B				; -1 TO B
-	JRST	PGFLOS				; INDICATE LOSSAGE
-
-PGFND1:	PUSH	P,E
-	PUSH	P,D
-	PUSH	P,C
-	PUSH	P,C%M1		; POSSIBLE CONTENTS FOR REG B
-	PUSH	P,A		; SAVE LENGTH OF BLOCK DESIRED FOR LATER USE
-	SETZB	B,C		; INITIAL SECTION AND PAGE NUMBERS
-	MOVEI	0,0		; COUNT OF PAGES ALREADY FOUND
-	PUSHJ	P,PINIT
-PLOOP:	TDNE	E,D		; FREE PAGE ?
-	JRST	NOTFRE		; NO
-	JUMPN	0,NFIRST	; FIRST FREE PAGE OF A BLOCK ?
-	MOVEI	A,(B)		; YES SAVE ADDRESS OF PAGE IN REG A
-	IMULI	A,16.
-	ASH	C,-1		; BACK TO PAGES
-	ADDI	A,(C)
-	ASH	C,1		; FIX IT TO WHAT IT WAS
-NFIRST:	ADDI	0,1
-	CAML	0,(P)		; TEST IF ENOUGH PAGES HAVE BEEN FOUND
-	JRST	PWIN		; YES, FINISHED
-	SKIPA	
-NOTFRE:	MOVEI	0,0		; RESET COUNT
-	PUSHJ	P,PNEXT	; NEXT PAGE
-	JRST	PLOSE		; NONE--LOSE RETURNING -1 IN REG B
-	JRST	PLOOP
-
-PWIN:	MOVEI	B,(A)		; GET WINNING ADDRESS
-	MOVEM	B,(P)-1		; RETURN ADDRESS OF WINNING PAGE
-	MOVE	A,(P)		; RELOAD LENGTH OF BLOCK OF PAGES
-	MOVE	0,[TDO E,D]	; INST TO SET "BUSY" BITS
-	JRST	ITAKE
-
-; CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A
-; THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B
-PGGIVE:	MOVE	0,[TDZ E,D]	; INST TO SET "FREE" BITS
-	SKIPA
-PGTAKE:	MOVE	0,[TDO E,D]	; INST TO SET "BUSY" BITS
-	JUMPLE	A,FPLOSS
-	CAIL	B,0
-	CAILE	B,255.
-	JRST	FPLOSS
-	PUSH	P,E
-	PUSH	P,D
-	PUSH	P,C
-	PUSH	P,B
-	PUSH	P,A
-ITAKE:	IDIVI	B,16.
-	PUSHJ	P,PINIT
-	SUBI	A,1
-RTL:	XCT	0		; SET APPROPRIATE BIT
-	PUSHJ	P,PNEXT	; NEXT PAGE'S BIT
-	JUMPG	A,FPLOSS	; TOO MANY ?
-	SOJGE	A,RTL
-	MOVEM	E,PMAPB(B)	; REPLACE BIT MASK
-PLOSE:	POP	P,A
-	POP	P,B
-	POP	P,C
-	POP	P,D
-	POP	P,E
-	POPJ	P,
-
-
-PINIT:	MOVE	E,PMAPB(B)	; GET BITS FOR THIS SECTION
-	HRLZI	D,400000	; BIT MASK
-	IMULI	C,2
-	MOVNS	C
-	LSH	D,(C)		; SHIFT TO APPROPRIATE BIT POSITION
-	MOVNS	C
-	POPJ	P,
-
-PNEXT:	AOS	(P)		; FOR SKIP RETURN ON EXPECTED SUCCESS
-	LSH	D,-2		; CONSIDER NEXT PAGE
-	CAIL	C,30.		; FINISHED WITH THIS SECTION ?
-	JRST	PNEXT1
-	AOS	C
-	AOJA	C,CPOPJ		; NO, INCREMENT AND CONTINUE
-PNEXT1:	MOVEM	E,PMAPB(B)	; REPLACE BIT MASK
-	SETZ	C,
-	CAIGE	B,15.		; LAST SECTION ?
-	AOJA	B,PINIT		; NO, INCREMENT AND CONTINUE
-	SOS	(P)		; YES, UNDO SKIP RETURN
-	POPJ	P,
-
-FPLOSS:	FATAL PAGE LOSSAGE
-
-PGINT:	MOVEI	B,HIBOT		; INITIALIZE MUDDLE'S PAGE MAP TABLE
-	IDIVI	B,2000		; FIRST PAGE OF PURE CODE
-	MOVE	C,HITOP
-	IDIVI	C,2000
-	MOVEI	A,(C)+1
-	SUBI	A,(B)		; NUMBER OF SUCH PAGES
-	PUSHJ	P,PGTAKE	; MARK THESE PAGES AS TAKEN
-	POPJ	P,
-
-
-
-
-ERRKIL:	PUSH	P,A
-	PUSHJ	P,KILGC		; KILL THE GARBAGE COLLECTOR
-	POP	P,A
-	JRST	CALER
-
-; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU
-
-CKPUR:	HRRZ	A,FSAV(TB)	; GET NAME OF CURRENT GOODIE
-	SETZM	CURPLN		; CLEAR FOR NONE
-	CAIL	A,HIBOT		; IF LESS THAN TOP OF PURE ASSUME RSUBR
-	JRST	(E)
-	GETYP	0,(A)		; SEE IF PURE
-	CAIE	0,TPCODE	; SKIP IF IT IS
-	JRST	NPRSUB
-NRSB2:	HLRZ	B,1(A)		; GET SLOT INDICATION
-	ADD	B,PURVEC+1	; POINT TO SLOT
-	HRROS	2(B)		; MUNG AGE
-	HLRE	A,1(B)		; - LENGTH TO A
-	TRZ	A,777
-	MOVNM	A,CURPLN	; AND STORE
-	JRST	(E)
-NPRSUB:	SKIPGE	B,1(R)		; SEE IF PURE RSUBR
-	JRST	(E)
-	MOVE	A,R
-	JRST	NRSB2
-	
-; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE
-; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY
-; THEIR MUDDLE.
-
-GCSET:	MOVE	A,RFRETP	; COMPUTE FREE SPACE AVAILABLE
-	SUB	A,PARTOP
-	MOVEM	A,NOWFRE
-	CAMLE	A,MAXFRE
-	MOVEM	A,MAXFRE	; MODIFY MAXIMUM
-	HLRE	A,TP		; FIND THE DOPE WORD OF THE TP STACK
-	MOVNS	A
-	ADDI	A,1(TP)		; CLOSE TO DOPE WORD
-	CAME	A,TPGROW
-	ADDI	A,PDLBUF	; NOW AT REAL DOPE WORD
-	HLRZ	B,(A)		; GET LENGTH OF TP-STACK
-	MOVEM	B,NOWTP
-	CAMLE	B,CTPMX		; SEE IF THIS IS THE BIGGEST TP
-	MOVEM	B,CTPMX
-	HLRE	B,P		; FIND DOPE WORD OF P-STACK
-	MOVNS	B
-	ADDI	B,1(P)		; CLOSE TO IT
-	CAME	B,PGROW		; SEE IF THE STACK IS BLOWN
-	ADDI	B,PDLBUF	; POINTING TO IT
-	HLRZ	A,(B)		; GET IN LENGTH
-	MOVEM	A,NOWP
-	CAMLE	A,CPMX		; SEE IF WE HAVE THE BIGGEST P STACK
-	MOVEM	A,CPMX
-	POPJ	P,		; EXIT
-
-RBLDM:	JUMPGE	R,CPOPJ
-	SKIPGE	M,1(R)		; SKIP IF FUNNY
-	JRST	RBLDM1
-
-	HLRS	M
-	ADD	M,PURVEC+1
-	HLLM	TB,2(M)
-	SKIPL	M,1(M)
-	JRST	RBLDM1
-	PUSH	P,0
-	HRRZ	0,1(R)
-	ADD	M,0
-	POP	P,0
-RBLDM1:	SKIPN	SAVM		; SKIP IF FUNNY (M)
-	POPJ	P,		; EXIT
-	MOVEM	M,SAVM
-	MOVEI	M,0
-	POPJ	P,
-CPOPJ1:
-C1POPJ:	AOS	(P)
-	POPJ	P,
-
-
-
-; THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE
-FRMUNG:	MOVEM	D,PSAV(A)
-	MOVE	SP,SPSTOR+1
-	MOVEM	SP,SPSAV(A)
-	MOVEM	TP,TPSAV(A)	; SAVE FOR MARKING
-	POPJ	P,
-
-
-; SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
-
-REHASH:	MOVE	D,ASOVEC+1	; GET POINTER TO VECTOR
-	MOVEI	E,(D)
-	PUSH	P,E		; PUSH A POINTER
-	HLRE	A,D		; GET -LENGTH
-	MOVMS	A		; AND PLUSIFY
-	PUSH	P,A		; PUSH IT ALSO
-
-REH3:	HRRZ	C,(D)		; POINT TO FIRST BUCKKET
-	HLRZS	(D)		; MAKE SURE NEW POINTER IS IN RH
-	JUMPLE	C,REH1		; BUCKET EMPTY, QUIT
-
-REH2:	MOVEI	E,(C)		; MAKE A COPY OF THE POINTER
-	MOVE	A,ITEM(C)	; START HASHING
-	TLZ	A,TYPMSK#777777	; KILL MONITORS
-	XOR	A,ITEM+1(C)
-	MOVE	0,INDIC(C)
-	TLZ	0,TYPMSK#777777
-	XOR	A,0
-	XOR	A,INDIC+1(C)
-	TLZ	A,400000	; MAKE SURE FINAL HASH IS +
-	IDIV	A,(P)		; DIVIDE BY TOTAL LENGTH
-	ADD	B,-1(P)		; POINT TO WINNING BUCKET
-
-	MOVE	C,[002200,,(B)]	; BYTE POINTER TO RH
-	CAILE	B,(D)		; IF PAST CURRENT POINT
-	MOVE	C,[222200,,(B)]	; USE LH
-	LDB	A,C		; GET OLD VALUE
-	DPB	E,C		; STORE NEW VALUE
-	HRRZ	B,ASOLNT-1(E)	; GET NEXT POINTER
-	HRRZM	A,ASOLNT-1(E)	; AND CLOBBER IN NEW NEXT
-	SKIPE	A		; SKKIP IF NOTHING PREVIOUSLY IN BUCKET
-	HRLM	E,ASOLNT-1(A)	; OTHERWISE CLOBBER
-	SKIPE	C,B		; SKIP IF END OF CHAIN
-	JRST	REH2
-REH1:	AOBJN	D,REH3
-
-	SUB	P,C%22	; FLUSH THE JUNK
-	POPJ	P,
-
-;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
-
-NWORDT:	PUSHJ	P,SAT		;GET STORAGE ALLOC TYPE
-NWORDS:	CAIG	A,NUMSAT	; TEMPLATE?
-	SKIPL	MKTBS(A)	;-ENTRY IN TABLE MEANS 2 NEEDED
-	SKIPA	A,C%1		;NEED ONLY 1
-	MOVEI	A,2		;NEED 2
-	POPJ	P,
-
-.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
-.GLOBAL LOCMK,BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,OFFSMK
-
-; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
-
-DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
-[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
-[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
-[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
-[SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]
-[SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
-
-IMPURE
-
-DSTORE:	0			; USED FOR MAPFS AND SEGMENTS
-BUFL:	0			; BUFFER PAGE (WORDS)
-BUFP:	0			; BUFFER PAGE (PAGES)
-NPWRIT:	0			; INDICATION OF PURIFY
-RNUMSP:	0			; NUMBER OF MARK/SWEEP GARBAGE
-				; COLLECTS TO REAL GARBAGE COLLECT
-NUMSWP:	0			; NUMBER MARK SWEEP GARBAGE COLLECTS TO GO
-SWAPGC:	0			; FLAG INDICATING WHETHER TO LOAD SWAP
-				;	GC OR NOT
-TOTCNT:	0			; TOTAL COUNT
-
-PURE
-
-PAT:
-PATCH:
-
-BLOCK 400
-PATEND:
-
-END
-