.TITLE	SUBTASK
	.IDENT	/V003.0/
;
;	AUTHOR:	MARK F. LEWIS, FEDERAL AVIATION ADMINISTRATION
;
;	CREATION DATE: 21-MAR-78
; 
;	REVISION DATE		CHANGE
;	-------- ----		------
;
;	30-JUN-78		CHANGE IN CHKEV FOR VERSION 3.0
;	13-OCT-78		ADD ERROR RETURNS AND ADDITIONAL
;				ENTRY POINTS FOR VERSION 3.0
;				(YES, 13-OCT-78 WAS A FRIDAY. THIS HAS
;				NO EFFECT ON THE INTEGRITY OF THE CODE.)
;	18-OCT-78		FIXED ERRORS MADE ON 13-OCT-78
;	10-JAN-79		EXIT RETURN ADDED TO RDEVTS
;	 5-MAR-79		ADD SUBTSK PARAMETER TO RSUM$T,
;				AND IMAX PARAMETER TO TDPRIV,
;				AND REMOVED SOME REDUNDANCIES.
;
; COPYRIGHT (C) NOT-AT-ALL
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ON ANY
; COMPUTER SYSTEM AND MAY BE COPIED WITH OR WITHOUT THE INCLUSION
; OF THIS NOTICE.  THIS SOFTWARE, OR ANY OTHER
; COPIES THEREOF, MAY BE PROVIDED OR OTHERWISE MADE AVAILABLE
; TO ANY OTHER PERSON. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN THE PUBLIC DOMAIN.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY THE AUTHOR,
; THE FEDERAL AVIATION ADMINISTRATION, THE DEPARTMENT OF TRANSPORTATION,
; OR ANY FEDERAL OR NON-FEDERAL GOVERNMENT. I UNDERSTAND THE DIGITAL
; EQUIPMENT CORPORATION CAN'T BE BLAMED EITHER.
;
; THE AUTHOR ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF THIS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY SOMEONE.
;

	.SBTTL	INTRODUCTION
;
; THESE SUBROUTINES PERMIT THE FORTRAN PROGRAMMER TO TAKE ADVANTAGE
; OF THE FACILITIES OFFERRED BY THE TIME-SHARING CONTROL SERVICES.
; EACH ROUTINE IS SELF-DOCUMENTING. WHERE NECESSARY, EXPLANATORY NOTES
; HAVE BEEN ADDED TO CLARIFY THE RELATIONSHIPS AMONG THE VARIOUS ROUTINES.
;
; IT IS ASSUMED THAT THE USER HAS READ THE "IAS GUIDE TO WRITING COMMAND
; LANGUAGE INTERPRETERS."
; THESE ROUTINES WERE DEVELOPED UNDER IAS-11 V3.0 AND USE SHOULD BE
; RESTRICTED TO THAT RELEASE. IN PARTICULAR, USE WITH SUCCEEDING RELEASES
; SHOULD BE ATTEMPTED ONLY AFTER EXTENSIVE TESTING.
;
; AN ATTEMPT WAS MADE TO MODULARIZE SERVICES AS MUCH AS POSSIBLE SO THAT
; EACH ROUTINE REPRESENTS A SINGLE FUNCTION. THE USER MAY WISH TO COMBINE
; SEVERAL ROUTINES INTO A SINGLE MUTLI-FUNCTION ROUTINE. CHKEV, CHKEVW,
; CHKALL, AND WTEREV ARE OBVIOUS CANDIDATES FOR COMBINATION.
;
; THE MEMORY-CONSCIOUS USER MAY WISH TO BREAK OUT THOSE ROUTINES NOT TIED TO
; THE COMMON DATA SECTION SO THAT SEVERAL INDEPENDENT SUBROUTINES ARE CREATED
; THAT MAY BE USED IN A LIBRARY.
;
; PLEASE NOTIFY ME OF ANY PROBLEMS EXPERIENCED  WITH THESE ROUTINES.
; IF POSSIBLE, SUPPLY COPIES OF THE OFFENDING PROGRAM, THE RESULTS OF RUNNING
; SAME, AND ANY CHANGES MADE TO THIS CODE.
;
; NOTE THAT THIS IS VERSION 3. VERSIONS 1 [OF WHICH ONLY THREE ROUTINES
; (CHAIN, SENTS, & RECV) WERE MADE PUBLIC] AND 2 ARE NOW OBSOLETE.
;
;	MARK F. LEWIS
;	FEDERAL AVIATION ADMINISTRATION
;	AAC-118
;	MIKE MONRONEY AERONAUTICAL CENTER
;	P.O. BOX 25082
;	OKLAHOMA CITY, OK 73125
;
;	13-OCT-78

 	.SBTTL	COMMON DATA SECTION
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ESB'S
;
; THE PURPOSE OF THIS SECTION IS TO HOUSE THE NECESSARY TDB'S, SDB'S
; AND  ESB'S. POINTERS TO THESE STRUCTURES ARE ALSO MAINTAINED HERE.
; THE BASIC DESIGN OF THE SUBROUTINES KEEPS THESE STRUCTURES AT ARM'S
; LENGTH FROM THE CALLER TO MINIMIZE THE CHANCE OF CORRUPTION BY
; IMPROPER USE.
;
	.MCALL	TCSMC$, RETURN
	TCSMC$
	.EVEN
	.MACRO	PUSH	X
	.IRP	Y,<X>
	MOV	Y,-(SP)
	.ENDR
	.ENDM
	.MACRO	POP	X
	.IRP	Y,<X>
	MOV	(SP)+,Y
	.ENDR
	.ENDM
;+
; DEFINE MAXIMUM NUMBER OF TDB'S AND SDB'S HANDLED
; THIS IS ONLY PARAMETER IN THE SOURCE. IF CHANGED, ONLY ROUTINE
; CHKALL NEED BE EDITED.
	MAXTD = 3	;SHOULD BE ENOUGH FOR MOST APPLICATIONS
;-
	.MACRO 	TABLE	
	DX=0
	.REPT MAXTD
	ENT	\DX
	DX=DX+1
	.ENDR
	.EVEN
	.ENDM
;
	.MACRO	ENT	DX
;
;
	.PSECT	$IDATA,D
TDB'DX:	TDBDF$
	TDCM$A
SDB'DX:	SDBDF$
ESB'DX:	ESBDF$
	.ENDM
;
	.MACRO	DTABL	SYM
	BX=0
	.REPT	MAXTD
	ENX	SYM,\BX
	BX=BX+1
	.ENDR
	.ENDM
;
	.MACRO	ENX	SYM,BX
	.WORD	SYM'BX
	.ENDM
;
	TABLE
TDB:	DTABL	TDB
SDB:	DTABL	SDB
ESB:	DTABL	ESB
	.EVEN
	.PSECT	$CODE1,RO

	.SBTTL	RUNTS
;
; FORTRAN-CALLABLE SUBROUTINE TO RUN A TIME-SHARED TASK,
; OPTIONALLY SEND A MESSAGE IT, AND OPTIONALLY WAIT FOR A SUBTASK EVENT
; OR STOP UNTIL A SUBTASK EVENT.
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE--
;   CALL RUNTS(TASKNAME [,NTDB] [,ITYP] [,MESS] [,IWAIT] [,IERR])
;
;   	TASKNAME - VALID COMMAND LINE FOR SUBTASK
;		 - LAST BYTE MUST BE ZERO. (SET AUTOMATICALLY BY
;		   F4P FOR LITERALS).
;
;	NTDB     - ORDINAL NUMBER OF SUBTASK
;		   NTDB RANGES FROM 1 (DEFAULT) TO MAXTD.
;
;   	ITYP     - OPTIONAL ARGUMENT SPECIFYING TYPE OF TASK.
;   	         = 1 (DEFAULT) COMMAND IS FILENAME OF TASK TO
;   		   BE AUTO-INSTALLED AND REMOVED
;		   NOTE:FIRST CHAR OF TASKNAME MUST BE A SPACE
;	           FOR ITYP=1
;   	         = 2 COMMAND IS FOR MCR TASK (...XYZ)
;   	         = 3 COMMAND IS FOR SYSTEM LIBRARY TASK ($$$XYZ)
;   	         = 4 COMMAND IS FOR AN INSTALLED TASK (UP TO 6 CHARACTERS)
;
;   	MESS     - OPTIONAL ARGUMENT SPECIFYING THE ADDRESS OF A MESSAGE
;   	           TO BE SENT TO THE SUBTASK. DEFAULT IS NO MESSAGE.
;   	           NOTE THAT THE FIRST WORD OF THE MESSAGE MUST CONTAIN
;   	           THE LENGTH, IN BYTES, OF THE MESSAGE, WHICH MUST START
;   	           AT ADRRESS MESS+2
;
;	IWAIT    - AN OPTIONAL ARGUMENT WHICH, IF NON-NULL, INDICATES
;		   THAT THE CALLING TASK WISHES TO WAIT FOR THE SUBTASK
;		   TO CAUSE AN EVENT (IWAIT.EQ.0) OR TO STOP UNTIL THE SUBTASK
;		   EVENT (IWAIT.NE.0).
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.MJA	ATTEMPT TO EXCEED MAX. NO. TASKS
;			PE.ABO	PE.TDB	TDB NOT DECLARED OR IN USE
;			PE.ABO	PE.TSE	ERROR IN COMMAND LINE (LENGTH)
;			PE.ABO	   0	ERROR IN COMMAND LINE - INAVLID FILE
;
;
	.EVEN
