.title 'Write specified CP/M file to Hard Disk'
	.ident WRUN0
	.sbttl	'Program description'
;
version ==	2
revision==	2	; Last revised 04/28/83  DRB
patcè	=½	' '
	.pabs
	.phex
	.loc	100h
;
;		Program: WRUN0
;
; This program reads a user specified file into a 
; buffer starting at 2000h. Next, the file is read
; to unit 0 of the Hard Disk starting at the user
; specified track and sector number.
;
; The user can enter the file name, track ,sector and
; volume thru the command line or be prompted for
; the same information.
;
; The user can specify a drive other than the default
; drive in the command line or when the program asks
; for the filename.
.page
.sbttl	'Update history'
;
; 10/21/80 WRUN0 updated to optionally read the command
;	   line.  This uses CP/M's self constructing
;	   File Control Block at 5Ch.	     D.Stein
;
;	   A>WRUN0 ALLOC.TAB 01 79
;
; 10/29/80 WRUN0's File Control Block improved to match
;	   CP/M's. Command line is now copied into the
;	   program for safe keeping. ( File I/O des-
;	   troys the CP/M command line. )	D.Stein
;
; 03/01/82 revision 6:	If user attempts to WRUN0 a 
;	   file with 0 sectors, give a message and 
;	   a boot. Clean up the code. Add more error
;	   diagnostics. D. Brentlinger
;
; 03/29/82 revision 7:	If user attempts to use Wrun0
;	   on the network, give a message and a boot.
;	   Add the improvements made in Read0's FCB 
;	   to Wrun0.  DB
;
; Ver 2.0  Changes made for the updated cpmMAP routine
;	   and for multiple hard disks. -16JUN82MdG
;
; 2.0a	   rudimentary adjustments to work with Fox.
; 2.0n	   works on Fox (direct drivers, i.e. no HD
;	   drivers are needed in BIOS)
; 2.0p,q,r attempt to restructure code
; 2.0s	   pretty nearly works for Fox.  Fixed *BUGS*
;	   in original code for detecting overruns
;	   on track and sector values.
;
; 2.1	26-apr-83	Les Wilson
;	   get volume info, write to specified volume
;
; 'A' 04/28/83	Clean up a few problems in writting
;		to volumes, send addrs to the CRT when
;		the write is done.  DRB
;
; 'B' 04/28/83	Organize equates at top, define storage
;		at end of program.  DRB
; 2.2 04/28/83	Version bumped up to get rid of the
;		patch byte.  DRB
.page
.sbttl	'Equates'
;
WBOOT	==	00h	;Warm Boot entry point
WBaddr	==	01h	;WBOOT + 1 entry to jump table
BDOS	==	05h	;Common CP/M entry point
cr	==	0Dh	;carriage return
lf	==	0Ah	;line feed
blank	==	20h	;ascii blank
period	==	2Eh	;ascii period
colon	==	3Ah	;ascii colon
EOF	==	1Ah	;end marker for file & buf I/O
incon	==	01h	;CP/M  1, Console Input 
bufread	==	0Ah	;CP/M 10, Read Console buffer
open	==	0Fh	;CP/M 15, Open File
close	==	10h	;CP/M 16, Close file
CPMread ==	14h	;CP/M 20, Read Sequential
dma	==	1Ah	;CP/M 26, Set DMA Address
filebuf ==	2000h	;Buffer for holding CP/M file
mxdskSEC==	80h	;max permitted sector on track
mxdskTRK==	0Fh	;max permitted track on part 0
maxvol	==	4	;max number of hard disk volumes
HARD	==	40h	;Hard disk media type
foxHARD ==	0C0h	;fhard disk media type
usernum ==	47h	;system user number
PIOAD	==	08h
secs	==	41h
iobyte	==	03h
cntlC	==	03h
conmask ==	03h
HARDP	==	01h
readHARD==	11h	; read 1 sector
writeHARD==	12h	; write one
selHARD ==	13h	; select a unit
statHARD==	18h	; get subsystem status
;	-- XEBEC s1410 controller equates --
CMDmode 	==	00011b	; command mode
wrDATAmode	==	00001b	; write mode
rdDATAmode	==	01001b	; read data mode
rdERRmode	==	01011b	; read error mode
LASTmode	==	01111b	; ret zero byte
xBUSY		==	0	; busy true high
xREQxfer	==	4	; data xfer request bit
DAT$CMDport	==	1	; mode is set by toggle
toggle		==	0
.page
; output to port0 toggles between cmd and data modes
;
xDRVready	==	0	; test drive ready
xREAD		==	08	; read command
xWRITE		==	0Ah	; write command
xSENSE		==	03	; status sense
xINITdrv	==	0Ch	; initialize drive
xSEEK		==	0Bh	; seek command
xRECAL		==	1	; recalibrate head
xERROR		==	02	; illegal command
xRAMdiag	==	0E0h	; ram diagnostic
xIDLE		==	40h	; idle command
xINITcont	==	0	; reset controller
xSELcont	==	0C1h	; select controller
xDESELcont	==	41h	; deselect controller
recSIZE 	==	128
secSIZE 	==	256
lenXEBcmd	==	6
OFFbias 	==	12	
;	(adrDPB+1) + OFFbias = adrOPSYS track offset
.page
.sbttl	'Parse command line or prompt user'
START:
	lxi	H,LOGmsg
	call	prtmsg	  ;print logon message
	lxi	H,usermsg
	lda	usernum   ;if user number = 0FFh,
	cpi	0FFh	  ;let user continue,
	cnz	termerr   ;else, give user a message

	call	getHDtyp  ; see what we're up against
	call	init	; set up buffers etc.
;
; Get file name from user or at CP/M's FCB at 5Ch.
;
	lxi	H,comline ; addr of com line
	mov	A,M	;A = length of com line
	cpi	0	;is com line garbage`
	cz	GETFIL	;Yep. ask the user for one.

	call	OPENFIL ; open it or die trying
	cz	termerr ; no such file.
	call	READFIL ; read it
	cz	termerr ; file empty: die
	call	SCANCOM ; break up command line
	cnz	GETADR	; if needful, ask user
			; where to write to
	call	writFILE  ; write the file to disk
			  ; jesus, I can hardly believe
			  ; Dave Stein actually put in
			  ; a subroutine to do this!
	lxi	H,finmsg  ; tell user were done
	call	prtmsg
	jmp	WBOOT	  ; and WBOOT
.page
.sbttl "SUBROUTINES"
;
; Set up FCB and command line buffers.
init:
	sub	A
	sta	FCBcnt	  ;set FCB count to 0
	lxi	H,FCBnam
	shld	FCBloc	  ;FCB file name location
	lxi	H,80h	  ;CP/M Command line address
	lxi	D,comline ;our command line address
	mov	A,M	  ;80h = length of com line
	inr	A	  ;A = num of bytes to copy
	mov	C,A
	mvi	B,00	  ;BC = num of bytes to copy
	ldir	;copy CP/M com line into our comline.
	lxi	H,5Ch	; Set up default FCB in case
	shld	FCBaddr ; we use the command line
	ret
;-------------------------------
; Get file name from the user, since there
; was no good one on the command line.

GETFIL: 		;no useable file name
	lxi	H,FCB	;set FCB address to inside
	shld	FCBaddr ;the program.
	lxi	H,entmsg 
	call	prtmsg	;ask user to enter file name
	call	putBUF	;read console buffer
	sta	charcnt ;number of char in filename
	lxi	H,nofnmsg
	cpi	0	;if something there, read
	cnz	readbuf ;get NZ if ok now.
	rnz		; go on to OPENFIL
;
..nono: call	prtmsg	;print 'no filename' msg
	jmpr	GETFIL	;and ask again.
.page
;--------------
; Read input line and try to make an FCB out of it
; Regs out:   Z if not ok, NZ if fine, thank you
;
READBUF:		;first check for drive select
	lxi	H,conbuf+1 ;get console buf address
	inx	H	;get to 1st chr of buffer
	mov	A,M	
	cpi	blank	;Is it a blank`
	jrnz	..1	
	push	PSW
	lxi	H,blnkmsg
	pop	PSW
	ret		;no blanks allowed

