.TITLE	RELTIM.MAC	87c26a		20-APR-81/26-Mar-87.

	.ENABL	LC


;	Author:	N. A. Bourgeois, Jr.
;		NAB Software Services, Inc.
;		PO Box 20009
;		Albuquerque, NM 87154


;	The code and information in this software is subject to
;	change without notice and should not be construed as a
;	commitment by NAB Software Services, Inc.  NAB Software
;	Services,Inc. assumes no responsibility for any errors
;	that may appear in this software.
;
;
;				NOTICE
;
;	This software is sponsored by NAB Software Services, Inc.
;	Neither NAB Software Services, Inc., nor any of their
;	employees, nor any of their contractors, subcontractors,
;	or their employees makes any warranty, express or implied,
;	or assumes any legal liability or responsibility for the
;	accuracy, completeness or usefulness of any information,
;	apparatus, product or process disclosed, or represents
;	that its use would not infringe privately owned rights.


;	THIS SOFTWARE WAS ORIGINALLY ISSUED  BY  SANDIA  NATIONAL
;	LABORATORIES,  OPERATED  FOR THE UNITED STATES DEPARTMENT
;	OF ENERGY BY SANDIA CORPORATION.
;
;				NOTICE
;
;	THIS SOFTWARE WAS ORIGINALLY  SPONSORED  BY  THE  UNITED
;	STATES GOVERNMENT.  NEITHER THE UNITED STATES GOVERNMENT
;	NOR THE UNITED STATES DEPARTMENT OF ENERGY, NOR  ANY  OF
;	THEIR   EMPLOYEES,   NOR   ANY   OF  THEIR  CONTRACTORS,
;	SUBCONTRACTORS, OR THEIR EMPLOYEES MAKES  ANY  WARRANTY,
;	EXPRESS  OR  IMPLIED,  OR ASSUMES ANY LEGAL LIABILITY OR
;	RESPONSIBILITY  FOR  THE   ACCURACY,   COMPLETENESS   OR
;	USEFULNESS  OF  ANY  INFORMATION,  APPARATUS, PRODUCT OR
;	PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD  NOT
;	INFRINGE PRIVATELY OWNED RIGHTS.
;
;	THIS WORK WAS ORIGINALLY FUNDED BY:
;
;		    HEADQUARTERS, ESD / OCB / STOP 36
;		    HANSCOM AIR FORCE BASE, MA 01731


.SBTTL	EDIT RECORD			20-APR-81/26-Mar-87.

;22-APR-81	ORIGINAL CREATION.
;16-JUN-81	CORRECTED TYPO'S IN DESCRIPTION.
;30-JUL-81	ADDED THE "DOIT5" SUBROUTINE AND REVISED THE "IRLINT"
;		 ROUTINE.  REVISED THE ERROR RETURN CODING IN THE
;		 SUPPORTING SUBROUTINES.
;26-FEB-82	ADDED IDENTIFICATION CODE.
;04-MAR-82	ADDED THE "TKCTL" AND "RLCTL" ROUTINES.
;25-MAR-82	ADDED THE "STPRLV" ROUTINE.
;18-APR-83	ADDED THE "MPRGN" ROUTINE.
;06-Jan-84	Maintenance assumed by NAB Software Services, Inc.
;28-Jan-84	Added the ICNRTN, ITCRTN, and DOIT7 routines.
;08-Aug-84	Corrected stack pointer problems in the DOIT5 and
;		 DOIT7 routines.
;03-Oct-84	Minor revision for V5.1.
;26-Feb-86	Revised for V6.0.  Changed CNVAPA description and
;		 DOIT subroutine.  Changed the IBICIO, IBISIO, ICNINT,
;		 ICNRTN, IPEKIO, IPOKIO, IRLINT, IUNLKM, LKANMY,
;		 LKLOMY, MPIOPS, MPRMPS, and MPRGN routine descriptions.
;26-Mar-87	Revised for V6.2.  Added NAB Software disclaimer.
;		 Revised description for MPRGN routine.  Revised code
;		 for DOIT6 subroutine.
.PAGE
.SBTTL	DESCRIPTION			20-APR-81/26-Mar-87.

;THESE REAL-TIME PROGRAM SUPPORT ROUTINES ARE CALLABLE AS
;SUBROUTINES.  Some OF THEM ARE ALSO CALLABLE AS FUNCTIONS.  THIS
;MODULE IS A PART OF THE LIBRARY OF FORTRAN CALLABLE TSX/TSX-PLUS
;EMT ROUTINES.

