TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES

RELOCA

.GLOBAL PATCH,TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE
.GLOBAL PAT,PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,SAT,CURPRI,CHFINI
.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
.GLOBAL EVATYP,EVTYPE,APLTYP,APTYPE,PRNTYP,PRTYPE,AGC,SGSNAM,NAPT,APLQ,STRTO6
.GLOBAL 6TOCHS,TYPFND,STBL,CHNL0,N.CHNS,CLOSAL,%LOGOUT,%SSNAM,%RSNAM,%KILLM
.GLOBAL MAKINF,%VALRET,COMPERR,IPUT,IGET,TMATCH,INITIZ,IPCINI,%UNAM,%JNAM,%RUNAM,%RJNAM
.GLOBAL NOTTY,PATEND,CFRAME,CARGS,CFUNCT,CITYPE,CTYPEQ,CPTYPE,CTYPEP,CUTYPE,CCHUTY
.GLOBAL RTFALS,PGINT,PURCLN,CTYPEC,CTYPEW,IDVAL1,CALLTY,MESSAG,INITFL,WHOAMI
.GLOBAL %SLEEP,%HANG,%TOPLQ,ONINT,CHUNW,CURFCN,BUFRIN,TD.LNT,TD.GET,TD.PUT,MPOPJ
.GLOBAL PURVEC,PLOAD,SSPECS,OUTRNG
.GLOBAL	TYPIC
.INSRT MUDDLE >

MONITS==1		; SET TO 1 IF PC DEMON WANTED
.VECT.==1		; BIT TO INDICATE VECTORS FOR GCHACK

;MAIN LOOP AND STARTUP

START:	MOVEI	0,0			; SET NO HACKS
	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:	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
	MOVE	TVP,TVPSTO+1(PVP)	; GET A TVP
	SETZB	R,M			; RESET RSUBR AC'S
	PUSHJ	P,%RUNAM
	PUSHJ	P,%RJNAM
	PUSHJ	P,TTYOPE		;OPEN THE TTY
	MOVEI	B,MUDSTR
	SKIPE	WHOAMI		; SKIP IF THIS IS MUDDLE
	JRST	.+3		; ELSE NO MESSAGE
	SKIPN	NOTTY			; IF NO TTY, IGNORE
	PUSHJ	P,MSGTYP		;TYPE OUT TO USER

	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	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
	MOVEM	E,-1(TB)
	JRST	CONTIN

	MQUOTE	TOPLEVEL
TOPLEVEL:
	MCALL	0,LISTEN
	JRST	TOPLEVEL


MFUNCTION 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


TPSUBR==TSUBR+400000

MFUNCTION ERROR%,PSUBR,ERROR

RMT [EXPUNGE TPSUBR
]
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(TVP)
	JRST	NOTINC
ER2:	MOVE	B,IMQUOTE INCHAN
	MOVEI	C,TTICHN(TVP)	; POINT TO VALU
	PUSHJ	P,PUSH6		; PUSH THE BINDING
	MOVE	B,TTICHN+1(TVP)	; GET IN CHAN
NOTINC:	SKIPE	NOTTY
	JRST	NOECHO
	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE 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(TVP)
	JRST	NOTOUT
ER3:	MOVE	B,IMQUOTE OUTCHAN
	MOVEI	C,TTOCHN(TVP)
	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,PVP		; 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
	MOVE	A,2(A)
	CAIE	A,ERROBL+1
	CAMN	A,ERROBL+1(TVP)	; 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
	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(TVP)
	PUSH	TP,INITIAL+1(TVP)
	PUSH	TP,ROOT(TVP)
	PUSH	TP,ROOT+1(TVP)
	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,MQUOTE 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,MQUOTE 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,MQUOTE 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


MFUNCTION 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
	MCALL	0,TERPRI
	MCALL	1,EVAL
	PUSH	TP,$TATOM
	PUSH	TP,IMQUOTE LAST-OUT
	PUSH	TP,A
	PUSH	TP,B
	MCALL	2,SET
	PUSH	TP,A
	PUSH	TP,B
	MCALL	1,PRIN1
	POP	P,C		;FLAG FOR FALL THROUGH OR CALL
	JUMPN	C,FINIS		;IN CASE LOOSER CALLED REP
	JRST	MAINLP


;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
	CAMGE	C,VECTOP	; CHECK FOR RSUBR
	CAMG	C,VECBOT
	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(TVP)
	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:	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	RETRN3

RETRN2:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE CANT-RETRY-ENTRY-GONE
	JRST	CALER1

