title	Number of Conversions
	name	('CONV')

;
; Complete package of different number conversions
; Based upon an article of BYTE, September 1976
;
; Written by W.Cirsovius
;
; It consists of:
;
; 1. Binary numbers
; 2. Octal numbers
; 3: Hexadecimal numbers
; 4: Signed decimal numbers
;
; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
; ! NOTE: Unfortunately the input handling for signed
; !      decimal numbers fail if a negative sign is detected. !
; !      In this version I changed the routine DIN a bit      !
; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;
	entry	bin,oin,xin,din
;
	entry	bot,oot,xot,dot
;
	entry	$memry

OS	equ	0000h
BDOS	equ	0005h
TPATOP	equ	BDOS+1

.condir	equ	6

_get	equ	0fdh

null	equ	00h
lf	equ	0ah
cr	equ	0dh
;
; -------------------------------------------------
; ***************** I/O Interface *****************
; -------------------------------------------------
;
; Get character from console to Accu and close line
;
CINnl:
	call	CIN		; Get character
	push	af
	call	nl		; Give new line
	pop	af		; Get back character
	ret
;
; Get character from console to Accu
;
get:
	call	CIN		; Get character
	push	hl
	ld	hl,(Numptr)	; Get pointer
	ld	(hl),a		; Store character
	inc	hl		; Update pointer
	ld	(Numptr),hl
	pop	hl
	ret
;
CIN:
	ld	a,_get
	call	COT		; Get character
	cp	'C'-'@'		; Test abort
	jr	z,abort
	call	upcase		; As upper case
	push	af
	call	COT		; Echo it
	pop	af
	ret
abort:
	ld	hl,aborted
	call	COTs		; Tell aborted
	jp	OS
;
; Close console line
;
nl:
	ld	a,cr
	call	COT		; Give sequence
	ld	a,lf
;
; Put character in Accu to console
;
put	equ	$
COT:
	push	bc
	push	de
	push	hl
	ld	e,a		; Get character
	ld	c,.condir
	call	BDOS		; Put character
	pop	hl
	pop	de
	pop	bc
	ret
;
; Put string in reg HL to console
;
COTs:
	ld	a,(hl)		; Get character
	or	a		; Test end
	ret	z		; Yeap
	call	COT		; Put to console
	inc	hl
	jr	COTs
;
; Convert character to upper case
;
upcase:
	cp	'a'		; Test case
	ret	c
	cp	'z'+1
	ret	nc
	add	a,'A'-'a'	; Convert
	ret
;
; Jump thru reg DE
;
jpde:
	ex	de,hl		; Get address
	jp	(hl)		; Execute it
;
; Add byte to address
;
adda:
	add	a,l		; Add low
	ld	l,a
	ret	nc		; That's it
	inc	h		; Remember carry
	ret
;
; ##################################################
;
; Enter package
;
CONV:
	ld	sp,(TPATOP)	; Get stack
	ld	hl,howtoend
	call	COTs		; Tell how to stop
illBase:
	ld	hl,($memry)
	ld	(hl),' '	; Blank first character
	inc	hl
	ld	(Numptr),hl	; Init pointer
	ld	hl,askbase
	call	COTs		; Ask for number base
	call	CINnl		; Get mode
	sub	'0'		; Verify valid range
	jr	c,illBase
	cp	'3'-'0'+1
	jr	nc,illBase
	add	a,a		; Double input
	push	af
	ld	hl,NUMTYP
	call	adda		; Position in type table
	ld	e,(hl)		; Get address
	inc	hl
	ld	d,(hl)
	pop	af
	push	de
	ld	hl,NUMINT
	call	adda		; Position in conversion table
	ld	e,(hl)		; Get address
	inc	hl
	ld	d,(hl)
	pop	hl		; Get back type
	ld	(Numbase),hl
	call	COTs		; Ask for number
	ld	hl,asknum
	call	COTs
	call	jpde		; Execute input
	call	nl		; Give new line
	ld	(Numres),hl	; Save result
	ld	hl,(Numptr)	; Get last pointer
	dec	hl		; Position to end character
	ld	(hl),null	; Close line
	ld	hl,resnum
	call	COTs		; Tell result
	ld	hl,(Numbase)
	call	COTs
	ld	hl,($memry)	; Get input
	call	COTs		; Tell it
	ld	hl,BINS
	ld	de,bot
	call	execNum		; Tell modes
	ld	hl,OCTS
	ld	de,oot
	call	execNum
	ld	hl,HEXS
	ld	de,xot
	call	execNum
	ld	hl,DECS
	ld	de,dot
	call	execNum
	call	nl		; Give new line
	jp	illBase		; Loop till abort