;CONVERT A VIRTUAL ADDRESS TO A PHYSICAL ADDRESS.
;
;CALLING SEQUENCE:
;
;	CALL CNVAPA ( IVADR , IPADR [ , IERR ] )
;
;	WHERE:	IVADR	IS THE VIRTUAL ADDRESS THAT IS TO BE
;			CONVERTED.
;
;		IPADR	IS THE TWO ELEMENT BUFFER INTO WHICH THE
;			PHYSICAL ADDRESS IS RETURNED.

;PEEK AT THE I/O PAGE.
;
;CALLING SEQUENCE:
;
;	CALL IPEKIO ( IADR , IRET [ , IERR ] )
;
;	WHERE:	IADR	IS THE ADDRESS OF THE WORD IN THE I/O PAGE TO
;			BE ACCESSED.
;
;		IRET	IS THE VALUE RETURNED FROM THE I/O PAGE.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "MEMMAP" PRIVILEGE.

;POKE INTO THE I/O PAGE.
;
;CALLING SEQUENCES:
;
;	CALL IPOKIO ( IADR , IVAL , [ ,IERR ] )
;			OR
;	IERR = IPOKIO ( IADR , IVAL )
;
;	WHERE:	IADR	IS THE ADDRESS OF THE WORD IN THE I/O PAGE TO
;			BE ACCESSED.
;
;		IVAL	IS THE VALUE TO BE DEPOSITED INTO THE I/O
;			PAGE.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "MEMMAP" PRIVILEGE.

;BIT-SET A VALUE INTO THE I/O PAGE.
;
;CALLING SEQUENCES:
;
;	CALL IBISIO ( IADR , IVAL [ , IERR ] )
;			OR
;	IERR = IBISIO ( IADR , IVAL )
;
;	WHERE:	IADR	IS THE ADDRESS OF THE WORD IN THE I/O PAGE TO
;			BE ACCESSED.
;
;		IVAL	IS THE VALUE TO BE BIT-SET INTO THE I/O PAGE.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "MEMMAP" PRIVILEGE.

;BIT-CLEAR A VALUE IN THE I/O PAGE.
;
;CALLING SEQUENCES:
;
;	CALL IBICIO ( IADR , IVAL [ , IERR ] )
;			OR
;	IERR = IBICIO ( IADR , IVAL )
;
;	WHERE:	IADR	IS THE ADDRESS OF THE WORD IN THE I/O PAGE TO
;			BE ACCESSED.
;
;		IVAL	IS THE VALUE TO BE BIT-CLEARED IN THE I/O
;			PAGE.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "MEMMAP" PRIVILEGE.

;MAP THE I/O PAGE INTO THE PROGRAM SPACE.
;
;CALLING SEQUENCEs:
;
;	CALL MPIOPS ( [ IERR ] )
;		or
;	IERR = MPIOPS
;
;	where:	IERR	is negative or the following:
;
;			0	job does not have MEMMAP privilege or
;				real time support is not available on
;				the system.

;MAP THE SIMULATED RMON INTO THE PROGRAM SPACE.
;
;CALLING SEQUENCEs:
;
;	CALL MPRMPS ( [ IERR ] )
;		or
;	IERR = MPRMPS
;
;	where:	IERR	is negative or the following:
;
;			0	job does not have MEMMAP privilege or
;				real time support is not available on
;				the system.

;LOCK A JOB INTO LOW MEMORY.
;
;CALLING SEQUENCES:
;
;	CALL LKLOMY [ IERR ]
;		OR
;	IERR = LKLOMY
;
;	WHERE:	IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "PSWAPM" PRIVILEGE.

;LOCK A JOB INTO ANY MEMORY.
;
;CALLING SEQUENCES:
;
;	CALL LKANMY [ IERR ]
;		OR
;	IERR = LKANMY
;
;	WHERE:	IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "PSWAPM" PRIVILEGE.

;UNLOCK A JOB FROM MEMORY.
;
;CALLING SEQUENCES:
;
;	CALL IUNLKM