RUNTS::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;INVALID ARGUMENT LIST
	INC	R5
	MOV	(R5)+,R0	;ADDRESS OF STRING TO R0
	BLE	99$		;INVALID ARGUMENT
4$:	CMP	#2,R2		;AT LEAST TWO ARGUMENTS?
	BGT	20$		;NO -- USE DEFAULT
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R4	;SET TDB
	MOV	R0,T.CMDA(R4)	;SET ADDRESS OF STRING IN TDB
	CLR	R1		;INITIALIZE CHARACTER COUNT
2$:	TSTB	(R0)+		;CHAR.EQ.0?
	BEQ	3$		;YES, STOP COUNTING
	INC	R1		;NO. COUNT IT
	BR	2$		;LOOP TILL ZERO FOUND
3$:	CMP	#3,R2		;THREE OR MORE ARGUMENTS?
	BGT	5$		;NO -- USE DEFAULT TYPE
	MOV	(R5)+,R0	;ADDRESS OF TYPE
	BLE	5$		;USE DEFAULT
	MOV	(R0),R0		;TYPE
	CMP	#1,R0		;TYPE 1?
	BEQ	5$		;YES
	CMP	#2,R0		;TYPE 2?
	BNE	6$		;NO
	MOVB	#TS.DOT,T.TTYP(R4) ;SET TYPE
	BR	11$
6$:	CMP	#3,R0		;TYPE 3?
	BNE	7$		;NO
	MOVB	#TS.DOL,T.TTYP(R4) ;SET TYPE
	BR	11$
7$:	CMP	#4,R0		;TYPE 4?
	BNE	5$		;NO!! TRY DEFAULT
	MOVB	#TS.INS,T.TTYP(R4) ;SET TYPE
	BR	11$
5$:	MOVB	#TS.USE,T.TTYP(R4)
11$:	MOVB	R1,T.CMDL(R4)
; IS THERE A MESSAGE TO SEND?
	CMP	#4,R2		;IS MESSAGE BUFFER SPECIFIED?
	BGT	12$		;NO
	MOV	(R5)+,R0	;ADDRESS OF MESSAGE BUFFER
	BLE	12$		;NULL
				;TEST FOR LENGTH TOO BIG DELETED.
				;ERROR RETURN FROM MACRO WILL TELL HIM.
	MOV	SDB(R3),R3
	MOV	R0,T.SNDA(R3)
	BR	70$
12$:	CMP	#5,R2		;FIVE ARGUMENTS?
	BGT	15$		;NO
	MOV	(R5)+,R1	;IWAIT ADDRESS TO R1
	BLT	15$		;IWAIT IS NULL
	MOV	(R1),R1		;IWAIT TO R1
	BEQ	13$		;IWAIT = 0 MEANS WAIT
	RUN$T	R4,,,,,STOP
	BR	99$
13$:	RUN$T	R4,,,,,WAIT
	BR	99$
15$:	RUN$T	R4		;RUN SUBTASK
99$:
	CMP	#6,R2		;SIX ARGUMENTS
	BNE	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOV	T.TESB(R4),R4	;ESB TO R4
	MOVB	T.ERR(R4),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R4),(R2);ERROR QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN
70$:	TDPR$R	R4,#JP.PI,#PR.CHN	;ENABLE SEND/RECV PRIV
	CMP	#5,R2		;5 ARGS?
	BGT	75$		;NO
	MOV	(R5)+,R1	;IWAIT ADDRESS TO R1
	BLT	75$		;IWAIT IS NULL
	MOV	(R1),R1		;IWAIT
	BEQ	73$		;IWAIT 0 IS WAIT
	RUN$T	R4,,,,R3,STOP
	BR	99$
75$:	RUN$T	R4,,,,R3
	BR	99$
73$:	RUN$T	R4,,,,R3,WAIT
	BR	99$


	.SBTTL	ABORTS
;
; FORTRAN CALLABLE SUBROUTINE TO ABORT A TIMESHARING SUBTASK
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE
;   CALL ABORTS(NTDB [,IERR])
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.NTA	TASK NOT ACTIVE
;
;
;
;
	.EVEN
ABORTS::
	PUSH	<R0,R1,R2> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	20$		;NO ARGS. USE DEFAULT
	INC	R5
	MOV	(R5)+,R1	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R1),R1		;NTDB
	CMP	#MAXTD,R1	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R1
	ASL	R1		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R1		;SET TO DEFAULT
21$:	MOV	TDB(R1),R0	;SET TDB
	ABRT$T
99$:	CMP	#2,R2		;TWO ARGUMENTS
	BNE	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOV	T.TESB(R0),R0	;ESB TO R0
	MOVB	T.ERR(R0),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R0),(R2);ERROR QUALIFIER
100$:	POP	<R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	CHKEV
;
; FORTRAN CALLABLE SUBROUTINE TO CHECK TASK EVENTS
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL CHKEV(ISTAT, NTDB [,IERR])
;
;	ISTAT - STATUS
;	      = -1 NO EVENTS HAVE OCCURRED
;	      = SET EQUAL TO NTDB IF TASK EVENT OCCURRED.
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
;
;
;
	.EVEN
CHKEV::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R1	;NUMBER OF ARGUMENTS
	BLE	99$		;RETURN -- NO ARGUMENTS
	INC	R5
	MOV	(R5)+,R4	;ADDRESS OF ISTAT
	CMP	#2,R1		;TWO OR MORE ARGS?
	BGT	10$		;NO
	MOV	(R5)+,R3		;NTDB ADDRESS
	BLE	10$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;IN RANGE?
	BLT	10$		;NO
	SUB	#1,R3
	ASL	R3		;WORD OFFSET
	BR	11$
10$:	CLR	R3
11$:	MOV	TDB(R3),R3	;SET TDB
	CKEV$T	,R3
	TST	R0		;CHECK EVENTS
	BLE	80$		;RETURN EVENTS (.LE.0)
	MOV	#TDB,R2
76$:	CMP	(R2)+,R0
	BNE	76$		;NO MATCH
	SUB	#2,R2		;FOUND POINTER
	SUB	#TDB,R2		;GET DIFFERENCE
	MOV	R2,R0
	ASR	R0		;FORM NTDB-1
	INC	R0		;NTDB
80$:	TST	R4		;IS ISTAT REAL OR NULL
	BLE	99$		;NULL -- FORGET RETURN
	MOV	R0,(R4)		;RETURN NTDB
99$:	CMP	#3,R1		;THREE ARGUMENTS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R2);ERROR QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	CHKEVW
;
; FORTRAN CALLABLE SUBROUTINE TO WAIT FOR (OR OPTIONALLY STOP
; UNTIL) TASK EVENTS
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL CHKEVW (NTDB [,STOP] [,IERR])
;
;	NTDB - ORDINAL NUMBER OF SUBTASK
;	       NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	STOP - OPTIONAL ARGUMENT WHICH, IF NON-NULL, INDICATES
;	       TASK SHOULD STOP UNTIL SUBTASK EVENT.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
;
;
;
	.EVEN
CHKEVW::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;RETURN -- NO ARGUMENTS
	INC	R5
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	10$		;N.G. USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;IN RANGE?
	BLT	10$		;NO
	SUB	#1,R3
	ASL	R3		;WORD OFFSET
	BR	11$
10$:	CLR	R3
11$:	MOV	TDB(R3),R3	;SET TDB
	CMP	#2,R2		;TWO ARGUMENTS
	BGT	15$		;NO. DEFAULT TO WAIT
	MOV	(R5)+,R1	;STOP
	BLE	15$		; NULL - DEFAULT TO WAIT
	CKEV$T	,R3,STOP
	BR	99$
15$:	CKEV$T	,R3,WAIT
99$:	CMP	#3,R2		;THREE ARGUMENTS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R2);ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN



	.SBTTL	CHKALL
