monroe/sw/CPM/monroe_files/cbios.asm

	TITLE	'CBIOS for Monroe "Monty" microcomputer and CP/M 2.2'
;
;	written by Bruce R. Ratoff
;		   26 Broad Street
;		   Cranford, NJ   07016
;	for Monroe Systems for Business
;	    The American Road
;	    Morris Plains, NJ   07950
;
;	Last change:	2/8/1983        WGW
;
false	equ	0
true	equ	not false
;
version		equ	2
revision	equ	27
production	equ	true	; true if production run
;
month		equ	2
day		equ	8
year		equ	83
;
;	v2.27	WGW	256K support
;	v2.26	WGW	Hard disk support, printer etx/ack and timeout, clock
;	v2.25	WGW	Added xon/xoff support on list device
;	v2.24	BRR	First release version
;	v2.23	BRR	Experimental versions from v2.20
;
etxack		equ	true			; enable etx/ack code
ulimit		equ	81			; upper block size limit (+1)
						;  for etx/ack mode
llimit		equ	77			; lower block size limit
						;  for etx/ack mode w/esc seq.
;
memorydisk	equ	true			; utilize top 64k as disk
mdisk$base	equ	60h			; uses top 4 bits in io$pmapa
;
defaultpmapa	equ	0			; default program map A offset
defaultpmapb	equ	0			; default program map B offset
;
scanuser0	equ	true			; ccp scan of user 0 on error
mpmbdoscalls	equ	true			; enables mp/m bdos functions
interrupts	equ	true			; enables timer interrupts
coninterrupt	equ	true and interrupts	; enables console type ahead
conbuffersize	equ	64			; size of console type ahead buffer

eiconst		equ	true and interrupts	; puts an EI in lconst:
todfunctions	equ	true and interrupts	; enable bdos tod functions
displayclock	equ	true and todfunctions	; display tod clock on OC
displayampm	equ	true and displayclock	; display as 12 hour AM/PM
clockoff	equ	false			; disables default tod display
;
clockattribute	equ	0			; see attributes below
clockcolumn	equ	65			; clock display column
;
;      Bit	Description (Display Attribute)
;	7 (msb)	no-op
;	6	Dim
;	5	Double width
;	4	Reverse video
;	3	Underline (or block graphics)
;	2	Blink
;	1-0	Select code
;			0 = Normal Character
;			1 = Double height bottom
;			2 = Double height top
;			3 = Graphics (Thin line or block)
;
maxfloppy	equ	4	; 4 floppies
maxharddisk	equ	4	; 2 hard disks (2 more for two 10M hard disks)
;
	if memorydisk
maxdisk		equ	maxfloppy+maxharddisk+1
mdrive		equ	8	;					   |10|
	else
maxdisk		equ	maxfloppy+maxharddisk
mdrive		equ	-1	;					   |10|
	endif
;
;
istacksize	equ	32	; bytes allocated to interrupt stack
;
	maclib	diskdef		;get table generation macros
	maclib	z80		;get z80 instruction set
	maclib	montyio		;get Monty port definitions
;
;
debug	equ	false		;true if trap "calc mode" key into Z80MON
reloc	equ	true		;true if assembling for MOVCPM
msize	equ	64		;cp/m memory size in kilobytes
;
sys$ram		EQU	41H	; SELECT 16K-32K-16K PARTITION
sys$video	EQU	45H	; SELECT VIDEO RAM AT 3000 HEX
;
;	"bias" is address offset from 2C00H for memory systems
;	larger than 21K (referred to as "b" throughout the text).
;	Note: In "standard" systems, this is the offset from 3400H.
;
bias	equ	(msize-21)*1024
;
	if	reloc
ccp	 equ	$		;will be 0 w/o MAC +R switch, 100h with
	else
ccp	 equ	2D00H+bias	;base of ccp
	endif
bdosb		equ	ccp+800h	;base of bdos
bdos		equ	ccp+806h	;entry to bdos
bios		equ	ccp+1600h	;base of bios
bdosaret	equ	bdosb+345h	;bdos function code return value
;
cdisk	equ	0004H	;current disk number 0=A,...,15=P
iobyte	equ	0003h	; i/o byte
;
start$ctc3	equ	85h	; div 16 with time constant and interrupt
oneslice	equ	250	; time constant
onetick		equ	15	; sub-interval to get 20 msec
onesecond	equ	50	; 20 msec clock tick, 50 ticks/second
;
maxrtr	equ	5	;max retries on floppy error
rate	equ	1	;seek rate select (12 ms)

	if interrupts

montime	equ	15	; seconds by timer interrupt

	else

montime	equ	10	;tick count for motor timeout

	endif

;
;	---  ASCII character codes  -----
;
etx	equ	3
ack	equ	6
bell	equ	7
bs	equ	8

lf	equ	10
ff	equ	12
cr	equ	13

xon	equ	17	; control-q
xoff	equ	19	; control-s

esc	equ	27	; escape

control	equ	1fh	; control characters
;
; ----  Additional implemented BDOS function codes -----
;
settime		equ	104
readtime	equ	105
returnserial	equ	107
readclock	equ	155
;
;
; ----  XEBEC COMMAND CONSTANTS  ------
;
TSTDR       EQU       0
RESTR       EQU       1
RQSEN       EQU       3
SEEK        EQU       0BH
RDSEC       EQU       08
WRSEC       EQU       0AH
CHKTK       EQU       05H
FORBD       EQU       07H
SETDR       EQU       0CH
;
DRVSEL1     EQU       20H
;
;         GORMAN INTERFACE STATUS
;
CSTAT       EQU       4
CDONE       EQU       2
GCMD        EQU       1
CBUSY       EQU       80H
;
DTAREQ      EQU       40H
ERHDK	    EQU       2
;
;         GORMAN-XEBEC PORT ASIGNMENTS
;
HD$DATA     EQU       78H
STCS        EQU       79H
ENDMA       EQU       7AH
DISDMA      EQU       7BH
ENINT       EQU       7CH
DISINT      EQU       7DH
;
SEL         EQU       79H
;
DMAMSK	   EQU	     0FCH
DMAHD      EQU       03
;
; Macro to generate correct ORG statements for reloc or non-reloc sys
rorg	macro	x
	if	reloc
	org	x-ccp
	else
	org	x
	endif
	endm
;
; The following code generates the boot header sector required
; by the IPL ROM.
; It normally resides in track 0, sector 1 of a system disk.
;
HORG	equ	CCP-100H		; Boot location rel. to CCP

	rorg	HORG+0EH		; Set BIOS entry point
	db	BIOS/256,BIOS and 0FFH

	rorg	HORG+1EH
	dw	0FFFFH			; Flag this as a CP/M disk

	rorg	HORG+82h		; Set load address
	db	CCP/256,CCP and 0FFH
	if	debug			; Set load length
	db	code$size/256+7,code$size and 0FFH
	else
	db	code$size/256,code$size and 0FFH
	endif
;
;
; The patches below cause the CCP to automatically search IPL drive
; for any .COM file not found on the current default drive.
;
ccp$get$user	equ	ccp+113h	; ccp entry points
ccp$set$user	equ	ccp+115h
;
ccp$jnz$user0	equ	ccp+6adh	; patch point
ccp$user0	equ	ccp+6c4h
ccp$start$com	equ	ccp+6cdh
ccp$jz$userer	equ	ccp+6dbh	; patch point
ccp$jnz$load1	equ	ccp+6ech	; patch point
ccp$load1	equ	ccp+701h
ccp$userer	equ	ccp+76bh
ccp$com$fcb	equ	ccp+7cdh
ccp$sdisk	equ	ccp+7f0h
ccp$end		equ	ccp+7f2h	; patch point
;
;
	rorg	ccp$jz$userer
	jz	ccppatch		; Taken if .COM not found
;
;
	if scanuser0

	 rorg	ccp$jnz$user0
	  jnz	ccp$jnz$user0$patch	; jump to patch location
;
	 rorg	ccp$jnz$load1
	  jnz	ccp$load1$patch		; jump to patch location

	endif				; end of scan user 0 option
;
;
	rorg	ccp$end			; top of ccp section (14 free bytes)
ccp$patch:				; use unaccessed ccp section
	lda	ccp$auto$retry		; a  := ccp auto retry flag
	ora	a			; see if zero
	jz	ccp$userer		; error if retries not allowed 
	jmp	continue$ccp$patch
;
; This patch allows the SUBMIT file ($$$.SUB) to reside on the IPL drive
;
	rorg	ccp+140h		; in READCOM was
	lda	ipldsk			; lda cdisk
	nop				; ora a
	nop				; mvi a,0
	nop
	db	0cdh			; cnz (now a call)
;
	rorg	ccp+17dh		; in READCOM was
	lda	ipldsk			; lda cdisk
	ora	a			; ora a
	db	0cdh			; cnz
;
	rorg	ccp+1e5h		; in DEL$SUB
	nop				; patches over: xra a
	call	ccppat3			; patches over: call select
;
; These patches force IPL drive to be selected after any BDOS error
;
	rorg	bdosb+0a2h
	dw	permerr
;
	rorg	bdosb+0b8h
	dw	permerr
;
; This patch changes the drive selected by the "disk reset" function
; to be the drive that the system was booted from, rather than A:
;
	rorg	bdosb+0c8dh
	jmp	rstpatch
;
	rorg	bdosb+0df7h
rstpatch:
	lda	ipldsk
	sta	bdosb+0342h
	jmp	bdosb+0c90h
;
;	This patch allows the mp/m bdos calls to be operable.
;
	if mpmbdoscalls
	rorg	bdosb+33h	; place where bdos checks function code

	jmp	bdospatch	; use internal check of limits
bdosfunc:			; enter here if bdos function is ok
	endif
;
;
;
	rorg	bios	;origin of this program
;
;	jump vector for individual subroutines
	jmp	boot		;cold start
wboote:	jmp	wboot		;warm start
xconst:	jmp	lconst		;console status
xconin:	jmp	lconin		;console character in
xco:	jmp	lconout		;console character out
	jmp	llist		;list character out
	jmp	lpunch		;punch character out
	jmp	lreader		;reader character out
	jmp	home		;move head to home position
	jmp	seldsk		;select disk
	jmp	settrk		;set track number
	jmp	setsec		;set sector number
	jmp	setdma		;set dma address
	jmp	read		;read disk
	jmp	write		;write disk
	jmp	llistst		;return list status
	jmp	sectran		;sector translate
;
; Physical driver variables:
; (Placed here in case maintenance utilities need them.)
fpyctrl:	ds	1		;current select/control port value
timecntr:	ds	1		;motor off delay count (0 if inactive)
ipldsk:		ds	1		;IPL drive - default for warm boot
bufptr:		ds	2		;used by COPY utility do not move  |10|
trktbl:		db	255,255,255,255	;current track on each drive
fpycmd:		ds	1		;current floppy command
timecntp: 	ds	2		;motor off delay prescale count
fpyrtry: 	ds	1		;retry count for seek, read, write
;
; Default CTC and SIO divider control bytes for serial ports
rbaud:	db	78,0c4h		;modem baud rate control (300 baud)
cbaud:	db	10,44h		;aux console baud rate control (9600 baud)
lbaud:	db	78,44h		;printer baud rate control (1200 baud)
;
; Function key translate table pointer
ukptr:	dw	uktbl		;reset to uktbl at every warm boot
;
; Sector translate table NOW FOR FLOPPY ONLY
xltbl:	db	0,1,8,9,16,17,24,25
	db	2,3,10,11,18,19,26,27
	db	4,5,12,13,20,21,28,29
	db	6,7,14,15,22,23,30,31
;
enableetxack:	db	0		; 0ffh enables etx/ack printer support
lsize:		db	0		; current line size with etx/ack mode
;
ccp$auto$retry:	db	true		; ccp auto retry on .com file load
;
logical$disk:				; logical to physical disk table
	db	 0, 1, 2, 3		; A:, B:, C:, D: (floppies)
hd$drvs:				;				   |10|
	db	 4, 5,-1,-1		; E:, F:, G:, H: (hard disk)
        db	-1,-1,-1,-1		; I:, J:, K:, L: (not used)
	db  mdrive,-1,-1,-1		; M:, N:, O:, P: (memory disk)     |10|
;
pmapa$current:	db	defaultpmapa	; current value of io$pmapa
pmapb$current:	db	defaultpmapb	; current value of io$pmapb
sys$current:	db	sys$ram		; current value of io$sys
cpm$system:	db	sys$ram		; current value while running cpm
					; can be changed to sys$video to
					; select video ram at 3000 hex
cpm$video:	db	sys$video	; current value while running cpm to
					; select video ram at 3000 hex
;
;
second$interrupt:			; for system programs ONLY
	if displayclock
	 if clockoff
	  ret				; patch to jump to enable display
	  dw	displaytod		; possible jump location
	 else
	  jmp	displaytod		; display time of day
	 endif
	else
	 ret				; Call made here each second.
	 dw	0			; Can be patched with a jump location
					; Only three stack levels available,
					; all 8080 registers saved
	endif
