;***************************************************************************
;* 12-8-1983			V1.9E					   *
;* DELETED RESTORE & RETRY INSERTED IN V1.9d				   *
;***************************************************************************
;* 10-24-1983			V1.9e				     WM03  *
;* CHANGED SCREEN SIZE IN 'clear2' TO 800H TO ELMINATE THE PHANTOM CURSOR  *
;*	ATTRIBUTE. COMMENTED & LEFT ORIGINAL CALCULATION FOR DOCUMENTATION.*
;***************************************************************************
;* 10-22-1983			V1.9d				     WM02  *
;* INSERTED hrestore_&retry before call nz,wrt.err & rd.err; THE ROUTINE   *
;*	WILL RESTORE DRIVE AND RETRY FUNCTION BEFORE GOING TO ERROR ROUTINE*
;* CHANGED 18 JP'S TO JR'S, ADDED 16 BYTES, NET GAIN = 2 BYTES		   *
;***************************************************************************
;* 10-21-1983			V 1.9c					   *
;* ISOLATED HARD DISK CONTROLLER RESET FROM HARD DISK RESET, MODIFIED ROM  *
;*  SO THAT THE HARD DISK CONTROLLER RESET IS ONLY PERFORMED AT POWER-UP   *
;*  OR RESET.  FIXED A BUG IN HARD DISK READY ROUTINE THAT WAS TURNING	   *
;*  ON THE FLOPPY DRIVE MOTOR AND SETTING ALL BITPORT BITS HIGH.  ALSO     *
;*  CHANGED THE SEEK SPEED OF FLOPPY RESTORE TO MATCH THE SEEK TIME (6ms). *
;*  (M. Sherman, 21-Oct-83)						   *
;***************************************************************************
;* 10-10-1983			V 1.9b				     WM01  *
;* CHANGED 12 JP'S TO JR AND ADDED A 4 SEC DELAY TO HARD DISK INITIAL RESET*
;*   HARD DISK RESET STATE HAS BEEN COMPLEMENTED TO BE COMPATABLE 	   *
;*   WITH THE IMPROVED WD 1002 CONTROLLER BOARD.			   *
;* IN 'seekcmd' STEP RATE CHANGED TO BE 6mS, THE SAME AS THE II & THE IV.  *
;* range of program 0000 - 0FFEH, added 11 bytes, net gain = 1 byte.	   *
;***************************************************************************
;
;***************************************************************************
;* INLINE ASSEMBLY OF BIOS MODULES	W. MCKINLEY	8-12-83  16:00	   *
;***************************************************************************
;
IF1
.PRINTX / 12-08-83 INLINE BIOS MODIFIED FOR IMPROVED WD-1002 CONTROLLER, SEEK = 6mS /
.PRINTX / VERSION 1.9E /
ENDIF
;
IF2
.PRINTX / PASS 2 /
ENDIF
;
title System scratch RAM used by ROM software and OVL.  (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty                                 ##
##                                                    ##
##      System scratch RAM used by ROM & OVL software ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
%
.z80


ovlram		equ	0EE00H	; overlay ram

wrt.err	equ	ovlram		; write sector error handler
rd.err	equ	wrt.err+3	; read sector error handler
pixon	equ	rd.err+3	; plot a pixel
pixoff	equ	pixon+3		; erase a pixel
lineon	equ	pixoff+3	; draw a line
lineoff	equ	lineon+3		; erase a line

ramscratch	equ	0F700H	; scratch ram

dsktyp	equ	ramscratch	;hard or floppy disk currently selected flag
adsk	equ	dsktyp+1	;hard or floppy is A: flag
sectrk	equ	adsk+1		;sectors per track
@sekdsk	equ	sectrk+1	;seek disk number
@sektrk	equ	@sekdsk+1	;seek track number
@seksec	equ	@sektrk+2	;seek sector number
@hstdsk	equ	@seksec+1	;host disk number
@hsttrk	equ	@hstdsk+1	;host track number
@hstsec	equ	@hsttrk+2	;host sector number
@sekhst	equ	@hstsec+1	;seek shr secshf
@hstact	equ	@sekhst+1	;host active flag
@hstwrt	equ	@hstact+1	;host written flag
@unacnt	equ	@hstwrt+1	;@unalloc rec cnt
@unadsk	equ	@unacnt+1	;last @unalloc disk
@unatrk	equ	@unadsk+1	;last @unalloc track
@unasec	equ	@unatrk+2	;last @unalloc sector
@erflag	equ	@unasec+1	;error reporting
@rsflag	equ	@erflag+1	;read sector flag
@readop	equ	@rsflag+1	;1 if read operation
@wrtype	equ	@readop+1	;write operation type
@dmaadr	equ	@wrtype+1	;last dma address
@hstbuf	equ	@dmaadr+2	;host buffer
@move	equ	@hstbuf+512	;move routine for deblocking
@dirbuf	equ	@move+15	;directory buffer for hard disk
@alva	equ	@dirbuf+128	; alocation map for hd A
@alvb	equ	@alva+162	; alocation map for hd B
@dpha	equ	@alvb+162	; dph for hd A
@dphb	equ	@dpha+16	; dph for hd B
@dpbh	equ	@dphb+16	; dpb for hd
sekdsk	equ	@dpbh+15	;seek disk number
sektrk	equ	sekdsk+1	;seek track number
seksec	equ	sektrk+2	;seek sector number
hstdsk	equ	seksec+1	;host disk number
hsttrk	equ	hstdsk+1	;host track number
hstsec	equ	hsttrk+2	;host sector number
sekhst	equ	hstsec+1	;seek shr secshf
hstact	equ	sekhst+1	;host active flag
hstwrt	equ	hstact+1	;host written flag
unacnt	equ	hstwrt+1	;unalloc rec cnt
unadsk	equ	unacnt+1	;last unalloc disk
unatrk	equ	unadsk+1	;last unalloc track
unasec	equ	unatrk+2	;last unalloc sector
erflag	equ	unasec+1	;error reporting
rsflag	equ	erflag+1	;read sector flag
readop	equ	rsflag+1	;1 if read operation
wrtype	equ	readop+1	;write operation type
dmaadr	equ	wrtype+1	;last dma address
hstbuf	equ	dmaadr+2	;host buffer
dsk	equ	hstbuf+512	; current disk drive
sidflg	equ	dsk+1		; single/double sided flag
csva	equ	sidflg+1	; directory check
alva	equ	csva+16		; allocation map
leadflg	equ	alva+25
; video graphics data storage
vidram	equ	leadflg			; initialization pointer
crow	equ	leadflg+1
ccol	equ	crow+1
vatt	equ	ccol+1
cursor	equ	vatt+1
vrbase	equ	cursor+2
esccmd	equ	vrbase+2
precur	equ	esccmd+1
ramlen	equ	12			; number of bytes to initialize
col	equ	precur+2
col2	equ	col+1
row	equ	col2+1
row2	equ	row+1
onoff	equ	row2+1
newc	equ	onoff+1
pix	equ	newc+1
saddr	equ	pix+1
xoff	equ	saddr+2
yoff	equ	xoff+1
difx	equ	yoff+1
dify	equ	difx+1
vgb1	equ	dify+1
dpha	equ	vgb1+1		; DPH for A
$dpb	equ	dpha+16		; single density dpb
adrbuf	equ	$dpb+15		; read address buffer
move	equ	adrbuf+6	; move logical sector from hstbuf
rd128	equ	move+15		; routine to read 128 byte sector
rd512	equ	rd128+7		; routine to read 512 byte sector
wrt128	equ	rd512+10	; routine to write 128 byte sector
wrt512	equ	wrt128+7	; routine to wrtie 512 byte sector
rdwrtend equ	rd128+145	; end of read and write routines
dirbuf	equ	rdwrtend+1	; bdos directory buffer

stack	equ	0FFFFH		; boot up stack space
title Cold start routines.    (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty                                 ##
##                                                    ##
##      Cold start routine, reset and configure       ##
##      system for power up condition.                ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
#							#
#	Modified for proper error handling on first	#
#	 attempts to load the overlay (which has the	#
#	 error message reporting calls in it.)		#
#	 (M. Sherman, 17-Jun-83)			#
#	Modified for proper response to the floppy	#
#	on power-up/reset by M. Sherman on 8-Jun-83	#
#							#
#########################################################
%
;
ovlram	equ	0EE00H		; load address for overlay
hdsel	equ	0		; hard disk is A: flag
fsel	equ	-1		; floppy is A: flag
status	equ	10H		; floppy status port (to look for index)

	.z80

; ROM master jump table

jp	start		; start up computer
jp	diskinit	; disk initialize
jp	vidinit		; video initialize
jp	devinit		; device initialize

jp	home_dispatch	; home selected disk drive
jp	seldsk		; select a disk drive
jp	settrk		; seek a track
jp	setsec		; set sector number to read
jp	setdma		; set dma address
jp	read		; read logical sector
jp	write		; write logical sector
jp	sectran		; xlate sector number
jp	diskon		; turn on disk
jp	diskoff		; turn off disk

jp	kbdstat		; KeyBoarD character ready
jp	kbdin		; input from keyboard
jp	kbdout		; output to keyboard (used to ring bell)
jp	ttystat		; status of serial input port
jp	ttyin		; serial input
jp	ttyout		; serial output
jp	liststat	; list output status (Centronics)
jp	list		; list output
JP	TTYOSTAT	;TESTSTATUS OF SERIAL OUTPUT
jp	vidout		; video output
jp	thnsd		; short delay

start:	di			; stop interupts while setup
	ld	sp,stack	; rom stack point
	ld	b,20		; a delay to let the hardware stabilize
	call	thnsd		; 20 milli-seconds worth.
	call	devinit		; init device sub-system
	call	vidinit		; init video sub-system
	call	hdcinit		; hard disk controller initialization
	call	diskinit	; init disk sub-system
	jr	bootsys		; boot system
	org	66H		; nmi vector
	ret			; return from "halt", NMI sequence when in rom
page
; boot system, the first sector (1) of the first track (0)
; hold system boot information. It does NOT hold a short boot routine!
; the image is:
;	self:	jr	self	; hang if booted and run
;		defw	loadpt	; where to load the opsys image
;		defw	bios	; where to go after booting system
;		defw	length	; length of image in 128 byte sectors
;	(* the rest of the sector is not used *)
;
; This sector image is loaded and inspected at 0FA00H during the boot process

esc	equ	1BH		; ascii esc

bootsys:call	print
	defb	esc,'=',20H+10,20H+31
	defb	'* KAYPRO 10 v 1.9E *',0
;	DEFB	' BETA TEST ROM V 1.7a',0
doagain:call	check		; is floppy alive?
	ld	a,hdsel		; parms for hard disk
	ld	(adsk),a
	ld	a,68
	ld	(sectrk),a
	jr	z,loadit
	ld	a,fsel		; parms for floppy
	ld	(adsk),a
	ld	a,40
	ld	(sectrk),a
loadit:	call	ovload		; load overlay
boot:	ld	c,0
	call	seldsk		; select disk, set density, do home after diskinit
	ld	bc,0		; set track
	call	settrk
	ld	c,0		; read the first sector
	call	setsec
	ld	bc,0FA00H	; header sector to go here
	call	setdma
	call	read		; read sector to FA00
	di			; read does EI upon exit
	or	a		; trouble reading?
	jr	nz,doagain	; tell crt
	ld	bc,(0FA02H)	; where to load system image
	ld	a,c		; system image?
	cp	0E5H
	jr	z,doagain
	ld	(@dmaadr),bc
	ld	(dmaadr),bc
	ld	bc,(0FA04H)	; where to go after loading system
	push	bc		; save for latter use
	ld	bc,(0FA06H)	; length of system in 128 byte sectors
	ld	b,c		; reg B holds # of sectors to load
	ld	c,1		; initial sector (0 was header sector)
cb1:	push	bc		; save sector count and current sector
	call	setsec		; select sector
	call	read
	di			; read does EI upon exit
	pop	bc
	or	a
	jr	nz,doagain	; bad read of sector
	ld	hl,(@dmaadr)	; update dma address for next sector
	ld	de,128		; new dma address
	add	hl,de
	ld	(@dmaadr),hl
	ld	(dmaadr),hl
	dec	b
	ret	z		; done booting goto system
	inc	c		; bump sector count
	ld	a,(sectrk)	; over sectors/track?
	cp	c
	jr	nz,cb1		; fetch another sector
	ld	c,16		; first sector to read on next track
	push	bc		; save counts
	ld	bc,1		; set for next track
	call	settrk
	pop	bc
	jr	cb1

check:	call	fndidx		; find index pulse
	ret	z		; no index, abort
	ld	b,8		; delay while waiting for index to go away
	call	thnsd		; 8 MS
	in	a,(status)
	cpl
	bit	1,a		; 0=no floppy, 1=floppy
	ret

fndidx:	call	$home		; home floppy
	ld	hl,9000H
lp1:	in	a,(status)	; index pulse?
	bit	1,a
	ret	nz		; index is nz, return if true
	dec	hl		; enough tries?
	ld	a,h
	or	l
	jr	nz,lp1
	ret

ovload:	call	filhdr		; set up bogus error reporting system
	ld	a,(adsk)	; is it possible to load overlay?
	or	a		; is not possible if hard disk is drive B:
	jr	z,loadovl	; go load overlay from hard disk

filhdr:	ld	hl,ovlram	; base of overlay, fill with no.op
	ld	b,16		; *16 [or a, nop, ret]
lp2:	ld	(hl),0B7H	; [or a]
	inc	hl
	ld	(hl),0		; [nop]
	inc	hl
	ld	(hl),0C9H	; [ret]
	inc	hl
	djnz	lp2
	ret

loadovl:ld	c,1		; select drive B:
	call	seldsk
	ld	bc,0		; track = 0
	call	settrk
	ld	hl,ovlram	; set dma address
	ld	(@dmaadr),hl
	ld	bc,0		; sector #
ldlp:	push	bc
	call	setsec
	call	read		; read sector
	pop	bc
	or	a
	jr	nz,filhdr	; fault, set up bogus overlay, exit.
	ld	hl,(@dmaadr)	; update dma address
	ld	de,128
	add	hl,de
	ld	(@dmaadr),hl
	inc	c
	ld	a,c
	cp	16		; load 2K sec# 0-15
	jr	nz,ldlp
	ld	a,(ovlram)	; check for a jp inst
	cp	0C3H
	jr	nz,filhdr	; bad data in ram, fill header with default
	ret

title System device I/O routines.   (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty                                 ##
##                                                    ##
##      System device I/O routines                    ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
%
.z80

	public	kbdstat, kbdin, kbdout, ttystat, ttyin, ttyout, TTYOSTAT
	public	liststat, list, devinit


;***************
;* sio equates *
;***************

sio	equ	04H	; base address of sio
sioa0	equ	sio+2	; channel a command/status
sioa1	equ	sio+0	; channel a data
siob0	equ	sio+3	; channel b command/status
siob1	equ	sio+1	; channel b data
sioc0	equ	sio+10	; channel a command/status
sioc1	equ	sio+8	; channel a data
siod0	equ	sio+11	; channel b command/status
siod1	equ	sio+9	; channel b data

; write registers 0-7 and control bits
; init registers in the following order 0,2,4,3,5,1

WR0	equ	0	; command register, crc reset, reg pointer
; bits 0-2 are register pointers to WRx and RRx
; bits 3-5 and commands as given bellow
null	equ	0	; null command
extrset	equ	10H	; reset ext/status interrupts
reset	equ	18H	; channel reset
ienrc	equ	20H	; Enable Int on Next Rx Character
rtip	equ	28H	; disable transmitter (prevents buffer empty int.)
			; and enable break (prevents under-run int.)
			; (note: since the transmitter is disabled,
			;  no break characters are transmitted.)
			; (also note:  Transmitter output is High-Z,
			;  which is neither high nor low (niether 'Mark'
			;  nor all zero's.  Value dependent upon pullup
			;  or pull down resistors or other external loading
			;  factors.) )
			; (note:  Auto Turnaround is also enabled.)
errset	equ	30H	; error reset

WR1	equ	1H	; interrupt enable and Wait/Ready modes
esie	equ	1H	; external/status interrupt enable
tie	equ	2H	; transmitter interrupt enable
tid	equ	0	; transmitter interrupt disable
statav	equ	4H	; Status affects vector (z80 mode 2) (see WR2)
; bits 3-4 affect receive interrupt mode
rid	equ	0	; receive interrupts disabled
rifc	equ	8H	; receive interrupt on first char only
riep	equ	10H	; recv interrupts enabled, parity err Special Recv Cond
rie	equ	18H	; same as riep but parity error not Special Recv Cond

WR2	equ	2	; interrupt vector address/pointer (chan b only)
; interrupt address (z80 reg I+WR2=interrupt address)
; returned as is if not statav above in wr1
; if statav then bits 1-3 are modified as bellow:
;	000	ch b transmit buffer empty
;	001	ch b external/status change
;	010	ch b receive char available
;	011	ch b special receive condition (parity error, Rx overrun,
;			framing error, end of frame(sdlc) )
;	1xx	ch a (* same vectors as for channel b above *)

WR3	equ	3	; receiver logic control and parameters
re	equ	1	; receiver enable
autoe	equ	20H	; auto enable (use dcd and cts to enable recv and xmt
; bits 6-7 are receiver bits/character
rbits5	equ	0	; 5 bits/character
rbits7	equ	40H	; 7 bits/character
rbits6	equ	80H	; 6 bits/character
rbits8	equ	0C0H	; 8 bits/character

WR4	equ	4	; control bits that affect both xmt and recv
pon	equ	1	; enable parity (parity on)
pstate	equ	2	; parity even   not pstate = parity odd
; bits 2-3 are number of stop bits
syncmd	equ	0	; sync mode is to be selected
sbits1	equ	4	; 1 stop bit
sbits5	equ	8H	; 1.5 stop bits
sbits2	equ	0CH	; 2 stop bits
; bits 6-7 control clock rate
cr1	equ	0	; data rate x1=clock rate
cr16	equ	40H	;           x16
cr32	equ	80H	;           x32
cr64	equ	0CH	;           x64

WR5	equ	5	; control bits that affect xmt
te	equ	8H	; transmit enable
break	equ	10H	; send break
; bits 5-6 are number of bits/character to transmit
tbits5	equ	0	; 5 or less bits/character
tbits7	equ	20H	; 7 bits/character
tbits6	equ	40H	; 6 bits/character
tbits8	equ	60H	; 8 bits/character
rts	equ	2	; RTS output
dtr	equ	80H	; DTR output

WR6	equ	6	; sdlc transmit sync character
WR7	equ	7	; sdlc receive sync character

; read registers 0-2 and status bits
rr0	equ	0	; general recv and xmt status
rca	equ	1	; receive character available
intped	equ	2	; interrupt pending (ch a only)
tbe	equ	4	; transmit buffer empty
synhnt	equ	10H	; sync/hunt
dcd	equ	8H	; DCD input
cts	equ	20H	; CTS input
xmtundr	equ	40H	; transmit underrun/ EOM
brk	equ	80H	; break/abort status

rr1	equ	1	; Special Receive conditions and Residue codes
; bits 4-7 are special receive conditions
rpe	equ	10H	; parity error
rovr	equ	20H	; Rx overrun error
framerr	equ	40H	; framing error

rr2	equ	2	; interrupt vector address/pointer

pdat	equ	24	; cent out data port (8 bit latch)

bitport	equ	20	; system bit port for status and control
;0 floppy drive 0 select:  0=select, 1=deselect.
;1 floppy drive 1 select / hard disk controller reset:
;  0=floppy drive 1 select / hard disk controller reset,
;  1=floppy drive 1 deselect / hard disk controller enable,
;2 floppy drive side select line:  0=side 1, 1=side 0.
;3 parallel port output line, used (for example) for centronics data strobe.
;4 floppy motor control:  0=motor off, 1=motor on.
;5 floppy controller density select, 0=double density, 1=single density.
;6 parallel port input line, used (for example) for centronics busy line.
;7 bank select:  0=64K ram only, 1=rom, video ram and upper 32k ram select.

;***************
;* baud rate   *
;***************

bauda	equ	00H	; baud rate generator for serial chan a (modem)
baudb	equ	08H	; baud rate generator for serial chan b (printer)

; baud rate factors, output to baudx to select baud rate
baud10	equ	02H	; 110 baud rate
baud30	equ	05H	; 300 baud rate
baud12	equ	07H	; 1200 baud rate
baud24	equ	0AH	; 2400 baud rate
baud48	equ	0CH	; 4800 baud rate
baud96	equ	0EH	; 9600 baud rate
baud19k	equ	0FH	; 19.2k baud rate
subttl I/O configuration tables
page

iotbint:defb	reset			; reset sio channel
	defb	wr4
	defb	sbits1 or cr16		; one stop bit, 16x clock
	defb	wr3
	defb	re or rbits8		; recv enable, 8 bits/char
	defb	wr5
	defb	te or tbits8 or dtr	; xmt enable, 8bits/char, assert dtr
	defb	wr1
	defb	tid or rid		; xmt & recv interrupts disabled
iotbend:

tblen	equ	iotbend-iotbint		; table length

devinit:ld	a,0cfh		; reset hard disk controller CF=(1100111)
	out	(bitport),a	; initialize bitport		      ^	
	ld	c,siob0
	call	tblout		; initialize channel
	ld	c,sioc0
tblout:	ld	hl,iotbint
	ld	b,tblen
	otir
	ret

subttl Device I/O handlers
page
kbdstat:in	a,(siob0)	; kbd char avail?
	and	rca
comout:	ld	a,0
	ret	z		; 0=no char
	ld	a,0FFH		; FF=char avail
	ret

kbdin:	call	kbdstat		; loop till char avail
	jr	z,kbdin
	in	a,(siob1)	; get char
	call	kbdmap		; map out funny chars of vector pad and #'s
	ret

kbdout:	in	a,(siob0)	; xmit buffer empty?
	and	tbe
	jr	z,kbdout
	ld	a,c		; out character
	out	(siob1),a
	ret

kbdmap:	ld	hl,mapin	; input map table
	ld	bc,mapout-mapin	; table length
	cpir			; search table
	ret	nz		; not found
	ld	de,mapin	; make hl=table index
	or	a		; hl-mapin=index
	sbc	hl,de
	ld	de,mapout-1	; index
	add	hl,de
	ld	a,(hl)		; get char from mapout
	ret

mapin:	defb	0F1H, 0F2H, 0F3H, 0F4H	; up, down, left, right arrows
	defb	0B1H, 0C0H, 0C1H, 0C2H	; 0,1,2,3
	defb	0D0H, 0D1H, 0D2H, 0E1H	; 4,5,6,7
	defb	0E2H, 0E3H, 0E4H, 0D3H	; 8,9, '-', ','
	defb	0C3H, 0B2H		; return, '.'
	defb	0FFH			; end of mapin table
mapout:	defb	80H, 81H, 82H, 83H	; vector pad, xlate in bios
	defb	84H, 85H, 86H, 87H
	defb	88H, 89H, 8AH, 8BH
	defb	8CH, 8DH, 8EH, 8FH
	defb	90H, 91H

ttystat:in	a,(sioc0)		; serial port status input
	and	rca
	JR	COMOUT

ttyin:	call	ttystat			; is a char ready?
	jr	z,ttyin
	in	a,(sioc1)
	ret

ttyout:	in	a,(sioc0)		; output a char to serial port
	and	tbe
	jr	z,ttyout		; xmit buffer full?
	ld	a,c
	out	(sioc1),a		; xmit character
	ret

;
TTYOSTAT:	;TEST STATUS OF SERIAL OUTPUT
	IN	A,(SIOD0)
	AND	TBE			;TX BUF FULL ?
	JR	COMOUT
;
; list port centronics equates
pready	equ	6			; bit in bit port
pstrob	equ	3			; bit in bit port

liststat:in	a,(bitport)		; centronics printer port status
	bit	pready,a
	ld	a,0
	ret	nz			; 00=busy
	ld	a,0FFH			; FF=ready
	ret

list:	call	liststat		; is printer busy?
	jr	nz,list
	ld	a,c
	out	(pdat),a		; output char to printer
	in	a,(bitport)		; strb. printer
	res	pstrob,a
	out	(bitport),a
	set	pstrob,a
	out	(bitport),a
	ret

title Dispatch to hard disk or floppy drive.   (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty                                 ##
##                                                    ##
##      Dispatch to hard disk or floppy drive         ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
%
	.z80


fsel	equ	-1

dispatch macro x, y
	.xlist
	ld	a,(dsktyp)
	cp	hdsel
	jp	z,x
	jp	y
	.list
	endm

home_dispatch:	dispatch @home,$home
settrk:	dispatch @settrk,$settrk
setsec:	dispatch @setsec,$setsec
read:	dispatch @read,$read
write:	dispatch @write,$write

seldsk:	ld	a,(adsk)		; hard disk = A:?
	cp	hdsel
	jr	nz,s2			; if not then floppy=A:, hd=B: & C:
	bit	1,c			; selecting hard of floppy
	jr	nz,s1
	ld	a,hdsel			; set hard disk as selected drive
	ld	(dsktyp),a
	jp	@seldsk
s1:	ld	a,fsel			; set floppy as selected drive
	ld	(dsktyp),a
	xor	a
	ld	c,a
	jp	$seldsk
s2:	ld	a,c			; selecting floppy or hard
	or	a
	jr	z,s3			; floppy
	sub	1			; hard disk is B: or C: xlate to 0,1
	ld	c,a
	ld	a,hdsel			; set hard disk as selected drive
	ld	(dsktyp),a
	jp	@seldsk
s3:	ld	a,fsel			; set floppy disk as selected drive
	ld	(dsktyp),a
	jp	$seldsk

setdma:	push	bc		; save dmaadr
	call	@setdma		; set hd dmaadr
	pop	bc
	jp	$setdma		; now go do floppy

diskinit:call	@diskinit	; do hd
	jp	$diskinit	; now floppy

diskoff:call	@diskoff	; do hd
	jp	$diskoff	; now floppy

title Hard disk support routines.    (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty & M. Sherman                    ##
##                                                    ##
##      Disk support routines (Deblocking hard disk)  ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
#							#
#	Current revision:	1.9	20-Jun-83	#
#	Previous revision:	1.8	17-Jun-83	#
#	Previous revision:	1.7a	13-Jun-83	#
#	Previous revision:	1.7	08-Jun-83	#
#	Previous revision:	1.5	15-May-83	#
#							#
#	Changes:  SEKOK tests drive ready as well as	#
#	 seek complete.  G. Ohynsty, revision 1.9	#
#	Changes:  SEKOK inserted into READY, which was	#
#	 the only routine using it.  4 bytes saved.	#
#	 M. Sherman, revision 1.8.			#
#	Changes:  DISKOFF now de-selects the hard disk	#
#	 by using a drive select mask on HDSEL to	#
#	 select drive 0, instead of using an "or 10h"	#
#	 to select drive 3.  Reasons:  Drive 3 is the	#
#	 floppy controller on the WD 1002 board, which	#
#	 isn't installed and always returns a 'drive	#
#	 ready" status.  This messes up DISKOFF, which	#
#	 then tells the WD 1002 board to seek the floppy#
#	 to track 305 (which it does) and wait until	#
#	 it's done, about .75 seconds later.		#
#	  Drive 0 was selected as the alternate because:#
#	1) We try not to use that drive for reliability	#
#	 purposes, and					#
#	2) We can't get a cable over that connector on	#
#	 the WD 1002 board, anyway.  (M. Sherman,	#
#	 version 1.7a)					#
#	Changes:  SEKOK modified to call HDBSY first,	#
#	 ( status bits are invalid if the controller	#
#	   is busy ) DISKOFF modified to call HDBSY	#
#	 instead of SEKOK.  (M. Sherman, version 1.7)	#
#	Changes:  DISKINIT now re-enables the hard	#
#	 disk controller immediately after resetting	#
#	 it.  ( A potential problem was discovered with	#
#	 holding the board in a reset state for long	#
#	 periods of time )				#
#							#
#########################################################
%
.z80


public	@home, @seldsk, @settrk, @setsec, @setdma, @read, @write
public	@diskinit, @diskoff


bitport	equ	20		; bit port (m80 does not support extrn bytes)
retcod	equ	0C9H		; return op code
nmivec	equ	0066H		; non-maskable interupt vector (used in rd/wt loop)

; Hard Disk Definitions:

;ports:
hdbase	equ	80h

hddata	equ	hdbase		; data register
hdetyp	equ	hdbase+1	; error type register
hdwrtp	equ	hdbase+1	; write precomp cylinder/4
hdscnt	equ	hdbase+2	; number of sectors count
hdsec	equ	hdbase+3	; first sector to read/write
hdclo	equ	hdbase+4	; cylinder number low byte
hdchi	equ	hdbase+5	; cylinder number high byte
hdsdh	equ	hdbase+6	; size/drive/head register
hdcmd	equ	hdbase+7	; command register
hdstat	equ	hdbase+7	; status register

;commands:

longrw	equ	00000010b	; long read/write bit
multrw	equ	00000100b	; multiple read/write bit
hddmam	equ	00001000b	; dma mode on read bit
rt35uS	equ	00000000b	; 035 uS step rate (fastest)
rt05mS	equ	00000001b	; 0.5 mS step rate (rest in inc. of this one)
rt10mS	equ	rt05mS*2	; 1.0 mS step rate
rt30mS	equ	rt05mS*6	; 3.0 mS step rate
rt60mS	equ	rt05mS*12	; 6.0 mS step rate
rt75mS	equ	rt05mS*15	; 7.5 mS step rate (slowest)
eccmod	equ	10000000b	; error correcting mode
sec512	equ	00100000b	; 512 byte sector size
hdselh	equ	10101000b	; select hard disk drive
hdsmsk	equ	11100111b	; drive select mask
hdinir	equ	00010000b+rt60mS ; restore used for initialization
hdrstr	equ	00010000b+rt05mS ; restore used for normal home command
hdseek	equ	01110000b+rt35uS ; fast seek
hdred	equ	00100000b	 ; read sector
hdredl	equ	00100000b+longrw ; long read (sector + ECC bytes)
hdwrt	equ	00110000b	 ; write sector
hdwrtl	equ	00110000b+longrw ; long write (sector + ECC bytes)

; hard disk info
lzone	equ	305	; safety zone
maxcyl	equ	305	; same as safety zone (see dsm)

; for use with bitport

hdcres	equ	00000010b	; hard disk controller reset mask	wm01
hdcsel	equ	11111101b	; hard disk controller select bit	wm01

page
; This section defines the disk parameters (dph's are images @moved to RAM)
dph0h:	defw	0,0,0,0		; dph for unit A:
	defw	@dirbuf,@dpbh	; directory buffer, Disk Parameter Block
	defw	0, @alva		; check sum pointer, allocation map pointer

	defw	0,0,0,0		; dph for unit B:
	defw	@dirbuf,@dpbh	; directory buffer, Disk Parameter Block
	defw	0, @alvb	; check sum pointer, allocation map pointer

;@dpbh:
	defw	68		; (spt) sectors per track
	defb	5		; (bsh) block shift factor
	defb	31		; (blm) block mask
	defb	1		; (exm) extent mask
	defw	1125		; (dsm) max logical block # (max 1282)
				; dsm is 1125 to allow for safety zone
	defw	1023		; (drm) max directory #
	defb	0FFH		; (al0) directory allocation map
	defb	00H		; (al1)
	defw	0		; (cks) size of directory check vector
	defw	4		; (off) reserved tracks

enddphh:
subttl Logical BIOS entry points & Deblocking
page
.8080
;*****************************************************
;*      Logical BIOS entry points                    *
;*      Sector Deblocking Algorithms                 *
;*****************************************************
blksizh	equ	4096		;CP/M allocation size
hstsiz	equ	512		;host disk sector size
hstspth	equ	17		;host disk sectors/trk
hstblk	equ	hstsiz/128	;CP/M sects/host buff
cpmspth	equ	hstblk * hstspth ;CP/M sectors/track
secmsk	equ	hstblk-1	;sector mask
secshf	equ	2		;log2(hstblk) sector mask
wrall	equ	0		;write to allocated
wrdir	equ	1		;write to directory
wrual	equ	2		;write to unallocated

.z80
hdcinit:
	; reset hard disk controller on power-up and hold it there
	; until the controller is properly powered up (100 milliseconds
	; to 2 seconds) and the hard disk unit is stabilized (1 to 3 seconds)
	in	a,(bitport)	; reset controller
	or	hdcres		; reset if bit 1 = 1			wm01
	out	(bitport),a
	push	af		; save a				wm01
;
;decrement b's A0h and dec b through [100H = (256)] - (02 - first dec) time
;
	ld	bc,0A002H	; delay four seconds  [(01x100H)+A0H)]	wm01
delay4:	call	thnsd		; delay loop (each b bit = .001 sec)	wm01
	dec	c		; done					wm01
	jr	nz,delay4	; jif not done				wm01
	pop	af		; retrieve acc				wm01
	and	hdcsel		; select if bit 1 = 0			wm01
	out	(bitport),a	; select controller
	ret

@diskinit:	;enter here on system boot to initialize
	ld	hl,ioimageh	;@move rd/wrt routines into RAM
	ld	de,@move
	ld	bc,image_length
	ldir
	ld	hl,dph0h		; set dph's
	ld	de,@dpha
	ld	bc,enddphh-dph0h
	ldir
.8080
	xra	a		;0 to accumulator
	sta	@hstact		;host buffer inactive
	sta	@unacnt		;clear unalloc count
	ret

@seldsk:			;select disk
	mov	a,c		;selected disk number
	sta	@sekdsk		;seek disk number
	lxi	h,0		;does disk exist?
	cpi	2
	rnc
	lxi	h,@dpha		;dph for drive a
	ora	a
	rz
	lxi	h,@dphb		;dph for drive b
	ret

@setsec:				;set sector given by register c 
	mov	a,c
	sta	@seksec		;sector to seek
	ret

.z80
@setdma:	ld	(@dmaadr),bc	;set dma address given by BC
	ret

@settrk:	ld	(@sektrk),bc	;set track given by registers BC
.8080
	ret

@home:	lda	@hstwrt		; (patch by DRI) host written flag
	ora	a		; written ?
.z80
	jr	nz,homedh	; jif not written			wm01
.8080
	sta	@hstact		; else store in host active
homedh:	jmp	dohomeh		; go do home disk drive

@read:				;read the selected CP/M sector
	xra	a		; a patch by DRI
	sta	@unacnt
	mvi	a,1
	sta	@readop		;read operation
	sta	@rsflag		;must read data
	mvi	a,wrual
	sta	@wrtype		;treat as unalloc
.z80
	jr	rwoperh		;to perform the read			wm01
.8080

@write:				;write the selected CP/M sector
	xra	a		;0 to accumulator
	sta	@readop		;not a read operation
	mov	a,c		;write type in c
	sta	@wrtype
	cpi	wrual		;write unallocated?
.z80
	jr	nz,chkunah	;check for unalloc			wm01
.8080

;	write to unallocated, set parameters
	mvi	a,blksizh/128	;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

chkunah:
	;check for write to unallocated sector
	lda	@unacnt		;any unalloc remain?
	ora	a
.z80
	jr	z,alloch	;skip if not				wm01
.8080

;	more unallocated records remain
	dcr	a		;@unacnt = @unacnt-1
	sta	@unacnt
	lda	@sekdsk		;same disk?
	lxi	h,@unadsk
	cmp	m		;@sekdsk = @unadsk?
.z80
	jr	nz,alloch	;skip if not				wm01
.8080

;	disks are the same
	lxi	h,@unatrk
	call	@sektrkcmp	;@sektrk = @unatrk?
.z80
	jr	nz,alloch	;skip if not				wm01
.8080

;	tracks are the same
	lda	@seksec		;same sector?
	lxi	h,@unasec
	cmp	m		;@seksec = @unasec?
.z80
	jr	nz,alloch	;skip if not				wm01
.8080

;	match, @move to next sector for future ref
	inr	m		;@unasec = @unasec+1
	mov	a,m		;end of track?
	cpi	cpmspth		;count CP/M sectors
.z80
	jr	c,noovfh	;skip if no overflow
.8080
;
;	overflow to next track
	mvi	m,0		;@unasec = 0
	lhld	@unatrk
	inx	h
	shld	@unatrk		;@unatrk = @unatrk+1

noovfh:
	;match found, mark as unnecessary read
	xra	a		;0 to accumulator
	sta	@rsflag		;@rsflag = 0
.z80
	jr	rwoperh		;to perform the write			wm02
.8080

alloch:
	;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       *;

rwoperh:
	;enter here to perform the read/write
	xra	a		;zero to accum
	sta	@erflag		;no errors (yet)
	lda	@seksec		;compute host sector
	ora	a		;carry = 0
	rar			;shift right
	ora	a		;carry = 0
	rar			;shift right
	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?
.z80
	jr	z,filhsth	;fill host if not			wm02
.8080

;	host buffer active, same as seek buffer?
	lda	@sekdsk
	lxi	h,@hstdsk	;same disk?
	cmp	m		;@sekdsk = @hstdsk?
.z80
	jr	nz,nomatchh						;wm02
.8080

;	same disk, same track?
	lxi	h,@hsttrk
	call	@sektrkcmp	;@sektrk = @hsttrk?
.z80
	jr	nz,nomatchh						;wm02
.8080

;	same disk, same track, same buffer?
	lda	@sekhst
	lxi	h,@hstsec	;@sekhst = @hstsec?
	cmp	m
.z80
	jr	z,matchh	;skip if match				wm02
.8080

nomatchh:
	;proper disk, but not correct sector
	lda	@hstwrt		;host written?
	ora	a
	cnz	writehsth	;clear host buff

filhsth:
	;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	readhsth	;yes, if 1
	xra	a		;0 to accum
	sta	@hstwrt		;no pending write

matchh:
	;copy data to or from buffer
	lda	@seksec		;mask buffer number
	ani	secmsk		;least signif bits
	mov	l,a		;ready to shift
	mvi	h,0		;double count
	dad	h		;shift left 7
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
;	hl has relative host buffer address
.z80
	ld	de,@hstbuf
	add	hl,de		;hl = host address
	ld	de,(@dmaadr)	;de = dma address
	ld	bc,128		;length
	ld	a,(@readop)	;which way?
	or	a
	jr	nz,rw@move	;skip if read

;	write operation, mark and switch direction
	ld	a,1
	ld	(@hstwrt),a	;@hstwrt = 1
	ex	de,hl		;source/dest swap

rw@move:	call	@move		;@move a logical sector to/from buffer

.8080
;	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	writehsth
	lda	@erflag
	ret

;*	Utility subroutine for 16-bit compare        *;

@sektrkcmp:			;HL = .@unatrk or .@hsttrk, compare with @sektrk
;	.z80
;	ld	bc,(@sektrk)
;	or	a		; clear carry
;	sbc	hl,bc		; hl=hl-bc
;	ret			; return status
	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

.z80

readhsth:call	hstcomh
	call	hdread
	ret

writehsth:call	hstcomh
	call	hdwrite
	ret

hstcomh:call	readyh
	ld	bc,(@hsttrk)
	call	trkseth
	ld	a,(@hstsec)
	ld	c,a
	call	secseth
	ret

dohomeh:call	readyh
	xor	a		; seek cyl 0
	out	(hdclo),a
	out	(hdchi),a
	ld	a,hdseek
	out	(hdcmd),a	; set future (implied) seek speed

hdbsy:	in	a,(hdstat)	; controller busy?
	and	80h
	jr	nz,hdbsy
	ret

@diskoff:in	a,(hdstat)	; is it not busy and ready?
	bit	7,a
	ret	nz		; controller busy, exit.
	bit	6,a
	ret	z		; selected disk not ready, exit.
	ld	a, low lzone	; seek lzone
	out	(hdclo),a
	ld	a, high lzone
	out	(hdchi),a
	ld	a,hdseek
	out	(hdcmd),a
	call	hdbsy	; wait till controller is finished issuing seek,
	ld	a,hdselh and hdsmsk	; de-select drive
	out	(hdsdh),a
	ret

; system is on tracks 0 and 1
; spares are on tracks 2 and 3
; the dir is on 4,6,8,10
; dup dir is on 5,7,9,11
; and data starts on 12
trkseth:ld	hl,4		; track >7 then +4
	ld	a,c
	and	0F8H
	or	b
	jr	nz,.set
	ld	hl,0		; then rest are +0
	ld	a,c
	cp	4		; track <4 then no change
	jr	c,.set
	sub	4		; form 4,6,8,10
	add	a,c
	ld	c,a
.set:	add	hl,bc		; hl is track number
	srl	h		; msb is head select
	rr	l
	ld	a,l
	out	(hdclo),a	; to controller
	ld	a,h
	out	(hdchi),a
	ret

secseth:ld	a,c
	out	(hdsec),a
	ret

readyh:	in	a,(bitport)
	and	hdcsel		; select controller, clear reset
	out	(bitport),a
	call	hdbsy		; controller busy?
	ld	a,hdselh		; select drive
	out	(hdsdh),a
sekok:	call	hdbsy		; make sure controller isn't busy first
	in	a,(hdstat)	; seek done?
	cpl			; ones' complement,
	and	01010000b	; are drive ready and seek complete true?
	jr	nz,sekok	; no, keep waiting, else -
	ld	a,(@hsttrk)	; select head
	and	1
	or	hdselh
	push	bc		; save conts of bc
	ld	b,a
	ld	a,(@hstdsk)	; select heads 0-1, or 2-3
	rla			; using disk #
	and	2
	or	b
	pop	bc		; restore bc
	out	(hdsdh),a
	ret

hdwrite:call	hrdwrt		; write sector
	call	nz,wrt.err	; if error try to recover
	ld	(@erflag),a	; set error flag to proper status
	in	a,(hdchi)	; do dup write?
	or	a
	ret	nz		; dup write on cly<6 only
	in	a,(hdclo)
	cp	6
	ret	nc
	in	a,(hdsdh)	; get head
	xor	1		; flip to other side
	out	(hdsdh),a
	call	hrdwrt		; do write
	call	nz,wrt.err	; if error try to recover
	ex	af,af		; save error flag of 2nd write
	ld	a,(@erflag)	; was 1st an error?
	or	a
	ret	z		; no so ret ok! (avoid giving cp/m a bad sec)
	ex	af,af		; else return status of 2nd write
	ld	(@erflag),a	; as it MAY be ok.
	ret

hrdwrt:	in	a,(hdclo)
	out	(hdclo),a		; clear data request line.
	ld	bc,0000h+hddata
	ld	hl,@hstbuf
	ld	a,hdwrt		; that's right, you
	out	(hdcmd),a	; issue the command
	otir			; before the data.
	otir
	call	hdbsy
	and	01		; error flag
	ld	a,0FFH		; write ok?
	ret	nz		; return if not
	ld	a,hdred		; do read after write verify
	out	(hdcmd),a
	call	hdbsy
	in	a,(hdstat)	; get status of read
	and	1
	ret	z
	ld	a,0FFH
	ret

hdread:	call	hdrd		; read sector
	call	nz,rd.err	; if error try to recover
	ld	(@erflag),a
	ret	z		; read op ok
	in	a,(hdchi)	; try other side of platter?
	or	a
	ret	nz		; cly # to big
	in	a,(hdclo)
	cp	6
	ret	nc
	in	a,(hdsdh)	; flip to other side
	xor	1
	out	(hdsdh),a
	call	hdrd
	call	nz,rd.err	; error, try to recover
	ld	(@erflag),a
	ret

hdrd:	ld	a,hdred			; read a sector
	out	(hdcmd),a
	ld	bc,0000h+hddata
	ld	hl,@hstbuf
	call	hdbsy
	inir				; get bytes before checking status
	inir				; so that even if sector is bad
	in	a,(hdstat)		; some of it may be recovered
	and	01
	ret	z		; no error
	ld	a,0FFH		; error flag
	ret
;
ioimageh:
;@move:				; block memory @move, turn rom on/off
	in	a,(bitport)	; turn rom off
	res	7,a
	out	(bitport),a
	ldir			; @move logical sector from @hstbuf
	in	a,(bitport)	; turn rom back on
	set	7,a
	out	(bitport),a
	ret			; back to rom

image_length  equ    $-ioimageh		; length of this image
title Floppy disk support routines.    (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By G. Ohnysty                                 ##
##                                                    ##
##      Disk support routines (Deblocking for floppy) ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
%
.z80

public	$home, $seldsk, $settrk, $setsec, $setdma, $read, $write, sectran
public	$diskinit, diskon, $diskoff, thnsd

bitport	equ	20		; bit port (m80 does not support extrn bytes)
drvmask	equ	0FEH		; drive select mask
denmask	equ	0DFH		; density bit mask
driveA	equ	00H		; drive A select bit
ddbit	equ	00H		; double density bit
sdbit	equ	20H		; single density bit
sidmask	equ	0FBH		; side select mask
sid0	equ	4H		; side 0 bit
sid1	equ	0H		; side 1 bit
control	equ	16		; I/O port of disk controller
status	equ	control+0	; status register
cmnd	equ	control+0	; command register
track	equ	control+1	; track register
sector	equ	control+2	; sector register
data	equ	control+3	; data register
ficmd	equ	11010000B	; force interrupt (Abort current command)
rdcmd	equ	10001000B	; read command
wrtcmd	equ	10101100B	; write command
;***************************************************************************
;* seek time at a clock rate of 1 MHZ				WM01	   *
;*									   *
;* bits	1	0	seek time					   *
;*	0	0	6  ms						   *
;*	0	1	12 ms						   *
;*	1	0	20 ms						   *
;*	1	1	30 ms						   *
;***************************************************************************
seekcmd	equ	00010000B	; seek command				WM01
rstcmd	equ	00000000B	; home (restore) command
adrcmd	equ	11000100B	; read track address
rdmask	equ	10011100B	; read status mask
wrtmask	equ	11111100B	; write status mask
tries1	equ	2		; re-home on bad sector # of tries+1
tries2	equ	5		; re-read/write # of retries+1
ssmblk	equ	194
dsmblk	equ	ssmblk*2
retcod	equ	0C9H		; return op code
nmivec	equ	0066H	; non-maskable interupt vector (used in rd/wt loop)
page
; This section defines the disk parameters (dph's are images moved to RAM)
dph0:	defw	0,0,0,0		; dph for unit A:
	defw	dirbuf,$dpb	; directory buffer, Disk Parameter Block
	defw	csva, alva	; check sum pointer, allocation map pointer

;dpb	;( double density );
	defw	40		; (spt) sectors per track
	defb	3		; (bsh) block shift factor
	defb	7		; (blm) block mask
	defb	0		; (exm) extent mask
	defw	194		; (dsm) max logical block #
	defw	63		; (drm) max directory #
	defb	0F0H		; (al0) directory allocation map & BIOS space
	defb	00H		; (al1)
	defw	16		; (cks) size of directory check vector
	defw	1		; (off) reserved tracks

enddph:

dpb:   ;( double sided double density );
	defw	40		; (spt) sectors per track
	defb	4		; (bsh) block shift factor
	defb	15		; (blm) block mask
	defb	1		; (exm) extent mask
	defw	196		; (dsm) max logical block #
	defw	63		; (drm) max directory #
	defb	0C0H		; (al0) directory allocation map & BIOS space
	defb	00H		; (al1)
	defw	16		; (cks) size of directory check vector
	defw	1		; (off) reserved tracks

subttl Logical BIOS entry points & Deblocking
page
.8080
;*****************************************************
;*      Logical BIOS entry points                    *
;*      Sector Deblocking Algorithms                 *
;*****************************************************
blksiz	equ	1024		;CP/M allocation size
hstsiz	equ	512		;host disk sector size
hstspt	equ	10		;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
secshf	equ	2		;log2(hstblk) sector mask
wrall	equ	0		;write to allocated
wrdir	equ	1		;write to directory
wrual	equ	2		;write to unallocated

$diskinit:	;enter here on system boot to initialize
.z80
	ld	hl,ioimage	;move rd/wrt routines into RAM
	ld	de,move
	ld	bc,imaglen
	ldir
	ld	hl,dph0		; set dph's
	ld	de,dpha
	ld	bc,enddph-dph0
	ldir
.8080
	xra	a		;0 to accumulator
	sta	hstact		;host buffer inactive
	sta	unacnt		;clear unalloc count
	cma
	sta	dsk		;clear disk number
	ret

$seldsk:			;select disk
	mov	a,c		;selected disk number
	sta	sekdsk		;seek disk number
	jmp	dsksel		;physical disk select (If needed to check den)

$setsec:			;set sector given by register c 
	mov	a,c
	sta	seksec		;sector to seek
	ret

.z80
$setdma: ld	(dmaadr),bc	;set dma address given by BC
	ret

$settrk: ld	(sektrk),bc	;set track given by registers BC
.8080
	ret

$home:	lda	hstwrt		; patch by DRI
	ora	a
.z80
	jr	nz,homed	;					wm02
.8080
	sta	hstact
homed:	jmp	dohome		; go do home disk drive

$read:				;read the selected CP/M sector
	xra	a		; a patch by DRI
	sta	unacnt
	mvi	a,1
	sta	readop		;read operation
	sta	rsflag		;must read data
	mvi	a,wrual
	sta	wrtype		;treat as unalloc
.z80
	jr	rwoper		;to perform the read			wm02
.8080

$write:				;write the selected CP/M sector
	xra	a		;0 to accumulator
	sta	readop		;not a read operation
	mov	a,c		;write type in c
	sta	wrtype
	cpi	wrual		;write unallocated?
.z80
	jr	nz,chkuna	;check for unalloc			wm02
.8080

;	write to unallocated, set parameters
	mvi	a,blksiz/128	;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
.z80
	jr	z,alloc		;skip if not				wm02

.8080
;	more unallocated records remain
	dcr	a		;unacnt = unacnt-1
	sta	unacnt
	lda	sekdsk		;same disk?
	lxi	h,unadsk
	cmp	m		;sekdsk = unadsk?
.z80
	jr	nz,alloc	;skip if not				wm02
.8080

;	disks are the same
	lxi	h,unatrk
	call	sektrkcmp	;sektrk = unatrk?
.z80
	jr	nz,alloc	;skip if not				wm02
.8080

;	tracks are the same
	lda	seksec		;same sector?
	lxi	h,unasec
	cmp	m		;seksec = unasec?
.z80
	jr	nz,alloc	;skip if not				wm02
.8080

;	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
.z80
	jr	c,noovf		;skip if no overflow			wm02
.8080

;	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
.z80
	jr	rwoper		;to perform the write			wm02
.8080

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	seksec		;compute host sector
	ora	a		;carry = 0
	rar			;shift right
	ora	a		;carry = 0
	rar			;shift right
	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?
.z80
	jr	z,filhst	;fill host if not			wm02
.8080

;	host buffer active, same as seek buffer?
	lda	sekdsk
	lxi	h,hstdsk	;same disk?
	cmp	m		;sekdsk = hstdsk?
.z80
	jr	nz,nomatch	; 					wm02

.8080
;	same disk, same track?
	lxi	h,hsttrk
	call	sektrkcmp	;sektrk = hsttrk?
.z80
	jr	nz,nomatch	;					wm02
.8080

;	same disk, same track, same buffer?
	lda	sekhst
	lxi	h,hstsec	;sekhst = hstsec?
	cmp	m
.z80
	jr	z,match		;skip if match				wm02
.8080

nomatch:
	;proper disk, but not correct sector
	lda	hstwrt		;host written?
	ora	a
	cnz	writehst	;clear host buff

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	seksec		;mask buffer number
	ani	secmsk		;least signif bits
	mov	l,a		;ready to shift
	mvi	h,0		;double count
	dad	h		;shift left 7
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
	dad	h
;	hl has relative host buffer address
.z80
	ld	de,hstbuf
	add	hl,de		;hl = host address
	ld	de,(dmaadr)	;de = dma address
	ld	bc,128		;length
	ld	a,(readop)	;which way?
	or	a
	jr	nz,rwmove	;skip if read

;	write operation, mark and switch direction
	ld	a,1
	ld	(hstwrt),a	;hstwrt = 1
	ex	de,hl		;source/dest swap

rwmove:	call	move		;move a logical sector to/from buffer

.8080
;	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
	lda	erflag
	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
subttl Physical disk routines
page
.z80
; select disk drive, C=drive number 0=A:, 1=B:
; return HL=dph for selected drive, or HL=0 for non-existent drive
dsksel:	ld	hl,0		; hl = 0 for non-existent drive
	ld	a,c
	or	a
	ret	nz		; drive number >B:
	ld	hl,dpha		; select proper dph for drive
	ld	a,(dsk)		; selecting disk already selected?
	cp	c
	ret	z		; yes, no further action needed
	xor	a		; set sid flag
	ld	(dsk),a		; only valid drive is A:
	ld	(sidflg),a	; single sided flag
	push	hl		; save pointer to dph
	call	dohome		; trk=0, dd-den, sid0, drvA
	in	a,(bitport)	; select side 1
	and	sidmask
	or	sid1
	out	(bitport),a
	call	dcheck		; can read?
	pop	hl		; if nz then can't
	ret	nz
	ld	a,(adrbuf+2)	; get sector number of side 1
	cp	10		; on other side? (side 1 sectors 10 to 19)
	ret	c		; if c then no
	push	hl
	ld	de,$dpb		; adjust dpb in ram
	ld	hl,dpb
	ld	bc,15
	ldir
	ld	a,0FFH		; double sided flag
	ld	(sidflg),a
	pop	hl		; pointer to dph
	ret

dcheck:	push	hl		; save hl and bc
	push	bc
	ld	hl,adrbuf	; buffer space
	ld	bc,6*256+data	; read 6 bytes from data port
	ld	a,adrcmd
	out	(cmnd),a
dchk1:	halt			; wait for drq
	ini
	jr	nz,dchk1
	call	busy		; wait for intrq
	bit	4,a		; test rnf flag
	pop	bc
	pop	hl
	ret

; home disk head ( set  trk=0, drv=A, sid=0, motor=on)
dohome:	call	ready		; make sure drive is on and ready
	in	a,(bitport)
	and	sidmask
	or	sid0
	out	(bitport),a	; select side 0
	ld	a,rstcmd	; restore command
	out	(cmnd),a	; issue command
	jr	busy		; test and wait for not busy

; seek track #, BC=Track #
trkset:	call	ready		; make sure drive is on and ready
	in	a,(bitport)	; set proper sense to side
	and	sidmask
	ld	b,a		; save in b
	ld	a,(sidflg)	; check flag
	or	a
	ld	a,sid0		; side 0 bit
	jr	z,outtrk
	srl	c		; double sided trk=trk/2
	jr	nc,outtrk	; if lsb=0 then side 0
	ld	a,sid1		; else side 1
outtrk:	or	b		; or in conts of bitport
	out	(bitport),a
	ld	a,c
	out	(data),a	; issue req. track to controller
	ld	a,seekcmd	; seek command
	out	(cmnd),a	; issue command
	jr	busy		; test and wait for not busy

; select sector #, BC=Sector #
secset:	in	a,(bitport)	; single or double sided?
	and	not sidmask
	cp	sid0
	ld	a,c		; pure sector number in a
	jr	z,secx		; single sided
	add	a,10		; double sided sector disp.
secx:	out	(sector),a	; to controller register
	ret

; perform logical to physical sector translation.
; logical sector number in BC, table address in DE
; return physical sector number in HL
sectran:ld	a,d	; table address 0?
	or	e
	ld	h,b	; if so no xlate
	ld	l,c
	ret	z
	ex	de,hl	; table address in hl
	add	hl,bc	; index by logical sector number
	ld	l,(hl)
	ld	h,0
	ret

; ready disk drive, perform physical disk select, set density bit
ready:	push	hl		; save hl
	push	de		; and de
	push	bc
	ld	a,ficmd		; abort any controller action
	out	(cmnd),a
	in	a,(bitport)	; select drive
	and	denmask and drvmask
;both	or	driveA
;are 0	or	ddbit
	out	(bitport),a	; to bit port
	call	diskon		; turn drive motor on
	pop	bc
	pop	de
	pop	hl
	ret

; turn disk motor on, delay for drive speed
diskon:	in	a,(bitport)	; get current drive motor status
	bit	4,a		; is motor on?
	ret	nz		; motor on, do nothing
	set	4,a		; motor on bit
	out	(bitport),a	; turn motor on
	ld	b,50		; delay
	call	thnsd
	ret

; turn disk motor off, de-select drive
$diskoff:in	a,(bitport)
	res	4,a		; motor off bit
	set	0,a
	out	(bitport),a
	ret

; delay for B th's @ 4Mhz (each call <=> one hundredh of a sec.)
thnsd:	ld	de,1670
tlp:	dec	de
	ld	a,d
	or	e
	jp	nz,tlp
	djnz	thnsd
	ret

; check status of controller, wait for command to finish executing
busy:	halt			; wait for command done
bsy:	in	a,(status)	; now wait for not busy
	bit	0,a
	jr	nz,bsy
	ret
subttl Writehst and Readhst logical to Physical routines
page
;*	WRITEHST performs the physical write to      *;
;*	the host disk, READHST reads the physical    *;
;*	disk.					     *;

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
	ld	l,3		; read after write retries
chk0:	ld	de,tries1*256+tries2	; retry error counts
wrthst:	push	hl
	push	de		; save error counts
	call	hstcom		; set track and sector
	call	wrt512		; read sector
	pop	de		; restore error flags
	pop	hl		; restore r/w error count
	jr	z,wrtchk	; do read after write
	dec	e		; retry count
	jr	nz,wrthst	; try again
	dec	d		; home and reseek count
	jr	z,chk3		; can't recover
	call	dohome		; re seek
	ld	e,tries2	; reset retry count
	jr	wrthst
wrtchk:	ld	b,0		; dummy read loop to check sector
	ld	a,rdcmd
	out	(cmnd),a
chk1:	halt
	in	a,(data)
	djnz	chk1
chk2:	halt
	in	a,(data)
	djnz	chk2
	call	busy		; get status
	and	rdmask
chk3:	ld	(erflag),a	; error return flag
	ret	z
	dec	l
	jr	nz,chk0		; try again
	ld	a,0ffh		; bail out, error
	jr	chk3

readhst:;hstdsk = host disk #, hsttrk = host track #,
	;hstsec = host sect #. read "hstsiz" bytes
	;into hstbuf and return error flag in erflag.
	ld	de,tries1*256+tries2	; retry error counts
rdhst:	push	de		; save error counts
	call	hstcom		; set track and sector
	call	rd512		; read sector
	ld	(erflag),a	; error return flag
	pop	de		; restore error flags
	ret	z		; good op
	dec	e		; retry count
	jr	nz,rdhst	; try again
	dec	d		; home and reseek count
	ret	z		; can't recover
	call	dohome		; re seek
	ld	e,tries2	; reset retry count
	jr	rdhst

hstcom:	ld	a,(hstdsk)	; select disk
	ld	c,a
	call	dsksel
	ld	bc,(hsttrk)	; set track to hsttrk
	call	trkset		; physical seek
	ld	a,(hstsec)	; set physical sector
	ld	c,a		; c=sector
	call	secset
	ret
subttl Physical disk I/O, RAM image
page
ioimage:
;move:				; block memory move, turn rom on/off
	in	a,(bitport)	; turn rom off
	res	7,a
	out	(bitport),a
	ldir			; move logical sector from hstbuf
	in	a,(bitport)	; turn rom back on
	set	7,a
	out	(bitport),a
	ret			; back to rom

;rd128:
	ld	hl,(dmaadr)	; address of operation
	ld	b,1		; read a 128 byte sector
	jr	rd
;rd512:
	ld	hl,hstbuf
	ld	b,4		; read a 512 byte sector
; read a sector, return A=0 for no errors, A=1 for non-recoverable error
; if b=1 128, b=2 256, b=3 384, b=4 512   bytes/sector
rd:	ld	de,rdmask*256+rdcmd	; d=read status mask, e=read command
	jr	action

;wrt128:
	ld	hl,(dmaadr)
	ld	b,1		; write a 128 byte sector
	jr	wrt
;wrt512:
	ld	hl,hstbuf
	ld	b,4		; write a 512 byte sector
; write a sector, return as per read
wrt:	ld	de,wrtmask*256+wrtcmd ; d=status mask, e=write command
	;fall through to action

action:	call	ready			; make sure drive is on and ready
	di				; no interrupts during disk I/O operations
	in	a,(bitport)		; turn rom off
	res	7,a
	out	(bitport),a
	push	hl			; save address of disk buffer
	ld	hl,nmivec		; set up nmi vector
	ld	a,(hl)			; save current contents
	ex	af,af'
	ld	(hl),retcod		; this is a return after HALT in loop
	pop	hl			; hl = dma address
	ld	a,b			; sector multiple
	ld	bc,128*256+data		; b=sector length, c=data port
	bit	0,a			; if 0 then 256 or 512 bytes/sector
	jr	nz,actn			; b set for 128 or 384 bytes/sector
	ld	b,0			; b set for 256 or 512 bytes/sector
actn:	cp	1			; compute entry point 1st or 2nd loop
	push	psw			; save as Z flag
	ld	a,e			; i/o command
	cp	wrtcmd			; a write?
	jr	z,wstart		; start write command

	out	(cmnd),a		; fall through to read loop
	pop	psw
	jr	z,rl2
rl1:	halt				; wait for controller
	ini
	jr	nz,rl1
rl2:	halt
	ini
	jr	nz,rl2
	jr	done			; read loop done, exit

wstart:	out	(cmnd),a		; write loop
	pop	psw
	jr	z,wl2
wl1:	halt
	outi
	jr	nz,wl1
wl2:	halt
	outi
	jr	nz,wl2

done:	ex	af,af'			; byte at nmi vector address
	ld	(nmivec),a		; restore it
	in	a,(bitport)		; turn rom back on
	set	7,a
	out	(bitport),a
	ei				; turn interrupts on
	call	busy			; get status when contoller not busy
	and	d			; status mask
	ret	z			; no bit set, return operation ok
	ld	a,1			; cp/m error return
	ret

imaglen	equ	$-ioimage		; length of this image
title Video driver routines for the KAYPRO-10  (C) 1983 By NLS.
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By M. Sherman                                 ##
##                                                    ##
##      Video driver routines for the KAYPRO-10       ##
##      and the 6545 video controller chip.           ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 04/14/83                    [01]        ##
########################################################
%


; routines for everyone else to use
public	vidout, vidinit, regrst, dtwait, clrdis, clreol, carret, putcur
public	getc, putc, getatt, putatt, print

.Z80

; conditional assembly equates

TRUE	equ	0ffffh
FALSE	equ	NOT TRUE

; video controller locations

vcbase	equ	1ch		; video controller base address
vccmd	equ	vcbase		; register select port
vcstat	equ	vcbase		; status port
vcrdat	equ	vcbase+1	; register data port
vcdata	equ	vcbase+3	; video controller data port

; command format, video controller commands:
; high byte = register to select, low byte = base addr. (register select)

curcmd	equ	0e1ch		; place cursor command
rwcmd	equ	121ch		; read/write command
strcmd	equ	01fh		; strobe, or "tickle", command
scrcmd	equ	0c1ch		; set start of display address command
				; ("scroll" command)
hiadd	equ	12h	; high byte register #, video mem. address,
loadd	equ	13h	; low byte register #, video mem. address.
cstart	equ	0ah	; cursor starting row count, cursor def. reg #
cstop	equ	0bh	; cursor ending row count.

csron	equ	60h	; cursor on, blinking at 1/32, starting row=0
csroff	equ	20h	; no cursor, starting row=0 (irrelevant)

; special character equates

space	equ	020h
nrmlatt	equ	00h

; single character control codes

belli	equ	07h	; bell code to video driver,
bello	equ	04h	; bell code to keyboard.
cr	equ	0dh	; carriage return
lf	equ	0ah	; line feed
ceol	equ	18h	; clear to end of line
ceos	equ	17h	; clear to end of screen
clrscr	equ	1ah	; clear screen
homec	equ	1eh	; home cursor
lcur	equ	08h	; left cursor (backspace)
rcur	equ	0ch	; right cursor (forespace)
ucur	equ	0bh	; up cursor
esc	equ	1bh	; escape code, initiates multi-
			; -character control sequences

; two-character commands

dline	equ	'R'	; delete line
iline	equ	'E'	; insert line

; three-character commands

atton	equ	'B'	; set attribute
attoff	equ	'C'	; clear attribute

; four-character commands

setpix	equ	'*'	; set pixel
clrpix	equ	' '	; clear pixel
lodcur	equ	'='	; load cursor address (cursor positioning)

; six-character commands

lindraw	equ	'L'	; draw a line
lineras	equ	'D'	; erase a line

; video driver equates

linesiz	equ	80		; characters per line
linesps	equ	24		; number of lines in the normal display
statlin	equ	linesps+1	; line number, status line
lastlin	equ	(linesps-1)*linesiz	; address, first chara last
					; normal display line
					; (the line above the status line)

;################################################
;#						#
;#		video drivers			#
;#						#
;################################################

	; clear to end of line
clreol:	call	caleol		; calculate end of line count
	jr	clrdis

	; clear to end of screen
clreos:	ld	c,linesps-1
	ld	a,(vatt)
	and	20h
	jr	nz,ceos22
	inc	c
ceos22:	ld	a,(crow)
	sub	c
	jr	nc,clreol	; clear to end of line if on last legal line
	neg			; two's complement, number of lines to erase
	ld	b,a
	ld	de,linesiz
	ld	hl,0
clresl:	add	hl,de
	djnz	clresl
	push	hl
	call	caleol
	pop	bc
	add	hl,bc		; total count in hl
	jr	clrdis		; do it

caleol:	ld	hl,linesiz
	ld	de,(cursor)
	ld	a,(ccol)
	ld	c,a
	xor	a		; clear a, clear flags (especially carry!)
	ld	b,a		; clear b
	sbc	hl,bc		; hl=number of bytes to move
	ret

vidinit:; Video hardware/software initialization routine.  Will set
	; video driver ram storage to reset/restart values,
	; reprogram the video controller chip,
	; clear the screen and place the cursor in the upper right corner.
	;
ramini:	ld	hl,vidram	; first, initialize the ram.
	ld	b,ramlen
	xor	a
rinilp:	ld	(hl),a
	inc	hl
	djnz	rinilp

ctrini:	ld	hl,ctrtbl	; then initialize the controller,
	ld	bc,ctblen*256+vcbase+1
	xor	a		; first register,=00
cinilp:	dec	c		; c:=base
	out	(c),a		; select register
	inc	a		; a:=register to program
	inc	c		; c:=data port
	outi			; (hl):=program data, out to (c)
	jr	nz,cinilp	; until b:=0
	ld	a,strcmd
	out	(vccmd),a	; start video chip processing.
	; fall through to clear screen
clear:	call	home		; home cursor
clear2:	ld	a,(vatt)
	and	0f0h		; clear ordinary attributes
	ld	(vatt),a	; clear attribute byte
	ld	de,(cursor)	; same as vrbase, now
	ld	hl,800h		; new screen size to eliminate phantom cursor wm03
;******************************************************************************
;*	ld	hl,statlin*linesiz	; screen size = 7d0H		      *
;******************************************************************************
	and	20h
	jr	z,clrdis
	ld	hl,linesps*linesiz
	; fall through to clrdis...

clrdis:	; clear display and associated attributes.
	; de := start address, hl := number of locations to clear
	; all registers affected...
	;
	ld	bc,hiadd*100h+loadd
cdislp:	in	a,(vcstat)
	or	a
	jp	p,cdislp	; wait until ready,
	ld	a,b		; high address byte register number,
	out	(vccmd),a	; select it
	ld	a,d		; get high byte, new address,
	and	07h		; qualify address,
	ld	d,a		; put it back,
	out	(vcrdat),a	; output it.
	ld	a,c		; select
	out	(vccmd),a	; low address byte register,
	ld	a,e		; get low address byte,
	out	(vcrdat),a	; output it.
	ld	a,strcmd
	out	(vccmd),a	; start a new cycle,
cdislp3:in	a,(vcstat)	; wait until it's ready,
	or	a
	jp	p,cdislp3
	ld	a,20h		; clear data byte,
	out	(vcdata),a
	inc	de		; set up for attr., next byte
cdislp2:in	a,(vcstat)	; go do attributes
	or	a
	jp	p,cdislp2	; jif until finished
	ld	a,b		; high address byte register number,
	out	(vccmd),a	; select it
	ld	a,d		; get high byte, new address,
	or	08h		; qualify address,
	out	(vcrdat),a	; output it.
	ld	a,c		; select
	out	(vccmd),a	; low address byte register,
	ld	a,e		; get low address byte,
	out	(vcrdat),a	; output it.
	ld	a,strcmd
	out	(vccmd),a	; start a new cycle,
cdislp4:in	a,(vcstat)	; wait until finished.
	or	a
	jp	p,cdislp4	; jif until finished
	xor	a		; clear attribute byte
	out	(vcdata),a
	dec	hl
	ld	a,h
	or	l
	jr	nz,cdislp
	ret

home:	xor	a
	ld	(ccol),a	; reset column count
	ld	(crow),a	; reset row count
	ld	hl,(vrbase)
	ex	de,hl
	jp	putcur		; place cursor and exit

; video controller initialization table, currently for a 25 by 80 display.
;
ctrtbl:	db	6ah	; reg00 total char/sweep including retrace, clocks
	db	50h	; reg01 total displayed, cclks
	db	56h
	db	99h
	db	19h
	db	0ah
	db	19h
	db	19h
	db	78h
	db	0fh
	db	60h
	db	0fh
	db	00h
	db	00h
	db	00h
	db	00h
ctblen	equ	$-ctrtbl	; table length

; main entry point.

vidout:	ld	a,(leadflg)	; set by escape sequences
	or	a
	jp	nz,escseq	; an escape sequence is in progress	
	ld	a,c
	or	a
	ret	z		; ignore nulls (requested by tech support)
	jp	m,vgmod		; video mode set? find out if negative (>80h)
	cp	space
	jp	c,spechar	; special characters
spcexe:	ld	a,c
	ld	de,(cursor)	; special character re-entry if non-control
	call	putc
	call	puta		; place attribute
vgmexe:	ld	a,(ccol)
	inc	a
	cp	linesiz
	jr	nc,crlf							;wm01
	ld	(ccol),a	; save new count
	ld	de,(cursor)
	inc	de
	jr	putcur		; reposition cursor and exit		wm01

vgmod:	ld	a,(vatt)
	and	10h
	jr	z,spcexe	; not video graphics mode if not zero
	ld	a,(vgb1)
	and	40h
	jr	z,vgmod2
	ld	a,c
	and	01
	ld	(vgb1),a
	ret
vgmod2:	ld	a,(vgb1)
	or	a
	ld	a,c
	jr	z,vgmod5
	cpl
vgmod5:	or	80h
	ld	de,(cursor)
	call	putc
	ld	a,(vgb1)
	ld	c,a
	ld	a,(vatt)
	or	c
	call	putatt
	ld	a,40h
	ld	(vgb1),a	; set first
	jr	vgmexe

; move the cursor to the beginning of the line

carret:	ld	hl,(cursor)
	ld	a,(ccol)
	ld	e,a
	xor	a		; clear flags,a
	ld	d,a
	ld	(ccol),a	; reset line count to zero
	sbc	hl,de		; hl = beginning of line
	ex	de,hl		; de = beginning of line
	jr	putcur		; place cursor and exit

; crlf places the cursor at the beginning of the next line and sets the
; character column count, ccol, to zero.

crlf:	call	carret		; carriage return
	; fall through to linefeed...

; move the cursor down one line, scroll if necc.

linefd:	ld	a,(crow)	; character row count
	cp	linesps-1	; lines per screen
	jr	c,linef2	; not last line if carry,
	cp	statlin-1	; status line?
	ret	z		; if so, don't scroll
	call	scroll		; else is last line, scroll screen
	jr	linef3		; don't update character row count.

linef2:	inc	a		; update character row count,
	ld	(crow),a

linef3:	ld	hl,(cursor)	; move the cursor down one line.
	ld	de,linesiz
	add	hl,de
	ex	de,hl
	; fall through to putcur...

; place cursor, new cursor address in de
putcur:	ld	a,d
	and	07h
	ld	d,a
	ex	de,hl
	ld	(cursor),hl
	ld	bc,(vrbase)
	sbc	hl,bc
	jr	nc,putcr2
	ld	de,0800h
	add	hl,de
putcr2:	add	hl,bc
	ex	de,hl
	ld	bc,curcmd
	jp	regrst

upcur:	ld	a,(crow)
	cp	statlin-1
	ret	z		; no cursor up from status line,
	or	a
	ret	z		; or from top line
	dec	a
	ld	(crow),a	; update row count
	ld	hl,(cursor)
	ld	de,linesiz
	sbc	hl,de
	ex	de,hl		; put new value in de
	jr	putcur

lfcur:	ld	a,(ccol)
	or	a
	jr	nz,lcur2
	ld	a,(crow)
	or	a
	ret	z		; no way can do
	cp	statlin-1	; on status line?
	jr	z,lcur3
	dec	a
	ld	(crow),a	; update row count
	ld	a,linesiz
lcur2:	dec	a
	ld	(ccol),a	; update column count
	ld	de,(cursor)
	dec	de
	jr	putcur		; place and exit
lcur3:	ld	a,linesiz-1
	ld	(ccol),a	; going to the end of the line
	ld	hl,(cursor)
	ld	de,linesiz-1
	add	hl,de
	ex	de,hl
	jr	putcur

rtcur:	ld	a,(ccol)
	cp	linesiz-1
	jp	nc,crlf		; do a cr, do a lf if not status line
	ld	de,(cursor)
	inc	de
	inc	a
	ld	(ccol),a	; reset column count
	jr	putcur

scroll:	jp	movsts		; fast scroll

setatr:	ld	hl,vatt
	ld	a,c
	sub	30h
	jr	z,revid		; set reverse video on
	dec	a
	jr	z,redint	; set reduced intensity on
	dec	a
	jr	z,sblink	; set blinking on
	dec	a
	jr	z,sunlin	; set underlining on
	dec	a
	jr	z,setcur	; set cursor on
	dec	a
	jr	z,setvid	; set video mode on
	dec	a
	jr	z,savcur	; save current cursor location
	dec	a
	jr	z,savsts	; save contents of status line during scroll
	ret			; illegal, exit

; set attributes

revid:	ld	a,(hl)
	or	01h
	ld	(hl),a
	ret
redint:	ld	a,(hl)
	or	02h
	ld	(hl),a
	ret
sblink:	ld	a,(hl)
	or	04h
	ld	(hl),a
	ret
sunlin:	ld	a,(hl)
	or	08h
	ld	(hl),a
	ret
setcur:	ld	c,csron		; cursor on, 1/16 blink
setcr2:	ld	a,cstart	; cursor select register
	out	(vccmd),a
	ld	a,c
	out	(vcdata),a	; turn on cursor, 1/16 blink
	ret
setvid:	ld	a,(vatt)	; turn on video mode.
	or	10h		; (GB1,GB2 graphics pairs)
	ld	(vatt),a
	ld	a,40h
	ld	(vgb1),a
	ret

savcur:	ld	hl,(crow)	; save, or 'remember', current cursor position
	ld	(precur),hl
	ret

savsts:	ld	a,(vatt)	; turn on status line preservation,
	or	00100000b	; protect it from scrolling.
	ld	(vatt),a
	ret

; clear attributes

clratr:	ld	hl,vatt
	ld	a,c
	sub	30h
	jr	z,nrmvid	; set normal video on
	dec	a
	jr	z,nrmint	; set normal intensity on
	dec	a
	jr	z,cblink	; set blinking off
	dec	a
	jr	z,cunlin	; set underlining off
	dec	a
	jr	z,clrcur	; set cursor off
	dec	a
	jr	z,clrvid	; set video mode off
	dec	a
	jr	z,rstcur	; restore cursor to last loc.
	dec	a
	jr	z,scrsts	; scroll contents of status line during scroll
	ret			; illegal, exit

; clear attributes:

nrmvid:	ld	a,(hl)		; set to non-inverted display mode.
	and	11111110b
	ld	(hl),a
	ret
nrmint:	ld	a,(hl)		; set to normal intensity
	and	11111101b
	ld	(hl),a
	ret
cblink:	ld	a,(hl)		; set to no blinking.
	and	11111011b
	ld	(hl),a
	ret
cunlin:	ld	a,(hl)		; set to no underlining.
	and	11110111b
	ld	(hl),a
	ret
clrcur:	ld	c,csroff	; turn cursor off
	jr	setcr2
clrvid:	ld	a,(hl)		; turn off video mode
	and	11101111b
	ld	(hl),a
	ret
rstcur:	ld	hl,(precur)	; return cursor to last remembered location.
	ld	a,h		; ccol
	add	a,space
	ld	(col),a
	ld	a,l
	add	a,space
	ld	(row),a
	jp	curpos		; restore previously saved cursor
scrsts:	ld	a,(vatt)	; turn off status line preservation,
	and	11011111b	; scroll status line on scrolls
	ld	(vatt),a
	ret

; X,Y cursor positioning routine
;
curpos:	ld	hl,0
	ld	c,l	; set c to zero, too.
	ld	a,(row)
	sub	space
	ret	c	; error, exit
	ld	b,a
	jr	z,curpo3
	cp	statlin		; lines per screen
	ret	nc		; error, exit
	ld	de,linesiz
curpo2:	add	hl,de
	djnz	curpo2
curpo3:	ld	e,a	; save row count
	ld	a,(col)
	sub	 space
	ret	c	; error, exit
	cp	linesiz
	ret	nc	; error, exit
	ld	c,a
	ld	(ccol),a	; new column count
	ld	a,e
	ld	(crow),a	; new row count
	add	hl,bc
	ld	de,(vrbase)
	add	hl,de
	ex	de,hl
	jp	putcur		; place cursor

dtwait:	ld	bc,rwcmd
rgwait:	call	regrst
	dec	c		; return c to original value
	ld	a,strcmd	; tickle the dummy
	out	(c),a
rgwt2:	in	a,(c)
	or	a
	jp	p,rgwt2
	ret

regrst:	out	(c),b
	inc	c
	out	(c),d
	dec	c
	inc	b
	out	(c),b
	inc	c
	out	(c),e
	ret

getc:	ld	a,d
	and	07h
	ld	d,a
getc2:	call	dtwait
	in	a,(vcdata)
	ret

putc:	push	af	; save data
	ld	a,d
	and	07h
	ld	d,a
putc2:	call	dtwait
	pop	af
	out	(vcdata),a
	ret

puta:	ld	a,(vatt)	; video attribute
putatt:	push	hl		; save hl
	push	af
	call	addatt
	call	dtwait
	pop	af
	out	(vcdata),a
	ex	de,hl
	pop	hl
	ret

getatt:	push	hl
	call	addatt
	call	getc2
	ex	de,hl
	pop	hl
	ret

addatt:	ld	hl,801h		; video attribute offset
	add	hl,de
	ld	a,h
	and	07h		; 00000000 to 00000111
	or	08h		; 00001000 to 00001111
	ld	h,a
	ex	de,hl
	ret

escseq:	ld	hl,leadflg
	ld	(hl),0		; clear flag
	cp	1
	jr	nz,esc2
	ld	a,c
	and	07fh
	cp	dline		; delete line?
	jp	z,dltlin
	cp	iline		; insert line?
	jp	z,inslin
	cp	'A'		; Kaypro-II display lower case?
	ret	z		; yes, ignore
	cp	'G'		; Kaypro-II display greek?
	ret	z		; yes, ignore
	ld	(esccmd),a	; set command
	ld	(hl),2
	ret

esc2:	cp	2
	jr	nz,esc3
	ld	a,(esccmd)
	cp	atton
	jp	z,setatr	; set attribute command
	cp	attoff
	jp	z,clratr	; clear attribute
	ld	a,c
	ld	(row),a
	ld	(hl),3
	ret

esc3:	cp	3
	jr	nz,esc4
	ld	a,c
	ld	(col),a
	ld	a,(esccmd)
	cp	lodcur
	jp	z,curpos	; cursor positioning
	cp	setpix
	jp	z,pixon		; pixel on
	cp	clrpix
	jp	z,pixoff	; pixel off
	ld	(hl),4
	ret
esc4:	cp	4
	jr	nz,esc5
	ld	a,c
	ld	(row2),a
	ld	(hl),5
	ret
esc5:	ld	a,c
	ld	(col2),a
	ld	a,(esccmd)
	cp	lindraw
	jp	z,lineon
	cp	lineras
	jp	z,lineoff
	ret			; illegal command, exit.

bell:	ld	c,bello		; put keyboard bell chara in c reg.,
	jp	kbdout		; ring bell

spechar:cp	cr
	jp	z,carret	; carriage return
	cp	lf
	jp	z,linefd	; line feed
	cp	belli
	jr	z,bell		; bell
	cp	ceol
	jp	z,clreol	; clear to end of line
	cp	ceos
	jp	z,clreos	; clear to end of screen
	cp	clrscr
	jp	z,clear		; clear screen
	cp	lcur
	jp	z,lfcur		; left cursor
	cp	rcur
	jp	z,rtcur		; right cursor
	cp	ucur
	jp	z,upcur		; up cursor
	cp	homec
	jp	z,home		; home cursor
	cp	esc
	jp	nz,spcexe	; not a control character, write it
	ld	a,1
	ld	(leadflg),a	; set escape in progress
	ret

; print routine

print:	pop	hl
	ld	a,(hl)
	inc	hl
	push	hl
	or	a
	ret	z
	ld	c,a
	call	vidout
	jr	print

	defw	0000h

title Block Move Routines for the 6545 CRT Controller.  (C) 1983 By NLS
.comment %
########################################################
##                                                    ##
##      KAYPRO 10 System                              ##
##                                                    ##
##      By M. Sherman                                 ##
##                                                    ##
##      block move routines for the 6545              ##
##                                                    ##
##      Copyright (C) 1983 By Non-Linear Systems, Inc ##
##      No warranty is made, expressed or implied.    ##
##                                                    ##
########################################################
##      Date: 03/28/83                    [77]        ##
########################################################

	Current revision:	7.7		28-Mar-83
	Previous revision:	7.6		11-Mar-83
	Prev. working rev.:	7.5		14-Feb-83
		Changes:  Attempt to add insert line.
		 (revision 7.5)
		Changes:  Updated scrolling (movsts), insert
		 line (revision 7.6)
		Changes:  Final modifications and debugging
		 prior to shipping (version 7.7)

includes the following routines:

MOVSTS:		move status line (if preserved=true), scroll screen
MDIR:		move data with attributes (emulates Z-80 LDIR)
MDDR:		move data with attributes (emulates Z-80 LDDR)
DLTLIN:		delete the current cursor line.
INSLIN:		insert a line at the current cursor location.
%
page


public	mdir, mddr, movsts, dltlin, inslin

vcdata	equ	1fh		; video ram data port
vccmd	equ	1ch		; register select port
vcstat	equ	1ch		; vc status port
scrcmd	equ	0c1ch		; used with regrst to alter base address
rwcmd	equ	121ch		; used with regrst to set up data address
strcmd	equ	1fh		; 'tickle', 'dummy' or strobe register.
lastlin	equ	0730h		; beginning address of last line (except stat)
linesiz	equ	80		; line length in counting numbers
bufsiz	equ	linesiz		; buffer size, if any
hiadd	equ	12h		; high byte of data address port
loadd	equ	13h		; low byte of data address port
vcrdat	equ	vccmd+1		; video controller register data port
linesps	equ	24

.Z80

page

; move status line and scroll
;

movsts:	ld	a,(vatt)	; first, check to see if the status line
	and	20h		; is to be preserved or not.
	jr	z,mvsts2	; if bit 5 is zero, no. else...
; status line preservation is TRUE.  Move the status line before doing
; anything else.
;
mvsts:	ld	hl,(vrbase)
	ld	de,lastlin+linesiz
	ld	bc,linesiz	; amount to move
	add	hl,de		; hl=source, de=statline
	ld	a,h		; qualify it
	and	07h
	ld	h,a
	ld	d,h		; copy it into de,
	ld	e,l		; de=source.
	add	hl,bc		; de=source, hl=destination
	ld	a,h		; qualify it
	and	07h
	ld	h,a
	ex	de,hl		; hl=source, de=destination
	push	hl		; save status line address
	call	mdir		; if so, move it
	pop	de		; status line address in de
	ld	hl,linesiz	; amount to clear
	call	clrdis		; clear it
	ld	hl,(vrbase)
	ld	de,linesiz
	add	hl,de
	ld	a,h
	and	07h
	ld	h,a
	ld	(vrbase),hl
	ex	de,hl
	ld	bc,scrcmd
	jp	regrst		; scroll screen and exit

; enter here for scroll if status line preservation IS NOT enabled.
; MVSTS2 scrolls the screen, then clears the status line.
;
mvsts2:	ld	hl,(vrbase)
	ld	de,linesiz
	add	hl,de
	ld	a,h
	and	07h
	ld	h,a
	ld	(vrbase),hl	; new base address
	ex	de,hl
	ld	bc,scrcmd
	call	regrst
	ld	hl,(vrbase)
	ld	de,linesps*linesiz	; starting addr., status line
	add	hl,de
	ld	a,h
	and	07h
	ld	h,a
	ex	de,hl
	ld	hl,linesiz
	jp	clrdis			; clear status line, exit.

; move a block of data, source in hl, destination in de, count in bc.
; (just like a Z-80 block move, or LDIR, command, only slower.)
;

mdir:	ld	a,b
	and	07h		; qualify the upper byte,
	or	c		; qualify the count
	ret	z		; not 65,535 please!
mdir2:	push	bc		; save the count
rdlopx:	in	a,(vcstat)
	or	a
	jp	p,rdlopx	; wait until ready to begin
	ld	bc,hiadd*100H+loadd	; address register numbers
			; change the data update address register:
	ld	a,b		; high address byte register, UA,
	out	(vccmd),a	; select it.
	ld	a,h		; get high byte, new address,
	out	(vcrdat),a	; put it in high byte, UA.
	ld	a,c		; low address byte, UA,
	out	(vccmd),a	; select it.
	ld	a,l		; new low address byte,
	out	(vcrdat),a	; set it.
	ld	a,strcmd	; strobe register
	out	(vccmd),a	; start a new cycle
rdlop1:	in	a,(vcstat)	; get status
	or	a		; set flags
	jp	p,rdlop1	; wait until vc is ready
	in	a,(vcdata)	; get a data byte
	ex	af,af'		; save it
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,d
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,e
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
	ex	af,af'
	out	(vcdata),a
	inc	de
	inc	hl
	ld	a,d
	and	7h
	ld	d,a
	ld	a,h
	and	7h
	ld	h,a
; and now for the attributes
rdlop2:	in	a,(vcstat)
	or	a
	jp	p,rdlop2
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,h
	or	08h		; go to attribute ram
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,l
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
rdlop3:	in	a,(vcstat)
	or	a
	jp	p,rdlop3
	in	a,(vcdata)
	ex	af,af'
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,d
	or	08h		; attribute ram
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,e
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
	ex	af,af'
	out	(vcdata),a
	pop	bc
	dec	bc
	ld	a,b
	or	c
	jr	nz,mdir2						;wm01
	jp	mdexlp		; make sure last byte got moved

; move a block of data, source in hl, destination in de, count in bc.
; (just like a Z-80 block move, or LDDR, command, only slower.)
;

mddr:	ld	a,b
	and	07h		; qualify the upper byte,
	or	c		; qualify the count
	ret	z		; not 65,535 please!
mddr2:	push	bc		; save the count
ddlopx:	in	a,(vcstat)
	or	a
	jp	p,ddlopx	; wait until ready to begin
	ld	bc,hiadd*100H+loadd	; address register numbers
			; change the data update address register:
	ld	a,b		; high address byte register, UA,
	out	(vccmd),a	; select it.
	ld	a,h		; get high byte, new address,
	and	07h		; qualify it
	out	(vcrdat),a	; put it in high byte, UA.
	ld	a,c		; low address byte, UA,
	out	(vccmd),a	; select it.
	ld	a,l		; new low address byte,
	out	(vcrdat),a	; set it.
	ld	a,strcmd	; strobe register
	out	(vccmd),a	; start a new cycle
ddlop1:	in	a,(vcstat)	; get status
	or	a		; set flags
	jp	p,ddlop1	; wait until vc is ready
	in	a,(vcdata)	; get a data byte
	ex	af,af'		; save it
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,d
	and	07h
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,e
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
	ex	af,af'
	out	(vcdata),a
	inc	de
	inc	hl
	ld	a,d
	and	7h
	ld	d,a
	ld	a,h
	and	7h
	ld	h,a
; and now for the attributes
ddlop2:	in	a,(vcstat)
	or	a
	jp	p,ddlop2
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,h
	or	08h		; go to attribute ram
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,l
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
ddlop3:	in	a,(vcstat)
	or	a
	jp	p,ddlop3
	in	a,(vcdata)
	ex	af,af'
	ld	a,b		; change address,
	out	(vccmd),a
	ld	a,d
	or	08h		; attribute ram
	out	(vcrdat),a
	ld	a,c
	out	(vccmd),a
	ld	a,e
	out	(vcrdat),a
	ld	a,strcmd
	out	(vccmd),a
	ex	af,af'
	out	(vcdata),a
	pop	bc
	dec	hl
	dec	hl
	dec	de
	dec	de
	dec	bc
	ld	a,b
	or	c
	jp	nz,mddr2
mdexlp:	in	a,(vcstat)
	or	a
	jp	p,mdexlp
	ret

dltlin:	call	carret		; do a carriage return
	ld	a,(crow)
	or	a
	jr	z,dscroll	; special scroll			wm01
	ld	de,(cursor)
	ld	hl,linesiz
	cp	23
	jp	nc,clrdis	; clear last line or status line, exit
	cp	11
	jr	nc,dltl1a	; normal delete line, lines 11-22
	ex	de,hl		; de=linesiz, hl=cursor
	ld	bc,linesiz-1
	add	hl,bc		; hl=end of current line=dest
	ld	a,h
	and	07h		; qualify it
	ld	h,a		; hl=dest.
	ld	b,h
	ld	c,l		; bc=dest.
	sbc	hl,de		; hl=source
	ld	a,h
	and	7h		; qualify it
	ld	h,a		; source in hl
	push	hl		; save source
	ld	de,(vrbase)
	sbc	hl,de		; hl=source-vrbase
	jr	nc,dltl2b	; true count if no carry
	ld	hl,0800h
	or	a		; clear carry
	sbc	hl,de
	pop	de		; source in de
	add	hl,de		; count in hl
	ld	a,h
	and	07h
	ld	h,b
	ld	b,a
	ld	a,l
	ld	l,c
	ld	c,a
	ex	de,hl		; hl=source, de=dest., bc=count
dscrla:	inc	bc		; count=count-1
	call	mddr
dscroll:call	mvsts		; scroll, saving status line
	ld	hl,(cursor)
	ld	de,linesiz
	add	hl,de
	ex	de,hl		; new cursor position in de
	jp	putcur		; place cursor and exit

dltl2b:	ld	d,b
	ld	e,c		; de=dest.
	ld	b,h
	ld	c,l		; bc=count
	pop	hl		; hl=source
	jr	dscrla		; go do it

dltl1a:	add	hl,de		; source = linesiz+destination
	ld	a,h
	and	7h		; qualify it,
	ld	d,a
	ld	e,l		; put source in de.
	ld	hl,(vrbase)
	ld	bc,lastlin+linesiz
	add	hl,bc		; lastpos=vrbase+(lastlin+linesiz)
	ld	a,h
	and	07h		; qualify it,
	ld	h,a		; put it back in hl,
	ld	b,a
	ld	c,l		; save lastpos in bc.
	sbc	hl,de		; hl=lastpos-source
	jr	nc,dltl3a	; valid if no carry,
	ld	hl,0800h	; else put boundry in hl,
	or	a		; clear carry
	sbc	hl,de		; hl=boundry-source
	add	hl,bc		; +lastpos
dltl3a:	ld	b,h		; put count in bc
	ld	c,l
	ld	hl,(cursor)	; dest
	ex	de,hl		; in de, source in hl
	call	mdir		; move it.
	ld	hl,(vrbase)
	ld	de,lastlin
	add	hl,de
	ld	a,h
	and	07h
	ld	d,a
	ld	e,l		; last line in de
	ld	hl,linesiz
	jp	clrdis		; clear the last line

; insert a line

inslin:	ld	a,(crow)
	cp	12
	jp	nc,insln2	; 'normal' insert line
	ld	hl,(vrbase)	; source
	ld	de,linesiz
	or	a		; clear carry
	sbc	hl,de		; hl = new vrbase
	ld	a,h
	and	07h		; qualify it
	ld	h,a
	ex	de,hl		; dest in de,
	ld	bc,scrcmd	; scroll
	call	regrst
	ld	hl,(cursor)
	ld	bc,(vrbase)
	or	a
	sbc	hl,bc
	jr	nc,insl2a	; hl=amount
	ld	hl,0800h
	or	a		; clear carry flag
	sbc	hl,bc		; hl=800h-source
	ld	a,h
	and	07h
	ld	h,a
	ld	bc,(cursor)
	add	hl,bc
insl2a:	ld	a,h
	and	07h
	ld	b,a
	ld	c,l		; amount in bc
; test
	ld	hl,80+48
	add	hl,bc
	ld	a,h
	and	07h
	ld	b,a
	ld	c,l
;
	ld	hl,(vrbase)	; source in hl
; test
	ld	de,23*linesiz
	add	hl,de
	ld	a,h
	and	07h
	ld	h,a
	ex	de,hl
	ld	hl,80
	add	hl,de		; source in hl, dest in de
	ld	a,h
	and	07h
	ld	h,a
;
	call	mdir
	ld	hl,(cursor)
	ld	bc,linesiz
	or	a		; clear carry
	sbc	hl,bc
	ld	a,h
	and	07h
	ld	h,a		; qualify address
	ex	de,hl		; put in de
	ld	a,(ccol)
	ld	c,a
	ld	b,0
	ld	hl,linesiz
	sbc	hl,bc		; hl=amount
	push	de		; save new cursor address
	push	hl
	call	clrdis		; clear to end of inserted line
	pop	bc		; amount
	push	bc
	ld	hl,(cursor)
	ld	a,(ccol)
	ld	e,a
	ld	d,0
	or	a
	sbc	hl,de
	ld	a,h
	and	07h
	ld	d,a
	ld	e,l		; dest in de
	ld	hl,(cursor)	; source in hl
	call	mdir
	pop	bc		; amount
	ld	hl,linesiz
	or	a
	sbc	hl,bc
	call	nz,clrdis
	ld	hl,(vrbase)
	ld	bc,linesiz
	or	a
	sbc	hl,bc
	ld	a,h
	and	07h
	ld	h,a
	ld	(vrbase),hl	; new vr base, 
	pop	de
	jp	putcur		; put cursor and exit

insln2:	sub	22
	jr	z,inl33
	jp	nc,clreol
	neg			; two's complement, number of lines to move
	push	af
	ld	hl,(vrbase)
	ld	de,79+22*80	; source
	ld	bc,80
	add	hl,de
	ld	a,h
	and	07h
	ld	d,a
	ld	e,l
	add	hl,bc		; destination
	ld	a,h
	and	07h
	ld	h,a
	ex	de,hl		; hl:=source, de:=dest.
	pop	af
	push	hl
	ld	hl,0
inl22:	add	hl,bc
	dec	a
	jr	nz,inl22
	ld	b,h
	ld	c,l		; bc=amount
	pop	hl		; restore source to hl
	call	mddr		; move them
inl33:	ld	hl,(cursor)	; source in de,
	ld	d,h
	ld	e,l
	ld	a,(ccol)
	ld	c,a		; amount to clear, next line
	ld	a,80
	sub	c		; amount to move and distance to go
	ld	c,a
	ld	b,0
	add	hl,bc		; dest. in hl,
	ld	a,h
	and	07h
	ld	h,a
	ex	de,hl		; now hl=source, de=dest, bc=amount
	call	mdir		; move the rest to beginning of next line
	ld	a,(ccol)
	ld	l,a
	ld	h,0
	or	a
	call	nz,clrdis	; clear to the end of the next line,
	jp	clreol		; clear to the end of this one.

	defw	0000h

	end