			SUBTITLE    "< File positioning subroutines >"
			NEWPAGE
			scope

;	Entry for byte I/O from zGET & zPUT

BYTEIO		PUSH	IX
			POP	DE		;Transfer DCB to DE
			CALL	CKOPENz		;Ck file open, save regs
			SET	7,(IX+1)	;Denote byte or LRec
			LD	A,B		;Get type code & test
			CP	2		;For get/put
			LD	A,C
			JR	Z,WRCHAR	;Go on PUT
			JR	NC,IORETZ	;Ignore if CTL

;	Get a byte from a file

RDCHAR		CALL	CKEOF1		;Ck for end of file
			RET	NZ		;Return if at end
			BIT	5,(IX+1)	;If buffer not current,
			CALL	NZ,NSEC1	;read next sector
			RET	NZ			
			CALL	BFRPOS		;Pt to byte posn in bfr
			LD	A,(DE)		;P/u the byte
			INC	(IX+5)		;Inc NEXT ptr
			CALL	Z,SET5		;Set bit 5 if zero
			CP	A		;Set Z flag--no error
			RET
SET5		SET	5,(IX+1)
			RET

;	Write a byte to a file

WRCHAR		BIT	6,(IX+0)	;Prot level give write acc?
			JP	Z,RWRIT3	;go if not
			PUSH	AF		;Save byte
			BIT	5,(IX+1)	;Get next sector if
			CALL	NZ,WRCH2	;buffer is not current
			JR	Z,WRCH1		;Skip if read was ok
			EX	(SP),HL		;Pop stack but keep
			POP	HL		;error # in AF
			RET
	
WRCH1		CALL	BFRPOS		;Next bfr byte posn
			POP	AF
			LD	(DE),A		;Stuff the byte
			SET	4,(IX+1)	;Buffer contains updated data
			INC	(IX+5)		;Inc NEXT byte
			PUSH	AF		;Save Z or NZ flag
			CALL	Z,SET5		;Set bit 5 if offset 0
			CALL	CKEOF1		;Check for EOF
			JR	NZ,ATEOFW	;Go if there
			BIT	6,(IX+1)	;Jump if EOF set to next
			JR	NZ,DNTSET	;only if at EOF
ATEOFW
			LD	(IX+8),C	;Set EOF
			LD	(IX+12),L
			LD	(IX+13),H
DNTSET		POP	AF		;Restore offset flag
			JR	Z,RWRIT1	;Go to write sector if 00
IORETZ
			XOR	A		;Set Z flag--no error
			RET

;	WRCHR needs the next sector - if UPDATE, ck EOF

WRCH2		LD	A,(IX+1)	;Ck if UPD bit set
			AND	7		;Mask for prot level
			CP	4		;Check for UPD
			JR	NZ,NSEC1	;Bypass EOF ck on > UPD
NXTSECT		CALL	CKEOF1		;Ck for end of file
			RET	NZ		;Can"t extend in update mode.
NSEC1		LD	A,(IX+1)	;Read access?
			AND	7
			CP	6
			JR	NC,RWRIT3	;"Illegal access..." if not
NSEC2		CALL	IOREC		;Calc cylinder/sector
			RET	NZ		; Return on error.
			RES	5,(IX+1)	;Show buffer current
			LD	L,(IX+3)	;P/u buffer address
			LD	H,(IX+4)
			CALL	zRDSEC		;Read the sector
			JR	Z,BUMPNRN	;Go if no error
			CP	6		;Test for prot sector
			RET	NZ		;Quit if error not 6
BUMPNRN	
			INC	(IX+10)		;Inc the NRN ptr LSB
			JR	NZ,ZEROAz
			INC	(IX+11)		;and MSB if necessary
zSEEKSC:		;<631>
ZEROAz		XOR	 A
			RET

;	Repositioning needs to write out the buffer

RWRITz		LD	A,(IX+1)
			AND	90h		;Test for non-sector i/o and
			CP	90h		;buffer contents changed
			JR	Z,RWRIT1	;Go if conditions true
			JR	ZEROAz		;else no need to write
zRWRIT		CALL	CKOPENz		;Ck file open, save regs
RWRIT1		CALL	GETNRN		;P/u NRN
			LD	A,H		;Ignore if rewound
			OR	L
			RET	Z
			DEC	HL		;Dec & reset NRN
			LD	(IX+10),L
			LD	(IX+11),H

;	Check access protection level

RWRIT2		LD	A,(IX+1)	;Get prot
			AND	7
			CP	5		;Update access or better?
			JR	C,RWRIT4
RWRIT3		LD	A,25h		;Illegal access error code
			OR	A		;Return NZ
			RET
RWRIT4
			AND	4		;If UPDATE access, then
			JR	Z,RWRIT5	;can"t extend if at EOF
			CALL	CKEOF1
			JR	NZ,RWRIT3	;so show "Illegal access...
RWRIT5
			CALL	IOREC		;Calculate cylinder & sector
			RET	NZ
			LD	L,(IX+3)	;P/u buffer addr
			LD	H,(IX+4)
			RES	4,(IX+1)	;Altered buffer flag off
			SET	2,(IX+0)	;Show modification done
			CALL	zWRSEC		;for directory mod flag
			RET	NZ