;
inputpointer:	db	0	; console buffer input pointer
outputpointer:	db	0	; console buffer output pointer
;
mem$hcol:	db	80h	; buzzer/hi-res/char video enable port copy
;
lstsec:		db	0ffh	; list time-out in seconds (0ffh is off)|14|
lstcnt:		db	0	; list time-out counter			|14|
;
;
;	XEBEC CONTROL BLOCK
DCB$CMD:    DS	1	;COMMAND SAVE BYTE.
DCB$DRV:    DS	1	;DRIVE AND MS ADDR
DCB$CTRK:   DS	2	;CURRENT LOGICAL ADDRESS
DCB$NSEC:   DB	1	;NUMBER OF SECTORS TO XFER
DCB$CTL:    db	0	;CONTROL BYTE					   |10|
DCB$RSTA:   DS	1	;RETURNED STATUS
DCB$RTRK:   DS	3	;RETURNED LOGICAL ADDRSS
DCB$RTRY:   DS	1	;RETRY COUNTER
;
;
	if interrupts

tod:		dw	0	; days since Jan. 1, 1978
todhours:	db	0	; hours	  (BCD)
todminutes:	db	0	; minutes (BCD)
todseconds:	db	0	; seconds (BCD)
		db	onesecond
todticks:	db	onetick	; ticks

interruptsp:	dw	0	; sp during clock interrupt

	 ds	istacksize	; interrupt stack (see next label)

	 if	(low $) gt 0d0h		; interrupt vectors start at xx0dh
	  rorg	<1D0h+(0ff00h and $)>	; on next page
	 else
	  rorg	<0d0h+(0ff00h and $)>	; on this page
	 endif

interruptstack:				; interrupt stack grows down
vectortbl:
	 dw	doreti		; SIO B (D0)	Transmit Ready	(Auxillary)
	 dw	doreti		;		Status Change
	 dw	doreti		;		Receiver Ready
	 dw	doreti		;		Special Reciver Condition
�
	 dw	doreti		; SIO A	(D8)	Transmit Ready	(Communication)
	 dw	doreti		;		Status Change
	 dw	doreti		;		Receiver Ready
	 dw	doreti		;		Special Reciver Condition

	 if coninterrupt
	  dw	consoleint	; Dart B (E0)	Transmit Ready	(Keyboard)
	  dw	consoleint	;		Status Change
	  dw	consoleint	;		Receiver Ready
	  dw	consoleint	;		Special Reciver Condition
	 else
	  dw	doreti		; Dart B (E0)	Transmit Ready	(Keyboard)
	  dw	doreti		;		Status Change
	  dw	doreti		;		Receiver Ready
	  dw	doreti		;		Special Reciver Condition
	 endif

	 dw	doreti		; Dart A (E8)	Transmit Ready	(Printer)
	 dw	doreti		;		Status Change
	 dw	doreti		;		Receiver Ready
	 dw	doreti		;		Special Reciver Condition

	 dw	doreti		; Ctc 0 (F0)
	 dw	doreti		; Ctc 1 (F2)
	 dw	doreti		; Ctc 2 (F4)
	 dw	clockint	; Ctc 3 (F6)
	 dw	doreti		; PIO A (F8)
	 dw	doreti		; PIO B (FA)
	 dw	doreti		; not used (FC)
	 dw	doreti		; External (Maybe FE)
;
	 if coninterrupt

consoleint:
	  sspd	interruptsp	; save user sp
	  lxi	sp,interruptstack
	  push	psw		; save parameters
	  push	b
	  push	d
	  push	h
	   in	io$drtbd	; a  := character entered
	   mov	c,a		; c  := character entered
	   lxi	h,outputpointer	; hl := output pointer index
	   mov	d,m		; d  := output pointer
	   dcx	h		; hl := input pointer index
	   mov	e,m		; l  := current input pointer
	   mov	a,e		; a  := current input pointer
	   inr	a		; increment pointer
	   cpi	conbuffersize	; check for pointer overflow
	   jrc	concheckbuffer
	   sub	a		; a  := 0 (start of buffer)
concheckbuffer:
	   cmp	d		; compare to output pointer
	   jrz	conrestore	; exit if buffer is full
	   mov	m,a		; update input pointer
	   mvi	d,0		; de := current input pointer
	   lxi	h,conbuffer	; hl := base of console buffer
	   dad	d		; hl := buffer index
	   mov	m,c		; update buffer
conrestore:
	  pop	h		; restore parameters
	  pop	d
	  pop	b
	  pop	psw
	  lspd	interruptsp	; restore user stack
	  ei			; enable interrupts
	  reti			; resume execution
	 endif

clockint:			; main timer interrupt for clock and timeout
	 sspd	interruptsp	; save user sp
	 lxi	sp,interruptstack	
	 push	psw		; save state on interrupt stack
	 push	h
	  lxi	h,todticks	; hl := tod ticks index
	  dcr	m
	  jrnz	noclocktick	; check the rest of the clock each tick
	  push	b		; save user bc and de
	  push	d		; all primary registers saved
	   call	clocktick	; do real operation
	  pop	d		; restore user registers
	  pop	b
noclocktick:
	 pop	h		; restore user regisers
	 pop	psw
	 lspd	interruptsp	; restore user stack
doreti:	 ei			; turn on interrupts
	 reti			; resume

clocktick:
	 mvi	m,onetick	; update tick counter
	 dcx	h		; index slice counter
	 dcr	m		; decrement slice count
	 rnz			; exit if not one second
	 mvi	m,onesecond	; update tick count

	 if todfunctions	; select if mp/m bdos tod functions
	  call	updatetod	; update clock (hl = base of tod block)
	  call	second$interrupt ; possible user routine
	 endif

	 call	chklist		; check list time-out every second
	 jmp	chkmotor	; check disk drive motor every second

chklist: lxi	h,lstcnt	; hl := list time-out counter index
	 mov	a,m		; a  := list time-out counter
	 ora	a		; time-out occurred?
	 rz			; exit on time-out
	 inr	a		; counter off? (a was 0ffh)
	 rz			; exit if counter turned off
	 dcr	m		; else decrement counter
	 ret	

	 if todfunctions
updatetod:			; update time-of-day clock
	  mvi	e,60h		; e  := seconds/minutes limit
	  call	checktoddigit	; check seconds
	  cnc	checktoddigit	; check minutes (skip if seconds < 60)
	  mvi	e,24h		; e  := hours limit
	  cnc	checktoddigit	; check hours (skip if sec/min < 60)
	  rc			; check days, exit if still today
	  dcx	h		; otherwise, increment day count
	  dcx	h		; index lsb of tod days
	  inr	m		; increment lsb
	  rnz			; exit if no overflow
	  inx	h		; index msb of tod days
	  inr	m		; increment msb
	  ret			; all done

	  
checktoddigit:
	  dcx	h		; index next digit
	  mov	a,m		; increment next digit(BCD)
	  adi	1
	  daa
	  mov	m,a		; update next digit
	  cmp	e		; check for one minute
	  rc			; return if less than limit
	  mvi	m,0		; zero digit
	  ret

	 endif			; end of tod functions
	endif			; end of interrupts


	if mpmbdoscalls		; check for mp/m bdos function calls

bdospatch:			; de = parameter
	 cpi	29h		; number of normal cp/m bdos functions
	 jc	bdosfunc
	 cpi	returnserial	; check for mp/m return serial number function
	 jrz	returnserialnumber

	 if (not todfunctions)
	  ret			; return to bdos
	 else			; else, check for tod bdos functions

	  lxi	h,tod		; hl := tod address, de = parameter
	  cpi	readtime	; check for mp/m read time function
	  jrz	copy4
	  cpi	readclock	; check for mp/m read clock function
	  jrz	copy5
	  cpi	settime		; check for mp/m set time function
	  rnz			; exit if invalid function
	  sub	a		; a  := 0
	  sta	todseconds	; clear seconds
	  xchg			; hl := source of time, de := tod
copy4:	  lxi	b,4		; move in new tod
	  ldir
	  ret

copy5:	  lxi	b,5		; copy 5 bytes
	  ldir
	  ret

	 endif			; end of mp/m time-of-day bdos functions

returnserialnumber:		; de  = user destination
	 lxi	h,bdosb		; hl := source of serial number
	 lxi	b,6		; 6 bytes in serial number
	 ldir			; copy to user buffer
	 ret			; all done

	endif

;
;
; ---	Rest of ccppatches   --------------------------------
;
;
continue$ccp$patch:			; fcb disk drive just tested for 0
	lda	ccp$sdisk		; a  := current drive number
	ora	a			;  zero means default was taken
	if scanuser0
	 jrnz	try$user0		; try user 0 on ipl disk
	else
	 jnz	ccp$userer		; If nonzero, don't change it
	endif
	lda	cdisk			; a  := current disk/user number
	ani	0fh			; a  := current disk
	mov	b,a			; save current disk number
	lda	ipldsk			; Get IPL drive
	cmp	b			; compare ipl disk with current disk
	if scanuser0
	 jrz	try$user0		; try user 0 of ipl already selected
	else
	 jz	ccp$userer		; error if already ipl disk and user 0
	endif
	inr	a			; convert to base 1
	sta	ccp$sdisk		; update fcb disk number with ipl disk
ccp$restart:
	lxi	d,ccp$com$fcb+9		; Setup for retry
	jmp	ccp$start$com		; Go do it
;
;
	if scanuser0			; scan ipl drive, user 0 if .com file
					;  not found on designated drive
ccp$local$user:	db	0		; local user number
;
ccp$jnz$user0$patch:
	 call	ccp$get$user		; a  := local user number
	 sta	ccp$local$user		; save, restored by load1 or userer
	 jmp	ccp$user0		; continue in the normal fashion
;
ccp$load1$patch:
	 push	psw			; save load result
	  call	ccp$reset$user		; reset to original user code
	 pop	psw
	 jmp	ccp$load1		; continue ccp load
;
ccp$userer$patch:
	 call	ccp$reset$user		; reset to original user code
	 jmp	ccp$userer		; continue with the normal error code
;
ccp$reset$user:
	 lda	ccp$local$user		; a  := user number
	 mov	e,a			; e  := user number
	 jmp	ccp$set$user		; set user number
;
;
;  ---	Alternatives to default disk   -------------------------
;
try$user0:
	 call	ccp$get$user		; a  := user code
	 ora	a
	 jrz	ccp$userer$patch	; error if user 0 already selected
	 mvi	e,0			; e  := user code
	 call	ccp$set$user		; set user 0
	 jmpr	ccp$restart
;
	endif				; end of scan user 0 option
;
;
;  ---	Additional area for XUB patch   -------------------------
;
ccppat3:				; select drive to delete $$$.sub
	lda	ipldsk			; get ipl drive
	mov	e,a
	mvi	c,14			; bdos select disk function code
	jmp	bdos			; select the disk
;
;
;  ---	Video clock display routines    -------------------------
;
	if displayclock

videodisplaytod	equ	3000h+(24*160)+(2*clockcolumn)	; line 24

displaytod:
	lda	cpm$video		; select video ram
	out	io$sys
	lxi	h,videodisplaytod	; hl := video display index
	lxi	d,todhours		; de := tod index

	if displayampm
	 mvi	c,'A'			; c  := AM/PM selection (AM default)
	 ldax	d			; a  := hours (BCD)
	 ora	a			; check if hours = 0
	 jrnz	notmidnight
	 mvi	a,12h			; set to midnight (2400 hours)
	 jmpr	displayam		; it is 12 AM in the morning

notmidnight:
	 cpi	12h			; see if it is AM
	 jrc	displayam		; skip if in the morning
	 jrz	displaypm		; skip if noon
	 adi	88h			; adjust hours (subtract 12)
	 daa				; adjust for BCD, now 1 to 11
displaypm:
	 mvi	c,'P'			; c  := PM selected
displayam:
	endif

	call	display2a		; display hours
	call	displaydot2		; display minutes
	call	displaydot2		; display seconds

	if displayampm
	 inx	h			; add a space
	 inx	h			; two bytes per character
	 mov	a,c			; a  := 'A' or 'P'
	 call	displaychar		; display it
	 mvi	a,'M'			; a  := 'M'
	 call	displaychar		; display it too
	endif

	lda	sys$current		; select previous value
	out	io$sys
	ret

displaydot2:				; display .dd
	call	displaydot		; display a dot
display2:
	ldax	d			; a  := 2 bcd digits
display2a:
	push	psw			; save for later
	 rar
	 rar
	 rar
	 rar				; a  := ms digit
	 call	displaydigit
	pop	psw			; a  := 2 bcd digits
	call	displaydigit
	inx	d			; index next tod position
	ret

displaydigit:				; display a digit
	ani	0fh
	ori	'0'
	jmpr	displaychar

displaydot:
	mvi	a,'.'
