.TITLE	SPOOL -- SPOOL FILES
	.IDENT	-010000-
	.SBTTL	TITLE PAGE
;+
; ABSTRACT: SPOOL
;
;	THIS SUBROUTINE SPOOLS FILES
;	THE FILE SHOULD BE OPEN; ON EXIT FFOM THIS ROUTINE
;	THE FILE WILL BE CLOSED.
;
; CALLING SEQUENCE:
;
; = SPOOL (FILE, [DEV], [UNIT], [PRI], [FRM], [COPIES], [PRE]) ;
;
; RETURNS:
;
;	FIXED BINARY (15,0)
;
;		+1 SUCCESSFUL COMPLETION.
;		<0 ERROR -- VALUE WILL BE ERROR FROM SEND.
;		-256	FILE NOT YET OPEN.
;		-257	DEVICE STRING TOO SHORT
;
; ARGUMENTS:
;
; FILE EXTERNAL STATIC FILE
;	THE FILE ON WHICH THE OPERATION IS TO BE DONE.
;
; DEV CHARACTER (*) [VARYING]
;	THE DEVICE TO WHICH THE FILE IS TO BE SPOOLED. DEFAULT
;	IS CL:
;
; UNIT FIXED BINARY (15,0)
;	THE UNIT NUMBER OF THE DEVICE TO WHICH THE FILE IS TO BE
;	SPOOLED.
;
; PRI FIXED BINARY (15,0)
;	THE PRIORITY OF THE REQUEST. IF NOT SPECIFIED, THE
;	PRIORITY OF THE TASK IS USED.
;
; FRM FIXED BINARY (15,0)
;	THE FORMS TYPE. IF NOT SPECIFIED, 0 IS USED.
;
; COPIES FIXED BINARY (15,0)
;	THE NUMBER OF COPIES TO PRINT. IF NOT SPECIFIED,
;	ONE IS PRINTED. MAXIMUM IS 31.
;
; PRE FIXED BINARY (15,0)
;	PRE=1 MEANS PRESERVE FILE.
;	PRE=0 OR NOT SPECIFIED MEANS DELETE FILE.
;
; FILES:
;
;	AS SUPPLIED BY THE USER.
;
; ERRORS:
;
;	FILE-RELATED ERRORS WILL BE RETURNED IN THE APPROPRIATE
;	ON-UNIT. ERRORS CONNECTED WITH THE SEND AND INTERNAL ERRORS
;	ARE REPORTED VIA THE RETURN VALUE.
;
; SUBROUTINES:
;
;	.OPENF - PL/I RUNTIME ROUTINE TO FIND AND OPEN FDB'S.
;	.CLOSF - PL/I RUNTIME ROUTINE TO CLOSE FDB'S.
;	ILNAR$ - SUBROUTINE TO SIGNAL WRONG NUMBER OF ARGS.
;	SAVRG$ - SUBROUTINE TO SAVE THE REGISTERS
;
; NONSTANDARD FEATURES:
;
;	THIS SUBROUTINE IS PURE AND POSITION INDEPENDENT, IF THE
;		REFERENCE TO .OPENF IS RESOLVED CORRECTLY.
;
; LIMITATIONS:
;
;	This is a special version for VAX/VMS.  It will not work
;	on a normal RSX-11D/IAS system, but is provided with the
;	VAX/VMS PLIUTL library for compatibility.
;
; WRITTEN: 10-OCT-77, -0.0.0-, BRUCE C. WRIGHT
; Modified: 23-Apr-1981, -1.0.0-, Bruce C. Wright
;	Complete rewrite for VAX/VMS.
; Verified: 23-Apr-1981, -1.0.0-, Bruce C. Wright
;-

	.SBTTL	ARGUMENT DEFINITIONS
;
	.MCALL	DIR$
;
; DEFINE OFFSETS TO ARGUMENT DEFINITIONS OFF OF THE STACK POINTER
;
NARGS	=	22	;NUMBER OF ARGUMENTS PASSED.
FILE	=	NARGS+2	;FILE NAME.
DEV	=	FILE+2	;DEVICE NAME.
UNIT	=	DEV+2	;DEVICE UNIT.
PRI	=	UNIT+2	;PRIORITY
FRM	=	PRI+2	;FORMS
COPIES	=	FRM+2	;COPIES
PRE	=	COPIES+2 ;PRESERVE SWITCH
;
; BIT DEFINITIONS FOR THE STRING DOPE VECTOR
;
SDVDMP	=	040000	;DUMP MODE
SDVVAR	=	100000	;VARYING STRING MODE
;
	.PSECT	$SPOOL,RW,D