VEROP		LD	A,0		;Verify operation if set
			OR	A
			CALL	NZ,zVRSEC	;Verify if no write error
			RET	NZ		;Return if wrt/ver error
			CALL	BUMPNRN	;Increment NRN

;	Check if ERN to be set to NRN
;	Should be done for byte i/o, but not random i/o

			CALL	CKEOF1		;Returns 0 if not at EOF
			DEC	A		;Set bit 6 if retcod=0
			AND	(IX+1)		;If IX+1, bit 6 set, then
			AND	40h		;don"t update EOF unless at
			JR	NZ,ZEROAz	;or past the old EOF
YESEOF		LD	(IX+12),L	;Update ERN
			LD	(IX+13),H
			BIT	3,(IX+1)	;Test if ending '!'
			jr	NZ,WEOF1	;<631>Upd dir if so
			RET
GETNRN
			LD	L,(IX+10)	;Xfer NRN to HL
			LD	H,(IX+11)
			RET
BFRPOS
			LD	A,(IX+5)	;P/u byte offset in buffer
			ADD	A,(IX+3)	;Add to buffer lsb
			LD	E,A
			LD	A,(IX+4)	;and adjust buffer MSB
			ADC	A,0		;if needed
			LD	D,A		;Return DE = posn
			RET

; 6.3.1 >>> changes dpm.

zDATE		CALL	DATEz		; @DATE handler
			PUSH	HL		; Points to end of date buffer
			DEC	HL		; back up 2
			DEC	HL		; Point to 10s of years
			LD	A,(HL)		; Get digit
			CP	'9'+1		; greater than 9?
			JR	C,M142E		; jump if not
			SUB	0AH		; Convert back to decimal
			LD	(HL),A		; Store in buffer
M142E		POP	HL		; Recover date ptr
			RET			; Return to caller
	
; Entry to Write an end-of-file mark
; This routine relocated here to allow more relative branch references.

			org	1430H
zWEOF		CALL	CKOPENz
			CALL	RWRITz		;Write buffer if needed
WEOF1		LD	B,(IX+7)	;P/u DEC of FPDE
			LD	C,(IX+6)	;P/u drive #
			CALL	zDIRRD		;Read file"s dir record
			RET	NZ		;Back if read error
			INC	L		;Pt to ERN offset
			INC	L
			INC	L
			LD	A,(IX+8)	;P/u EOF offset
			LD	(HL),A		;Put in direc
			LD	DE,17		;Pt to EOF in dir
			ADD	HL,DE
			LD	A,(IX+12)	;P/u lo EOF
			LD	(HL),A		;Put EOF in direc
			INC	HL
			LD	A,(IX+13)	;P/u hi EOF
			LD	(HL),A
			JP	zDIRWR		;Write direc and return


;	Entry to Skip record routine
			org	1457H
zSKIP		CALL	zLOC		;Locate next record
			INC	BC		;Step past it

;	Entry to Position to record routine

zPOSN		CALL	CKOPENz
			SET	6,(IX+1)	;Upd eof only if NRN>EOF
			BIT	7,(IX+1)	;Jump if sector i/o only
			JR	Z,POSN1
			LD	H,B		;Record ptr to HL
			LD	L,C
			OR	(IX+9)		;P/u LRL
			JR	Z,POSN1		;Skip nxt if LRL=256
			CALL	zMUL16		;Calc sector & offset
			LD	B,H		;Physical sector =>BC
			LD	C,L
			LD	(IX+5),A	;Set byte ptr
			BIT	5,(IX+1)	;Jump if buffer does not
			JR	NZ,POSN2	;contain current sector
			CALL	GETNRN		;P/u the NRN
			SCF
			SBC	HL,BC
			JR	Z,$CKEOF	;Pass on to CKEOF
POSN1		LD	(IX+5),A	;Offset in buffer
POSN2		PUSH	BC
POSN2A		CALL	RWRITz		;Write current if needed
			POP	BC		;before moving
			RET	NZ		;Back on write error
			LD	(IX+10),C	;NRN
			LD	(IX+11),B
			CALL	SET5		;Show bfr does not
$CKEOF		JP	CKEOF1		;contain current sector

;	Entry to force a physical read

zRREAD		CALL	CKOPENz
			LD	C,1		;Cause ADJUST to bump NRN when called.
BKSP1		CALL	GETNRN		;Get current record #
			LD	A,H		;If file is rewound,
			OR	L		;then ignore the req
			JR	Z,BKSP0		;& force OFFSET = 0
			DEC	HL		;Back up by 1
			CALL	ADJ2		;RET if sector I/O only,
					;else bump fwd if RREAD
					;then back up if bit 5=0
			PUSH	HL		;Will be popped into BC
			JR	POSN2A		;Finish the job

; Entry to backspace one logical record

zBKSP		CALL	CKOPENz
			LD	C,A		;Keep ADJUST from bumping
			LD	B,(IX+9)	;P/u LRL
			OR	B		;Is it a 0
			JR	Z,BKSP1		;Go if so
			LD	A,(IX+5)	;P/u next byte pointer
			SUB	B		;Sub one record length
