;
; Write sequential
;
cmnd21:	call	seldrv			; Select drive from FCB
;
; Write sector
;
writes:	ld	a,0ffh			; Set read/write flag
	ld	(rdwr),a		; And save it
	call	chkro			; Check disk r/o
	push	ix			; Save FCB pointer
	pop	hl			; Get it back in hl
	call	chkfr0			; Check file r/o
	ld	a,(ix+32)		; Get record count
	cp	080h			; Test if end this extent
	jr	c,writs0		; Yes then open next extent
	call	openex			; Open next extent
	ld	a,(pexit)		; Get error code
	or	a		
	jp	nz,writs9		; Error then directory full error
	ld	(ix+32),a		; Clear record counter
writs0:	call	getdm			; Get block number from FCB
	ld	a,d			; Test if block number = 0
	or	e
	jr	nz,writs5		; No then write sector
	push	hl			; Save pointer to block number
	ld	a,c			; Test first block number in extent
	or	a
	jr	z,writs1		; Yes then jump
	dec	a			; Decrement pointer to block number
	call	getdm4			; Get previous blocknumber
writs1:	call	getfre			; Get nearest free block
	pop	hl			; Get pointer to block number
	ld	a,d			; Test if blocknumber = 0
	or	e
	jp	z,writs8		; Yes then disk full error (jr without archive routines. L.h.)
	res	7,(ix+14)		; Reset FCB/file modified
	ld	(hl),e			; Save blocknumber
	ld	a,(maxlen+1)		; Get number of blocks
	or	a			; Test if <256
	jr	z,writs2		; Yes then jump
	inc	hl			; Increment to MSB block number
	ld	(hl),d			; Save MSB block number
writs2:	ld	c,2			; Set write new block flag
	ld	a,(funct)		; Get function number
	sub	40			; Test if write rr with zero fill
	jr	nz,writs6		; No then jump
	push	de			; Save blocknumber
 	ld	hl,(dirbuf)		; Use directory buffer for zero fill
	ld	b,128			; 128 bytes to clear
writs3:	ld	(hl),a			; Clear directory buffer
	inc	hl			; Increment pointer
	djnz	writs3			; Clear all bytes
	call	calsec			; Calculate sector number (128 bytes)
	ld	a,(nmask)		; Get sector mask
	ld	b,a			; Copy it
	inc	b			; Increment it to get number of writes
	cpl				; Complement sector mask
	and	e			; Mask sector number
	ld	e,a			; And save it
	ld	c,2			; Set write new block flag
writs4:	push	hl			; Save registers
	push	de
	push	bc
	call	calst			; Calculate sector/track
	call	dmadir			; Set DMA directory buffer
	pop	bc			; Get write new block flag
	push	bc			; Save it again
;       res	7,(ix+11)		; Reset the archive bit (l.h.)
	call	writer			; Write record on disk
	pop	bc			; Restore registers
	pop	de
	pop	hl
	ld	c,a  ;writer sets a=0	; Clear write new block flag
	inc	e			; Increment sector number
	djnz	writs4			; Write all blocks
	call	stdma			; Set user DMA address
	pop	de			; Get block number
writs5:	ld	c,0			; Clear write new block flag 
writs6:	res	7,(ix+14)		; Reset FCB/file modified flag
	push	bc			; Save it
	call	calsec			; Calculate sector number (128 bytes)
	call	calst			; Calculate sector/track
	pop	bc			; Get write new block flag
	call	writer			; Write record on disk
	bit	7,(ix+11)		; Archive bit set? (l.h.)
	jr	z,noarc			; If not, don't jump
	res	7,(ix+11) 		; Reset the archive bit
	call	cstat			; Do it for all extents
;	xor	a			; Make a null. Cstat returns a=0
	ld	(pexit),a		; Error code null on return to caller
noarc:	ld	a,(ix+32)		; Get record counter
	cp	(ix+15)			; Compare with next record
	jr	c,writs7		; If less then jump
	inc	a			; Increment record count 
	ld	(ix+15),a		; Save it on next record position
	res	7,(ix+14)		; Reset FCB/file modified flag
