.TITLE	GETFLS - FILE OPENING AND CLOSING FOR TECOIO

	.IDENT	"X0216"

; ANDREW C. GOLDSTEIN  3-AUG-79  19:08
; MARK H. BRAMHALL     10-JUL-79  19:33

	.MCALL	CSI$1,CSI$2,OFNB$R,OFNB$W,OFNB$A,CLOSE$,QIOW$C

.SBTTL	MAIN FILE OPEN ROUTINE

;+
;
; *** - GETFLS	OPEN REQUESTED FILES
;
; THIS ROUTINE OPENS THE REQUESTED FILES AND PREPARES FOR INPUT AND OUTPUT.
; IT IS CALLED IN RESPONSE TO "ER", "EW", AND "EB" COMMANDS.
;
; INPUTS:
;
;	R2 =	MODE FLAG
;	FILBUF(R5) CONTAINS POINTER TO FILE STRING, TERMINATED WITH -1.
;
; OUTPUTS:
;
;	NONE.
;	ALL REGISTERS ARE PRESERVED.
;
; INTERPRETATION OF MODE FLAG:
;
;	ZERO		"ER" OPEN
;	POSITIVE	"EW" OPEN
;	NEGATIVE:
;	 =	'B-'R	"EB" OPEN
;	 =	'I-'R	"EI" OPEN
;	 =	'N-'R	"EN" OPEN
;
; IF THE SPECIFIED LENGTH OF THE FILE STRING IS ZERO AND THE MODE IS 0,
; THE FILE AND STATE SAVED BY THE LAST CALL TO INPSAV AND/OR OUTSAV WILL
; BE RESTORED.
;
; CSI IS CALLED TO SCAN THE FILE STRING AND CONSTRUCT A DATASET POINTER
; BLOCK. THEN THE APPROPRIATE OPEN CALL IS MADE.
;
; THE FOLLOWING SWITCHES ARE RECOGNIZED TO FORCE FCS CARRIAGE CONTROL
; ATTRIBUTES ON BOTH INPUT AND OUTPUT FILES:
;
;	/-CR	USE INTERNAL CARRIAGE CONTROL (I.E., NONE)
;	/CR	USE IMPLIED CARRIAGE CONTROL (FD.CR)
;	/FT	USE FORTRAN CARRIAGE CONTROL (FD.FTN)
;	/B2	DO BASIC-PLUS-2 "&" PROCESSING
;
;-

	.PSECT	CODE,RO,I
	.ENABL	LSB

GETFLS::
	SAVE			; SAVE ALL REGISTERS
	MOV	FILBUF(R5),R0	; GET ADDRESS OF FILE STRING
	MOV	#STRNGL,R3	; MAXIMUM BYTE COUNT
	MOV	#STRING,R2	; POINT TO STRING BUFFER
10$:	MOVB	(R0)+,R1	; PICK UP BYTE
	BEQ	30$
	CMPB	R1,#40		; A SPACE OR CONTROL CHARACTER?
	BLOS	10$		; YES, IGNORE IT
	CMPB	R1,#'A+40	; SEE IF THIS IS A LOWER CASE ALPHA
	BLO	20$		; NO
	CMPB	R1,#'Z+40
	BHI	20$		; NOT EITHER
	BIC	#40,R1		; IT IS - CONVERT TO UPPER CASE
20$:	MOVB	R1,(R2)+	; COPY CHAR INTO BUFFER
	SOB	R3,10$
	ERROR	BFS,<"Bad file string">
;
; TERMINATOR DETECTED
;
30$:	NEG	R3
	ADD	#STRNGL,R3	; COMPUTE STRING'S BYTE COUNT
	BNE	60$
	MOV	SR2(SP),R4	; GET OPEN MODE SPECIFIER
	BGE	50$		; "ER" AND "EW" FIGURED OUT LATER
	CMPB	R4,#'N-'R	; CHECK FOR "EN"
	BEQ	ENEXT
	CMPB	R4,#'I-'R	; CHECK FOR "EI"
	BNE	40$
	CLRB	CCLFLG		; YES - FLUSH STORED COMMAND LINE
	JMP	INDCLS
40$:	ERROR	IEC,<"Illegal E character">
50$:	JMP	FILRST		; NULL STRING = FILE RESTORE