..1:	inx	H	;No. Get to 2nd buf chr addr
	mov	A,M	
	cpi	colon	;Was 1st chr a drive select`
	dcx	H	 
	dcx	H	;get back to start of conbuf
	jrnz	..4	;No, its only a file name
	inx	H	;Yes. Get to 'drive name' addr
	mov	A,M	;Get drive name
	ani	0DFh	;make sure its UPPER CASE
	sui	'A'	;make the ascii chr numeric
	cpi	4	;Is drive select more than 'D'
	jrc	..3
	lxi	H,drivmsg 
	xra	A
	ret		; ask user for file name

..3:	sta	DSKname ; we'll save it
	push	H	; save conbuf addr
	lxi	H,charcnt
	dcr	m	; dcr char counter for drive
	dcr	m	; select and colon
	pop	H	; get conbuf addr back
	inx	H	; load file name into FCB
;
»	continueä nexô page
.page
..4:	inx	H	; next conbuf address
	mov	A,M	; next buffer character
	cpi	blank	; Is chr a blank`
	jrnz	..5	; no, continue processing
	lxi	H,blnkmsg
	call	prtmsg
	lxi	H,FCBnam ; FCB buffer
	mvi	m,blank
	lxi	D,FCBnam+1 ; next byte in FCB buff
	lxi	B,10	; length of FCB buffer
	ldir		; clear FCB buffer
	sub	A
	sta	FCBcnt	  ;initialize FCB counter
	lxi	H,FCBnam
	shld	FCBloc	  ;FCB file name location
	lxi	H,FCB
	shld	FCBaddr   ;FCB address, if no com line
	lxi	H,nullmsg ; dummy, dummy, dummy
	xra	A
	ret

..5:	cpi	period	; Is it a period`
	cz	expand	; Yes. Leave padded blanks
	jrz	..4	; skip to next chr
	push	H	; save conbuf addr
	lhld	FCBloc	; FCB buffer
	cpi	'a'	;Is char upper case`
	jrc	..6	;yes
	ani	0DFh	;no, make char UPPER CASE
..6:	mov	M,A	;store chr at FCB buffer
	inx	H	;next FCB addr
	shld	FCBloc
	lxi	H,FCBcnt 
	inr	M	;increment char count for FCB
	lda	charcnt ;read last char in conbuf`
	cmp	M	;if no, restore conbuf char
	pop	H	;and read another char
	jrnz	..4	;else, return ok.
	ori	0FFh
	ret		; triumph.
;--------------
; Open the file to be read.
; Regs out:  NZ if file present, Z if not

OPENFIL:
	mvi	C,open
	lded	FCBaddr
	call	BDOS	; open the alleged file
	cpi	0FFh	; CPM ret FF if no file
	lxi	H,nofnmsg ;just in case not there
	ret
.page
;--------------
; Read the file into memory.
; Regs out:  A = number of sectors read
;	     (Z if empty file)
READFIL:		;Load into buffer (until EOF)
	lxi	H,ffmsg
	call	prtmsg	;Print 'file found' message
	lxi	H,filebuf
	shld	DMAaddr ;Initialize the DMA address
	mvi	A,0	
	sta	numSEC	;Initialize sector counter
readsec:		;read the sequential file
	mvi	C,dma	;CP/M 26, Set DMA Address
	lded	DMAaddr
	call	BDOS	;Set the DMA address
	mvi	C,CPMread ;CP/M 20, Read Sequential
	lded	FCBaddr
	call	BDOS	;Read 128-byte sector into DMA
	cpi	00	;CP/M returns 00 if good read
	jrnz	..fin	; or NZ if end of file

	lhld	DMAaddr
	lxi	D,128
	dad	D	;Increment DMA address 
	shld	DMAaddr
	lda	numSEC
	inr	A	;Increment sector counter
	sta	numSEC	;number of sectors read
	jmpr	readsec ;read another sector

..fin:	lda	numsec	;if number of sectors written
	cpi	0	;is > 0, ok; else, get ready 
	lxi	H,zeromsg; to give user the boot
	ret
.page
;------------------------------
; Get starting track and sector, # of sectors to read
; Regs out: Z if everything found, NZ if not

SCANCOM:		;chk comline for trk and sect
	lxi	H,comline ;command line address
	mov	A,M	;get the length of com line
	cpi	2	;Is com line just garbage`
	jrc	..bad	;Yes. Get data from user.
	call	passover; get past name
	call	scanbyt ; get track
	cpi	mxdskTRK+1; Is it within bounds`
	jrnc	..bad	  ; No. Ask user for data.
	sta	curTRK	  ; Yes. Save as starting track
	call	scanbyt ; get sector
	cpi	mxdskSEC+1; Is it within bounds`
	jrnc	..bad	  ; No. Ask user for data.
	cpi	1	  ; Is it within bounds`
	jrc	..bad	  ; No. sector value is 0
	sta	curSEC	  ; Yes. save as current sector.
	call	scanbyt	;get volume to read
	jrc	..defaultvolume	;none specified
	cpi	maxvol	;see if in range
	jrnc	..bad
	sta	curvol	;save as current volume
	jmpr	..good
..defaultvolume:
	xra	a	;default volume is zero
	sta	curvol	;save as current volume
..goodº calì	validatå ;telì useò whaô happened
	xra	A	 ; set flag for success.
	ret

..bad:	ori	0FFh	; bad
	ret
.page
;---------------
; Command line exists.	Pass over the file name
; to the expected track and sector data.
passover:
..1:	inx	H	; No. Look for non-blnk
	mov	A,M	; character.
	cpi	blank	; Have we found it`
	jrz	..1	; No. Try next character.

..2:	inx	H	; Yes. Now look for 
	mov	A,M	; next blank character
	cpi	blank	; Have we found it`
	jrnz	..2	; No. Try next character
	ret
;---------------
; Get a number from the command line
; Return it as a byte in register A
scanbyt:
	call	eatblank  ; Yes. Eat any more blanks.
	call	makHBYT   ; And make chr(s) into a byte
	ret
;--------------
;Bad data on comline, get track and sector # from user
GETADR:
	call	getTRK
	sta	curTRK
	call	getSEC
	sta	curSEC
	call	getvol
	sta	curvol
	call	validate
	call	askifOK
	jrnz	GETADR	 ; no good, try again
	ret 
.page
;--------------
; Get the starting track number from the user.
; Regs out:  A = track number (checked for validity)

getTRK: lxi	H,crlf	 ; space down a line
	call	prtmsg
	lxi	H,TRKmsg ; ask which track
	call	putBUF	 ; read console buffer
	lxi	H,errmsg
	cpi	0	 ; A=length of buffer 
	jrz	..blech
	lxi	H,conbuf+2 ;get console buffer addr
	call	makHBYT  ;make chrs into a hex byte
	cpi	mxdskTRK+1 ;is it with in bounds`
	rc		 ;yes, save tracks
	lxi	H,errmsg ;No, print error message
..blech:call	prtmsg	;and try again.
	jmpr	getTRK