BKSP0		LD	(IX+5),A
			JR	C,BKSP1		;Go if crossed sec bdry
			XOR	A		;else all done
			RET

;	Entry to Rewind to beginning

zREW		CALL	CKOPENz
		LD	B,A		;Zero NRN
		LD	C,A
		JR	POSN1		;Will also zero offset

;	Entry to Position to end-of-file

zPEOF		CALL	CKOPENz
		LD	C,(IX+12)	;ERN to BC
		LD	B,(IX+13)
		OR	(IX+8)		;P/u EOF byte
		JR	Z,POSN1		;Go if full sector
		DEC	BC		;Point to last rec
		JR	POSN1		;Use POSN to get end

;	Entry to Locate current record number

zLOC		CALL	CKOPENz
		CALL	GETNRN		;P/u NRN
		CALL	ADJUST		;Get offset and adj NRN
LOC1		LD	E,(IX+9)	;P/u LRL
		LD	A,E		;Test LRL for zero
		OR	A		;If zero, then give NRN
		JR	Z,LOC3		;LRL=0, NRN is correct
		INC	C		;If offset is zero,
		DEC	C		;then it"s at 256,
		JR	Z,LOC2		;and we don"t dec NRN
		DEC	HL

;	Divide the three byte pointer (HLC) by the LRL

LOC2		CALL	zDIV16		;Divide (NRN-1)/LRL
		LD	B,L		;Save high order result
		LD	D,H		;Save possible overflow
		LD	H,A		;Prepare 2nd dividend
		LD	L,C		;P/u low order dividend
		LD	A,E		;P/u LRL divisor again
		CALL	zDIV16
		LD	H,B		;Xfer high order result
		OR	A		;If remainder, we have a
		JR	Z,$+3		;partial record to round
		INC	HL		;up to next record #
		LD	A,D		;Xfer possible overflow
LOC3		POP	BC		;Pop RESTREG return adr
		EX	(SP),HL		;Exchange value with BC
		PUSH	BC		;Restore RESTREG
ORARETz		EQU	$
		OR	A
		RET

;	Entry to Locate the end-of-file record

zLOF		CALL	CKOPENz
		LD	L,(IX+12)	;P/u ERN
		LD	H,(IX+13)
		LD	C,(IX+8)	;EOF byte
		JR	LOC1		;Handle all LRLs

;	Entry to Read a record

zREAD		CALL	CKOPENz
		PUSH	HL
		CALL	RWRITz		;Write buffer if needed
		POP	HL
		RET	NZ		;Back on write error
		LD	B,(IX+9)	;P/u LRL
		LD	A,B		;If LRL=256, just
		OR	A
		JP	Z,NXTSECT	;get the next sector
RDREC		PUSH	HL		;Save buffer posn
		PUSH	BC		;Save LRL
		CALL	RDCHAR		;Read next byte
		POP	BC
		POP	HL
		RET	NZ		;Back on read error
		LD	(HL),A		;Put char into buffer
		INC	HL		;Bump buffer ptr
		DJNZ	RDREC		;Loop for entire record
		RET

;	Entry to Write a record

zWRITE		CALL	CKOPENz
WRIT1		LD	(VEROP+1),A	;Turn on/off verify
		LD	B,(IX+9)	;P/u LRL
		LD	A,B		;Bypass if LRL=256
		OR	A
		JP	Z,RWRIT2
		PUSH	HL		;Save some FCB values
		LD	H,(IX+5)	;P/u buffer offset loc
		LD	L,(IX+8)	;P/U EOF offset byte
		EX	(SP),HL		;Put values on stack
					;and recover HL
WRREC		LD	A,(HL)		;Pass the logical record
		INC	HL		;to the writing routine
		PUSH	HL		;byte by byte
		PUSH	BC
		CALL	WRCHAR
		POP	BC
		POP	HL
		JR	NZ,WRERROR	;Exit and fix FCB
		DJNZ	WRREC		;Loop for entire record
		EX	(SP),HL		;Remove stored FCB info
		POP	HL		;Recover HL
		RET
WRERROR	EX	(SP),HL			;Get FCB Values
		LD	(IX+5),H	;and put them back
		LD	(IX+8),L
		POP	HL		;Restore HL
		RET			;Go back with error

;	Entry to Verify after write of a record

zVER		CALL	CKOPENz
		INC	A		;Set verify byte
		JR	WRIT1
LNKFCBz		SCF			;Init to force file open
		DB	0D2h		;test by JP NC,aaaa
CKOPENz		LD	A,(DE)		;Ignore if from LNKFCB
		RLCA			;Test hi bit of FCB
		EX	(SP),HL
		LD	(JRET$),HL	;Save ret
		LD	(JDCB$),DE	;Save DCB
		EX	(SP),HL
		JR	NC,NOTOPEN	;Go if not an open FCB
		POP	AF		;Get return
		PUSH	DE		;Dcb addr to IX
		EX	(SP),IX
		PUSH	HL		;Save regs
		PUSH	DE
		PUSH	BC
		PUSH	HL		;Estab ret
		LD	HL,RESTREG	;to restore registers
		EX	(SP),HL
		PUSH	AF		;Put back ret
		XOR	A
		RET			;Go back