60$:	CSI$1	#CSIBLK,#STRING,R3
	BCC	70$		; CHECK FOR SYNTAX ERROR
	ERROR	BFS,<"Bad file string">

70$:	CSI$2	R0,OUTPUT,#SWTAB ; GET A FILE SPEC FROM STRING
	BCC	80$		; CHECK FOR FUNNY STUFF
	ERROR	ILS,<"Illegal switches">

80$:	MOV	SR2(SP),R4	; GET SPECIFIED OPEN REQUIREMENTS.
	MOV	#CS.MOR,R1	; CHECK FOR MULTIPLE FILES
	CMPB	R4,#'N-'R
	BEQ	90$		; UNLESS "EN" COMMAND
	BIS	#CS.WLD,R1	; ALSO CHECK FOR WILD CARDS
90$:	BITB	R1,C.STAT(R0)
	BEQ	100$		; LOOK FOR WILD CARDS, MULTIPLE FILES
	ERROR	BFS,<"Bad file string">

100$:	CLR	DN+N.FTYP	; SET UP FOR STANDARD DEFAULT
	TST	R4		; DISPATCH ON OPEN MODE
	BGE	EWOPEN		; GO OPEN FOR EDIT READ/WRITE
	CMPB	R4,#'B-'R	; CHECK FOR "EB"
	BEQ	EBOPEN
	CMPB	R4,#'I-'R	; CHECK FOR "EI"
	BEQ	EIOPEN
	CMPB	R4,#'N-'R	; CHECK FOR "EN"
	BEQ	ENOPEN
	ERROR	IEC,<"Illegal E character">

	.DSABL	LSB

; THE FOLLOWING ROUTINES DO THE ACTUAL FILE MANIPULATION
; APPROPRIATE TO THE CALL.

	.ENABL	LSB
;
; HERE WHEN EDIT NEXT SETUP IS REQUESTED BY CALLER
;
ENOPEN:	MOV	#6,R0
	MOV	#DATSET,R1	; POINT TO CSI DATASET OUTPUT
	MOV	#ENDATS,R2	; POINT TO EN DATASET
10$:	MOV	(R1)+,(R2)+	; COPY CSI OUTPUT TO EN DATASET
	SOB	R0,10$

	MOV	ENDATS+N.DIRD,R0 ; GET LENGTH OF DIRECTORY STRING
	BEQ	30$		; BRANCH IF NULL
	MOV	ENDATS+N.DIRD+2,R1 ; GET ADDRESS OF DIRECTORY
	MOV	#ENAFNB+N.WNM2,R2 ; ADDRESS OF DIRECTORY STRING STORAGE
	MOV	R2,ENDATS+N.DIRD+2 ; SET NEW STRING ADDRESS
20$:	MOVB	(R1)+,(R2)+	; COPY DIRECTORY STRING INTO SCRATCH STORAGE
	SOB	R0,20$		; FOR FUTURE USE

30$:	MOV	#ENFDB,R0	; GET FDB
	MOV	#ENFDB+F.FNB,R1	; AND FNB
	MOV	F.DSPT(R0),R2	; DATASET DESCRIPTOR
	MOV	F.DFNB(R0),R3	; DEFAULT NAME BLOCK
	MOV	#ENAFNB,R4	; AND AUX NAME BLOCK
	CALL	.WPARS		; PARSE THE CONTROLLING STRING
	BCS	FILERR
	INCB	ENFLAG		; INDICATE "EN" VALID
	MOV	N.FVER(R1),ENVER ; SAVE ORIGINAL VERSION NUMBER
	RETURN
;
; HERE WHEN THE NEXT OCCURRANCE OF A WILD CARD CLASS IS REQUESTED.
;
ENEXT:	TSTB	ENFLAG		; SEE IF CONTEXT IS VALID
	BNE	40$		; IF NOT,
	ERROR	FNF,<"No such file">
40$:	MOV	#ENFDB,R0	; GET FDB
	MOV	#ENFDB+F.FNB,R1	; AND FNB
	MOV	#ENAFNB,R2	; AUX FNB FOR WILD CARD DIRECTORIES
	BIT	#NB.SFL,N.STAT(R1) ; SEE IF ANY WILD CARDS AT ALL
	BNE	50$		; BRANCH IF YES
	CLRB	ENFLAG		; ELSE MAKE THE CALL A SINGLE SHOT AFFAIR