;CONNECT AN INTERRUPT TO A COMPLETION ROUTINE.
;
;CALLING SEQUENCES:
;
;	CALL ICNINT ( IVEC , CPLRTN , IPRI [ , IERR ] )
;			OR
;	IERR = ICNINT ( IVEC , CPLRTN , IPRI )
;
;	WHERE:	IVEC	IS THE ADDRESS OF THE INTERRUPT VECTOR.
;
;		CPLRTN	IS THE NAME OF THE COMPLETION ROUTINE.
;
;		IPRI	IS THE EXECUTION PRIORITY FOR THE COMPLETION
;			ROUTINE.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "REALTIME" PRIVILEGE.
;
;			1	MAXIMUM NUMBER OF INTERRUPTS ARE
;				ALREADY IN USE.
;
;			2	SOME OTHER JOB IS ALREADY CONNECTED TO
;				THE INTERRUPT.
;
;			3	the job is not locked into memory.

;RELEASE AN INTERRUPT CONNECTION.
;
;CALLING SEQUENCE:
;
;	CALL IRLINT ( IVEC )
;
;	WHERE:	IVEC	IS THE INTERRUPT VECTOR ADDRESS

;TAKE EXCLUSIVE CONTROL OF THE SYSTEM.
;
;CALLING SEQUENCE:
;
;	CALL TKCTL

;RELINQUISH EXCLUSIVE CONTROL OF THE SYSTEM.
;
;CALLING SEQUENCE:
;
;	CALL RLCTL

;SET THE USER MODE PROCESSOR PRIORITY LEVEL
;
;CALLING SEQUENCE:
;
;	CALL STPRLV ( IPRLVL )
;
;	WHERE:	IPRLVL	IS THE DESIRED USER MODE PROCESSOR PRIORITY
;			LEVEL.

;MAP A REGION OF VIRTUAL MEMORY TO A SPECIFIED REGION OF PHYSICAL MEMORY.
;
;CALLING SEQUENCES:
;
;	CALL MPRGN ( IPAR , IPAD , ISIZ , IACS , ICBF [ , IERR ] )
;				OR
;	IERR = MPRGN ( IPAR , IPAD , ISIZ , IACS , ICBF )
;
;	WHERE:	IPAR	IS ONE OF THE FOLLOWING PAGE ADDRESS REGISTER
;			(PAR) NUMBERS INDICATING THE BEGINNING OF THE
;			VIRTUAL ADDRESS REGION TO BE MAPPED:
;
;			PAR	VIRTUAL REGION
;			0	000000-017777
;			1	020000-037777
;			2	040000-057777
;			3	060000-077777
;			4	100000-117777
;			5	120000-137777
;			6	140000-157777
;			7	160000-177777
;
;		IPAD	IS THE PHYSICAL ADDRESS DEVIDED BY 100 (OCTAL)
;			TO WHICH THE VIRTUAL ADDRESS IS TO BE MAPPED.
;
;		ISIZ	IS THE NUMBER OF 100-BYTE (OCTAL) PAGES TO BE
;			MAPPED.  IF ZERO ALL PAR MAPPING IS RESTORED
;			TO NORMAL.
;
;		IACS	INDICATES THE READ/WRITE ACCESS OF THE MAPPED
;			REGION AS FOLLOWS:
;
;			0	READ ONLY.
;			1	READ AND WRITE.
;
;		ICBF	is a cache bypass flag.  If zero cache is
;			enabled, and if one cache is disabled.
;
;		IERR	IS NEGATIVE OR AS FOLLOWS:
;
;			0	REAL-TIME SUPPORT IS NOT AVAILABLE OR
;				JOB DOES NOT HAVE "MEMMAP" PRIVILEGE.

;Connect a service routine to an interrupt.
;
;Calling sequences:
;
;	CALL ICNRTN ( IVEC , IRTN , 0 [ , IERR ] )
;			or
;	IERR = ICNRTN ( IVEC , IRTN, 0 )
;
;	where:	IVEC	is the address of the interrupt vector.
;
;		IRTN	is the name of the service routine.
;
;		IERR	is negative or as follows:
;
;			0	real time support is not included
;				in the system or the job does not
;				have REALTIME privilege.
;
;			1	no interrupt control blocks are
;				available.
;
;			2	another job is connected to the
;				interrupt.
;
;			3	the job is not locked in memory.

