TITLE DSKDRV  FORTRAN-80 RUNTIME DISK DRIVER -- CP/M VERSIONS	|

CPM	SET	1		;CPM Version
ADDS	EQU	0		;SYSTEM 70
TANDY	EQU	0		;TANDY CP/M
CPMSBC	EQU	0		;CPM RELOCATED TO 4000H
CROMEM	SET	0		; Cromemco Version
;
MAXLUN	SET	10		; Max # of LUN's allowed
;
	IFT	CROMEM
MAXLUN	SET	64
CPM	SET	1
	ENDIF

	IFT	ADDS
CPMWRM	EQU	1004H		;CP/M WARM BOOT Entry Point
	ENDIF

	IFT	CPM
CPMWRM	EQU	0
	ENDIF

	IFT	TANDY
CPMWRM	EQU	4200H
	ENDIF

	IFT	CPMSBC
CPMWRM	EQU	4000H
	ENDIF

	IF2
	.PRINTX/DSKDRV - Runtime Disk Support/
	IFT	CPM
	.PRINTX/CPM Version/
	ENDIF
	IFT	CROMEM
	.PRINTX/Cromemco Version/
	ENDIF
	IFT	ADDS
	.PRINTX/ADDS Version/
	ENDIF
	IFT	TANDY
	.PRINTX/TANDY Version/
	ENDIF
	IFT	CPMSBC
	.PRINTX/SBC Version/
	ENDIF
	ENDIF
	PAGE
; BDOS Function Calls, FCB Offsets

CPMENT	EQU	CPMWRM+5	;CP/M BDOS Entry Point

.VERSN	EQU	12	; Get CP/M Version No.
.RSET	EQU	13	; Init BDOS
.SELCT	EQU	14	; Select Disk
.OPEN	EQU	15	; Open File
.CLOSE	EQU	16	; Close File
.FFILE	EQU	17	; Search directory for filename.
.DELET	EQU	19	; Delete File
.READS	EQU	20	; Read  Sequential (1.x)
.WRITS	EQU	21	; Write Sequential (1.x)
.MAKE	EQU	22	; Create File
.STDMA	EQU	26	; Set DMA address
.READR	EQU	33	; Read  Random (2.x)
.WRITR	EQU	34	; Write Random (2.x)

FCB.FT	EQU	9	; File Type
FCB.EX	EQU	12	; Extent Byte
FCB.RC	EQU	15	; Record Count Byte
FCB.NR	EQU	32	; Next Record  Byte
FCB.RR	EQU	33	; Random Record number (2.x)
FCBLEN	EQU	36	; FCB Size

LRECL	EQU	128	; Logical Record Length (Sector size)

; MACRO Definitions

	.SALL

SVC	MACRO	.FUNC		;; SUPERVISOR CALL
	MVI	C,.FUNC		;; CP/M BDOS Call
	CALL	CPMENT		;; With Function in [C].
	ENDM

; Global Definitions

	EXTRN	$CPMVN,$CPMRF,$CPMWF
	EXTRN	$BL,$BF,$IOERR,$IOINI,$ERR,$REC,$UN,$LUNTB,$CLSFL

	PUBLIC	$DSKER,$FLFLG,$MEMRY
;	PUBLIC	GTMODE,ALCBUF,GTFCB,DSKCLS
	PUBLIC	OPEN,DSKCLS

	PAGE
	DSEG		; Data Area

;	I/O Error Code Defns

OBOVF	EQU	016Q		; Output Buffer Limit Exceeded
IRECER	EQU	022Q		; Input Record too Long
NOFILE	EQU	236Q		; File Not Found
FULERR	EQU	237Q		; Disk Full
LUNERR	EQU	240Q		; LUN too Large
NOMEM	EQU	241Q		; Out-of-Memory

;	I/O Mode Defn Byte 