50$:	MOV	N.FVER(R1),N.FID+4(R1) ; COPY OLD VERSION NUMBER
	BIS	#NB.WLV,N.STAT(R1) ; AND SET WILD VERSION INPUT FLAG
	MOV	ENVER,N.FVER(R1) ; RESTORE ORIGINAL VERSION NUMBER
	CALL	GETRWD		; GET REWIND SWITCH
	CALL	.FNDNX		; FIND NEXT FILE
	BCC	70$
	CLRB	ENFLAG		; CONTEXT NO LONGER VALID
	BR	FILERR
;
; HERE WHEN EDIT INDIRECT HAS BEEN REQUESTED BY CALLER
;
EIOPEN:	CALL	INDCLS		; CLOSE OPEN COMMAND FILE IF ANY
	MOV	#CMDR50,DN+N.FTYP ;DEFAULT TO .CMD FOR FILE TYPE
	MOV	#CMDFDB,R0
	CALL	PARSE		; PARSE THE FILE NAME
	BCS	60$
	CALL	GETRWD		; GET REWIND SWITCH
	OFNB$R	R0		; AND OPEN THE INDIRECT FILE
60$:	BCS	FILERR
	MOV	R0,INDIR(R5)	; SET INDIRECT FILE OPEN INDICATOR
	MOV	#-1,F.NRBD(R0)	; CLEAN OUT RECORD BUFFER
70$:	JMP	GFLXIT

;
; TO HERE ON ALL FILE SYSTEM ERRORS.
;
FILERR:	JMP	FDBERR
;
; HERE WHEN OPEN FOR EDIT WRITE HAS BEEN REQUESTED.
; OPEN AN OUTPUT FILE.
;
EWOPEN:	BEQ	EROPEN		; GO OPEN FOR EDIT READ
	MOV	#OUTFDB,R0
	TST	F.BDB(R0)	; SEE IF AN OUTPUT FILE IS OPEN
	BEQ	80$		; BRANCH IF NOT
OFOERR:	ERROR	OFO,<"Output file already open">
80$:	CALL	PARSE		; PARSE THE FILE NAME
	BCS	FILERR		; OUT ON ERROR
	CALL	GETRWD		; GET REWIND SWITCH
	BR	EWCOMM		; OPEN WITH COMMON CODE
;
; HERE WHEN EDIT BACKUP HAS BEEN REQUESTED BY CALLER.
;
EBOPEN:	TST	OUTFDB+F.BDB	; IS ANY OUTPUT FILE OPEN
	BNE	OFOERR		; EB IS NOT PERMITTED WITH OUTPUT OPEN
;
; HERE FOR EDIT READ REQUEST FROM CALLER.
;
EROPEN:	CALL	CLOSIF		; CLOSE ANY OPEN INPUT FILE
	MOV	#INFDB,R0	; FDB ADDRESS TO R0
	MOV	#STATBK,F.STBK(R0) ; GET STATISTICS BLOCK
	CALL	PARSE		; PARSE THE FILE NAME
	BCS	FILERR		; BRANCH IF ERROR
	CALL	GETRWD		; GET REWIND SWITCH
	TST	R4		; IF EB COMMAND
	BPL	100$
	MOV	#OUTFDB+F.FNB,R2 ; COPY FNB TO OUTPUT FDB
	MOV	#S.FNBW,R3	; NO. OF WORDS TO MOVE
90$:	MOV	(R1)+,(R2)+
	SOB	R3,90$
	CLR	OUTFDB+F.FVER	; FORCE NEW OUTPUT FILE VERSION
100$:	CALL	GETRWD		; GET REWIND SWITCH
	MOVB	#FO.RD,F.FACC(R0) ; ASSUME NORMAL OPEN
	BIT	#SW.SH,CSIBLK+C.MKW2 ; SEE IF SHARED MODE OPEN
	BEQ	110$		; BRANCH IF NOT
	BISB	#FA.SHR,F.FACC(R0) ; SET SHARED OPEN
