.TITLE	DELETE
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	DELETE
;
;  DATE:	12-JUL-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL DELETE(LUN,FILSPEC,[ISW])
;
;		LUN	= INTEGER CONTAINING THE LOGICAL UNIT NUMBER TO BE
;			  USED BY DELETE.
;
;		FILSPEC	= VARIABLE, ARRAY, OR LITERAL SPECIFYING THE 
;			  FILE(S) TO BE DELETED.  THE FILE SPECIFICATION
;			  MAY CONTAIN "WILD-CARD" SPECIFIERS AND MUST INCLUDE
;			  AN EXPLICIT OR WILD-CARD VERSION NUMBER.
;
;		ISW	= VARIABLE TO RECEIVE THE INTEGER STATUS WORD.
;
;			     00 = SUCCESS.  FILE NOT FOUND.
;
;			    +NN = SUCCESS.  NN FILES DELETED.
;
;			    -01 = ILLEGAL FILE SPECIFICATION
;			    -16 = PRIVILEGE VIOLATION
;			    -34 = LUN ALREADY IN USE
;			    -63 = VERSION NOT SPECIFIED
;			    -96 = INVALID LOGICAL UNIT NUMBER
;
;			    -NN = OTHER FCS ERROR CODE
;
;
;  DESCRIPTION:
;
;	"DELETE" ALLOWS THE USER TO DELETE SPECIFIED FILES FROM A FORTRAN
;  PROGRAM.  THE FILE SPECIFICATION MAY INCLUDE "WILD-CARD" SPECIFIERS AND
;  MUST INCLUDE AN EXPLICIT OR WILD-CARD VERSION NUMBER.  THE NUMBER OF FILES
;  DELETED IS OPTIONALLY RETURNED IN THE INTEGER STATUS WORD.
;
;  EXAMPLE:
;
;		CALL DELETE(1,'[1,1]*.TMP;*')
;
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
					;
	.PSECT				;
	.MCALL	CSI$,CSI$1,CSI$2	;
	.MCALL	OTSWA,$AOTS,FBLOCK	; IN [11,40]F4P.MAC
					;
	CSI$				; DEFINE CSI OFFSETS
	OTSWA				; DEFINE OTS OFFSETS
	FBLOCK				; DEFINE FDB AND FFDB OFFSETS AND BITS
					;
CSIB:	.BLKB	C.SIZE			; CSI BLOCK
					;
STAT:	.WORD	0			; FNB STATUS
NEXT:	.WORD	0			; FNB 'NEXT'
					;
	.EVEN				;
					;

	.SBTTL	ENTRY POINT -- DELETE FILE(S)
;
;
					;
DELETE::				;
					;
					; SCAN FOR FILESPEC STRING LENGTH
	MOV	4(R5),R1		; STRING ADDRESS TO R1
	CLR	R2			; CLEAR CHARACTER COUNT
2$:	TSTB	(R1)+			; END-OF-STRING?
	BEQ	4$			; YES, BRANCH FROM SCAN
	INC	R2			; NO, INCREMENT CHARACTER COUNT
	BR	2$			; AND CONTINUE TO SCAN
					;
					; VALIDATE AND PARSE FILESPEC
4$:	MOV	#CSIB,R0		; CSI BLOCK ADDRESS TO R0
	MOV	4(R5),R1		; STRING ADDRESS TO R1
	CSI$1	R0,R1,R2		; CHECK FILE SPECIFICATION SYNTAX
	BCS	IEBAD			; RETURN ON ERROR
	CSI$2	R0,OUTPUT		; PARSE FILE SPECIFICATION
					;
					; TEST LUN / FETCH FDB ADDRESS
	MOV	@2(R5),R2		; LOGICAL UNIT NUMBER TO R2
	BLT	IEILU			; RETURN ON ERROR
	$AOTS				; ADDRESS OF IMPURE OTS SECTION TO R3
	CMP	W.LUNS(R3),R2		; COMPARE LUN TO TKB OPTION
	BLT	IEILU			; RETURN ON ERROR
	CALL	$FCHNL			; ADDRESS OF LUN'S FFDB TO R0
	BIT	#DV.OPN,D.STAT(R0)	; LUN OPEN?
	BNE	IEALN			; YES, RETURN ON ERROR
	ADD	#D.FDB,R0		; ADDRESS OF LUN'S FDB TO R0
					;
					; INITIALIZE LUN'S FNB
	MOV	R0,R1			; ADDRESS OF LUN'S FDB TO R1
	ADD	#F.FNB,R1		; ADDRESS OF LUN'S FNB TO R1
	MOV	#CSIB+C.DSDS,R2		; ADDRESS OF DSD TO R2
	CLR	R3			; NO DEFAULT FNB
	CALL	.PARSE			; INITIALIZE
	BIT	#NB.VER!NB.SVR,N.STAT(R1)	; EXPLICIT OR WILD VERSION?
	BEQ	IEBVR			; NO, RETURN ON ERROR
					;
					; "FIND" AND DELETE FILE(S)
	CLR	R4			; CLEAR DELETE COUNT
6$:	CALL	.FIND			; FETCH FID AND N.NEXT VALUES
	BCS	SUC			; FILE NOT FOUND, RETURN TO CALLER
	MOV	N.STAT(R1),STAT		; PRESERVE FNB STATUS
	MOV	N.NEXT(R1),NEXT		; PRESERVE FNB 'NEXT'
	CLR	N.STAT(R1)		; CLEAR FNB STATUS
	CLR	N.NEXT(R1)		; CLEAR FNB 'NEXT'
	CALL	.DLFNB			; DELETE FILE
	BCS	ERR			; RETURN ON ERROR
	MOV	STAT,N.STAT(R1)		; RESTORE FNB STATUS
	MOV	NEXT,N.NEXT(R1)		; RESTORE FNB 'NEXT'
	INC	R4			; INCREMENT DELETE COUNT
	BR	6$			; AND LOOP FOR MORE
					;

	.SBTTL	PROCESS ERRORS AND RETURN TO CALLER
;
;
					;
SUC:	BR	RTN			; RETURN WITH ISW = # FILES DELETED
					;
IEBAD:	MOV	#IE.BAD,R4		; FILE SPECIFICATION ERROR
	BR	RTN			;
IEILU:	MOV	#IE.ILU,R4		; INVALID LUN
	BR	RTN			;
IEALN:	MOV	#IE.ALN,R4		; LUN ALREADY IN USE
	BR	RTN			;
IEBVR:	MOV	#IE.BVR,R4		; VERSION NOT SPECIFIED
	BR	RTN			;
ERR:	MOVB	F.ERR(R0),R4		; DELETE FAILURE
					;
					;
RTN:	CMPB	#3,(R5)			; THREE ARGUMENTS?
	BGT	2$			; NO, RETURN TO CALLER
	TST	6(R5)			; NULL ARGUMENT?
	BLT	2$			; YES, RETURN TO CALLER
	MOV	R4,@6(R5)		; NO, RETURN STATUS
2$:	RTS	PC			; RETURN TO CALLER
	.END				;