[z180-stamp-cpm3.git] / cbios / utils.180

==== BASE ====
	title 'general utility routines'

	; i/o port init routines

	public ioiniml,ioini1l		;

	; math

	public ijphl			; vectored CALL point
	public add_hla			; add a to hl
	public div32_16,div32_r		; divide 32 bit by 16 bit number (rounded)

	; print utils

	public ?pmsg			; print message
	public pr.idx			; print message from table indexed by <A>
	public pr.inln,pr.crlf		; print message inline, print newline
	public phex2,phex4		; print 2 digit hex <A> or 4 digit hex <HL>
	public pr.dec,pr.decl		; print 16 or 32 bit decimal number
	public pr.errors		; print BIOS disk error message header


	extrn ?const,?conin,?cono
	extrn @adrv,@trk,@sect		; used by disk error message
	extrn @op,@ermde

;-------------------------------------------------------------------------------

cr	equ	13
lf	equ	10
bell	equ	7


	dseg

;----------------------------------------------------------------------
; output bytes to consecutive portaddresses
;
;     hl: table with following structure:
;        db n, port1, val1, val2,... valn
;        db m, port1, val1, val2,... valm
;        ...
;        db 0 ; Terminate table

ioiniml:
	push	bc
	xor	a
ioml_lp:
	ld	b,(hl)
	inc	hl
	cp	b
	jr	z,ioml_e

	ld	c,(hl)
	inc	hl
	otimr
	jr	ioml_lp
ioml_e:
	pop	bc
	ret

;----------------------------------------------------------------------
; output bytes to ports
;
;     hl: tables of port,value pairs:
;         db n, port1,val1, port2,val2,... portn,valn
;         ...
;         db 0 ; Terminate table

ioini1l:
	push	bc
	jr	io1_nxt
io1_lp:
	ld	c,(hl)		;port address
	inc	hl
	otim
	jr	nz,io1_lp
io1_nxt:
	ld	b,(hl)		;count
	inc	hl
	inc	b
	djnz	io1_lp

	pop	bc
	ret
;--------------------------------------------------------------------
; vectored CALL point

ijphl:
	jp	(hl)

;--------------------------------------------------------------------
; add a to hl
;
;    return:
;       hl = hl + a
;       Flags undefined

add_hla:
	add	a,l
	ld	l,a
	ret	nc
	inc	h
	ret

;--------------------------------------------------------------------
; rounded div 32 by 16 bit
;
;	DEHL:	Dividend (x)
;	BC:	Divisor  (y)
;    return:
;	HLDE: 	Rounded Quotient (q)
;	BC:   	Remainder	       (r)

div32_r:
	push bc
	srl	b		;y/2
	rr	c
	add	hl,bc		;low x + y/2
	pop	bc
	jr	nc,div_r1
	inc	de
div_r1:
	;fall thru

;--------------------------------------------------------------------
; Divide 32 bit by 16
;
;    DEHL:	Dividend (x)
;    BC:	Divisor  (y)
;
;  return:
;    DEHL:	Quotient
;    BC:	Reminder

div32_16:
	exx			;low
	push	de		;save alternate registers (de,bc)
	push	bc
	exx			;high
	push	hl		;lx
	push	bc		;ly
	ld	bc,0		;bc  = hy = 0
	ld	h,b		;hl  = hr = 0
	ld	l,c
				;de = x, hl = r
	exx			;low
	pop	bc		;bc' = ly
	ex	(sp),hl		;hl' = lx, save alternate hl
	ld	de,0		;de' = lr = 0
	ex	de,hl		;de = x, hl = r
	exx			;high
	ld	a,32		;count