;
; FORTRAN CALLABLE SUBROUTINE TO WAIT FOR ALL EVENTS
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78		ADDED ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL CHKALL (ISTAT [,ITERM] [,IERR])
;
;
;	ISTAT - STATUS (SOURCE OF EVENT)
;	      = 0 TERMINAL EVENT (CONTROL-C) OCCURRED.
;	      = + -- NTDB OF SUBTASK CAUSING EVENT
;	        NTDB RANGES FROM 1 TO MAXTD.
;	      = -1 -- NO EVENTS OCCURRED.
;	      = -2 -- SHUTDOWN EVENT OCCURRED.
;
;	ITERM - OPTIONAL ARGUMENT, WHICH, IF NON-NULL, INDICATES
;	        INCLUDING TERMINAL AND SHUTDOWN EVENTS IN WAIT.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
;
;	NOTE: THIS ROUTINE MUST ONLY BE CALLED AFTER ALL POSSIBLE
;	TDB'S HAVE BEEN DECLARED. THE NUMBER POSSIBLE IS DETERMINED
;	BY PARAMETER MAXTD. IF THE ORIGINAL VALUE OF MAXTD IS CHANGED,
;	LINES AT LABELS 40$ AND 50$ BELOW MUST ALSO BE CHANGED.
;
;
;
	.PSECT	$IDATA
ESBA:	ESBDF$			;DECLARE ESB FOR THIS ROUTINE
				;AND OTHERS; WE ONLY NEED ONE CAUSE
				;THE TCP MACROS WON'T LET US DO ANYTHING
				;ASYNCHRONOUSLY. IN THOSE FEW CASES WHERE
				;IT APPEARS PRUDENT, WE'LL ADD OTHERS.
	.PSECT	$CODE1
	.EVEN
CHKALL::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOV	#ESBA,R1	;SET ESB INTO R1
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;RETURN -- NO ARGUMENTS
	INC	R5
	MOV	(R5)+,R4	;ADDRESS OF ISTAT
	BLE	99$		;WON'T LET HIM CALL WITH NULL ISTAT
				;IF HE'S NOT INTERESTED IN SOURCE OF EVENT
				;HE MUST KNOW IT. SO LET HIM USE ANOTHER
				;ROUTINE (I.E. CHKEVW OR WTEREV).
	CMP	#2,R2		;TWO ARGUMENTS
	BGT	50$		;NO
	MOV	(R5)+,R3	;GET 2ND
	BLE	50$		;IT'S NULL -- TO TERM
40$:	CKEV$T	<SHUT,TERM>,<#TDB0,#TDB1,#TDB2>,WAIT,R1
	BR	98$
50$:	CKEV$T	,<#TDB0,#TDB1,#TDB2>,WAIT,R1
98$:	TST	R0		;CHECK SOURCE OF EVENT
	BLE	80$		;RETURN VALUE .LE. 0
	MOV	#TDB,R3
76$:	CMP	(R3)+,R0
	BNE	76$		;NO MATCH
	SUB	#2,R3		;FOUND POINTER
	SUB	#TDB,R3		;GET DIFFERENCE
	MOV	R3,R0
	ASR	R0		;FORM NTDB-1
	INC	R0		;FORM NTDB
80$:	MOV	R0,(R4)		;RETURN ISTAT
99$:	CMP	#3,R2		;THREE ARGUMENTS
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOVB	T.ERR(R1),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R1),(R2);ERROR QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	WTEREV
;
; FORTRAN CALLABLE SUBROUTINE TO WAIT FOR TERMINAL OR SHUTDOWN EVENT
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-74	ADDED EVENT AND ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE
;   CALL WTEREV(ISTAT, [,IERR)
;
;	ISTAT	 - SOURCE OR EVENT, SET AS FOLLOWS:
;		 = -2 SHUTDOWN EVENT OCCURRED
;		 =  0 CTRL/C EVENT OCCURRED
;		 = -1 NO EVENT OCCURRED
;	
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
;	NOTE: NUMBER OF MINUTES TO SHUTDOWN MAY BE OBTAINED, BY CLI'S,
;		VIA ENTRY POINT SHUTTS.
;
;
;
	.EVEN
WTEREV::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	MOV	#ESBA,R1
	CKEV$T	<SHUT,TERM>,,WAIT,R1
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	INC	R5
	CMP	#1,R2		;AT LEAST 1?
	BGT	100$		;NO
	MOV	(R5)+,R3	;ISTAT
	MOV	R0,(R3)		;RETURN STATUS
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R3	;IERR
	MOVB	T.ERR(R1),(R3)+	;ERROR CODE
	MOVB	T.ERR+2(R1),(R3) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RDEVTS
;
; FORTRAN CALLABLE SUBROUTINE TO READ TASK EVENTS
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE
;   CALL RDEVTS(ISTAT,NTDB [,IERR] [,IEXIT])
;
;	ISTAT  - STATUS
;		 ISTAT IS SET TO CONTAIN THE FLAGS BYTE FROM LOCATION
;		 T.EVNT CODED AS FOLLOWS:
;		 BIT 0 - IF.JS -- SUBTASK SUCCESSFULLY TERMINATED
;		 BIT 1 - IF.JA -- TASK ABORTED
;		 BIT 2 - IF.NL -- LOAD FAILURE
;		 BIT 3 - IF.SU -- SUBTASK SUSPENDED ITSELF
;		 BIT 4 - IF.CH -- TERMINATED AND CHAINED SUCCESSFULLY
;		 BIT 5 - IF.SD -- SUBTASK HAS SENT A MESSAGE
;
;	NTDB   - ORDINAL NUMBER OF SUBTASK
;		 NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	PS.NOE	TASK HAS NOT CAUSED ANY EVENTS
;
;	IEXIT  - AN OPTIONAL INTEGER ARRAY TO HOLD SUBTASK TERMINATION
;		 INFORMATION (MEANINGFUL ONLY IF ISTAT INDICATES THAT
;		 THE SUBTASK TERMINATED.  CODED AS FOLLOWS:
;			IEXIT(1) = TASK SIZE (32-WORD BLOCKS)
;			IEXIT(2) = TASK CPU TIME - 1ST HALF
;			IEXIT(3) = TASK CPU TIME - 2ND HALF
;			IEXIT(4) = BIT 0 - EV.ST -- TASK EXITED WITH STATUS
;				   BIT 1 - EV.AB -- TASK TERMINATED ABNORMALLY
;			IEXIT(5) = TASK TERMINATION CODE
;			IEXIT(6) = TASK EXIT STATUS -- MEANINGFUL ONLY IF
;				   BIT 0 OF IEXIT(4) IS SET.
;
	.EVEN
RDEVTS::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R1	;NUMBER OF ARGUMENTS
	BLE	100$
	INC	R5
	MOV	(R5)+,R4	;ADDRESS OF ISTAT
	CMP	#2,R1		;TWO ARGS
	BGT	20$		;NO USE DEFAULT
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R3	;SET TDB
	RDEV$T	R3
	MOVB	T.EVNT(R3),R2	;GET FLAGS BYTE
	CLR	(R4)
	BITB	#IF.JS,R2
	BEQ	1$
	ADD	#1,(R4)
1$:	BITB	#IF.JA,R2
	BEQ	2$
	ADD	#2,(R4)
2$:	BITB	#IF.NL,R2
	BEQ	3$
	ADD	#4,(R4)
3$:	BITB	#IF.SU,R2
	BEQ	4$
	ADD	#10,(R4)
4$:	BITB	#IF.CH,R2
	BEQ	5$
	ADD	#20,(R4)
5$:	BITB	#IF.SD,R2
	BEQ	99$
	ADD	#40,(R4)
99$:	CMP	#3,R1		;3 ARGS?
	BGT	98$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	98$		;N.G.
	MOV	T.TESB(R3),R4	;ESB
	MOVB	T.ERR(R4),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R4),(R2) ;ERROR QUALIFIER
98$:	CMP	#4,R1		;4 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R4	;ADDRESS OF IEXIT
	MOV	T.EVBF+E.SIZ(R3),(R4)+ ;TASK SIZE TO IEXIT(1)
	MOV	T.EVBF+E.TIM(R3),(R4)+ ;TASK TIME TO IEXIT(2)
	MOV	T.EVBF+E.TIM+2(R3),(R4)+ ; AND IEXIT(3)
	MOV	T.EVBF+E.TR(R3),R2	;E.TR TO R2
	CLR	(R4)		;CLEAR IEXIT(4)
	BIT	#EV.ST,R2	;EV.ST?
	BEQ	96$		;NO
	ADD	#1,(R4)		;ADD 1 TO IEXIT(4)
96$:	BIT	#EV.AB,R2	;EV.AB?
	BEQ	97$		;NO
	ADD	#2,(R4)		;ADD 2 TO IEXIT(4)
97$:	ADD	#2,R4		;POINT TO IEXIT(5)
	MOVB	R2,(R4)+	;AND MOVE LOW ORDER BYTE OF E.TR TO IEXIT(5)
	INC	R4		;POINT TO IEXIT(6)
	MOV	T.EVBF+E.TS(R3),(R4) ;AND MOVE EXIT STATUS TO IEXIT(6)
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RSUMTS
;
; FORTRAN CALLABLE SUBROUTINE TO RESUME A SUSPENDED SUBTASK
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURNS
;	 5-MAR-79	RESUME ANY OF SUBTASK'S SUBTASKS
;
; FORTRAN CALLING SEQUENCE
;   CALL RSUMTS(NTDB [,IERR] )
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.NTA	SUBTASK NOT ACTIVE
;
;
;
	.EVEN
RSUMTS::
	PUSH	<R0,R2,R3> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	20$		;NO ARGS. USE DEFAULT
	INC	R5
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R3	;SET TDB
	RSUM$T	R3,,SUBTSK	;RESUME TASK AND ITS SUBTASKS
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	100$		;N.G.
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R3),(R2) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	SPNDTS
;
; FORTRAN CALLABLE SUBROUTINE TO SUSPEND A SUBTASK
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL SPNDTS(NTDB [,IERR] )
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.NTA	SUBTASK NOT ACTIVE
;
;
;
	.EVEN
