X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=%3Cmdl.int%3E%2Fmain.mid.351;fp=%3Cmdl.int%3E%2Fmain.mid.351;h=6b7ae6e2fe38e0de36cd4ceee7c809d53a01fc79;hb=bab072f950a643ac109660a223b57e635492ac25;hp=0000000000000000000000000000000000000000;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c;p=pdp10-muddle.git

diff --git a/<mdl.int>/main.mid.351 b/<mdl.int>/main.mid.351
new file mode 100644
index 0000000..6b7ae6e
--- /dev/null
+++ b/<mdl.int>/main.mid.351
@@ -0,0 +1,2058 @@
+TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES
+
+RELOCA
+
+.GLOBAL TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE
+.GLOBAL PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,CURPRI,CHFINI,MKTBS
+.GLOBAL TOPLEVEL,INTOBL,INITIA,ERROBL,MAINPR,RESFUN,STATUS,TYPVEC,ROOT,TTICHN,TTOCHN
+.GLOBAL TTYOPE,MOPEN,MCLOSE,MIOT,ILVAL,MESS,ERROR,CHFRM,IGVAL,TYPBOT,ASOVEC
+.GLOBAL PRINT,PRIN1,PRINC,MUDSTR,VECBOT,CSTACK,IFALSE,TYPLOO,RCALL,SWAPIN,CTMPLT
+.GLOBAL IDPROC,CHFSWP,ILOC,MAKACT,BNDV,SPECSTORE,BINDID,IGLOC,MTYO,MSGTYP,CAFRE1,CPOPJ
+.GLOBAL EVATYP,EVTYPE,APLTYP,APTYPE,PRNTYP,PRTYPE,AGC,SGSNAM,NAPT,APLQ,STRTO6
+.GLOBAL 6TOCHS,TYPFND,STBL,CHNL0,N.CHNS,CLOSAL,%LOGOUT,%SSNAM,%RSNAM,%KILLM,SAT
+.GLOBAL MAKINF,%VALRET,COMPERR,IPUT,IGET,TMATCH,INITIZ,IPCINI,%UNAM,%JNAM,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%VALFI
+.GLOBAL NOTTY,DEMFLG,CFRAME,CARGS,CFUNCT,CITYPE,CTYPEQ,CPTYPE,CTYPEP,CUTYPE,
+.GLOBAL CCHUTY,RTFALS,PGINT,PURCLN,CTYPEC,CTYPEW,IDVAL1,CALLTY,MESSAG,INITFL,WHOAMI
+.GLOBAL %SLEEP,%HANG,%TOPLQ,ONINT,CHUNW,CURFCN,BUFRIN,TD.LNT,TD.GET,TD.AGC,TD.PUT,MPOPJ
+.GLOBAL PURVEC,PLOAD,SSPECS,OUTRNG,CVTYPE,FSTART,CKVRS,CPRTYC,PVSTOR,SPSTOR
+.GLOBAL	TYPIC,CISET,LSTUF,IMPURI,REALTV
+.INSRT MUDDLE >
+
+;MAIN LOOP AND STARTUP
+
+START:	MOVEI	0,0			; SET NO HACKS
+	JUMPE	0,START1
+	TLNE	0,-1			; SEE IF CHANNEL
+	JRST	START1
+	MOVE	P,GCPDL
+	MOVE	A,0
+	PUSH	P,A
+	PUSHJ	P,CKVRS			; CHECK VERSION NUMBERS
+	POP	P,A
+	JRST	FSTART			; GO RESTORE
+START1:	MOVEM	0,WHOAMI		; HACK FOR TS FOO linked to TS MUDDLE
+	MOVE	PVP,MAINPR		; MAKE SURE WE START IN THE MAIN PROCESS
+	JUMPE	0,INITIZ		; MIGHT BE RESTART
+	MOVE	P,PSTO+1(PVP)		; SET UP FOR BOOTSTRAP HACK
+	MOVE	TP,TPSTO+1(PVP)
+INITIZ:	MOVE	PVP,MAINPR
+	SKIPN	P			; IF NO CURRENT P
+	MOVE	P,PSTO+1(PVP)		; PDL TO GET OFF THE GROUND
+	SKIPN	TP			; SAME FOR TP
+	MOVE	TP,TPSTO+1(PVP)		; GET A TP TO WORK WITH
+	SETZB	R,M			; RESET RSUBR AC'S
+	PUSHJ	P,%RUNAM
+	 JFCL
+	PUSHJ	P,%RJNAM
+	PUSHJ	P,TTYOPE		;OPEN THE TTY
+	MOVEI	B,MUDSTR
+	SKIPE	WHOAMI		; SKIP IF THIS IS MUDDLE
+	JRST	NODEMT		; ELSE NO MESSAGE
+	SKIPE	DEMFLG		; SKIP IF NOT DEMON
+	JRST	NODEMT
+	SKIPN	NOTTY			; IF NO TTY, IGNORE
+	PUSHJ	P,MSGTYP		;TYPE OUT TO USER
+
+NODEMT:	XCT	MESSAG			;MAYBE PRINT A MESSAGE
+	PUSHJ	P,INTINT		;INITIALIZE INTERRUPT HANDLER
+	XCT	IPCINI
+	PUSHJ	P,PURCLN		; CLEAN UP PURE SHARED AREA
+RESTART:				;RESTART A PROCESS
+STP:	MOVEI	C,0
+	MOVE	PVP,PVSTOR+1
+	MOVE	B,TBINIT+1(PVP)		;POINT INTO STACK AT START
+	PUSHJ	P,CHUNW			; LEAVE WHILE DOING UNWIND CHECK
+	MOVEI	E,TOPLEV
+	MOVEI	A,TFALSE		; IN CASE FALLS OFF PROCESS
+	MOVEI	B,0
+	HRRM	E,-1(TB)
+	JRST	CONTIN
+
+	IMQUOTE	TOPLEVEL
+TOPLEVEL:
+	MCALL	0,LISTEN
+	JRST	TOPLEVEL
+
+
+IMFUNCTION LISTEN,SUBR
+
+	ENTRY
+	PUSH	P,[0]		;FLAG: DON'T PRINT ERROR MSG
+	JRST	ER1
+
+; USER SUPPLIED ERROR HANDLER, TEMPORARY KLUDGE
+	IMQUOTE	ERROR
+
+ERROR:	MOVE	B,IMQUOTE ERROR
+	PUSHJ	P,IGVAL		; GET VALUE
+	GETYP	C,A
+	CAIN	C,TSUBR		; CHECK FOR NO CHANGE
+	CAIE	B,RERR1		; SKIP IF NOT CHANGED
+	JRST	.+2
+	JRST	RERR1		; GO TO THE DEFAULT
+	PUSH	TP,A		; SAVE VALUE
+	PUSH	TP,B
+	MOVE	C,AB		; SAVE AB
+	MOVEI	D,1		; AND COUNTER
+USER1:	PUSH	TP,(C)		; PUSH THEM
+	PUSH	TP,1(C)
+	ADD	C,[2,,2]	; BUMP
+	ADDI	D,1
+	JUMPL	C,USER1
+	ACALL	D,APPLY		; EVAL USERS ERROR
+	JRST	FINIS
+
+
+
+IMFUNCTION ERROR%,SUBR,ERROR
+
+RERR1:	ENTRY
+	PUSH	TP,$TATOM
+	PUSH	TP,MQUOTE ERROR,ERROR,INTRUP
+	PUSHJ	P,FRMSTK	; PUT ERROR'S FRAME ON STACK
+	MOVEI	D,2
+	MOVE	C,AB
+RERR2:	JUMPGE	C,RERR22
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	ADD	C,[2,,2]
+	AOJA	D,RERR2
+RERR22:	ACALL	D,EMERGENCY
+	JRST	RERR
+
+IMQUOTE ERROR
+RERR:	ENTRY
+	PUSH	P,[-1] 		;PRINT ERROR FLAG
+
+ER1:	MOVE	B,IMQUOTE INCHAN
+	PUSHJ	P,ILVAL		; CHECK INPUT CHANNEL IS SOME KIND OF TTY
+	GETYP	A,A
+	CAIE	A,TCHAN		; SKIP IF IT IS A CHANNEL
+	JRST	ER2		; NO, MUST REBIND
+	CAMN	B,TTICHN+1
+	JRST	NOTINC
+ER2:	MOVE	B,IMQUOTE INCHAN
+	MOVEI	C,TTICHN	; POINT TO VALU
+	PUSHJ	P,PUSH6		; PUSH THE BINDING
+	MOVE	B,TTICHN+1	; GET IN CHAN
+NOTINC:	SKIPN	DEMFLG		; SKIP IF DEMON
+	SKIPE	NOTTY
+	JRST	NOECHO
+	PUSH	TP,$TCHAN
+	PUSH	TP,B
+	PUSH	TP,$TATOM
+	PUSH	TP,IMQUOTE T
+	MCALL	2,TTYECH	; ECHO INPUT
+NOECHO:	MOVE	B,IMQUOTE OUTCHAN
+	PUSHJ	P,ILVAL		; GET THE VALUE
+	GETYP	A,A
+	CAIE	A,TCHAN		; SKIP IF OK CHANNEL
+	JRST	ER3		; NOT CHANNEL, MUST REBIND
+	CAMN	B,TTOCHN+1
+	JRST	NOTOUT
+ER3:	MOVE	B,IMQUOTE OUTCHAN
+	MOVEI	C,TTOCHN
+	PUSHJ	P,PUSH6		; PUSH THE BINDINGS
+NOTOUT:	MOVE	B,IMQUOTE OBLIST
+	PUSHJ	P,ILVAL	; GET THE VALUE OF OBLIST
+	PUSHJ	P,OBCHK		; IS IT A WINNER ?
+	SKIPA	A,$TATOM	; NO, SKIP AND CONTINUE
+	JRST	NOTOBL		; YES, DO NOT DO REBINDING
+	MOVE	B,IMQUOTE OBLIST
+	PUSHJ	P,IGLOC
+	GETYP	0,A
+	CAIN	0,TUNBOU
+	JRST	MAKOB		; NO GLOBAL OBLIST, MAKE ONE
+	MOVEI	C,(B)		; COPY ADDRESS
+	MOVE	A,(C)		; GET THE GVAL
+	MOVE	B,(C)+1
+	PUSHJ	P,OBCHK		; IS IT A WINNER ?
+	JRST	MAKOB		; NO, GO MAKE A NEW ONE
+	MOVE	B,IMQUOTE OBLIST
+	PUSHJ	P,PUSH6
+
+NOTOBL:	PUSH	TP,[TATOM,,-1]	;FOR BINDING
+	PUSH	TP,IMQUOTE LER,[LERR ]INTRUP
+	PUSHJ	P,MAKACT
+	HRLI	A,TFRAME	; CORRCT TYPE
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSH	TP,[0]
+	PUSH	TP,[0]
+	MOVE	A,PVSTOR+1		; GET PROCESS
+	ADD	A,[PROCID,,PROCID]	; POINT TO ID (ALSO LEVEL)
+	PUSH	TP,BNDV
+	PUSH	TP,A
+	MOVE	A,PROCID(PVP)
+	ADDI	A,1		; BUMP ERROR LEVEL
+	PUSH	TP,A
+	PUSH	TP,PROCID+1(PVP)
+	PUSH	P,A
+
+	MOVE	B,IMQUOTE READ-TABLE
+	PUSHJ	P,IGVAL
+	PUSH	TP,[TATOM,,-1]
+	PUSH	TP,IMQUOTE READ-TABLE
+	GETYP	C,A		; TO GVAL OF READ-TABLE ON ERROR AND
+	CAIE	C,TVEC	; TOP ERRET'S
+	JRST	.+4
+	PUSH	TP,A
+	PUSH	TP,B
+	JRST	.+3
+	PUSH	TP,$TUNBOUND
+	PUSH	TP,[-1]
+	PUSH	TP,[0]
+	PUSH	TP,[0]
+
+	PUSHJ	P,SPECBIND	;BIND THE CRETANS
+	MOVE	A,-1(P)		;RESTORE SWITHC
+	JUMPE	A,NOERR		;IF 0, DONT PRINT ERROR MESS
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE *ERROR*
+	MCALL	0,TERPRI
+	MCALL	1,PRINC	;PRINT THE MESSAGE
+NOERR:	MOVE	C,AB		;GET A COPY OF AB
+
+ERRLP:	JUMPGE	C,LEVPRT	;IF NONE, RE-ENTER READ-EVAL-PRINT LOOP
+	PUSH	TP,$TAB
+	PUSH	TP,C
+	MOVEI	B,PRIN1
+	GETYP	A,(C)		; GET  ARGS TYPE
+	CAIE	A,TATOM
+	JRST	ERROK
+	MOVE	A,1(C)		; GET ATOM
+	HRRO	A,2(A)
+	CAME	A,[-1,,ERROBL+1]
+	CAMN	A,ERROBL+1	; DONT SKIP IF IN ERROR OBLIST
+	MOVEI	B,PRINC		; DONT PRINT TRAILER
+ERROK:	PUSH	P,B		; SAVE ROUTINE POINTER
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	MCALL	0,TERPRI	; CRLF
+	POP	P,B		; GET ROUTINE BACK
+	.MCALL	1,(B)
+	POP	TP,C
+	SUB	TP,[1,,1]
+	ADD	C,[2,,2]	;BUMP SAVED AB
+	JRST	ERRLP		;AND CONTINUE
+
+
+LEVPRT:	XCT	INITFL		;LOAD MUDDLE INIT FILE IF FIRST TIME
+	MCALL	0,TERPRI
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE [LISTENING-AT-LEVEL ]
+	MCALL	1,PRINC		;PRINT LEVEL
+	PUSH	TP,$TFIX	;READY TO PRINT LEVEL
+	HRRZ	A,(P)		;GET LEVEL
+	SUB	P,[2,,2]	;AND POP STACK
+	PUSH	TP,A
+	MCALL	1,PRIN1		;PRINT WITHOUT SPACES ETC.
+	PUSH	TP,$TATOM	;NOW PROCESS
+	PUSH	TP,EQUOTE [ PROCESS ]
+	MCALL	1,PRINC		;DONT SLASHIFY SPACES
+	MOVE	PVP,PVSTOR+1
+	PUSH	TP,PROCID(PVP)	;NOW ID
+	PUSH	TP,PROCID+1(PVP)
+	MCALL	1,PRIN1
+	SKIPN	C,CURPRI
+	JRST	MAINLP
+	PUSH	TP,$TFIX
+	PUSH	TP,C
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE [ INT-LEVEL ]
+	MCALL	1,PRINC
+	MCALL	1,PRIN1
+	JRST	MAINLP		; FALL INTO MAIN LOOP
+	
+;ROUTINES FOR ERROR-LISTEN
+
+OBCHK:	GETYP	0,A
+	CAIN	0,TOBLS
+	JRST	CPOPJ1		; WIN FOR SINGLE OBLIST
+	CAIE	0,TLIST		; IF LIST, MAKE SURE EACH IS AN OBLIST
+	JRST	CPOPJ		; ELSE, LOSE
+
+	JUMPE	B,CPOPJ		; NIL ,LOSE
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSH	P,[0]		;FLAG FOR DEFAULT CHECKING
+	MOVEI	0,1000		; VERY BIG NUMBER FOR CIRCULARITY TEST
+
+OBCHK0:	INTGO
+	SOJE	0,OBLOSE	; CIRCULARITY TEST
+	HRRZ	B,(TP)		; GET LIST POINTER
+	GETYP	A,(B)
+	CAIE	A,TOBLS		; SKIP IF WINNER
+	JRST	DEFCHK		; CHECK FOR SPECIAL ATOM DEFAULT
+	HRRZ	B,(B)
+	MOVEM	B,(TP)
+	JUMPN	B,OBCHK0
+OBWIN:	AOS	(P)-1
+OBLOSE:	SUB	TP,[2,,2]
+	SUB	P,[1,,1]
+	POPJ	P,
+
+DEFCHK:	SKIPN	(P)		; BEEN HERE BEFORE ?
+	CAIE	A,TATOM		; OR, NOT AN ATOM ?
+	JRST	OBLOSE		; YES, LOSE
+	MOVE	A,(B)+1
+	CAME	A,MQUOTE DEFAULT
+	JRST	OBLOSE		; LOSE
+	SETOM	(P)		; SET FLAG
+	HRRZ	B,(B)		; CHECK FOR END OF LIST
+	MOVEM	B,(TP)
+	JUMPN	B,OBCHK0		; NOT THE END, CONTINUE LOOKING
+	JRST	OBLOSE		; LOSE FOR DEFAULT AT THE END
+
+
+
+PUSH6:	PUSH	TP,[TATOM,,-1]
+	PUSH	TP,B
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	PUSH	TP,[0]
+	PUSH	TP,[0]
+	POPJ	P,
+
+
+MAKOB:	PUSH	TP,INITIAL
+	PUSH	TP,INITIAL+1
+	PUSH	TP,ROOT
+	PUSH	TP,ROOT+1
+	MCALL	2,LIST
+	PUSH	TP,$TATOM
+	PUSH	TP,IMQUOTE OBLIST
+	PUSH	TP,A
+	PUSH	TP,B
+	MCALL	2,SETG
+	PUSH	TP,[TATOM,,-1]
+	PUSH	TP,IMQUOTE OBLIST
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSH	TP,[0]
+	PUSH	TP,[0]
+	JRST	NOTOBL
+
+
+;THIS IS IT FOLKS...THE MAIN LOOP.  READ, EVAL, PRINT
+
+MAINLP:	MOVE	A,$TATOM	;KLUDGE BY NDR LIKE ERROR TO LET LOOSER REDEFINE
+	MOVE	B,IMQUOTE REP
+	PUSHJ	P,ILVAL		;GET ITS LVAL TO SEE IF REDEFINED
+	GETYP	C,A
+	CAIE	C,TUNBOUND
+	JRST	REPCHK
+	MOVE	A,$TATOM	;SEE IF IT HAS GVAL SINCE NO LVAL
+	MOVE	B,IMQUOTE REP
+	PUSHJ	P,IGVAL
+	GETYP	C,A
+	CAIN	C,TUNBOUN
+	JRST	IREPER
+REPCHK:	CAIN	C,TSUBR
+	CAIE	B,REPER
+	JRST	.+2
+	JRST	IREPER
+REREPE:	PUSH	TP,A
+	PUSH	TP,B
+	GETYP	A,-1(TP)
+	PUSHJ	P,APLQ
+	JRST	ERRREP
+	MCALL	1,APPLY		;LOOSER HAS REDEFINED SO CALL HIS
+	JRST	MAINLP
+IREPER:	PUSH	P,[0]		;INDICATE FALL THROUGH
+	JRST	REPERF
+
+ERRREP:	PUSH	TP,[TATOM,,-1]
+	PUSH	TP,IMQUOTE REP
+	PUSH	TP,$TSUBR
+	PUSH	TP,[REPER]
+	PUSH	TP,[0]
+	PUSH	TP,[0]
+	PUSHJ	P,SPECBIN
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE NON-APPLICABLE-REP
+	PUSH	TP,-11(TP)
+	PUSH	TP,-11(TP)
+	MCALL	2,ERROR
+	SUB	TP,[6,,6]
+	PUSHJ	P,SSPECS
+	JRST	REREPE
+
+
+IMFUNCTION REPER,SUBR,REP
+REPER:	ENTRY	0
+	PUSH	P,[1]		;INDICATE DIRECT CALL
+REPERF:	MCALL	0,TERPRI
+	MCALL	0,READ
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVE	B,IMQUOTE L-INS
+	PUSHJ	P,ILVAL		; ASSIGNED?
+	GETYP	0,A
+	CAIN	0,TLIST
+
+	PUSHJ	P,LSTTOF		; PUT LAST AS FIRST
+	MCALL	0,TERPRI
+	MCALL	1,EVAL
+	MOVE	C,IMQUOTE LAST-OUT
+	PUSHJ	P,CISET
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVE	B,IMQUOTE L-OUTS
+	PUSHJ	P,ILVAL		; ASSIGNED?
+	GETYP	0,A
+	CAIN	0,TLIST
+
+	CAME	B,(TP)		; DONT STUFF IT INTO ITSELF
+	JRST	STUFIT		; STUFF IT IN
+	GETYP	0,-1(TP)
+	CAIE	0,TLIST		; IF A LIST THE L-OUTS
+STUFIT:	PUSHJ	P,LSTTOF		; PUT LAST AS FIRST
+	MCALL	1,PRIN1
+	POP	P,C		;FLAG FOR FALL THROUGH OR CALL
+	JUMPN	C,FINIS		;IN CASE LOOSER CALLED REP
+	JRST	MAINLP
+
+LSTTOF:	SKIPN	A,B
+	POPJ	P,
+
+	HRRZ	C,(A)
+	JUMPE	C,LSTTO2
+	MOVEI	D,(C)		; SAVE PTR TO 2ND ELEMENT
+	MOVEI	0,-1		; LET THE LOSER LOSE (HA HA HA)
+
+LSTTO1:	HRRZ	C,(C)		; START SCAN
+	JUMPE	C,GOTIT
+	HRRZ	A,(A)
+	SOJG	0,LSTTO1
+
+GOTIT:	HRRZ	C,(A)
+	HLLZS	(A)
+	CAIE	D,(C)		; AVOID CIRCULARITY
+	HRRM	D,(C)
+	HRRM	C,(B)
+	MOVE	D,1(B)
+	MOVEM	D,1(C)
+	GETYP	D,(B)
+	PUTYP	D,(C)
+
+LSTTO2:	MOVSI	A,TLIST
+	MOVE	C,-1(TP)
+	MOVE	D,(TP)
+	JRST	LSTUF
+
+;FUNCTION TO RETRY A PREVIOUS FUNCTION CALL
+
+MFUNCTION RETRY,SUBR
+
+	ENTRY
+	JUMPGE	AB,RETRY1	; USE MOST RECENT
+	CAMGE	AB,[-2,,0]
+	JRST	TMA
+	GETYP	A,(AB)		; CHECK TYPE
+	CAIE	A,TFRAME
+	JRST	WTYP1
+	MOVEI	B,(AB)		; POINT TO ARG
+	JRST	RETRY2
+RETRY1:	MOVE	B,IMQUOTE LER,[LERR ]INTRUP
+	PUSHJ	P,ILOC		; LOCATIVE TO FRAME
+RETRY2:	PUSHJ	P,CHFSWP	; CHECK VALIDITY AND SWAP IF NECESSARY
+	HRRZ	0,OTBSAV(B)	; CHECK FOR TOP
+	JUMPE	0,RESTAR	; YES RE-ENTER TOP LEVEL
+	PUSH	TP,$TTB
+	PUSH	TP,B		; SAVE FRAME
+	MOVE	B,OTBSAV(B)	; GET PRVIOUS FOR UNBIND HACK
+	MOVEI	C,-1(TP)
+	PUSHJ	P,CHUNW		; CHECK ANY UNWINDING
+	CAME	SP,SPSAV(TB)	; UNBINDING NEEDED?
+	PUSHJ	P,SPECSTORE
+	MOVE	P,PSAV(TB)	; GET OTHER STUFF
+	MOVE	AB,ABSAV(B)
+	HLRE	A,AB		; COMPUTE # OF ARGS
+	MOVNI	A,-FRAMLN(A)	; MAKE TP POINT PAST FRAME
+	HRLI	A,(A)
+	MOVE	C,TPSAV(TB)	; COMPUTE TP
+	ADD	C,A
+	MOVE	TP,C
+	MOVE	TB,B		; FIX UP TB
+	HRRZ	C,FSAV(TB)	; GET FUNCTION
+	CAIL	C,HIBOT
+	JRST	(C)		; GO
+	GETYP	0,(C)		; RSUBR OR ENTRY?
+	CAIE	0,TATOM
+	CAIN	0,TRSUBR
+	JRST	RETRNT
+	MOVS	R,(C)		; SET UP R
+	HRRI	R,(C)
+	MOVEI	C,0
+	JRST	RETRN3
+
+RETRNT:	CAIE	0,TRSUBR
+	JRST	RETRN1
+	MOVE	R,1(C)
+RETRN4:	HRRZ	C,2(C)		; OFFSET
+RETRN3:	SKIPL	M,1(R)
+	JRST	RETRN5
+RETRN7:	ADDI	C,(M)
+	JRST	(C)
+
+RETRN5:	MOVEI	D,(M)		; TOTAL OFFSET
+	MOVSS	M
+	ADD	M,PURVEC+1
+	SKIPL	M,1(M)
+	JRST	RETRN6
+	ADDI	M,(D)
+	JRST	RETRN7
+
+RETRN6:	HLRZ	A,1(R)
+	PUSH	P,D
+	PUSH	P,C
+	PUSHJ	P,PLOAD
+	JRST	RETRER		; LOSER
+	POP	P,C
+	POP	P,D
+	MOVE	M,B
+	JRST	RETRN7
+
+RETRN1:	HRL	C,(C)		; FIX LH
+	MOVE	B,1(C)
+	PUSH	TP,$TVEC
+	PUSH	TP,C
+	PUSHJ	P,IGVAL
+	GETYP	0,A
+	MOVE	C,(TP)
+	SUB	TP,[2,,2]
+	CAIE	0,TRSUBR
+	JRST	RETRN2
+	MOVE	R,B
+	JRST	RETRN4
+
+RETRN2:	ERRUUO	EQUOTE CANT-RETRY-ENTRY-GONE
+
+RETRER:	ERRUUO	EQUOTE PURE-LOAD-FAILURE
+
+
+;FUNCTION TO DO ERROR RETURN
+
+IMFUNCTION ERRET,SUBR
+
+	ENTRY
+	HLRE	A,AB		; -2*# OF ARGS
+	JUMPGE	A,STP		; RESTART PROCESS
+	ASH	A,-1		; -# OF ARGS
+	AOJE	A,ERRET2	; NO FRAME SUPPLIED
+	AOJL	A,TMA
+	ADD	AB,[2,,2]
+	PUSHJ	P,OKFRT
+	JRST	WTYP2
+	SUB	AB,[2,,2]
+	PUSHJ	P,CHPROC	; POINT TO FRAME SLOT
+	JRST	ERRET3
+ERRET2:	MOVE	B,IMQUOTE LER,[LERR ]INTRUP
+	PUSHJ	P,ILVAL		; GET ITS VALUE
+ERRET3:	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)
+	PUSHJ	P,CHFSWP	; CHECK VALIDITY AND SWAP IF NECESSARY
+	HRRZ	0,OTBSAV(B)	; TOP LEVEL?
+	JUMPE	0,TOPLOS
+	PUSHJ	P,CHUNW		; ANY UNWINDING
+	JRST	CHFINIS
+
+
+; FUNCTION TO RETURN LAST ERROR FRAME OR PREVIOUS FRAME
+
+IMFUNCTION	FRAME,SUBR
+	ENTRY
+	SETZB	A,B
+	JUMPGE	AB,FRM1		; DEFAULT CASE
+	CAMG	AB,[-3,,0]	; SKIP IF OK ARGS
+	JRST	TMA
+	PUSHJ	P,OKFRT		; A FRAME OR SIMILAR THING?
+	JRST	WTYP1
+
+FRM1:	PUSHJ	P,CFRAME	; GO TO INTERNAL
+	JRST	FINIS
+
+CFRAME:	JUMPN	A,FRM2		; ARG SUPPLIED?
+	MOVE	B,IMQUOTE LER,[LERR ]INTRUP
+	PUSHJ	P,ILVAL
+	JRST	FRM3
+FRM2:	PUSHJ	P,CHPROC	; CHECK FOR PROCESS
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)	; POINT TO SLOT
+	PUSHJ	P,CHFRM		; CHECK IT
+	MOVE	C,(TP)		; GET FRAME BACK
+	MOVE	B,OTBSAV(C)	;GET PREVIOUS FRAME
+	SUB	TP,[2,,2]
+	TRNN	B,-1		; SKIP IF OK
+	JRST	TOPLOSE
+
+FRM3:	JUMPN	B,FRM4	; JUMP IF WINNER
+	MOVE	B,IMQUOTE THIS-PROCESS
+	PUSHJ	P,ILVAL		; GET PROCESS OF INTEREST
+	GETYP	A,A		; CHECK IT
+	CAIN	A,TUNBOU
+	MOVE	B,PVSTOR+1	; USE CURRENT
+	MOVEI	A,PVLNT*2+1(B)	; POINT TO DOPE WORDS
+	MOVE	B,TBINIT+1(B)	; AND BASE FRAME
+FRM4:	HLL	B,OTBSAV(B)	;TIME
+	HRLI	A,TFRAME
+	POPJ	P,
+
+OKFRT:	AOS	(P)		;ASSUME WINNAGE
+	GETYP	0,(AB)
+	MOVE	A,(AB)
+	MOVE	B,1(AB)
+	CAIE	0,TFRAME
+	CAIN	0,TENV
+	POPJ	P,
+	CAIE	0,TPVP
+	CAIN	0,TACT
+	POPJ	P,
+	SOS	(P)
+	POPJ	P,
+
+CHPROC:	GETYP	0,A		; TYPE
+	CAIE	0,TPVP
+	POPJ	P,		; OK
+	MOVEI	A,PVLNT*2+1(B)
+	CAMN	B,PVSTOR+1	; THIS PROCESS?
+	JRST	CHPRO1
+	MOVE	B,TBSTO+1(B)
+	JRST	FRM4
+
+CHPRO1:	MOVE	B,OTBSAV(TB)
+	JRST	FRM4
+
+; FUNCTION TO RETURN ARGS TUPLE FOR A FRAME
+
+MFUNCTION	ARGS,SUBR
+	ENTRY	1
+	PUSHJ	P,OKFRT		; CHECK FRAME TYPE
+	JRST	WTYP1
+	PUSHJ	P,CARGS
+	JRST	FINIS
+
+CARGS:	PUSHJ	P,CHPROC
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)	; POINT TO FRAME SLOT
+	PUSHJ	P,CHFRM		; AND CHECK FOR VALIDITY
+	MOVE	C,(TP)		; FRAME BACK
+	MOVSI	A,TARGS
+CARGS1:	GETYP	0,FSAV(C)	; IS THIS A FUNNY ONE
+	CAIE	0,TCBLK		; SKIP IF FUNNY
+	JRST	.+3		; NO NORMAL
+	MOVE	C,OTBSAV(C)	; ASSOCIATE WITH PREVIOUS FRAME
+	JRST	CARGS1
+	HLR	A,OTBSAV(C)	; TIME IT AND
+	MOVE	B,ABSAV(C)	; GET POINTER
+	SUB	TP,[2,,2]	; FLUSH CRAP
+	POPJ	P,
+
+; FUNCTION TO RETURN FUNCTION ASSOCIATED WITH A FRAME
+
+MFUNCTION FUNCT,SUBR
+	ENTRY	1	; FRAME ARGUMENT
+	PUSHJ	P,OKFRT		; CHECK TYPE
+	JRST	WTYP1
+	PUSHJ	P,CFUNCT
+	JRST	FINIS
+
+CFUNCT:	PUSHJ	P,CHPROC
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVEI	B,-1(TP)
+	PUSHJ	P,CHFRM		; CHECK IT
+	MOVE	C,(TP)		; RESTORE FRAME
+	HRRZ	A,FSAV(C)	;FUNCTION POINTER
+	CAIL	A,HIBOT
+	SKIPA	B,@-1(A)	;NO, GET SUBR'S NAME POINTER
+	MOVE	B,(A)+3		;YES, GET RSUBR'S NAME ENTRY
+	MOVSI	A,TATOM
+	SUB	TP,[2,,2]
+	POPJ	P,
+
+BADFRAME:
+	ERRUUO	EQUOTE FRAME-NO-LONGER-EXISTS
+
+
+TOPLOSE:
+	ERRUUO	EQUOTE TOP-LEVEL-FRAME
+
+
+
+
+; ROUTINE TO HANG INDEFINITELY WITH INTERRUPTS ENABLED
+
+MFUNCTION	HANG,SUBR
+
+	ENTRY
+
+	JUMPGE	AB,HANG1	; NO PREDICATE
+	CAMGE	AB,[-3,,]
+	JRST	TMA
+	PUSH	TP,(AB)
+	PUSH	TP,1(AB)
+	PUSHJ	P,CHKPRD
+REHANG:	MOVE	A,[PUSHJ P,CHKPRH]
+	MOVEM	A,ONINT		; CHECK PREDICATE AFTER ANY INTERRUPT
+HANG1:	ENABLE			;LET OURSELVES BE INTERRUPTED OUT
+	PUSHJ	P,%HANG
+	DISABLE			;PREVENT INTERRUPTS AT RANDOM TIMES
+	SETZM	ONINT
+	MOVE	A,$TATOM
+	MOVE	B,IMQUOTE T
+	JRST 	FINIS
+
+
+; ROUTINE TO SLEEP FOR POSITIVE NUMBER OF SECONDS WITH INTERRUPTS ENABLED
+; ARGUMENT SHOULD BE OF TYPE FIX OR FLOAT AND NON-NEGATIVE
+
+MFUNCTION	SLEEP,SUBR
+
+	ENTRY
+
+	JUMPGE	AB,TFA
+	CAML	AB,[-3,,]
+	JRST	SLEEP1
+	CAMGE	AB,[-5,,]
+	JRST	TMA
+	PUSH	TP,2(AB)
+	PUSH	TP,3(AB)
+	PUSHJ	P,CHKPRD
+SLEEP1:	GETYP	0,(AB)
+	CAIE	0,TFIX
+	JRST	.+5
+	MOVE	B,1(AB)
+	JUMPL	B,OUTRNG	;ARG SHOULDNT BE NEGATIVE
+	IMULI	B,30.		;CONVERT TO # OF THIRTIETHS OF A SECOND
+	JRST	SLEEPR		;GO SLEEP
+	CAIE	0,TFLOAT	;IF IT WASNT FIX MAKE SURE IT IS FLOAT
+	JRST	WTYP1		;WRONG TYPE ARG
+	MOVE	B,1(AB)
+	FMPR	B,[30.0]	;CONVERT TO FLOATING # OF THIRTIETHS OF A SECOND
+	MULI	B,400		;KLUDGE TO FIX IT
+	TSC	B,B
+	ASH	C,(B)-243
+	MOVE	B,C		;MOVE THE FIXED NUMBER INTO B
+	JUMPL	B,OUTRNG	;CHECK TO SEE THAT WE HAVE POSITIVE NUMBER
+SLEEPR:	MOVE	A,B
+RESLEE:	MOVE	B,[PUSHJ P,CHKPRS]
+	CAMGE	AB,[-3,,]
+	MOVEM	B,ONINT
+	ENABLE
+	PUSHJ	P,%SLEEP
+	DISABLE
+	SETZM	ONINT
+	MOVE	A,$TATOM
+	MOVE	B,IMQUOTE T
+	JRST	FINIS
+
+CHKPRH:	PUSH	P,B
+	MOVEI	B,HANGP
+	JRST	.+3
+
+CHKPRS:	PUSH	P,B
+	MOVEI	B,SLEEPP
+	HRRM	B,LCKINT
+	SETZM	ONINT		; TURN OFF FEATURE FOR NOW
+	POP	P,B
+	POPJ	P,
+
+HANGP:	SKIPA	B,[REHANG]
+SLEEPP:	MOVEI	B,RESLEE
+	PUSH	P,B
+CHKPRD:	PUSH	P,A
+	DISABLE
+	PUSH	TP,(TB)
+	PUSH	TP,1(TB)
+	MCALL	1,EVAL
+	GETYP	0,A
+	CAIE	0,TFALSE
+	JRST	FINIS
+	POP	P,A
+	POPJ	P,
+
+MFUNCTION	VALRET,SUBR
+; SUBR TO VALRET A STRING TO SUPERIOR ITS PROCESS
+
+	ENTRY	1
+	GETYP	A,(AB)		; GET TYPE OF ARGUMENT
+	CAIN	A,TFIX		; FIX?
+	 JRST	VALRT1
+	CAIE	A,TCHSTR	; IS IT A CHR STRING?
+	JRST	WTYP1		; NO...ERROR WRONG TYPE
+	PUSHJ	P,CSTACK	; COPY THE CHR STRING TO THE STACK
+					; CSTACK IS IN ATOMHK
+	MOVEI	B,0		; ASCIZ TERMINATOR
+	EXCH	B,(P)		; STORE AND RETRIEVE COUNT
+
+; CALCULATE THE BEGINNING ADDR OF THE STRING
+	MOVEI	A,-1(P)		; GET ADDR OF TOP OF STACK
+	SUBI	A,-1(B)		; GET STARTING ADDR
+	PUSHJ	P,%VALRE	; PASS UP TO MONITOR
+	JRST	IFALSE		; IF HE RETURNS, RETURN FALSE
+
+VALRT1:	MOVE	A,1(AB)
+	PUSHJ	P,%VALFI
+	JRST	IFALSE
+
+MFUNCTION	LOGOUT,SUBR
+
+; SUBR TO DO A .LOGOUT (VALID ONLY AT TOP LEVEL)
+	ENTRY	0
+	PUSHJ	P,%TOPLQ	; SKIP IF AT TOP LEVEL
+	JRST	IFALSE
+	PUSHJ	P,CLOSAL
+	PUSHJ	P,%LOGOUT	; TRY TO FLUSH
+	JRST	IFALSE		; COULDN'T DO IT...RETURN FALSE
+
+; FUNCTS TO GET UNAME AND JNAME
+
+; GET XUNAME (REAL UNAME)
+MFUNCTION XUNAME,SUBR
+
+	ENTRY	0
+
+	PUSHJ	P,%RXUNA
+	 JRST	RSUJNM
+	JRST	FINIS		; 10X ROUTINES SKIP
+
+MFUNCTION UNAME,SUBR
+
+	ENTRY	0
+
+	PUSHJ	P,%RUNAM
+	 JRST	RSUJNM
+	JRST	FINIS
+
+; REAL JNAME
+MFUNCTION XJNAME,SUBR
+
+	ENTRY	0
+
+	PUSHJ	P,%RXJNA
+	JRST	RSUJNM
+
+MFUNCTION JNAME,SUBR
+
+	ENTRY	0
+
+	PUSHJ	P,%RJNAM
+	JRST	RSUJNM
+
+; FUNCTION TO SET AND READ GLOBAL SNAME
+
+MFUNCTION SNAME,SUBR
+
+	ENTRY
+
+	JUMPGE	AB,SNAME1
+	CAMG	AB,[-3,,]
+	JRST	TMA
+	GETYP	A,(AB)		; ARG MUST BE STRING
+	CAIE	A,TCHSTR
+	JRST	WTYP1
+	PUSH	TP,$TATOM
+	PUSH	TP,IMQUOTE SNM
+	PUSH	TP,(AB)
+	PUSH	TP,1(AB)
+	MCALL	2,SETG
+	JRST	FINIS
+
+SNAME1:	MOVE	B,IMQUOTE SNM
+	PUSHJ	P,IDVAL1
+	GETYP	0,A
+	CAIN	0,TCHSTR
+	JRST	FINIS
+	MOVE	A,$TCHSTR
+	MOVE	B,CHQUOTE
+	JRST	FINIS
+
+RSUJNM:	PUSHJ	P,6TOCHS	; CONVERT IT
+	JRST	FINIS
+
+
+SGSNAM:	MOVE	B,IMQUOTE SNM
+	PUSHJ	P,IDVAL1
+	GETYP	0,A
+	CAIE	0,TCHSTR
+	JRST	SGSN1
+
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSHJ	P,STRTO6
+	POP	P,A
+	SUB	TP,[2,,2]
+	JRST	.+2
+
+SGSN1:	MOVEI	A,0
+	PUSHJ	P,%SSNAM	; SET SNAME IN SYSTEM
+	POPJ	P,
+
+
+
+;THIS SUBROUTINE ALLOCATES A NEW PROCESS
+;TAKES TP-STACK SIZE (2*WORDS) IN A AND P-STACK SIZE (WORDS) IN B
+;IS CALLED BY PUSHJ P,. RETURNS IN A AND B A NEW PROCESS.
+
+ICR:	PUSH	P,A
+	PUSH	P,B
+	MOVEI	A,PVLNT		;SETUP CALL TO VECTOR FOR PVP
+	PUSHJ	P,IVECT		;GOBBLE A VECTOR
+	HRLI	C,PVBASE	;SETUP A BLT POINTER
+	HRRI	C,(B)		;GET INTO ADDRESS
+	BLT	C,PVLNT*2-1(B)	;COPY A PROTOTYPE INTO NEW PVP
+	MOVSI	C,400000+SPVP+.VECT.	;SET SPECIAL TYPE
+	MOVEM	C,PVLNT*2(B)	;CLOBBER IT IN
+	PUSH	TP,A		;SAVE THE RESULTS OF VECTOR
+	PUSH	TP,B
+
+	PUSH	TP,$TFIX	;GET A UNIFORM VECTOR
+	POP	P,B
+	PUSH	TP,B
+	MCALL	1,UVECTOR
+	ADD	B,[PDLBUF-2,,-1]	;FUDGE WITH BUFFER
+	MOVE	C,(TP)		;REGOBBLE PROCESS POINTER
+	MOVEM	B,PSTO+1(C)	;STORE IN ALL HOMES
+	MOVEM	B,PBASE+1(C)
+
+
+	POP	P,A		;PREPARE TO CREATE A TEMPORARY PDL
+	PUSHJ	P,IVECT		;GET THE TEMP PDL
+	ADD	B,[PDLBUF,,0]	;PDL GROWTH HACK
+	MOVE	C,(TP)		;RE-GOBBLE NEW PVP
+	SUB	B,[1,,1]	;FIX FOR STACK
+	MOVEM	B,TPBASE+1(C)
+
+;SETUP INITIAL BINDING
+
+	PUSH	B,$TBIND
+	MOVEM	B,SPBASE+1(C)	;SAVE AS BASE OF SP
+	MOVEM	B,SPSTO+1(C)	;AND CURRENT THEREOF
+	MOVEM	B,CURFCN+1(C)	; AND AS CURRENT FCN FOR SPEC/UNSPEC LOGIC
+	PUSH	B,IMQUOTE THIS-PROCESS
+	PUSH	B,$TPVP	;GIVE IT PROCESS AS VALUE
+	PUSH	B,C
+	ADD	B,[2,,2]	;FINISH FRAME
+	MOVEM	B,TPSTO+1(C)	;MAKE THIS THE CURRENT STACK POINTER
+	MOVEM	C,PVPSTO+1(C)	;SAVE THE NEW PVP ITSELF
+	AOS	A,IDPROC		;GOBBLE A UNIQUE PROCESS I.D.
+	MOVEM	A,PROCID+1(C)	;SAVE THAT ALSO
+	AOS	A,PTIME		; GET A UNIQUE BINDING ID
+	MOVEM	A,BINDID+1(C)
+
+	MOVSI	A,TPVP		;CLOBBER THE TYPE
+	MOVE	B,(TP)		;AND POINTER TO PROCESS
+	SUB	TP,[2,,2]
+	POPJ	P,
+
+;MINI ROUTINE TO CALL VECTOR WITH COUNT IN A
+
+IVECT:	PUSH	TP,$TFIX
+	PUSH	TP,A
+	MCALL	1,VECTOR	;GOBBLE THE VECTOR
+	POPJ	P,
+
+
+;SUBROUTINE TO SWAP A PROCESS IN
+;CALLED WITH JSP A,SWAP AND NEW PVP IN B
+
+SWAP:				;FIRST STORE ALL THE ACS
+
+	MOVE	PVP,PVSTOR+1
+	MOVE	SP,$TSP		; STORE SPSAVE
+	MOVEM	SP,SPSTO(PVP)
+	MOVE	SP,SPSTOR+1
+	IRP	A,,[SP,AB,TB,TP,P,M,R,FRM]
+	MOVEM	A,A!STO+1(PVP)
+	TERMIN
+
+	SETOM	1(TP)		; FENCE POST MAIN STACK
+	MOVEM	TP,TPSAV(TB)	; CORRECT FRAME
+	SETZM	PSAV(TB)	; CLEAN UP CURRENT FRAME
+	SETZM	SPSAV(TB)
+	SETZM	PCSAV(TB)
+
+	MOVE	E,PVP	;RETURN OLD PROCESS IN E
+	MOVE	PVP,D	;AND MAKE NEW ONE BE D
+	MOVEM	PVP,PVSTOR+1
+
+SWAPIN:
+	;NOW RESTORE NEW PROCESSES AC'S
+
+	MOVE	PVP,PVSTOR+1
+	IRP	A,,[AB,TB,SP,TP,P,M,R,FRM]
+	MOVE	A,A!STO+1(PVP)
+	TERMIN
+
+	SETZM	SPSTO(PVP)
+	MOVEM	SP,SPSTOR+1
+	JRST	(C)		;AND RETURN
+
+
+
+
+;SUBRS ASSOCIATED WITH TYPES
+
+;TYPE (ITYPE) ARE FUNCTIONS TO RETURN THE ATOMIC NAME OF THE
+;TYPE OF A GOODIE.  TYPE TAKES ITS ARGS ON AP AND RETURNS IN A AND B.
+;ITYPE TAKES ITS ARGS IN A AND B AND RETURNS IN SAME (B=0) FOR INVALID
+;TYPECODE.
+MFUNCTION TYPE,SUBR
+
+	ENTRY	1
+	GETYP	A,(AB)		;TYPE INTO A
+TYPE1:	PUSHJ	P,ITYPE		;GO TO INTERNAL
+	JUMPN	B,FINIS		;GOOD RETURN
+TYPERR:	ERRUUO	EQUOTE TYPE-UNDEFINED
+
+CITYPE:	GETYP	A,A		; GET TYPE FOR COMPILER CALL
+ITYPE:	LSH	A,1		;TIMES 2
+	HRLS	A  		;TO BOTH SIDES
+	ADD	A,TYPVEC+1	;GET ACTUAL LOCATION
+	JUMPGE	A,TYPERR	;LOST, TYPE OUT OF BOUNDS
+	MOVE	B,1(A)		;PICKUP TYPE
+	HLLZ	A,(A)
+	POPJ	P,
+
+; PREDICATE -- IS OBJECT OF TYPE SPECIFIED
+
+MFUNCTION %TYPEQ,SUBR,[TYPE?]
+
+	ENTRY
+
+	MOVE	D,AB		; GET ARGS
+	ADD	D,[2,,2]
+	JUMPGE	D,TFA
+	MOVE	A,(AB)
+	HLRE	C,D
+	MOVMS	C
+	ASH	C,-1		; FUDGE
+	PUSHJ	P,ITYPQ		; GO INTERNAL
+	JFCL
+	JRST	FINIS
+
+ITYPQ:	GETYP	A,A		; OBJECT
+	PUSHJ	P,ITYPE
+TYPEQ0:	SOJL	C,CIFALS
+	GETYP	0,(D)
+	CAIE	0,TATOM		; Type name must be an atom
+	JRST	WRONGT
+	CAMN	B,1(D)		; Same as the OBJECT?
+	JRST	CPOPJ1		; Yes, return type name
+	ADD	D,[2,,2]
+	JRST	TYPEQ0		; No, continue comparing
+
+CIFALS:	MOVEI	B,0
+	MOVSI	A,TFALSE
+	POPJ	P,
+
+CTYPEQ:	SOJE	A,CIFALS	; TREAT NO ARGS AS FALSE
+	MOVEI	D,1(A)		; FIND BASE OF ARGS
+	ASH	D,1
+	HRLI	D,(D)
+	SUBM	TP,D		; D POINTS TO BASE
+	MOVE	E,D		; SAVE FOR TP RESTORE
+	ADD	D,[3,,3]	; FUDGE
+	MOVEI	C,(A)		; NUMBER OF TYPES
+	MOVE	A,-2(D)
+	PUSHJ	P,ITYPQ
+	JFCL		; IGNORE SKIP FOR NOW
+	MOVE	TP,E		; SET TP BACK
+	JUMPL	B,CPOPJ1	; SKIP
+	POPJ	P,
+
+; Entries to get type codes for types for fixing up RSUBRs and assembling
+
+MFUNCTION %TYPEC,SUBR,[TYPE-C]
+
+	ENTRY
+
+	JUMPGE	AB,TFA
+	GETYP	0,(AB)
+	CAIE	0,TATOM
+	JRST	WTYP1
+	MOVE	B,1(AB)
+	CAMGE	AB,[-3,,0]	; skip if only type name given
+	JRST	GTPTYP
+	MOVE	C,IMQUOTE ANY
+
+TYPEC1:	PUSHJ	P,CTYPEC	; go to internal
+	JRST	FINIS
+
+GTPTYP:	CAMGE	AB,[-5,,0]
+	JRST	TMA
+	GETYP	0,2(AB)
+	CAIE	0,TATOM
+	JRST	WTYP2
+	MOVE	C,3(AB)
+	JRST	TYPEC1
+
+CTYPEC:	PUSH	P,C		; save primtype checker
+	PUSHJ	P,TYPFND	; search type vector
+	JRST	CTPEC2		; create the poor loser
+	POP	P,B
+	CAMN	B,IMQUOTE ANY
+	JRST	CTPEC1
+	CAMN	B,IMQUOTE TEMPLATE
+	JRST	TCHK
+	PUSH	P,D
+	HRRZ	A,(A)
+	ANDI	A,SATMSK
+	PUSH	P,A
+	PUSHJ	P,TYPLOO
+	HRRZ	0,(A)
+	ANDI	0,SATMSK
+	CAME	0,(P)
+	JRST	TYPDIF
+	MOVE	D,-1(P)
+	SUB	P,[2,,2]
+CTPEC1:	MOVEI	B,(D)
+	MOVSI	A,TTYPEC
+	POPJ	P,
+TCHK:	PUSH	P,D		; SAVE TYPE
+	MOVE	A,D		; GO TO SAT
+	PUSHJ	P,SAT
+	CAIG	A,NUMSAT	; SKIP IF A TEMPLATE
+	JRST	TYPDIF
+	POP	P,D		; RESTORE TYPE
+	JRST	CTPEC1
+
+CTPEC2:	POP	P,C		; GET BACK PRIMTYPE
+	SUBM	M,(P)
+	PUSH	TP,$TATOM
+	PUSH	TP,B
+	CAMN	C,IMQUOTE ANY
+	JRST	CTPEC3
+	PUSH	TP,$TATOM
+	PUSH	TP,C
+	MCALL	2,NEWTYPE		; CREATE THE POOR GUY
+	MOVE	C,IMQUOTE ANY
+	SUBM	M,(P)		; UNRELATIVIZE
+	JRST	CTYPEC
+
+CTPEC3:	HRRZ	0,FSAV(TB)
+	CAIE	0,%TYPEC
+	CAIN	0,%TYPEW
+	JRST	TYPERR
+
+	MCALL	1,%TYPEC
+	JRST	MPOPJ
+
+MFUNCTION %TYPEW,SUBR,[TYPE-W]
+
+	ENTRY
+
+	JUMPGE	AB,TFA
+	GETYP	0,(AB)
+	CAIE	0,TATOM
+	JRST	WTYP1
+	MOVEI	D,0
+	MOVE	C,IMQUOTE ANY
+	MOVE	B,1(AB)
+	CAMGE	AB,[-3,,0]
+	JRST	CTYPW1
+
+CTYPW3:	PUSHJ	P,CTYPEW
+	JRST	FINIS
+
+CTYPW1:	GETYP	0,2(AB)
+	CAIE	0,TATOM
+	JRST	WTYP2
+	CAMGE	AB,[-5,,0]	; JUMP IF RH IS GIVEN
+	JRST	CTYPW2
+CTYPW5:	MOVE	C,3(AB)
+	JRST	CTYPW3
+
+CTYPW2:	CAMGE	AB,[-7,,0]
+	JRST	TMA
+	GETYP	0,4(AB)
+	CAIE	0,TFIX
+	JRST	WRONGT
+	MOVE	D,5(AB)
+	JRST	CTYPW5
+
+CTYPEW:	PUSH	P,D
+	PUSHJ	P,CTYPEC	; GET CODE IN B
+	POP	P,B
+	HRLI	B,(D)
+	MOVSI	A,TTYPEW
+	POPJ	P,
+
+MFUNCTION %VTYPE,SUBR,[VALID-TYPE?]
+
+	ENTRY	1
+
+	GETYP	0,(AB)
+	CAIE	0,TATOM
+	JRST	WTYP1
+	MOVE	B,1(AB)
+
+	PUSHJ	P,CVTYPE
+	JFCL
+	JRST	FINIS
+
+CVTYPE:	PUSHJ	P,TYPFND		; LOOK IT UP
+	JRST	PFALS
+
+	MOVEI	B,(D)
+	MOVSI	A,TTYPEC
+	JRST	CPOPJ1
+
+PFALS:	MOVEI	B,0
+	MOVSI	A,TFALSE
+	POPJ	P,
+	
+;PRIMTTYPE  RETURNS THE TYPE ATOM OF A PRIMITIVE TYPE IN A CLASS
+
+STBL:	REPEAT NUMSAT,SETZ MQUOTE INTERNAL-TYPE
+
+LOC STBL
+
+IRP A,,[[1WORD,WORD],[2WORD,LIST],[NWORD,UVECTOR],[2NWORD,VECTOR],[STORE,STORAGE]
+[ARGS,TUPLE],[FRAME,FRAME],[ATOM,ATOM],[LOCID,LOCD],[CHSTR,STRING],[OFFS,OFFSET,1]
+[PVP,PROCESS,1],[ASOC,ASOC,1],[LOCA,LOCA],[LOCS,LOCS],[LOCU,LOCU],[LOCV,LOCV]
+[LOCL,LOCL],[LOCN,LOCAS],[LOCT,LOCT,1],[LOCR,LOCR],[LOCB,LOCB,1],[BYTE,BYTES,1]]
+IRP B,C,[A]
+LOC STBL+S!B
+IRP X,Y,[C]
+IFSE [Y],SETZ IMQUOTE X
+IFSN [Y],SETZ MQUOTE X
+.ISTOP
+TERMIN
+.ISTOP
+
+TERMIN
+TERMIN
+
+LOC STBL+NUMSAT+1
+
+
+MFUNCTION TYPEPRIM,SUBR
+
+	ENTRY	1
+	GETYP	A,(AB)
+	CAIE	A,TATOM
+	JRST	NOTATOM
+	MOVE	B,1(AB)
+	PUSHJ	P,CTYPEP
+	JRST	FINIS
+
+CTYPEP:	PUSHJ	P,TYPLOO	; CONVERT ATOM TO CODE
+	HRRZ	A,(A)		; SAT TO A
+	ANDI	A,SATMSK
+	JRST	PTYP1
+
+MFUNCTION PTSATC,SUBR,[PRIMTYPE-C]
+
+	ENTRY	1
+
+	GETYP	A,(AB)
+	CAIE	A,TATOM
+	JRST	WTYP1
+	MOVE	B,1(AB)
+	PUSHJ	P,CPRTYC
+	JRST	FINIS
+
+CPRTYC:	PUSHJ	P,TYPLOO
+	MOVE	B,(A)
+	ANDI	B,SATMSK
+	MOVSI	A,TSATC
+	POPJ	P,
+
+
+IMFUNCTION PRIMTYPE,SUBR
+
+	ENTRY	1
+
+	MOVE	A,(AB)		;GET TYPE
+	PUSHJ	P,CPTYPE
+	JRST	FINIS
+
+CPTYPE:	GETYP	A,A
+	PUSHJ	P,SAT		;GET SAT
+PTYP1:	JUMPE	A,TYPERR
+	MOVE	B,IMQUOTE TEMPLATE
+	CAIG	A,NUMSAT	; IF BIG SAT, THEN TEMPLATE
+	MOVE	B,@STBL(A)
+	MOVSI	A,TATOM
+	POPJ	P,
+
+
+; RSUBR MAKES A VECTOR INTO AN OBJECT OF TYPE RSUBR, ALSO SLIGHTLY MUNGING IT
+
+IMFUNCTION RSUBR,SUBR
+	ENTRY	1
+
+	GETYP	A,(AB)
+	CAIE	A,TVEC		; MUST BE VECTOR
+	JRST	WTYP1
+	MOVE	B,1(AB)		; GET IT
+	GETYP	A,(B)		; CHECK 1ST ELEMENTS TYPE
+	CAIN	A,TPCODE	; PURE CODE
+	JRST	.+3
+	CAIE	A,TCODE
+	JRST	NRSUBR
+	HLRM	B,(B)		; CLOBEER SPECIAL COUNT FIELD
+	MOVSI	A,TRSUBR
+	JRST	FINIS
+
+NRSUBR:	ERRUUO	EQUOTE FIRST-ELEMENT-OF-VECTOR-NOT-CODE
+
+; ROUTINE TO GENERATE ENTRYY OTHER THAN FIRST TO RSUBRR
+
+IMFUNCTION MENTRY,SUBR,[RSUBR-ENTRY]
+
+	ENTRY	2
+
+	GETYP	0,(AB)		; TYPE OF ARG
+	CAIE	0,TVEC		; BETTER BE VECTOR
+	JRST	WTYP1
+	GETYP	0,2(AB)
+	CAIE	0,TFIX
+	JRST	WTYP2
+	MOVE	B,1(AB)		; GET VECTOR
+	CAML	B,[-3,,0]
+	JRST	BENTRY
+	GETYP	0,(B)		; FIRST ELEMENT
+	CAIE	0,TRSUBR
+	JRST	MENTR1
+MENTR2:	GETYP	0,2(B)
+	CAIE	0,TATOM
+	JRST	BENTRY
+	MOVE	C,3(AB)
+	HRRM	C,2(B)		; OFFSET INTO VECTOR
+	HLRM	B,(B)
+	MOVSI	A,TENTER
+	JRST	FINIS
+
+MENTR1:	CAIE	0,TATOM
+	JRST	BENTRY
+	MOVE	B,1(B)		; GET ATOM
+	PUSHJ	P,IGVAL		; GET VAL
+	GETYP	0,A
+	CAIE	0,TRSUBR
+	JRST	BENTRY
+	MOVE	C,1(AB)		; RESTORE B
+	MOVEM	A,(C)
+	MOVEM	B,1(C)
+	MOVE	B,C
+	JRST	MENTR2
+
+BENTRY:	ERRUUO	EQUOTE BAD-VECTOR
+	
+; SUBR TO GET ENTRIES OFFSET
+
+MFUNCTION LENTRY,SUBR,[ENTRY-LOC]
+
+	ENTRY	1
+
+	GETYP	0,(AB)
+	CAIE	0,TENTER
+	JRST	WTYP1
+	MOVE	B,1(AB)
+	HRRZ	B,2(B)
+	MOVSI	A,TFIX
+	JRST	FINIS
+
+; RETURN FALSE
+
+RTFALS:	MOVSI	A,TFALSE
+	MOVEI	B,0
+	POPJ	P,
+
+;SUBROUTINE CALL FOR RSUBRs
+RCALL:	SUBM	M,(P)		;CALCULATE PC's OFFSET IN THE RSUBR
+	HRLI	0,400000	; DONT LOSE IN MULTI SEG MODE
+
+	PUSHJ	P,@0		;GO TO THE PROPER SUBROUTINE
+	SUBM	M,(P)		;RECONSTITUTE THE RSUBR's PC
+	POPJ	P,
+
+
+
+;CHTYPE TAKES TWO ARGUMENTS.  ANY GOODIE AND A AN ATOMIC TYPE NAME
+;IT CHECKS THE STORAGE ALLOCATION TYPES OF THE TWO ARE THE SAME AND
+;IF THEY ARE CHANGES THE TYPE OF THE FIRST TO THAT NAME D IN THE SECOND
+
+MFUNCTION CHTYPE,SUBR
+
+	ENTRY	2
+	GETYP	A,2(AB)		;FIRST CHECK THAT ARG 2 IS AN ATOM
+	CAIE	A,TATOM	
+	JRST	NOTATOM
+	MOVE	B,3(AB)		;AND TYPE NAME
+	PUSHJ	P,TYPLOO		;GO LOOKUP TYPE
+TFOUND:	HRRZ	B,(A)		;GOBBLE THE SAT
+	TRNE	B,CHBIT		; SKIP IF CHTYPABLE
+	JRST	CANTCH
+	TRNE	B,TMPLBT	; TEMPLAT
+	HRLI	B,-1
+	AND	B,[-1,,SATMSK]
+	GETYP	A,(AB)		;NOW GET TYPE TO HACK
+	PUSHJ	P,SAT		;FIND OUT ITS SAT
+	JUMPE	A,TYPERR	;COMPLAIN
+	CAILE	A,NUMSAT
+	JRST	CHTMPL		; JUMP IF TEMPLATE DATA
+	CAIE	A,(B)		;DO THEY AGREE?
+	JRST	TYPDIF		;NO, COMPLAIN
+CHTMP1:	MOVSI	A,(D)		;GET NEW TYPE
+	HRR	A,(AB)		; FOR DEFERRED GOODIES
+	JUMPL	B,CHMATC	; CHECK IT
+	MOVE	B,1(AB)		;AND VALUE
+	JRST	FINIS
+
+CHTMPL:	MOVE	E,1(AB)		; GET ARG
+	HLRZ	A,(E)
+	ANDI	A,SATMSK
+	MOVE	0,3(AB)		; SEE IF TO "TEMPLATE"
+	CAMN	0,IMQUOTE TEMPLATE
+	JRST	CHTMP1
+	TLNN	E,-1		; SKIP IF RESTED
+	CAIE	A,(B)
+	JRST	TYPDIF
+	JRST	CHTMP1
+
+CHMATC:	PUSH	TP,A
+	PUSH	TP,1(AB)	; SAVE GOODIE
+	MOVSI	A,TATOM
+	MOVE	B,3(AB)
+	MOVSI	C,TATOM
+	MOVE	D,IMQUOTE DECL
+	PUSHJ	P,IGET		; FIND THE DECL
+	PUSH	TP,A
+	PUSH	TP,B
+	MOVE	C,(AB)
+	MOVE	D,1(AB)		; NOW GGO TO MATCH
+	PUSHJ	P,TMATCH
+	JRST	CHMAT1
+	SUB	TP,[2,,2]
+CHMAT2:	POP	TP,B
+	POP	TP,A
+	JRST	FINIS
+
+CHMAT1:	POP	TP,B
+	POP	TP,A
+	MOVE	C,-1(TP)
+	MOVE	D,(TP)
+	PUSHJ	P,TMATCH
+	JRST	TMPLVI
+	JRST	CHMAT2
+
+TYPLOO:	PUSHJ	P,TYPFND
+	ERRUUO	EQUOTE BAD-TYPE-NAME
+	POPJ	P,
+
+TYPFND:	HLRE	A,B		; FIND DOPE WORDS
+	SUBM	B,A		; A POINTS TO IT
+	HRRE	D,(A)		; TYPE-CODE TO D
+	JUMPE	D,CPOPJ
+	ANDI	D,TYPMSK	; FLUSH FUNNY BITS
+	MOVEI	A,(D)
+	ASH	A,1
+	HRLI	A,(A)
+	ADD	A,TYPVEC+1
+CPOPJ1:	AOS	(P)
+	POPJ	P,
+
+
+REPEAT 0,[	
+	MOVE	A,TYPVEC+1	;GOBBLE DOWN TYPE VECTOR
+	MOVEI	D,0		;INITIALIZE TYPE COUNTER
+TLOOK:	CAMN	B,1(A)		;CHECK THIS ONE
+	JRST	CPOPJ1
+	ADDI	D,1		;BUMP COUNTER
+	AOBJP	A,.+2		;COUTN DOWN ON VECTOR
+	AOBJN	A,TLOOK
+	POPJ	P,
+CPOPJ1:	AOS	(P)
+	POPJ	P,
+]
+
+TYPDIF:	ERRUUO	EQUOTE STORAGE-TYPES-DIFFER
+
+
+TMPLVI:	ERRUUO	EQUOTE DECL-VIOLATION
+
+
+; FUNCTION TO ADD A NEW TYPE TO THE WORLD WITH GIVEN PRIMITIVE TYPE
+
+MFUNCTION NEWTYPE,SUBR
+
+	ENTRY
+
+	HLRZ	0,AB		; CHEC # OF ARGS
+	CAILE	0,-4		; AT LEAST 2
+	JRST	TFA
+	CAIGE	0,-6
+	JRST	TMA		; NOT MORE THAN 3
+	GETYP	A,(AB)		; GET 1ST ARGS TYPE (SHOULD BE ATOM)
+	GETYP	C,2(AB)		; SAME WITH SECOND
+	CAIN	A,TATOM		; CHECK
+	CAIE	C,TATOM
+	JRST	NOTATOM
+
+	MOVE	B,3(AB)		; GET PRIM TYPE NAME
+	PUSHJ	P,TYPLOO	; LOOK IT UP
+	HRRZ	A,(A)		; GOBBLE SAT
+	ANDI	A,SATMSK
+	HRLI	A,TATOM		; MAKE NEW TYPE
+	PUSH	P,A		; AND SAVE
+	MOVE	B,1(AB)		; SEE IF PREV EXISTED
+	PUSHJ	P,TYPFND
+	JRST	NEWTOK		; DID NOT EXIST BEFORE
+	MOVEI	B,2(A)		; FOR POSSIBLE TMPLAT BIT
+	HRRZ	A,(A)		; GET SAT
+	HRRZ	0,(P)		; AND PROPOSED
+	ANDI	A,SATMSK
+	ANDI	0,SATMSK
+	CAIN	0,(A)		; SKIP IF LOSER
+	JRST	NEWTFN		; O.K.
+
+	ERRUUO	EQUOTE TYPE-ALREADY-EXISTS
+
+NEWTOK:	POP	P,A
+	MOVE	B,1(AB)		; NEWTYPE NAME
+	PUSHJ	P,INSNT		; MUNG IN NEW TYPE
+
+NEWTFN:	CAML	AB,[-5,,]	; SKIP IF TEMPLAT SUPPLIED
+	JRST	NEWTF1
+	MOVEI	0,TMPLBT	; GET THE BIT
+	IORM	0,-2(B)		; INTO WORD
+	MOVE	A,(AB)		; GET TYPE NAME
+	MOVE	B,1(AB)
+	MOVSI	C,TATOM
+	MOVE	D,IMQUOTE DECL
+	PUSH	TP,4(AB)	; GET TEMLAT
+	PUSH	TP,5(AB)
+	PUSHJ	P,IPUT
+NEWTF1:	MOVE	A,(AB)
+	MOVE	B,1(AB)		; RETURN NAME
+	JRST	FINIS
+
+; SET  UP GROWTH FIELDS
+
+IGROWT:	SKIPA	A,[111100,,(C)]
+IGROWB:	MOVE	A,[001100,,(C)]
+	HLRE	B,C
+	SUB	C,B		; POINT TO DOPE WORD
+	MOVE	B,TYPIC	; INDICATED GROW BLOCK
+	DPB	B,A
+	POPJ	P,
+
+INSNT:	PUSH	TP,A
+	PUSH	TP,B		; SAVE NAME OF NEWTYPE
+	MOVE	C,TYPBOT+1	; CHECK GROWTH NEED
+	CAMGE	C,TYPVEC+1
+	JRST	ADDIT		; STILL ROOM
+GAGN:	PUSHJ	P,IGROWB	; SETUP BOTTOM GROWTH
+	SKIPE	C,EVATYP+1
+	PUSHJ	P,IGROWT	; SET UP TOP GROWTH
+	SKIPE	C,APLTYP+1
+	PUSHJ	P,IGROWT
+	SKIPE	C,PRNTYP+1
+	PUSHJ	P,IGROWT
+	MOVE	C,[11.,,5]	; SET UP INDICATOR FOR AGC
+	PUSHJ	P,AGC		; GROW THE WORLD
+	AOJL	A,GAGN		; BAD AGC LOSSAGE
+	MOVE	0,[-101,,-100]
+	ADDM	0,TYPBOT+1	; FIX UP POINTER
+
+ADDIT:	MOVE	C,TYPVEC+1
+	SUB	C,[2,,2]	; ALLOCATE ROOM
+	MOVEM	C,TYPVEC+1
+	HLRE	B,C		; PREPARE TO BLT
+	SUBM	C,B		; C POINTS DOPE WORD END
+	HRLI	C,2(C)		; GET BLT AC READY
+	BLT	C,-3(B)
+	POP	TP,-1(B)	; CLOBBER IT IN
+	POP	TP,-2(B)
+	HLRE	C,TYPVEC+1	; GET CODE
+	MOVNS	C
+	ASH	C,-1
+	SUBI	C,1
+	MOVE	D,-1(B)		; B HAS POINTER TO TYPE VECTOR DOPE WORDS
+	MOVEI	0,(D)
+	CAIG	0,HIBOT		; IS ATOM PURE?
+	 JRST	ADDNOI		; NO, SO NO HACKING REQUIRED
+	PUSH	P,C
+	MOVE	B,D
+	PUSHJ	P,IMPURIF	; DO IMPURE OF ATOM
+	MOVE	C,TYPVEC+1
+	HLRE	B,C
+	SUBM	C,B		; RESTORE B
+	POP	P,C
+	MOVE	D,-1(B)		; RESTORE D
+ADDNOI:	HLRE	A,D
+	SUBM	D,A
+	TLO	C,400000
+	HRRM	C,(A)		; INTO "GROWTH" FIELD
+	POPJ	P,
+
+
+; Interface to interpreter for setting up tables associated with
+;	template data structures.
+;	A/	<-name of type>-
+;	B/	<-length ins>-
+;	C/	<-uvector of garbage collector code or 0>
+;	D/	<-uvector of GETTERs>-
+;	E/	<-uvector of PUTTERs>-
+
+CTMPLT:	SUBM	M,(P)		; could possibly gc during this stuff
+	PUSH	TP,$TATOM	; save name of type
+	PUSH	TP,A
+	PUSH	P,B		; save length instr
+	HLRE	A,TD.LNT+1	; check for template slots left?
+	HRRZ	B,TD.LNT+1
+	SUB	B,A		; point to dope words
+	HLRZ	B,1(B)		; get real length
+	ADDI	A,-2(B)
+	JUMPG	A,GOODRM	; jump if ok
+
+	PUSH	TP,$TUVEC	; save getters and putters
+	PUSH	TP,C
+	PUSH	TP,$TUVEC	; save getters and putters
+	PUSH	TP,D
+	PUSH	TP,$TUVEC
+	PUSH	TP,E
+	MOVEI	A,10-2(B)	; grow it 10 by copying remember d.w. length
+	PUSH	P,A		; save new length
+	PUSHJ	P,CAFRE1	; get frozen uvector
+	ADD	B,[10,,10]	; rest it down some
+	HRL	C,TD.LNT+1	; prepare to BLT in
+	MOVEM	B,TD.LNT+1	; and save as new length vector
+	HRRI	C,(B)		; destination
+	ADD	B,(P)		; final destination address
+	BLT	C,-12(B)
+	MOVE	A,(P)		; length for new getters
+	PUSHJ	P,CAFRE1
+	HRL	C,TD.GET+1	; get old for copy
+	MOVEM	B,TD.GET+1
+	PUSHJ	P,DOBLTS	; go fixup new uvector
+	MOVE	A,(P)		; finally putters
+	PUSHJ	P,CAFRE1
+	HRL	C,TD.PUT+1
+	MOVEM	B,TD.PUT+1
+	PUSHJ	P,DOBLTS	; go fixup new uvector
+	MOVE	A,(P)		; finally putters
+	PUSHJ	P,CAFRE1
+	HRL	C,TD.AGC+1
+	MOVEM	B,TD.AGC+1
+	PUSHJ	P,DOBLTS	; go fixup new uvector
+	SUB	P,[1,,1]	; flush stack craft
+	MOVE	E,(TP)
+	MOVE	D,-2(TP)
+	MOVE	C,-4(TP)			;GET TD.AGC
+	SUB	TP,[6,,6]
+
+GOODRM:	MOVE	B,TD.LNT+1	; move down to fit new guy
+	SUB	B,[1,,1]	; will always win due to prev checks
+	MOVEM	B,TD.LNT+1
+	HRLI	B,1(B)
+	HLRE	A,TD.LNT+1
+	MOVNS	A
+	ADDI	A,-1(B)		; A/ final destination
+	BLT	B,-1(A)
+	POP	P,(A)		; new length ins munged in
+	HLRE	A,TD.LNT+1
+	MOVNS	A		; A/ offset for other guys
+	PUSH	P,A		; save it
+	ADD	A,TD.GET+1	; point for storing uvs of ins
+	MOVEM	D,-1(A)
+	MOVE	A,(P)
+	ADD	A,TD.PUT+1
+	MOVEM	E,-1(A)		; store putter also
+	MOVE	A,(P)
+	ADD	A,TD.AGC+1
+	MOVEM	C,-1(A)		; store putter also
+	POP	P,A		; compute primtype
+	ADDI	A,NUMSAT
+	PUSH	P,A
+	MOVE	B,(TP)		; ready to mung type vector
+	SUB	TP,[2,,2]
+	PUSHJ	P,TYPFND	; CHECK TO SEE WHETHER TEMPLATE EXISTS
+	JRST	NOTEM
+	POP	P,C		; GET SAT
+	HRRM	C,(A)
+	JRST	MPOPJ
+NOTEM:	POP	P,A		; RESTORE SAT
+	HRLI	A,TATOM		; GET TYPE
+	PUSHJ	P,INSNT		; INSERT INTO VECTOR
+	JRST	MPOPJ
+
+; this routine copies GET and PUT vectors into new ones
+
+DOBLTS:	HRRI	C,(B)
+	ADD	B,-1(P)
+	BLT	C,-11(B)	; zap those guys in
+	MOVEI	A,TUVEC		; mung in uniform type
+	PUTYP	A,(B)
+	MOVEI	C,-7(B)		; zero out remainder of uvector
+	HRLI	C,-10(B)
+	SETZM	-1(C)
+	BLT	C,-1(B)
+	POPJ	P,
+
+
+; FUNCTIONS TO SET UP EVALUATION AND APPLICATION RULES FOR DATA TYPES
+
+MFUNCTION EVALTYPE,SUBR
+
+	ENTRY
+
+	PUSHJ	P,CHKARG	; VERIFY WINNAGE IN ARGS
+	MOVEI	A,EVATYP	; POINT TO TABLE
+	MOVEI	E,EVTYPE	; POINT TO PURE VERSION
+	MOVEI	0,EVAL
+TBLCAL:	PUSHJ	P,TBLSET	; SETUP TABLE ENTRY
+	JRST	FINIS
+
+MFUNCTION APPLYTYPE,SUBR
+
+	ENTRY
+
+	PUSHJ	P,CHKARG
+	MOVEI	A,APLTYP	; POINT TO APPLY TABLE
+	MOVEI	E,APTYPE	; PURE TABLE
+	MOVEI	0,APPLY
+	JRST	TBLCAL
+
+
+MFUNCTION PRINTTYPE,SUBR
+
+	ENTRY
+
+	PUSHJ	P,CHKARG
+	MOVEI	A,PRNTYP	; POINT TO APPLY TABLE
+	MOVEI	E,PRTYPE	; PURE TABLE
+	MOVEI	0,PRINT
+	JRST	TBLCAL
+
+; CHECK ARGS AND SETUP FOR TABLE HACKER
+
+CHKARG:	JUMPGE	AB,TFA
+	CAMGE	AB,[-5,,]
+	JRST	TMA
+	GETYP	A,(AB)		; 1ST MUST BE TYPE NAME
+	CAIE	A,TATOM
+	JRST	WTYP1
+	MOVE	B,1(AB)		; GET ATOM
+	PUSHJ	P,TYPLOO	; VERIFY THAT IT IS A TYPE
+	PUSH	P,D		; SAVE TYPE NO.
+	MOVEI	D,-1		; INDICATE FUNNYNESS
+	CAML	AB,[-3,,]	; SKIP IF 2 OR MORE
+	JRST	TY1AR
+	HRRZ	A,(A)		; GET SAT
+	ANDI	A,SATMSK
+	PUSH	P,A
+	GETYP	A,2(AB)		; GET 2D TYPE
+	CAIE	A,TATOM		; EITHER TYPE OR APPLICABLE
+	JRST	TRYAPL		; TRY APPLICABLE
+	MOVE	B,3(AB)		; VERIFY IT IS A TYPE
+	PUSHJ	P,TYPLOO
+	HRRZ	A,(A)		; GET SAT
+	ANDI	A,SATMSK
+	POP	P,C		; RESTORE SAVED SAT
+	CAIE	A,(C)		; SKIP IF A WINNER
+	JRST	TYPDIF		; REPORT ERROR
+TY1AR:	POP	P,C		; GET SAVED TYPE
+	MOVEI	B,0		; TELL THAT WE ARE A TYPE
+	POPJ	P,
+
+TRYAPL:	PUSHJ	P,APLQ		; IS THIS APPLICABLE
+	JRST	NAPT
+	SUB	P,[1,,1]
+	MOVE	B,2(AB)		; RETURN SAME
+	MOVE	D,3(AB)
+	POP	P,C
+	POPJ	P,
+
+
+; HERE TO PUT ENTRY IN APPROPRIATE TABLE
+
+TBLSET:	PUSH	TP,B
+	PUSH	TP,D		; SAVE VALUE 
+	PUSH	TP,$TFIX
+	PUSH	TP,A
+	PUSH	P,C		; SAVE TYPE BEING HACKED
+	PUSH	P,E
+	SKIPE	B,1(A)		; SKIP IF VECTOR DOESN'T EXIST YET
+	JRST	TBL.OK
+	MOVE	B,-2(TP)	; CHECK FOR RETURN IT HACK
+	SKIPN	-3(TP)
+	CAIE	B,-1
+	JRST	.+2
+	JRST	RETPM2
+	HLRE	A,TYPBOT+1	; GET CURRENT TABLE LNTH
+	MOVNS	A
+	ASH	A,-1
+	PUSH	P,0
+	PUSHJ	P,IVECT		; GET VECTOR
+	POP	P,0
+	MOVE	C,(TP)		; POINT TO RETURN POINT
+	MOVEM	B,1(C)		; SAVE VECTOR
+
+TBL.OK:	POP	P,E
+	POP	P,C		; RESTORE TYPE
+	SUB	TP,[2,,2]
+	POP	TP,D
+	POP	TP,A
+	JUMPN	A,TBLOK1	; JUMP IF FUNCTION ETC. SUPPLIED
+	CAIN	D,-1
+	JRST	TBLOK1
+	CAILE	D,NUMPRI	; SKIP IF ORIGINAL TYPE
+	MOVNI	E,(D)		; CAUSE E TO ENDUP 0
+	ADDI	E,(D)		; POINT TO PURE SLOT
+TBLOK1:	ADDI	C,(C)		; POINT TO VECTOR SLOT
+	ADDI	C,(B)
+	CAIN	D,-1
+	JRST	RETCUR
+	JUMPN	A,OK.SET	; OK TO CLOBBER
+	ADDI	B,(D)		; POINT TO TARGET TYPE'S SLOT
+	ADDI	B,(D)		; POINT TO TARGET TYPE'S SLOT
+	SKIPN	A,(B)		; SKIP IF WINNER
+	SKIPE	1(B)		; SKIP IF LOSER
+	SKIPA	D,1(B)		; SETUP D
+	JRST	CH.PTB		; CHECK PURE TABLE
+
+OK.SET:	CAIN	0,(D)		; SKIP ON RESET
+	SETZB	A,D
+	MOVEM	A,(C)		; STORE
+	MOVEM	D,1(C)
+RETAR1:	MOVE	A,(AB)		; RET TYPE
+	MOVE	B,1(AB)
+	JRST	FINIS
+
+CH.PTB:	MOVEI	A,0
+	MOVE	D,[SETZ NAPT]
+	JUMPE	E,OK.SET
+	MOVE	D,(E)
+	JRST	OK.SET
+
+RETPM2:	SUB	TP,[4,,4]
+	SUB	P,[2,,2]
+	ASH	C,1
+	SOJA	E,RETPM4
+
+RETCUR:	SKIPN	A,(C)
+	SKIPE	1(C)
+	SKIPA	B,1(C)
+	JRST	RETPRM	
+
+	JUMPN	A,CPOPJ
+RETPM1:	MOVEI	A,0
+	JUMPL	B,RTFALS
+	CAMN	B,1(E)
+	JRST	.+3
+	ADDI	A,2
+	AOJA	E,.-3
+
+RETPM3:	ADD	A,TYPVEC+1
+	MOVE	B,3(A)
+	MOVE	A,2(A)
+	POPJ	P,
+
+RETPRM:	SUBI	C,(B)		; UNDO BADNESS
+RETPM4:	CAIG	C,NUMPRI*2
+	SKIPG	1(E)
+	JRST	RTFALS
+
+	MOVEI	A,-2(C)
+	JRST	RETPM3
+
+CALLTY:	MOVE	A,TYPVEC
+	MOVE	B,TYPVEC+1
+	POPJ	P,
+
+MFUNCTION ALLTYPES,SUBR
+
+	ENTRY	0
+
+	MOVE	A,TYPVEC
+	MOVE	B,TYPVEC+1
+	JRST	FINIS
+
+;
+
+;FUNCTION TO RETURN TYPE OF ELEMENTS IN A UVECTOR
+
+MFUNCTION UTYPE,SUBR
+
+	ENTRY	1
+
+	GETYP	A,(AB)		;GET U VECTOR
+	PUSHJ	P,SAT
+	CAIE	A,SNWORD
+	JRST	WTYP1
+	MOVE	B,1(AB)		; GET UVECTOR
+	PUSHJ	P,CUTYPE
+	JRST	FINIS
+
+CUTYPE:	HLRE	A,B		;GET -LENGTH
+	HRRZS	B
+	SUB	B,A		;POINT TO TYPE WORD
+	GETYP	A,(B)
+	JRST	ITYPE		; GET NAME OF TYPE
+
+; FUNCTION TO CHANGE UNIFORM TYPE OF A VECTOR
+
+MFUNCTION CHUTYPE,SUBR
+
+	ENTRY	2
+
+	GETYP	A,2(AB)		;GET 2D TYPE
+	CAIE	A,TATOM
+	JRST	NOTATO
+	GETYP	A,(AB)		; CALL WITH UVECTOR?
+	PUSHJ	P,SAT
+	CAIE	A,SNWORD
+	JRST	WTYP1
+	MOVE	A,1(AB)		; GET UV POINTER
+	MOVE	B,3(AB)		;GET ATOM
+	PUSHJ	P,CCHUTY
+	MOVE	A,(AB)		; RETURN UVECTOR
+	MOVE	B,1(AB)
+	JRST	FINIS
+
+CCHUTY:	PUSH	TP,$TUVEC
+	PUSH	TP,A
+	PUSHJ	P,TYPLOO	;LOOK IT UP
+	HRRZ	B,(A)		;GET SAT
+	TRNE	B,CHBIT
+	JRST	CANTCH
+	ANDI	B,SATMSK
+	SKIPGE	MKTBS(B)
+	JRST	CANTCH
+	HLRE	C,(TP)		;-LENGTH
+	HRRZ	E,(TP)
+	SUB	E,C		;POINT TO TYPE
+	GETYP	A,(E)		;GET TYPE
+	JUMPE	A,WIN0		;ALLOW TYPE "LOSE" TO CHANGE TO ANYTHING
+	PUSHJ	P,SAT		;GET SAT
+	JUMPE	A,TYPERR
+	CAIE	A,(B)		;COMPARE
+	JRST	TYPDIF
+WIN0:	ADDI	D,.VECT.
+	HRLM	D,(E)		;CLOBBER NEW ONE
+	POP	TP,B
+	POP	TP,A
+	POPJ	P,
+
+CANTCH:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE CANT-CHTYPE-INTO
+	PUSH	TP,2(AB)
+	PUSH	TP,3(AB)
+	MOVEI	A,2
+	JRST	CALER
+
+NOTATOM:
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE NON-ATOMIC-ARGUMENT
+	PUSH	TP,(AB)
+	PUSH	TP,1(AB)
+	MOVEI	A,2
+	JRST	CALER
+
+
+
+; SUBROUTINE TO LEAVE MUDDLE CLOSING ALL CHANNELS ON THE WAY
+
+MFUNCTION QUIT,SUBR
+
+	ENTRY	0
+
+
+	PUSHJ	P,CLOSAL	; DO THE CLOSES
+	PUSHJ	P,%KILLM
+	JRST	IFALSE		; JUST IN CASE
+
+CLOSAL:	MOVEI	B,CHNL0+2	; POINT TO 1ST (NOT INCLUDING TTY I/O)
+	MOVE	PVP,PVSTOR+1
+	MOVE	TVP,REALTV+1(PVP)
+	SUBI	B,(TVP)
+	HRLS	B
+	ADD	B,TVP
+	PUSH	TP,$TVEC
+	PUSH	TP,B
+	PUSH	P,[N.CHNS-1]	; MAX NO. OF CHANS
+
+CLOSA1:	MOVE	B,(TP)
+	ADD	B,[2,,2]
+	MOVEM	B,(TP)
+	HLLZS	-2(B)
+	SKIPN	C,-1(B)		; THIS ONE OPEN?
+	JRST	CLOSA4		; NO
+	CAME	C,TTICHN+1
+	CAMN	C,TTOCHN+1
+	JRST	CLOSA4
+	PUSH	TP,-2(B)	; PUSH IT
+	PUSH	TP,-1(B)
+	MCALL	1,FCLOSE		; CLOSE IT
+CLOSA4:	SOSLE	(P)		; COUNT DOWN
+	JRST	CLOSA1
+
+
+	SUB	TP,[2,,2]
+	SUB	P,[1,,1]
+
+CLOSA3:	SKIPN	B,CHNL0+1
+	POPJ	P,
+	PUSH	TP,(B)
+	HLLZS	(TP)
+	PUSH	TP,1(B)
+	HRRZ	B,(B)
+	MOVEM	B,CHNL0+1
+	MCALL	1,FCLOSE
+	JRST	CLOSA3
+
+
+IMPURE
+
+WHOAMI:	0		; SYAYS WHETHER I AM REALLY A MUDDLE OR SOME HACK
+
+
+;GARBAGE COLLECTORS PDLS
+
+
+GCPDL:	-GCPLNT,,GCPDL
+
+	BLOCK	GCPLNT
+
+
+PURE
+
+MUDSTR:	ASCII /MUDDLE /
+STRNG:	-1
+	-1
+	-1
+	ASCIZ / IN OPERATION./
+
+;MARKED PDLS FOR GC PROCESS
+
+VECTGO
+; DUMMY FRAME FOR INITIALIZER CALLS
+
+	TENTRY,,LISTEN
+	0
+	.-3
+	0
+	0
+	-ITPLNT,,TPBAS-1
+	0
+
+TPBAS:	BLOCK	ITPLNT+PDLBUF
+	GENERAL
+	ITPLNT+2+PDLBUF+7,,0
+
+
+VECRET
+
+
+$TMATO:	TATOM,,-1
+
+END
+
\ No newline at end of file