.TITLE	TCLOSE

	.IDENT	/V01A/                                                          ;GLM001
                                                                                ;**-1
;+
;   TCLOSE - FORTRAN TRUNCATE AND CLOSE ROUTINE
;
;   AUTHOR:
;           GARY L. MAXWELL
;           STRONG MOTION DATA CENTER
;           OFFICE OF EARTHQUAKE STUDIES
;           U.S. GEOLOGICAL SURVEY
;           MENLO PARK, CALIFORNIA
;           19-SEP-79
;
;  MODIFICATIONS:                                                               ;GLM001
;                                                                               ;GLM001
;    GLM001     G. L. MAXWELL       8-JAN-79                                    ;GLM001
;	.POINT THE FILE TO BE CLOSED AT VIRTUAL BLOCK 1, BYTE 0,                ;GLM001
;	IN ORDER TO FLUSH ANY UNWRITTEN BUFFERS (.TRNCL DOES NOT                ;GLM001
;	DO THIS!)                                                               ;GLM001
;                                                                               ;GLM001
;  FORTRAN CALL:
;
;        CALL TCLOSE (LUN,IERR)
;        CALL TCLOSE (LUN,IERR,IFCSER)
;
;  INPUTS:
;        LUN: LOGICAL UNIT NUMBER OF OPEN FILE (OPENED WITH
;             BOTH WRITE AND EXTEND ACCESS) TO BE TRUNCATED
;             AND CLOSED.
;  OUTPUTS:
;        IERR: TCLOSE ERROR SEMAPHORE:
;               0 IF ROUTINE WAS SUCCESSFUL (FILE WAS CLOSED)
;               1 IF TRUCATE AND CLOSE BOTH FAILED
;        IFCSER: FCS ERROR CODE (0 IF CLOSE WAS SUCCESSFUL)
;
;        TCLOSE WILL MAKE THE LUN REUSABLE UPON CLOSING THE FILE
;
;  NOTES:
;
;   TCLOSE WILL INDICATE SUCCESS EVEN IF THE TRUNCATE FAILED AND
;   THE CLOSE WORKED. THIS IS DUE TO THE LOGIC OF THE .TRNCL ROUTINE.
;
;   IF THE TRUNCATE AND CLOSE BOTH FAIL, THE FILE IS LEFT POSITIONED            ;GLM001
;   AT THE FIRST BYTE OF THE FIRST VIRTUAL BLOCK OF THE FILE.                   ;GLM001
;                                                                               ;GLM001
;   INVALID LUN'S WILL RESULT IN A FORTRAN ERROR TRAPPED BY
;   THE FCHNL ROUTINE.
;
; REGISTER USAGE:
;
;   R0 = RSX FDB
;   R1 = LOOP COUNTER FOR RESTORING LUN
;   R2 = LUN NUMBER
;   R3 = POINTER TO OTS WORK AREA
;   R4 = WORK POINTER TO FORTRAN FDB
;-

	.GLOBL	$FCHNL,$OTSV,F.ERR,.TRNCL

TCLOSE::
	MOV	@2(R5),R2	; GET LUN
	MOV	@#$OTSV,R3	; POINT TO WORK AREA
	CALL	$FCHNL		; GET FDB ADDRESS IN R0
	MOV	R0,R4		; COPY ADDRESS FOR LATER
	ADD	#14,R0		; POINT TO RSX FDB
	CLR	R1		; HIGH ORDER VBN IS ZERO                        ;GLM001
	MOV	#1,R2		; LOW ORDER: VBN #1                             ;GLM001
	CLR	R3		; POSITION AT BYTE 0 OF VBN 1                   ;GLM001
	CALL	.POINT		; PERFORM THE FLUSH                             ;GLM001
	CLR	@4(R5)		; ASSUME TCLOSE WORKS
	CALL	.TRNCL		; TRUNCATE AND CLOSE
	BCS	20$		; FAILURE! SKIP AHEAD

	MOV	#66,R1		; RESET FDB - GET COUNT
10$:	CLR	(R4)+		; CLEAR A WORD
	SOB	R1,10$		; UNTIL WE'VE REACHED END
	BR	30$		; SKIP ERROR SETTING

20$:	INC	@4(R5)		; INDICATE FAILURE
30$:	MOVB	(R5),R1		; GET NUMBER OF ARGS
	CMP	#2,R1		; DO WE HAVE MORE THAN TWO?
	BGE	TRET		; NO, JUST EXIT
	CMP	#-1,6(R5)	; IFCSER PRESENT?
	BEQ	TRET		; NO, JUST EXIT
	MOVB	F.ERR(R0),R0	; GET ERROR BYTE (SIGN EXTEND!)
	MOV	R0,@6(R5)	; STUFF INTO VARIABLE

TRET:	RETURN			; EXIT TO CALLER

	.END