writs7:	ld	a,(funct)		; Get function number
	cp	21			; Test write sequential
	ret	nz			; Not then return
	inc	(ix+32)			; Increment record count
	ret				; And return to caller
writs8:	ld	a,2			; Set disk full error
	ld	(pexit),a
	ret				; And return to caller
writs9:	ld	a,1			; Set directory full flag
	ld	(pexit),a
	ret				; And return to caller
;
; Load FCB for random read/write
;  exit : zero flag : 1 no error
;                     0 error occured
;
ldfcb:	ld	(rdwr),a		; Save read/write flag
	ld	a,(ix+33)		; Get first byte random record
	ld	d,a			; Save it in d
	res	7,d			; Reset MSB to get next record
	rla				; Shift MSB in carry
	ld	a,(ix+34)		; Load next byte random record
	rla				; Shift carry
	push	af			; Save it
	and	01fh			; Mask next extent
	ld	c,a			; Save it in c
	pop	af			; Get byte
	rla				; Shift 4 times
	rla
	rla
	rla
	and	0fh			; Mask it
	ld	b,a			; Save FCB+14
	ld	a,(ix+35)		; Get next byte random record
	ld	e,6			; Set random record to large flag
	cp	4			; Test random record to large 
	jr	nc,ldfcb8		; Yes then error
	rlca				; Shift 4 times
	rlca
	rlca
	rlca
	add	a,b			; Add byte
	ld	b,a			; Save FCB+14 in b
	ld	(ix+32),d		; Set next record count
	ld	d,(ix+14)		; Get FCB+14
	bit	6,d			; Test error random record
	jr	nz,ldfcb0		; Yes then jump
	ld	a,c			; Get new extent number
	cp	(ix+12)			; Compare with FCB
	jr	nz,ldfcb0		; Not equal then open next extent
	ld	a,b			; Get new FCB+14
	xor	(ix+14)			; Compare with FCB+14
	and	03fh			; Mask it
	jr	z,ldfcb6		; Equal then return
ldfcb0:	bit	7,d			; Test FCB modified (write)
	jr	nz,ldfcb1		; No then jump
	push	de			; Save registers
	push	bc
	call	close			; Close extent
	pop	bc			; Restore registers
	pop	de
	ld	e,3			; Set close error
	ld	a,(pexit)		; Get exit code
	inc	a
	jr	z,ldfcb7		; Error then exit
ldfcb1:	ld	(ix+12),c		; Save new extent number
	ld	(ix+14),b		; Save new FCB+14
	bit	7,d			; Test FCB modified (previous FCB)
	jr	nz,ldfcb3		; No then jump
ldfcb2:	ld	a,15			; Set number of bytes to search for
	call	search			; Search next FCB
	jr	ldfcb4			; Jump
ldfcb3:	bit	7,(ix+10)		; Test if system file
	jr	z,ldfcb2		; No use search
	call	findf			; Open file (use path name)
ldfcb4:	ld	a,(pexit)		; Get error code
	inc	a
	jr	nz,ldfcb5		; No error then exit
	ld	a,(rdwr)		; Get read/write flag
	ld	e,4			; Set read empty record
	inc	a
	jr	nz,ldfcb7		; Read then error
	call	make			; Make mew FCB
	ld	e,5			; Set make error
	ld	a,(pexit)		; Get error code
	inc	a
	jr	z,ldfcb7		; Error then exit
	jr	ldfcb6			; No error exit (zero set)
ldfcb5:	call	openf0			; Open file
ldfcb6:	xor	a			; Set zero flag and clear error code
	ld	(pexit),a
	ret				; And return to caller
ldfcb7:	ld	(ix+14),0c0h		; Set random record error
ldfcb8:	ld	a,e			; Get error code
	ld	(pexit),a		; And save it
	set	7,(ix+14)		; Set FCB/file not modified
	or	a			; Clear zero flag
	ret				; And return to caller