MD.ALC	EQU	X'80'		; 80H  Allocated Buffer and FCB
MD.OPN	EQU	X'40'		; 40H  File is OPEN
MD.OUT	EQU	X'20'		; 20H  If Output
MD.BIN	EQU	X'10'		; 10H  If Binary I/O

MD.WRT	EQU	X'08'		; 08H  Write-Data-in-Buffer
MD.RND	EQU	X'04'		; 04H  If Random I/O

$FLFLG:	DS	MAXLUN		; I/O Mode Byte for each Lun
$FLCNT:	DS	MAXLUN		; I/O Buffer Index for each Lun
$FLBUF:	DS	MAXLUN*2	; Buffer Location for each Lun
$FLFCB:	DS	MAXLUN*2	; FCB Location for each Lun
;	------------
$DSKER:	DS	1		;STATUS OF LAST I/O
CLSADR:	DS	2
;	------------
$MEMRY:	DS	2		;FOR LOADER TO STORE TOP OF MEM INTO

	CSEG		; Code Area

FILTXT:	DB	"FORT",0
FILEXT:	DB	"DAT",0

	PAGE
; I/O DISPATCH TABLE

; LUN's 6 thru MAXLUN point to this table via $LUNTB.
; An explicit open via CALL OPEN (<filespec>) allow
; other units to use the disk also...

ENTRY	DSKDRV
DSKDRV:	DW	DSKFRD		;FORMATTED READ
	DW	DSKFWR		;FORMATTED WRITE
	DW	DSKBRD		;BINARY READ
	DW	DSKBWR		;BINARY WRITE
	DW	DSKREW		;REWIND
	DW	$IOERR		;BACKSPACE (not supported).
	DW	DSKCLS		;ENDFILE

DSKFUL:	CALL	$ERR
	DB	FULERR		;Disk Full
LUNOVF:	CALL	$ERR
	DB	LUNERR		;LUN too Large
MEMERR:	CALL	$ERR
	DB	NOMEM		;Out-of-Memory

;------------------------------------------------------
;
; GET MODE BYTE(LUN) FROM $FLFLG
;
GTMODE:	LXI	H,$FLFLG-1
	LDA	$UN		;GET UNIT #
	MVI	D,0
	MOV	E,A
	DAD	D		;[HL] POINTS TO FLAG
	MOV	A,M		;GET FLAG
	RET
;------------------------------------------------------
;
; SET DMA TO DATA BUFFER(LUN)
;
SETBUF:	PUSH	B
	PUSH	D
	CALL	GETBUF		;GET BUFFER ADR
	SVC	.STDMA		;Set DMA to buffer address
	POP	D
	POP	B
	RET
;------------------------------------------------------
GETBUF:	LDA	$UN
	ADD	A
	MOV	E,A
	MVI	D,0
	LXI	H,$FLBUF-2
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	RET
;------------------------------------------------------
;
; GET DATA.BUFFER.OFFSET(LUN)
;
GTBOFF:
	LXI	H,$FLCNT-1
	LDA	$UN
	MVI	D,0
	MOV	E,A
	DAD	D
	MOV	A,M		;GET OFFSET
	RET
;------------------------------------------------------
;
; GET ADR OF FCB(LUN) IN [DE]
;
GTFCB:	LXI	H,$FLFCB-2
	LDA	$UN
	ADD	A
	MOV	E,A
	MVI	D,0
	DAD	D		;POINT TO ADR OF FCB
	MOV	E,M
	INX	H
	MOV	D,M
	RET
;------------------------------------------------------
;
; Get Read/Write Record Number for LUN
; On Return:
;		[HL] = FCB.RR(LUN) adr of Rnd Rec Num.
;		[DE] = $REC	   00  or Rnd Rec Num.
;
GTREC:
	CALL	GTFCB
	LXI	H,FCB.RR
	DAD	D
	XCHG
	LHLD	$REC
	XCHG
	RET
;------------------------------------------------------
; Zero FCB from Extent Byte to end.
;
CLRFCB:
	CALL	GTFCB
	LXI	H,FCB.EX
	DAD	D
	LXI	B,FCBLEN-FCB.EX