displaychar:
	mvi	m,clockattribute	; display attribute
	inx	h
	mov	m,a			; display character
	inx	h
	ret

	endif
;
;
;
;Warm-boot entry point must re-load CCP and BDOS,
;then jump into CCP warm entry point.
;
wboot:	lxi	sp,0100h	; use temporary stack for warm boot
	call	wb$disk		; a  := warm boot disk drive number
	lxi	h,ccp+3		; where to go on init
gocpm:				; ccp and bdos loaded
	push	h		; save ccp entry address
;
	 mvi	a,montime	; a  := floppy disk motor timeout delay
	 sta	timecntr	; enable floppy disk motor timeout
;
	 xra	a		;0 to accumulator
	 sta	hstact		;host buffer inactive
	 sta	unacnt		;clear unalloc count
;
	 mvi	a,0c3h		;c3 is a jmp instruction
	 sta	0		;for jmp to wboot
	 lxi	h,wboote	;wboot entry point
	 shld	1		;set address field for jmp at 0
;
	 sta	5		;for jmp to bdos
	 lxi	h,bdos		;bdos entry point
	 shld	6		;address field of jump at 5 to bdos
;
	 lxi	b,80h		;default dma address is 80h
	 call	setdma
;
	 lxi	h,hstbuf	;set host buffer address
	 shld	bufptr		;for deblocking reads and writes
;
	 lxi	h,uktbl		;reset function key pointer
	 shld	ukptr		;to built-in translate table
;
	 lda	iobyte		;is this 40-col screen
	 ani	3
	 cpi	1		;if so then modify DIR command for 2 cols.
	 jrnz	go2
	 sta	ccp+4b2h
go2:
	if interrupts
	 ei			;enable the interrupt system
	endif

	 lda	cdisk		;get current disk number
	 mov	c,a		;send to the ccp
	 ret			;go to cp/m for further processing
;
wb$disk:
	if memorydisk

	 lxi	h,4000h+100h	; hl := base of ccp/bdos in mdisk
	 lxi	d,ccp		; de := ccp/bdos base
	 lxi	b,bios-ccp	; number of bytes to move
	 mvi	a,mdisk$base	; a  := mapping value
	 out	io$pmapa	; select mdisk base
	 ldir			; copy ccp and bdos
	 lda	pmapa$current	; select current value
	 out	io$pmapa	; select normal ram
	 ret

	else

	 lda	ipldsk		; a  := physical disk number
	 ani	0fh		; make sure it there are only 16 devices
	 mov	e,a
	 mvi	d,0		; de := logical disk number
	 lxi	h,logical$disk	; hl := logical disk table
	 dad	d		; hl := physical disk number index
	 mov	a,m		; a  := physical disk number
	 sta	hstdsk		;select boot drive
	 lxi	h,0
	 shld	hsttrk		;track 0
	 mvi	a,1		;sector 2
	 lxi	h,ccp		;load ccp first
wbloop:	 sta	hstsec		;sector to read
	 shld	bufptr		;where to read it to
	 call	readhst		;perform read
	 lda	erflag		;was it successful?
	 ora	a
	 jnz	wboot		;retry boot on any read error
	 lhld	bufptr
	 inr	h		;bump pointer
	 mov	a,h
	 cpi	bios/256	;done yet?
	 rnc			;exit if yes
	 lda	hstsec		;else bump sector
	 inr	a
	 cpi	16		; time for seek yet?
	 jrc	wbloop		; loop back if not
	 mvi	a,1		; else update track
	 sta	hsttrk
	 sub	a
	 jmpr	wbloop		;continue at track 1, sector 1

	endif
;
;
;
;Print message at (HL) until null
prmsg:	mov	a,m	;get char
	ora	a	;test for 0
	rz
	push	h	;save pointer
	mov	c,a
	call	xco	;output char.
	pop	h
	inx	h	;bump pointer
	jmpr	prmsg	;loop till all done
;
;
; Console drivers for Monroe 'Monty' microcomputer
;
; Entry point for normal sequential console output.
; Character to be output is passed in C reg.
;
conout:	sspd	spsave		; Save caller's stack and set up our own
	lxi	sp,loclstk	;  so we can safely bank out low RAM
	 lda	cpm$video	; a  := select byte for video ram
	 sta	sys$current	; update current value in ram
	 out	io$sys
	 call	point		; Remove existing cursor
	 res	7,m
	 call	crtout		; Process new character
	 call	setcur		; Turn on new cursor
	 lda	cpm$system	; a  := select byte while running cpm
	 sta	sys$current	; update current value in ram
	 out	io$sys		; Switch out VRAM
	lspd	spsave		; restore user stack pointer
	ret			; Bye-bye
;
; Main CRT output routine
;
crtout:	lded	ukop		; Are we loading a function key?
	mov	a,d
	ora	a		; we are if pointer is nonzero
	jrz	notuko
	xchg			; put pointer in HL
	lded	ukptr		; check for overflow
	push	h
	 dsbc	d		; get offset from start of table
	 mov	a,l		; save low ord
	pop	h		; and restore true pointer
	inr	a
	ani	07h		; is pointer to last char of this key?
	jrnz	nukov		; jump if not
	mvi	c,0		; if end of key, force terminating null
nukov:	mov	m,c		; store key
	inx	h		; bump pointer
	mov	a,c
	ora	a		; is this terminating null?
	jrnz	ukoput		; no, skip
	lxi	h,0		; got terminating null...turn off key load
ukoput:	shld	ukop
	ret			; bye bye

notuko:	lda	escflg		; are we in an escape sequence?
	ora	a
	jnz	escseq		; yes, go process escape sequence
	mov	a,c		; a  := output character
	cpi	' '		; Printable?
	jrc	notprintable	; Try non-printing control characters
;
; If here, we got a printable character (we hope)
;
putchar:
	lda	attrib		; set attribute byte
	mov	m,a		; to current attributes
	inx	h		; Bump past attribute byte
	mov	m,c		; Store character on screen
curfwd:	lda	hpos		; a  := hpos
	inr	a		; Bump horizontal position
	lxi	h,linlen	;  and check for end-of-line
	cmp	m
	sta	hpos		; Else set new horiz pos.
	rc			; And exit if no wrap needed
	sub	a		; Force HPOS back to 0
	sta	hpos		; hpos := 0 
;
; Here to advance one line
;
lfout:	lda	vpos		; Get current line no.
	inr	a		; Bump it
	cpi	24		; Off the end?
	jnc	rollup		;  then go scroll
	sta	vpos		; Else save new line no.
	ret			; and exit
;
notprintable:
	cpi	cr		; CR?
	jz	crout
	cpi	lf		; LF?
	jrz	lfout
	cpi	esc		; escape sequence?
	jz	gotesc
	cpi	bs		; BS?
	jz	bsout
	cpi	control and 'Z'	; control-Z?
	jz	ehome		; Clear screen
	cpi	0bh		; VT?
	jz	curup		; Cursor up
	cpi	ff		; FF?
	jz	curfwd		; Cursor right one space
	cpi	bell		; BELL?
	jz	beep
	cpi	11h		; DC1?
	jz	eeos		; Erase EOS
	cpi	1eh		; ^^?
	jz	vhome		; Home cursor
	ret			; ignore undecoded characters
;
; Develop address of current screen byte
;
point:	lda	vpos		; Use current line # to get base addr
	add	a		; a  := 2 * line index (less than 47)
	mov	e,a
	mvi	d,0		; de := 2 * line index (used below too)
	lhld	ltabptr		; hl := pointer to line address table
	dad	d		; hl := index to line address
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a		; hl := address of current line
	lda	hpos		; a  := column index
	add	a		; a  := 2 * column index (less than 161)
	mov	e,a		; de := 2 * column index (d = 0)
	dad	d		; hl := character index
	ret
;
; Turn on cursor at current screen location
;
setcur:	call	point		; Get screen address
	lda	l80$40		; Which machine is this?
	ora	a
	jrnz	setc40		; Branch if 40-col version
	mvi	a,14
	out	io$crta		; Reference hi-ord cursor loc
	mov	a,h		; and store pointer/2 since there
	ani	0fh		; Keep within 4k range
	rar			; are two VRAM bytes per char.
	out	io$crtd
	mvi	a,15
	out	io$crta		; Now do low order
	mov	a,l
	rar
	out	io$crtd
	ret
;
; Here's the 40-col version
;
setc40:	setb	7,m		; Just set inverse flag on current char
	ret
;
; Delete line
deline:	lda	vpos		; What line are we on?
	mov	e,a		; e  := current line index
	mvi	d,0		; de := current line index
	mvi	a,23
	sub	e		; a  := number of lines below
	mov	b,a		; b  := number of lines to roll up
	lhld	ltabptr		; hl := line index table base
	dad	d
	dad	d		; hl := line index index (zero flag unchanged)
	ora	a		; check number of lines to roll up
	jrnz	rollx		; No, do delete
	sta	hpos		; hpos := 0, Last line....
	jmp	eeol		; just clear it
;
; Scroll the whole screen up one line
;
rollup:	lda	l80$40		; a  := machine type
	ora	a		; test for 40/80 column version
	jrz	fast$roll	; use fast scroll in 80 column version
	mvi	b,23		; Get # of lines
	lhld	ltabptr		; Point to table of line addresses
rollx:	lda	linlen		; Get # of columns
	add	a		; a  := 2 * columns/line (2 bytes/char)
	mov	c,a		; c  := bytes/line
	inx	h		; adjust for DCX in loop
rollnext:
	dcx	h		; Point to destination line
	mov	e,m		; and get its address
	inx	h
	mov	d,m		; de := destination line
	inx	h
	mov	a,m		; Get source line
	inx	h
	push	h		; Remember place in line address table
	 mov	h,m
	 mov	l,a		; hl := source line
	 push	b		; Remember line size
	  mvi	b,0		; bc := bytes/line
	  ldir			; Copy the line
	 pop	b		; restore loop count and line size
	pop	h		; restore line pointer
	djnz	rollnext	; repeat for 23 lines
	mov	d,m		; get start of last line from table
	dcx	h
	mov	e,m		; de := start of last line
	xchg			; hl := start of last line
	jmpr	eline		; Go clear it (bc := line size)
;
fast$roll:			; for 80 column machine from bottom line
	lxi	b,2*23*80	; bc := number bytes to scroll
	lxi	d,3000h		; de := destination (line 0)
	lxi	h,3000h+(2*80)	; hl := source (line 1)
	ldir			; roll the screen
	xchg			; hl := first character of last line
	mvi	c,2*80		; c  := number of characters to erase
	jmpr	eline		; clear the last line (hl = last line)
;
; Backspace cursor
;
bsout:	lda	hpos		; Get current column
	ora	a		; Already 0?
	rz			; then ignore
	dcr	a		; Else back up one
	sta	hpos
	ret
;
; Make some noise in version-specific way
;
beep:	lda	mem$hcol	; Turn on biz model beeper
	ori	1		; turn on OC beeper bit
	out	io$hcol
	lxi	b,6cch		; Prepare for 6 bytes to port 0CCH
	lxi	h,urrk		; Point to noise table for educ. model
	outir			; Send noise command bytes
	lxi	b,0e24h		; Now kill some time
beep1:	djnz	beep1
	dcr	c
	jrnz	beep1
	lda	mem$hcol	; Turn off beeper
	ani	0feh		; turn off beeper control bit on OC
	out	io$hcol
	mvi	a,9fh		; For both machines
	out	0cch
	ret
;
urrk:	db	8eh,04h,92h,0bfh,0dfh,0ffh
;
; Clear the screen and home the cursor
;
ehome:	call	vhome
;
; Erase from current cursor to end of screen
;
eeos:	lda	linlen		; 40 or 80 chars per line
	add	a		; convert to bytes/line
	mov	c,a
	mvi	b,23		; do 23 lines
	lxi	d,48
	lhld	ltabptr		; Point to last line of screen
	dad	d
eeosnext:
	dcx	h		; Get line address
	mov	d,m
	dcx	h
	mov	e,m
	xchg
	lda	vpos		; Have we reached current line yet?
	cmp	b
	jrz	eeol		; Then only erase from cursor posn
	push	b
	push	d		; Else erase whole line
	 call	eline
	pop	h
	pop	b		; Restore pointer and counter
	djnz	eeosnext	; Repeat as long as required
;
; Erase from current cursor to end of line
;
eeol:	call	point		; Get screen address
	lda	hpos
	mov	c,a		; Figure out how many bytes left
	lda	linlen		; from cursor to EOL
	sub	c
	add	a		; a  := 2 * number of characters
	mov	c,a		; c  := 2 * number of characters
eline:	mvi	b,0		; Hi-ord count is 0
	mov	e,l
	mov	d,h		; Source := destination
	inx	d
	inx	d		; de := index of second character
	mvi	m,7		; clear attribute byte
	inx	h
	mvi	m,' '		; first char is a space
	dcx	h
	dcr	c		; Is that all?
	dcr	c
	rz			; Yup, just one itty bitty character
	ldir			; Else copy blank to rest of line
	ret