;Trigger a completion routine from an interrupt service routine.
;
;Calling sequence:
;
;	CALL ITCRTN ( CPLRTN , IPRI , ID, 0 )
;
;	where:	CPLRTN	is the name of the completion routine.
;
;		IPRI	is the execution priority for the completion
;			routine in the range of 0 through 7.
;
;		ID	is an identification integer passed to the
;			completion routine.
.PAGE
.SBTTL	DIRECTIVES			20-APR-81/26-Mar-87.

	.IDENT	\87c26a\	;TELL LINKER OUR VERSION
	.PSECT	TSXLIB
	.GLOBL	TSLBID
	.WORD	TSLBID
	.DSABL	GBL


.SBTTL	ASSIGNMENTS			20-APR-81/30-JUL-81.

	ERRBYT	= 52		;ERROR CODE LOCATION
	NOERR	= -1		;CODE FOR NO ERROR
.PAGE
.SBTTL	ENTRY POINTS			20-APR-81/21-Jan-84.

;CONVERT A VIRTUAL ADDRESS TO A PHYSICAL ADDRESS.
;
CNVAPA::MOV	#140	,R1		;EMT CODE
	CLR	R2			;EMT ID
	JSR	PC	,DOIT		;CONVERT THE ADDRESS
	RTS	PC

;PEEK AT THE I/O PAGE.
;
IPEKIO::MOV	#140	,R1		;EMT CODE
	MOV	#1	,R2		;EMT ID
	JSR	PC	,DOIT1		;PEEK AT THE PAGE
	RTS	PC

;POKE INTO THE I/O PAGE.
;
IPOKIO::MOV	#140	,R1		;EMT CODE
	MOV	#2	,R2		;EMT ID
	JSR	PC	,DOIT2		;POKE INTO THE PAGE
	RTS	PC

;BIT-SET A VALUE INTO THE I/O PAGE.
;
IBISIO::MOV	#140	,R1		;EMT CODE
	MOV	#3	,R2		;EMT ID
	JSR	PC	,DOIT2		;BIT-SET THE VALUE
	RTS	PC

;BIT-CLEAR A VALUE IN THE I/O PAGE.
;
IBICIO::MOV	#140	,R1		;EMT CODE
	MOV	#4	,R2		;EMT ID
	JSR	PC	,DOIT2		;BIT-CLEAR THE VALUE
	RTS	PC

;MAP THE I/O PAGE INTO THE PROGRAM SPACE.
;
MPIOPS::MOV	#140	,R1		;EMT CODE
	MOV	#5	,R2		;EMT ID
	JSR	PC	,DOIT3		;MAP THE PAGE
	RTS	PC

;MAP THE SIMULATED RMON INTO THE PROGRAM SPACE.
;
MPRMPS::MOV	#140	,R1		;EMT CODE
	MOV	#6	,R2		;EMT ID
	JSR	PC	,DOIT3		;MAP THE RMON
	RTS	PC

;LOCK A JOB INTO LOW MEMORY.
;
LKLOMY::MOV	#140	,R1		;EMT CODE
	MOV	#7	,R2		;EMT ID
	JSR	PC	,DOIT3		;LOCK THE JOB
	RTS	PC

;LOCK A JOB INTO ANY MEMORY.
;
LKANMY::MOV	#140	,R1		;EMT CODE
	MOV	#13	,R2		;EMT ID
	JSR	PC	,DOIT3		;LOCK THE JOB
	RTS	PC

;UNLOCK A JOB FROM MEMORY.
;
IUNLKM::MOV	#140	,R1		;EMT CODE
	MOV	#10	,R2		;EMT ID
	JSR	PC	,DOIT3		;UNLOCK THE JOB
	RTS	PC

;CONNECT AN INTERRUPT TO A COMPLETION ROUTINE.
;
ICNINT::MOV	#140	,R1		;EMT CODE
	MOV	#11	,R2		;EMT ID
	JSR	PC	,DOIT4		;CONNECT THE INTERRUPT
	RTS	PC

;RELEASE AN INTERRUPT CONNECTION.
;
IRLINT::MOV	#140	,R1		;EMT CODE
	MOV	#12	,R2		;EMT ID
	JSR	PC	,DOIT5		;RELEASE THE CONNECTION
	RTS	PC

;TAKE EXCLUSIVE CONTROL OF THE SYSTEM.
;
TKCTL::	MOV	#140	,R1		;EMT CODE
	MOV	#14	,R2		;EMT ID
	JSR	PC	,DOIT3		;TAKE CONTROL
	RTS	PC

;RELINQUISH EXCLUSIVE CONTROL OF THE SYSTEM.
;
RLCTL::	MOV	#140	,R1		;EMT CODE
	MOV	#15	,R2		;EMT ID
	JSR	PC	,DOIT3		;RELINQUISH CONTROL
	RTS	PC