;---------------
getSEC: lxi	H,SECmsg ;ask which sector
	call	putBUF	;read console buffer
	cpi	0	;A = length of buff
	jrz	..blech
	lxi	H,conbuf+2 ; get console buffer addr
	call	makHBYT ; make chrs into a hex byte
	cpi	1	; is it within bounds`
	jrc	..blech ; too low`	
	cpi	mxdskSEC+1; too high`
	rc		; No. save the byte
..blech:lxi	H,errmsg; Yes. Print the error message
	call	prtmsg
	jmpr	getSEC	; and ask again.
.page
;---------------
getvol:	
	lxi	H,volmsg ; ask which volume
	call	putBUF	 ; read console buffer
	cpi	0	 ; just a car ret`
	jrz	..defaultvolume
	lxi	H,conbuf+1 ; CP/M console buffer addr
	mov	m,A	; number of chars in conbuf
	inx	H	; first char in conbuf
	call	makHBYT ; make chrs into a hex byte
	cpi	maxvol	; If within bounds 
	rc		; return,
..blech:lxi	H,errmsg; ELSE, print error message
	call	prtmsg
	jmpr	getvol	; and ask again.
..defaultvolume:
	xra	a	;zero is default
	ret
;---------------
; Valid track and sector number received. 
; Display starting track and sector to the user.
; Display number of sectors to write.
; Regs out:  Z if valid, NZ if not
validate:
	lxi	H,crlf	; space down a line
	call	prtmsg	
	lxi	H,HEADmsg ; print the header
	call	prtmsg
	lxi	H,space4  ; space over 4 spaces
	call	prtmsg
	lda	curTRK
	call	prtbyt	  ; print current track
	lxi	H,space4  ; space over 4 spaces
	call	prtmsg
	lda	curSEC	   
	call	prtbyt	  ; print current sector
	lxi	H,space4  
	call	prtmsg
	lxi	H,space4
	call	prtmsg	  ; space over 8 spaces
	lda	numSEC
	call	prtbyt	  ; print no. of secs to write
	lxi	H,space4  
	call	prtmsg
	lxi	H,space4  
	call	prtmsg
	lxi	H,space4
	call	prtmsg	  ; space over 12 spaces
	lda	curvol
	call	prtbyt	; print volume
	ret		; and go back
.page
;--------------
ASKifOK:		 ;ask user if data is correct
	lxi	H,crlf	 ;space down a line
	call	prtmsg
	lxi	H,VERmsg
	call	prtmsg	 ;print 'data correct`' msg
	mvi	C,incon
	call	BDOS	 ;get console chr
	ani	0DFh	 ;make it upper case
	cpi	'N'
	jrz	..bad	 ;Data incorrect, start over
	cpi	'Y'
	rz		 ;User says data is correct
	cpi	3	 ;3 is a Control-C
	jz	WBOOT	 ;User wants to abort
	lxi	H,errmsg
	call	prtmsg	 ; print error message
	jmpr	ASKifOK  ; bad entry. Ask again

..bad:	ori	0FFh	 ; NZ 'cause no good.
	ret
;--------------
; Subroutine writFILE:	Write from buffer to HD
; Regs	in:	none
; Regs out:	none
;Destroyed:
;
writFILE:
	lxi	H,filebuf
	shld	DMAaddr ;set value for first DMA addr
	ora	A	; reset the carry flag
..1:	rc
	xra	A
	sta	cpmDSK	; select hard disk
	lda	curTRK	; load current track
	mov	C,A
	mvi	B,0
	sbcd	cpmTRK	; select requested track 
	lda	curSEC	; load current sector
	sta	cpmSEC	; select it
	lbcd	DMAaddr
	sbcd	cpmDMA	; select proper buffer location
	call	WRITE	; and write to the disk
	call	INRdata ; increment DMA addr, sector--
			; decrement sector counter.
	jmpr	..1	; read until INRaddr sets carry
.page
;---------------
;Subroutine:	INRdata
; Regs	in:	none
; Regs out:	carry bit is set/reset (used as a flag)
;Destroyed:
; Decrement the sector counter. Set carry flag if done
; Increment the DMA address and sector number
;
INRdata:
	lda	numSEC	; number of SECs left to write
	dcr	A	; decrement,
	sta	numSEC	; and save.
	cpi	0	; Are we done writing sectors`
	jrnz	..2	; NO. Increment the data
	stc		; YES. Set the carry bit
	ret		; and return.
;
..2:	lhld	DMAaddr ; get current DMA address
	lxi	D,128
	dad	D	; increment by 128 bytes
	shld	DMAaddr ; and save as new DMA address
	lda	curSEC	; get the current sector
	inr	A	; increment,
	sta	curSEC	; and save as current sector
	cpi	mxdskSEC+1 ; past last sector`
	jrc	..3	   ; no, return
	lxi	H,INRmsg; 'moving to next track' msg
	call	prtmsg
	lda	curTRK	; get next track number
	inr	A
	cpi	mxdskTRK+1  ; past last track`
	lxi	H,partmsg ;try to write out of part0
	jnc	termerr ; Yes. Terminal error. Abort.
	sta	curTRK	; ok. save new track number
	call	prtbyt	; print the track number
	mvi	A,1	; Reset sector number to 1
	sta	curSEC	; and save
..3:	ora	A	; reset carry flag
	ret		; and return.
.page
;---------------------
;Subroutine EXPAND:  Leave blanks between file name 
;		     and extension in FCB
;  Regs  in:
;  Regs out:
; Destroyed:
;
EXPAND:
	push	PSW	;save condition flags
	push	H	;save conbuf addr
	lda	FCBcnt	;no. of chrs transfered
	mov	B,A
	mvi	A,8	;eight total spaces
	sub	B
	cpi	0
	jrz	..2	;no pads nessecary
	lxi	H,filmsg ;incorrect file name
	jm	termerr ;terminal error
	lhld	FCBloc	;get FCB addr
..1:	dcr	A	;decr counter
	inx	H	;incr buf addr
	cpi	0
	jrnz	..1	;leave more padded blanks
	shld	FCBloc
..2:	lxi	H,FCBcnt
	inr	m
	pop	H	;restore conbuf addr
	pop	PSW	;restore flags
	ret
;---------------
; Subroutine eatblank:	get to next valid character
; Regs	in:	HL= Present buffer address
; Regs out:	HL= Addr of 1st non-blank buffer addr
;		A = num of chrs before next blank
; Destroyed	A,B
;
eatblank:
	mvi	B,0	; B is the chr counter
..4:	inx	H	; get to next buffer address
	mov	A,M
	cpi	blank	; Is chr a blank`
	jrz	..4	; Yes. keep scanning.
	inr	B	; No. Increment chr counter
	push	H	; and save non-blnk chr addr
..5:	inx	H	; get to next chr address
	inr	B	; increment chr counter
	mov	A,M	; get the chr
	cpi	blank	; Is chr a blank`
	jrnz	..5	; No. Keep scanning for one.
	dcr	B	; Yes. Adjust the chr counter
	mov	A,B	; and put it in A.
	pop	H	; restore non-blnk chr addr
	ret		; and return.
.page
;---------------
; Subroutine prtmsg:  print ascii string to CRT
; Regs	in:	HL=addr of string to be printed
; Regs out:	none
; Destroyed:	A,HL,C
;
prtmsg: mov	A,M
	ora	A
	rz		; finished if a null
	push	H
	mov	C,A
	call	CONOUT
	pop	H
	inx	H
	jmpr	prtmsg

;---------------
; Subroutine prtstr:  print ascii string to CRT
; Regs	in:	HL=addr of string to be printed
;		B = its length
; Regs out:	none
; Destroyed:	A,HL,BC
;
prtstr: mov	A,B
	ora	A
	rz		; finished if a null
..loop: push	H
	push	B
	mov	C,A
	call	CONOUT
	pop	B
	pop	H
	inx	H
	djnz	..loop
	ret
;---------------
; Subroutine termerr: terminal error, message and boot
; Regs	in:	none
; Regs out:	none
; Destroyed:
;
termerr:
	call	prtmsg	;print error message
	lxi	H,termsg
	call	prtmsg	;tell user it's all over
	jmp	WBOOT
.page
;---------------
; Subroutine prtbyt:  Print a byte to the console.
; Regs	in:	A=byte to be printed
; Regs out:	none
; Destroyed:	all 
; 
prtbyt:
	push	PSW	; save the chr
	rlc
	rlc
	rlc
	rlc
	call	prtnbl
	pop	PSW
	call	prtnbl
	ret
prtnbl: ani	0Fh
	adi	'0'
	cpi	'9'+1
	mov	C,A
	jc	CONOUT
	adi	'A'-'9'-1
	mov	C,A
	jmp	CONOUT
;---------------
; Subroutine cvtbcd:  Convert binary to BCD
; Regs	in:	A=byte to be converted
; Regs out:	A=byte, in BCD format
; Destroyed:	B
;
cvtbcd:
	ora	A
	rz
	mov	B,A
	xra	A
..4:	inr	A
	daa
	djnz	..4
.page
;---------------
; Subroutine makHBYT:  Make hex byte from 1 or 2 chrs
; Regs	in:	A = length of buffer
;		HL= addr of 1st buffer chr
; Regs out:	A=hex byte made from console buffer
;		HL= addr of last chr used
; Destroyed:	B,C
;
makHBYT:
	cpi	1	   ; just one chr`
	mvi	B,0
	jrz	..2	   ; process 1st chr only
