.TITLE	QUEUE
;
; FORTRAN CALLABLE ROUTINE TO MAKE QUEUE REQUESTS.
;
; WRITTEN   NOVEMBER 1979   R B FRENCH   THE BOEING COMPANY
;
; CALLING SEQUENCE
;
;    CALL QUEUE(FNAME,DEV,PRI,LUN,FLAGS,NCOPY,NFORM,ERR)
;
;	FNAME = FILENAME TO BE QUEUED. IF FNAME = '$S' OR '$E', CONCATENATED
;		OUTPUT WILL BE STARTED OR ENDED, RESPECTIVELY.
;	DEV   = DEVICE TO BE QUEUED TO (DEFAULT = 'CL')
;	PRI   = PRIORITY (DEFAULT = 100)
;	LUN   = FREE LUN FOR QUEUE'S INTERNAL USE (DEFAULT = 1)
;
;   THE NEXT THREE ARGUMENTS WILL BE IGNORED IF DEV = 'BA'
;
;	FLAGS = FLAGS INDICATING TYPE OF QUEUE REQUEST
;		1 - DON'T DELETE FILE AFTER PRINTING
;		2 - DON'T PRINT BANNERS
;		(DEFAULT = DELETE FILE AND PRINT BANNERS)
;	NCOPY = NUMBER OF COPIES (DEFAULT = 1)
;	NFORM = FORM NUMBER (DEFAULT = 0)
;
;	ERR   = OPTIONAL ERROR RETURN. IF NOT INPUT, ERRORS WILL BE
;		REPORTED VIA MO (MESSAGE OUTPUT HANDLER).
;		 1 = SYNTAX ERROR
;		 0 - SUCCESS
;		<0 - FCS ERROR CODE
;
	.MCALL	SPRSY$,CSI$,CSI$1,CSI$2,OPEN$R,CLOSE$,DIR$,VSDR$,MOUT$S
;
	SPRSY$			;DEFINE SPOOLER SYMBOLS
	CSI$			;DEFINE CSI SYMBOLS
;
QUEUE::
	MOV	#"CL,BUF	;SET DEFAULT DEVICE NAME
	MOV	#BUF+2,R0	;POINT TO 2ND BUFFER WORD
	MOV	#12.,R1		;12. WORDS LEFT
10$:	CLR	(R0)+		;CLEAR 'EM
	SOB	R1,10$
;
	MOV	2(R5),R1	;GET FILENAME
	CMPB	#'$,(R1)	;CONCATENATE REQUEST ?
	BNE	FILE		;BR IF NOT
	CMPB	#'S,1(R1)	;IS IT START
	BNE	20$		;BR IF NOT
	MOVB	#QF.STC,BUF+5	;SET FLAG ACCORDINGLY
	BR	40$		;AND GO DO IT
20$:	CMPB	#'E,1(R1)	;HOW ABOUT END
	BEQ	30$		;GOOD !
	JMP	SYNERR		;GO TELL THIS TURKEY HE SCREWED UP
30$:	MOVB	#QF.ENC,BUF+5	;SET FLAG
40$:	MOV	#3,VSDR+S.DRBL	;3 WORDS FOR CONCATENATE REQUEST
	JMP	SEND		;TELL SPR ABOUT IT
;
FILE:	MOV	#13.,VSDR+S.DRBL ;13. WORD SEND BLOCK
	MOV	#32.,R0		;UP TO 32 BYTES IN A FILENAME
	MOV	R1,R2		;SAVE THE START IN R2
30$:	TSTB	(R1)+		;SCAN FOR ZERO BYTE
	BEQ	40$		;GOT IT !
	SOB	R0,30$
	BR	SYNERR		;AND GO REPORT ERROR
