;
;	AUTHOR:
;		R. STODOLA
;		THE INSTITUTE FOR CANCER RESEARCH
;		7701 BURHOLME AVE.
;		PHILADELPHIA, PA.  19111
;
;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
;      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
;      *         NIH CA06927                                 *
;      *         NIH CA22780                                 *
;      *                                                     *
;      *      DIRECT INQUIRIES TO:                           *
;      *            COMPUTER CENTER                          *
;      *            THE INSTITUTE FOR CANCER RESEARCH        *
;      *            7701 BURHOLME AVENUE                     *
;      *            PHILADELPHIA, PENNSYLVANIA   19111       *
;      *                                                     *
;      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
;      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
;      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
;      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
;      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
;      *      OWNED RIGHTS.                                  *
;      *                                                     *
;      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
;      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
;      *      THE USE OF THIS SOFTWARE                       *
;      *                                                     *
;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
;      *      PDP-11/70 OPERATING UNDER IAS V2.0 USING       *
;      *      THE IAS PDP-11 MACRO ASSEMBLER.                *
;      *                                                     *
;      *******************************************************
	.TITLE	FSTM  	-- FORTRAN SUBTASK MANAGER
	.IDENT	/ICR001/
	.MCALL	ERSMDF
;
;	THIS MODULE HAS THREE CALLABLE SUBROUTINES.
;
;	.CERR.	CLEARS USERS ERROR BUFFER (IF ANY), CLEARS THE ESB IN
;	THE ERROR BLOCK, AND RETURNS.  R0 IS DESTROYED.
;
;	.GIDNT	GETS THE TDB ADDRESS OF THE IDENT IN R0.  IF NO SUBTASK
;	HAS BEEN ALLOCATED TO THIS IDENT, ..STER IS CALLED WITH ERROR
;	MESSAGE -1, AND ROUTINE RETURNS TO .+2.  IF NO ERROR OCCURS,
;	ROUTINE RETURNS TO .+4 WITH TDB ADDRESS IN R3, AND ESB ADDRESS
;	IN TDB.
;
;	.NIDNT	HAS ESSENTIALLY THE SAME FUNCTION AS .GIDNT, EXCEPT THAT
;	AN EMPTY TDB IS SEARCHED FOR, AND ERROR MESSAGE -2 IS USED INSTEAD
;	OF -1.
;
	ERSMDF
;
ST.MAX==4.				;MAXIMUM NUMBER OF SUBTASKS ALLOWED.
;
	.WORD	0			;FREE TDB FLAG
.TDB1.::
TDB1:	TDBDF$
	TDCM$A	,,TS.USE
	TDPR$A	JP.PI,PR.RST!PR.CHN,ST.MAX
;
	.WORD	0			;FREE TDB FLAG
.TDB2.::
TDB2:	TDBDF$
	TDCM$A	,,TS.USE
	TDPR$A	JP.PI,PR.RST!PR.CHN,ST.MAX
;
	.WORD	0			;FREE TDB FLAG
.TDB3.::
TDB3:	TDBDF$
	TDCM$A	,,TS.USE
	TDPR$A	JP.PI,PR.RST!PR.CHN,ST.MAX
;
	.WORD	0			;FREE TDB FLAG
.TDB4.::
TDB4:	TDBDF$
	TDCM$A	,,TS.USE
	TDPR$A	JP.PI,PR.RST!PR.CHN,ST.MAX
;
.CERR.::
	CLR	E..ESB+T.ERR(R4)	;CLEAR ERROR BLOCK ESB
	CLR	E..ESB+T.ERR+2(R4)
	MOV	E..ARG(R4),R0		;SEE IF USER BUFFER EXISTS.
	CMPB	R0,(R5)
	BGT	RET			;NO.
	ASL	R0
	ADD	R5,R0
	MOV	(R0),R0
	BIT	#1,R0
	BNE	RET			;NO.
	CLR	(R0)+			;YES, SO CLEAR
	CLR	(R0)
RET:	RETURN				;RETURN TO CALLER.
;
.GIDNT::
	TST	R0			;INSURE VALID IDENT.
	BLE	ERRET			;NO.
	CMP	R0,#ST.MAX
	BGT	ERRET			;NO.
GID:	MOV	#TDB1,R3		;SCAN FOR IDENT
	CLR	R2
LOOP:	INC	R2
	CMP	R2,#ST.MAX		;NO MORE IDENTS?
	BGT	ERRET
	CMP	-2(R3),R0		;IS THIS THE ONE?
	BEQ	GOTIT			;YES.
	ADD	#TDB2-TDB1,R3		;INCREMENT.
	BR	LOOP
GOTIT:	ADD	#2,(SP)			;BUMP RETURN ADDRESS.
	MOV	#E..ESB,-(SP)		;GET ERROR BLOCK ADDRESS.
	ADD	R4,(SP)
	MOV	(SP)+,T.TESB(R3)		;INSERT INTO TDB.
	RETURN				;RETURN TO .+4
;
ERRET:	MOV	#-1,R2			;SAVE MESSAGE NUMBER.
ERET:	CALL	..STER			;GO DO ERROR BIT.
	RETURN				;RETURN TO .+2
;
.NIDNT::
	TST	INITF			;SEE IF INITTED.
	BEQ	GO			;YES.
	TINIT$				;INITIALIZE TCS
	TDBD$T	#TDB1			;DECLARE ALL TDBS
	TDBD$T	#TDB2
	TDBD$T	#TDB3
	TDBD$T	#TDB4
	CLR	INITF			;CLEAR INIT FLAG.
GO:	CLR	R0			;SET TO LOOK FOR EMPTY SLOT.
	CALL	GID			;GO GET IT.
	BR	ERROR			;NONE LEFT.
	MOV	R2,R0			;SAVE NEW IDENT.
	ADD	#2,(SP)			;FLAG FOR SUCCESS
	RETURN
;
ERROR:	MOV	#-2,R2
	BR	ERET
;
INITF:	.WORD	-1
	.END