;
; Calculate random record
;  entry hl = offset in FCB
;        de = FCB pointer
;
;  exit  d  = LSB random record
;        c  = ISB random record
;        b  = MSB random record
;
calrrc:	add	hl,de			; Pointer to FCB+15 or FCB+32
	ld	a,(hl)			; Get byte
	ld	hl,12			; Offset to extent number
	add	hl,de			; Get pointer to extent byte
	ld	d,a			; Save first byte
	ld	a,(hl)			; Get extent byte
	and	01fh			; Mask it
	rl	d			; Shift MSB in carry
	adc	a,0			; Add carry
	rra				; Shift 1 time (16 bits)
	rr	d
	ld	c,a			; Save ISB
	inc	hl			; Increment to FCB+14
	inc	hl
	ld	a,(hl)			; Get FCB+14
	rrca				; Shift 4 times
	rrca
	rrca
	rrca
	push	af			; Save it
	and	03h			; Mask MSB
	ld	b,a			; Save it
	pop	af			; Get LSB
	and	0f0h			; Mask it
	add	a,c			; Add with ISB
	ld	c,a			; Save ISB
	ret	nc			; No carry then return
	inc	b			; Increment MSB
	ret				; And return to caller
;
;
; Get/Set Flags Byte
;
setflag:
	ld	hl,flags		; Get old flags byte
	or	a			; A=0 means get flags
	jr	nz,sflg1		; If not, then get/set
	ld	a,(hl)			; Load flags
	ld	(pexit),a		; to exit buffer
	ret				; and go home
;
sflg1:	bit	7,a			; Test of setting or resetting
	res	7,a			; Reset the set/reset bit
	jr	z,sflg2			; Jump if resetting
	or	(hl)			; Set
	ld	(hl),a			; and save
	ret	
sflg2:	cpl				; Complement flags byte
	and	(hl)			; Reset
	ld	(hl),a			; and save
	ret

	 if	pathcall and ispath
;
; Get/Set Path Address
;
setpath:
	ld	a,d
	or	e
	jr	z,getpath
	ld	(path),de
	ret
getpath:
	ld	hl,(path)
	ld	(pexit),hl
	ret
	 endif	; pathcall

	 if	hifuncs
;
; Set Warm Boot Trap
;
wbtrap:	
	ld	(trap),de
	ld	a,0ffh
	jr	gotrap		; Set the trap flag for wbtres

;
; Reset Warm Boot Trap
;
wbtres:	ld	hl,ramlow
	ld	(trap),hl
	xor	a
gotrap:	ld	(trapflag),a
	ret
	 endif	; hifuncs

;
; Relocate code
; 
; SPR type Relocator
; =================
; 
; Bridger Mitchell's  Word-wide relocator starts here.. Modified to work in
; DOS with relocation control block. The relocation control block has the
; format:
;
;	defw	codeadrs	; Address of code to move and address adjust
;	defw	newadrs		; Address to which to move code
;	defw	offset		; Offset to add to relative addresses
;	defw	size		; Size of code
;	defw	bitmap		; Pointer to SPR type relocation bitmap
;
;
	 if	relfunc
cmnd38:	di			; Disable interrupt system
	ex	de,hl		; HL -> relocation control block
	ld	(recdir),sp	; Save stack pointer in free buffer
	ld	sp,hl		; SP -> relocation control block
	pop	hl		; HL has address of code
	pop	de		; DE has new address of code
	push	de		; Save it away
;
	exx		 	; Select alternate registers
	pop	hl		; HL -> new code
	pop	de		; DE' has offset for address adjustment
	exx			; Select main registers
;
	pop	bc		; BC = size of code
	push	bc		; Save it
	or	a		; Clear carry
	sbc	hl,de		; Test if new address higher than old
	jr	c,rel2		; If smaller (nc), then use LDIR
	add	hl,de		; Add restore HL -> old code, DE -> new
	ldir			; Move code, buttom up
	jr	rel3
rel2:	add	hl,de		; Restore pointers to old and new
	add	hl,bc		; Offset to end of old code
	ex	de,hl		; Exchange old and new addresses
	add	hl,bc		; Offset to end of new code
	ex	de,hl		; HL -> end of old, DE -> end of new
	dec	de		; Move from past end to end
	dec	hl		; Save for source
	lddr			; Move from the top down