;
40$:	DEC	R1		;BACK UP POINTER
	SUB	R2,R1		;SUBTRACT OFF THE START
	CSI$1	#CSIBLK,R2,R1	;CHECK SYNTAX
	BCS	SYNERR		;BR ON ERRORS
	CSI$2	#CSIBLK,OUTPUT	;PARSE IT
	BCC	GO		;CHECK FOR ERRORS
;
SYNERR:	MOV	#1,R2		;1 = SYNTAX ERROR
	JMP	ERR
;
GO:	MOV	#1,R2		;ASSUME LUN 1
	MOV	#4,R0		;WAS LUN INPUT
	JSR	PC,IARG		;GO AND SEE
	BCS	50$		;BR IF NOT
	MOV	@10(R5),R2	;OTHERWISE GET IT
50$:	JSR	PC,$FCHNL	;GET THE FORTRAN FDB
	ADD	#12.,R0		;OFFSET TO NORMAL FDB
	MOV	R0,-(SP)	;AND SAVE IT
	OPEN$R	,R2,#CSIBLK+C.DSDS ;OPEN THE FILE
	BCC	60$		;CHECK FOR ERRORS
	TST	(SP)+		;CLEAN UP STACK
	BR	OPNERR
60$:	ADD	#F.FNB,R0	;OFFSET TO FILENAME BLOCK
	MOV	#BUF+6,R1	;POINT TO BUFFER
	MOV	N.DVNM(R0),(R1)+ ;PUT FILENAME DATA IN BUFFER
	MOV	N.UNIT(R0),(R1)+ ;
	MOV	N.DID(R0),(R1)+	 ;
	MOV	N.DID+2(R0),(R1)+ ;
	MOV	N.DID+4(R0),(R1)+ ;
	MOV	N.FNAM(R0),(R1)+ ;
	MOV	N.FNAM+2(R0),(R1)+ ;
	MOV	N.FNAM+4(R0),(R1)+ ;
	MOV	N.FTYP(R0),(R1)+ ;
	MOV	N.FVER(R0),(R1)+ ;
;
	CLOSE$	(SP)+		;CLOSE THE FILE
;
	MOVB	DEFPRI,BUF+3	;PUT IN DEFAULT PRIORITY
	MOV	#3,R0		;WAS PRIORITY SPECIFIED
	JSR	PC,IARG
	BCS	DEV		;BR IF NOT INPUT
	MOVB	@6(R5),BUF+3	;OTHERWISE PUT IT IN BUFFER
;
DEV:	MOV	#2,R0		;WAS DEVICE SPECIFIED ?
	JSR	PC,IARG		;GO CHECK IT
	BCS	FLAG		;BR IF NOT
	MOV	@4(R5),BUF	;OTHERWISE GET IT
	CMP	#"BA,BUF	;WAS DEVICE 'BA' ?
	BNE	FLAG		;BR IF NOT
	MOVB	#QF.INO,BUF+5	;OTHERWISE SET PROPER FLAG
	BR	SEND		;AND DO IT
;
FLAG:	MOV	#5,R0		;FLAGS ?
	JSR	PC,IARG
	BCS	COPY
	MOV	@12(R5),R0	;GET THEM
	BIC	#177774,R0	;MAKE SURE THERE'S NO GARBAGE
	ASH	#6,R0		;SHIFT EM
	MOVB	R0,BUF+5	;AND INTO THE BUFFER
;
COPY:	MOVB	#1,BUF+4	;DEFAULT OF 1 COPY
	MOV	#6,R0		;COPIES INPUT ?
	JSR	PC,IARG
	BCS	FORM		;BR IF NOT
	MOVB	@14(R5),BUF+4	;PUT IN BUFFER
;
FORM:	MOV	#7,R0		;FORMS INPUT ?
	JSR	PC,IARG
	BCS	SEND		;BR IF NOT
	MOVB	@16(R5),R0	;PUT IN R0
	ASH	#5,R0		;SHIFT TO PROPER POSITION
	BISB	R0,BUF+5	;AND PUT IN BUFFER