RETRER:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE PURE-LOAD-FAILURE
	JRST	CALER1


;FUNCTION TO DO ERROR RETURN

MFUNCTION 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

MFUNCTION	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,PVP		; 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,PVP		; 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	;RETURNS FUNCTION NAME OF
	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
	CAMG	A,VECTOP	;IS THIS AN RSUBR ?
	CAMGE	A,VECBOT
	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:
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE FRAME-NO-LONGER-EXISTS
	JRST	CALER1


TOPLOSE:
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE TOP-LEVEL-FRAME
	JRST	CALER1




; ROUTINE TO HANG INDEFINITELY WITH INTERRUPTS ENABLED

MFUNCTION	HANG,SUBR

	ENTRY

	JUMPGE	AB,HANG1	; NO PREDICATE
	CAMGE	AB,[-3,,]
	JRST	TMA
REHANG:	MOVE	A,[PUSHJ P,CHKPRH]
	MOVEM	A,ONINT		; CHECK PREDICATE AFTER ANY INTERRUPT
	PUSH	TP,(AB)
	PUSH	TP,1(AB)
HANG1:	ENABLE			;LET OURSELVES BE INTERRUPTED OUT
	PUSHJ	P,%HANG
	DISABLE			;PREVENT INTERRUPTS AT RANDOM TIMES
	SETZM	ONINT
	MOVE	A,$TATOM
	MOVE	B,MQUOTE 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)
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,MQUOTE 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
	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
	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


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

MFUNCTION UNAME,SUBR

	ENTRY	0

	PUSHJ	P,%RUNAM
	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 NO ARGS AND
;IS CALLED BY PUSHJ P,. RETURNS IN A AND B A NEW PROCESS.

ICR:	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
	PUSH	TP,[PLNT]
	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)


	MOVEI	A,TPLNT		;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
	MOVEM	TVP,TVPSTO+1(C)	;AND THE GOOD OLD TRANSFER VECTOR
	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

	IRP	A,,[PVP,TVP,AB,TB,TP,SP,P,M,R]
	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

SWAPIN:
	;NOW RESTORE NEW PROCESSES AC'S

	IRP	A,,[PVP,TVP,AB,TB,TP,SP,P,M,R]
	MOVE	A,A!STO+1(PVP)
	TERMIN

	JRST	(C)		;AND RETURN




;SUBRS ASSOCIATED WITH TYPES

;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(TVP)	;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

;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:	PUSH	TP,$TATOM	;SETUP ERROR CALL
	PUSH	TP,EQUOTE TYPE-UNDEFINED
	JRST	CALER1"		;STANDARD ERROR HACKER

CITYPE:	GETYP	A,A		; GET TYPE FOR COMPILER CALL
ITYPE:	LSH	A,1		;TIMES 2
	HRLS	A  		;TO BOTH SIDES
	ADD	A,TYPVEC+1(TVP)	;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,MQUOTE 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,TYPLOO	; search type vector
	POP	P,B
	CAMN	B,MQUOTE ANY
	JRST	CTPEC1
	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,

MFUNCTION %TYPEW,SUBR,[TYPE-W]

	ENTRY

	JUMPGE	AB,TFA
	GETYP	0,(AB)
	CAIE	0,TATOM
	JRST	WTYP1
	MOVEI	D,0
	MOVE	C,MQUOTE 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
	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	CTYPW3

CTYPEW:	PUSH	P,D
	PUSHJ	P,CTYPEC	; GET CODE IN B
	POP	P,B
	HRLI	B,(D)
	MOVSI	A,TTYPEW
	POPJ	P,
	
;PRIMTTYPE  RETURNS THE TYPE ATOM OF A PRIMITIVE TYPE IN A CLASS

STBL:	REPEAT NUMSAT,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]
[PVP,PROCESS],[ASOC,ASOC],[LOCA,LOCA],[LOCS,LOCS],[LOCU,LOCU],[LOCV,LOCV]
[LOCL,LOCL],[LOCN,LOCAS],[LOCT,LOCT]]
IRP B,C,[A]
LOC STBL+S!B
MQUOTE C

.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 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,MQUOTE 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

MFUNCTION 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:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE FIRST-ELEMENT-OF-VECTOR-NOT-CODE
	JRST	CALER1

; ROUTINE TO GENERATE ENTRYY OTHER THAN FIRST TO RSUBRR

MFUNCTION 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	B,1(AB)		; RESTORE B
	JRST	MENTR2

BENTRY:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE BAD-VECTOR
	JRST	CALER1
	