110$:	OFNB$	R0		; AND OPEN THE FILE FOR INPUT
120$:	BCS	FILERR		; FILE NOT FOUND.
	CLR	F.ACTL(R0)	; SHUT OFF REWIND
	BITB	#FD.SQD,F.RCTL(R0) ; SEE IF MAGTAPE
	BNE	140$		; SKIP EMPTY CHECK IF YES
	TST	F.EFBK(R0)	; CHECK IF THE FILE IS EMPTY
	BNE	140$
	MOV	#1,R2
	CMP	F.EFBK+2(R0),R2	; LOW ORDER EOF
	BHI	140$		; BRANCH IF NOT EMPTY
	BLO	130$
	TST	F.FFBY(R0)
	BNE	140$		; BRANCH IF NOT EMPTY

130$:	MOV	STATBK+4,R1	; GET PHYSICAL FILE SIZE
	MOV	STATBK+6,R3	; (LOW ORDER)
	MOV	R1,F.EFBK(R0)	; CONSTRUCT EOF FROM STATISTICS BLOCK
	MOV	R1,F.HIBK(R0)	; ALSO RESET HIBK
	BIS	R3,R1		; SEE IF FILE IS REALLY EMPTY
	BEQ	140$		; BRANCH IF YES
	MOV	R3,F.EFBK+2(R0)
	MOV	#512.,F.FFBY(R0)
	MOV	R3,F.HIBK+2(R0)
	CLR	F.VBN+2(R0)	; FORCE A RE-READ OF BLOCK 1
	CLR	R1
	CLR	R3		; VBN = 1, BYTE = 0
	CALL	.POINT
	MOVB	#R.VAR,F.RTYPE(R0) ; ASSUME VARIABLE LENGTH RECORDS
	MOVB	#FD.CR,F.RATT(R0)  ; IMPLIED CARRIAGE CONTROL

140$:	CALL	FSWIT		; APPLY SWITCHES
	BIT	#SW.B2,C.MKW2+CSIBLK ; SEE IF /B2
	BEQ	143$		; NO
	MOVB	#-1,INBP2	; YES
143$:	TST	R4		; CHECK OPEN INTENT AGAIN
	BPL	GFLXIT		; IF "ER", THAT'S ALL

	MOV	R4,-(SP)	; SAVE OPEN MODE
	CALL	GETNAM		; GET FULL FILE NAME SPEC OF INPUT
	MOV	(SP)+,R4
	MOV	#OUTFDB,R0	; R0=OUTPUT FDB ADDRESS

EWCOMM:	MOVB	INFDB+F.RATT,F.RATT(R0) ; DEFAULT RECORD ATTRIBUTES TO INPUT'S
	BEQ	145$		; BUT DEFAULT NONE TO CR
	BITB	#FD.PRN,F.RATT(R0)
	BEQ	150$		; ALSO CONVERT PRINT FILE TO CR
145$:	MOVB	#FD.CR,F.RATT(R0)
150$:	CALL	FSWIT		; APPLY SWITCHES
;
; READ THE PROTECTION OF THE INPUT FILE IF THIS IS AN EB AND APPLY IT TO THE OUTPUT
;
	CALL	.RDFFP		; GET CURRENT FILE PROTECTION
	MOV	R1,-(SP)	; AND SAVE IT
	TST	R4		; SEE IF THIS IS AN EB
	BPL	160$		; BRANCH IF NOT
	QIOW$C	IO.RAT,INLUN,1,,IOSTAT,,<INFDB+F.FNB,RDPROT>,CODE
	BCS	160$
	TSTB	IOSTAT		; CHECK FOR SUCCESS
	BMI	160$		; IF NOT, FORGET IT
	MOV	FILPRO,R1	; GET PROTECTION OF INPUT FILE
	BIC	#360,R1		; FORCE RWED FOR OWNER
	CALL	.WDFFP		; AND SET IT
160$:	OFNB$W	R0		; OPEN THE OUTPUT FILE
	MOV	(SP)+,R1	; GET BACK FILE PROTECTION
	ROL	-(SP)		; SAVE ERROR STATUS
	CALL	.WDFFP		; RESTORE FILE PROTECTION
	ROR	(SP)+		; RESTORE C BIT
	BCS	120$		; OUT ON ERROR
	BIT	#SW.B2,C.MKW2+CSIBLK ; SEE IF /B2
	BEQ	GFLXIT		; NO
	MOVB	#-1,OUBP2	; YES