;
SEND:	DIR$	#VSDR		;SEND THE WHOLE THING TO SPR...
	MOV	#10,R0		;ERROR RETURN SPECIFIED ?
	JSR	PC,IARG
	BCS	RET		;BR IF NOT
	CLR	@20(R5)		;ELSE CLEAR IT
RET:	RTS	PC
;
OPNERR:	MOVB	F.ERR(R0),FCSERR ;GET FCS ERROR CODE
	MOV	F.LUN(R0),BUF	;AND THE LUN
	CLRB	BUF+1		;CLEAR UPPER BYTE
	BIS	#177400,FCSERR	;SET THE SIGN BIT
ERR:	MOV	#10,R0		;ERROR RETURN SPECIFIED ?
	JSR	PC,IARG
	BCS	10$		;IF NOT, GO USE MO
	MOV	FCSERR,@20(R5)	;OTHERWISE JUST RETURN ERROR
	BR	RET
10$:	TST	FCSERR		;OPEN ERROR ?
	BEQ	20$		;BR IF SYNTAX
	MOV	R5,-(SP)	;SAVE R5
	MOV	#LIST,R5	;POINT TO ARGUMENT LIST
	JSR	PC,IOE		;GET ERROR CODE
	MOV	(SP)+,R5	;RESTORE R5
	MOV	BUF+2,BUF+16	;TRUNCATE START OF STRING
	SUB	#14,BUF+16	;CORRECT STRING SIZE
	MOV	#BUF+22,BUF+20	;PUT IN STRING ADDRESS
	MOV	FCSERR,BUF+14	;DON'T FORGET FCSERR
	MOUT$S	#OERR,#BUF+14	;REPORT ERROR
	CLR	FCSERR		;CLEAR ERROR (SINCE IT'S USED FOR TEST)
	BR	RET
20$:	MOUT$S	#SERR
	BR	RET
;
SERR:	.WORD	NSEMSG		;SYNTAX ERROR MESSAGE FOR MO
	.WORD	SEMSG
SEMSG:	.ASCIZ	/QUEUE: SYNTAX ERROR/
NSEMSG=.-SEMSG
;
OERR:	.WORD	NOEMSG
	.WORD	OEMSG
OEMSG:	.ASCIZ	/QUEUE: OPEN ERROR %D  %VA/
NOEMSG=.-OEMSG
;
	.EVEN
FCSERR:	.WORD	0
;
VSDR:	VSDR$	SPR...,,,,,BUF,13.
BUF:	.BLKW	13.
CSIBLK:	.BLKB	C.SIZE
DEFPRI:	.WORD	100.		;DEFAULT PRIORITY
;
LIST:	.WORD	4		;ARGUMENT LIST FOR IOE
	.WORD	BUF		;LUN
	.WORD	FCSERR		;ERROR CODE
	.WORD	BUF+6		;ERROR STRING
	.WORD	BUF+2		;LENGTH OF STRING
	.PAGE
;
; ROUTINE THAT CHECK THE VALIDITY OF A FORTRAN
; CALLING ARGUMENT.
;
; INPUT
;
; R0 = ARGUMENT NUMBER
;
; OUTPUT
;
; CARRY BIT WILL BE SET IF ARGUMENT WAS NOT
; INPUT OR IS A NULL ARGUMENT.
;
IARG:
	CMPB	R0,(R5)		;CHECK NUMBER OF ARGUMENTS
	BLE	10$		;BR IF OK
	SEC
	BR	30$
10$:	MOV	R0,R1		;GET ARGUMENT NUMBER
	ASL	R1		;CONVERT TO WORDS
	ADD	R5,R1		;AND ADD ARGUMENT LIST POINTER
	CMP	#-1,(R1)	;IS IT NULL
	BNE	20$		;BR IF NOT
	SEC
	BR	30$
20$:	CLC
30$:	RTS	PC
;
	.END