SPNDTS::
	PUSH	<R0,R2,R3> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	20$		;NO ARGS. USE DEFAULT
	INC	R5
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R3	;SET TDB
	SPND$T R3
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	100$		;N.G.
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R3),(R2) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	STEVTS
;
; FORTRAN CALLABLE SUBROUTINE TO SET SUBTASK LOCAL EVENT FLAG
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE
;   CALL STEVTS(IFLAG, NTDB [,IERR] )
;
;	IFLAG - NUMBER OF LOCAL EVENT FLAG TO BE SET
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.NTA	SUBTASK NOT ACTIVE
;			PE.ABO	PE.GEF	GLOBAL EVENT FLAG SPECIFIED
;			PE.ABO	PE.INS	TASK NOT INSTALLED;
	.EVEN
STEVTS::
	PUSH	<R0,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$
	INC	R5
	MOV	(R5)+,R4	;ADDRESS OF IFLAG
	MOV	(R4),R4		;IFLAG
	CMP	#2,R2		;2 ARGS?
	BGT	20$		;USE DEFAULT
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R3	;SET TDB
	SETF$T	R3,R4
	CMP	#3,R2		;3 ARGS?
	BGT	99$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	99$		;N.G.
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R3),(R2) ;ERROR QUALIFIER
99$:	POP	<R4,R3,R2,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TDPRIV
;
; FORTRAN CALLABLE SUBROUTINE TO SET TASK PRIVILEGE SECTION OF TDB
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURN AND PLAS PRIVILEGES
;	 5-MAR-79	ADDED IMAX PARAMETER
;
; FORTRAN CALLING SEQUENCE
;   CALL TDPRIV(IALL, NTDB [,IMAX] [,IERR] )
;
;	IALL  - ARGUMENT WHICH IF NON-NULL INDICATES THAT
;		TDB PRIVILEGES SHOULD EQUAL OWNER TASKS
;		IF IALL IS A NULL-ARGUMENT, PRIVILEGES ARE DENIED
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;       IMAX  - OPTIONAL INTEGER ARGUMENT SPECIFYING THE MAXIMUM NUMBER
;		OF SUBTASKS THE TASK MAY CONTROL SIMULTANEOUSLY.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
	.EVEN
TDPRIV::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	100$
	INC	R5
	MOV	(R5)+,R4	;IALL ARGUMENT ADDRESS
	CMP	#2,R2		;2 ARGS?
	BGT	20$		;USE DEFAULT
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R3	;SET TDB
	TST	R4
	BLE	50$		;NULL ARGUMENT MEANS DENY PRIVILEGES
	CMP	#3,R2		;3 ARGS
	BGT	60$		;NO -- SET MAXSUBTASKS TO 0
	MOV	(R5)+,R1	;IMAX ADDRESS
	BLE	60$		;NULL - SET ZERO
	MOV	(R1),R1		;SET IMAX INTO R1
	BR	65$		;AND GO.
60$:	CLR	R1		;SET IMAX TO ZERO
65$:	TDPR$R	R3,#JP.PI!JP.PD!JP.PT!JP.PP,#PR.RST!PR.CTC!PR.TEV!PR.CHN,R1
99$:	CMP	#4,R2		;4 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	100$		;N.G.
	MOV	T.TESB(R3),R3	;ESB
	MOVB	T.ERR(R3),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R3),(R2) ;QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN
50$:	TDPR$R	R3,#0,#0	;DENY EVERYTHING
	BR	99$

	.SBTTL	DECTDB
;
; FORTRAN CALLABLE SUBROUTINE TO DECLARE A TDB
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADD ERROR RETURNS AND ESB'S
;
; THIS ROUTINE SHOULD BE CALLED ONCE FOR EACH TDB TO BE USED
; IN A PROGRAM BEFORE CALLING ANY ROUTINE THAT HAS NTDB AS AN ARGUMENT.
;
; FORTRAN CALLING SEQUENCE
;   CALL DECTDB(NTDB [,IERR] )
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.TDB	TDB ALREADY DECLARED
;
	.EVEN
DECTDB::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	20$		;NO ARGS. USE DEFAULT
	INC	R5
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R0	;SET TDB
	MOV	ESB(R3),R1	;SET ESB
	TDBD$T	R0,R1
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R2	;IERR
	BLE	100$		;N.G.
	MOVB	T.ERR(R1),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R1),(R2) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RELTDB
;
; FORTRAN CALLABLE SUBROUTINE TO RELEASE A TDB
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL RELTDB(NTDB [,IERR])
;
;	NTDB  - ORDINAL NUMBER OF SUBTASK
;		NTDB RANGES FROM 1 (DEFAULT) TO MAXTD
;
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.TDB	TDB NOT DECLARED
;			PE.ABO	PE.TAA	TDB REPRESENTS ACTIVE TASK
;
	.EVEN
RELTDB::
	PUSH	<R0,R2,R3> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	100$		;NO ARGS. RETURN
	INC	R5
	MOV	(R5)+,R3	;NTDB ADDRESS
	BLE	20$		;N.G--USE DEFAULT
	MOV	(R3),R3		;NTDB
	CMP	#MAXTD,R3	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R3
	ASL	R3		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R3		;SET TO DEFAULT
21$:	MOV	TDB(R3),R0	;SET TDB
	TDBR$T	R0
99$:	CMP	#2,R2		;2 ARGS
	BGT	100$		;NO.
	MOV	(R5)+,R2	;IERR
	BLE	100$		;N.G.
	MOV	T.TESB(R0),R0	;ESB
	MOVB	T.ERR(R0),(R2)+ ;ERROR CODE
	MOVB	T.ERR+2(R0),(R2) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	CLAIMC
;
; FORTRAN CALLABLE SUBROUTINE TO CLAIM CONTROL-C NOTIFICATION
;
;	MARK F. LEWIS
;	19-OCT-77
;	13-OCT-78	ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL CLAIMC (IERR)
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PE.ABO	PE.CTC	OWNER IS NOT CTRL/C TASK
;
;
	.PSECT	$IDATA
ZESB:	ESBDF$			;ESB
	.PSECT	$CODE1
	.EVEN
CLAIMC::
	PUSH	<R0,R1,R2> ;SAVE REGISTERS
	MOV	#ZESB,R2	;SET ESB
	CTC$T	CLAIM,R2
	MOVB	(R5)+,R1	;NO. ARGUMENTS
	BLE	100$		;NONE
	INC	R5
	MOV	(R5)+,R1	;IERR
	BLE	100$		;NO GOOD
	MOVB	T.ERR(R2),(R1)+ ;ERROR CODE
	MOVB	T.ERR+2(R2),(R1) ;ERROR QUALIFIER