rel3:	pop	bc		; BC = size of code again
	pop	de		; DE -> bitmap
	exx			; Exchange to get start of moved code in HL
	ld	sp,hl		; Sp -> start of moved code, lag 1 byte
	exx
	dec	sp		; ..because prl marks the high byte
	ex	de,hl		; HL -> bitmap, DE is surplus
	ld	e,1		; Init the rotation byte
				; It will set CY every 8 bytes
; Main relocation loop..

rloop:	ld	a,b		; Check byte count
	or	c
	jr	z,rdone		; Return to MLOAD caller

	dec	bc		; Reduce byte count
	rrc	e		; Every 8 bits the CY is set
	jr	nc,same		; ..not set

	ld	d,(hl)		; Set d = next byte from bitmap
	inc	hl		; And advance bitmap pointer

same:	rlc	d		; Shift bitmap byte left into CY
	jr	nc,noof		; No relocation needed

	exx			; Alternate registers
	pop	hl		; Get word to relocate from 'stack'
	add	hl,de		; Add the load address in DE'
	push	hl		; Put it back
	exx			; Main registers

noof:	inc	sp		; -> next byte of code
	jr	rloop

rdone:	
	ld	sp,(recdir)	; Restore the stack pointer
	ei			; And permit interrupts again
	ret			; Return to caller
	 endif
;
;
; Set time and date
;  entry: e : 1 : set creation time/date
;             5 : set last update time/date
;  time return pointer in hl
;   hl+0 : low  byte date since Jan,1,1978
;   hl+1 : high byte date since Jan,1,1978
;   hl+2 : hours   (bcd)
;   hl+3 : minutes (bcd)
;   hl+4 : seconds (bcd) (not used in time stamp)
;	
	if	dotime
stime:	ld	hl,(dirbuf)		; Get directory entry
	ld	bc,060h			; Offset entry point time/date stamp
	add	hl,bc			; Add offset
	ld	a,(hl)			; Get byte
	sub	021h			; Test if time stamp present
	ret	nz			; No then return
	ld	d,a			; Clear d
	add	hl,de			; Add entry (update/create)
	ld	a,(secpnt)		; Get sector pointer
	rrca				; Shift 2 times
	rrca
	ld	e,a			; Save it
	rrca				; Shift 2 times
	rrca
	add	a,e			; Add it (a=0,10,20)
	ld	e,a			; Save in e
	add	hl,de			; Add offset
	push	hl			; Save result
	ld	c,0			; Return pointer in hl
					; c=ff means set date pointed to by hl
	call	btime			; Return pointer in hl
	pop	de			; Get pointer
	ld	bc,4			; Set 4 bytes
	ldir				; Copy 4 bytes
	ret				; And return to caller
;
; Get time
;
gettim:	push	de			; Save address to put time 
	ld	c,0			; Get time address
	call	btime			; Execute P2bios call
	pop	de			; Restore address to put time
	ld	bc,5			; 5 bytes to move
	ldir				; Store the time
	ret				; And return to caller
;
; Set time
;
settim:	ex	de,hl			; Get address time in hl 
	ld	c,0ffh			; Set time address
					; and fall through to P2bios call 
;
; Execute P2bios time routine
;
btime:	push	hl			; Save value in hl
	ld	hl,(timead)		; Get address time routine
	ex	(sp),hl			; Put address on stack and restore hl
	ret				; Execute time routine
;
	endif	
;
; P2dos exit routine
;
p2exit:	ld	a,(fldrv)		; Test drive select used flag
	or	a			
	jr	z,p2ext0		; No then exit
	ld	a,(FCB0)		; Get FCB byte 0
	ld	(ix+0),a		; Save it
	ld	a,(drive)		; Get old drive number
	call	seldk			; Select disk
p2ext0:	push	ix			; Save ix
	pop	de			; Restore de
	 if	relfunc			; If using relocation function
	exx
	pop	de			; Restore alternate registers
	pop	hl
	exx
	 endif
	pop	ix			; Restore ix
	ld	sp,(spsave)		; Get old sp
	ld	hl,(pexit)		; Get exit code
	ld	a,(funct)		; Get function code
	ld	c,a			; Restore c
	ld	a,l			; Copy function code
	ld	b,h
	ret				; And return to caller