NOTOPEN	POP	AF
		LD	A,26h		;File not open
		OR	A
		RET

RESTREG	POP	BC			;Pop back registers save
		POP	DE		;in CKOPENz
		POP	HL
		POP	IX
		RET

;	Entry to Check if at end-of-file.

zCKEOF		CALL	CKOPENz
CKEOF1		CALL	GETNRN		;P/U NRN into HL
		PUSH	HL		;Save un-adjusted NRN
		CALL	ADJUST		;Adjust for special cases
		LD	A,H		;Compare hi byte
		CP	(IX+13)
		JR	NZ,CKEOF2	;Go if not equal
		LD	A,L		;Compare lo byte
		CP	(IX+12)
		JR	NZ,CKEOF2	;Go if not equal
		DEC	C		;Adjust for 00=256
		LD	A,(IX+8)	;Compare offset byte
		DEC	A
		SUB	C
		CCF
		INC	BC		;Restore old C value

CKEOF2		POP	HL		;Restore unadjusted NRN
		LD	A,1Dh		;Rec # out of range code
		JR	NZ,CKEOF3	;Go if not at EOF
		DEC	A		;X"1C'=EOF encountered
		RET			;Return with NZ flag
CKEOF3		RET	NC		;Return with error
		XOR	A		;No error
		RET

;	File positioning adjustment routines

ADJUST		EQU	$		;Entry from zCKEOF & zLOC
		LD	C,(IX+5)	;Pick up offset
ADJ2		EQU	$		;Entry from zBKSP/zRREAD
		BIT	7,(IX+1)	;Sector I/O only?
		RET	Z		;No adjustment if so
		LD	A,C		;Offset =0? (or "RREAD?")
		OR	A
		JR	Z,$+3		;Go if zero
		INC	HL		;Adjust
		BIT	5,(IX+1)	;Check magic bit
		RET	NZ		;Go if set
		DEC	HL		;Adjust
		RET
;
;	Calculate the cylinder/sector of needed record
;
IOREC		CALL	GETNRN		;P/u record number
		CALL	zDCTBYT-5	;Get # of sectors/gran
		AND	1Fh
		INC	A
		CALL	zDIV16		;By # of sectors/gran
		LD	(CALS5+1),A	;Sv rmndr (sector offset)
		PUSH	IX		;Xfer fcb to HL
		EX	(SP),HL
		LD	BC,14		;Pt to 1st extent info
		ADD	HL,BC
		POP	BC		;Pop gran ptr HL into BC
		LD	A,5		;Init to ck 4 extents
		LD	DE,0		;& extended FXDE ptr
GREC1		PUSH	AF
		LD	A,(HL)		;P/u starting cyl byte
		INC	HL		;& bypass if FF
		INC	A
		JR	Z,GREC2
		PUSH	HL		;Xfer the # of grans up
		LD	H,D		;to but not including
		LD	L,E		;this extent into HL
		XOR	A		;Sub gran pointer from
		SBC	HL,BC		;cumulative figure & go
		JR	C,GREC3		;if not in previous ext
		POP	HL
		JR	Z,CALCSEC
GREC2		INC	HL
		POP	AF
		DEC	A
		JR	Z,GREC4		;Jump when all quads c"kd
		LD	E,(HL)		;P/u cumulative # grans
		INC	HL		;up to but not
		LD	D,(HL)		;including this extent
		INC	HL
		JR	GREC1
GREC3		INC	H		;Within 256 grans?
		LD	A,L		;Xfer lo-order difference
		POP	HL		;Rcvr # of contig grans
					;in this extent
		JR	NZ,GREC2	;Go if not within 256
		PUSH	DE		;Save cumulative count 
		LD	E,A		;Xfer gran dif (neg)
		LD	A,(HL)		;P/u # of grans
		AND	1Fh		;in this extent
		ADD	A,E		;Add to negative diff
		LD	A,E		;Put neg diff into A
		POP	DE
		JR	NC,GREC2	;Go if not in this extent
		NEG			;Is in this extent, make
		JR	CALCSEC		;diff positive & use it

;	All current quads checked - Need directory info

GREC4		CALL	ALLOC		;Get # of grans
		RET	NZ		;into the extent
		LD	(CALS4+1),A	;or error RET
		JR	NC,CALS3	;Jp if record in 1st ext
		JR	CALS1		;else jp if in another

;	Calc sector in gran

CALCSEC	LD	(CALS4+1),A		;Stuff # grans into
		LD	B,(HL)		;this extent
		DEC	HL		;P/u # contig grans &
		LD	C,(HL)		;rel start & start cyl
		INC	HL
		POP	AF		;Rcvr # of quad
		CPL
		ADD	A,4
		JR	NC,CALS2	;Jump if 1st ext or quad
		INC	A		;If not 1st, set up to move
		RLCA			;matching quad to the
		RLCA			;first position by
		PUSH	BC		;shuffling the others up
		PUSH	DE
		LD	C,A		;Get bytes to move
		LD	B,0
		EX	DE,HL		;DE = top of last quad
		LD	HL,-4
		ADD	HL,DE		;HL = top of next lower
		LDDR			;Do the shuffle
		EX	DE,HL
		POP	DE
		POP	BC