;multiply first chr by 16 and save in B
	mov	A,M	; get 1st chr
	inx	H	; get 2nd chr address
	cpi	'A'
	jrc	..1
	ani	0DFh	; make all letters upper case
	sui	'A'-'9'-1
..1:	sui	'0'
	cpi	0
	jrz	..2	; skip mult if nibble is 0
	ora	A	; reset carry flag
	rlc
	rlc
	rlc
	rlc
	mov	B,A	;save 16*firstnumber in B
..2:	mov	A,M	; get 2nd chr
	cpi	'A'
	jrc	..3
	ani	0DFh	; make all letters upper case
	sui	'A'-'9'-1
..3:	sui	'0'
	ora	A	; reset the flags
	add	B	; add the two chrs
	ret
.page
;---------------
; Subroutine putBUF:  Put console input in a buffer
; Regs	in:	HL=address of message to print
; Regs out:	A =number of chrs put in buffer
;		HL=(addr of 1st buf chr)-1
;Destroyed:
;
putBUF:
	call	prtmsg
	call	clrBUF	 ; clear the console buffer
	mvi	C,bufread ; CP/M console buffer read
	lxi	D,conbuf ; address of console buffer
	call	BDOS	 ; put console input in buffer
	lxi	H,conbuf+1
	mov	A,M	 ; put num of buffer chrs in A
	ret
;---------------
; Subroutine clrBUF:  Clear console buffer at address
; Regs	in:	none
; Regs out:
; Destroyed:
;
clrBUF:
	lxi	B,12
	lxi	H,clrBYTS
	lxi	D,conbuf+2
	ldir
	ret
.page
.sbttl	'Hard disk drivers'
;---------------
; Hard Disk Subroutines 
;---------------
;Sybertine getHDtype:  Get type of controller, and
; boot out fatally if there is no hard disk at all,
; or if it's down.

getHDtype:
	call	machine ; find out what kind of station
	jrz	..dms
	call	Foxinit
	ret
..dms:	call	getHDstat
	ret
;--------------
; See whether a Fox or another type of machine
; Parallel console IO is prima facie evidence
; of foxiness
; Regs out:  Z if not a Fox, NZ if a Fox.
; Trashed:   PSW
machine:
	lda	iobyte	; not a Fox if console bits = 00
	ani	conmask
	ret
;---------------
;
getHDstat:
	lxi	B,STATbuf
	call	HDstat 
	lda	STATbuf+7
	ora	A
	rz
	lxi	H,noHDmsg
	call	termerr
	ret			; for form
;--------------
READ: 
	call	machine
	jz	HARDrd	; if 00, dms
	jmp	fHARDrd ; else, fox.
;--------------
WRITE:
	call	machine
	jz	HARDwr	; if 00, dms
	jmp	fHARDwr ; else, fox.
.page
;--------------
; Initialize the Fox hard disk by
; first figuring out whether it's there
; and then, if it is, reading its firmware
; Regs in:  none
; Regs out: none
; Trashed:  all
;
Foxinit:
	call	Foxthere
	cz	noHD	 
	call	xinit	; controller init
	call	getFIRM ; get nature of drive
	call	xinit	; real drive init
	ret
;--------------
noHD:
	lxi	H,noHDmsg
	call	termerr
	ret
;--------------
Foxthere:
	call	xCONTinit
	call	xseltime; sets Z if impossible
	ret
;--------------
xinit:
	call	xCONTinit  ; start fresh
	call	xDRIVEinit
	call	qREADY
	call	doRECAL
	ret
;--------------
xDRIVEinit:
	mvi	A,xINITdrv
	call	cmdFOXhard
	lxi	H,DRVCHR
	mvi	B,lenDVC
..init: call	xWAITreq
	mov	A,M
	out	DAT$CMDport
	inx	H
	djnz	..init
	call	xSTATrcv
	cnz	xERRrcv
	ret
.page
;--------------
getFIRM:
	lxi	H,STATBUF+8
	shld	cpmDMA
	lxi	H,0
	shld	cpmTRK	; track 0
	xra	A
	sta	cpmDSK	; in case
	inr	A
	sta	cpmSEC	; sector 1
	call	fHARDrd
	ret
;--------------
xseltime:
	call	tBUSYfalse ; wait for nbusy
			   ; (but not forever.)
	rz		   ; ret if failed
	mvi	A,xSELcont 
	out	toggle
	out	DAT$CMDport
	out	toggle
	call	tBUSYtrue ; wait for busy
	ret		  ; (but not forever.)
;--------------
; Wait for xebec to be ready to be selected
;   But if it doesn't answer after a couple
;   of seconds, assume there is no xebec
;   and boot on out.

tBUSYfalse:
	lxi	B,4000h ; maybe 1/2 second or so
..busy: call	xINstatus
	bit	xBUSY,A
	jrz	..ok	; ready. return
	dcx	B
	mov	A,C
	ora	B	; no, we missed it
	rz		; ret in disgrace
	jmpr	..busy
..ok:	ori	0FFh	; triumph
	ret
.page
;--------------
; Wait for xebec to assert busyness;
;  timeout as in nbusytime since, after
;  all, we haven't got all day.

tBUSYtrue: 
	lxi	B,4000h ; maybe 1/2 second or so
..busy: call	xINstatus
	bit	xBUSY,A
	rnz		; ready. return
	dcx	B
	mov	A,C
	ora	B	; no, we missed it
	rz		; ret in disgrace
	jmpr	..busy
.page
;	*****	XEBEC controller primitives	*****
xselect:
	call	wBUSYfalse
	mvi	A,xSELcont
	call	xOUTstatus
	call	wBUSYtrue
	ret
;
deselect:
	call	wBUSYtrue
	mvi	A,xDESELcont
	call	xOUTstatus
	ret
;
xWAITreq:
	in	PIOAD
	bit	xREQxfer,A	; (4)
	jrz	xWAITreq
	ret
;
xCMDsend:
	call	xWAITreq
	mov	A,M
	out	DAT$CMDport
	inx	H
	djnz	xCMDsend
	ret
;
wBUSYfalse:
	call	xINstatus
	bit	xBUSY,A
	jrnz	wBUSYfalse	; wait till not busy
	ret
;
wBUSYtrue:
	call	xINstatus
	bit	xBUSY,A
	jrz	wBUSYtrue	; wait till busy
	ret
;
SASIstat:
	call	xWAITreq
	call	xINstatus	; get bus status
	ani	0fh
	ret
.page
xSTATrcv:
	call	SASIstat
	cpi	rdERRmode
	jnz	xERRcode	; not in result mode!