;
; PLACE THE FULL FILE SPEC FOR THE FILE OPENED INTO THE SEARCH BUFFER.
;
OUTXIT:
GFLXIT:	CLR	F.ACTL(R0)	; TURN OFF REWIND MODE IF ON
	CALL	GETNAM		; GET FILE NAME STRING
	CLC
	RETURN

	.DSABL	LSB

;
; READ ATTRIBUTE CONTROL LIST TO READ FILE PROTECTION OF CURRENT INPUT FILE
;

	.PSECT	PURE,D,RO

RDPROT:	.BYTE	-2,2		; CODE = 2, 2 BYTES
	.WORD	FILPRO		; ADDRESS TO STORE
	.WORD	0		; END OF LIST

.SBTTL	GET NAME STRING OF OPEN FILE

;+
;
; *** - GETNAM	GET NAME STRING OF OPEN FILE
;
; THIS ROUTINE RETURNS THE FULLY EXPANDED FILE NAME STRING OF THE FILE
; OPEN ON THE INDICATED FDB IN THE FILENAME BUFFER. IF THE FDB IS THE INPUT
; OR OUTPUT FDB, THE STRING IS ALSO STORED IN THE AREA FOLLOWING THE FDB.
;
; INPUTS:
;	R0 = FDB ADDRESS
;
; OUTPUTS:
;	R0 - R4 CLOBBERED
;
;-

	.PSECT	CODE,I,RO

GETNAM:
	MOV	R0,R4		; R4 = FDB ADDRESS
	MOV	FILBUF(R5),R0	; R0 = ADDRESS FOR STRING
	MOV	F.FNB+N.DVNM(R4),(R0)+ ; COPY DEVICE NAME
	MOV	F.FNB+N.UNIT(R4),R1 ; UNIT NUMBER
	ASR	R1		; EXTRACT VAX CONTROLLER INDICATOR
	ASR	R1
	ASR	R1
	ASR	R1
	BEQ	10$		; BRANCH IF "A"
	ADD	#'A,R1		; ELSE INSERT CONTROLLER LETTER
	MOVB	R1,(R0)+
10$:	MOV	F.FNB+N.UNIT(R4),R1 ; RECOVER LOW PART OF UNIT NUMBER
	BIC	#^C17,R1
	CLR	R2		; SUPPRESS LEADING ZEROES
	CALL	$CBOMG		; CONVERT TO OCTAL
	MOVB	#':,(R0)+	; COLON ENDS DEVICE NAME
	MOV	F.DSPT(R4),R1	; GET DATASET DESCRIPTOR ADDR
	MOV	N.DIRD+2(R1),R2	; GET DIRECTORY STRING ADDRESS
	MOV	N.DIRD(R1),R1	; AND LENGTH
	BNE	20$		; BRANCH IF NOT NULL
	CALL	.RDFDR		; GET DEFAULT STRING INSTEAD
	TST	R1		; IS DEFAULT STRING NULL?
	BEQ	25$		; BRANCH IF NULL
20$:	MOVB	(R2)+,(R0)+	; COPY DIRECTORY STRING
	SOB	R1,20$

25$:	ADD	#F.FNB+N.FNAM,R4 ; POINT TO FILE NAME IN NAME BLOCK
	MOV	#3,R3		; COUNT FOR 3 WORDS
30$:	MOV	(R4)+,R1	; GET WORD OF FILE NAME
	CALL	$C5TA		; AND CONVERT TO ASCII
	SOB	R3,30$
	CALL	ESP		; TRUNCATE TRAILING SPACES
	MOVB	#'.,(R0)+	; TYPE DELIMITER
	MOV	(R4)+,R1	; TYPE
	CALL	$C5TA
	CALL	ESP		; TRUNCATE TRAILING SPACES
	MOVB	#';,(R0)+	; VERSION DELIMITER (SCREW YOU, DCLS!)
	MOV	(R4)+,R1	; VERSION NUMBER
	CLR	R2
	CALL	$CBVER		; CONVERT IN VERSION RADIX
	BIT	#SW.B2,C.MKW2+CSIBLK ; SEE IF /B2
	BEQ	35$		; NO
	MOVB	#'/,(R0)+	; YES
	MOVB	#'B,(R0)+
	MOVB	#'2,(R0)+