; 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
	PUSHJ	P,@0		;GO TO THE PROPER SUBROUTINE
	SUBM	M,(P)		;RECONSTITUTE THE RSUBR's PC
	POPJ	P,


; ERRORS IN COMPILED CODE MAY END UP HERE

COMPERR:
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE ERROR-IN-COMPILED-CODE
	JRST	CALER1


;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"
	CAME	0,MQUOTE TEMPLATE
	CAIN	A,(B)
	JRST	CHTMP1
	JRST	TYPDIF

CHMATC:	PUSH	TP,A
	PUSH	TP,1(AB)	; SAVE GOODIE
	MOVSI	A,TATOM
	MOVE	B,3(AB)
	MOVSI	C,TATOM
	MOVE	D,MQUOTE DECL
	PUSHJ	P,IGET		; FIND THE DECL
	MOVE	C,(AB)
	MOVE	D,1(AB)		; NOW GGO TO MATCH
	PUSHJ	P,TMATCH
	JRST	TMPLVIO
	POP	TP,B
	POP	TP,A
	JRST	FINIS

TYPLOO:	PUSHJ	P,TYPFND
	JRST	.+2
	POPJ	P,
	PUSH	TP,$TATOM	;LOST, GENERATE ERROR
	PUSH	TP,EQUOTE BAD-TYPE-NAME
	JRST	CALER1

TYPFND:	MOVE	A,TYPVEC+1(TVP)	;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:	PUSH	TP,$TATOM	;MAKE ERROR MESSAGE
	PUSH	TP,EQUOTE STORAGE-TYPES-DIFFER
	JRST	CALER1


TMPLVI:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE DECL-VIOLATION
	JRST	CALER1


; 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
	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	0,SATMSK
	ANDI	A,SATMSK
	CAIN	0,(A)		; SKIP IF LOSER
	JRST	NEWTFN		; O.K.

	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE TYPE-ALREADY-EXISTS
	JRST	CALER1

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,MQUOTE 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(TVP)	; CHECK GROWTH NEED
	CAMGE	C,TYPVEC+1(TVP)
	JRST	ADDIT		; STILL ROOM
GAGN:	PUSHJ	P,IGROWB	; SETUP BOTTOM GROWTH
	SKIPE	C,EVATYP+1(TVP)
	PUSHJ	P,IGROWT	; SET UP TOP GROWTH
	SKIPE	C,APLTYP+1(TVP)
	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(TVP)	; FIX UP POINTER

ADDIT:	MOVE	C,TYPVEC+1(TVP)
	SUB	C,[2,,2]	; ALLOCATE ROOM
	MOVEM	C,TYPVEC+1(TVP)
	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)
	POPJ	P,


; Interface to interpreter for setting up tables associated with
;	template data structures.
;	A/	<-name of type>-
;	B/	<-length ins>-
;	C/	<-uvector of length code or 0>
;	D/	<-uvector of GETTERs>-
;	E/	<-uvector of PUTTERs>-

CTMPLT:	SUBM	M,(P)		; could possibly gc during this stuff
	SKIPE	C		; for now dont handle vector of length ins
	FATAL	TEMPLATE DATA WITH COMPUTED LENGTH
	PUSH	TP,$TATOM	; save name of type
	PUSH	TP,A
	PUSH	P,B		; save length instr
	HLRE	A,TD.LNT+1(TVP)	; check for template slots left?
	HRRZ	B,TD.LNT+1(TVP)
	SUB	B,A		; point to dope words
	HLRZ	B,1(B)		; get real length
	ADDM	B,A		; any room?
	JUMPG	A,GOODRM	; jump if ok

	PUSH	TP,$TUVEC	; save getters and putters
	PUSH	TP,D
	PUSH	TP,$TUVEC
	PUSH	TP,E
	MOVEI	A,6(B)		; grow it 10 by copying
	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(TVP)	; prepare to BLT in
	MOVEM	B,TD.LNT+1(TVP)	; and save as new length vector
	HRRI	C,(B)		; destination
	ADD	B,(P)		; final destination address
	BLT	C,-13(B)
	MOVE	A,(P)		; length for new getters
	PUSHJ	P,CAFRE1
	MOVE	C,TD.GET+1(TVP)	; get old for copy
	MOVEM	B,TD.GET+1(TVP)
	HRRI	C,(B)
	ADD	B,(P)
	BLT	C,-13(B)	; zap those guys in
	MOVE	A,(P)		; finally putters
	PUSHJ	P,CAFRE1
	MOVE	C,TD.PUT+1(TVP)
	MOVEM	B,TD.PUT+1(TVP)
	HRRI	C,(B)		; BLT pointer
	ADD	B,(P)
	BLT	C,-13(B)
	SUB	P,[1,,1]	; flush stack craft
	MOVE	E,(TP)
	MOVE	D,-2(TP)
	SUB	TP,[4,,4]