;
; Insert line - Scroll from cursor to EOS down and clear cursor line.
;
inslin:	lda	linlen		; Convert line length
	add	a		;  to byte count for line move
	mov	c,a		;  and save it
	mvi	b,23		; Max # of lines to move down
	lxi	d,48		; Get to end of
	lhld	ltabptr		;  line address table
	dad	d
insnext:
	dcx	h		; point to destination line
	mov	d,m
	dcx	h		; fetch destination pointer
	mov	e,m
	xchg			; xfer to HL in case this is last line
	lda	vpos		; where is cursor?
	cmp	b		; if this is cursor line,
	jrz	eline		;  then we're done, so just clear it
	xchg			; put dest back in DE where it belongs
	push	h		; save position in line table
	 dcx	h
	 mov	a,m		; pick up source pointer
	 dcx	h
	 mov	l,m
	 mov	h,a
	 push	b		; save line counter
	  mvi	b,0		; we only need char count (C)
	  ldir			; copy line down
	 pop	b		; get back counter
	pop	h		; get back line pointer
	djnz	insnext		; go move next line
	dcx	h		; we only get here for top line
	mov	a,m
	dcx	h		; set up to clear it
	mov	l,m
	mov	h,a
	jmpr	eline		; go do it
;
; Delete character under cursor
;
delchr:	call	point		; get screen address
	lda	hpos
	add	a		; get # bytes from cursor to eol
	mov	c,a
	lda	linlen
	add	a
	sub	c
	mov	c,a
	mvi	b,0
	mov	e,l		; copy cursorn addr to de
	mov	d,h
	inx	h		; hl --> next char pos
	inx	h
	dcr	c
	dcr	c		; enuf bytes to move some?
	jrz	delch1
	ldir			; copy line left 2 bytes (1 char pos)
delch1:	xchg
	mvi	m,7		; make vacated position a space
	inx	h
	mvi	m,' '
	ret
;
; Insert 1 space at cursor position
;
inschr:	lda	vpos		; what line are we on?
	add	a
	mov	c,a
	mvi	b,0		; BC is offset into line address table
	lhld	ltabptr
	dad	b		; get entry from table
	mov	e,m
	inx	h
	mov	d,m		; DE is addr of beg. of line
	lda	linlen
	dcr	a		; rightmost screen cursor address
	add	a
	push	psw		; save for later
	mov	l,a
	mvi	h,0		; copy to HL
	dad	d		; gives addr of rightmost char pos
	mov	d,h
	mov	e,l
	dcx	h		; source is char to left of it
	dcx	h
	lda	hpos		; now get cursor posn
	add	a		; convert to bytes
	mov	c,a
	pop	psw		; get back bytes per line - 2
	sub	c		; compute move count
	mov	c,a
	mvi	b,0
	jrz	delch1		; skip move if at last byte
	lddr			; slide line right
	jmpr	delch1
;
; HOME the cursor to column 0, line 0
;
vhome:	sub	a		; Zap out line and column
	sta	vpos
;
; Handle carriage return, cursor column 0
;
crout:	sub	a		; Just clear horizontal position
	sta	hpos
	ret
;
; Cursor up one line
;
curup:	lda	vpos
	dcr	a
	ora	a
	rm
	sta	vpos
	ret
;
; Handle escape character
;
gotesc:	mvi	a,1		; Set escape flag
	sta	escflg
	ret			; that's all
;
; Here to process character after escape
escseq:	dcr	a		; flag=1?
	jnz	cursph		; no, must be multi-key function
	sta	escflg
	mov	a,c		; check character after escape
	cpi	esc		; function key load?
	jz	escesc
	cpi	'('		; Dim off?
	jz	dimoff
	cpi	')'		; dim on?
	jz	dimon
	cpi	'['		; reverse off?
	jz	revoff
	cpi	']'		; reverse on?
	jz	revon
	cpi	'{'		; underline off?
	jz	undoff
	cpi	'}'		; underline on?
	jz	undon
	cpi	'<'		; blink off?
	jz	blioff
	cpi	'>'		; blink on?
	jz	blion
	cpi	'E'		; Insert line?
	jz	inslin
	cpi	'F'		; Monroe attribute control?
	jz	escf
	cpi	'G'		; ADM-31 attribute control?
	jz	escg
	cpi	'R'		; Delete line?
	jz	deline
	cpi	'T'		; Erase EOL?
	jz	eeol
	cpi	'Y'		; Erase EOS?
	jz	eeos
	cpi	'*'		; Clear screen?
	jz	ehome
	cpi	'W'		; delete char?
	jz	delchr
	cpi	'Q'		; insert char?
	jz	inschr

	if	etxack
	 cpi     '+'             ; Set Etx/Ack on for list device
	 jz      etxon
	 cpi     '-'             ; Set Etx/Ack off     
	 jz      etxoff  
	endif

	cpi	'='		; Cursor address?
	rnz
	mvi	a,3		; flag waiting for cursor address
escxit:	sta	escflg		; save flag value
	ret
escesc:	mvi	a,6
	jmpr	escxit
escg:	mvi	a,4
	jmpr	escxit
escf:	mvi	a,5
	jmpr	escxit
;
; Process possible x coordinate
cursph:	dcr	a		; was flag=2?
	jrnz	curspv		; no, must be y coordinate
	mov	a,c		; get coordinate
	sui	32		; remove offset
	lxi	h,linlen	; point to line length
cursh1:	cmp	m		; make sure not out of range
	jrc	cursh2
	sub	m		; adjust and re-check
	jmpr	cursh1
cursh2:	sta	hpos		; save it
zapesc:	sub	a		; clear escape flag
	jmpr	escxit
;
; Process y coordinate
curspv:	dcr	a		; was flag=3?
	jrnz	escgv		; no, try attribute controls
	mov	a,c		; get char
	ani	31		; remove offset
cursv1:	cpi	24		; range check
	jrc	cursv2
	sui	24
cursv2:	sta	vpos		; save new row number
	mvi	a,2		; change flag for column
	jmpr	escxit
;
; Process ADM-31 attribute control (ESC G <0-7>)
escgv:	dcr	a			; was escflg=4?
	jrnz	escfv			; no, try Monroe attributes
	mov	a,c
	sui	'0'			; check for valid digit
	jrc	zapesc
	cpi	8			; must be 0-7
	jrnc	zapesc
	mov	c,a			; look up correspinding attributes
	mvi	b,0
	lxi	h,escgtbl		; in table
	dad	b
	lda	attrib			; get current attributes
	ani	40h			; preserve dim attribute
	ora	m			; include new attributes
stazap:	sta	attrib			; store new attribute byte
	jmpr	zapesc			; and terminate escape sequence
;
escgtbl:db	0,7,4,7,10h,17h,14h,17h
;
; Process Monroe attribute control (esc F <byte>)
escfv:	dcr	a			; was escflg = 5?
	jrnz	uknum			; no, try next handler
	mov	a,c			; this one's easy...just store
	jmpr	stazap			; whole byte as attributes