100$:	POP	<R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	SENTS
;
; FORTRAN CALLABLE SUBROUTINE TO SEND A MESSAGE TO A TIME-SHARED TASK
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	REVISE ERROR HANDLING
;
; FORTRAN CALLING SEQUENCE --
;   CALL SENTS(BUFF, IDEST [,IERR])
;
;	BUFF	-  BUFFER CONTAINING MESSAGE. BUFFER MUST
;		   START ON A WORD BOUNDARY AND FIRST WORD MUST BE
;	 	   LENGTH OF BUFFER IN BYTES.
;
;	IDEST	- WORD CONTAINING DESTINATION:
;		= -1 DESTINATION IS OWNER TASK
;		=  0 DESTINATION IS CHAIN TASK
;		= OTHER: ORDINAL SUBTASK NUMBER (NTDB)
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.NTA	SUBTASK NOT ACTIVE
;			PE.ABO	PE.BUF	FAILED TO CLAIM A BUFFER
;			PE.ABO	PE.ADR	MESSAGE NOT ALL IN USER'S SPACE.
;			PE.ABO	PE.IBS	MESSAGE LENGTH >253. CHARACTERS
;			PE.ABO	PE.ILL	CLI SENDING TO OWNER.
;
;  NOTE:	SENTS USES ITS OWN SDB WHEN IDEST.LE.0
;		SENTS USES THE COMMON SDB'S WHEN IDEST.GT.0
;
	.PSECT	$IDATA
SDBS:	SDBDF$ ,,,ESBS
ESBS:	ESBDF$
	.PSECT	$CODE1
;
	.EVEN
SENTS::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;INVALID ARGUMENT LIST
	INC	R5
	MOV	(R5)+,R3	;GET BUFFER ADDRESS
	BLE	99$		;INVALID ADDRESS
	CMP	#2,R2		;2 ARGS?
	BGT	99$		;MUST HAVE AT LEAST TWO ARGUMENTS
	MOV	(R5)+,R4	;R4=ADDRESS OF IDEST
	MOV	(R4),R4		;R4=IDEST
	BGT	50$		;USE SDB OF TDB
	MOV	#SDBS,R0	;SET UP SDB
	MOV	R4,T.SNDT(R0)	;SET DESTINATION ADDRESS
	BR	51$
50$:	CMP	#MAXTD,R4	;IDEST WITHIN RANGE?
	BLT	20$		;NO -- USE DEFAULT
	SUB	#1,R4
	ASL	R4		;SET UP WORD OFFSET
	BR	21$
20$:	CLR	R4
21$:	MOV	TDB(R4),T.SNDT(R0)
	MOV	SDB(R4),R0
51$:	MOV	R3,T.SNDA(R0)	;SET UP BUFFER ADDRESS
	SEND$T	R0,,,#ESBS
98$:	CMP	#3,R2		;3 ARGS?
	BGT	99$		;NO.
	MOV	(R5)+,R1	;ADDRESS OF IERR
	BLE	99$
	MOV	#ESBS,R0	;ESB
	MOVB	T.ERR(R0),(R1)+	;RETURN ERROR CODE
	MOVB	T.ERR+2(R0),(R1)	; AND SUBCODE
99$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RELINC
;
; FORTRAN CALLABLE SUBROUTINE TO RELINQUISH CONTROL-C NOTIFICATION
;
;	MARK F. LEWIS
;	19-OCT-77
;	13-OCT-78	ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL RELINC (IERR)
;
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.ILL	CALLER IS NOT CTRL/C TASK
;
	.EVEN
RELINC::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	MOV	#ZESB,R3	;ESB
	CTC$T	RELINQ,R3
	MOVB	(R5)+,R2	;NO. OF ARGS
	BLE	100$		;NONE
	INC	R5
	MOV	(R5)+,R1	;IERR
	BLE	100$		;NO GOOD
	MOVB	T.ERR(R3),(R1)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R1) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RSASTS
;
; FORTRAN CALLABLE SUBROUTINE TO RESUME ALL AUTO-SUSPENDED SUBTASKS
;
;	MARK F. LEWIS
;	19-OCT-77
;	13-OCT-78	ERROR RETURN
;
; FORTRAN CALLING SEQUENCE
;   CALL RSASTS(IERR)
;
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.NTA	NO ACTIVE SUBTASKS
;
;
	.EVEN
RSASTS::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	RSAS$T	#ESBA
	MOVB	(R5)+,R2	;NO. OF ARGUMENTS
	BLE	100$		;NONE
	INC	R5
	MOV	(R5)+,R1	;IERR
	BLE	100$		;NONE
	MOV	#ESBA,R3	;ESB ADDR
	MOVB	T.ERR(R3),(R1)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R1) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL CHAIN
;
; FORTRAN-CALLABLE SUBROUTINE TO CHAIN TO A TIME-SHARED TASK
; AND OPTIONALLY SEND A MESSAGE TO THE SUCCESSOR
;
;	MARK F. LEWIS
;	21-MAR-78
;
; FORTRAN CALLING SEQUENCE--
;   CALL CHAIN(TASKNAME [,ITYP] [,MESS] [,IERR])
;
;   	TASKNAME - VALID COMMAND LINE FOR SUCCESSOR TASK
;		 - LAST BYTE MUST BE ZERO. (SET AUTOMATICALLY BY
;		   F4P FOR LITERALS).
;
;	ITYP     - OPTIONAL ARGUMENT SPECIFYING TYPE OF TASK
;		 = 1 (DEFAULT) COMMAND IS FILENAME OF TASK TO
;		   BE AUTO-INSTALLED AND REMOVED
;		 = 2 COMMAND IS FOR MCR TASK (...XYZ)
;		 = 3 COMMAND IS FOR SYSTEM LIBRARY TASK ($$$XYZ)
;		 = 4 COMMAND IS FOR AN INSTALLED TASK (UP TO 6 CHARACTERS)
;
;   	MESS     - OPTIONAL ARGUMENT SPECIFYING THE ADDRESS OF A MESSAGE
;		   TO BE SENT TO THE CHAINED TASK. DEFAULT IS NO MESSAGE.
;		   NOTE THAT THE FIRST WORD OF THE MESSAGE MUST CONTAIN
;		   THE LENGTH, IN BYTES, OF THE MESSAGE, WHICH MUST START
;		   AT ADDRESS MESS+2
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.TSE	COMMAND LINE 0 LENGTH/SPACE FILLED
;			PE.ABO	PE.BUF	NO COMMAND LINE/LINE TOO  LONG
;			PE.ABO	PE.ADR	COMMAND LINE NOT IN USER'S SPACE
;			PE.ABO	PE.ILL	ILLEGAL COMMAND LINE FORMAT/STYLE
;			PE.ABO	PE.TNI	NO EXISTANT SYSTEM/LIBRARY TASK
;			PE.ABO	PE.UPN	SCOM NODE POOL EXHAUSTED
;			PE.ABO	PE.IBS	SEND MESSAGE >253. CHARACTERS
;			PE.ABO	PE.BUF	UNAVAILABLE BUFFER SPACE
;			PE.ABO	PE.ADR	SEND MESSAGE NOT ALL IN USER'S SPACE
;
;
;
	.PSECT	$IDATA
CTDB:	CDBDF$			;DEFINE THE CTDB
SDBC:	SDBDF$			;DEFINE SDB FOR LATER USE
ESBC:	ESBDF$			;DEFINE ESB
	.PSECT	$CODE1
	.EVEN
;
CHAIN::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;INVALID ARGUMENT LIST
	INC	R5
	MOV	(R5)+,R0	;ADDRESS OF TASKNAME STRING TO R0
	BLE	99$
4$:	MOV	#CTDB,R4
	MOV	R0,T.CHNA(R4)	;SET ADDRESS OF TASKNAME STRING IN CTDB
	CLR	R3		;INITIALIZE CHARACTER COUNT
2$:	TSTB	(R0)+		;CHAR.EQ.0?
	BEQ	3$		;YES, STOP COUNTING
	INC	R3		;NO. COUNT IT
	BR	2$		;LOOP TILL ZERO FOUND
3$:	CMP	#2,R2		;TWO OR MORE ARGUMENTS?
	BGT	5$		;NO -- USE DEFAULT TYPE
	MOV	(R5)+,R0	;ADDRESS OF TYPE
	BLE	5$		;USE DEFAULT
	MOV	(R0),R0		;TYPE
	CMP	#1,R0		;TYPE 1?
	BEQ	5$		;YES
	CMP	#2,R0		;TYPE 2?
	BNE	6$		;NO
	MOVB	#TS.DOT,T.CTYP(R4) ;SET TYPE
	BR	11$
6$:	CMP	#3,R0		;TYPE 3?
	BNE	7$		;NO
	MOVB	#TS.DOL,T.CTYP(R4) ;SET TYPE
	BR	11$
7$:	CMP	#4,R0		;TYPE 4?
	BNE	5$		;NO!! TRY DEFAULT
	MOVB	#TS.INS,T.CTYP(R4) ;SET TYPE
	BR	11$
5$:	MOVB	#TS.USE,T.CTYP(R4)
11$:	MOVB	R3,T.CHNL(R4)	;SET LENGTH OF TASKNAME STRING
	MOV	#ESBC,R1	;SET ESB INTO R1
