;	SEQUENTIAL FILE I/O LIBRARY

;	VRS 2.2    Jack Riley, Boulder Colorado(RCPM phone: (303)499-9169)
;
;	This is a highly modified version of the original by unknown author
;	believed to be Ward Christensen.
;	It has been expanded to include the following new features:
;	1) An APPEND mode to the FILE macro to allow the opening of files
;	   with automatic positioning to the EOF. Both GET and PUT macros
;	   are expanded to allow full random access to the file. Random
;	   access reads and writes are used instead of sequential(and also
;	   in other modes of use of the FILE macro so 1.4 is now incompatible).
;	2) PUBLIC and NONLOC options have been added to the FILE macro
;	   to allow access to files not in the current user area or on the
;	   current disk drive. The GET and PUT macros also handle the switching
;	   needed to provide for multiple opens in multiple areas. The way
;	   they work is to momentarily switch the user area to the one needed
;	   for the file undergoing an IO operation. A return is made to the
;	   'home' user area to allow for 'local' file accesses or switches
;	   to other areas to access other files. This is not completely
;	   satisfactory and one could wish for a more elegant method which
;	   should have been available under CPM. Also an additional byte
;	   has been added to the FCB generated by FILLFCB to contain the
;	   user area. The NONLOC option prevents an otherwise automatic
;	   sequence to look first in the current user area and on the current
;	   disk for the file, then switch the user area, then the disk to
;	   the default locations. When PUBLIC is included in an invocation 
;	   of FILE, then code accessing default and current values is made.
;	   The allocations for these variables is shown below.
;		DEFAULT$USER:
;			DB	0	; or other user area
;		DEFAULT$DISK:
;			DB	'x'-'A'	; where x is the default
;		CUR$USER:
;			DB	0FFH	; necessary initial value
;		CUR$DISK:
;			DB	0FFH	;  "           "
;
;	   The intention was to allow the default values to be modified
;	   at run time(one of the failings of MACRO-economics) so that
;	   determinations of the availability of hard disks, for example,
;	   could be included. Also it is sometimes nice to have these
;	   values at the very beginning of a program so that DDT-style
;	   customizations can be made.
;	3) A SECTBUF parameter has been added to FILE to turn off the
;	   standard character buffering previously provided. It seemed
;	   reasonable to provide this new open machinery even when
;	   simple sector buffering was intended. Also when SECTBUF=NONE
;	   all buffering is turned off and only the new open code is
;	   produced. This can also be done through use of the POPEN macro
;	   directly(without FCB's being generated).

FILERR	SET	0000H	;REBOOT AFTER ERROR
@FALSE	SET	0000H
@TRUE	SET	NOT @FALSE
@BDOS	EQU	0005H	;BDOS ENTRY POINT
@TFCB	EQU	005CH	;DEFAULT FILE CONTROL BLOCK
@TBUF	EQU	0080H	;DEFAULT BUFFER ADDRESS
;
;	BDOS FUNCTIONS
@MSG	EQU	9	;SEND MESSAGE
@OPN	EQU	15	;FILE OPEN
@CLS	EQU	16	;FILE CLOSE
@DIR	EQU	17	;DIRECTORY SEARCH
@DEL	EQU	19	;FILE DELETE
@MAK	EQU	22	;FILE MAKE
@REN	EQU	23	;FILE RENAME
@DMA	EQU	26	;SET DMA ADDRESS
@FRD	EQU	33	;FILE RANDOM READ OPERATION
@FWR	EQU	34	;FILE RANDOM WRITE OPERATION
@CFS	EQU	35	;COMPUTE FILE SIZE
@SETRR	EQU	36	;SET RANDOM RECORD
;
@SECT	EQU	128	;SECTOR SIZE
EOF	EQU	1AH	;END OF FILE
@CR	EQU	0DH	;CARRIAGE RETURN
@LF	EQU	0AH	;LINE FEED
TAB	EQU	09H	;HORIZONTAL TAB
;
@KEY	EQU	1	;KEYBOARD
@CON	EQU	2	;CONSOLE DISPLAY
@RDR	EQU	3	;READER
@PUN	EQU	4	;PUNCH
@LST	EQU	5	;LIST DEVICE
;
;	KEYWORDS FOR "FILE" MACRO
NONE	EQU	1
SECTBUFF	EQU	@TRUE
NONLOC	EQU	@TRUE
INFILE	EQU	1	;INPUT FILE
OUTFILE	EQU	2	;OUTPUTFILE
SETFILE	EQU	3	;SETUP NAME ONLY
APPEND	EQU	4	;APPEND TO FILE
;
;	THE FOLLOWING MACROS DEFINE SIMPLE SEQUENTIAL
;	FILE OPERATIONS:
;
FILLNAM	MACRO	FC,C
;;	FILL THE FILE NAME/TYPE GIVEN BY FC FOR C CHARACTERS
@CNT	SET	C	;;MAX LENGTH
	IRPC	?FC,FC	;;FILL EACH CHARACTER
;;	MAY BE END OF COUNT OR NUL NAME
	IF	@CNT=0 OR NUL ?FC
	EXITM
	ENDIF
	DB	'&?FC'	;;FILL ONE MORE
@CNT	SET	@CNT-1	;;DECREMENT MAX LENGTH
	ENDM		;;OF IRPC ?FC
;;
;;	PAD REMAINDER
	REPT	@CNT	;;@CNT IS REMAINDER
	DB	' '	;;PAD ONE MORE BLANK
	ENDM		;;OF REPT
	ENDM
;
FILLDEF	MACRO	FCB,?FL,?LN
;;	FILL THE FILE NAME FROM THE DEFAULT FCB
;;	FOR LENGTH ?LN (9 OR 12)
	LOCAL	PSUB
	JMP	PSUB	;;JUMP PAST THE SUBROUTINE
@DEF:	;;THIS SUBROUTINE FILLS FROM THE TFCB (+16)
	MOV	A,M	;;GET NEXT CHARACTER TO A
	STAX	D	;;STORE TO FCB AREA
	INX	H
	INX	D
	DCR	C	;;COUNT LENGTH DOWN TO 0
	JNZ	@DEF
	RET
;;	END OF FILL SUBROUTINE
PSUB	EQU $
FILLDEF	MACRO	?FCB,?F,?L
	LXI	H,@TFCB+?F	;;EITHER @TFCB OR @TFCB+16
	LXI	D,?FCB
	MVI	C,?L		;;LENGTH = 9,12
	CALL	@DEF
	ENDM
	FILLDEF	FCB,?FL,?LN
	ENDM
;
FILLNXT	MACRO
;;	INITIALIZE BUFFER AND DEVICE NUMBERS
@NXTB	SET	0	;;NEXT BUFFER LOCATION
@NXTD	SET	@LST+1	;;NEXT DEVICE NUMBER
FILLNXT	MACRO
	ENDM
	ENDM
;
FILLFCB	MACRO	MD,FID,DN,FN,FT,BS,BA
;;	FILL THE FILE CONTROL BLOCK WITH DISK NAME
;;	DEFINE FILE USING MODE MD:
;;		INFILE = 1	INPUT FILE
;;		OUTFILE = 2	OUTPUT FILE
;;		SETFILE = 3	SETUP FCB
;;	FID IS AN INTERNAL NAME FOR THE FILE,
;;	DN IS THE DRIVE NAME (A,B..), OR BLANK
;;	FN IS THE FILE NAME, OR BLANK
;;	FT IS THE FILE TYPE 
;;	BS IS THE BUFFER SIZE
;;	BA IS THE BUFFER ADDRESS
	LOCAL	PFCB
;;
FID&TYP	SET	MD	;;SET MODE FOR LATER REF'S
;;	SET UP THE FILE CONTROL BLOCK FOR THE FILE
;;	LOOK FOR FILE NAME = 1 OR 2
@C	SET	1	;;ASSUME TRUE TO BEGIN WITH
	IRPC	?C,FN	;;LOOK THROUGH CHARACTERS OF NAME
	IF	NOT ('&?C' = '1' OR '&?C' = '2')
@C	SET	0	;;CLEAR IF NOT 1 OR 2
	ENDIF
	ENDM
;;	@C IS TRUE IF FN = 1 OR 2 AT THIS POINT
	IF	@C	;;THEN FN = 1 OR 2
;;	FILL FROM DEFAULT AREA
	IF	NUL FT	;;TYPE SPECIFIED?
@C	SET	12	;;BOTH NAME AND TYPE
	ELSE
@C	SET	9	;;NAME ONLY
	ENDIF
	FILLDEF	FCB&FID,(FN-1)*16,@C	;;TO SELECT THE FCB
	JMP	PFCB	;;PAST FCB DEFINITION
	DS	@C	;;SPACE FOR DRIVE/FILENAME/TYPE
	FILLNAM	FT,12-@C	;;SERIES OF DB'S
	ELSE
	JMP	PFCB	;;PAST INITIALIZED FCB
	IF	NUL DN
	DB	0	;;USE DEFAULT DRIVE IF NAME IS ZERO
	ELSE
	DB	'&DN'-'A'+1	;;USE SPECIFIED DRIVE
	ENDIF
	FILLNAM	FN,8	;;FILL FILE NAME
;;	NOW GENERATE THE FILE TYPE WITH PADDED BLANKS
	FILLNAM	FT,3	;;AND THREE CHARACTER TYPE
	ENDIF
FCB&FID	EQU	$-12	;;BEGINNING OF THE FCB
	DB	0	;;EXTENT FIELD 00 FOR SETFILE
;;	NOW DEFINE THE 3 BYTE FIELD, AND DISK MAP
	DS	23	;;X,X,RC,DM0...DM15,CR,R0,R1,R2 FIELDS
	DB	0FFH	;; DEFAULT CURRENT USER AREA
;;
	IF	FID&TYP<=2	;;IN/OUTFILE
;;	GENERATE CONSTANTS FOR INFILE/OUTFILE
	FILLNXT		;;@NXTB=0 ON FIRST CALL
	IF	BS+0<@SECT
;;	BS NOT SUPPLIED, OR TOO SMALL
@BS	SET	@SECT	;;DEFAULT TO ONE SECTOR
	ELSE
;;	COMPUTE EVEN BUFFER ADDRESS
@BS	SET	(BS/@SECT)*@SECT
	ENDIF
;;
;;	NOW DEFINE BUFFER BASE ADDRESS
	IF	NUL BA
;;	USE NEXT ADDRESS AFTER @NXTB
FID&BUF	SET	BUFFERS+@NXTB
;;	COUNT PAST THIS BUFFER
@NXTB	SET	@NXTB+@BS
	ELSE
FID&BUF	SET	BA
	ENDIF
;;	FID&BUF IS BUFFER ADDRESS
FID&ADR	EQU $
	DW	FID&BUF
;;
FID&SIZ	EQU	@BS	;;LITERAL SIZE
FID&LEN	EQU $
	DW	@BS	;;BUFFER SIZE
FID&PTR	EQU $
	DS	2	;;SET IN INFILE/OUTFILE
;;	SET DEVICE NUMBER
@&FID	SET	@NXTD	;;NEXT DEVICE
@NXTD	SET	@NXTD+1
	ENDIF	;;OF FID&TYP<=2 TEST
PFCB	EQU $
	ENDM
;
FILE	MACRO	FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF
;;	(SEE FILLFCB FOR PARAMETERS)
FID&FLG	SET	1
	IF NUL PU
FID&PUB	SET	0
	ELSE
FID&PUB	SET	1
	ENDIF

@SETRC	SET	@SETRR
	IF	FMODE=APPEND
@SETRC	SET	@CFS
	GFILE	FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,0
FID&TYP	SET	OUTFILE		;;SET MODE FOR LATER REF'S
	ENDIF
	GFILE	FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,@SETRC
	ENDM
;
GFILE	MACRO	FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,@SETRC
	LOCAL	PSUB,MSG,PMSG
	LOCAL	PND,EOD,EOB,PNC,GLOOP,SAMEUSR
;;	CONSTRUCT THE FILE CONTROL BLOCK
;;
MD	SET	FMODE
	IF	FMODE=APPEND
	IF	@SETRC=0
MD	SET	INFILE
	ELSE
MD	SET	OUTFILE
	ENDIF
	ENDIF
	IF	FID&FLG
	FILLFCB	MD,FID,DN,FN,FT,BS,BA
	ENDIF
	IF	MD=SETFILE	;;SETUP FCB ONLY, SO EXIT
	EXITM
	ENDIF
;;	FILE CONTROL BLOCK AND RELATED PARAMETERS
;;	ARE CREATED INLINE, NOW CREATE IO FUNCTION
BLOCKING	SET	@TRUE
	IF	NUL SECTBUF	;;INPUT FILE
	JMP	PSUB	;;PAST INLINE SUBROUTINE
	IF	MD=OUTFILE
PUT&FID	EQU $
	PUSH	PSW	;;SAVE OUTPUT CHARACTER
	ELSE
GET&FID	EQU $
	ENDIF
	LHLD	FID&LEN	;;LOAD CURRENT BUFFER LENGTH
	XCHG		;;DE IS LENGTH
	LHLD	FID&PTR	;;LOAD NEXT TO GET/PUT TO HL
	MOV	A,L	;;COMPUTE CUR-LEN
	SUB	E
	MOV	A,H
	SBB	D	;;CARRY IF NEXT<LENGTH
	JC	PNC	;;CARRY IF LEN GTR CURRENT
;;	END OF BUFFER, FILL/EMPTY BUFFERS
	ELSE
	IF	SECTBUF=NONE
BLOCKING	SET	@FALSE
	ENDIF
	ENDIF
	IF	BLOCKING
	LXI	H,0
	SHLD	FID&PTR	;;CLEAR NEXT TO GET/PUT
PND	EQU $
;;	PROCESS NEXT DISK SECTOR:
	XCHG		;;FID&PTR TO DE
	LHLD	FID&LEN	;;DO NOT EXCEED LENGTH
;;	DE IS NEXT TO FILL/EMPTY, HL IS MAX LEN
	MOV	A,E	;;COMPUTE NEXT-LEN
	SUB	L	;;TO GET CARRY IF MORE
	MOV	A,D
	SBB	H	;;TO FILL
	JNC	EOB
;;	CARRY GEN'ED, HENCE MORE TO FILL/EMPTY
	LHLD	FID&ADR	;;BASE OF BUFFERS
	DAD	D	;;HL IS NEXT BUFFER ADDR
	XCHG
	MVI	C,@DMA	;;SET DMA ADDRESS
	CALL	@BDOS	;;DMA ADDRESS IS SET
	IF	FID&PUB
	LDA	FCB&FID+36	;; GET USER AREA OF FILE
	CPI	0FFH
	JZ	SAMEUSR
	MVI	C,32
	MOV	E,A
	CALL	@BDOS		;; GO TO FILE USER AREA
SAMEUSR	EQU	$
	ENDIF
	LXI	D,FCB&FID	;;FCB ADDRESS TO DE
	IF	MD=INFILE	;;READ BUFFER FUNCTION
	MVI	C,@FRD	;;FILE READ FUNCTION
	ELSE
	MVI	C,@FWR	;;FILE WRITE FUNCTION
	ENDIF
	CALL	@BDOS	;;RD/WR TO/FROM DMA ADDRESS
	IF	FID&PUB
	CALL	RESET$SYSTEM
	ENDIF
	ORA	A	;;CHECK RETURN CODE
	JNZ	EOD	;;END OF FILE/DISK?
;;	NOT END OF FILE/DISK, INCREMENT LENGTH
	LHLD	FCB&FID+33	;;INDEX TO RANDOM RECORD #
	INX	H
	SHLD	FCB&FID+33	;;POINTER UPDATED
	LXI	D,@SECT	;;SECTOR SIZE
	LHLD	FID&PTR	;;NEXT TO FILL
	DAD	D
	SHLD	FID&PTR	;;BACK TO MEMORY
	JMP	PND	;;PROCESS ANOTHER SECTOR
;;
EOD	EQU $
;;	END OF FILE/DISK ENCOUNTERED
	IF	MD=INFILE	;;INPUT FILE
	LHLD	FID&PTR	;;LENGTH OF BUFFER
	SHLD	FID&LEN	;;RESET LENGTH
	ELSE
;;	FATAL ERROR, END OF DISK
	LOCAL	EMSG
	MVI	C,@MSG	;;WRITE THE ERROR
	LXI	D,EMSG
	CALL	@BDOS	;;ERROR TO CONSOLE
	POP	PSW	;;REMOVE STACKED CHARACTER
	JMP	FILERR	;;USUALLY REBOOTS
EMSG	EQU $
	DB	@CR,@LF
	DB	'DISK FULL: &FID'
	DB	'$'
	ENDIF
;;
EOB	EQU $
;;	END OF BUFFER, RESET DMA AND POINTER
	LXI	D,@TBUF
	MVI	C,@DMA
	CALL	@BDOS
	LXI	H,0
	SHLD	FID&PTR	;;NEXT TO GET
;;
PNC	EQU $
	IF	NUL SECTBUF
;;	PROCESS THE NEXT CHARACTER
	XCHG		;;INDEX TO GET/PUT IN DE
	LHLD	FID&ADR	;;BASE OF BUFFER
	DAD	D	;;ADDRESS OF CHAR IN HL
	XCHG		;;ADDRESS OF CHAR IN DE
	IF	MD=INFILE	;;INPUT PROCESSING DIFFERS
	LHLD	FID&LEN	;;FOR EOF CHECK
	MOV	A,L	;;0000?
	ORA	H
	MVI	A,EOF	;;END OF FILE?
	RZ		;;ZERO FLAG IF SO
	LDAX	D	;;NEXT CHAR IN ACCUM
	ELSE
;;	STORE NEXT CHARACTER FROM ACCUMULATOR
	POP	PSW	;;RECALL SAVED CHAR
	STAX	D	;;CHARACTER IN BUFFER
	ENDIF
	LHLD	FID&PTR	;;INDEX TO GET/PUT
	INX	H
	SHLD	FID&PTR	;;POINTER UPDATED
;;	RETURN WITH NON ZERO FLAG IF GET
	ENDIF
	RET
	ENDIF		; IF BLOCKING
;;
PSUB	EQU $
	IF	FID&FLG
	;;PAST INLINE SUBROUTINE
	XRA	A		;;ZERO TO ACC
	STA	FCB&FID+12	;;CLEAR EXTENT
	STA	FCB&FID+32	;;CLEAR CUR REC
	LXI	H,FID&SIZ	;;BUFFER SIZE
	SHLD	FID&LEN		;;SET BUFF LEN
	IF	MD=INFILE	;;INPUT FILE
	SHLD	FID&PTR	;;CAUSE IMMEDIATE READ
	ELSE		;;OUTPUT FILE
	LXI	H,0	;;SET NEXT TO FILL
	SHLD	FID&PTR	;;POINTER INITIALIZED
	MVI	C,@DEL
	LXI	D,FCB&FID	;;DELETE FILE
	CALL	@BDOS	;;TO CLEAR EXISTING FILE
	MVI	C,@MAK	;;CREATE A NEW FILE
	ENDIF
;;	NOW OPEN (IF INPUT), OR MAKE (IF OUTPUT)
	LXI	D,FCB&FID
LOCALT	SET	NUL NOLOC
	IF	NOT FID&PUB OR LOCALT
	PUSH	D
	MVI	C,@OPN	;;OPEN FILE FUNCTION
	CALL	@BDOS	;;OPEN/MAKE OK?
	INR	A	;;255 BECOMES 00
	POP	D
	JNZ	PMSG
	ENDIF		; NUL NOLOC OR NUL PU
	IF	FID&PUB AND MD=INFILE
	POPEN	NOLOC
	JNZ	PMSG
	ENDIF
	IF	FMODE=APPEND
	MVI	A,EOF	;; PRIME THE BUFFER
	STA	FID&BUF
	LXI	H,0	;;SET NEXT TO FILL
	SHLD	FID&PTR	;;POINTER INITIALIZED
	LXI	D,FCB&FID
	MVI	C,@MAK
	CALL	@BDOS
	INR	A	;;255 BECOMES 00
	JNZ	PMSG
	ENDIF
	MVI	C,@MSG	;;PRINT MESSAGE FUNCTION
	LXI	D,MSG	;;ERROR MESSAGE
	CALL	@BDOS	;;PRINTED AT CONSOLE
	JMP	FILERR	;;TO RESTART
MSG	EQU $
	DB	@CR,@LF
	IF	MD=INFILE AND NOT (FMODE=APPEND)	;;INPUT MESSAGE
	DB	'NO &FID FILE'
	ELSE
	DB	'NO DIR SPACE: &FID'
	ENDIF
	DB	'$'

	IF	@SETRC=0
BACK&FID	EQU	$
	LXI	H,FID&SIZ	;;RESET THE LENGTH, IT MAY BE ZERO
	SHLD	FID&LEN		;;IF NO EOF CHARACTER WAS FOUND
	LHLD	FID&PTR		;;GET INDEX TO GET/PUT
	MOV	A,L		;;IF =0000 NO EOF CHARACTER TO BACK UP OVER
	ORA	H
	RZ
	DCX	H
	SHLD	FID&PTR	;;POINTER UPDATED
@@&FID	EQU	$
	LHLD	FCB&FID+33	;;INDEX TO RANDOM RECORD #
	MOV	A,L		;;=0000? BE SURE WE DON'T GO BELOW
	ORA	H
	RZ
	DCX	H
	SHLD	FCB&FID+33	;;POINTER UPDATED
	RET
	ENDIF
PMSG	EQU $
	ENDIF
	IF	NOT (@SETRC=0)
	MVI	C,@SETRC	; GET RANDOM RECORD #
	LXI	D,FCB&FID
	CALL	@BDOS
	IF	FMODE=APPEND
	CALL	@@&FID
GLOOP	EQU	$		; MOVE TO EOF IN LAST RECORD
	CALL	GET&FID
	CPI	EOF
	JNZ	GLOOP
	CALL	BACK&FID
	ENDIF		; FMODE=APPEND
	IF	FID&PUB
	CALL	RESET$SYSTEM
	ENDIF		; FID&PUB
	ENDIF		; @SETRC
FID&FLG	SET	0
	ENDM
;
PUT	MACRO	DEV
;;	WRITE CHARACTER FROM ACCUM TO DEVICE
	IF	@&DEV <= @LST
;;	SIMPLE OUTPUT
	PUSH	PSW	;;SAVE CHARACTER
	MVI	C,@&DEV	;;WRITE CHAR FUNCTION
	MOV	E,A	;;READY FOR OUTPUT
	CALL	@BDOS	;;WRITE CHARACTER
	POP	PSW	;;RESTORE FOR TESTING
	ELSE
	CALL	PUT&DEV
	ENDM
;
FINIS	MACRO	FID
;;	CLOSE THE FILE(S) GIVEN BY FID
	IRP	?F,<FID>
;;	SKIP ALL BUT OUTPUT FILES
	IF	?F&TYP=OUTFILE
	LOCAL	EOB?,PEOF,MSG,PMSG,SAMEUSR
;;	WRITE ALL PARTIALLY FILLED BUFFERS
EOB?	EQU $
	;;ARE WE AT THE END OF A BUFFER?
	LHLD	?F&PTR	;;NEXT TO FILL
	MOV	A,L	;;ON BUFFER BOUNDARY?
	ANI	(@SECT-1) AND 0FFH
	JNZ	PEOF	;;PUT EOF IF NOT 00
	IF	@SECT>255
;;	CHECK HIGH ORDER BYTE ALSO
	MOV	A,H
	ANI	(@SECT-1) SHR 8
	JNZ	PEOF	;;PUT EOF IF NOT 00
	ENDIF
;;	ARRIVE HERE IF END OF BUFFER, SET LENGTH
;;	AND WRITE ONE MORE BYTE TO CLEAR BUFFS
	SHLD	?F&LEN	;;SET TO SHORTER LENGTH
PEOF	EQU $
	MVI	A,EOF	;;WRITE ANOTHER EOF
	PUSH	PSW	;;SAVE ZERO FLAG
	CALL	PUT&?F
	POP	PSW	;;RECALL ZERO FLAG
	JNZ	EOB?	;;NON ZERO IF MORE
;;	BUFFERS HAVE BEEN WRITTEN, CLOSE FILE
	IF	?F&PUB
	LDA	FCB&?F+36	;; GET USER AREA OF FILE
	CPI	0FFH
	JZ	SAMEUSR
	MVI	C,32
	MOV	E,A
	CALL	@BDOS		;; GO TO FILE USER AREA
SAMEUSR	EQU	$
	ENDIF
	LXI	D,FCB&?F	;;FCB ADDRESS TO DE
	MVI	C,@CLS
	CALL	@BDOS		;; CLOSE THE FILE
	IF	?F&PUB
	CALL	RESET$SYSTEM
	ENDIF
	INR	A	;;255 IF ERR BECOMES 00
	JNZ	PMSG
;;	FILE CANNOT BE CLOSED
	MVI	C,@MSG
	LXI	D,MSG
	CALL	@BDOS
	JMP	PMSG	;;ERROR MESSAGE PRINTED
MSG	EQU $
	DB	@CR,@LF
	DB	'CANNOT CLOSE &?F'
	DB	'$'
PMSG	EQU $
	ENDIF
	ENDM	;;OF THE IRP
	ENDM
;
ERASE	MACRO	FID
;;	DELETE THE FILE(S) GIVEN BY FID
	IRP	?F,<FID>
	MVI	C,@DEL
	LXI	D,FCB&?F
	CALL	@BDOS
	ENDM	;;OF THE IRP
	ENDM
;
DIRECT	MACRO	FID
;;	PERFORM DIRECTORY SEARCH FOR FILE
;;	SETS ZERO FLAG IF NOT PRESENT
	LXI	D,FCB&FID
	MVI	C,@DIR
	CALL	@BDOS
	INR	A	;00 IF NOT PRESENT
	ENDM
;
RENAME	MACRO	NEW,OLD
;;	RENAME FILE GIVEN BY "OLD" TO "NEW"
	LOCAL	PSUB,REN0
;;	INCLUDE THE RENAME SUBROUTINE ONCE
	JMP	PSUB
@RENS	EQU $
	;;RENAME SUBROUTINE, HL IS ADDRESS OF
	;;OLD FCB, DE IS ADDRESS OF NEW FCB
	PUSH	H	;;SAVE FOR RENAME
	LXI	B,16	;;B=00,C=16
	DAD	B	;;HL = OLD FCB+16
REN0	EQU $
	LDAX	D	;;NEW FCB NAME
	MOV	M,A	;;TO OLD FCB+16
	INX	D	;;NEXT NEW CHAR
	INX	H	;;NEXT FCB CHAR
	DCR	C	;;COUNT DOWN FROM 16
	JNZ	REN0
;;	OLD NAME IN FIRST HALF, NEW IN SECOND HALF
	POP	D	;;RECALL BASE OF OLD NAME
	MVI	C,@REN	;;RENAME FUNCTION
	CALL	@BDOS
	RET		;;RENAME COMPLETE
PSUB	EQU $
RENAME	MACRO	N,O	;;REDEFINE RENAME
	LXI	H,FCB&O	;;OLD FCB ADDRESS
	LXI	D,FCB&N	;;NEW FCB ADDRESS
	CALL	@RENS	;;RENAME SUBROUTINE
	ENDM
	RENAME	NEW,OLD
	ENDM
;
GET	MACRO	DEV
;;	READ CHARACTER FROM DEVICE
	IF	@&DEV <= @LST
;;	SIMPLE INPUT
	MVI	C,@&DEV
	CALL	@BDOS
	ELSE
	CALL	GET&DEV
	ENDM
;
POPEN	MACRO	NOLOC
;	DE is assumed to point to the file FCB on entry
OPEN	SET	0FH
	LOCAL	PSUB,LEAVE
;OPEN MAST.CAT
*  OPTION 1:  TRY TO OPEN FILE IN CURRENT USER NUMBER ON CURRENT DISK
	JMP	PSUB
@OPEN	EQU	$
	PUSH	D	; save the FCB
	MVI	A,0FFH	; DECLARE CURRENT USER AREA ON FILE
	STA	FILEUA
	MVI	C,12	; GET VERSION NUMBER
	CALL	@BDOS
	MOV	A,H	; CP/M 1.X?
	ORA	L
	JZ	START2$DISK	; CHECK FOR DEFAULT DISK IF SO

*  OPTION 2:  TRY TO OPEN FILE IN USER 0 ON CURRENT DISK
	MVI	E,0FFH	; GET CURRENT USER NUMBER
	MVI	C,32	; GET USER CODE
	CALL	@BDOS
	MOV	C,A
	LDA	DEFAULT$USER	; CHECK IF AT DEFAULT USER
	CMP	C
	JZ	START2$DISK	; DON'T TRY IF AT DEFAULT USER AREA
	STA	FILEUA		; WHERE THE FILE IS IF ANYWHERE
	MOV	E,A
	MOV	A,C
	STA	CUR$USER	; WHERE WE ARE(SAVE FOR LATER)
	MVI	C,32	; SET USER CODE TO DEFAULT$USER
	CALL	@BDOS
	IF	NUL NOLOC
	POP	D	; GET BACK FCB
	PUSH	D	; PRESERVE THE STACK
	MVI	C,OPEN
	CALL	@BDOS	; TRY TO OPEN FILE AGAIN
	CPI	255	; NOT PRESENT?
	JNZ	LEAVE
	ENDIF		; NUL NOLOC
*  OPTION 3:  TRY TO OPEN FILE IN USER 0 ON DEFAULT DISK IF NOT CURRENT DISK
START2$DISK	EQU	$
	MVI	C,25	; DETERMINE IF CURRENT DISK IS THE DEFAULT
	CALL	@BDOS
	MOV	C,A
	LDA	DEFAULT$DISK	; CHECK IF AT DEFAULT DISK
	CMP	C
	IF	NUL NOLOC
	JZ	LEAVE		;FAILURE TO OPEN SINCE NOTHING LEFT TO TRY
	ENDIF
	POP	H		; FCB INTO HL
	PUSH	H		; PRESERVE STACK
	IF	NUL NOLOC
	ELSE
	JZ	START3$DISK
	ENDIF
	INR	A		; ADD ONE TO DISK NUMBER
	MOV	M,A	; PUT INTO FCB
START3$DISK	EQU	$
	XCHG		; FCB INTO DE
	MVI	C,15	; OPEN FILE
	CALL	@BDOS
	CPI	255	; NOT PRESENT?

LEAVE	EQU	$
	POP	D	; GET THE FCB AGAIN(AND CLEAN UP STACK)
	PUSH	PSW	; SAVE OPEN STATUS ON FILE
	LXI	H,36
	DAD	D
	LDA	FILEUA		; GET THE USER AREA FOR THE FILE
	MOV	M,A		; PUT USER AREA INTO FCB
	POP	PSW
	RET
;
RESET$SYSTEM	EQU	$
	PUSH	PSW
	LDA	CUR$USER	; CHECK USER
	CPI	0FFH	; 0FFH=NO CHANGE
	JZ	RESET$RET
	MOV	E,A	; USER IN E
	MVI	C,32	; GET/SET USER CODE
	CALL	@BDOS
RESET$RET	EQU	$
	POP	PSW
	RET

FILEUA	EQU	$
	DS	1
PSUB	EQU	$
POPEN	MACRO
	CALL	@OPEN
	ENDM
	POPEN
	ENDM