;
; start:
;     de: x	(de: hx, de': lx)
;     bc: y	(bc: hy, bc': ly)
;     hl: 0
;
div_lp:				;do
	exx			;    low
	ex	de,hl		;    x
	add	hl,hl		;    x <<= 1
	exx			;    high
	ex	de,hl		;    x
	adc	hl,hl		;    x <<= 1
	exx			;    low
	ex	de,hl		;    r
	adc	hl,hl		;    r <<= 1
	exx			;    high
	ex	de,hl		;    r
	adc	hl,hl		;    r <<= 1
	exx			;    low
	inc	de		;    x/q += 1
	or	a		;
	sbc	hl,bc		;
	exx			;    high
	sbc	hl,bc		;
	jr	nc,div_no_restore
	exx			;        low
	dec	de		;
	add	hl,bc		;        r += y
	exx			;        high
	adc	hl,bc		;

div_no_restore:			;
	dec	a		;
	jr	nz,div_lp	;while (--count)

; result:
;     de: q	(de: hq, de': lq)
;     hl: r	(hl: hr, hl': lr)

	exx			;low
	ex	de,hl		;hl = lq,  de = lr

	ex	(sp),hl		;lq
	push	de		;lr
	exx			;high
	pop	bc		;bc = lr
	pop	hl		;de = lq

	exx			;low
	pop	bc		;restore alternate registers
	pop	de
	exx			;high
	ret

;-------------------------------------------------------------------------------
; print message @<HL> up to a null
; saves <BC> & <DE>

?pmsg:
	push	bc
	push	de
pmsg$loop:
	ld	a,(hl)
	inc	hl
	or	a
	jr	z,pmsg$exit
	ld	c,a
	push	hl
	call	?cono
	pop	hl
	jr	pmsg$loop
pmsg$exit:
	pop	de
	pop	bc
	ret

;-------------------------------------------------------------------------------
; print message from table @<HL>, indexed by <A>
; saves <BC> & <DE>

pr.idx:
	push	bc
	push	de
	push	hl		; put pointer to first message on stack
	ld	e,a		; save message number
	xor	a
	ld	b,a
	ld	c,a
	inc	e
pdc_nxt_str:
	dec	e
	ex	(sp),hl
	jr	z,pdc_found
	ex	(sp),hl
	cpir
	cp	(hl)
	jr	nz,pdc_nxt_str
				; End of List, msg not found.
				; Print first msg.
pdc_found:
	pop	hl
	call	?pmsg
	pop	de
	pop	bc
	ret

;-------------------------------------------------------------------------------
; print message inline up to a null
; saves all registers

pr.inln:
	ex	(sp),hl
	push	af
	call	?pmsg
	pop	af
	ex	(sp),hl
	ret

;-------------------------------------------------------------------------------
; print <CR><LF>
; saves all registers

pr.crlf:
	call	pr.inln
	db	cr,lf,0
	ret

;-------------------------------------------------------------------------------
; print hl as a 4 digit hexadecimal number
; saves all registers

phex4:
	ld a,h
	call phex2
	ld a,l
	; fall thru

;-------------------------------------------------------------------------------
; print a as a 2 digit hexadecimal number
; saves all registers

phex2:
	push	af
	rra
	rra
	rra
	rra
	call	print.digit
	pop	af

print.digit:
	push	hl
	push	de
	push	bc
	push	af
	and	00fh
	cp	10
	jr	c,prd_1
	add	a,007h
prd_1:
	add	a,'0'

	ld	c,a
	call	?cono
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret


;-------------------------------------------------------------------------------
; print decimal 16 bit number from HL
;
;	HL: unsigned binary number to print
;	 C: minimum print field width
;	    number is prined right-aligned
;	 B: pad character, typically ' ' or '0'

pr.dec:
	push	de
	ld	de,0
	call	pr.decl
	pop	de
	ret

;-------------------------------------------------------------------------------
; print decimal 32 bit number from DEHL
;
;	DEHL: unsigned binary number to print
;	   C: minimum print field width
;	      number is prined right-aligned
;	   B: pad character, typically ' ' or '0'

pr.decl:
	push	bc		;save width and fillchar
	push	bc
	exx			;(alt)
	ex	(sp),hl		;save hl', get width and fill
	push	de		;save de'

	xor	a
	ld	d,a		;clear counter
	ld	e,a
	push	af		; string terminator
	inc	sp

prd_divloop:			;do
	exx			;    (main)
	ld	bc,10		;
	call	div32_16	;    get a digit
	ld	a,c		;
	add	a,'0'		;    make it printable
	push	af		;

	ld	a,h		;
	or	l		;
	or	d		;
	or	e		;
	exx			;    (alt)
	inc	sp		;
	inc	de		;
	jr	nz,prd_divloop	;

prd_filloop:			;h=filler, l=field width
	ld	a,e
	cp	l
	jr	nc,prd_out
	push	hl
	inc	sp
	inc	de
	jr	prd_filloop
prd_out:
	ld	hl,0
	add	hl,sp		;ptr to beginning of number string (hl==0 here)
	call	?pmsg
	ex	de,hl
	add	hl,sp
	ld	sp,hl
	inc	sp		;remove string terminator
	pop	de
	pop	hl
	exx			;(main)
	pop	bc
	ret


;-------------------------------------------------------------------------------

?pderr:
	ld	hl,drive$msg
	call	?pmsg		; error header
	ld	a,(@adrv)
	add	a,'A'
	ld	c,a
	call	?cono		; drive code
	ld	hl,track$msg
	call	?pmsg		; track header
	ld	c,0
	ld	hl,(@trk)
	call	pr.dec		; track number
	ld	hl,sector$msg
	call	?pmsg		; sector header
	ld	hl,(@sect)
	jp	pr.dec		; sector number

	; error message components
drive$msg:	db	cr,lf,bell,'BIOS Error on ',0
track$msg:	db	': T-',0
sector$msg:	db	', S-',0


;-------------------------------------------------------------------------------
; get console input, echo it, and shift to upper case
; save hl,de,bc

uciecho:
	push	hl
	push	de
	push	bc
u$c0:
	call	?const
	or	a
	jr	z,u$c1		; see if any char already struck
	call	?conin
	jr	u$c0		; yes, eat it and try again
u$c1:
	call	?conin
	push	af
	ld	c,a
	cp	' '-1
	call	nc,?cono
	pop	af
	pop	bc
	pop	de
	pop	hl
	cp	'a'
	ret	c
	sub	'a'-'A'		; make upper case
	ret

;-------------------------------------------------------------------------------
;

pr.errors:

	; suppress error message if BDOS
	; is returning errors to application...

	ld	a,(@ermde)
	inc	a
	jr	nz,pre1
	dec	a		;return NZ, if @ermde == 0FFH
	ret
pre1:
	push	hl
	ld	hl,pre2
	ex	(sp),hl
	push	hl

	; Had permanent error, print message like:
	; BIOS Err on d: T-nn, S-mm, <operation> <type>, Retry ?

	call	?pderr		; print message header

	ld	hl,op$msg
	ld	a,(@op)
	jp	pr.idx		; last function (read or write)

pre2:
				; prompt for retry
	call	pr.inln
	db	' Retry (Y/N) ? ',0

	call	uciecho		; get operator response
	cp	'Y'
	ret			; return Z-flag for yes


op$msg:
	db	', Unknown op, ',0
	db	', Read, ',0
	db	', Write, ',0
	db	0

	end
Commit	Line	Data
6dd88c25 L	1	==== BASE ====
	2	title 'general utility routines'
	3
	4	; i/o port init routines
	5
	6	public ioiniml,ioini1l ;
	7
	8	; math
	9
	10	public ijphl ; vectored CALL point
	11	public add_hla ; add a to hl
	12	public div32_16,div32_r ; divide 32 bit by 16 bit number (rounded)
	13
	14	; print utils
	15
	16	public ?pmsg ; print message
	17	public pr.idx ; print message from table indexed by <A>
	18	public pr.inln,pr.crlf ; print message inline, print newline
	19	public phex2,phex4 ; print 2 digit hex <A> or 4 digit hex <HL>
	20	public pr.dec,pr.decl ; print 16 or 32 bit decimal number
	21	public pr.errors ; print BIOS disk error message header
	22
	23
	24
	25	extrn ?const,?conin,?cono
	26	extrn @adrv,@trk,@sect ; used by disk error message
	27	extrn @op,@ermde
	28
	29	;-------------------------------------------------------------------------------
	30
	31	cr equ 13
	32	lf equ 10
	33	bell equ 7
	34
	35
	36	dseg
	37
	38	;----------------------------------------------------------------------
	39	; output bytes to consecutive portaddresses
	40	;
	41	; hl: table with following structure:
	42	; db n, port1, val1, val2,... valn
	43	; db m, port1, val1, val2,... valm
	44	; ...
	45	; db 0 ; Terminate table
	46
	47	ioiniml:
	48	push bc
	49	xor a
	50	ioml_lp:
	51	ld b,(hl)
	52	inc hl
	53	cp b
	54	jr z,ioml_e
	55
	56	ld c,(hl)
	57	inc hl
	58	otimr
	59	jr ioml_lp
	60	ioml_e:
	61	pop bc
	62	ret
	63
	64	;----------------------------------------------------------------------
65	; output bytes to ports
66	;
67	; hl: tables of port,value pairs:
68	; db n, port1,val1, port2,val2,... portn,valn
69	; ...
70	; db 0 ; Terminate table
71
72	ioini1l:
73	push bc
74	jr io1_nxt
75	io1_lp:
76	ld c,(hl) ;port address
77	inc hl
78	otim
79	jr nz,io1_lp
80	io1_nxt:
81	ld b,(hl) ;count
82	inc hl
83	inc b
84	djnz io1_lp
85
86	pop bc
87	ret
88	;--------------------------------------------------------------------
89	; vectored CALL point
90
91	ijphl:
92	jp (hl)
93
94	;--------------------------------------------------------------------
95	; add a to hl
96	;
97	; return:
98	; hl = hl + a
99	; Flags undefined
100
101	add_hla:
102	add a,l
103	ld l,a
104	ret nc
105	inc h
106	ret
107
108	;--------------------------------------------------------------------
109	; rounded div 32 by 16 bit
110	;
111	; DEHL: Dividend (x)
112	; BC: Divisor (y)
113	; return:
114	; HLDE: Rounded Quotient (q)
115	; BC: Remainder (r)
116
117	div32_r:
118	push bc
119	srl b ;y/2
120	rr c
121	add hl,bc ;low x + y/2
122	pop bc
123	jr nc,div_r1
124	inc de
125	div_r1:
126	;fall thru
127
128	;--------------------------------------------------------------------
129	; Divide 32 bit by 16
130	;
131	; DEHL: Dividend (x)
132	; BC: Divisor (y)
133	;
134	; return:
135	; DEHL: Quotient
136	; BC: Reminder
137
138	div32_16:
139	exx ;low
140	push de ;save alternate registers (de,bc)
141	push bc
142	exx ;high
143	push hl ;lx
144	push bc ;ly
145	ld bc,0 ;bc = hy = 0
146	ld h,b ;hl = hr = 0
147	ld l,c
148	;de = x, hl = r
149	exx ;low
150	pop bc ;bc' = ly
151	ex (sp),hl ;hl' = lx, save alternate hl
152	ld de,0 ;de' = lr = 0
153	ex de,hl ;de = x, hl = r
154	exx ;high
155	ld a,32 ;count
156	;
157	; start:
158	; de: x (de: hx, de': lx)
159	; bc: y (bc: hy, bc': ly)
160	; hl: 0
161	;
162	div_lp: ;do
163	exx ; low
164	ex de,hl ; x
165	add hl,hl ; x <<= 1
166	exx ; high
167	ex de,hl ; x
168	adc hl,hl ; x <<= 1
169	exx ; low
170	ex de,hl ; r
171	adc hl,hl ; r <<= 1
172	exx ; high
173	ex de,hl ; r
174	adc hl,hl ; r <<= 1
175	exx ; low
176	inc de ; x/q += 1
177	or a ;
178	sbc hl,bc ;
179	exx ; high
180	sbc hl,bc ;
181	jr nc,div_no_restore
182	exx ; low
183	dec de ;
184	add hl,bc ; r += y
185	exx ; high
186	adc hl,bc ;
187
188	div_no_restore: ;
189	dec a ;
190	jr nz,div_lp ;while (--count)
191
192	; result:
193	; de: q (de: hq, de': lq)
194	; hl: r (hl: hr, hl': lr)
195
196	exx ;low
197	ex de,hl ;hl = lq, de = lr
198
199	ex (sp),hl ;lq
200	push de ;lr
201	exx ;high
202	pop bc ;bc = lr
203	pop hl ;de = lq
204
205	exx ;low
206	pop bc ;restore alternate registers
207	pop de
208	exx ;high
209	ret
210
211	;-------------------------------------------------------------------------------
212	; print message @<HL> up to a null
213	; saves <BC> & <DE>
214
215	?pmsg:
216	push bc
217	push de
218	pmsg$loop:
219	ld a,(hl)
220	inc hl
221	or a
222	jr z,pmsg$exit
223	ld c,a
224	push hl
225	call ?cono
226	pop hl
227	jr pmsg$loop
228	pmsg$exit:
229	pop de
230	pop bc
231	ret
232
233	;-------------------------------------------------------------------------------
234	; print message from table @<HL>, indexed by <A>
235	; saves <BC> & <DE>
236
237	pr.idx:
238	push bc
239	push de
240	push hl ; put pointer to first message on stack
241	ld e,a ; save message number
242	xor a
243	ld b,a
244	ld c,a
245	inc e
246	pdc_nxt_str:
247	dec e
248	ex (sp),hl
249	jr z,pdc_found
250	ex (sp),hl
251	cpir
252	cp (hl)
253	jr nz,pdc_nxt_str
254	; End of List, msg not found.
255	; Print first msg.
256	pdc_found:
257	pop hl
258	call ?pmsg
259	pop de
260	pop bc
261	ret
262
263	;-------------------------------------------------------------------------------
264	; print message inline up to a null
265	; saves all registers
266
267	pr.inln:
268	ex (sp),hl
269	push af
270	call ?pmsg
271	pop af
272	ex (sp),hl
273	ret
274
275	;-------------------------------------------------------------------------------
276	; print <CR><LF>
277	; saves all registers
278
279	pr.crlf:
280	call pr.inln
281	db cr,lf,0
282	ret
283
284	;-------------------------------------------------------------------------------
285	; print hl as a 4 digit hexadecimal number
286	; saves all registers
287
288	phex4:
289	ld a,h
290	call phex2
291	ld a,l
292	; fall thru
293
294	;-------------------------------------------------------------------------------
295	; print a as a 2 digit hexadecimal number
296	; saves all registers
297
298	phex2:
299	push af
300	rra
301	rra
302	rra
303	rra
304	call print.digit
305	pop af
306
307	print.digit:
308	push hl
309	push de
310	push bc
311	push af
312	and 00fh
313	cp 10
314	jr c,prd_1
315	add a,007h
316	prd_1:
317	add a,'0'
318
319	ld c,a
320	call ?cono
321	pop af
322	pop bc
323	pop de
324	pop hl
325	ret
326
327
328	;-------------------------------------------------------------------------------
329	; print decimal 16 bit number from HL
330	;
331	; HL: unsigned binary number to print
332	; C: minimum print field width
333	; number is prined right-aligned
334	; B: pad character, typically ' ' or '0'
335
336	pr.dec:
337	push de
338	ld de,0
339	call pr.decl
340	pop de
341	ret
342
343	;-------------------------------------------------------------------------------
344	; print decimal 32 bit number from DEHL
345	;
346	; DEHL: unsigned binary number to print
347	; C: minimum print field width
348	; number is prined right-aligned
349	; B: pad character, typically ' ' or '0'
350
351	pr.decl:
352	push bc ;save width and fillchar
353	push bc
354	exx ;(alt)
355	ex (sp),hl ;save hl', get width and fill
356	push de ;save de'
357
358	xor a
359	ld d,a ;clear counter
360	ld e,a
361	push af ; string terminator
362	inc sp
363
364	prd_divloop: ;do
365	exx ; (main)
366	ld bc,10 ;
367	call div32_16 ; get a digit
368	ld a,c ;
369	add a,'0' ; make it printable
370	push af ;
371
372	ld a,h ;
373	or l ;
374	or d ;
375	or e ;
376	exx ; (alt)
377	inc sp ;
378	inc de ;
379	jr nz,prd_divloop ;
380
381	prd_filloop: ;h=filler, l=field width
382	ld a,e
383	cp l
384	jr nc,prd_out
385	push hl
386	inc sp
387	inc de
388	jr prd_filloop
389	prd_out:
390	ld hl,0
391	add hl,sp ;ptr to beginning of number string (hl==0 here)
392	call ?pmsg
393	ex de,hl
394	add hl,sp
395	ld sp,hl
396	inc sp ;remove string terminator
397	pop de
398	pop hl
399	exx ;(main)
400	pop bc
401	ret
402
403
404	;-------------------------------------------------------------------------------
405
406	?pderr:
407	ld hl,drive$msg
408	call ?pmsg ; error header
409	ld a,(@adrv)
410	add a,'A'
411	ld c,a
412	call ?cono ; drive code
413	ld hl,track$msg
414	call ?pmsg ; track header
415	ld c,0
416	ld hl,(@trk)
417	call pr.dec ; track number
418	ld hl,sector$msg
419	call ?pmsg ; sector header
420	ld hl,(@sect)
421	jp pr.dec ; sector number
422
423	; error message components
424	drive$msg: db cr,lf,bell,'BIOS Error on ',0
425	track$msg: db ': T-',0
426	sector$msg: db ', S-',0
427
428
429	;-------------------------------------------------------------------------------
430	; get console input, echo it, and shift to upper case
431	; save hl,de,bc
432
433	uciecho:
434	push hl
435	push de
436	push bc
437	u$c0:
438	call ?const
439	or a
440	jr z,u$c1 ; see if any char already struck
441	call ?conin
442	jr u$c0 ; yes, eat it and try again
443	u$c1:
444	call ?conin
445	push af
446	ld c,a
447	cp ' '-1
448	call nc,?cono
449	pop af
450	pop bc
451	pop de
452	pop hl
453	cp 'a'
454	ret c
455	sub 'a'-'A' ; make upper case
456	ret
457
458	;-------------------------------------------------------------------------------
459	;
460
461	pr.errors:
462
463	; suppress error message if BDOS
464	; is returning errors to application...
465
466	ld a,(@ermde)
467	inc a
468	jr nz,pre1
469	dec a ;return NZ, if @ermde == 0FFH
470	ret
471	pre1:
472	push hl
473	ld hl,pre2
474	ex (sp),hl
475	push hl
476
477	; Had permanent error, print message like:
478	; BIOS Err on d: T-nn, S-mm, <operation> <type>, Retry ?
479
480	call ?pderr ; print message header
481
482	ld hl,op$msg
483	ld a,(@op)
484	jp pr.idx ; last function (read or write)
485
486	pre2:
487	; prompt for retry
488	call pr.inln
489	db ' Retry (Y/N) ? ',0
490
491	call uciecho ; get operator response
492	cp 'Y'
493	ret ; return Z-flag for yes
494
495
496	op$msg:
497	db ', Unknown op, ',0
498	db ', Read, ',0
499	db ', Write, ',0
500	db 0
501
502	end