CLRFCL:
	MOV	M,B
	INX	H
	DCR	C
	JNZ	CLRFCL
	RET
;------------------------------------------------------
; Copy Bytes from [DE] to [HL] until null (00).
;
CPYTXT:
	MOV	M,A		;Copy from [DE] to [HL]
	INX	H		; until null.
	INX	D
	LDAX	D
	ORA	A
	JNZ	CPYTXT
	RET

	PAGE
;------------------------------------------------------
;
; OPNCHK - Assure that File is Open and Buffers Allocated.
;	   If not then:
;	1.  Allocate Data buffer and FCB from $MEMRY.
;	2.  Open File with name of FORT##.DAT where:
;	    ## is Logical-Unit-Number (LUN) of file.

OPNCHK:
	LDA	$UN
	CPI	MAXLUN+1	;
	JNC	LUNOVF		; LUN is too Large
;	----------------
	PUSH	B		;Save Open Mode Request.
	CALL	GTMODE		;GET FLAG
	ORA	A		;ALLOCATED BUFFER,FCB?
	CP	ALCBUF		;NO, GET SPACE AND SET PTRS
;	----------------
	POP	B		;Get I/O Mode in [C]
	ANI	MD.OPN		;Was OPEN?
	CZ	OPNFIL		;No, Open File.

;------------------------------------------------------
;
; SETREC - SET UP RECORD NUMBER
;
SETREC:
	CALL	GTREC		;Get current & Last Record Numbers
	MOV	A,D		; [DE] = $REC
	ORA	E		; If Random I/O
	JNZ	SETRND		; use value in $REC
;	----------------
	MOV	E,M		; ..Else
	INX	H		; Use current record
	MOV	D,M		; set by Seq read/write.
	PUSH	D		;Save Rec No.
	CALL	GTMODE
	ANI	NOT MD.RND	;Set Sequential Mode
	MOV	M,A
	POP	D		;Restore Rec No.
	JMP	SETSEQ
;	----------------
SETRND:
	CALL	GTMODE
	ANI	MD.WRT		;Write-Data-in-Buffer?
	CNZ	FRCOUT		;Yes, Flush it first.
	CALL	GTMODE
	ORI	MD.RND		;Set Random Mode
	MOV	M,A
	CALL	GTREC		; Restore Rec no's.
	DCX	D		; Adjust Random Rec no.
	MOV	M,E
	INX	H		; Store at FCB.RR for next I/O
	MOV	M,D
	INX	H
	MVI	M,0
;	----------------
SETSEQ:
IFF	CROMEM
	LDA	$CPMVN		;CP/M Version Flag
	ORA	A		; Version 1.x ?
	RZ			;No, Version 2.x nothing else needed.
ENDIF
;------------------------------------------------------
;
; SPLIT RANDOM RECORD INTO EXTENT AND RELATIVE RECORD
;	FOR VERSION 1.x
;
SETV1:
	MOV	A,E
	RAL
	MOV	A,D
	RAL
	MOV	B,A
	MOV	A,E
	ANI	X'7F'
	MOV	C,A
;	----------------
	CALL	GTFCB		; [DE] = adr of FCB(LUN)
	LXI	H,FCB.EX
	DAD	D
	MOV	A,M		;FETCH CURRENT EXTENT
	CMP	B
	JZ	SAMEXT		;IF SAME AS REQUESTED EXTENT
;
; CLOSE CURRENT EXTENT, OPEN REQUESTED ONE
;
	PUSH	B		;EXT/REC
	PUSH	D		;FCB adr
	LXI	H,FCB.NR
	DAD	D
	MVI	M,0		;ZERO the Record Number
	LHLD	$MEMRY		;Get scratch Buffer
	XCHG			;from top of Heap for Open/Close
	SVC	.STDMA		;SET DMA TO DEFAULT BUFFER
	CALL	GTMODE
	ANI	MD.OUT		;Open for Output?
	JZ	OPNXT		;No, skip this close
	POP	D
	PUSH	D		;FCB
	SVC	.CLOSE		;CLOSE THE EXTENT