35$:	CLRB	(R0)+		; NULL TERMINATES THE STRING
;
; IF THE FDB IN THE INPUT OR OUTPUT FDB, COPY THE STRING INTO THE AREA FOLLOWING
; THE FDB.
;
	ADD	#S.FNB-N.FVER-2,R4 ; POINT OFF END OF FDB
	CMP	R4,#CMDFDB	; SEE IF INPUT OR OUTPUT FDB
	BHIS	50$		; BRANCH IF NOT
	MOV	FILBUF(R5),R0	; POSITION TO START OF STRING
	MOV	#FILSIZ,R1	; GET BYTE COUNT
40$:	MOVB	(R0)+,(R4)+	; AND COPY THE STRING
	SOB	R1,40$
50$:	RETURN			; RESTORE REGISTERS AND RETURN TO CALLER



;
; SUBROUTINE TO TRUNCATE OFF SPACES FROM THE END OF THE STRING POINTED
; AT BY R0.
;
ESP:	CMPB	-(R0),#SPACE	; SEE IF LAST CHARACTER IS SPACE
	BEQ	ESP		; YES - LOSE IT
	INC	R0		; NO - GET IT BACK
	RETURN

;+
;
; *** - PARSE	PARSE THE FILE NAME INTO THE FDB
;
; THIS ROUTINE TAKES THE NECESSARY INFORMATION OUT OF THE FDB
; AND INVOKES THE FCS PARSE ROUTINE.
;
; INPUTS:
;
;	R0=FDB ADDRESS
;
; OUTPUTS:
;
;	C=0 IF SUCCESSFUL, C=1 IF ERROR
;	R1=R0+F.FNB
;	R2=F.DSPT(R0)
;	R3=F.DFNB(R0)
;	R0,R4,R5 PRESERVED
;
;-

PARSE:	MOV	R0,R1
	ADD	#F.FNB,R1	; R1=FILE NAME BLOCK ADDRESS
	MOV	F.DSPT(R0),R2	; R2=DESCRIPTOR POINTER
	MOV	F.DFNB(R0),R3	; R3=DEFAULT NAME BLOCK ADDRESS
	CALL	.PARSE		; PARSE THE FILE NAME
	RETURN			; AND RETURN

.SBTTL		FILE SWITCH SUBROUTINE

;+
;
; *** - FSWIT	APPLY SWITCHES TO FILE IN PROCESS
;
; THIS ROUTINE TAKES THE SWITCH VALUES LEFT BY CSI2 AND STUFFS THE RECORD
; ATTRIBUTES BYTE OF THE FILE IN QUESTION APPROPRIATELY.
;
; INPUTS:
;
;	R0 =	POINTER TO FDB OF FILE
;
; OUTPUTS:
;
;	F.RATT(R0)	GETS RECORD ATTRIBUTES
;	R3	IS CLOBBERED
;
; OTHER REGISTERS ARE PRESERVED.
;
;-

	.ENABL	LSB

FSWIT:	TSTB	C.MKW1+CSIBLK	; SEE IF ANY SWITCHES WERE SPECIFIED
	BEQ	20$		; NO
	MOVB	C.MKW2+CSIBLK,R3 ; GET SWITCH SETTINGS
	BEQ	10$		; ALL ZERO IS OK
	CMPB	R3,#SW.CR	; CHECK FOR CR SWITCH
	BEQ	10$		; YES
	CMPB	R3,#SW.FT	; CHECK FOR FT SWITCH
	BEQ	10$		; YES
	ERROR	ILS,<"Illegal switches">
10$:	MOVB	R3,F.RATT(R0)	; APPLY SWITCHES TO FILE
20$:	RETURN

	.DSABL	LSB

;+
;
; *** - GETRWD	GET REWIND SWITCH
;
; THIS ROUTINE APPLIES THE REWING SWITCH TO THE CURRENT FDB.
;
; INPUTS:
;
;	R0 = FDB ADDRESS
;
; OUTPUTS:
;
; ALL REGISTERS PRESERVED
;
;-