CALS1		LD	(HL),B		;Move info on matching quad
		DEC	HL		;into position
		LD	(HL),C
		DEC	HL
		LD	(HL),D
		DEC	HL
		LD	(HL),E
CALS2		LD	H,B		;Xfer start & contig gran
		LD	L,C		;Xfer start cylinder
CALS3		LD	A,H
		RLCA			;P/u start gran on track
		RLCA
		RLCA
		AND	7
CALS4		ADD	A,0		;P/u # grans into extent
		CALL	RELCYL		;Calc 1st relative cyl
		ADD	A,L		;Add starting cylinder
		LD	D,A
		LD	A,B		;Rcvr # sectors/gran
		AND	1Fh
		INC	A
		PUSH	DE		;Calculate sector offset
		CALL	zMUL8		;into desired cylinder
		POP	DE		;for desired granule
CALS5		ADD	A,0		;P/u # of excess sectors
		LD	E,A		;over even gran & add
		XOR	A		;to granule sector
		RET

; On entry, gran needed is in BC

ALLOC		CALL	CYL_GRN		;Find ext cntng gran
		RET	NZ		;Ret on error
		PUSH	HL		;Save starting cyl & gran
		LD	H,B		;Xfer granule needed to
		LD	L,C		;HL then calculate how
		XOR	A		;many grans into this
		SBC	HL,DE		;extent is the desired
		LD	A,L		;granule
		LD	(ALL6+1),A	;Stuff rel gran from
		POP	HL		;start of extent
		PUSH	DE		;Save granule count
		PUSH	IX		;to extent
		EX	(SP),HL		;FCB pointer to HL
		LD	DE,14		;Pt to 1st alloc in FCB
		ADD	HL,DE
		POP	DE		;Pop starting cylinder
		LD	B,5		;to this extent
ALL1		LD	A,(HL)		;P/u a cyl
		INC	HL		;Does starting cyl of
		CP	E		;needed gran alloc
		JR	NZ,ALL2		;appear in this extent?
		LD	A,(HL)		;Now see if needed gran is
		XOR	D		;in this extent field
		AND	0E0h		;by checking its starting gran
		JR	Z,ALL4
ALL2		DEC	B		;Dec the count down loop
		JR	Z,ALL3		;Done if no match
		INC	HL		;Go to next extent
		INC	HL		;info in FCB
		INC	HL
		JR	ALL1
ALL3		PUSH	DE		;Save needed extent info
		EX	DE,HL		;Set up to shuffle extent
		LD	HL,-4		;info
		ADD	HL,DE
		LD	BC,12
		LDDR
		EX	DE,HL
		POP	BC
		XOR	A		;Set Z, no error
		SCF			;Set CF, extent not found
		JR	ALL5
ALL4		LD	(HL),D
		EX	DE,HL
		XOR	A		;Set Z no error
ALL5		POP	DE
ALL6		LD	A,0		;# of grans into this ext
		RET			;Where desired gran is

;	Extent is unused - need to allocate more space

CG06		CALL	CG07		;Try to allocate more
		POP	BC		;Get back desired gran
		RET	NZ		;Return on error
					;Look for gran again

;	Find extent containing desired granule

CYL_GRN		PUSH	BC		;Save desired gran #
		LD	DE,0		;Init gran counter
		LD	B,(IX+7)	;P/u DEC of file
CG01		LD	A,B
		LD	(STUFDEC+1),A	;Stuff
		LD	C,(IX+6)	;P/u drive for file
		CALL	zDIRRD		;Read its directory
		LD	BC,22		;Point to 1st extent
		ADD	HL,BC		;of its directory
		EX	DE,HL		;Gran count to HL
		POP	BC		;Restore desired gran
		RET	NZ		;Return on read error
CG02		LD	A,(DE)		;Is this extent
		CP	0FEh		;allocated?
		JR	NC,CG05		;Jump if it is not
		INC	DE		;Point to allocation
		LD	A,(DE)		;P/u relative gran & #
		PUSH	HL		;of contiguous grans
		AND	1Fh		;Keep contiguous grans
		INC	A		;& bump for 0 offset
		ADD	A,L		;Add to count in HL
		LD	L,A
		JR	NC,CG03
		INC	H		;Bump hi order
CG03		PUSH	HL		;Save gran count to
		DEC	HL		;end of extent
		XOR	A		;Test if EOF is in this
		SBC	HL,BC		;allocation
		POP	HL
		JR	NC,CG04		;EOF not > this alloc
		INC	DE		;Get rid of old
		POP	AF		;current quantity
		JR	CG02		;Check next extent
	
;	The EOF is within this allocation. Recover
;	the allocation data and exit

CG04		POP	HL		;P/u gran count to extent
		EX	DE,HL		;Gran count to DE
		LD	A,(HL)		;P/u granule data
		DEC	HL
		LD	L,(HL)		;P/u starting cylinder
		LD	H,A
		XOR	A
		RET

;	This extent is 1) unused, or 2) FXDE pointer
;	and the needed gran has not been found yet