exfc:	.byte	145.,8.		; Directive code for elephant directive
	.word	4		; Subfunction code - call native image
	.word	secnam		; Section name to call
	.word	seclen		; Length of section name
;
; Arguments to receive.
;
func:	.word	6		; Function code - execute spooler command
	.word	0		; Queue device name
	.word	0		; Queue unit number and priority
	.word	0		; Copies, forms, delete
	.word	0		; File device name
	.word	0		; File unit number
	.word	0,0,0		; File ID
	.word	0,0,0		; Directory ID
	.word	0,0,0		; File name
	.word	0		; File type
	.word	0		; File version number.
iost:	.word	0,0,0,0		; VMS I/O status block
;
; Global section name
;
	.psect	$merli,ro,d,ovr
secnam:	.ascii	/_DBA0:[PLIUTL]NATVMODE.EXE/
seclen	=	.-secnam

	.SBTTL	EXECUTABLE CODE
	.PSECT	SPOOL,RO,I
;
SPOOL::	JSR	R0,SAVRG$	;SAVE THE REGISTERS
	MOV	R4,-(SP)	;SAVE R4
	MOV	R5,-(SP)	;AND R5
	CMPB	NARGS(SP),#2	;CORRECT NUMBER OF ARGS?
	BHIS	900$		;SKIP IF ENOUGH.
	JSR	R5,ILNAR$	;REPORT THE ERROR.
900$:	MOV	FILE(SP),R2	;GET THE FILE.
	CLR	R1
	CLR	R0		;SET UP FOR CALL TO .OPENF
	.SBTTL	GET FDB AND OPEN FILE IF NECESSARY.
	JSR	R5,.OPENF	;OPEN THE FILE IF NOT YET OPEN.
	000000			;DEFAULTS:
	002000			;CONFLICTS: STRING
	MOV	R3,R0		;GET A(FCB)
	SUB	#S.FDB,R0	;GET A(FDB)
	.SBTTL	GET PRIORITY
	TST	F.BDB(R0)
	BNE	1$
	JMP	256$		;LEAVE IF NOT YET OPEN.
1$:	clr	r3		; Assume priority of 0
	CMP	NARGS(SP),#5	;IS PRI PARAMETER THERE?
	BLT	2$		;NO
	CMP	PRI(SP),#-1	;IS IT SPECIFIED?
	BEQ	2$		;NO
	MOV	@PRI(SP),R3	;YES -- PRI SPECIFIED.
	.SBTTL	GET UNIT NUMBER
2$:	SWAB	R3		;PUT PRI INTO HIGH BYTE
	CLRB	R3		;CLEAN LOW BYTE.
	CMP	NARGS(SP),#4	;IS UNIT SPECIFIED?
	BLT	4$		;NO
	CMP	UNIT(SP),#-1	;IS THE PARAMETER PRESENT?
	BEQ	4$		;NO
	BISB	@UNIT(SP),R3	;SET UNIT NUMBER.
	.SBTTL	GET NUMBER OF COPIES
4$:	MOV	#1,R4		;ASSUME ONE COPY.
	CMP	NARGS(SP),#7.	;IS THE COPY PARAMETER THERE?
	BLT	6$		;NO
	CMP	COPIES(SP),#-1	;IS IT SPECIFIED?
	BEQ	6$		;NO
	TST	@COPIES(SP)	;TOO LOW?
	BEQ	6$		;YES
	MOV	@COPIES(SP),R4	;GET IT.
	CMP	R4,#37		;TOO MANY?
	BLOS	6$		;NO
	MOV	#37,R4		;MAKE IT THE MAXIMUM NUMBER.
	.SBTTL	GET FORMS TYPE
6$:	CMP	NARGS(SP),#6	;IS THE FORMS PARAMETER PRESENT?
	BLT	8$		;NO
	CMP	FRM(SP),#-1	;IS IT SPECIFIED?
	BEQ	8$		;NO
	MOV	@FRM(SP),R5	;GET IT.
	CMP	R5,#6		;IS IT TOO HIGH?
	BLOS	7$		;NO
	CLR	R5		;YES -- MAKE IT 0
7$:	ASH	#5,R5		;MOVE IT INTO PROPER PLACE
	BIS	R5,R4		;MOVE IT INTO PARAMETER
	.SBTTL	GET PRESERVE INDICATOR