; IS THERE A MESSAGE TO SEND?
	CMP	#3,R2		;IS MESSAGE BUFFER SPECIFIED?
	BGT	12$		;NO
;THE FOLLOWING LINE GRANTS ALL PRIVILEGES TO THE CHAINED TASK
;THIS ROUTINE WILL HAVE TO BE RE-DONE IF THIS IS NOT DESIRED
	TDPR$R	R4,#JP.PI!JP.PD!JP.PT,#PR.RST!PR.CTC!PR.TEV!PR.CHN
	MOV	(R5)+,R0	;ADDRESS OF MESSAGE BUFFER
	BLE	12$		;INVALID ADDRESS
	MOV	#SDBC,R4
	MOV	R0,T.SNDA(R4)
	CHN$T	#CTDB,,,,R4,R1 ;CHAIN AND SEND MESSAGE
	BR	99$

12$:	CHN$T	#CTDB,,,,,R1		;CHAIN
99$:
	CMP	#4,R2		;FOUR ARGUMENTS
	BNE	100$		;NO
	MOV	(R5)+,R2	;IERR ADDRESS
	BLE	100$		;NULL
	MOVB	T.ERR(R1),(R2)+	;ERROR CODE
	MOVB	T.ERR+2(R1),(R2);ERROR QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	RECV
;
; FORTRAN CALLABLE SUBROUTINE TO RECEIVE A MESSAGE FROM A TIME-SHARED TASK
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	REVISED ERROR RETURNS
;
; FORTRAN CALLING SEQUENCE --
;   CALL RECV(BUFF ,LENGTH [,ISNDER]  [,IERR] )
;
;	BUFF	- ADDRESS OF BUFFER TO RECEIVE MESSAGE. BUFFER MUST
;		  START ON A WORD BOUNDARY.
;
;	LENGTH  - LENGTH OF BUFFER IN BYTES
;
;	ISNDER  -  OPTIONAL WORD TO RECEIVE SENDING TASK INDICATOR
;		= -2   SENDER WAS A SUBTASK WHOSE TDB AS BEEN RELEASED
;			OR REUSED.
;		= -1   SENDER WAS OWNER.
;		=  0   SENDER WAS THE PREDECESSOR.
;		= OTHER -- NTDB OF SENDER
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.ILL	BUFFER < 2 BYTES
;			PE.ABO	PE.ADR	BUFFER NOT ALL IN USER'S SPACE
;			PE.ABO	PE.NOD	NO MESSAGES QUEUED
;			PS.SUC	PS.RBS	BUFFER TOO SHORT - MESSAGE TRUNCATED
;			PS.SUC	PS.TDB	SENDING TASK'S TDB RELEASED/REUSED
;
;
;
	.PSECT	$IDATA
SDBR:	SDBDF$
ESBR:	ESBDF$
	.PSECT	$CODE1
;
	.EVEN
RECV::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$		;INVALID ARGUMENT LIST
	INC	R5
	MOV	#SDBR,R4
	MOV	(R5)+,T.SNDA(R4) ;SET UP ADDRESS
	BLE	99$		;INVALID ADDRESS
	CMP	#2,R2
	BGT	99$		;MUST HAVE AT LEAST TWO ARGUMENTS
	MOV	(R5)+,R1	;ADDRESS OF LENGTH
	MOVB	(R1),T.SNDL(R4)	;LENGTH OF BUFFER
	CMP	#3,R2		;THREE ARGS?
	BGT	10$		;NO
	MOV	(R5)+,R3	;ADDRESS OF ISNDER
	CMP	#4,R2		;FOUR ARGS?
	BGT	10$
	MOV	(R5)+,R1	;ADDRESS OF IERR
10$:	RCV$T	#SDBR,,,#ESBR
; DO WE NEED SENDER STUFF?
	CMP	#3,R2		;THREE OR MORE ARGUMENTS?
	BGT	99$		;NO
	TST	R3		;VALID ADDRESS?
	BLE	99$		;NO
	MOV	T.SNDT(R4),R4	;GET SENDER
	BLE	97$		;ISNDER .LE.0
	MOV	#TDB,R2	
76$:	CMP	(R2)+,R4
	BNE	76$		;NO MATCH
	SUB	#2,R2		;FOUND POINTER
	SUB	#TDB,R2		;GET DIFFERENCE
	MOV	R2,R4
	ASR	R4		;R4=NTDB-1
	INC	R4		;R4=NTDB
97$:	MOV	R4,(R3)		;RETURN ISNDER
98$:			;IF AN ERROR OCCURS
	TST	R1	;VALID ADDRESS?
	BLE	99$
	MOV	#ESBR,R0	;ESB
	MOVB	T.ERR(R0),(R1)+	;RETURN ERROR CODE
	MOVB	T.ERR+2(R0),(R1) ; AND SUBCODE
99$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	STMAXT
;
; FORTRAN CALLABLE ROUTINE TO SET A TERMINAL'S MAXIMUM TASK ALLOCATION
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURNS
;
; CALLING SEQUENCE:
;	CALL STMAXT(N [,IERR] )
;
;	N   - REQUIRED ALLOCATION LIMIT DESIRED
;	      ON RETURN N IS SET TO THE ACTUAL ALLOCATION MADE.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PS.SUC	PS.JAE	ATTEMPT TO EXCEED SYSTEM LIMIT
;			PS.SUC	PS.NOE	ATTEMPT TO REDUCE CURRENT ALLOCATION
;
;
; NOTE THAT THIS ROUTINE IS AVAILABLE ONLY TO A CLI.
;
;
	.EVEN
STMAXT::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	99$
	INC	R5
	MOV	(R5)+,R4	;ALLOCATION LIMIT ADDRESS
	BLE	99$		;NO GOOD
	MOV	(R4),R3		;LIMIT
	JNOD$T	R3,#ESBA
	MOV	R0,(R4)		;RETURN ALLOCATION
	CMP	#2,R2		;2 ARGS?
	BGT	99$		;NO
	MOV	(R5)+,R1	;IERR
	BLE	99$		;NO GOOD
	MOV	#ESBA,R0	;ESB
	MOVB	T.ERR(R0),(R1)+ ;ERROR CODE
	MOVB	T.ERR+2(R0),(R1) ;ERROR QUALIFIER
99$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	INITS
;
; FORTRAN CALLABLE SUBROUTINE TO INITIALIZE TCS
; AND RELEASE ANY DECLARED TDB'S.
;
;	MARK F. LEWIS
;	21-MAR-78
;	13-OCT-78	ADDED ERROR RETURNS
;
; SHOULD BE CALLED IF IT IS INTENDED TO RESTART A PROGRAM WITHOUT
; PRIOR LOADING.
;
; CALLING SEQUENCE:
;	CALL INITS( IERR)
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.TAA	ACTIVE SUBTASKS
;
	.EVEN
INITS::
	PUSH	<R0,R1,R2,R3> ;SAVE REGISTERS
	MOV	#ESBA,R3
	TINIT$	R3
	MOVB	(R5)+,R2	;NO. ARGUMENTS
	BLE	100$		;NONE
	INC	R5
	MOV	(R5)+,R1	;IERR
	BLE	100$		;NULL
	MOVB	T.ERR(R3),(R1)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R1) ;ERROR QUALIFIER
100$:	POP	<R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL SHUTTS
;
; FORTRAN CALLABLE SUBROUTINE TO OBTAIN MINUTES TILL SHUTDOWN.
; CALLABLE BY CLI'S ONLY.
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;   CALL SHUTTS(ITIME [,IERR])
;
;	ITIME    - NUMBER OF MINUTES BEFORE SHUTDOWN
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	  -	SUCCESS
;			PS,ABO	PE.NOS	NO SHUTDOWN
	.EVEN
SHUTTS::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NO. OF ARGUMENTS
	BLE	100$		;NONE
	INC	R5
	MOV	(R5)+,R1	;ITIME ADDRESS
	BLE	100$		;NULL
	MOV	#ESBA,R3	;ESB
	SHUT$T	R3
	MOV	R0,(R1)		;RETURN MINUTES
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO
	MOV	(R5)+,R4	;IERR
	BLE	100$		;NULL
	MOVB	T.ERR(R3),(R4)+	;RETURN ERROR CODE
	MOVB	T.ERR+2(R3),(R4) ;AND QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TSLEVL
;
;	FORTRAN CALLABLE SUBROUTINE TO DEFINE TASK SCHEDULING LEVEL
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;   CALL TSLEVL(NTDB ,LEVEL [,IERR] )
;
;	NTDB	- ORDINAL NUMBER OF TASK DESCRIPTOR BLOCK
;
;	LEVEL	- OPTIONAL INTEGER SPECIFYING THE SCHEDULING LEVEL
;
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
	.EVEN