CG05		PUSH	BC		;Gran count to DE &
		EX	DE,HL		;DIR ptr to HL
		JR	NZ,CG06		;Jump if unused
		INC	HL		;Point to DEC of FXDE
		LD	B,(HL)		;P/u the DEC
		JR	CG01		;& loop

;	See if the drive has enough free space left

CG07		PUSH	BC		;Save needed gran
		LD	C,(IX+6)	;P/u file"s drive
		CALL	zGATRD		;Get GAT
		POP	BC		;Rcvr needed gran
		RET	NZ		;Return if GAT error
		PUSH	HL
		LD	H,B		;Xfer the requested
		LD	L,C		;gran to HL &
		XOR	A		;subtract current gran
		SBC	HL,DE		;Count to calculate how
		LD	B,H		;many excess grans
		LD	C,L		;are needed
		INC	BC
		POP	DE		;Rcvr dir byte ptr
		INC	DE		;Pt to next DIR byte
		LD	H,DIRBUF$>>8	;Start looking at TRK #1
		LD	A,(AFLAG$)	;P/u Search start CYL
		LD	L,A		;and put it in L
		PUSH	BC		;Save excess grans needed
		LD	A,E		;Is this extent the 1st?
		AND	1Eh		;Jump if so, else we can
		CP	16h		;use it for allocation
		JR	Z,CG14
		DEC	E		;Backup to previous
		DEC	E		;extent
CG12		LD	A,(DE)		;P/u # of contig grans to
		AND	1Fh		;see if the last gran
		INC	A		;used can be extended
		LD	C,A		;Is current # the max
		CP	20h		;an extent can hold?
		JR	Z,CG13		;Jump if a full extent
		LD	A,(DE)		;(32 grans max) - else
		AND	0E0h		;p/u the relative
		RLCA			;granule offset
		RLCA
		RLCA
		ADD	A,C		;Add the # of contiguous
		PUSH	DE		;granules
		CALL	RELCYL		;Calc relative cyl needed
		LD	B,A		;Save offset
		LD	C,E
		POP	DE
		DEC	DE		;Backup to starting cyl
		LD	A,(DE)
		INC	DE		;& repoint to alloc byte
		ADD	A,B		;Add cyls used to
		LD	L,A		;starting cyl
		LD	H,DIRBUF$>>8	;Is it less than max?
		CP	0CBh
		JR	NC,CG13		;Jump if too big
		LD	A,C
		LD	B,(HL)		;P/u the cyl"s GAT
		CALL	TSTBIT		;Test if gran is free
		JR	Z,CG21		;Bypass if free gran

;	The next gran cannot be used - get another extent

CG13		INC	E		;Else point to next
		INC	E		;extent field
		LD	A,E
		AND	1Eh		;Jump if not on the FXDE
		CP	1Eh		;field, else we have to
		JR	NZ,CG14	;obtain an FXDE record

;	Last extent used up, get new dir rec for FXDE

		CALL	CG23		;Write curent GAT & HIT
		POP	BC
		RET	NZ		;Ret if GAT/HIT error
		PUSH	BC
		CALL	NEWHIT		;Get new HIT for FXDE
		POP	BC
		RET	NZ		;Loop to process
		JP	CYL_GRN		;new extent

;	Extent is vacant - use it & get new allocation

CG14		CALL	MAXCYL		;Get highest # cyl
		LD	(CG17+1),A	;Stuff highest cyl
		LD	B,2
CG16		LD	A,L		;Test last cyl used
CG17		CP	0		;P/u max cyl
		JR	NC,CG18
		LD	A,(HL)		;P/u a GAT byte
		INC	A
		JR	NZ,CG19		;Go if space in this cyl
		INC	L		;else bump to next one
		JR	CG16		;& loop
CG18		LD	L,0		;Now start from begin
		DJNZ	CG16		;of disk & recheck
		POP	BC
		CALL	CG23		;Write out GAT & HIT
		RET	NZ
		LD	A,1Bh		;"disk space full"
		OR	A
		RET

;	Found available space in cylinder

CG19		LD	A,0FFh		;Set DIR extent to FF
		LD	(DE),A
		LD	C,0
		LD	B,(HL)		;P/u current GAT alloc
CG20		LD	A,C
		CALL	TSTBIT		;Find a free gran
		JR	Z,CG21		;& jump when found
		LD	A,(DE)		;else advance starting
		ADD	A,20h		;rel gran value
		LD	(DE),A
		INC	C		;Bump pointer to test
		JR	CG20		;next gran

;	Next gran in line is free - allocate it

CG21		LD	A,C
		CALL	SETBIT		;Show it allocated
		OR	(HL)
		LD	(HL),A
		DEC	E		;Backup to starting cyl
		LD	A,(DE)		;Bump by one to see if
		INC	A		;this alloc is the 1st
		JR	NZ,CG22		;one for the extent &
		LD	A,L		;we have to set the
					;starting cylinder
		LD	(DE),A		;Stuff starting cyl