;
; Ram area
;
tabcnt:	db	0			; Tab counter
tabcx1:	db	0			; Temporary tab counter (used by rdbuf)
fcontp:	db	0			; List enable flag (control p)
lastch:	db	0			; Last character
delay:	db	0ffh			; Delay counter
;
trapflag:	db	0		; Warm boot trap flag
;
trans:	defw	0			; Translation vector
temp0:	defw	0			; Number of files on drive 
dirbuf:	defw	0			; Directory buffer
ixp:	defw	0			; Disk parameter block
csv:	defw	0			; Check sum pointer
alv:	defw	0			; Allocation vector pointer
;
maxsec:	defw	0			; Maximum number of sectors/track
nblock:	db	0			; Number of blocks
nmask:	db	0			; Mask number of blocks
nextnd:	db	0			; Extent mask
maxlen:	defw	0			; Maximum block number-1
nfiles:	defw	0			; Maximum number of files-1
ndir0:	db	0			; First two entries alv buffer
ndir1:	db	0
ncheck:	defw	0			; Number of checksum entruies
nftrk:	defw	0			; First track number
;
dskro:	defw	0			; Disk r/o vector
login:	defw	0			; Login vector
	 if 	hifuncs
pmedia:	defw	0			; Permanent media vector
	 endif
dma:	defw	080h			; DMA address
;
funct:	db	0			; Function number
pexit:	defw	0			; Exit code
; The next two must remain together (l.h.)
retflg:	db	0			; Allows recovery from read/write errors 
fldrv:	db	0			; Drive select used flag
; The next two must remain together (l.h.)
passfg:	db	0			; Pass attrib check on extent > 0
rdwr:	db	0			; Read/write flag
;
FCB0:	db	0			; FCB byte 0
user:	db	0			; User number
drive:	db	0			; Drive number
defdrv:	db	0			; Default drive number
recdir:	defw	0			; Record directory (checksum)
filcnt:	defw	0			; File counter
secpnt:	db	0			; Sector pointer
subflg:	db	0			; Submit flag (reset disk command)
;
dcopy:	defw	0			; Copy address FCB
searex:	db	0			; Exit code search
searnb:	db	0			; Search number of bytes
searqu:	db	0			; Search question mark used
searpu:	db	0			; Search public file
;
; Next flag added by b.h.
;
diff:	db	0			; Disk changed flag
;
spsave:	defw	0			; Stack pointer location
	 if	exstack
p2doss	equ	exstack
	 else
	defs	36,0			; 36 byte stack
p2doss:		
	 endif				; P2dos stack
dosstop	equ	$
        if z33adr or intadr
	.dephase
        endif
;

dossiz	equ	dosstop-dosstrt

	.printx ..
	if	(dossiz gt 3584)
oversiz	equ	(dosstop-dosstrt)-3584
	.printx ..
	.printx *=====================================*
	.printx =***  B D O S   T O O   L A R G E  ***=
	.printx *=====================================*
	.printx ..
	prtval	16,<DOS size......>,dossiz,<hex bytes>
	 if	oversiz gt 99
	prtval	10,<Excess.........>,oversiz,<bytes>
	 else	;oversiz < 100
	 if	oversiz gt 9
	prtval	10,<Excess..........>,oversiz,<bytes>
	 else	;oversiz <10
	prtval	10,<Excess...........>,oversiz,<bytes>
	 endif	;oversiz > 9
	 endif	;oversiz > 99

	else	; If DOS size is OK
	
freesiz	equ	3584-dossiz
	prtval	16,<DOS size......>,dossiz,<hex bytes>
	 if	freesiz gt 99
	prtval	10,<Free space.....>,freesiz,<bytes>
	 else	;freesiz < 100
	 if	freesiz gt 9
	prtval	10,<Free space......>,freesiz,<bytes>
	 else	;freesiz <10
	prtval	10,<Free space.......>,freesiz,<bytes>
	 endif	;freesiz > 9
	 endif	;freesiz > 99
	endif
	.printx ..