;
; Execute number output
;
execNum:
	push	de		; Set output routine
	call	COTs		; Tell base
	ld	hl,(Numres)	; Get number
	ld	b,l
	ret			; Do output
;
$memry:
	ds	2
howtoend:
	db	'Type ^C to end conversion'
	db	cr,lf,lf,null
aborted:
	db	cr,lf
	db	'... aborted'
	db	cr,lf,null
askbase:
	db	'Number base - 0: Binary, 1: Octal, 2: Hex, 3:Decimal :',null
asknum:
	db	' number :',null
resnum:
	db	'Result of ',null
NUMTYP:
	dw	Sbin,Soin,Sxin,Sdin
Sbin:
	db	'Binary',null
Soin:
	db	'Octal',null
Sxin:
	db	'Hex',null
Sdin:
	db	'Decimal',null
NUMINT:
	dw	bin.in,oin.in,xin,din
BINS:
	db	': binary=',null
OCTS:
	db	', octal=',null
HEXS:
	db	', hex=',null
DECS:
	db	', decimal=',null
Numres:
	ds	2
Numptr:
	ds	2
Numbase:
	ds	2
;
; ----------------------------------------------
; ***************** Input hooks ****************
; ----------------------------------------------
;
bin.in:
	call	bin		; Get number into reg B
	jr	xpnd		; Expand it
oin.in:
	call	oin		; Get number into reg B
xpnd:
	ld	l,b		; Expnad to 16 bit
	ld	h,0
	ret
;
; -------------------------------------------------
; ***************** Input routines ****************
; -------------------------------------------------
;
; Input binary to reg B
;
bin:
	ld	b,0		; ANSWER := 0;
binloop:
	call	get		; A := INPUT [character];
	cp	'0'		; is A LT '0'?
	ret	c		; if so then return;
	cp	'1'+1		; is A LT '2'?
	ret	nc		; if not then return;
	rra			; CARRY := A0;
	ld	a,b		; A := ANSWER;
	rla			; rotate carry into A;
	ret	c		; overflow: if CARRY = 1 then return;
	ld	b,a		; ANSWER := A;
	jr	binloop		; reiterate for next bit;
;
; Input octal to reg B
;
oin:
	ld	b,0		; ANSWER :=0;
oinloop:
	call	get		; A := INPUT [character];
	cp	'0'		; is A LT '0'?
	ret	c		; if so then return;
	cp	'7'+1		; is A LT '8'?
	ret	nc		; If not then return;
	and	00000111b	; A := A & b'00000111' [mask loworder];
	ld	c,a		; C := A;
	ld	a,b		; A := ANSWER;
	rlca			; rotate A left three
	ret	c		;   bit positions
	rlca			;   and check for
	ret	c		;   overflow into
	rlca			;   CARRY after
	ret	c		;   each operation;
	or	c		; A := A OR ANSWER;
	ld	b,a		; ANSWER := A;
	jr	oinloop		; reiterate for next digit;
;
; Input hexadecimal to reg HL
;
xin:
	ld	hl,0		; ANSWER := 0;
xinloop:
	call	get		; A := INPUT [character];
	cp	'0'		; is A LT '0'?
	ret	c		; if so then return;
	cp	'9'+1		; is A LT ':' [numerics]?
	jr	c,xinshift	; if so then go shift it in;
	cp	'A'		; is A LT 'A'?
	ret	c		; if so then return;
	cp	'F'+1		; is A LT'G' [alphabetic A to F]?
	ret	nc		; if not then return;
	add	a,'A'-'9'+1	; A := A + 9 [convert to hexadezimal];