8$:	CMP	NARGS(SP),#8.	;IS THE PRESERVE PARM SPECIFIED?
	BLT	10$		;NO
	CMP	PRE(SP),#-1	;IS IT PRESENT ?
	BEQ	10$		;NO
	TST	@PRE(SP)	;IS IT TO BE DELETED?
	BEQ	10$		;YES
	BIS	#40000,R4	;SET PRESERVE BIT.
	.SBTTL	GET DEVICE NAME
10$:	MOV	#"CL,R5		;SET DEFAULT DEVICE.
	CMP	NARGS(SP),#3	;IS DEVICE SPECIFIED?
	BLT	14$		;NO
	CMP	DEV(SP),#-1	;IS IT THERE?
	BEQ	14$		;NO
	MOV	DEV(SP),R1	;GET SDV
	MOV	(R1)+,R2	;GET LENGTH AND BITS.
	MOV	2(R1),R1	;GET A(STRING)
	TST	R2		;IS IT VARYING?
	BGE	12$		;NO
	MOV	(R1)+,R2	;GET THE LENGTH.
12$:	BIC	#SDVVAR,R2	;CLEAN VARYING BIT
	CMP	R2,#2		;IS LENGTH TOO SHORT?
	BLT	257$		;YES
	MOVB	1(R1),R5	;GET HIGH BYTE.
	SWAB	R5		;GET IT INTO HIGH BYTE.
	CLRB	R5		;CLEAN LOW BYTE IN R5
	BISB	(R1),R5		;MOVE IN THE LOW BYTE.
	.SBTTL	COMPLETE SPOOLING PROCESSING
14$:	mov	#iost,r1	; Point to the parameter block.
	MOV	R0,R2
	ADD	#F.FNB,R2
	MOV	N.FVER(R2),-(r1)
	MOV	N.FTYP(R2),-(r1)
	MOV	N.FNAM+4(R2),-(r1)
	MOV	N.FNAM+2(R2),-(r1)
	MOV	N.FNAM(R2),-(r1)
	MOV	N.DID+4(R2),-(r1)
	MOV	N.DID+2(R2),-(r1)
	MOV	N.DID(R2),-(r1)
	mov	n.fid+4(r2),-(r1)
	mov	n.fid+2(r2),-(r1)
	mov	n.fid(r2),-(r1)
	MOV	N.UNIT(R2),-(r1)
	MOV	N.DVNM(R2),-(r1)
	MOV	R4,-(r1)	;SAVE COPIES, FORMS, DELETE
	MOV	R3,-(r1)	;SAVE PRI, UNIT
	MOV	R5,-(r1)	;SAVE DEVICE NAME
	CLR	R3		;CLEAR FLAG REG.
	TST	F.SPDV(R0)	;IS IT ALREADY SPOOLED?
	BNE	99$		;YES -- DON'T SPOOL IT AGAIN.
	BITB	#FD.REC,F.RCTL(R0) ;IS IT RECORD ORIENTED DEVICE?
	BEQ	100$		;NO -- SO IT CAN BE SPOOLED.
99$:	INC	R3		;SET FLAG REG - DON'T DO SEND.
100$:	MOV	R3,-(SP)	;SAVE R3
	MOV	FILE+42(SP),R2	;GET THE FILE BLOCK
	JSR	R5,.CLOSF	;CLOSE THE FILE.
	.WORD	0
	.WORD	0
	MOV	(SP)+,R3	;RECOVER R3
	BNE	300$		; Don't do the send
110$:	dir$	#exfc		; Execute extended function.
	br	300$		; And return the error code.
256$:	MOV	#-256.,@#$DSW	;ERROR - FILE NOT OPEN.
	BR	300$		;AND EXIT
257$:	MOV	#-257.,@#$DSW	;ERROR - DEVICE STRING TOO SHORT
	.SBTTL	RETURN THE ERROR CODE IF ANY
300$:	MOV	NARGS(SP),R0	;FIND THE LAST ARGUMENT.
	ASL	R0		;MAKE IT WORDS.
	ADD	SP,R0		;POINT INTO THE STACK.
	MOV	@#$DSW,@NARGS(R0) ;RETURN THE ERROR CODE IF ANY
	.SBTTL	RETURN TO CALLING PROGRAM.
	MOV	(SP)+,R5	;RECOVER R5
	MOV	(SP)+,R4	;AND R4
	RTS	PC		;AND LEAVE.
	.END