GOODRM:	MOVE	B,TD.LNT+1(TVP)	; move down to fit new guy
	SUB	B,[1,,1]	; will always win due to prev checks
	MOVEM	B,TD.LNT+1(TVP)
	HRLI	B,1(B)
	HLRE	A,TD.LNT+1(TVP)
	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(TVP)
	MOVNS	A		; A/ offset for other guys
	PUSH	P,A		; save it
	ADD	A,TD.GET+1(TVP)	; point for storing uvs of ins
	MOVEM	D,-1(A)
	MOVE	A,(P)
	ADD	A,TD.PUT+1(TVP)
	MOVEM	E,-1(A)		; store putter also
	POP	P,A		; compute primtype
	ADDI	A,NUMSAT
	HRLI	A,TATOM
	MOVE	B,(TP)		; ready to mung type vector
	SUB	TP,[2,,2]
	PUSHJ	P,INSNT		; insert into vector
	JRST	MPOPJ


; FUNCTIONS TO SET UP EVALUATION AND APPLICATION RULES FOR DATA TYPES

MFUNCTION EVALTYPE,SUBR

	ENTRY	2

	PUSHJ	P,CHKARG	; VERIFY WINNAGE IN ARGS
	MOVEI	A,EVATYP	; POINT TO TABLE
	MOVEI	E,EVTYPE	; POINT TO PURE VERSION
TBLCAL:	PUSHJ	P,TBLSET	; SETUP TABLE ENTRY
	JRST	FINIS

MFUNCTION APPLYTYPE,SUBR

	ENTRY	2

	PUSHJ	P,CHKARG
	MOVEI	A,APLTYP	; POINT TO APPLY TABLE
	MOVEI	E,APTYPE	; PURE TABLE
	JRST	TBLCAL


MFUNCTION PRINTTYPE,SUBR

	ENTRY	2

	PUSHJ	P,CHKARG
	MOVEI	A,PRNTYP	; POINT TO APPLY TABLE
	MOVEI	E,PRTYPE	; PURE TABLE
	JRST	TBLCAL

; CHECK ARGS AND SETUP FOR TABLE HACKER

CHKARG:	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.
	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
	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:	HRLI	A,(A)		; FOR TVP HACKING
	ADD	A,TVP		; POINT TO TVP SLOT
	PUSH	TP,B
	PUSH	TP,D		; SAVE VALUE 
	PUSH	TP,$TVEC
	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
	HLRE	A,TYPBOT+1(TVP)	; GET CURRENT TABLE LNTH
	MOVNS	A
	ASH	A,-1
	PUSHJ	P,IVECT		; GET VECTOR
	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
	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)
	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:	MOVEM	A,(C)		; STORE
	MOVEM	D,1(C)
	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

CALLTY:	MOVE	A,TYPVEC(TVP)
	MOVE	B,TYPVEC+1(TVP)
	POPJ	P,

MFUNCTION ALLTYPES,SUBR

	ENTRY	0

	MOVE	A,TYPVEC(TVP)
	MOVE	B,TYPVEC+1(TVP)
	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
	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:	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:	MOVE	B,TVP		; POINT TO XFER VECCTOR
	ADD	B,[CHNL0+2,,CHNL0+2]	; POINT TO 1ST (NOT INCLUDING TTY I/O)
	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)
	SKIPN	C,-1(B)		; THIS ONE OPEN?
	JRST	CLOSA4		; NO
	CAME	C,TTICHN+1(TVP)
	CAMN	C,TTOCHN+1(TVP)
	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(TVP)
	POPJ	P,
	PUSH	TP,(B)
	HLLZS	(TP)
	PUSH	TP,1(B)
	HRRZ	B,(B)
	MOVEM	B,CHNL0+1(TVP)
	MCALL	1,FCLOSE
	JRST	CLOSA3

; LITTLE ROUTINES USED ALL OVER THE PLACE

CRLF:	MOVEI	A,15
	PUSHJ	P,MTYO
	MOVEI	A,12
	JRST	MTYO
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,MTYO"
	JRST	MSGTY1		;AND GET NEXT CHARACTER
CPOPJ:	POPJ	P,

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


PATCH:
PAT:	BLOCK	100
PATEND:	0

END