TSLEVL::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NO. OF ARGUMENTS
	BLE	100$		;NONE.
	INC	R5
	MOV	(R5)+,R1	;NTDB ADDRESS
	BLE	20$		;NULL -- USE DEFAULT
	MOV	(R1),R1		;NTDB
	CMP	#MAXTD,R1	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R1
	ASL	R1		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R1		;SET DEFAULT
21$:	MOV	TDB(R1),R0	;SET TDB
	MOV	ESB(R1),R3	;SET ESB FOR RETURN USE
	CMP	#2,R2		;2 ARGS
	BGT	100$		;NO. DO NOTHING
	MOV	(R5)+,R1	;ADDRESS OF LEVEL
	BLE	100$		;NULL
	MOV	(R1),R1		;LEVEL
	TDTA$R	R0,R1		;SET LEVEL
	CMP	#3,R2		;3 ARS?
	BGT	100$		;NO
	MOV	(R5)+,R4	;IERR
	BLE	100$		;N.G.
	MOVB	T.ERR(R3),(R4)+	;ERROR CODE
	MOVB	T.ERR+2(R3),(R4) ;ERROR QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TSBATC
;
;	FORTRAN CALLABLE SUBROUTINE TO DEFINE TASK SCHDEULING AT BATCH LEVEL
;	AND/OR CHANGE AUTO-SUSPENDABLE CHARACTER OF SUBTASK.
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;	CALL TSBATC( NTDB [,IBATCH] [,ICTRLC] [,IERR] )
;
;	NTDB	 - ORDINAL NUMBER OF TASK DESCRIPTOR BLOCK
;
;	IBATCH	 - OPTIONAL ARGUMENT WHICH IF 0 (DEFAULT) INDICATES
;		   TASK IS TOO RUN AT BATCH SCHEDULING LEVEL. IF IBATCH.NE.0
;		   TASK IS NOT TO RUN AT BATCH SCHEDULING LEVEL.
;
;	ICTRLC	 - OPTIONAL ARGUMENT WHICH IF 0 (DEFAULT) INDICATES
;		   TASK IS TO BE AUTOMATICALLY SUSPENDED ON CTRL/C OCCURRENCE.
;		   IF ICTRLC.NE.0 TASK IS NOT TO BE AUTO-SUSPENDED.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
	.EVEN
TSBATC::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	20$		;NONE. USE DEFAULT
	INC	R5
	MOV	(R5)+,R1	;NTDB ADDRESS
	BLE	20$		;NULL. USE DEFAULT
	MOV	(R1),R1		;NTDB
	CMP	#MAXTD,R1	;WITHIN RANGE?
	BLT	20$		;USE DEFAULT
	SUB	#1,R1
	ASL	R1		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R1		;SET DEFAULT
21$:	MOV	TDB(R1),R0	;SET TDB
	CMP	#2,R2		;2 ARGS?
	BGT	30$		;NO USE DEFAULTS
	MOV	(R5)+,R3	;IBATCH ADDRESS
	BLE	30$		;NULL. USE DEFAULT
	MOV	(R3),R3		;IBATCH
	BEQ	30$		;0 MEANS BATCH LEVEL
	CLR	R3		;NO BATCH SCHEDULING LEVEL
	BR	35$
30$:	MOVB	#FB.BT,R3	;SET BATCH SCHEDULING LEVEL
35$:	CMP	#3,R2		;3 ARGUMENTS?
	BGT	40$		;NO. USE DEFAULT
	MOV	(R5)+,R4	;ICTRLC
	BEQ	40$		;SET CTRLC
	CLR	R4		;SET CTRLC FLAG TO ZERO
	BR	45$
40$:	MOVB	#FB.NC,R4	;SET CTRLC FLAG
45$:	BIS	R4,R3		;SET ATTRIBUTES
	TDTA$R	R0,,R3
	MOV	ESB(R1),R1	;SET ESB
	CMP	#4,R2		;4 ARGS?
	BGT	100$		;NO.
	MOV	(R5)+,R4	;IERR
	BLE	100$		;N.G.
	MOVB	T.ERR(R1),(R4)+ ;ERROR CODE
	MOVB	T.ERR+2(R1),(R4) ;QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TSUIC
;
;	FORTRAN CALLABLE SUBROUTINE TO DEFINE TASK UIC
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;   CALL TSUIC ( NTDB, IGROUP, IMEMBR [,IERR] )
;
;	NTDB	 - ORDINAL NUMBER OF TASK DESCRIPTOR BLOCK
;
;	IGROUP	 - INTEGER REPRESENTING GROUP CODE OF USER IDENTIFICATION
;		   CODE.
;
;	IMEMBR	 - INTEGER REPRESENTING MEMBER CODE OF USER IDENTIFICATION
;		   CODE.
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;
	.EVEN
TSUIC::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	100$		;NONE. RETURN
	INC	R5
	MOV	(R5)+,R1	;NTDB ADDRESS
	BLE	20$		;NULL -- USE DEFAULT
	MOV	(R1),R1		;NTDB
	CMP	#MAXTD,R1	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R1
	ASL	R1		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R1		;SET DEFAULT
21$:	MOV	TDB(R1),R0	;SET TDB
	CMP	#2,R2		;2 ARGS?
	BGT	100$		;NO. STUPID
	MOV	(R5)+,R3	;GROUP CODE ADDRESS
	BLT	100$		;DAMN FOOL.
	MOV	(R3),R3		;GROUP CODE
	CMP	#3,R2		;3 ARGS.
	BGT	100$		;ALSO STUPID
	MOV	(R5)+,R4	;MEMBER CODE ADDRESS
	BLT	100$		;STILL A FOOL.
	MOV	(R4),R4		;MEMBER CODE
	TDTA$R	R0,,,<R3,R4>
	CMP	#4,R2		;4 ARGS?
	BGT	100$		;NO.
	MOV	(R5)+,R3	;IERR
	MOV	ESB(R1),R1	;ESB
	MOVB	T.ERR(R1),(R3)+ ;ERROR CODE
	MOVB	T.ERR+2(R1),(R3) ;QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TSSTAT
;
;	FORTRAN CALLABLE SUBROUTINE TO OBTAIN SIZE AND CPU TIME
;	FOR A SUBTASK
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;   CALL TSSTAT (NTDB, ISIZE, ITIME [,IERR] )
;
;	NTDB	 - ORDINAL NUMBER OF TASK DESCRIPTOR BLOCK
;
;	ISIZE	 - ON RETURN, SET TO SUBTASK SIZE IN 32-WORD BLOCKS
;
;	ITIME	 - ON RETURN, SET TO TIME IN TICKS
;		   ITIME SHOULD BE A TWO-WORD INTEGER ARRAY
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.NTA	SUBTASK IS NOT ACTIVE
;
	.EVEN
TSSTAT::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	100$		;NONE. RETURN
	INC	R5
	MOV	(R5)+,R1	;NTDB ADDRESS
	BLE	20$		;NULL -- USE DEFAULT
	MOV	(R1),R1		;NTDB
	CMP	#MAXTD,R1	;WITHIN RANGE?
	BLT	20$		;TOO BIG--USE DEFAULT
	SUB	#1,R1
	ASL	R1		;NEED WORD OFFSET
	BR	21$
20$:	CLR	R1		;SET DEFAULT
21$:	MOV	TDB(R1),R0	;SET TDB
	TKST$T	R0
	CMP	#2,R2		;2 ARGS
	BGT	30$		;NO
	MOV	(R5)+,R3	;ISIZE ADDRESS
	BLE	30$		;NULL
	MOV	T.EVBF+E.SIZ(R0),(R3)	;RETURN SIZE
30$:	CMP	#3,R2		;3 ARGS?
	BGT	40$		;NO.
	MOV	(R5)+,R4	;ITIME
	BLE	40$		;NULL
	MOV	T.EVBF+E.TIM(R0),(R4)+ ;RETURN TIME
	MOV	T.EVBF+E.TIM+2(R0),(R4) ;2ND WORD
40$:	CMP	#4,R2		;4 ARGS?
	BGT	100$		;NO.
	MOV	(R5)+,R3	;IERR
	BLE	100$		;NULL
	MOV	ESB(R1),R1	;ESB
	MOVB	T.ERR(R1),(R3)+	;ERROR CODE
	MOVB	T.ERR+2(R1),(R3) ;QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN

	.SBTTL	TSCODE