;
	in	DAT$CMDport
	push	psw
	call	xWAITreq
	in	DAT$CMDport
	pop	psw	; the only byte we care about
	ora	A
	ret			; a=0 means no error
xPRTerr:
	lxi	h,xERR0str	; prt ' XEBEC error at '
	call	PRTMSG
;
; the following routine takes the top 2 return adrs
; off of the stack, saves the top adr in <saveADR>,
; outputs the 2nd adr to the console (it's the adr
; at which an error was found), restores the error
; adr and then restores the 1st ret adr.
	pop	h		; get caller's adr
	shld	saveADR 	; and save it away
	pop	h		; get error adr
	call	calladr 	; print error adr
	push	h		; restore err ret adr
	lhld	saveADR 	; get caller's adr
	push	h		; restore caller's adr
; well that's the end of this rather clumsy routine
;
	lxi	h,xERRcmdstr	; prt ' command '
	call	prtMSG		; and buf contents
	lxi	H,xOPcode
	mvi	B,lenXEBcmd	; (6)
	call	prBUFF
	lxi	H,xERR1str	; prt ' status '
	call	PRTMSG		; and error buf
	lxi	H,xERRbuf
	mvi	B,4		; 4 error bytes
	call	prBUFF
	ret		
xGETerr:
	mvi	A,xSENSE
	call	cmdFOXhard
	lxi	H,xERRbuf
	mvi	B,4
..inERR:
	call	xWAITreq	; get the 4 error bytes
	in	DAT$CMDport
	mov	M,A
	inx	H
	djnz	..inERR
	ret
.page
xERRrcv:
	call	xGETerr
	call	xPRTerr 	; print the err bufs
	call	xSTATrcv	; ck for err on rcving
	rz			; already had one error
				; so another is fatal
xERRcode:
	lxi	H,xFATALerr
	call	PRTMSG
	pop	H		; get ret adr
	call	calladr 	; print error adr
	push	H		; restore ret adr
	lxi	H,xERRcmdstr
	call	prtMSG
	lxi	H,xOPcode
	mvi	B,lenXEBcmd	; (6)
	call	prBUFF
	jmp	waituser
;
xOUTstatus:
	out	toggle
	out	DAT$CMDport
	out	toggle
	ret
;
xINstatus:
	out	toggle
	in	DAT$CMDport
	out	toggle
	ret
;
xCONTinit:
	mvi	A,xINITcont	; reset the controller
	out	toggle
	out	DAT$CMDport
	mvi	A,xIDLE
	out	DAT$CMDport
	out	toggle
;
	lxi	H,xOPcode	; zero the command byte
	lxi	D,xOPcode+1	; and logical addresses
	lxi	B,3		; leave the skew alone
	mvi	M,0
	ldir
	ret
.page
doRECAL:
	mvi	A,xRECAL
	call	cmdFOXhard
	call	xSTATrcv
	cnz	xERRrcv
	ret
;
qREADY:
	mvi	A,xDRVready
	call	cmdFOXhard
	call	xSTATrcv
	cnz	xERRrcv
	ret
;
;	*****	CP/M mapping primitives   *****
;
divDEby2:
	mov	a,e
	srar	D
	rar
	mov	E,A
	ret
;
divHLby2:
	mov	A,L
	srar	H
	rar
	mov	L,A
	ret
;
.page
;	*****	CP/M mapping functions	*****
;
;---------------
; Regs in:   HL = pointer to device type in DPB
;	     A = device type
;	     NONE OF WHICH IS USED
; Regs out:  -- data xferred --
;	     A	=    0 if success
; Thrashed:  all
;
fHARDrd:
	mvi	A,0FFH
	sta	qRDorWR 	; FF to read, 0 to write
	call	HARDwork
	ret
;--------------
; Regs in:  HL = pointer to device type in DPB
;	    A = device type
;	    THESE AREN'T USED THOUGH
; Regs out: -- data xferred --
;	    Z  =    error code 
; Trashed:  all
fHARDwr:

      ; lda	secs		; 1 second timer
      ; sta	actTIMER	; reset timer
	xra	A	
	sta	qRDorWR 	; FF to read, 0 to write
	call	HARDwork
	ret