OPNXT:
	POP	D		; FCB
	POP	B		; EXT/REC
	PUSH	B
	PUSH	D
	LXI	H,FCB.EX
	DAD	D
	MOV	M,B		;SET NEW EXTENT NUMBER
	SVC	.OPEN		;Open New Extent
	INR	A
	JNZ	SKEXT		;IF IT EXISTS
	POP	D
	PUSH	D		; FCB
	CALL	MAKEXT		;CREATE NEW EXTENT
SKEXT:
	POP	D		; FCB
	POP	B		; EXT/REC
SAMEXT:
	LXI	H,FCB.NR
	DAD	D
	MOV	M,C		;SET RECORD NUMBER
	RET

	PAGE
;------------------------------------------------------
; ALLOCATE FCB AND BUFFER FOR UNIT . ALLOCATES UP FROM
; $MEMRY AND STORES PTRS IN TABLE.

ALCBUF:	PUSH	H
	LHLD	$MEMRY		;GET CURRENT TOP
	XCHG			;IN [DE]
;	----------------
	LXI	H,-256
	DAD	SP
	MOV	A,L		; If Memtop-256
	SUB	E		; is < top of heap ($MEMRY)
	MOV	A,H		; then give Out-of-Memory
	SBB	D		; Error and Exit...
	JC	MEMERR
;	----------------
	LXI	H,$FLBUF-2
	LDA	$UN
	ADD	A
	MVI	B,0
	MOV	C,A		;[BC]= 2*UNIT#
	DAD	B		;GET ADR OF PTR TO BUFFER
	MOV	M,E
	INX	H
	MOV	M,D		;STORE $MEMRY AS ADR
	LXI	H,LRECL
	DAD	D		;GET NEW TOP
	PUSH	H		;SAVE FCB ADR
	CALL	GTFCB		;GET [HL]=ENTRY+1
	POP	D
	PUSH	D		;Save FCB adr
	MOV	M,D
	DCX	H
	MOV	M,E		;STORE ADR OF FCB
	LXI	H,FCBLEN
	DAD	D		;GET NEW TOP OF ALLOC
	SHLD	$MEMRY		;STORE AWAY
;	----------------
	POP	H		;FCB adr.
	MVI	M,0		;Default to Current Disk
	INX	H
	LXI	D,FILTXT	;Default Name initially FORT##.DAT
	LDAX	D
	CALL	CPYTXT		; Move "FORT" to FCB
	CALL	CONLUN		; get 1st digit in C, 2nd in B
	MOV	A,C
	ADI	'0'		; convert to ASCII
	MOV	M,A		; Store 10s digit
	MOV	A,B
	ADI	'0'
	INX	H
	MOV	M,A		; Store units digit
	MVI	A," "
	INX	H
	MOV	M,A
	INX	H
	LXI	D,FILEXT-1	;EXTENSION
	CALL	CPYTXT		; Move "DAT" to FCB
;	----------------
	POP	H		;GET PTR TO FLAG
	MVI	A,MD.ALC	;Now Allocated.
	MOV	M,A		;SET FLAG
	RET
;---------------
;
; Convert Logical Unit Number to two digits
; Return:	B = Units digit (binary)
;		C = Tens  digit (binary)
; Preserve [HL] please
;
CONLUN:
	LDA	$UN		; Get Logical Unit Number
	MVI	C,0		; C will count subtractions
CON1:	SUI	10		; Does 10 go in?
	JC	CON2		; Get out if not
	INR	C		; Bump tens counter if so
	JMP	CON1		; And go around again
CON2:	ADI	10		; Add divisor back to get remainder
	MOV	B,A		; Which is the units digit in B
	RET

	PAGE