CG22		INC	E
		LD	A,(DE)		;Add 1 to # of contiguous
		INC	A		;granules
		LD	(DE),A
		POP	BC		;Decrement needed gran
		DEC	BC		;count since we just
		PUSH	BC		;allocated one
		LD	A,B		;Loop if we need more
		OR	C		;space allocated
		JP	NZ,CG12
		POP	BC
CG23		LD	C,(IX+6)	;Else p/u the drive #
		CALL	zGATWR		;& write out the GAT
		RET	NZ
STUFDEC		LD	B,0		;P/u DEC of FPDE
		JR	zDIRWR

; Get new HIT for FXDE

NEWHIT		LD	C,(IX+6)	;P/u drive #
		CALL	zHITRD		;Read the HIT
		RET	NZ
		LD	A,(IX+7)	;P/u FPDE DEC so 1st ck
		AND	1Fh		;will be for next
		CALL	zSCNHIT		;in line
		LD	A,1Eh		;Init "full directory...
		RET	NZ		;Ret if no space
		LD	B,L		;Set DEC for
		LD	A,L		;directory read
		LD	(NHIT3+1),A	; Stuff new DEC from HIT
		LD	D,H
		LD	E,(IX+7)	;P/u current DEC
		LD	A,(DE)		;Copy filespec hash code
		LD	(HL),A		;to new DEC
		CALL	zHITWR
		CALL	Z,zDIRRD
		RET	NZ
		LD	(HL),90h	;Show dir rec in use as
		INC	L		;FXDE record
		PUSH	BC		;P/u DEC of FPDE &
		LD	A,(STUFDEC+1)	;stuff it into FXDE"s
		LD	(HL),A		;DIR+1 to link back
		INC	L
		LD	B,20		;Zero out 20 bytes
NHIT1		LD	(HL),0		;in the FXDE
		INC	L
		DJNZ	NHIT1
		PUSH	HL		;Save ptr to 1st extent
		LD	B,10		;Init to X"FF' 10 bytes
NHIT2		LD	(HL),0FFh	;or 5 extents
		INC	L
		DJNZ	NHIT2
		POP	DE		;Rcvr ptr to 1st extent
		INC	DE		;Pt to allocation byte
		POP	BC
		CALL	zDIRWR		;Write FXDE back to disk
		RET	NZ		;Return if error
		LD	A,(STUFDEC+1)	;else p/u DEC of FPDE
		LD	B,A
		CALL	zDIRRD		;Read its directory
		RET	NZ		;& return if error
		LD	A,L
		ADD	A,1Eh		;Point to FXDE posn
		LD	L,A		;in FPDE
		LD	(HL),0FEh	;Show link to FXDE
		INC	L
NHIT3		LD	(HL),0		;Show what"s the FXDE DEC													;& write the DIR back

;	Routine to write a directory sector
;	B => DEC of FPDE, C => logical drive number
;	HL <= points to directory record in SBUFF$

zDIRWR		CALL	DIRWR		;Permit two attempts
		RET	Z
DIRWR		PUSH	DE		;Save the reg
		CALL	CALCDIR		;Calc dir cyl
		LD	L,0		;Set buffer to start
		CALL	zWRSSC		;Write the sector
		CALL	Z,zVRSEC	;Verify on no error
		SUB	6
		POP	DE
		RET	Z		;Back on system sector
		CP	0Fh-6		;WP error?
		LD	A,18		;Set dir write error
		RET	NZ		;if not WP
		SUB	3
		RET

;	Find a spare HIT entry

zSCNHIT		PUSH	AF
		LD	A,7		;Get highest # sector
		CALL	zDCTBYT		;on a cylinder
		PUSH	DE		;into register E
		LD	D,A
		AND	1Fh
		LD	E,A
		INC	E		;& get number of heads
		XOR	D		;into register A
		RLCA
		RLCA
		RLCA
		INC	A
		CALL	zMUL8		;To calc sectors/cylinder
		CALL	CKDBLBIT	;Double if necessary
		POP	DE		;Total sectors per cyl
		SUB	2		;Reduce for GAT & HIT
		LD	(NHIT7+1),A	;# of directory sectors
		POP	AF		;Get DEC init entry
		LD	L,A
		CALL	NHIT6		;Ck if HIT slot is spare
		RET	Z		;Return if it is spare
		LD	L,1		;Start at beginning
NHIT5		INC	L
		JR	NZ,NHIT6
		OR	H
		RET
NHIT6		LD	A,L
		AND	1Fh
NHIT7		CP	0
		LD	A,L
		JR	C,NHIT8
		OR	1Fh
		LD	L,A
		JR	NHIT5
NHIT8		LD	A,(HL)
		OR	A
		RET	Z
		JR	NHIT5

;	Test if gran is free in GAT

TSTBIT		AND	7		;Get 0 to 7
		RLCA			;Shift to match BIT n,
		RLCA			;opcode
		RLCA
		OR	40h
		LD	(TBIT1+1),A	;Modify BIT instruction
TBIT1		BIT	0,B
		RET

;	Set gran to allocated in GAT

SETBIT		RLCA			;Shift to create opcode
		RLCA			;to match current bit
		RLCA
		OR	0C7h
		LD	(SBIT1+1),A	;Create SET n, opcode
		XOR	A
