.TITLE	SUBTSK
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	SUBTSK
;
;  DATE:	26-APR-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL SUBTSK(COMMAND,[ITYP],[ISW])
;
;		COMMAND	= VALID COMMAND LINE FOR THE SUBTASK.
;			  (LAST BYTE OF COMMAND STRING MUST BE NULL)
;
;		ITYP	= OPTIONAL ARGUMENT SPECIFYING TYPE OF TASK.
;
;			   01 COMMAND IS FILENAME OF TASK TO BE AUTO-INSTALLED
;			      AND REMOVED (DEFAULT).  NOTE: FIRST CHARACTER OF
;			      COMMAND STRING MUST BE A SPACE FOR ITYP=1.
;			   02 COMMAND IS FOR AN MCR TASK (...XYZ).
;			   03 COMMAND IS FOR A SYSTEM LIBRARY TASK ($$$XYZ).
;			   04 COMMAND IS FOR AN INSTALLED TASK.
;
;		ISW	= VARIABLE TO RECEIVE THE INTEGER STATUS WORD.
;
;			   00 TASK SUCCESSFUL (OR STATUS NOT RETURNED)
;
;			   01 TASK SUCCESSFUL, WARNING DIAGNOSTICS OCCURED
;			   02 TASK SUCCESSFUL, NON-FATAL ERRORS OCCURED
;			   04 TASK FAILED, FATAL ERRORS
;			   08 TASK ABORTED ABNORMALLY (EG: SEGMENT FAULT)
;
;			  -01 BAD TCP PARAMETERS
;			  -02 INVALID TCP FUNCTION CODE
;			  -15 TCP REQUEST TERMINATED
;			  -16 TCP PRIVILEGE VIOLATION
;			  -60 UNAVAILABLE IAS NODE POOL
;			  -63 INVALID ARGUMENT LIST
;
;
;  DESCRIPTION:
;
;	"SUBTSK" IS A FORTRAN-CALLABLE SUBROUTINE TO RUN A TIME-SHARED
;  TASK.  THE CALLING ROUTINE WILL WAIT FOR A SUBTASK EVENT, EITHER
;  SUCCESSFULL COMPLETION OF THE TASK OR AN ABORT ON FAILURE.
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
	.PSECT
	.MCALL	TCSMC$			;
	TCSMC$				; MCALL ALL TCS MACROS
					;
TDB:	TDBDF$				; RESERVE TASK DESCRIPTOR BLOCK
	TDCM$A				;
ESB:	ESBDF$				; RESERVE ERROR STATUS BLOCK
	TDEB$A	ESB			;
	.EVEN				;
					;
;
;
;   REGISTER USAGE:
;
;	R0 = ADDRESS OF TDB
;	R1,R2 = SCRATCH
;	R4 = STATUS FLAG
;	R5 = ARGUMENT POINTER
;
;

	.SBTTL	ENTRY POINT -- SET UP TDB AND EXECUTE SUBTASK
;
;
;   SET UP TDB AND EXECUTE SUBTASK
;
					;
SUBTSK::				;
					;
	MOV	#-77,R4			; INITIALIZE STATUS FLAG
	MOV	#TDB,R0			; ADDRESS OF TDB TO R0
	TDBD$T				; DECLARE TDB
	TSTB	(R5)			; TEST NUMBER OF ARGUMENTS
	BLE	RTN			; NO ARGUMENTS, INVALID ARGUMENT LIST
	CMPB	#3,(R5)			; MORE THAN THREE ARGUMENTS?
	BLT	RTN			; YES, INVALID ARGUMENT LIST
	MOV	2(R5),R1		; ADDRESS OF COMMAND STRING TO R1
	BLE	RTN			; NO COMMAND LINE, INVALID ARGUMENT LIST
	MOV	R1,T.CMDA(R0)		; COMMAND STRING ADDRESS TO TDB
	CLR	R2			; INITIALIZE CHARACTER COUNT
2$:	TSTB	(R1)+			; NULL CHARACTER?
	BEQ	4$			; YES, STOP COUNTING
	INC	R2			; NO, INCREMENT CHARACTER COUNT
	BR	2$			; AND LOOP UNTIL NULL
4$:	MOVB	R2,T.CMDL(R0)		; CHARACTER COUNT TO TDB
					;
	CMPB	#2,(R5)			; AT LEAST TWO ARGUMENTS?
	BGT	6$			; NO, USE DEFAULT ITYP
	TST	4(R5)			; TEST ITYP ADDRESS
	BLE	6$			; NULL ADDRESS, USE DEFAULT ITYP
	MOV	@4(R5),R1		; ITYP TO R1
	CMP	#1,R1			; TYPE 1?
	BNE	10$			; NO, TRY TYPE 2
6$:	MOVB	#TS.USE,T.TTYP(R0)	; YES, DECLARE TYPE 1 (DEFAULT)
	BR	RUN			;
10$:	CMP	#2,R1			; TYPE 2?
	BNE	12$			; NO, TRY TYPE 3
	MOVB	#TS.DOT,T.TTYP(R0)	; YES, DECLARE TYPE 2
	BR	RUN			;
12$:	CMP	#3,R1			; TYPE 3?
	BNE	14$			; NO, TRY TYPE 4
	MOVB	#TS.DOL,T.TTYP(R0)	; YES, DECLARE TYPE 3
	BR	RUN			;
14$:	CMP	#4,R1			; TYPE 4?
	BNE	RTN			; NO, INVALID TYPE
	MOVB	#TS.INS,T.TTYP(R0)	; YES, DECLARE TYPE 4
					;
RUN:	RUN$T	,,,,,WAIT		; EXECUTE SUBTASK
	BCS	ERR			; BRANCH IF TCP ERROR
					;
	BIT	#EV.AB,T.EVBF+E.TR(R0)	; ABNORMAL TASK TERMINATION?
	BEQ	2$			; NO
	MOV	#10,R4			; YES, SET STATUS FLAG
	BR	RTN			; AND RETURN TO CALLER  (ISW=8)
					;
2$:	BIT	#EV.ST,T.EVBF+E.TR(R0)	; TERMINATION WITH STATUS?
	BEQ	6$			; NO
	MOV	T.EVBF+E.TS(R0),R4	; TASK STATUS TO R4
	BNE	4$			; WARNING?
	MOV	#1,R4			; YES, SET STATUS FLAG
	BR	RTN			; AND RETURN TO CALLER  (ISW=1)
4$:	CMP	#2,R4			; NON-FATAL ERRORS?
	BEQ	RTN			; YES, RETURN TO CALLER (ISW=2)
	CMP	#4,R4			; FATAL ERRORS?
	BEQ	RTN			; YES, RETURN TO CALLER (ISW=4)
6$:	CLR	R4			; SUCCESS, CLEAR STATUS FLAG
	BR	RTN			; AND RETURN TO CALLER  (ISW=0)
					;
ERR:	MOV	T.TESB(R0),R1		; ESB ADDRESS TO R1
	MOVB	T.ERR(R1),R4		; TCP ERROR CODE TO STATUS FLAG
	BR	RTN			; RETURN TO CALLER
					;

	.SBTTL	RETURN TO CALLER
;
;
;   RETURN TO CALLER
;
					;
RTN:	CMPB	#3,(R5)			; AT LEAST THREE ARGUMENTS?
	BGT	2$			; NO
	TST	6(R5)			; TEST ISW ADDRESS
	BLE	2$			; NULL ADDRESS
	MOV	R4,@6(R5)		; STATUS FLAG TO ISW
2$:	TDBR$T				; RELEASE TDB
	RTS	PC			; RETURN TO CALLER
	.END				;
					;