;------------------------------------------------------
;
; OPEN File Given by LUN and Clear Buffer Index.
; Entry:	[DE] = adr of FCB
; Exit:		[HL] = adr of Mode Byte
;		[A]  = Mode byte -  Allocated & Open.
;
OPNFIL:
	PUSH	B		;Save I/O Mode
	CALL	GTBOFF		; Get Buffer.offset(LUN)
	MOV	M,D		;Clear Buffer Index
;	----------------
	LHLD	$CLSFL
	LXI	D,CLSALL
	MOV	A,H
	SUB	D
	JNZ	STRADR		;NOT US, STORE ROUTINE ADR
	MOV	A,L
	SUB	E
	JZ	STRCLS		;US, DON'T STORE AGAIN
STRADR:	SHLD	CLSADR
STRCLS:	XCHG
	SHLD	$CLSFL		;ON EXIT, CLOSE ALL FILES
	CALL	CLRFCB		;Zero FCB & Record Number.
	CALL	SETBUF		;Set DMA to File buffer.
;	----------------
	POP	B		;I/O Mode
	PUSH	B
	MOV	A,C
	ANI	MD.OUT
	JZ	OPNINP		;Brief Open Input
	LHLD	$REC		;Check for random I/O.
	MOV	A,H
	ORA	L
	JZ	OPNDEL		;Delete file on Output + non-Random.
	PUSH	D		;Save FCB pointer
	SVC	.FFILE		;Check for file already exists
	POP	D		;  we don't want to delete random files
	CPI	255		;Check file not found flag.
	JNZ	OPNINP		;File does exist.

;------------------------------------------------------
;
; OPEN NEW File for Output or Random.
;
OPNDEL:	PUSH	D		;Save FCB adr
	SVC	.DELET		;DELETE Old File
	POP	D
	PUSH	D
	CALL	MAKEXT		;Create New File.
	POP	D		;Restore FCB adr
;------------------------------------------------------
;
; OPEN Existing File for Input or Random.
;
OPNINP:
	SVC	.OPEN		;OPEN File
	INR	A
	JZ	FNFERR		; Brif File Not Found (Fatal).

OPNDON:
	CALL	GTMODE
	POP	B		;Get I/O Mode.
	MOV	A,C
	ORI	MD.ALC+MD.OPN
	MOV	M,A		; Mode Allocated/Open + I/O
	RET

FNFERR:	POP	PSW		;Clear 1st level of return.
	POP	PSW		;Clear 2nd level of return.
	POP	PSW		;Clear 3rd level of return.
	MVI	A,1		;Force error #1
	STC			;Set error flag.
	RET


;------------------------------------------------------
;
; MAKE New file or Extent.
;
MAKEXT:
	SVC	.MAKE		;Create New File
	INR	A
	JZ	DSKFUL		;Brif DISK FULL Error.
	RET

	PAGE
;------------------------------------------------------
;
; REWIND UNIT #
;
DSKREW:	CALL	GTMODE
	ANI	MD.OPN		;FILE OPEN?
	CNZ	DSKCLS		;YES, CLOSE IT
NOCLOS:	XRA	A		;GOOD RETURN
	RET

;------------------------------------------------------
;
; ENDFILE UNIT #
;
DSKCLS:	CALL	GTMODE
	MOV	C,A		;Save mode byte for later checks.
	ANI	MD.OPN		;Open?
	JZ	NOCLOS		;No, so don't close lun #.
	MOV	A,C		;Retrieve mode byte.
	ANI	MD.WRT		;Check, for data write condition.
	CNZ	FRCBUF		;Yes, write it out.
	CALL	GTFCB		;Get addr of FCB
	CALL	SETBUF		;SET DMA ADR
	SVC	.CLOSE		;CLOSE File
	CALL	GTMODE
	MVI	M,MD.ALC	;Set mode as closed,
				; but that buffer is allocated.
	XRA	A		;NEVER AN ERROR
	RET