SBIT1		SET	0,A
		RET

;	Routine reads/writes the Granule Allocation Table

zGATRD		DB	0F6h		;Set NZ for test
zGATWR		XOR	A		;Set Z for test
		PUSH	DE
		PUSH	HL
		PUSH	AF		;Save flag for test
		CALL	zDIRCYL
		LD	HL,DIRBUF$
		LD	E,L		;Set E to 0
		POP	AF		;Rcvr flag for R/W
		JR	Z,GATRW1	;Go if zGATWR
		CALL	zRDSSC
		LD	A,14h		;Init "GAT read error"
		JR	GATRW2
GATRW1	
		CALL	zWRSSC		;Protected sector write
		CALL	Z,zVRSEC	;Verify if OK
		CP	6		;Protected sector?
		LD	A,15h		;Init "GAT write error"
GATRW2		POP	HL
		POP	DE
		RET

;	Read or write the hash index table

zHITRD		DB	0F6h		;Set NZ for test
zHITWR		XOR	A		;Set Z for test
		PUSH	BC
		PUSH	DE
		PUSH	AF		;Save flag for test
		CALL	zDIRCYL		;D => directory cylinder
		LD	E,1		;E => HIT sector
		LD	HL,SBUFF$	;HL => HIT buffer area
		POP	AF		;Rcvr flag for RD/WR
		JR	Z,HITRW1	;Go if zHITWR
		CALL	zRDSSC		;Read cyl D, sector E
		LD	A,22		;Init "HIT read error"
		JR	HITRW2
HITRW1		CALL	zWRSSC		;Protected sector write
		CALL	Z,zVRSEC	;Verify the write
		CP	6		;Protected sector?
		LD	A,23		;"HIT write error"
HITRW2		POP	DE		;Message for other than
		POP	BC		;attempt protected sector
		RET

;	Routine to read a directory sector
;	B => DEC of FPDE, C => logical drive number
;	HL <= points to directory record in SBUFF$

zDIRRD		PUSH	DE
		CALL	CALCDIR		;Set HL to SBUFF$
		PUSH	HL
		LD	L,0		;Start of bfr
		CALL	zRDSSC		;Read it
		POP	HL
		LD	A,17		;Init to dir read err
		POP	DE
		RET

;	Routine to get directory access data
;	B => DEC
;	DE <= cylinder and sector needed
;	HL <= pointer to directory record in SBUFF$

CALCDIR		CALL	zDIRCYL		;Get directory cyl in D
		LD	A,B		;Calculate record star		
		AND	0E0h		;from the DEC
		LD	L,A
		LD	H,SBUFF$>>8	;Point to buffer start
		XOR	B		;Calculate directory
		ADD	A,2		;sector needed
		LD	E,A
		RET

zRDSSC	;	Read system sector, D=Track, E=Sector, HL=Buffer.

		CALL	READIR
		RET	Z
		PUSH	DE
		LD	DE,1		;Pt to tk 0, sec 1
		CALL	zRDSEC		;Read to find dir cyl
		POP	DE
		RET	NZ
		PUSH	HL
		INC	HL		;Pt to dir tk #
		INC	HL
		LD	D,(HL)		;P/u dir tk fm boot
		LD	H,9		;Update memory table
		CALL	DCTFLDz
		LD	L,A
		LD	(HL),D
		POP	HL
READIR
		CALL	zRDSEC		;Retry dir read
		SUB	6		;Test protected
		RET
;
zDIRCYL
		LD	A,9
		CALL	zDCTBYT		;Get the dir cylinder
		LD	D,A
		RET

MAXCYL
		LD	A,6
		PUSH	BC
		LD	C,(IX+6)
		CALL	zDCTBYT		;Get highest # cyl
		INC	A		;Adjust for zero offset
		POP	BC
		RET

;	Multiply register E by register A

zMUL8		PUSH	BC		;  Mult A x E
		LD	D,A
		XOR	A
		LD	B,8
MEA1		ADD	A,A
		SLA	E
		JR	NC,MEA2
		ADD	A,D
MEA2		DJNZ	MEA1
		POP	BC
		RET
;
;	Calculate relative cylinder for granule needed
;
RELCYL		LD	E,A
		CALL	zDCTBYT-5	;Get # of grans/track
		LD	B,A		;Hang on to this
		RLCA
		RLCA
		RLCA
		AND	7
		INC	A		;Adj for 0 offset
		CALL	CKDBLBIT

;	Divide register E by register A

zDIV8		PUSH	BC
		LD	C,A
		LD	B,8
		XOR	A
DEA1		SLA	E
		RLA
		CP	C
		JR	C,DEA2
		SUB	C
		INC	E
DEA2		DJNZ	DEA1
		LD	C,A
		LD	A,E
		LD	E,C
		POP	BC
		RET

;	Routine to double the A register if DBL bit is set

CKDBLBIT	LD	D,A		;Adjust for 2-sided &
		LD	A,4		;calculate # of cyls
		CALL	zDCTBYT
		BIT	5,A		;Test if 2-sided
		LD	A,D
		JR	Z,$+3		;Double the grans if 2
		ADD	A,A		;& fall thru to DIV8
		RET