;SET THE USER MODE PROCESSOR PRIORITY LEVEL.
;
STPRLV::MOV	#140	,R1		;EMT CODE
	MOV	#16	,R2		;EMT ID
	JSR	PC	,DOIT5		;SET THE LEVEL
	RTS	PC

;MAP A REGION OF VIRTUAL MEMORY TO PHYSICAL MEMORY.
;
MPRGN::	MOV	#140	,R1		;EMT CODE
	MOV	#17	,R2		;EMT ID
	JSR	PC	,DOIT6		;MAP THE REGION
	RTS	PC

; Connect a service routine to an interrupt vector.
;
ICNRTN::MOV	#140	,R1		;EMT code
	MOV	#20	,R2		;EMT id
	CALL	DOIT4			;make the connection
	RETURN

; Trigger a completion routine from an interrupt service routine.
;
ITCRTN::MOV	#140	,R1		;EMT code
	MOV	#21	,R2		;EMT id
	CALL	DOIT7			;trigger the routine
	RETURN
.PAGE
.SBTTL	SUPPORTING SUBROUTINES		20-APR-81/26-Mar-87.

DOIT:	MOV	4(R5)	,-(SP)		;SA FOR AGGUMENT 2
	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	EMT	375			;LET TSX DO IT
	ADD	#6	,SP		;FIX THE STACK POINTER
	RTS	PC

DOIT1:	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET CODE
1$:	MOV	R0	,@4(R5)		;RETURN ARGUMENT 2
	CMPB	#3	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV	R1	,@6(R5)		; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	CMP	(SP)+	,(SP)+		;FIX THE STACK POINTER
	RTS	PC

DOIT2:	MOV	@4(R5)	,-(SP)		;PASS ARGUMENT 2
	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET CODE
1$:	CMPB	#3	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV	R1	,@6(R5)		; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	ADD	#6	,SP		;FIX THE STACK POINTER
	RTS	PC

DOIT3:	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET CODE
1$:	CMPB	#1	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV	R1	,@2(R5)		; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	TST	(SP)+			;FIX THE STACK POINTER
	RTS	PC

DOIT4:	MOV	@6(R5)	,-(SP)		;PASS ARGUMENT 3
	MOV	4(R5)	,-(SP)		;PASS ARGUMENT 2
	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET CODE
1$:	CMPB	#4	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV	R1	,@10(R5)	; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	ADD	#10	,SP		;FIX THE STACK POINTER
	RTS	PC

DOIT5:	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET CODE
1$:	CMPB	#2	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV R1	,@4(R5)			; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	CMP	(SP)+	,(SP)+		;FIX THE STACK POINTER
	RTS	PC

DOIT6:	MOV	@10(R5)	,-(SP)		;lo byte = PASS ARGUMENT 4
	MOV	SP	,R0		;hi byte =
	MOVB	@12(R5)	,1(R0)		; argument 5
	MOV	@6(R5)	,-(SP)		;PASS ARGUMENT 3
	MOV	@4(R5)	,-(SP)		;PASS ARGUMENT 2
	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1
	MOV	R2	,-(SP)		;LO BYTE = EMT ID
	MOV	SP	,R0		;EMT POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	MOV	#NOERR	,R1		;NO ERROR CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R1			; IF ERROR
	MOVB	@#ERRBYT,R1		;  GET THE CODE
1$:	CMPB	#5	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	2$			; NO
	MOV	R1	,@14(R5)	; YES
2$:	MOV	R1	,R0		;FUNCTION ERROR RETURN
	ADD	#12	,SP		;FIX THE STACK POINTER
	RTS	PC

DOIT7:	MOV	10(R5)	,-(SP)		;pass argument 4
	MOV	@6(R5)	,-(SP)		;pass argument 3
	MOV	@4(R5)	,-(SP)		;pass argument 2
	MOV	@2(R5)	,-(SP)		;pass argument 1
	MOV	R2	,-(SP)		;lo byte = EMT id
	MOV	SP	,R0		;EMT pointer
	MOVB	R1	,1(R0)		;hi byte = EMT code
	MOV	#NOERR	,R1		;no error code
	EMT	375			;let TSX do it
	ADD	#12	,SP		;fix the stack pointer
	RETURN


.SBTTL	END				20-APR-81/.

	.END