;------------------------------------------------------
;
; CLOSE ALL FILES. CALLED FROM EXIT
;
CLSALL:	LXI	D,1
CLSAL1:	LXI	H,$FLFLG-1
	DAD	D
	MOV	A,M
	ADD	A		;SET MINUS IF OPEN
	PUSH	D		;SAVE UNIT #
	MOV	A,E
	STA	$UN		;SET UP FOR OTHERS
	CM	DSKCLS		;CLOSE FILE IF OPEN
	POP	D		;GET # BACK
	INX	D		;BUMP IT
	LDA	$LUNTB		; Get max LUN
	CMP	E		; Done all?
	JNZ	CLSAL1		;NO, DO NEXT
	RET			;RETURN

	PAGE
;------------------------------------------------------
;
; BINARY WRITE
;
DSKBWR:
	MVI	C,MD.OUT+MD.BIN
	CALL	OPNCHK		;OPEN IF NOT OPEN
	LHLD	$BF		;GET BUFFER ADR
	PUSH	H
	XCHG
	LHLD	$BL		;GET LENGTH OF DATA
	MVI	H,0		;# OF BYTES
	XCHG
	DAD	D		;PTR TO 1ST TO CLEAR
	XRA	A
	DCR	E
DSKWCL:
	INR	E		;CLEARED REST OF BUFFER?
	JM	DSKBW1		;YES, DONE
	MOV	M,A
	INX	H
	JMP	DSKWCL		;CLEAR END OF BUFFER
DSKBW1:
	POP	D		;GET BUFFER ADR
	SVC	.STDMA		;Set DMA to Buffer
	CALL	WRITE		;WRITE Record
	ORA	A		;ERROR?
	RZ			;NO, GOOD RETURN
	STC
	RET

	PAGE
;------------------------------------------------------
;
; BINARY READ
;
DSKBRD:
	MVI	C,MD.BIN
	CALL	OPNCHK		;OPEN IF NEEDED
	LHLD	$BF
	XCHG
	SVC	.STDMA		;Set DMA to $BF
	MVI	A,128
	STA	$BL		;ALWAYS 1 SECTOR
	CALL	READ		;READ Record into $BF
	ORA	A		;EOF OR GOOD
	RZ
	CPI	2
	CMC
	RET
;
	PAGE
;------------------------------------------------------
;
; FORMATTED WRITE
;
DSKFWR:
	MVI	C,MD.OUT
	CALL	OPNCHK		;OPEN FILE IF NEEDED
	XRA	A
	STA	$DSKER		;CLEAR COUNT
	LDA	$BL		;GET # TO WRITE
	ORA	A
	RZ			;IGNORE NULL BUFFERS
	LDA	$BL
	ORA	A
	JP	DSKFW0
	CALL	$ERR		;Warn User of..
	DB	OBOVF		; Output Buffer Limit Exceeded
	MVI	A,127		; and truncate to 127 bytes.
DSKFW0:
	CALL	RNDCHK		;If Rnd Mode, Set offset to 0.
	LHLD	$BF		; Get buffer ptr
DSKFW2:
	PUSH	PSW		; SAVE COUNT
	MOV	A,M
	CALL	DSKOUT		;SEND OUT BYTE
	INX	H		; Increment buffer ptr
	POP	PSW		; Retrieve count
	DCR	A		; Decrement count
	JNZ	DSKFW2		; One more time
;
DSKWDN:	MVI	A,15Q
	CALL	DSKOUT		;PUT OUT <CR>
	CALL	GTMODE		;Mark Mode Byte with
	ORI	MD.WRT		; Write-Data-in-Buffer.
	MOV	M,A
	LDA	$DSKER		;GET $DSKEROR STATUS
	ORA	A		;ERROR?
	RZ			;NO
	STC			;YES
	RET
;
	PAGE