;
; Process downloaded function key number
; (esc esc <key# + 31> <0-7 text chars> nul)
uknum:	mov	a,c			; get key #
	ani	3FH			; restrict range
	cpi	32+nfk
	jrnc	zapesc
	mov	l,a
	mvi	h,0
	lbcd	ukptr			; base of table
	dad	h
	dad	h			; offset to this key
	dad	h
	dad	b
	shld	ukop			; save pointer for next call
	jmpr	zapesc			; now turn off escflg
;
; Enable dim character mode
dimon:	mvi	c,40h		; select dim bit
;				  and fall thru
; Set an attribute bit
atton:	lda	attrib		; get current attribute byte
	ora	c		; and set appropriate bit
	sta	attrib
	ret
;
; End dim character mode
dimoff:	mvi	c,0bfh		; select dim bit
;				  and fall thru
; Clear an attribute bit
attoff:	lda	attrib		; get attribute byte
	ana	c		; and clear appropriate bit
	sta	attrib
	ret
;
; Reverse on
revon:	mvi	c,10h
	jmpr	atton
;
; reverse off
revoff:	mvi	c,0efh
	jmpr	attoff
;
; underline on
undon:	mvi	c,08h
	jmpr	atton
;
; underline off
undoff:	mvi	c,0f7h
	jmpr	attoff
;
; blink on
blion:	mvi	c,04h
	jmpr	atton
;
; blink off
blioff:	mvi	c,0fbh
	jmpr	attoff
;
	if      etxack
;
; Set etx/ack flag on
etxon:  mvi     a,0ffh
        sta     enableetxack
        ret
;
; Set etx/ack flag off
etxoff: sub     a
        sta     enableetxack
        ret          
;
	endif
;
; Define a macro to generate table of N addresses, starting
; with B, incrementing by L.  This is what we need to build
; line address tables for screens.
ADRTBL	MACRO	B,L,N
@A	SET	B
	REPT	N
	DW	@A
@A	SET	@A+L
	ENDM
	ENDM
;
; 80-Column line address table
;
LTAB80:	ADRTBL	3000H,160,24
;
; 40-Column line address table
;
LTAB40:	ADRTBL	3000H,100H,8
	ADRTBL	3050H,100H,8
	ADRTBL	30A0H,100H,8
;
;
lconout:
	lda	iobyte		; a  := io byte
	ani	03		; check current assignment
	cpi	02
	jc	conout		; TTY: or CRT:
	jz	llist		; BAT:
				; else must be UC1:
uc1out:	sub	a		; a  := 0
	out	io$siobc	; select status register
	in	io$siobc	; a  := status register
	ani	04		; select output status bit
	jrz	uc1out		; wait until ready
	mov	a,c		; a  := output character
	out	io$siobd	; output character
	ret
;
;
; Console status routine -- returns 0FFH when char available,
; otherwise returns 00
;
lconst:
	if (interrupts and eiconst)
	 ei			; enable interrupts
	endif

	if (not interrupts)
	 call	chkmotor	; do floppy motor timing
	endif

	lda	iobyte		; dispatch to current console
	ani	03
	cpi	02
	jrc	const		; builtin console
	jrz	lrdrst		; batch (logical RDR in, logical LST out)
uc1st:	sub	a		; aux port
	out	io$siobc
	in	io$siobc
	jmpr	genst		; rest of code is common
;
lrdrst:	lda	iobyte		; get iobyte
	ani	0ch		; get reader bits
	jrz	rdrst		; it's physical reader (COMM port)
	cpi	08h		; check other possibilities
	jrc	const		; CRT
	jrz	uc1st		; AUX
lptst:	sub	a		; PRI
	out	io$drtac
	in	io$drtac
	jmpr	genst
rdrst:	sub	a		; COM
	out	io$sioac
	in	io$sioac
	jmpr	genst
;
; builtin console
const:	lhld	ukip		; function key in progress?
	mov	a,h
	ora	a
	jrz	const1		; jump if not
	mov	a,m
	ora	a		; return true unless end of funct key
	jrnz	const2
const1:
	if coninterrupt
	 lxi	h,inputpointer	; hl := console buffer pointer index
	 mov	a,m		; a  := input pointer
	 inx	h		; hl := output pointer index
	 sub	m		; compare with output pointer
	 jrnz	const2		; return true if not equal
	else
	 sub	a		; Select DART register 0
	 out	io$drtbc
	 in	io$drtbc
	endif

genst:	ani	01h		; Check data-avail bit
	rz
const2:	mvi	a,0ffh
	ret
;
; Console input routine -- waits for a char and returns it
;
lconin:	call	lconst		;check ready and motor timing
	ora	a
	jrz	lconin
	lda	iobyte		;now split to right routine
	ani	03
	cpi	02
	jrc	conin
	jz	lreader
	call	uc1in
	ani	7fh
	ret
;
;AUX port driver
uc1in:	call	uc1st
	jrz	uc1in
	in	io$siobd
	ret
;
; Built-in keyboard driver
; Note:  high bit is not stripped, since it is used to
; signify one of the special keys on the system keyboard.
conin:	lhld	ukip		; is function key active?
	mov	a,h
	ora	a
	jrz	conin1		; no, do physical read
ukin:	mov	a,m		; get next byte of func key
	inx	h		; bump pointer
	shld	ukip		; save new pointer
	ora	a		; is this terminating null?
	rnz			; return if not
	lxi	h,0		; got null, turn off function key
	shld	ukip		; and fall into normal input
conin1:	call	const		; Wait for data
	jrz	conin1

	if coninterrupt
	 lda	outputpointer	; a  := output pointer
	 mov	l,a
	 mvi	h,0		; hl := output pointer
	 lxi	d,conbuffer	; de := console buffer base
	 dad	d		; hl := character index
	 mov	c,m		; c  := character
	 inr	a		; increment pointer
	 cpi	conbuffersize	; check for overflow
	 jrc	conin1a
	 sub	a		; a  := 0 (start of buffer)
conin1a: sta	outputpointer	; update output pointer
	 mov	a,c		; get it
	else
	 in	io$drtbd	; Get it
	endif

	if	debug
	 cpi	0d4h		; monitor trap?
	 jz	0f800h
	endif

	cpi	80h		; special key?
	rc			; if not, return
	lxi	b,nfk*256+0a0h	; # of white function keys + first value
	lxi	h,fktbl		; table of same
fklup:	cmp	m		; do we have one?
	jrz	gotfk		; jump if match
	inr	c
	inx	h		; point to next key
	djnz	fklup		; loop till out of keys
	mov	c,a		; use original key
gotfk:	mov	a,c		; replace key with translated value
	cpi	0a0h+nfk
	rnc			; return if too big *** can't happen ***
	ani	3fh		; get table offset
	mov	l,a
	mvi	h,0
	lbcd	ukptr		; make pointer into user key table
	dad	h
	dad	h
	dad	h
	dad	b
	jmpr	ukin		; now fetch from table
;
; "Hardwired" function key table (white keys)
FKTBL:	DB	0CAH	; insrt lock
	DB	0C1H	; char del
	DB	0D0H	; run
	DB	0C0H	; print scrn
	DB	0D4H	; calc mode
	DB	0C7H	; home
	DB	0C5H	; up arrow
	DB	0C6H	; down arrow
	DB	0C4H	; right arrow
	DB	0C3H	; left arrow
	DB	0C2H	; line del
	DB	0D1H	; load
	DB	0D2H	; cont
	DB	0D3H	; shft calc mode
	DB	0C8H	; clear
	DB	0B5H	; cntl up arrow
	DB	0B6H	; cntl down arrow
	DB	0B4H	; cntl right arrow
	DB	0B3H	; cntl left arrow
	DB	0FFH	; stop
	DB	0A8H	; cntl backspace
	DB	0A9H	; cntl tab
NFK	EQU	$-FKTBL
;
;
;List device drivers
llist:	lda	lstsec		; a  := list time-out in seconds	|14|
	sta	lstcnt		; update list time-out counter		|14|
	call	llistwait
	lda	iobyte		; dispatch to correct driver
	ani	0c0h		; get list field
	jrz	list		; default (TTY:)
	cpi	80h
	jc	conout		; CRT:
	jz	punch		; LPT: (comm port)
	jmp	uc1out		; UC1: (aux port)
;
llistwait:
	call	llistst		; a  := llist status
	ora	a		; ready?
	rnz			; exit when ready?
	lda	lstcnt		; a  := list time-out counter
	ora	a		; time-out?
	jrnz	llistwait	; loop until time-out or ready
	lxi	h,lstmsg	; hl := print not ready message
	call	prmsg		; print message
llistlp:
	call	llistst		; a  := llist status
	ora	a		; ready?
	jnz	crlf		; terminate message and exit
	call	xconst		; a  := console status
	ora	a		; character ready?
	jrz	llistlp		; loop until ready or character entered
	call	xconin		; a  := console character
	cpi	3		; control-c?
	jrnz	llistlp		; loop if not control-c
	jmp	wboot		; abort program
;
lstmsg:	db	7,13,10,'Printer not ready',0
;
;
; Printer port driver
;
;  For etx/ack protocol, if an ESC char is found when the length
;  of the current output line is between llimit and ulimit, an Etx
;  char is sent before sending the ESC char.  Also when the length
;  reaches the ulimit, Etx is sent.
;
list:
	call	listst		; check status
	jrz	list		; wait until printer ready

	if etxack
	 lda     enableetxack	; check if etxack flag is set or not
	 ora     a       	; 0 means not set
	 jrz     list2
	 lda     lsize		; a  := current line size
	 inr     a		; increment size
	 sta     lsize		; save size
	 cpi     llimit    	; compare to lower limit
	 jrc     list2		; send character if under lower limit
	 cpi     ulimit		; compare to upper limit
	 jrnc    sendetx	; send etx if over limit
	 mov     a,c		; a  := character to be printed
	 cpi     esc     	; Check for escape sequence
	 jrz     sendetx	; send etx if escape sequence
list2:
	endif

	mov	a,c		; a  := character to send to printer
	out	io$drtad	; send character to printer
	ret			; exit

	if etxack
sendetx:			; send an etx character
	 sub	a		; a  := 0
	 sta	lsize		; current line size := 0
	 sta	enablelist	; disable listing   
	 mvi	a,etx
	 out	io$drtad	; output to printer
	 jmpr	list		; try again
	endif
;
;
; List device status returns a=0 if not ready, a=ff if ready
llistst:
	lda	iobyte		; a  := io byte
	ani	0c0h
	jrz	listst
	cpi	80h
	jrz	punst
	jrc	conost
uc1ost:	sub	a		; a  := 0
	out	io$siobc	; select status register
	in	io$siobc	; a  := io status byte
	jmpr	genost		; return output status

punst:	sub	a		; a  := 0
	out	io$sioac	; select status register
	in	io$sioac	; a  := io status
	jmpr	genost		; return output status

conost:	mvi	a,0ffh		; return all ones
	ret
;
; Normal printer port status

enablelist:	db	0ffh	; initially enabled

listst:	sub	a		; a := 0
	out	io$drtac	; select status port
	in	io$drtac	; a := list status
	ani	01h		; get input status
	jrz	list1
	in	io$drtad	; a := input character
	ani	07fh		; get an ASCII character
	cpi	xon		; check for an xon
	jrz	listxon
	cpi	xoff		; check for an xoff
	jrz	listxoff

	if	etxack
	 cpi     ack		; check for an ack
	 jrz     listxon
	endif

list1:	lda	enablelist	; check if an xoff has disabled the list device
	ora	a
	rz			; return zero if not ready (due to xoff)
	SUB	A		; a := 0
	OUT	IO$DRTAC	; select status port
	IN	IO$DRTAC	; a := list status
genost:	ANI	04h
	rz			; return zero if not ready
	mvi	a,0ffh		; return 0ffh (true) if ready
	ret

listxoff:
	sub	a		; a := 0
	sta	enablelist	; turn off the list device
	jmpr	listst		; check again

listxon:
	mvi	a,0ffh		; a := 0ffh
	sta	enablelist	; turn on the list device
	jmpr	listst

;
lpunch:	;punch character from register c
	lda	iobyte		; a  := io byte
	ani	30h		; see if punch selected
	jrz	punch
	cpi	20h		; see if console selected
	jc	conout		; console if less than 20h
	jz	uc1out		; aux: if equal to 20h
	jmp	list		; must be list device
;
; comm port output
punch:	sub	a		; a  := 0
	out	io$sioac	; select status port
	in	io$sioac	; a  := com: port status
	ani	4		; check input status bit
	jrz	punch		; wait until ready
	mov	a,c		; a  := outuput character
	out	io$sioad	; output character
	ret			; exit
;
;
lreader: ;read character into register a from reader device
	lda	iobyte		; a  := io byte
	ani	0ch		; get lower bits
	jrz	reader		; check for physical device
	cpi	08h
	jc	conin
	jz	uc1in
lptin:	call	lptst		; wait until ready
	jrz	lptin
	in	io$drtad	; output character
	ret
;
reader:	call	rdrst		; wait for reader to become ready
	jrz	reader
	in	io$sioad	; output character
	ret
;
;
;*****************************************************
;*                                                   *
;*      Sector Deblocking Algorithms for CP/M 2.2    *
;*                                                   *
;*****************************************************
;
;	utility macro to compute sector mask
smask	macro	hblk
;;	compute log2(hblk), return @x as result
;;	(2 ** @x = hblk on return)
@y	set	hblk
@x	set	0
;;	count right shifts of @y until = 1
	rept	8
	if	@y = 1
	exitm
	endif
;;	@y is not 1, shift right one position
@y	set	@y shr 1
@x	set	@x + 1
	endm
	endm
;
;*****************************************************
;*                                                   *
;*         CP/M to host (Monty) disk constants       *
;*                                                   *
;*****************************************************
blksiz	equ	2048		;CP/M allocation size
hstsiz	equ	256		;host disk sector size
hstspt	equ	16		;host disk sectors/trk
hstblk	equ	hstsiz/128	;CP/M sects/host buff
cpmspt	equ	hstblk * hstspt	;CP/M sectors/track
secmsk	equ	hstblk-1	;sector mask
	smask	hstblk		;compute sector mask
secshf	equ	@x		;log2(hstblk)
;
;*****************************************************
;*                                                   *
;*        BDOS constants on entry to write           *
;*                                                   *
;*****************************************************
wrall	equ	0		;write to allocated
wrdir	equ	1		;write to directory
wrual	equ	2		;write to unallocated
;
;*****************************************************
;*                                                   *
;*	Disk parameter blocks for drives:	     *
;*                                                   *
;*****************************************************
;
logical$size:				; CP/M records/block (see diskdef)
	rept	4			; floppy disks (4)
	 db	16			; 16 records (2048 bytes)/block
	endm
	rept	4			; hard disks (4)
	 db	16			; 16 records (2048 bytes)/block
	endm
	rept	1			; memory disk (1)
	 db	8			; 8 records (1024 bytes)/block
	endm
	rept	7			; remaining logical disks (7)
	 db	0			; not used
	endm
;
;
	disks	maxdisk			; CP/M disk parameter blocks
;
;	Floppy disk constants
;
	diskdef	0,1,32,,2048,154,64,64,3
	diskdef	1,0
	diskdef	2,0
	diskdef	3,0
;
;	Hard disk constants
;	size is (19200/8)-(48/8)=2394 useable blks			   |10|
;
	diskdef	4,0,31,,2048,2394,512,0,3
	diskdef 5,4
	diskdef 6,4
	diskdef 7,4
;
; Memory disk constants.  'mdisk$dsm' is the address of the word which
; indicates the number of block (1K bytes/block in this case) less one.
; It should have a value of 64 in a 128K system and 180 in a 256K system.
; The 'mdisk$off' is the address of the word which indicates the number
; of offset tracks which should be used.  It is 0 for a 128K system and
; 1 for a 256K system.
;
	if memorydisk

mdisk$dsm equ $+5				;		|2.27.01|

	 diskdef 8,0,63,,1024,180,32,0,1	;		|2.27.01|

clearmemorydisk	equ 16		; number of 128 byte sectors to set to E5h
				; should be number of directory entries/4
	endif
;
;
	;home the selected disk
home:
	lda	hstwrt	;check for pending write
	ora	a
	jrnz	homed
	sta	hstact	;clear host active flag
homed:
	lxi	h,0
	shld	sektrk
	ret
;
seldsk:				;select disk
	mov	a,c		;selected disk number
	ani	0fh		; make sure it there are only 16 devices
	mov	e,a
	mvi	d,0		; de := logical disk number
	lxi	h,logical$size	; hl := logical disk block size table
	dad	d		; hl := table index
	mov	a,m		; a  := logical (128 byte) records per block
	sta	records$per$block
	lxi	h,logical$disk	; hl := logical disk table
	dad	d		; hl := physical disk number index
	mov	a,m		; a  := physical disk number
	sta	sekdsk		;seek disk number 
	lxi	h,0
	cpi	maxdisk		;trap bad drive #
	rnc
	mov	l,a		;disk number to HL
	rept	4		;multiply by 16
	dad	h
	endm
	lxi	d,dpbase	;base of parm block
	dad	d		;hl=.dpb(curdsk)
	ret
;
settrk:
	;set track given by registers BC
	sbcd	sektrk		;track to seek
	ret
;
setsec:
	;set sector given by register c 
	mov	a,c
	sta	lac$sec		;sector to seek (with interlace applied)
	ret
;
setdma:
	;set dma address given by BC
	sbcd	dmaadr
	ret
;
sectran:
	;translate sector number BC
	mov	a,c
	sta	sek$sec		;save un-interlaced sector for deblock logic
	LDA	sekdsk		;check for hard disk
	CPI	4
	JRC	INTLC
	MOV	L,C
	MVI	H,0
	RET			;NO INTERLACE FOR HARD DISK 
;
INTLC:	lxi	h,xltbl
	dad	b		;look up interlaced sector
	mov	l,m
	mvi	h,0
	ret
;
;*****************************************************
;*                                                   *
;*	The READ entry point performs a 'logical'    *
;*	128-byte read with deblocking.               *
;*                                                   *
;*****************************************************
read:
	;read the selected CP/M sector

	if memorydisk
	 lda	sekdsk		; a  := select disk number
	 cpi	mdrive		;					   |10|
	 jz	memoryread	; and see if it is the memory drive	   |10|
	endif

	mvi	a,1
	sta	readop		;read operation
	sta	rsflag		;must read data
	xra	a		; a  := 0
	sta	unacnt
	mvi	a,wrual
	sta	wrtype		;treat as unalloc
	jmpr	rwoper		;to perform the read
;
;*****************************************************
;*                                                   *
;*	The WRITE entry point does a 'logical'       *
;*	128-byte write with blocking.                *
;*                                                   *
;*****************************************************
write:
	;write the selected CP/M sector

	if memorydisk
	 lda	sekdsk		; a  := select disk number
	 cpi	mdrive		;					   |10|
	 jz	memorywrite	; and see if it is the memory drive	   |10|
	endif

	xra	a		;0 to accumulator
	sta	readop		;not a read operation
	mov	a,c		;write type in c
	sta	wrtype
	cpi	wrual		;write unallocated?
	jrnz	chkuna		;check for unalloc
;
;	write to unallocated, set parameters
	lda	records$per$block	;next unalloc recs
	sta	unacnt
	lda	sekdsk			;disk to seek
	sta	unadsk			;unadsk = sekdsk
	lhld	sektrk
	shld	unatrk			;unatrk = sectrk
	lda	seksec
	sta	unasec			;unasec = seksec
;
chkuna:
	;check for write to unallocated sector
	lda	unacnt		;any unalloc remain?
	ora	a
	jrz	alloc		;skip if not
;
;	more unallocated records remain
	dcr	a		;unacnt = unacnt-1
	sta	unacnt
	lda	sekdsk		;same disk?
	lxi	h,unadsk
	cmp	m		;sekdsk = unadsk?
	jrnz	alloc		;skip if not
;
;	disks are the same
	lxi	h,unatrk
	call	sektrkcmp	;sektrk = unatrk?
	jrnz	alloc		;skip if not
;
;	tracks are the same
	lda	seksec		;same sector?
	lxi	h,unasec
	cmp	m		;seksec = unasec?
	jrnz	alloc		;skip if not
;
;	match, move to next sector for future ref
	inr	m		;unasec = unasec+1
	mov	a,m		;end of track?
	cpi	cpmspt		;count CP/M sectors
	jrc	noovf		;skip if no overflow
;
;	overflow to next track
	mvi	m,0		;unasec = 0
	lhld	unatrk
	inx	h
	shld	unatrk		;unatrk = unatrk+1
;
noovf:
	;match found, mark as unnecessary read
	xra	a		;0 to accumulator
	sta	rsflag		;rsflag = 0
	jmpr	rwoper		;to perform the write
;
alloc:
	;not an unallocated record, requires pre-read
	xra	a		;0 to accum
	sta	unacnt		;unacnt = 0
	inr	a		;1 to accum
	sta	rsflag		;rsflag = 1
;
;*****************************************************
;*                                                   *
;*	Common code for READ and WRITE follows       *
;*                                                   *
;*****************************************************
rwoper:
	;enter here to perform the read/write
	xra	a		;zero to accum
	sta	erflag		;no errors (yet)
	lda	lac$sec		;compute host sector
	rept	secshf
	ora	a		;carry = 0
	rar			;shift right
	endm
	sta	sekhst		;host sector to seek
;
;	active host sector?
	lxi	h,hstact	;host active flag
	mov	a,m
	mvi	m,1		;always becomes 1
	ora	a		;was it already?
	jrz	filhst		;fill host if not
;
;	host buffer active, same as seek buffer?
	lda	sekdsk
	lxi	h,hstdsk	;same disk?
	cmp	m		;sekdsk = hstdsk?
	jrnz	nomatch
;
;	same disk, same track?
	lxi	h,hsttrk
	call	sektrkcmp	;sektrk = hsttrk?
	jrnz	nomatch
;
;	same disk, same track, same buffer?
	lda	sekhst
	lxi	h,hstsec	;sekhst = hstsec?
	cmp	m
	jrz	match		;skip if match
;
nomatch:			;proper disk, but not correct sector
	call	checkwritehst	; check if host buffers needs to be written
;
filhst:				;may have to fill the host buffer
	lda	sekdsk
	sta	hstdsk
	lhld	sektrk
	shld	hsttrk
	lda	sekhst
	sta	hstsec
	lda	rsflag		;need to read?
	ora	a
	cnz	readhst		;yes, if 1
	xra	a		;0 to accum
	sta	hstwrt		;no pending write
;
match:
	;copy data to or from buffer
	lda	lac$sec		;mask buffer number
	ani	secmsk		;least signif bits
	mov	l,a		;ready to shift
	mvi	h,0		;double count
	rept	7		;shift left 7
	dad	h
	endm
;	hl has relative host buffer address
	lxi	d,hstbuf
	dad	d		;hl = host address
	lded	dmaadr		;get/put CP/M data
	lxi	b,128		;length of move
	lda	readop		;which way?
	ora	a
	jrnz	rwmove		;skip if read
;
;	write operation, mark and switch direction
	mvi	a,1
	sta	hstwrt		;hstwrt = 1
	xchg			;source/dest swap
;
rwmove:
	;BC initially 128, HL is source, DE is dest
	ldir
;
;	data has been moved to/from host buffer
	lda	wrtype		;write type
	cpi	wrdir		;to directory?
	lda	erflag		;in case of errors
	rnz			;no further processing
;
;	clear host buffer for directory write
	ora	a		;errors?
	rnz			;skip if so
	xra	a		;0 to accum
	sta	hstwrt		;buffer written
	call	writehst	; write buffer
	lda	erflag		; a  := result (error flag)
	ret
;
;*****************************************************
;*                                                   *
;*	Utility subroutine for 16-bit compare        *
;*                                                   *
;*****************************************************
sektrkcmp:
	;HL = .unatrk or .hsttrk, compare with sektrk
	xchg
	lxi	h,sektrk
	ldax	d		;low byte compare
	cmp	m		;same?
	rnz			;return if not
;	low bytes equal, test high 1s
	inx	d
	inx	h
	ldax	d
	cmp	m	;sets flags
	ret
;
;*****************************************************
;*                                                   *
;*	WRITEHST performs the physical write to      *
;*	the host disk, READHST reads the physical    *
;*	disk.					     *
;*                                                   *
;*****************************************************
dma$read	equ	7dh
dma$write	equ	79h
;
;
checkwritehst:
	lda	hstwrt		;host written?
	ora	a
	rz			; exit if host written
writehst:
	;hstdsk = host disk #, hsttrk = host track #,
	;hstsec = host sect #. write "hstsiz" bytes
	;from hstbuf and return error flag in erflag.
	;return erflag non-zero if error
;
	lxi	b,(fcwri� shl 8)+wrsec � se� fd� command in b and XBC in C |10|
	lxi	h,(dma$write shl 8)+05 ; DMA command and direction         |10|
	jmpr	rwhst		       ; go to common code
;
readhst:
	;hstdsk = host disk #, hsttrk = host track #,
	;hstsec = host sect #. read "hstsiz" bytes
	;into hstbuf and return error flag in erflag.
;
	lxi	b,(fcread shl 8)+rdsec ; set fdc command in b and XBC in c |10|
	lxi 	h,(dma$read shl 8)+01  ; DMA command and direction         |10|

;  and fall thru to common code
;
;***************************************************
;*                                                 *
;*      Common code for physical read/write        *
;*                                                 *
;***************************************************
;
rwhst:
	shld	dmarw		;save the dma controller command	   |10|
	lda	hstdsk		;look up the requested drive
	cpi	maxfloppy
	jnc	hdrw		;go to the hard disk driver
;
;this is the floppy driver
;
	if interrupts
	 ei			; turn on timer interrupt just in case
	endif

	LXI	H,fpycmd
	MOV	M,B   
	mov	c,a		;for this drive
	mvi	b,0
	lxi	h,trktbl
	dad	b
	mov	a,m
	out	io$fdtrk	;pass it to fdc
	mov	b,c
	inr	b		;generate shift count
	sub	a
	sta	timecntr	;disable motor timeout
	stc
nrbit:				;generate drive select bit
	adc	a
	djnz	nrbit
	mov	e,a		;save select mask
	call	motoron		;turn on motors
	jrnz	wason		;skip delay if already on
	mvi	c,0
mondly:
	xthl			;kill lots of time
	xthl
	xthl
	xthl
	djnz	mondly
	dcr	c
	jrnz	mondly
wason:
	in	io$fdst		;see if drive is alive
	ani	fsnrdy
	jrz	fpy$seek	;skip if ready
	call	drvnrdy		;else wait for user to fix it
	jmpr	mondly-2	;and give it some time to sync up
fpy$seek:
	mvi	a,maxrtr	;set retry count
	sta	fpyrtry
fpy$rsek:
	lda	hstsec		;set desired sector
	inr	a		;change 0-15 into 1-16
	out	io$fdsec
	lda	hsttrk		;set track for seek operation
	ora	a		;track 0?
	jrnz	doseek		;skip if not
	call	restore		;turn seek 0 into restore
	sub	a
doseek:
	lbcd	hstdsk		;index into track table
	mvi	b,0
	lxi	h,trktbl
	dad	b
	cmp	m		;compare to desired track
	jrz	noseek		;skip seek if already there
	inr	m		;255 means drive never accessed
	cz	restore		;do restore if first access to drive
	lda	hsttrk
	out	io$fdata	;set track # for seek
	mov	m,a		;store new track # in table
	cpi	52		;time for precompensation?
	lda	fpyctrl
	jrc	noprec		;adjust command accordingly
	ori	fdprec
noprec:
	call	newctrl		;send new control port bits
	mvi	a,fcseek+fcverf+rate	;do seek with verify
	call	xqt
	in	io$fdst		;check status
	ani	fscrc+fsrnf+fsnrdy	;check for errors
	jrz	noseek
	call	resterr		;if error, home and retry
	lda	fpyrtry
	dcr	a		;count down retries
	sta	fpyrtry
	jrnz	fpy$rsek
fpy$erx:
	mvi	a,1		;giving up...too many errors
	jmpr	hstexit
;
;come here when positioned to right track
noseek:
	mvi	a,maxrtr	;reset retry count
	sta	fpyrtry
fpy$rtr:
;	|10|
;set up for floppy dma call
	MVI	A,io$fdata	;port # for DMA command block
	MVI	C,01		;set up DMA channel mux select
;
	call	loadmar		;set up z80-dma
fpynxrw:
	lda	fpycmd		;issue read or write command
	call	xqt		; and wait for completion
	in	io$fdst
	ani	fsdlost+fscrc+fsrnf+fsnrdy+fswprot	;check for errors
	jrnz	fpy$err		;jump if error
	sub	a		;else clear error flag
hstexit:
	sta	erflag		;save error flag
	mvi	a,montime	;set up motor timeout
	sta	timecntr
	ret			;return to caller
;
;Here to home drive
restore:
	mvi	a,rate		;use normal rate
	jmpr	restx		;share code with error recovery
;
;Here to recover from seek error
resterr:
	mvi	a,rate+1	;use slower rate
restx:
	lbcd	hstdsk		;index into track table
	mvi	b,0
	lxi	h,trktbl
	dad	b
	mvi	m,0		;force track to 0
				;and fall into XQT to issue home command
;
;This routine issues fdc command and waits for IRQ
xqt:
	out	io$fdcmd	;send the command
xqtl:
	in	io$pioad	;look at irq line
	bit	4,a
	jrz	xqtl		;loop till true
	ret
;
;
;Here to recover from read or write error
fpy$err:
	lda	fpyrtry		;check retry count
	dcr	a		;bump it
	sta	fpyrtry
	jnz	fpy$rtr		;retry if not exhausted
	call	resterr		;out of retries...home drive and quit
	jmp	fpy$erx
;
;	TITLE     XEBEC-GORMAN WINCHESTER DISK **

;   03/23/82 5 MEG COMPRESSED VERSION JRT
;   08/12/82 Multi-type disks configured from boot JRT
;   ===================================
;
hdrw:			;this is the hard disk XEBEC driver
;	SELECT DRIVE
;	A= the drive to select, codes 6-7 indicate multi-volume drvs   |10|
;	C= Command Read or Write
;
;       we got here thru the logical to physical disk table and being
;	 not equal to Mdrive the only alternatives are 4,6=drive 0 5,7=drive 1
	mov	b,a		;					|10|
	cpi	maxfloppy+maxharddisk	; hard disk ?			|15|
	mvi	a,1		; a  := possible error result		|15|
	rnc			; exit if not hard disk drive		|15|
	mov	a,b		; a  := disk number			|15|
	ani	1		; resource as drive select lsb=drive 	|10|
	jrz	sdrv0
	mvi	a,drvsel1
sdrv0:	sta	dcb$drv		;set the drive to select
;
	mov	a,c
	sta	dcb$cmd		;set the read or write command
;
;GET RANDOM ADDRESS.
;	We are playing games with tracks and sectors/track
;	to avoid possible interaction with deblocking vs the floppys.
;	Even though we have 32 256 byte sectors/surface and 4 surfaces
;	CPM sees it as 32 128 byte sectors and 2*4*152 tracks  
;
;	Xebec however sees only 1 type of address, a logical sector number
;	so we must glue the tracks and sectors back together, fortunately
;	sectors/track is a power of 2
;
;	The higher capacity drives are viewed as having multiple 5 Meg
;	volumes, 6= second half of drive 0, 7=second half of drive 1
; 
	lhld	hsttrk		; hl := host track
	rept	4
	 dad	h		; hl := 16 * host track
	endm
	lda	hstsec		;Deblock thinks there are 16 sects/track
	add	l		; a  := (16 * host track) + host sector
	mov	l,a		;			|10|---------
;  Test the size of the logical address
 	xchg
	lxi	h,-19199	;the size of 5 Meg
	dad	d
	jrc	oversiz
;  Multi volume drive? The drive select is in B
	xchg
	lxi	d,19200
	bit	1,b
	jrz	notten
	dad	d
notten:
	mov 	a,l		;			|10|---------
	sta	dcb$ctrk+1	;MSB IS FIRST
	mov 	a,h
	sta	dcb$ctrk	;XEBEC IS BACKWARDS
;
;Load the DMA using code common with floppy
;
	MVI	C,DMAHD			;set up Dma mux select
	MVI	A,HD$DATA		;Port address for Dma block
;
	CALL	loadmar
;
;	Number of sectors is always 1 and is a constant in the control block
;
;         NOW COMMAND THE  CONTROLLER
;
	CALL	ACQUIRE
	JRC	HDK$DOWN
;
	LXI	H,DCB$CMD
	LXI	B,600H+HD$DATA		;COUNT 6 BYTES TO DATA PORT
HXQLP:	IN	STCS
	ANI	GCMD+DTAREQ
	JRNZ	HXQLP
	OUTI      
	JRNZ	HXQLP
;
;         CONTROLLER NOW EXECUTES  ENABLE DMA AND COMPLETION INTRPT
;
	OUT	ENDMA			;ANY VALUE
	NOP				;DO NOT REMOVE
XWAT:	IN	STCS			;CHECK IF  DONE
	ANI	CSTAT+DTAREQ
	JRNZ	XWAT			;THIS IS THE NON INTERRUPT VERSION
;
;         DO DISABLES AND CHECK STATUS
	OUT	DISDMA
	CALL	WBUSY
;
;         IF ERROR READ STATUS BYTES TO DCB FOR DEBUG
;
	JRNZ	HDK$ER
;
;	  HANDLE REQUEST COMPLETION.
;
HDK$EXIT:             
	STA	erflag
	RET				;COMPLETE REQUEST.
;
oversiz:
HDK$DOWN:
	MVI	A,1
	STA	erflag
	RET
;
; COMMON ERROR HANDLER
;
HDK$ER:     ;DO A REQUEST-SENSE TO GET INFO
	CALL	ACQUIRE
	JRC	HDK$DOWN
	MVI	A,RQSEN
	CALL	CKGCMD
	LDA	DCB$DRV
	CALL	CKGCMD
	CALL	GIVCMD
	LXI	B,400H+HD$DATA
	LXI	H,DCB$RSTA
RQDLP:	IN	STCS
	CPI	0FH			;DATA FROM CONTROLLER
	JRNZ	RQDLP
	INI       
	JRNZ	RQDLP
;
;         GET IN THE STATUS AND COMPLETION FOR RQSEN
;
	CALL	WBUSY
	LDA	DCB$RSTA
	SUI	98H			;ECC CORRECTED
	JR	HDK$EXIT		;NZ=UNRECOVERABLE ERROR.
;
ACQUIRE:
	IN	STCS		;CHECK CONTROLLER ALREADY BUSY
	ANI	CBUSY
	STC
	RZ			;low is busy
	MVI	A,1		;SELECT CONTROLLER 1
	OUT	SEL
	MVI	B,0FFH 		;AN ARBITRARY TIMEOUT
RDYLP:	IN	STCS
	ANI	CBUSY
	RZ			;RETURN OK
	DJNZ	RDYLP
	STC
	RET			;DID NOT GO BUSY--ERROR
;
;	WAIT FOR DONE ON SHORT COMMAND--TEST DRV AND GET SENSE
;
WBUSY:	IN	STCS		;Test the interface status
	ANI	CSTAT+DTAREQ
	JRNZ	WBUSY
	IN	HD$DATA		;Read in the completion status
	MOV	B,A
WDONE:	IN	STCS
	ANI	CDONE+DTAREQ
	JRNZ	WDONE
	IN	HD$DATA		;Read in the Done Byte and discard
	MOV	A,B
	ANI	ERHDK		;Set the status for test after return
	RET       
;
;
GIVCMD:	MVI	A,0
	MVI	B,4
GCLP:	CALL	CKGCMD
	DJNZ	GCLP
	RET       
;
CKGCMD:	PUSH	PSW
CKGLP:	IN	STCS
	ANI	GCMD+DTAREQ
	JRNZ	CKGLP
	POP	PSW
	OUT	HD$DATA
	RET
;
;Routine to initialize z80-dma
; at entry C= DMA mux channel to select
;      DMARW=Dma direction DMARW+1 =Read or Write DMA command, 		   |10|
;          A= >DCPORT= io$fdata or HD$DATA
;
; sets DCDIR= Direction A port or B port

loadmar:
	STA	DCPORT		;set the port address into the command tbl
	lhld	bufptr		;					   |10|
	shld	bptr		; bufptr is used by the copy utilities     |10|
	lxi	h,DMARW		;					   |10|
	mov	a,m		;					   |10|
	inx     h
	STA	DCDIR		;in the command table
;
	in	io$pioad
	ani	DMAMSK		;throw dma switch to correct controller
	ora	C
	out	io$pioad
	lxi	b,600h+io$dma	;send 6 resets to z80-dma
	mvi	a,0c3h
resdma:
	outp	a
	djnz	resdma
;
	mvi	b,dmte-dmtb	;command+address+count+table	|10|----------
	outir			;send commands to z80-dma
	ret
;
;
;z80-dma read command table
DMARW:	ds	1		;Temp for DCDIR
;
dmtb:	ds	1		;Command read or write
bptr:	ds	2		;put it here where we use it
bufcnt:	dw	256		;the count constant		|10|----------
	db	14h		;port a mem, increment addresses
	db	28h		;port b i/o, fixed addresses
	db	85h		;byte mode, next port lower
DCPORT:	DS	1		;io$fdata OR HD$DATA ;port address of fdc
	db	9ah		;ready active high
	db	0cfh		;load
DCDIR:	DS	1		;source is b, transfer only
				;01 FOR FPY->MEM, 05 FOR M->FPY 
	db	0cfh		;load
	db	087h		;enable dma (start)
dmte:
;
;
; Drive not ready error branches here
DRVNRDY:
	LDA	HSTDSK			; generate error message
	ANI	3
	ADI	'A'			; with correct drive name
	STA	DVNAME
	LXI	H,NRDYMSG		; and print it
	CALL	PRMSG
WAITRDY:
	IN	IO$FDST			; get floppy controller status byte
	ANI	FSNRDY			; check ready status
	JRZ	CRLF			; exit if it became ready
	CALL	XCONST			; check console
	ORA	A
	JRZ	WAITRDY			; loop if not ready
	CALL	XCONIN			; get response
	CALL	CRLF
PERMERR:
	LDA	IPLDSK			; Get user 0/IPL drive
	STA	CDISK			; force IPL drive selected
	JMP	WBOOT			; branch out of error
CRLF:
	LXI	H,CRLFMSG
	JMP	PRMSG			; do CR & LF
;	RET				; and go continue disk I/O
;
CRLFMSG:
	DB	13,10,0
NRDYMSG:
	DB	7,13,10,'Drive '
DVNAME	DB	0
	DB	' not ready',0
;
;
;
;Turn on the floppy motors and test if they were already on
motoron:
	lda	fpy$ctrl	;look at current control bits
	ani	0b0h		;eliminate precomp and selects
	ora	e		;get passed precomp and select
	ori	fdenab		;make sure enable remains
	bit	5,a		;test motor on bit
	setb	5,a		;and force it on
newctrl:
	sta	fpy$ctrl	;save control byte
	out	io$fdctl	;and send it
	ret
;
;Decrement motor delay count if pending...turn off if time
;

chkmotor:
	lda	timecntr	; first see if delay pending
	ora	a
	rz			; nope

	if (not interrupts)
	 lhld	timecntp	; do prescale count
	 dcx	h		; if interrupts not available
	 shld	timecntp
	 mov	a,h
	 ora	l
	 rnz			; quit unless prescale exhausted
	 lda	timecntr
	endif

	dcr	a		;count down time
	sta	timecntr
	jrz	motoroff	;kill motors if time
	cpi	montime/2	;time to kill select light?
	rnz
	lda	fpy$ctrl	;get current control byte
	ani	0f0h		;remove select bits
	jmpr	newctrl		;send new control byte

motoroff:
	lda	fpy$ctrl	;get control byte
	res	5,a		;reset motor on bit
	jmpr	newctrl		;go send it
;
;
	if memorydisk
memoryread:
	 call	checkwritehst	; write out host buffer if necessary
	 call	memorybase	; hl := memory base, a := a-segment map offset
	 lded	bufptr		; de := host buffer index (destination)
	 push	d		; save for later
	  call	memorymove	; move into host buffer, reset write flag
	 pop	h		; hl := host buffer index (source)
	 lded	dmaadr		; de := dma buffer (destination)
	 lxi	b,128		; bc := buffer size
	 ldir			; copy into dma buffer
	 jmpr	memorydone	; done transfer				|12|

memorywrite:
	 call	checkwritehst	; write out host buffer if necessary
	 lhld	bufptr		; hl := host buffer index
	 push	h		; save for later
	  xchg			; de := host buffer index (destination)
	  lhld	dmaadr		; hl := dma buffer (source)
	  lxi	b,128		; bc := buffer size
	  ldir			; copy into host buffer
	  call	memorybase	; hl := memory base, a := a-segment map offset
	  xchg			; de := memory base (destination)
	 pop	h		; hl := host buffer index (source)
memorymove:
	 lxi	b,128		; bc := block size (size)
	 di			; turn off interrupts
	  out	io$pmapa	; select memory disk into a-segment
	  ldir			; copy memory
	  lda	pmapa$current	; a  := current setting of io$pmapa
	  out	io$pmapa	; select default a-segment
	 ei			; enable interrupts
memorydone:			; succesful transfer			|12|
	 mvi	a,mdrive	; a  := mdrive				|12|
	 sta	hstdsk		; mark mdrive use of host buffer	|12|
	 sub	a		; a  := 0				|12|
	 sta	hstwrt		; reset host write  flag		|12|
	 sta	hstact		; reset host active flag
	 sta	unacnt		; reset unallocated count	|2.27.02|
	 ret			; all done (return with not errors, a = 0)

memorybase:
	; return hl = memory index, a  = map offset
	; memory index	:= 4000h + (sector * 128) + (track * 8K)
	; map offset	:= mdisk$base + (track * 8)
	;
	 lda	lac$sec		; a  := sector number (0 - 63)
	 rrc			; a  := rotate right (sector)
	 mov	h,a		; save in h
	  ani	80h		; a  := (sector mod 2) * 128
	  mov	l,a		; l  := (sector mod 2) * 128
	 mov	a,h		; h  := rotate right (sector)
	 ani	1fh		; a  := sector / 128
	 adi	40h		; add in a-segment base (4000 hex)
	 mov	h,a		; hl := memory index
	 lda	sektrk		; a  := track
	 ani	1fh		; make sure there are only 32 segments
	 add	a		; a  := track * 2
	 add	a		; a  := track * 4
	 add	a		; a  := track * 8
	 add	a		; a  := track * 16
	 aci	mdisk$base	; a  := a-segment map offset	|2.27.01|
	 rnc			; exit if no carry generated	|2.27.01|
	 inr	a		; add in carry			|2.27.01|
	 ret

	endif
;
;
;
;
;*****************************************************
;*                                                   *
;*	Unitialized RAM data areas		     *
;*                                                   *
;*****************************************************
;
;
; Macro to generate a pre-loaded function key
key	macro	str
@a	set	$+8
	db	str
	db	0
	if	$ lt @a
	ds	@a-$
	endif
	endm
;
;
; Screen driver variables
;
L80$40:	ds	1		; 40-column flag
VPOS:	ds	1		; Vertical position (line)
HPOS:	ds	1		; Horizontal position (column)
ATTRIB:	ds	1		; current character attributes
ESCFLG:	ds	1		; Nonzero if in escape sequence
LTABPTR:ds	2		; Pointer to start of line address table
LINLEN:	ds	1		; Number of characters per line
ukip:	ds	2		; Pointer to key string being read
ukop:	ds	2		; Pointer to key string being loaded
uktbl:	ds	256		; Storage for user func key strings (F1-F32)
; Pre-initialized function keys (white)
	key	'V'-40h		; insert lock
	key	'G'-40h		; del char
	key	'RUN'
	key	'P'-40h		; print screen
	key	0D4h		; calc mode
	key	'^'-40h		; home
	key	'K'-40h		; up-arrow
	key	'J'-40h		; down-arrow
	key	'L'-40h		; right-arrow
	key	'H'-40h		; left-arrow
	key	'Y'-40h		; del line
	key	'LOAD'
	key	'CONT'
	key	0D3h		; shifted calc mode
	key	'Z'-40h		; clear
	key	'E'-40h		; cntl up arrow
	key	'X'-40h		; cntl down arrow
	key	'D'-40h		; cntl right arrow
	key	'S'-40h		; cntl left arrow
	key	'S'-40h		; stop
	key	7fh		; cntl backspace
	key	'F'-40h		; cntl tab
;
SPSAVE:	ds	2		; Place to save caller's stk ptr
	ds	32
LOCLSTK	EQU	$		; Local stack area
;
;
; Blocking/deblocking driver variables
;
sekdsk:	ds	1		;seek disk number
sektrk:	ds	2		;seek track number
seksec:	ds	1		;seek sector number
lacsec	ds	1		;interlaced sector number
;
hstdsk:	ds	1		;host disk number
hsttrk:	ds	2		;host track number
hstsec:	ds	1		;host sector number
;
sekhst:	ds	1		;seek shr secshf
hstact:	ds	1		;host active flag
hstwrt:	ds	1		;host written flag
;
unacnt:	ds	1		;unalloc rec cnt
unadsk:	ds	1		;last unalloc disk
unatrk:	ds	2		;last unalloc track
unasec:	ds	1		;last unalloc sector
;
erflag:	ds	1		;error reporting
rsflag:	ds	1		;read sector flag
readop:	ds	1		;1 if read operation
wrtype:	ds	1		;write operation type
dmaadr:	ds	2		;last dma address
hstbuf:	ds	hstsiz		;host buffer
;
records$per$block:
	ds	1		; CP/M (128 byte) records/block
;
;
	ENDEF			; generate bdos data areas

	if coninterrupt
conbuffer:	ds	conbuffersize	; console interrupt buffer
	endif

end$bios:			; last label in data area
;
;
;***********************************************************************
;*                                                                     *
;*      Initialization section - the following code is used only       *
;*      during startup.  It overlays the uninitialized data areas      *
;*      to save space.                              		       *
;*                                                                     *
;***********************************************************************
;
;
	rorg	uktbl
;
; Routine to initialize the internal screen for use by CP/M
CRT$INIT:
	PUSHIX
	MVI	A,80H		; Enable text
	OUT	IO$HCOL
	MVI	A,15		; Check for presence of 6845
	OUT	IO$CRTA		;  to decide if we have 80 col. screen
	SUB	A
	STA	ESCFLG		; Not in escape sequence
	STA	ATTRIB		; No attributes set
	STA	L80$40		; Assume 80 col.
	OUT	IO$CRTD
	LXI	H,LTAB80
	SHLD	LTABPTR
	MVI	A,80
	STA	LINLEN
	IN	IO$CRTD+2	; Now see if there's a device on that port
	ORA	A		; 0 means yes, 0FFH (open circuit) means no
	JRZ	GOT80
				; Reset params for 40 col screen
	if displayclock
	 lxi	h,second$interrupt
	 mvi	m,0c9h		; put RET instruction in second$interrupt
	endif

	MVI	A,0FFH
	STA	L80$40
	LXI	H,LTAB40
	SHLD	LTABPTR
	MVI	A,40
	STA	LINLEN
GOT80:	MVI	A,5		; Get VRAM
	OUT	IO$SYS
	CALL	EHOME		; Clear and home the screen
	MVI	A,1		; Kill VRAM
	OUT	IO$SYS
	MVI	A,10
	OUT	IO$CRTA		; Put up underscore cursor
	OUT	IO$CRTD
	MVI	A,11
	OUT	IO$CRTA
	OUT	IO$CRTD
	CALL	SETCUR		; Position cursor home
	MVI	A,5
	OUT	IO$DRTBC	; Enable keyboard
	MVI	A,0E8H
	OUT	IO$DRTBC
	POPIX
	RET
;
	if	reloc
psize	equ	0
	else
psize	equ	msize
	endif
;
sgnmsg:	db	psize/10+'0',psize-psize/10*10+'0'
	db	'k CP/M vers '
	db	version+'0'
	db	'.'
	db	(revision/10)+'0'
	db	(revision mod 10)+'0'
	db	' for Monroe '
sgnms1:	db	'OC 8800'

	if production ne true
	 db	' Experimental '
	 db	(production/10)+'0'
	 db	(production mod 10)+'0'
	endif

	db	'  '
	db	(month/10)+'0'
	db	(month mod 10)+'0'
	db	'/'
	db	(day/10)+'0'
	db	(day mod 10)+'0'
	db	'/'
	db	(year/10)+'0'
	db	(year mod 10)+'0'
	db	0					; end of text
;
lstitb:		db	0,30h,1,0,2,0e8h,3,0e1h,4	; initialize list
lstibaud:	db	044h,5,0eah,0			; reg 4 is baud rate
lstitbsize	equ	$-lstitb
;
ptritb:		db	0,30h,1,0,2,0d8h,3,0c1h,4	; initialize printer
ptribaud:	db	0c4h,5,0eah,0			; reg 4 is baud rate
ptritbsize	equ	$-ptritb
;
uc1itb:		db	0,30h,1,0,2,0d0h,3,0c1h,4	; initialize user port
uc1ibaud:	db	044h,5,0eah,0			; reg 4 is baud rate
uc1itbsize	equ	$-uc1itb
;
keyitb:		db	0,30h,2,0e0h	; set interrupt vector
	if coninterrupt
	 	db	1,14h		; enable receiver interrupt w/status
	endif
		db	0
keyitbsize	equ	$-keyitb
;
;*****************************************************************
;
	rorg	loclstk
;
; Print sign-on, and initialize all I/O devices and parameters.
; Register C contains the IPL drive number in the lower nibble.
;    It also contains a flag in the ms bit: 0 = 128K machine
;                                           1 = 256K machine
;
boot:	lxi	sp,0200H	; put stack in a safe place
	mov	a,c		; a  := machine flag/boot drive
	ani	80h		; 256k machine ?
	jnz	is256k		; skip if 256k machine
	mvi	a,55		; a  := sectors on mdisk for 128k machine
	sta	mdisk$dsm	; update number of blocks in m-disk
is256k:	pushix			; save machine flag/boot drive
	pop	b		; c  := machine flag/boot drive
	mov	a,c		; remember which drive was booted
	ani	7		;					   |10|
	sta	ipldsk
	sta	cdisk		; select booted disk
	sub	a		; a  := 0
	sta	timecntr	; reset floppy motor timer
	mov	a,b
	sta	fpyctrl		;current drive control byte
	call	crt$init	;initialize crt driver
	lda	l80$40		;look at 80/40 column flag
	ani	1		;and leave in iobyte so applications
	sta	iobyte		; know screen width
	jrz	boot1
	mvi	a,'E'		;make signon reflect model number
	sta	sgnms1
boot1:
	if	interrupts
	 di
	  im2			: Vector table interrupt mode
	  mvi	a,vectortbl/256	; load interrupt base register
	  stai			; Interrupt page register := A
	  mvi	a,0f0h		; set CTC interrupt vector again
	  out	io$ctc0
	  mvi	a,start$ctc3
	  out	io$ctc3
	  mvi	a,oneslice	; setup for 20 msec interrupt
	  out	io$ctc3
;	 ei-- don't enable here get other things done first		   |10|
	endif

	lxi	h,rbaud
	mvi	a,45h
	out	io$ctc0		;set modem port baud rate
	mov	a,m
	out	io$ctc0
	inx	h
	mov	a,m		;set sio divider also
	sta	ptribaud	;					|11|
	inx	h
	mvi	a,45h
	out	io$ctc1		;set AUX port baud rate
	mov	a,m
	out	io$ctc1
	inx	h
	mov	a,m
	sta	uc1ibaud	;set sio divider too			|11|
	inx	h
	mvi	a,45h
	out	io$ctc2		;set printer baud rate
	mov	a,m
	out	io$ctc2
	inx	h
	mov	a,m
	sta	lstibaud	;set sio divider too			|11|
	lxi	b,(lstitbsize*256)+io$drtac	;			|11|
	lxi	h,lstitb	;init printer DART
	outir
	lxi	b,(ptritbsize*256)+io$sioac	;			|11|
	lxi	h,ptritb	;init rdr/pun SIO
	outir
	lxi	b,(uc1itbsize*256)+io$siobc	;			|11|
	lxi	h,uc1itb	;init alt. cons. SIO
	outir

	if interrupts
	 lxi	b,(keyitbsize*256)+io$drtbc
	 lxi	h,keyitb	;init keyboard interrupt vector
	 outir
	endif

	lxi	h,sgnmsg	;say hello to the nice folks
	call	prmsg
	lxi	h,0
	shld	ukip		;deactivate function keys
	shld	ukop
	lxi	d,7		;init them to contain their own values
	lxi	h,uktbl		;(7 chars + null per key)
	lxi	b,32*256+80H	;32 keys, values 80h thru 9Fh
zuklup:	mov	m,c		; store key value
	inx	h
	mvi	m,0		; follow with null
	dad	d		; point to next key
	inr	c		; generate next key value
	djnz	zuklup		; repeat 32 times

	if memorydisk
					; |2.27.01| -----------------------
	 di				; initialize with interrupts off
	 call	initialize$mdisk	; initialize mdisk
	 jmp	mdisk$initialized	; finish rest of system initialization

initialize$mdisk:
	 lxi	h,ccp			; hl := ccp base
	 lxi	d,4000h+100h		; de := sector 1 of track 0 (base 0)
	 lxi	b,bios-ccp		; bc := size of block to copy
	 mov	a,m			; a  := byte to put into first position
	 call	move$to$memory$disk	; copy ccp and bdos to mdisk
	 lxi	h,6000h			; hl := base of directory (track 1)
	 lxi	d,6000h+1		; de := second byte in directory
	 lxi	b,(clearmemorydisk*128)-1 ; bc := segment size to clear
	 mvi	a,0e5h			; a  := byte to clear memory with
move$to$memory$disk:
	 sta	first$mdisk$byte	; save first byte
	 mvi	a,mdisk$base		; swap in first memory disk segment
	 out	io$pmapa
	 lda	first$mdisk$byte	; a  := first byte
	 mov	m,a			; set first byte
	 ldir				; move remaining bytes
	 lda	pmapa$current		; a  := current setting of io$pmapa
	 out	io$pmapa		; select default a-segment
	 ret

first$mdisk$byte: db 0			; first byte to set in mdisk

mdisk$initialized:			; all done with mdisk
					; --------------------	|2.27.01|
	endif
;
;--|10|--
;       Set Cpm disk availability based on boot prom values
;
Ms8type	equ	1
Cpmtype	equ	2
Untype	equ	3	;formatted but not allocated
Ofltype	equ	4	;test drive says drive down at boot time

hdtype0	equ	13h	;address of data passed from prom
hdtype1	equ	23h
;			for MP/M compat. these are not used after Coldst.
;
;	First check nonexistant or allocated to MS-8
;	 if value is 55 then old boot prom, use the defaults
;
	lxi	h,hdtype0
	lxi	d,hd$drvs
	mov	a,m		;the Os type byte
	inx	h
	mov	c,m		;control byte--same for both drives
	inx	h
	cpi 	55h
	jrz	dskset		;the loaded image has constants in place
;
	mvi	b,4		;the first drive is always 4
	call	sethd		;sets the logical$disk for online and size
	lxi	h,hdtype1
	mov	a,m
	inx	h
	inx	h		;skip cntl byte--this is a XEBEC
	mvi	b,5		;the second drive is always 5
	call	sethd		;last call has incremented DE
;
;	Load the Drive type control bits to the DCB
	mov 	a,c
	sta	DCB$CTL
;							-------------------|10|
dskset:	lxi	h,wboot		;prevent this code from being accessed again
	shld	bios+1		;by changing cold boot vector to warm
	lxi	h,ccp		;select CCP cold entry point
	jmp	gocpm		;initialize and go to cp/m
;							|10|-------------------
;	Set the Logical$disk table according to the sizes
;	 A 5 Meg drive system  0=E: 1=F:
;	 A 10 Meg drive system 0=E:+F: 1=G:+H:
; Future: A 15 Meg drive system 0=E:+F:+G: 1=H:+I:+J:

sethd:	cpi	Cpmtype
	jrz	settype
	cpi	Untype
	jrz	settype
	mvi	b,0ffh		;mark it non-existant
settype:
	mov	a,b		;offline or drive #
	stax	d		;mark this drive
	inx	d
	inx	h		;skip the size MSB
	mov	a,m		;the middle byte of size
	cpi	04ah		;19200
  	rz			;can only set one partition on 5 meg 
;
	mov	a,b
	ori	2		;4+2=6,5+2=7  ff+2=ff
	stax	d		;set the second partition of drive
	inx	d
	ret			
;								-----------|10|
;
code$size equ	$-ccp
;
	if	$ lt end$bios
	ds	end$bios-$	; force MAC to show true size of BIOS
	endif
;
	end