xinshift:
	and	00001111b	; A := A & b'00001111' [mask low order];
	add	hl,hl		; shift ANSWER register pair
	ret	c		;     left four bit
	add	hl,hl		;     positions using
	ret	c		;     double byte addition
	add	hl,hl		;     and test each
	ret	c		;     operation for
	add	hl,hl		;     an overflow error
	ret	c		;     return condition;
	or	l		; A := A OR L [add new code to lower order];
	ld	l,a		; restore low order to ANSWER;
	jr	xinloop		; reiterate for next nybble;
;
; Input decimal to reg HL
;
din:
	ld	hl,0		; ANSWER :=0;
	ld	c,0		; SIGN := 0;
	call	get		; A := INPUT (character);
	cp	'+'		; is A = '+'?
	jr	z,plusign	; if so then go save sign
	cp	'-'		; is A = '-'?
	jr	nz,dinnumb	; if not then go to numeric tests;
	dec	c		; SIGN := -1;
plusign:
	call	get		; A := INPUT (character);
dinnumb:
	push	bc
	call	cnvdec		; Convert
	pop	bc
;;	ret	c		; If overflow then return;
	inc	c		; Do we expect a negative number
	ret	nz		; Nope, return;
	xor	a
	sub	l
	ld	l,a		; Negate ANSWER;
	ld	a,c
	sbc	a,h
	ld	h,a
	ret	
;
; Convert positive ANSWER only
;
dinsign:
	call	get		; A := INPUT (character);
cnvdec:
	cp	'0'		; is A LT '0'?
	ret	c		; if so then return [not numeric];
	cp	'9'+1		; is A LT ':'?
	ccf
	ret	c		; if not then return [not numeric);
	and	00001111b	; A :=A & b'00001111' [mask low order];
	ld	c,a		; VALUE := A [save input, loworder];
	ld	b,10-1		; CNT := 9;
	ld	d,h		; MULTPLR := ANSWER [high order];
	ld	e,l		; MULTPLR := ANSWER [low order];
dinmpyp:
	add	hl,de		; ANSWER := ANSWER + MULTPLR;
	ret	c		; if CARRY := 1 then return [overflow];
	djnz	dinmpyp		; CNT := CNT-1;if CNT NE 0 then reiterate;
	add	hl,bc		; ANSWER := ANSWER + VALUE;
	ld	a,h		; A := ANSWER [high order];
	rla			; is ANSWER negative?
	jr	nc,dinsign	; reiterate with next numeric character if not;
	ret
;
; -------------------------------------------------
; **************** Output routines ****************
; -------------------------------------------------
;
; Output binary from reg B
;
bot:
	ld	c,8		; CNT := 8;
botloop:
	ld	a,b		; A := ANSWER;
	rlca			; CARRY := A7; rotate A Left;
	ld	b,a		; ANSWER:=A;
	ld	a,'0' / 2	; A :=b'00011000';
	rla			; rotate A left; A0 = CARRY;
	call	put		; OUTPUT := A;
	dec	c		; CNT :- CNT - 1;
	jr	nz,botloop	; if CNT NE 0 then repeat;
	ret			; else return;
;
; Output octal from reg B
;
oot:
	ld	c,3		; CNT := 3;
	xor	a		; Clear A; Clear CARRY;
	ld	a,b		; A := ANSWER;
	jr	ootskip		; skip around POP first time;
ootloop:
	pop	af		; restore (A, flags);
ootskip:
	rla			; rotate A left
	rla			;    by three
	rla			;    bit positions;
	push	af		; save (A, flags);
	and	00000111b	; A := A & b'00000111'
				;    [mask low order];
	or	'0'		; A := A OR b'00110000'
				;    [add hexadecimal 30];
	call	put		; OUTPUT := A;
	dec	c		; CNT:= CNT - 1;
	jr	nz,ootloop	; if CNT NE 0 then repeat;
	pop	af		; flush garbage from stack;
	ret			; return to caller;
;
; Output hexadecimal from reg HL
;
xot:
	ld	c,4		; CNT := 4;
xotloop:
	xor	a		; CARRY := 0; A := 0 [clear A, CARRY];
	add	hl,hl		; Shift four bits of ANSWER
	rla			; into A using
	add	hl,hl		; two bvte addition
	rla			; with CARRY
	add	hl,hl		; receiving each
	rla			; bit from the high
	add	hl,hl		; order due to overflow;
	rla
	cp	9+1		; is A LT 10 [test for numeric digit]?
	jr	c,xotascii	; if so then go form ASCII character code;
	add	a,'A'-'0'-10	; if not then A := A + 7 [adjust to alpha];