.page
;--------------
; Regs in:  DE =    sec/trk (from dpb)
;	    A  =    log sector no.
; Regs out: HL =    log unit adr for XEBEC cont
;
; multiply (cpmTRK+curOFF) by 2 for
; (log base 2 of DE) times -
; (ie. mult HL by DE, DE must = some power of 2)
; then add the cpmSEC-1 and divide by
; [(bytes/sec)/(bytes/record)]	 (currently = 2)
; log adr =
;   [(((trk# + curOFF) X (sec/trk)) + sec#-1) / 2]
; 
; Also the size of the disk requires 17 bits,
; thus 'bit17' flags the overflow
;
calcLOGadr:
	push	PSW
	xra	A
	sta	bit17	; reset the overflow flag
	lhld	actTRK
     ;	lbcd	curOFF	; offset is always 0 since
     ;	dad	b	; WRUN0 only writes to unit 0.
..loop: call	divDEby2
	jrc	..endMULT
	dad	H
	jrnc	..loop
	lda	bit17	; cur value
	adi	80h
	jrc	..trkERR; can't use more than 17 bits
	sta	bit17	; we had overflow
	jmpr	..loop
;
..trkERR:	lxi	h,ILLtrack
		call	prtMSG
		jmp	0
;
..secERR:	lxi	h,ILLsect
		call	prtMSG
		jmp	0
;
..endMULT:
	pop	PSW	; here's the logical sector
	dcr	A	; xebec sec# start at 0
	jm	..secERR
	mov	C,A
	mvi	B,0
	dad	B	; (bytes/sec)/(bytes/rec)
	call	divHLby2
..fudge:lda	bit17
	add	H	; add overflow (we know this
	mov	H,A	; addition WON'T overflow)
	ret
.page
;--------------
; Regs in:   A	=    logical sector
; Regs out:  physical sector number put
;	     into xebec command block
; Trashed:   all
;
doLOGadr:
	push	PSW
    ;	call	CPMmap		; hl=dpb-1, de=dph

    ;	push	H
	call	setLogUnitNo	; get volume right
    ;	pop	H		; hl=adr of unit#

    ;	push	h		; don't need to calc
    ;	call	calcTRKoff	; since offset is 0  
    ;	pop	h		; for partition 0!

    ;	inx	H		; hl=adr of sec/track
    ;	mov	E,M
    ;	inx	H
    ;	mov	D,M		; de=sec/track
	lxi	D,80h		; mandatory secs/track

	pop	PSW		; here's the sector
	call	calcLOGadr	; HIGHadr is always
	mov	A,H		; 0 for 15 meg drv
	sta	MIDadr		; log unit number
	mov	A,L		; is stored NOT
	sta	LOWadr		; inverted
	ret
;--------------
;	read/write common code
; ENTRY>       HL  =	pointer to DPB-1
; EXIT> 	-- none --
; TRASHED>     A, HL
setLogUnitNo:
      ; dcx	H	; ignore CPMmap stuff
      ; dcx	H	; since we don't really
      ; mov	A,M	; need to have our hand
			; held for unit 0.
	lda	curVOL	; here is the volume.
	ani	1		; LUN always < 2
	rrc			; HIGHadr always 0
	rrc
	rrc
	sta	HIGHadr
	ret
.page
;--------------
; ENTRY>	A  =	command code
; EXIT> 	-- none --
cmdFOXhard:
	push	H
	lxi	h,xOPcode
	mov	M,A
	call	xselect
	call	SASIstat
	cpi	CMDmode
	jnz	xERRcode	; not in command mode
;
	call	deselect
	mvi	B,lenXEBcmd	; (6)
	call	xCMDsend
	pop	H
	ret
;--------------
; ENTRY>	A  =	media type
; EXIT> 	HL =	cpmDMA adr
;		B  =	vol no.
;		A  =	unit no.
;		log unit adr in HIGH,MID,LOWadr
xHARDprep:
	call	doLOGadr

      ; call	CPMmap
      ; dcx	H
      ; dcx	H		; hl=adr of volume

	lxi	H,curVOL	; do it this way.
	mov	B,M		; b=vol no.
	lhld	cpmDMA
	ret
.page
;--------------
; ENTRY>	none
; EXIT> 	none
;		sets actDSK,TRK,SEC,VOL
; TRASHED>	c,de,hl,h
setACT:
	di			; can't flush buffer
	lxi	H,cpmDSK	; inside this routine
	lxi	D,actDSK
	lxi	B,5
	ldir

	lda	cpmSEC	    ; jimmy the sector to lie
	dcr	A	    ; on a 1K boundary
	ani	0F8h
	inr	A
	sta	actSEC
	ei
	call	doLOGadr	; set the phys adr to
	ret			; match the logical adr
;--------------
; Go get 1K containing the desired CP/M record
; ENTRY>  nothing
; EXIT>   z set if ok
xPREread:
	lxi	H,actBUF    ; rcvd data buf adr
	call	fREAD1k     ; go get it
	ret
;--------------
; ENTRY>	hl = source
;		de = dest
; EXIT> 	-- data xferred --
bufSWAP:
	lxi	B,recSIZE	; (128)
	ldir
	ret
.page
;--------------
; ENTRY>     none
; EXIT>      data read or written
;	     A=0 if successful
HARDwork:
	call	COMPsec     ; see whether desired rec
	jrz	..disp	    ; is in our buffer already
;
	lda	actDIRTY    ; do we need to write buf
	ora	a	    ; before we can read
	cnz	flushACT
;
	call	setACT	    ; set ACT to CPM
	call	xPREread

..disp: call	getDISP
	lxi	H,actBUF
	dad	D	    ; adr of buffered rec in HL
	lded	cpmDMA	    ; user data adr
	lda	qRDorWR     ; which way to move data
	ora	A	    ; 0 for write op
	jrz	..write     ; 0ffh for read op
;
..read: 	; hl = buffer adr
		; de = user data adr
	call	bufswap     ; xfer to CPMdma loc
	xra	A	    ; won't get here if XEBEC
			    ; error so return success
	ret		    ; flag to cp/m
;
..write:	; hl = buffer adr
		; de = user data adr
	xchg
	call	bufswap     ; get it into XEBbuf
	mvi	a,0ffh
	sta	actDIRTY    ; buf data not same as disk
	call	flushACT    ; don't buffer writes
;
	xra	a	; return success flag to cp/m
	ret
;--------------
; ENTRY>	none
; EXIT> 	writes actBUF to disk
;		clears buf dirty flag
; TRASHED>	all
flushACT:
	lxi	h,actBUF
	call	WRITE1k
	xra	a
	sta	actDIRTY
	ret
.page
;---------------
; ENTRY>	none
; EXIT> 	de = byte displacement
; TRASHED>	de,hl,a
getDISP:
	lxi	H,actSEC    ; addr of 1K boundary
	lda	cpmSEC
	sub	M	    ; how far into buffer it is
	mov	D,A
	mvi	E,0	    ; DE has sectors * 256
	call	divDEby2    ; get byte displacement
	ret
;--------------
; Compares CPM disk, track, sector with the
; ones showing the current contents of actBUF.
; ENTRY>   nothing
; EXIT>    Z set if match

COMPsec:
	mvi	b,3
	lxi	H,actDSK    ; what we've got
	lxi	D,cpmDSK    ; what we want
	call	..comp	    ; compare DSK,TRK(hi)
	rnz		    ; TRK(lo)
;
	ldax	D	    ; logical record
	dcr	A
	ani	0F8h	    ; convert to 1K boundary
	inr	A
	cmp	M	    ; actSEC
	rnz		    ; sec mis-match
;
	inx	H
	inx	D	    ; point to volume
	mvi	b,1
	call	..comp	    ; compare volume
	ret
;
..comp:
	ldax	D
	cmp	M
	inx	H
	inx	D
	rnz
;
	djnz	..comp
;			; z reset if match
	ret
.page
;--------------
; ENTRY>	hl =	buffer adr
; EXIT> 	-- data xferred --
;		A  =	0 if success
fREAD256:
	mvi	B,1	; one sector only
	call	justREAD	
	ret
fREAD1k:
	mvi	B,4	; 4 * 256 = 1024
	call	justREAD
	ret
;--------------
; ENTRY>	hl =	buffer address
;		b  =	block count
; EXIT> 	-- data xferred --
;		A  =	0 if success
justREAD:
	mov	A,B		; block count
	sta	skew$blk	; put in command 
	push	H		; where to read into
	lxi	H,0		; figure xfer length
	lxi	D,secSIZE
..dad:	dad	D
	djnz	..dad
	xchg			; result in DE
	push	D		; save xfer len 
	mvi	A,xREAD
	call	cmdFOXhard	; send read command
	pop	B		; get xfer len
	pop	H		; get buffer address
	call	xRCVdata	; get data
	call	xSTATrcv	; get result bytes
	cnz	xERRrcv
	ret
;--------------
; ENTRY>	hl =	buffer adr
;		bc =	block count
xRCVdata:
	call	SASIstat
	cpi	rdDATAmode
	jnz	xERRcode
..xread:
	call	xWAITreq
	in	DAT$CMDport
	mov	M,A
	inx	H
	dcx	B
	mov	A,B
	ora	C
	jrnz	..xread
	ret
.page
;--------------
; Setup for transfer of data to the hard disk
; ENTRY>	HL =	data buffer address
; EXIT> 	z  =	error code
;		-- data xferred --
WRITE256:
	mvi	b,1
	call	justWRITE
	ret
;
WRITE1k:
	mvi	b,4
	call	justWRITE
	ret
;--------------
; Transfer data to the hard disk.
; ENTRY>	HL =	data buffer address
; EXIT> 	z  =	error code
;		-- data xferred --
justWRITE: 
	mov	a,b
	sta	skew$blk
	push	H
	lxi	H,0		; figure xfer length
	lxi	D,secSIZE
..dad:	dad	D
	djnz	..dad
	xchg			; result in DE
	push	D		; save xfer len 
	mvi	A,xWRITE
	call	cmdFOXhard	; send write command
	pop	b		; get xfer len
	pop	H		; get xfer adr
	call	xSENDdata	; send data bytes
	call	xSTATrcv
	cnz	xERRrcv
	ret
;--------------
; ENTRY>	hl =	buffer adr
;		bc =	block count
xSENDdata:
	call	SASIstat
	cpi	wrDATAmode
	jnz	xERRcode
..xwrite:
	call	xWAITreq
	mov	a,m
	out	DAT$CMDport
	inx	H
	dcx	B
	mov	A,B
	ora	C
	jrnz	..xwrite
	ret
.page
;--------------
; Get hard disk subsystem status
;  Regs in:	bc = block address
;		on return block has 8 byte hard disk
;		command status followed by 128 byte
;		volume information block
;  Regs out:	none
;  Destroyed:	A, BC, DE, HL
HDstat:
	push	B	; block addr
	call	machine
	pop	H
	jrnz	..xeb
	call	dmsHDstat
	ret
..xeb:	call	xebHDstat
	ret
.page
;-----------
; Get hard disk subsystem status (xebec controller) 
;
xebHDstat:
	mvi	B,5
..fill: mvi	M,0
	inx	H
	djnz	..fill
;
	mvi	M,'X'	; say it's XEBEC disk
	inx	H
	mvi	M,0	; byte 6 zeroed out
	push	H
	call	xGETerr ; really returns status!
	call	xSTATrcv
	pop	H
	inx	H
	mov	M,A
	rnz		; don't read if disk is down
;
	inx	H	; begin volume info blocks
	push	H	; save adr to read into later
	lda	actDIRTY
	ora	a	; flush buf if dirty
	cnz	flushACT
;
	call	point0	; aim stuff at firmware sector
	push	PSW	; save user's assignment
	push	H	; and its address
	call	xPREread; get 1K containing it
	pop	H
	pop	PSW
	mov	M,A	; restore user's assignment
	lxi	H,actBUF; where data is now
	pop	D	; where user wants it
	call	bufswap ; send it on over
	ret
.page
;----------
; Get hard disk subsystem status (dms controller)
;
dmsHDstat:
	push	H	; save block address
	mvi	A,statHARD ; Cmd in Acc
	call	cmdHARD ; Send cmd to HD subsystem
	pop	H	; Get ready to rcve block
	push	H	; Save addr once again
	lxi	B,8	; block length
	call	RECHARD ; Get 8 byte block
	pop	H	; Get the block addr
	lxi	D,7
	dad	D	; HL points at status byte
	sub	A
	ora	M	; Test status byte for zero
	rnz		; No more if non-zero
	inx	H	; Point past 8 byte block
	lxi	B,128
	call	RECHARD ; Get the 128 byte block
	ret
;--------------
; Set actDSK, TRK, SEC to aim at phys.sec 0000
; Also overlay DPB unit assignment (make it 0)
; Regs in: none
; Regs out: A = old unit assignment
;	   HL = adr of same in DPB
; Trashed: all
point0:
	lxi	H,0
	shld	actTRK	; track 0
	mvi	a,0
	sta	actDSK	; partition 0
	sta	actVOL	; volume 0
	inr	A
	sta	actSEC	; sector 1
	call	cpmmap	; get adr of unit #
	mov	A,M	; save user's assignment
	mvi	M,0	; force 1st partition
	ret
.page
;----------
; Hard disk read
; Regs in: HL = DMA address
;	   DE = track number	 (0-511)
;	   B  = HD volume number (0-3)
;	   C  = sector number	 (1-128)
;	   A  = unit number (0-63)
HARDrd: 
	call HARDprep
	push	H	; save DMA address
	call	HARDrw
	mvi	A,readHARD
	call	CMDhard ; send read command
	call	REShard ; get result status
	pop	H
	push	psw	; A=0 means success
	lxi	B,128
	call	REChard ; get data bytes
	pop	psw
	ret
;--------------
; Hard disk write
; Regs in: HL = DMA address
;	   DE = track number	 (0-511)
;	   B  = HD volume number (0-3)
;	   C  = sector number	 (1-128)
;	   A  = unit number (0-63)
HARDwr: 
	call	HARDprep
	push	H	; save DMA address
	call	HARDrw
	mvi	A,writeHARD
	call	CMDhard ; send write command
	pop	H
	lxi	B,128
	call	SENDhard; send data bytes
	call	REShard ; get result status
	ret
;--------------
; Prepare hard disk parameters
HARDprep:
	lxi	h,curvol
	mov	B,M	; volume # in B
	lda	cpmSEC
	mov	C,A	; sector number in C
	lded	cpmTRK	; get track number
	lhld	cpmDMA	; get DMA address
	xra	a	;zero unit number
	ret
.page
;--------------
; Read/write common code
HARDrw:
	sta	HARDdsk ; store unit number
	push	B	; save volume and sector
	push	D	; save track
	mov	A,B	; put volume # in A
	sta	HARDcom+2; store in cmd. string
	mvi	A,'M'	; 'M' for multi HD feature
	sta	HARDcom+6; store in cmd. string
	mvi	A,selHARD
	call	CMDhard ; select the unit
;
;	go get status from hard disk controller
;	do this in line as only 8 bytes being read
;	note: this code provides no timeout since
;	on first select after cold boot it may take
;	several seconds for the hard disk controller
;	to respond
;
	lxi	h,hardstat	;block recieve address
	mvi	b,8		;block length
	mvi	c,hardp 	;hdc data port
selloop:
	in	pioad		;status port
	bit	4,a		;data ready bit
	jrz	selloop 	;nothing yet
	ini			;read a byte
	jrnz	selloop 	;test if done
	dcx	h		;point to error byte
			;in status block
	lxi	b,hardstat+1	;pointer that ioerr 
				;routine wants
	mov	a,m
	ora	a
HSELerr:cnz	ioerr	;error did occur(note label is
			;for ioerr deciphering of error
			;origination
	pop	D	; restore track
	pop	B	; restore sector
	lxi	H,HARDsec
	mov	M,C	; hard disk sector
	inx	H
	mov	M,E	; hard disk track (low byte)
	inx	H
	mov	M,D	; hard disk track (high byte)
	ret
.page
;----------
; Transmit/receive a block to/from the hard disk
;  Regs in:   HL = block address
;	      BC = byte count
;  Regs out:  none
;  Destroyed: A, BC, DE, HL
SENDHARD:
	mov	B,C	; assume less than 256 bytes
	mvi	C,HARDP
..1:	in	PIOAD
	bit	3,A
	jrnz	..1
	outi		; shove'em one at a time
	jrnz	..1
	ret
;
RECHARD:
	mov	B,C	; assume less than 256 bytes
	mvi	C,HARDP
..1:	in	PIOAD
	bit	4,A
	jrz	..1
	ini		; grap'em one at a time
	jrnz	..1
	ret
;--------------
; Send a command to the hard disk
;  Regs in:   A = command byte
;  Regs out:  none
;  Destroyed: A, BC, HL
cmdHARD:
	sta	HARDcom
	lxi	B,0	; keep activity count
..1:	in	HARDP	; clear status
	mvi	A,51h	; "request to send"
	out	HARDP
..2:	dcx	B	; timeout if no (or bad) disk
	mov	A,B
	ora	C
	jrnz	..3	; jump if we're still OK
	dcr	A	; clear zero flag
	jmp	begHDSKerr	; harddisk is dead
..3:	in	PIOAD	; wait for HDC send
	bit	4,A
	jrz	..2
	in	HARDP	; check if "clear to send"
	cpi	52h
	jrnz	..1	; if not, retry
	lxi	H,HARDcom ; send the command
	lxi	B,8
	jmp	SENDHARD
.page
;--------------
; Receive status info from the hard disk
;  Regs in:   none
;  Regs out:  A = error status
;  Destroyed: A, BC, HL
RESHARD:
	lxi	H,HARDstat
	lxi	B,8
	call	RECHARD
	lda	HARDstat+7
	ora	A
	rz
begHDSKerr:	
	lxi	B,HARDstat+1	; point to THS
HDSKerr:call	IOERR	; HDC error
	mvi	A,0ffh
	ora	A
	ret		; This ret ought to be
			; changed to something
			; better
.page
;--------------
IOerr:
	pop	D	; addr
	push	D
	push	B	; THS pointer
	dcx	D
	dcx	D
	dcx	D
	lxi	H,errtab
	mvi	B,numerr
findadr:
	mov	A,M
	cmp	E
	inx	H
	mov	A,M
	inx	H
	jrnz	..1
	cmp	D
	jrz	foundadr
..1:	inx	H
	inx	H
	inx	H
	inx	H
	djnz	findadr
;
foundadr:
	push	H
	lxi	H,ermsg1
	call	PRTMSG
	pop	H
	mvi	B,4
	call	PRTSTR
	lxi	H,ermsg2
	call	PRTMSG
;
PRBUFF:
	push	B
	push	H
	lxi	H,ermsg5
	call	PRTMSG
	pop	H
	pop	B
..ploop:
	push	B
	push	H
	mvi	C,' '
	call	conout
	pop	H
	pop	B
	mov	A,M
	call	PRTBYT
	inx	H
	djnz	..ploop
	ret
.page
;---------------
waituser:
	lxi	H,errmsg
	call	PRTMSG
	call	CONIN
	cpi	cntlC
	jz	0
	sui	cr
	rz
	jmpr	waituser
errtab:
	.word	0
	.ascii	'NRDY'
	.word	0
	.ascii	'DATA'
	.word	0
	.ascii	'TRAC'
	.word	0
	.ascii	'ENDT'
	.word	0
	.ascii	' ID '
	.word	0
	.ascii	'ORUN'
	.word	0
	.ascii	'SECT'
	.word	0
	.ascii	'PROT'
	.word	0
	.ascii	'DENS'
	.word	0
	.ascii	'MADR'
	.word	0
	.ascii	'HDSK'
	.word	0
	.ascii	'HSEL'
numerr	==	(.-errtab)/6
	.ascii	'I/O '		; default
;--------------
callADR:
	push	H
	dcx	H
	dcx	H
	dcx	H
	mov	A,H
	push	H
	call	prtbyt
	pop	H
	mov	A,L
	call	prtbyt
	pop	H
	ret
.page
;---------------
; Call BIOS directly using WBaddr in low memory
;
CONIN:
	lhld	WBaddr
	lxi	D,06h
	dad	D
	pchl 
CONOUT:
	lhld	WBaddr
	lxi	D,09h
	dad	D
	pchl
CPMMAP:
	lhld	WBaddr
	lxi	D,60h
	dad	D
	pchl
.page
.sbttl 'Define storage'
;
charcnt:.byte	00h	;number of char in com line
curVOL: .byte	0	;Current volume number
curSEC: .byte	00h	;current sector for disk I/O
curTRK: .byte	00h	;current track for disk I/O
DSKname:.byte	00	;Holder for CP/M drive select
DMAaddr: .word	00h	;addr (in file buffer) for DMA
FCBaddr:.word	0000h	;address of FCB (here or 5Ch)
FCBcnt: .byte	00h	;Counter of FCB bytes tranfered
numSEC: .byte	00h	;Number of sectors read by CP/M
FCBloc: .word	00h	;Address of current FCB loc
FCB:	.byte	00h	;File Control Blocks
FCBnam: .byte	20h,20h,20h,20h,20h,20h
	.byte	20h,20h,20h,20h,20h
	.byte	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	.byte	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
; The first 19 bytes of the command line are copied
; into this buffer.  CP/M file I/O destroys it.
comline: 
	.byte	20h,20h,20h,20h,20h,20h,20h
	.byte	20h,20h,20h,20h,20h,20h,20h
	.byte	20h,20h,20h,20h,20h,20h,20h
;
; Space for 12-chr CP/M maintained buffer
conbuf: .byte	15,0
	.byte	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
clrBYTS:.ascii	'                          '

; Area for hard disk status info, including
; drive initialization table if Xebec controller
STATbuf:.blkb	8+128	; HD subsystem status
; default drive characteristics (cmi 15 meg)
	.loc	STATbuf+8+22
DRVCHR: .byte	01	 ; max number
	.byte	(306-256);  of cylinders
	.byte	06	 ; heads
	.byte	01	 ; reduce write
	.byte	(306-256);  current cylinder
	.byte	01	 ; write
	.byte	(306-256);  precomp
	.byte	04
lenDVC	==	.-DRVCHR
	.reloc

; Stuff for the xebec controller timeout detector
timstart:.byte	0
$1secflag:.byte 0
.page
bit17:		.byte	0	; overflow flag
qRDorWR:	.byte	0FFh
saveADR:	.word	0	; temp storage for TOS
actDIRTY:	.byte	0	; init to buffer clean

xERRbuf:	.blkb	4	; error buffer
actBUF: 	.blkb	secsize*4
lenACTbuf	==	.-actBUF
HSTadr: .word	0FFFFh	; Storage for HDstat
cpmDSK: .byte	0
cpmTRK: .word	0
cpmSEC: .byte	0
cpmDMA: .word	0
actDSK: .byte	0FFh
actTRK: .word	0FFh
actSEC: .byte	0FFh
actVOL: .byte	0FFh
HARDcom:.byte	0
HARDdsk:
HARDsec:.byte	0
HARDtrk:.word	0
	.byte	0,0,0Ah,0 ; -- supposedly unused--
HARDstat:.blkb	8 
;
;	-- XEBEC command block --

xOPcode:	.byte	0
HIGHadr:	.byte	0
MIDadr: 	.byte	0
LOWadr: 	.byte	0
skew$blk:	.byte	1	; skewed at format
ctl$fld:	.byte	7	; 15 uSec buf'd step
.page
.sbttl "CRT MESSAGES"
;----------
; CRT Messages
;
LOGmsg: .ascii	[cr][lf]'Wrun0 Version '
	.byte	version+'0','.'
	.byte	revision/10+'0',revision@10+'0'
	.byte	patch
	.asciz	' Write specified CP/M file to Unit 0'
entmsg: .asciz	[cr][lf]'Enter file name  - '
nofnmsg:.asciz	[cr][lf]'No file name found.'[lf]
drivmsg:.asciz	[cr][lf]'Incorrect drive select.'
blnkmsg:.ascii	[cr][lf]'You have blanks in your '
	.asciz		'file name.'
noHDmsg:.asciz	[cr][lf]'Hard disk not operational.'
termsg: .asciz	[cr][lf]'***  TERMINAL ERROR  ***'
ffmsg:	.ascii	[cr][lf][lf]'File found:  Data for '
	.asciz		'writing to the hard disk'
HEADmsg:.ascii	[cr][lf]'  TRACK  SECT  TOTAL SECTORS'
	.ascii		'    VOLUME'
	.ascii	[cr][lf]'  -----  ----  -------------'
	.ascii		'    ------'
	.asciz	[cr][lf]
VERmsg: .ascii	[cr][lf]'Is data ready to be written '
	.asciz		'to the hard disk ?(Y or N)'
volmsg:	.ascii	[cr][lf]'Volume number(0-3, RETURN for '
	.asciz		'default)? '
INRmsg: .asciz	[cr][lf][lf]'Incrementing to track '
errmsg: .ascii	[cr][lf]'Incorrect entry.  Control-C '
	.asciz	'aborts program.  Please try again.'
finmsg: .asciz	[cr][lf][lf]' Data written to Unit 0'
nullmsg:.byte	0
space4: .asciz		'    '
crlf:	.asciz	[cr][lf]
TRKmsg: .ascii	[cr][lf]'Starting track  number '
	.asciz		'(in hex)? '
SECmsg: .ascii	[cr][lf]'Starting sector number '
	.asciz		'(in hex)? '
zeromsg:.ascii	[cr][lf]'You are attempting to write '
	.asciz		'a CP/M file with 0 sectors.'
filmsg: .asciz	[cr][lf]'Incorrect filename.'[lf]
partmsg:.ascii	[cr][lf]'Attempting to write out of '
	.asciz		'partition 0.'[lf]
usermsg:.ascii	[cr][lf]'You must be booted from a '
	.asciz		'floppy disk to use Wrun0.'
.page
ILLtrack:.asciz	[cr][lf]'%%% cpmTRK too large'
ILLsect:.asciz	[cr][lf]'%%% cpmSEC too large'
xFATALerr:.ascii[cr][lf]'%%% XEBEC s1410 '
	.asciz		'FATAL error at '
xERR0str:.ascii	[cr][lf]'%%% XEBEC s1410 '
	.ascii		'error occured at '
xERRcmdstr:.asciz[cr][lf]'command '
xERR1str:.asciz	[cr][lf]'status  '
ermsg1: .asciz	[cr][lf]'*** '
ermsg2: .asciz	' error '
ermsg5: .asciz	[cr][lf]'HDC buffer: '
;
	.blkb	30
stack:
	.end