;------------------------------------------------------
;
; FORMATTED READ
;
DSKFRD:
	MVI	C,0
	CALL	OPNCHK		;OPEN IF NEEDED
	XRA	A
	STA	$BL		;CLEAR LENGTH OF RECORD
	STA	$DSKER		;CLEAR $DSKEROR
	CALL	RNDCHK		;If Rnd Mode, Set offset to 0.
DSKFR1:
	CALL	DSKIN		;GET CHAR
	JC	DSKRDN		;JUMP IF EOF
	CPI	32Q		;CP/M EOF?
	JZ	DSKEOF		;YES
	LHLD	$BL
	MVI	H,0
	XCHG
	LHLD	$BF		;BASE
	DAD	D		;GET WHERE TO PUT BYTE
	MOV	M,A		;STORE CHAR
	INX	D		;BUMP OFFSET
	XCHG
	SHLD	$BL		;UPDATE OFFSET
	CPI	15Q		;<CR>?
	JZ	DSKRDN		;YES, HAVE RECORD
	MOV	A,L		;GET OFFSET
	CPI	128		;BUFFER FULL?
	JC	DSKFR1		;NO, GET NEXT
	CALL	$ERR		;Warn User of..
	DB	IRECER		; Input Record too Long.
	XRA	A
	RET
;
DSKRDN:	LDA	$DSKER		;GET STATUS
	ORA	A
	RZ			;NO ERROR
	CPI	2
	CMC
	RET
DSKEOF:	ORA	A		;SET CC'S
	RET
;
	PAGE
;------------------------------------------------------
;
; RESET BUFFER OFFSET IF RANDOM READ or WRITE
;
RNDCHK:
	PUSH	PSW
	CALL	GTMODE
	ANI	MD.RND
	JZ	RNDCHX		;Do nothing if Sequential Mode.
	CALL	GTBOFF		;Else zero Buffer offset so..
	MVI	M,0		;next READ/WRITE starts at beginning.
RNDCHX:
	POP	PSW
	RET
;------------------------------------------------------
;
; DISK INPUT ROUTINE
;
DSKIN:
	CALL	GTBOFF		; Buffer.offset(LUN)
	ORA	A		;BUFFER EMPTY?
	CZ	REDBUF		;YES, REFIL
	RC			;EOF
	DCR	M		;DECR. # LEFT
	LXI	H,$FLBUF-2
	DAD	D
	DAD	D		;GET $FLBUF PTR
	CMA
	ADI	129		;128-#LEFT=OFFSET
	ADD	M
	MOV	E,A
	INX	H
	MVI	A,0
	ADC	M
	MOV	D,A
	LDAX	D		;GET CHAR
	ORA	A
	RET
;------------------------------------------------------
;
; READ BUFFER FROM DISK
;
REDBUF:	PUSH	H
	PUSH	D
	CALL	SETBUF
	CALL	READ		;READ Record
	STA	$DSKER		;STORE STATUS
	ORA	A
	POP	D
	POP	H
	MVI	A,128		;FULL BUFFER
	MOV	M,A		;STORE COUNT
	RZ			;IF NO ERROR
	STC
	RET
;------------------------------------------------------
;
; DISK OUTPUT ROUTINE
;
DSKOUT:	PUSH	H
	PUSH	PSW
	CALL	GTBOFF		;Get Buffer offset
	ORA	A		;BUFFER FULL?
	CM	DMPBUF		;YES, DUMP
	INR	M
	LXI	H,$FLBUF-2
	DAD	D
	DAD	D		;POINT TO ADR OF BUFFER
	ADD	M
	MOV	E,A
	INX	H
	MVI	A,0
	ADC	M
	MOV	D,A		;POINTS TO FREE
	POP	PSW		;GET CHAR BACK
	STAX	D		;STORE CHAR
	POP	H
	RET
;------------------------------------------------------
;
; FORCE FORMATTED BUFFER OUT ON CLOSE
;
FRCBUF:	CALL	GTMODE		;Get orginal mode byte.
	ANI	MD.RND + MD.BIN	;Check random or binary modes.
	JNZ	FRCOUT		;Skip EOF char. write if either.
	MVI	A,32Q
	CALL	DSKOUT		;SET END OF FILE