xotascii:
	add	a,'0'		; A := A + '0' [convert to ASCII code];
	call	put		; OUTPUT :=A;
	dec	c		; CNT := CNT - 1;
	jr	nz,xotloop	; if CNT NE 0 then repeat;
	ret			; else return to caller;
;
; Output decimal from reg HL
;
dot:
	ld	de,tenstabl	; POINTER :=addr (TENSTABL);
	push	de		; STACK := POINTER;
	ld	c,1		; NONZERO := 1;
	ld	a,h		; A := ANSWER;
	rla			; is ANSWER negative?
	jr	nc,dotposit	; if not then go to positive routine;
	ld	a,l		; \
	cpl			;  > ANSWER :=- ANSWER - 1 [low order];
	ld	l,a		; /
	ld	a,h		; \
	cpl			;  > ANSWER :- -ANSWER - 1 [high order];
	ld	h,a		; /
	inc	hl		; ANSWER := (-ANSWER-1) + 1;
	ld	a,'-'		; A := '-' [ASCII leading minus];
	call	put		; OUTPUT := A [display minus sign];
dotposit:
	ex	(sp),hl		; exchange POINTER and ANSWER;
	ld	e,(hl)		; TEMP := M(POINTER) [low order];
	inc	hl		; POINTER := POINTER + 1;
	ld	d,(hl)		; TEMP := M(POINTER) [high order];
	inc	hl		; POINTER := POINTER +1;
	ex	(sp),hl		; exchange ANSWER and POINTER;
	ld	b,0		; VALUE := 0;
dotdivid:
	ld	a,l		; \
	sub	e		;  > ANSWER := ANSWER - TEMP [low Order];
;
; !!!!!!!!!!!!!!!!!!!!!!!!!!!
; !! BUG IN ORIGINAL CODE: !!
; !!                       !!
; !! Found                 !!
; !!    ld      a,h        !!
; !! twice.                !!
; !!                       !!
; !! Must be               !!
; !!    ld      l,a        !!
; !!!!!!!!!!!!!!!!!!!!!!!!!!!
;
	ld	l,a		; /
	ld	a,h		; \
	sbc	a,d		;  > ANSWER := ANSWER - TEMP [high order];
	ld	h,a		; /
	jp	m,dotout	; if ANSWER LT 0 then go put eharacter;
	inc	b		; VALUE := VALUE + 1;
	jr	dotdivid	; reiterate, counting in VALUE;
dotout:
	add	hl,de		; ANSWER := ANSWER + TEMP;
	xor	a		; A := 0; CARRY := 0;
	or	b		; is VALUE = 0?
	jr	nz,dotprnt	; if not then go print it;
	or	c		; is NON2ERO = 0 [leading zero test];
	jr	nz,dotbypa	; if not then bypass leading zero print;
dotprnt:
	or	'0'		; A :* A OR '0' [convert VALUE to ASCII];
	ld	c,0		; NONZERO := 0 [reset zero flag];
	call	put		; OUTPUT := A [display ASCII digit];
dotbypa:
	ld	a,e		; A := TEMP [low order];
;
; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
; !!  BUG IN ORIGINAL CODE:   !!
; !!                          !!
; !! The original source      !!
; !! ends if divisor          !!
; !! TEMP = 1 [low order]     !!
; !!                          !!
; !! That is pk for all cases !!
; !! except for               !!
; !! ANSWER = 0;              !!
; !!                          !!
; !! The original code prints !!
; !! a blank in that case.    !!
; !!                          !!
; !! Now end is reached if    !!
; !! TEMP = 19 [low order].   !!
; !!                          !!
; !! But the units have to    !!
; !! be printed at last.      !!
; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;
	cp	10
	jr	nz,dotposit	; if not them reiterate
	ld	a,l
	add	a,'0'		; Output last character
	call	put
	pop	de		; then flush stack
	ret			;     and return;
;
tenstabl:
	dw	10000		; \   define constants for the
	dw	1000		; |     decimal division routine
	dw	100		;  >    (note: low Order at low
	dw	10		; /     memory address for 8080);

	end	CONV