GETRWD:	CLR	F.ACTL(R0)		; INIT TO NO REWIND
	BIT	#SW.RW,C.MKW2+CSIBLK	; SEE IF SWITCH SPECIFIED
	BEQ	10$			; BRANCH IF NO
	MOV	#FA.ENB!FA.RWD,F.ACTL(R0) ; ELSE SET REWIND BEFORE OPEN
10$:	RETURN

.SBTTL	CLOSE FILES

;+
;
; *** - CLSFIL	CLOSE INPUT AND OUTPUT FILE
;
; THIS ROUTINE CLOSES THE INPUT AND OUTPUT FILES AND CLEARS THE OUTPUT FILE
; OPEN FLAG.
;
; INPUTS:	NONE
;
; OUTPUTS:	NONE
;
; ALL REGISTERS ARE PRESERVED.
;
;-

	.ENABL	LSB

CLSFIL::
	SAVE
	CALL	CLOSIF		; CLOSE THE INPUT FILE
	BR	10$


;+
;
; *** - CLSOUT	CLOSE OUTPUT FILE
;
; THIS ROUTINE CLOSES THE OUTPUT FILE AND CLEARS THE OUTPUT FILE
; OPEN FLAG.
;
; INPUTS:	NONE
;
; OUTPUTS:	NONE
;
; ALL REGISTERS ARE PRESERVED.
;
;-

CLSOUT::
	SAVE
10$:	TST	OUTFDB+F.BDB	; SEE IF THERE IS A FILE OPEN
	BEQ	20$		; NOPE, JUST EXIT
	CALL	CLOSOF		; USE COMMON SUBR TO DO THE CLOSE
20$:	RETURN

	.DSABL	LSB

.SBTTL	KILL OUTPUT FILE

;+
;
; *** KILFIL	KILL OUTPUT FILE
;
; THIS ROUTINE DELETES THE CURRENT OUTPUT FILE AND CLEARS THE OUTPUT FILE
; OPEN FLAG. IF THERE IS NO OUTPUT FILE THEN NOTHING IS DONE.
;
; INPUTS:	NONE
;
; OUTPUTS:	NONE
;
; ALL REGISTERS ARE PRESERVED.
;
;-

	.ENABL	LSB

KILFIL::
	SAVE
	CLRB	OUBP2		; NO BP2 MODE NOW
	TST	OUTFDB+F.BDB	; SEE IF THERE IS AN OUTPUT FILE
	BEQ	20$		; BRANCH IF NO
	MOV	#OUTFDB,R0	; R0=ADDRESS OF THE OUTPUT FDB
	CALL	.DLFNB		; DELETE THE FILE
	BCC	20$
	JMP	FDBERR		; ERROR RETURN
20$:	RETURN

	.DSABL	LSB

.SBTTL	COMMON SUBROUTINES

; CLOSIF -- CLOSE INPUT FILE IF OPEN
; EDIT BACKUP AND INPUT FILE ALWAYS ENDED BY THIS SUBROUTINE

CLOSIF::CLR	EOFLAG(R5)	; CLEAR THE END OF FILE FLAG
	CLRB	CHRFLG		; CLEAR INPUT CHARACTER FLAG
	CLRB	INBP2		; NO BP2 MODE NOW
	TST	INFDB+F.BDB	; WAS THERE AN OPEN INPUT FILE ?
	BEQ	10$		; NO, JUST EXIT
	CLOSE$	#INFDB		; JUST CLOSE INPUT
	BCS	CLERR		; OUT ON ERROR
10$:	RETURN			; RETURN TO CALLER

; CLOSOF -- CLOSE OUTPUT FILE IF OPEN

CLOSOF::CLRB	OUBP2		; NO BP2 MODE NOW
	TST	OUTFDB+F.BDB	; WAS THERE AN OPEN OUTPUT FILE ?
	BEQ	20$		; NO, JUST EXIT
	CLOSE$	#OUTFDB		; CLOSE IT ALREADY
	BCS	CLERR		; OUT ON ERROR
20$:	RETURN			; RETURN TO CALLER

; TO HERE ON ANY ERROR ON A CLOSE

CLERR:	JMP	FDBERR		; AND DEAL WITH I/O ERROR



	.END