FRCOUT:
	CALL	GTBOFF		;Buffer.offset(LUN)
	ORA	A		;EMPTY?
	MVI	M,0		;CLEAR OFFSET
	RZ			;YES, DO NOTHING
	PUSH	PSW		;SAVE OFFSET
	CALL	GETBUF		;GET BUFFER ADR
	POP	PSW
	MOV	L,A
	MVI	H,0
	DAD	D		;POINT TO 1ST UNUSED
CHKFIL:	ORA	A		;SET MINUS IF FULL
	JM	DMPBF1		;NOTHING TO FILL
	MVI	M,0		;CLEAR BYTE
	INX	H
	INR	A		;BUMP OFFSET
	JMP	CHKFIL
;------------------------------------------------------
;
; DUMP BUFFER TO DISK
;
DMPBF1:
	DCX	H		;SO THAT DRIVE # ISN'T CLEARED
DMPBUF:
	PUSH	H
	PUSH	D
	CALL	SETBUF
	CALL	WRITE		;WRITE Record
	STA	$DSKER		;STORE STATUS
	CALL	GTMODE
	ANI	NOT MD.WRT	;Clear Write-Data Bit
	MOV	M,A
	POP	D
	POP	H
	XRA	A
	MOV	M,A		;Clear Buffer offset
	RET

;------------------------------------------------------
;
; READ RECORD/WRITE RECORD PRIMITIVES
;
READ:
	CALL	GTFCB		;Lookup FCB
	LDA	$CPMRF		;CP/M 1.x or 2.x
	MOV	C,A		;Random Read Function
	JMP	IOCALL		;Read Next
WRITE:
	CALL	GTFCB		;Lookup FCB
	LDA	$CPMWF		;CP/M 1.x or 2.x
	MOV	C,A		;Random Write Function
IOCALL:	CALL	CPMENT
	PUSH	PSW
	CALL	GTREC
	INR	M		; Update Sequential
	JNZ	POPART
	INX	H		; Record Number.
	INR	M
POPART:
	POP	PSW
	RET			; With I/O cond.


	PAGE
;------------------------------------------------------
;
; CALL OPEN(UNIT #,FILENAME,DRIVE #)
;

OPEN:	LDA	$LUNTB		; Get max LUN
	DCR	A		;
	CMP	M		; Out of range?
	JC	LUNOVF		; Yes, LUN too Large.
;	----------------
	MOV	A,M		; Fetch LUN
	STA	$UN		;SET IT UP
	PUSH	D		;SAVE REGISTERS
	PUSH	B		;SAVE FILPTR
	CALL	$IOINI		;INITIALIZE IF NOT ALREADY DONE
	CALL	GTMODE
	ORA	A		;ALLOCATED?
	CP	ALCBUF		;NO, ALLOCATE
	POP	B
	CALL	GTFCB
	XCHG
	POP	D		;[DE]=NAME PTR
	LDAX	B		;GET DRIVE #
	MOV	M,A		;STORE DRIVE #
	MVI	B,11		;# TO COPY
FILLOP:	LDAX	D
	ORA	A		;NULL BYTE?
	JZ	FILLEN		;YES, LEAVE REST AS BEFORE
	INX	D
	INX	H
	MOV	M,A
	DCR	B		;DONE COPY?
	JNZ	FILLOP		;NO, DO REST
FILLEN:	LDA	$UN		;GET UNIT #
	ADD	A		;WORD TABLE
	MVI	D,0
	MOV	E,A		;[DE]= OFFSET
	LXI	H,$LUNTB
	DAD	D		;POINT TO HIGH OF ADR
	LXI	B,DSKDRV	;ADR OF DISPATCH TABLE
	MOV	M,B
	DCX	H
	MOV	M,C		;NOW A DISK FILE
	RET

	PAGE

	END