.TITLE	IVSAST -- VARIABLE SEND-DATA AST SETUP ROUTINE
	.IDENT	/073181/
	.MCALL	QIOW$,DIR$,ASTX$S
EFN	=	5			;DEFINE LOCAL EVENT FLAG FOR USE HERE
;
;	THIS MODULE CONTAINS A FORTRAN-CALLABLE SETUP ROUTINE THAT
;	ENABLES AST'S FOR A LIST OF VS: QUEUES.  IT ALSO CONTAINS THE
;	ACTUAL AST ROUTINE ENTRY POINT, AS WELL AS THE AST EXIT CODE,
;	SINCE FORTRAN ITSELF IS UNABLE TO HANDLE AST ROUTINES.
;
;	THE SETUP ROUTINE:
;
;	INTEGER*2 FUNCTION IVSAST(LUN,NQUES,QNAMES,IASTAD[,])
;
;	WHERE:
;		LUN	IS A LOGICAL UNIT ASSIGNED TO VS:, WHICH IS TO BE USED
;			TO SET UP THE AST'S
;		NQUES	IS THE NUMBER OF QUEUES TO HAVE AST'S SET UP
;		QNAMES	IS AN ARRAY OF <NQUES> RAD50 QUEUE NAMES
;		IASTAD	IS EITHER: (1) THE NAME OF THE AST SUBROUTINE
;			   OR: (2) AN ARRAY OF <NQUES> AST ROUTINE ADDRESSES
;			THE FIRST FORM IS SPECIFIED WITH NO COMMA AFTER THE
;			ROUTINE NAME, WHILE THE SECOND FORM REQUIRES THE COMMA
;
;	AND THE VALUE RETURNED IS 0 IF THE CALL FAILED, AND NONZERO IF IT
;	SUCCEEDED.  (YOU CAN DO A  CALL IVSAST  INSTEAD OF A FUNCTION CALL,
;	IF YOU DON'T CARE ABOUT THE STATUS.)
;
;	TYPICAL USAGE:
;		REAL*4 QNAMES(3)
;		INTEGER*2 IASTAD(3)
;		EXTERNAL ASTSUB,ASTSB1,ASTSB2,ASTSB3
;		DATA QNAMES/6RFIRSTQ,6RNEXTQ ,6RLASTQ /
;	C
;	C  THE FOLLOWING THREE STATEMENTS ARE FOR THE SECOND FORM ONLY
;	C
;		CALL GETADR(IASTAD(1),ASTSB1)
;		CALL GETADR(IASTAD(2),ASTSB2)
;		CALL GETADR(IASTAD(3),ASTSB3)
;		...
;		CALL ASNLUN(1,'VS',0)
;	C
;	C  FIRST FORM CALL
;	C
;		ISTAT=IVSAST(1,3,QNAMES,ASTSUB)
;	C
;	C  SECOND FORM CALL
;	C
;		ISTAT=IVSAST(1,3,QNAMES,IASTAD,)
;		...
;
;	THE FIRST CALL SETS UP	ASTSUB	AS THE AST ROUTINE FOR ALL THREE QUEUES
;
;	THE SECOND CALL SETS UP	ASTSB1	AS THE AST ROUTINE FOR QUEUE	FIRSTQ
;				ASTSB2					NEXTQ
;				ASTSB3					LASTQ
;
;	TO CLEAR THE CURRENT AST DEFINITIONS, CALL IVSAST WITH NQUES=0 AND
;	NO QNAMES OR IASTAD PARAMETERS, E.G.  CALL IVSAST(1,0)
;
;	YOU CAN DECLARE IVSAST TO BE TYPE  LOGICAL  IN WHICH CASE A STATEMENT
;	LIKE:  IF(IVSAST(...))GOTO12345  WILL GO TO 12345 IF THE CALL SUCCEEDS.
;
;	YOU *MUST* CLEAR THE CURRENT AST DEFINITIONS IF, FOR SOME REASON, YOU
;	WANT TO CHANGE AST SETUPS IN MID-PROGRAM.  A SECOND CALL TO IVSAST
;	WILL FAIL OTHERWISE!  ALSO, THE QNAMES AND IASTAD ARRAYS *MUST NOT*
;	BE MODIFIED WHILE AST'S ARE SET UP!!!
;
;	PLEASE NOTE:  IF YOU ARE USING OVERLAYS, THIS ROUTINE, AND THE AST
;	ROUTINES, SHOULD ALL BE IN THE ROOT SEGMENT!
;
;	THE AST SUBROUTINE SHOULD LOOK LIKE THIS:
;
;		SUBROUTINE ASTSUB(QUENAM,LENGTH)
;				...
;			AST PROCESSING CODE
;				...
;		RETURN
;
;	THE PARAMETER  QUENAM  WILL RECEIVE THE RAD50 QUEUE NAME, AND THE
;	PARAMETER  LENGTH  WILL RECEIVE THE LENGTH OF THE MESSAGE (INCLUDING
;	THE FOUR EXTRA BYTES FOR SENDER TASK NAME).
;
	.PAGE
	.PSECT	.CODE.,RW,I,LCL,REL,CON
IVSAST::
	MOV	@2(R5),LUN		;SET VS: LUN
	TST	@4(R5)			;CLEARING AST'S?
	BEQ	ASTCLR			;YES, GO CLEAR THEM
	TST	NASTYS			;HOW MANY AST'S SET NOW?
	BNE	RETN0			;RETURN IF SOME ALREADY SET
	MOV	@4(R5),NASTYS		;COPY NUMBER OF AST'S
	MOV	6(R5),QLSTAD		;GET QUEUE LIST ADDRESS
	CMPB	#5,(R5)			;COMMA PRESENT AFTER FOURTH PARM?
	BEQ	10$			;IF SO, PROCESS LIST OF AST'S
	CLR	SLSTAD			;NO AST SUBROUTINE LIST ADDRESS
	MOV	10(R5),SUBADR		;COPY SINGLE AST ROUTINE ADDRESS
	BR	20$			;MERGE WITH LIST CODE
10$:	CLR	SUBADR			;NO SINGLE AST ROUTINE ADDRESS
	MOV	10(R5),SLSTAD		;SET AST SUBROUTINE LIST ADDRESS
20$:	MOV	NASTYS,R4		;GET NUMBER OF AST'S TO BE SET
	MOV	QLSTAD,R3		;GET QUEUE LIST ADDRESS
	MOV	#IO.AST,IOFUNC		;PUT IN "SET AST" FUNCTION
	MOV	#VSAST,IOPRM6		;SET OUR AST ADDRESS
22$:	MOV	(R3)+,QNAME1		;STORE FIRST WORD OF QUEUE NAME
	MOV	(R3)+,QNAME2		;STORE SECOND WORD OF QUEUE NAME
	DIR$	#QIOWPB			;DO ONE
	CMP	#1,$DSW			;DSW OK?
	BNE	RETN0			;NO, ERROR
	CMPB	#1,IOSB			;SUCCESS?
	BNE	RETN0			;NO, ERROR
	SOB	R4,22$			;LOOP FOR ALL QUEUES
	MOV	#177777,R0		;INDICATE SUCCESS
	RTS	PC			;RETURN
ASTCLR:
	MOV	#IO.CLN,IOFUNC		;SET CLEAN-UP FUNCTION
	DIR$	#QIOWPB			;DO IT
	CMP	#1,$DSW			;DSW OK?
	BNE	RETN0			;NO, ERROR
	CMPB	#1,IOSB			;SUCCESS?
	BNE	RETN0			;NO, ERROR
	CLR	NASTYS			;GET RID OF THEM NASTY AST'S
	MOV	#177777,R0		;INDICATE SUCCESS
	RTS	PC			;RETURN
RETN0:
	CLR	R0			;INDICATE FAILURE
	RTS	PC			;AND RETURN
;
;	THIS IS THE ACTUAL AST ROUTINE
;
VSAST:
	MOV	(SP)+,QNAME1		;GET FIRST QUEUE NAME WORD
	MOV	(SP)+,QNAME2		;GET SECOND QUEUE NAME WORD
	MOV	(SP)+,LENGTH		;GET LENGTH OF MESSAGE
	MOV	R0,-(SP)		;PUSH ALL THE REGISTERS
	MOV	R1,-(SP)		;
	MOV	R2,-(SP)		;
	MOV	R3,-(SP)		;
	MOV	R4,-(SP)		;
	MOV	R5,-(SP)		;
	MOV	SUBADR,R0		;GET SUBROUTINE ADDRESS AND TEST
	BNE	10$			;IF SINGLE SUBROUTINE, CALL IT
	MOV	SLSTAD,R1		;ELSE GET LIST ADDRESS
	BEQ	ASTEXT			;NO LIST, SO EXIT
	MOV	QLSTAD,R2		;GET QUEUE NAME LIST ADDRESS
	MOV	NASTYS,R3		;GET COUNT
1$:	MOV	(R1)+,R0		;GET NEXT ROUTINE ADDRESS
	CMP	QNAME1,(R2)+		;FIRST WORDS MATCH?
	BNE	3$			;NO THEY DON'T
	CMP	QNAME2,(R2)+		;SECOND WORDS MATCH?
	BEQ	10$			;YES, DO THE CALL
	BR	5$			;NO, LOOP
3$:	TST	(R2)+			;SKIP THE SECOND WORD
5$:	SOB	R3,1$			;LOOP FOR ALL THE REST
	BR	ASTEXT			;IF NOT FOUND, SKIP IT
10$:	MOV	#PARMS,R5		;SET PARAMETER LIST
	JSR	PC,(R0)			;CALL THE SUBROUTINE
ASTEXT:	MOV	(SP)+,R5		;RESTORE THE REGISTERS
	MOV	(SP)+,R4		;
	MOV	(SP)+,R3		;
	MOV	(SP)+,R2		;
	MOV	(SP)+,R1		;
	MOV	(SP)+,R0		;
	ASTX$S				;EXIT FROM AST STATE
;
	.PSECT	.DATA.,RW,D,LCL,REL,CON
QIOWPB:	QIOW$	0,0,EFN,,IOSB,,<0,0,0,0,0,0>
LUN	=	QIOWPB+Q.IOLU		;LUN WORD
IOFUNC	=	QIOWPB+Q.IOFN		;I/O FUNCTION WORD
IOPRM6	=	QIOWPB+Q.IOPL+12	;SIXTH QIO PARAMETER WORD (AST ADDRESS)
QNAME1	=	QIOWPB+Q.IOPL+4		;QUEUE NAME WORD 1 (QIO PARM 3)
QNAME2	=	QIOWPB+Q.IOPL+6		;QUEUE NAME WORD 2 (QIO PARM 4)
IOSB:	.BLKW	2			;I/O STATUS BLOCK
NASTYS:	.WORD	0			;NUMBER OF AST'S SET UP
QLSTAD:	.BLKW	1			;QUEUE LIST ADDRESS
SLSTAD:	.WORD	0			;AST SUBROUTINE LIST ADDRESS
SUBADR:	.WORD	0			;SINGLE AST SUBROUTINE ADDRESS
LENGTH:	.BLKW	1			;LENGTH PARAMETER TO FORTRAN ROUTINES
PARMS:	.WORD	2,QNAME1,LENGTH		;PARAMETER LIST FOR FORTRAN CALLS
IO.AST	=	4400			;SET/CLEAR AST FUNCTION
IO.CLN	=	3400			;CLEAN-UP AST'S FUNCTION
	.END