;
;	FORTRAN CALLABLE SUBROUTINE TO DEFINE SUBTASKING ERROR CODES
;
;
;	MARK F. LEWIS
;	13-OCT-78
;
; FORTRAN CALLING SEQUENCE
;   CALL TSCODE( IARRAY [,IERR] )
;
;	IARRAY	 - 70-ELEMENT BYTE ARRAY TO RECEIVE ERROR CODES
;		   THAT MAY BE RETURNED BY CALLS TO SUBTASKING.
;
;	IERR	 - AN OPTIONAL INTEGER WORD (OR 2-BYTE ARRAY) FOR ERROR
;		   RETURNS. CODED AS FOLLOWS:
;			BYTE 0 = ERROR CODE
;			BYTE 1 = ERROR QUALIFIER
;		  POSSIBLE RESULTS:
;			BYTE 0	BYTE 1	MEANING
;			------	------	-------
;			PS.SUC	   -	SUCCESS
;			PE.ABO	PE.BUF	INVALID USER BUFFER
;
;
; NOTE: THE FOLLOWING PSECT WAS CREATED TO PERMIT THE USER TO OBTAIN
; ACCESS TO ERROR CODES BY MAPPING A COMMON AREA ONTO ECODES RATHER THAN
; BY CALLING TSCODE.  THIS ALTERNATIVE WILL SAVE BOTH TIME AND SPACE.
	.PSECT	$PDATA,D,RO
ECODES::
	.EVEN
;ERROR RETURN CODES --
	.BYTE	PE.BAD			; BAD PARAMETERS
	.BYTE	PE.IFC			; INVALID FUNCTION CODE
	.BYTE	PE.ABO			; REQUEST TERMINATED
	.BYTE	PE.PRI			; PRIVILEGE VIOLATION -ILLEGAL CALLER
	.BYTE	PE.UPN			; UNAVAILABLE IAS POOL NODE
; 
; 

;SUCESSFUL RETURN CODES --
	.BYTE	PS.PND			; OPERATION PENDING
	.BYTE	PS.SUC			; OPERATION COMPLETE,SUCESS
;SUCCESSFUL RETURN QUALIFIERS --
	.BYTE	PS.DMO			; RSX DISMOUNT CAN BE RUN
	.BYTE	PS.REL			; DEVICE CAN BE RELEASED
	.BYTE	PS.VNO			; VOLUME NOT ON LINE FOR TERMINAL USER
	.BYTE	PS.VNM			; VOLUME NOT MOUNTED IN SYSTEM
	.BYTE	PS.RBS			;++013 LOST DATA ON A RECEIVE
	.BYTE	PS.JAE			;++016 JOB NODE ALLCN EXCEEDED
	.BYTE	PS.TDB			;++018 SENDING TASK'S TDB NON-EXISTENT
	.BYTE	PS.NOE			;++018 REQUEST < CURRENT ALLOCATION
; 
; 
; 
;ERROR RETURN QUALIFIERS --
	.BYTE	PE.FTL			; FATAL ERROR - IASCOM INCONSISTANT
	.BYTE	PE.ILL			; ILLEGAL REQUEST
	.BYTE	PE.NTS			;++008 NON-TIMESHARING TASK
; 
	.BYTE	PE.UNS			; UNAVAILABLE NODE SPACE (NODE FULL)
	.BYTE	PE.NAL			; (IAS) NODE ALREADY ALLOCATED
	.BYTE	PE.MJA			;++014 MAX JOB NODES ALLOCATED
					;++016 1 LINE DELETED
					;++018 1 LINE REPLACED
	.BYTE	PE.TDB			;++018 ILLEGAL USE OF TDB'S
	.BYTE	PE.NOS			;++022 NO SHUTDOWN DECLARED
	.BYTE	PE.INS			;++014 TASK NOT YET INSTALLED
	.BYTE	PE.GEF			;++014 GLOBAL EF 
	.BYTE	PE.CTC			;++014 OWNER IS NOT TERM. RESP. TASK
; 
	.BYTE	PE.JNE			; JOB NODE ERROR
	.BYTE	PE.MJN			; MAX JOBS
	.BYTE	PE.JOB			; JOB NAME ERROR
	.BYTE	PE.TSE			; TASK STRING ERROR
	.BYTE	PE.TNI			; SYSTEM TASK NOT INSTALLED
	.BYTE	PE.TAA			; TASK ALREADY ACTIVE
	.BYTE	PE.NTA			; NO TASK ACTIVE
	.BYTE	PE.CNE			;++010 CLI NODE ERROR
; 
	.BYTE	PE.BUF			; BUFFER ERROR
; 
	.BYTE	PE.IBS			;++013 SEND DATA > 253 BYTES
	.BYTE	PE.UTS			;++013 UNAVAILABLE TABLE SPACE
	.BYTE	PE.NOD			;++013 NO DATA (RECEIVE OR DRB)
	.BYTE	PE.ADR			;++007 USER'S BUFFER NOT IN HIS SPACE
					;++017 1 LINE DELETED
	.BYTE	PE.NBH			; +++004 NO BATCH I/O HANDLER
	.BYTE	PE.NST			; +++002 NO SUCH T/S TERMINAL
					;++017 1 LINE DELETED
	.BYTE	PE.TNE			; TERMINAL NODE ERROR
	.BYTE	PE.TNA			; TERMINAL NOT ACTIVE
	.BYTE	PE.TAC			; TERMINAL ACTIVE
	.BYTE	PE.MTT			; MAX TERMINALS
	.BYTE	PE.NOB			; NO BATCH LEVEL 
	.BYTE	PE.COT			; CO TERMINAL SPECIFIED FOR NON SCI
	.BYTE	PE.SCA			; SCI ACTIVE ON TT CANNOT REALLOCATE
; 
	.BYTE	PE.VNM			; VOLUME NOT MOUNTED(FOR REQUESTOR)
	.BYTE	PE.NSD			; NO SUCH DEVICE (AVAIL TO T/S)
	.BYTE	PE.LUN			; LUN ERROR
	.BYTE	PE.DNA			; DEVICE NOT ALLOCATED
	.BYTE	PE.DIU			; DEVICE IN USE
;			-155		; UNUSED
	.BYTE	PE.NMD			; NO MORE DEVICES (OF REQ.TYPE)
	.BYTE	PE.ACT			; VOLUME ACTIVE WITH I/O
	.BYTE	PE.DIS			; DEVICE IS SPOOLED
	.BYTE	PE.DAC			; DEVICE ACTIVE
	.BYTE	PE.DIR			; DEVICE IS DIRECTORY
	.BYTE	PE.NDD			;NON-DIRECTORY DEVICE 
	.BYTE	PE.DNC			; DEVICE NOT CLAIMED
	.BYTE	PE.VMO			; VOLUME MOUNTED
	.BYTE	PE.VOU			; VOLUME MOUNTED ON OTHER DEVICE
	.BYTE	PE.LAA			; LUN ALREADY ASSIGNED
	.BYTE	PE.DOF			; DEVICE OFF LINE TO USER
	.BYTE	PE.DNL			; DEVICE NOT LOADED
	.BYTE	PE.NRQ			; NO LOAD REQUEST FOR DEVICE
	.BYTE	PE.ORJ			; OPERATOR REJECTION OF VOL REQUEST
	.BYTE	PE.SAT			; LOAD REQUEST ALREADY SATISFIED
	.BYTE	PE.WUN			; WRONG UNIT NUMBER
	.BYTE	PE.DRQ			; DEVICE ALREADY REQUESTED
	.PSECT	$CODE1
	.EVEN
TSCODE::
	PUSH	<R0,R1,R2,R3,R4> ;SAVE REGISTERS
	MOVB	(R5)+,R2	;NUMBER OF ARGUMENTS
	BLE	100$		;NONE. DAMN STUPID.
	INC	R5
	MOV	(R5)+,R1	;IARRAY ADDRESS
	BLE	90$		;INVALID ADDRESS.
	MOV	#70.,R0		;NUMBER OF CODES TO R0
	MOV	#ECODES,R3	;ADDRESS OF ERROR CODE ARRAY
10$:	MOVB	(R3)+,(R1)+	;MOVE CODE TO USER ARRAY
	DEC	R0		;SURE WOULD LIKE TO USE AN SOB HERE
	BGT	10$		;BUT...
;
	MOVB	#PS.SUC,R3
	CLR	R4
	BR	95$
90$:	MOVB	#PE.ABO,R3
	MOVB	#PE.BUF,R4
95$:	CMP	#2,R2		;2 ARGS
	BGT	100$		;NO.
	MOV	(R5)+,R1	;IERR
	BLE	100$		;NO GOOD
	MOVB	R3,(R1)+	;ERROR CODE
	MOVB	R4,(R1)		;QUALIFIER
100$:	POP	<R4,R3,R2,R1,R0> ;RESTORE REGISTERS
	RETURN
	.END