cseg
	.phase	4800h

; B.C.D. base math routines

cr	equ	0dh

DIGBITS	equ	00001111b	; B.C.D. number bits
MANSGN	equ	00110000b	; Mantissa sign bits
EXPSGN	equ	11000000b	; Exponent sign bits

numlen	equ	8		; Length of number

NUMSTA	equ	6		; Pointer to signs and decimal places
EXPVAL	equ	NUMSTA+1	; Pointer to exponent

_r0	equ	0		; Register 0
_r1	equ	1		; Register 1
_r4	equ	4		; Register 4
_r5	equ	5		; Register 5
_r6	equ	6		; Register 6
_r7	equ	7		; Register 7
_r8	equ	8		; Register 8

ra0	equ	_r0*numlen	; Relative address of register 0
ra1	equ	_r1*numlen	; Relative address of register 1
ra4	equ	_r4*numlen	; Relative address of register 4
ra5	equ	_r5*numlen	; Relative address of register 5
ra8	equ	_r8*numlen	; Relative address of register 8

l0400	equ	0400h
l0505	equ	0505h
l0506	equ	0506h
l0508	equ	0508h
l050b	equ	050bh
l0601	equ	0601h
l0605	equ	0605h
l0609	equ	0609h
l0708	equ	0708h
l070a	equ	070ah
l0804	equ	0804h
l0805	equ	0805h
l0807	equ	0807h
l0808	equ	0808h
l080a	equ	080ah
l0905	equ	0905h
l0906	equ	0906h
l0908	equ	0908h
l090a	equ	090ah
l0a06	equ	0a06h
l0a09	equ	0a09h
l0a0b	equ	0a0bh
l0b08	equ	0b08h
l1bc0	equ	1bc0h

l0b40	equ	0b40h		; External routine to read character from keyboard
l4091	equ	4091h		; External routine to enter monitor
l43fd	equ	43fdh		; Local stack ib case of error
;
; Start of 8 byte registers - 0x00..0x7F
;
l4400	equ	4400h

;
; Register L:=0.0
;
l4800::
	call	l4f4f
	db	00h,00h,00h,00h,00h,00h,01h,00h
	ret
;
; Register L:=1.0
;
l480c::
	call	l4f4f
	db	10h,00h,00h,00h,00h,00h,01h,00h
	ret
;
; Register L:=pi
;
l4818:
	call	l4f4f
	db	31h,41h,59h,26h,53h,59h,01h,00h
	ret
;
; Register L:=e
;
l4824::
	call	l4f4f
	db	27h,18h,28h,18h,28h,46h,01h,00h
	ret
;
; Register L:=ln(10)
;
l4830::
	call	l4f4f
	db	23h,02h,58h,50h,92h,94h,01h,00h
	ret
;
; Register L:=SQR(Register E)
;
l483c::
	push	hl
	ld	l,_r4
	call	l4c17		; Copy register E to register 4
	ld	l,_r6
	call	l4f4f		; Copy 0.5 to register 6
	db	50h,00h,00h,00h,00h,00h,0c1h,01h
	ld	e,_r4
	ld	l,_r5
	call	l4c17		; Copy register 4 to register 5
	ld	l,ra5
	ld	a,(hl)
	and	a		; Test SQR(0)
	ld	e,_r5
	jp	z,l4d13		; Yeap, return 0.0
	ld	l,ra5+NUMSTA
	ld	a,(hl)		; Get sign
	and	MANSGN		; Test mantissaa < 0.0
	jp	nz,l4f5e	; Yeap, error
	inc	l
	ld	a,(hl)		; Get exponent
	rra			; Halve it
	adc	a,b		; Add carry
	ld	b,a
	and	8		; Test range
	ld	a,b
	jp	z,l4874
	sub	3		; Fix exponent
l4874:
	ld	(hl),a		; Save exponent
	ld	b,7		; Set loop count
l4877:
	push	bc
	ld	de,256*_r4+_r5
	ld	l,_r7
	call	l4eb8		; Register 7:=Register 4 / Register 5
	ld	de,256*_r7+_r5
	ld	l,d
	call	l4d06		; Register 7:=Register 7 + Register 5
	ld	de,256*_r7+_r6
	ld	l,_r5
	call	l4e09		; Register 5:=Register 7 * Register 6
	pop	bc
	dec	b
	jp	nz,l4877
	ld	e,_r5
	jp	l4d13		; Unpack result
;
; Register L:=LOG(Register E)
;
l4899::
	push	hl
	push	de
	ld	l,_r4
	call	l4f4f		; Copy 0.0 to register 4
	db	00h,00h,00h,00h,00h,00h,01h,01h
	ld	l,_r5
	call	l480c		; Register 5:=1.0
	ld	l,_r6
	call	l4824		; Register 6:=e
	ld	l,_r7
	call	l4830		; Register 7:=ln(10)
	pop	de
	ld	l,_r8
	call	l4c17		; Copy register E to register 8
	ld	l,ra8
	ld	a,(hl)		; Get entry register
	and	a		; Test 0.0
	jp	z,l4f5e		; Error if so
	ld	l,ra8+NUMSTA
	ld	a,(hl)		; Get sign
	and	MANSGN		; Test sign of mantissa
	jp	nz,l4f5e	; Error if < 0.0
	ld	e,ra4+NUMSTA	; Point to decimal places
	ld	a,(hl)		; Get sign
	and	EXPSGN		; Extract exponent sign
	rrca			; 40 -> 11
	rrca			; 00 -> 01
	inc	a		; 80 -> 21
	ld	(de),a		; C0 -> 31
	inc	l
	ld	a,(hl)		; Get exponent
	ld	(hl),0		; Clear it
	ld	e,ra4
	ld	(de),a		; Put into register 4
	ld	e,_r4
	ld	l,_r0
	call	l4c17		; Copy register 4 to register 0
	call	l4c88		; Normalize number in register 0 
	ld	e,_r0
	ld	l,_r4
	call	l4c17		; Copy register 0 to register 4
	ld	de,256*_r7+_r4
	ld	l,d
	call	l4e09		; Register 7:=Register 7 * Register 4
l48f4:
	ld	l,ra8+EXPVAL
	ld	a,(hl)		; Get exponent of register 8
	dec	a		; Count down
	jp	z,l4914		; End
	ld	l,ra8
	ld	a,(hl)		; Get value
	cp	17h		; Test range
	jp	c,l4914		; Nothing to be fixed
	ld	de,256*_r8+_r6
	ld	l,d
	call	l4eb8		; Register 8:=Register 8 / Register 6
	ld	de,256*_r7+_r5
	ld	l,d
	call	l4d06		; Register 7:=Register 7 + Register 5
	jp	l48f4		; Loop on
l4914:
	ld	de,l0805
	ld	l,9
	call	l4cfa		; Register L:=Register D - Register E
	ld	de,l0805
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	de,l0908
	ld	l,e
	call	l4eb8		; Register L:=Register D / Register E
	ld	e,8
	ld	l,9
	call	l4c17		; Copy register E to register L
	ld	de,l0808
	ld	l,0ah
	call	l4e09		; Register L:=Register D * Register E
	ld	de,l0505
	ld	l,0bh
	call	l4d06		; Register L:=Register D + Register E
l4941:
	ld	de,l090a
	ld	l,d
	call	l4e09		; Register L:=Register D * Register E
	ld	de,l050b
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	de,l0905
	ld	l,4
	call	l4eb8		; Register L:=Register D / Register E
	ld	de,l0804
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	l,' '
	ld	a,(hl)
	and	a
	jp	z,l496d
	ld	l,''''
	ld	a,(hl)
	cp	12h
	jp	c,l4941
l496d:
	ld	de,l0808
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	de,l0807
	pop	hl
	jp	l4d06		; Register L:=Register D + Register E
;
; Register L:=INTEGER part of Register E
;
l497b::
	ld	c,l
	ld	l,0
	call	l4c17		; Copy register E to register 0
	ld	l,ra0+NUMSTA
	ld	a,(hl)		; Get sign
	and	a		; Test >0
	ld	l,c
	jp	m,l4800		; Nope, return 0.0
	push	hl
	ld	l,ra0+EXPVAL
	ld	a,(hl)		; Get exponent
	cp	11h		; Test range
	jp	nc,l4d1e
	cp	10h
	jp	nz,l4999
	sub	6
l4999:
	and	a
	rra
	ld	l,a
	jp	c,l49a3
	ld	a,(hl)
	and	0f0h
	ld	(hl),a
l49a3:
	inc	l
	ld	a,l
	cp	6
	jp	z,l4d1e
	ld	(hl),0
	jp	l49a3
;
; Register L:=Register E - INTEGER part of Register E
;
l49af::
	push	hl
	push	de
	ld	l,2
	call	l497b		; Register L:=INTEGER part of Register E
	pop	de
	pop	hl
	ld	d,e
	ld	e,2
	jp	l4cfa		; Register L:=Register D - Register E
;
; Register L:=EXP(Register E)
;
l49be::
	push	hl
	ld	l,4
	call	l4c17		; Copy register E to register L
	ld	l,5
	call	l4830		; Register L:=ln(10)
	ld	l,6
	call	l480c		; Register L:=1.0
	ld	de,256*_r4+_r5
	ld	l,7
	call	l4eb8		; Register 7:=Register 4 / Register 5
	ld	l,'>'
	ld	a,(hl)
	and	a
	jp	m,l4a00
	inc	l
	ld	a,(hl)
	cp	2
	jp	nc,l4f5e	; Error
	cp	1
	ld	l,'8'
	ld	a,(hl)
	jp	z,l49f2
	and	0f0h
	rlca
	rlca
	rlca
	rlca
l49f2:
	ld	l,'7'
	ld	(hl),a
	ld	l,'>'
	ld	a,(hl)
	and	'0'
	rlca
	rlca
	inc	a
	ld	l,'6'
	ld	(hl),a
l4a00:
	ld	e,7
	ld	l,e
	call	l49af		; Register L:=register E - INTEGER part of register E
	ld	l,8
	call	l480c		; Register L:=1.0
	ld	l,9
	call	l4824		; Register L:=e
	ld	de,256*_r7+_r5
	ld	l,d
	call	l4e09		; Register 7:=Register 7 * Register 5
	call	l4a8f
	call	l4a8f
l4a1d:
	ld	l,'8'
	ld	a,(hl)
	and	a
	jp	z,l4a43
	ld	l,'?'
	ld	a,(hl)
	cp	'I'
	jp	nc,l4a9d
	dec	l
	ld	a,(hl)
	and	a
	jp	m,l4a43
	ld	de,l0708
	ld	l,d
	call	l4cfa		; Register L:=Register D - Register E
	ld	de,l0906
	ld	l,e
	call	l4e09		; Register L:=Register D * Register E
	jp	l4a1d
l4a43:
	ld	e,7
	ld	l,9
	call	l4c17		; Copy register E to register L
	ld	de,l0708
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	e,9
	ld	l,0ah
	call	l4c17		; Copy register E to register L
	ld	l,0bh
	call	l480c		; Register L:=1.0
l4a5d:
	ld	de,l0b08
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	de,l0a09
	ld	l,d
	call	l4e09		; Register L:=Register D * Register E
	ld	de,l0a0b
	ld	l,d
	call	l4eb8		; Register L:=Register D / Register E
	ld	de,l070a
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	l,'P'
	ld	a,(hl)
	and	a
	jp	z,l4a88
	ld	l,'W'
	ld	a,(hl)
	cp	12h
	jp	c,l4a5d
l4a88:
	ld	de,256*_r7+_r6
	pop	hl
	jp	l4e09		; Register L:=Register 7 * Register 6
l4a8f:
	ld	de,l0708
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	de,l0609
	ld	l,d
	jp	l4eb8		; Register L:=Register D / Register E
l4a9d:
	ld	(hl),'I'
	jp	l4a43
;
; Register L:=SIN(Register E)
;
l4aa2::
	push	hl
	ld	l,4
	call	l4c17		; Copy register E to register L
	ld	l,5
	call	l4818		; Register L:=pi
	ld	l,6
	call	l4f4f
	db	20h,00h,00h,00h,00h,00h,01h,00h
	ld	de,l0506
	ld	l,d
	call	l4eb8		; Register L:=Register D / Register E
	ld	de,256*_r4+_r5
	ld	l,d
	call	l4eb8		; Register 4:=Register 4 / Register 5
	ld	e,4
	ld	l,7
	call	l497b		; Register L:=INTEGER part of Register E
	ld	e,4
	ld	l,8
	call	l49af		; Register L:=register E - INTEGER part of register E
	ld	de,l0805
	ld	l,d
	dec	c
	add	hl,bc
	ld	c,(hl)
	ld	l,4
	call	l4f4f
	db	40h,00h,00h,00h,00h,00h,01h,00h
	ld	de,256*_r7+_r4
	ld	l,d
	call	l4eb8		; Register 7:=Register 7 / Register 4
	ld	e,7
	ld	l,e
	call	l49af		; Register L:=register E - INTEGER part of register E
	ld	l,'F'
	ld	a,(hl)
	push	af
	and	0cfh
	ld	(hl),a
	ld	l,'8'
	ld	a,(hl)
	and	a
	jp	z,l4b23
	ld	de,l0805
	cp	75h
	jp	z,l4b1e
	cp	'P'
	jp	nz,l4b1b
	ld	l,'F'
	ld	a,(hl)
	or	'0'
	ld	(hl),a
	jp	l4b23
l4b1b:
	ld	de,l0508
l4b1e:
	ld	l,8
	call	l4cfa		; Register L:=Register D - Register E
l4b23:
	pop	af
	ld	l,'F'
	and	'0'
	xor	(hl)
	ld	(hl),a
	ld	l,5
	call	l480c		; Register L:=1.0
	ld	e,8
	ld	l,0ah
	call	l4c17		; Copy register E to register L
	ld	de,l0808
	ld	l,0bh
	call	l4e09		; Register L:=Register D * Register E
	ld	l,5eh
	ld	a,(hl)
	xor	'0'
	ld	(hl),a
l4b44:
	ld	de,l0a0b
	ld	l,d
	call	l4e09		; Register L:=Register D * Register E
	call	l4b6c
	call	l4b6c
	ld	de,l080a
	ld	l,d
	call	l4d06		; Register L:=Register D + Register E
	ld	l,'P'
	ld	a,(hl)
	and	a
	jp	z,l4b67
	ld	l,'W'
	ld	a,(hl)
	cp	12h
	jp	c,l4b44
l4b67:
	ld	e,8
	jp	l4d13
l4b6c:
	ld	de,l0a06
	ld	l,d
	call	l4eb8		; Register L:=Register D / Register E
	ld	de,l0605
	ld	l,d
	jp	l4d06		; Register L:=Register D + Register E
;
; Register L:=ABS(Register E)
;
l4b7a::
	call	l4c17		; Copy register E to register L
	dec	de		; Position to sign
	dec	de
	ld	a,(de)		; Get sign
	and	NOT MANSGN	; Make absolute
	ld	(de),a
	ret
;
; Compare Register D:Register E
;
l4b84::
	ld	l,0
	call	l4cfa		; Register L:=Register D - Register E
	ld	e,0
	ld	l,e
;
; Register L:=Register E - 0
;
l4b8b::
	call	l4c00		; Convert register L to real memory address
	ld	a,(hl)
	and	a
	ret	z
	ld	a,l
	add	a,6
	ld	l,a
	ld	a,(hl)
	and	'0'
	add	a,a
	add	a,a
	ret	m
	inc	a
	scf
	ret

	nop
	nop
	nop
;
; **** START OF USER SUPPLIED 1ST OUTPUT ROUTINE ****
;
; Indicate sign of mantiass
;
l4ba2:
	ld	l,6
	and	(hl)
	ret	z
	ld	a,'-'
	jp	l4ffa		; Give sign
;
; Output a number from Register E
;
l4bab::
	ld	l,0
	call	l4c17		; Copy register E to register L
	ld	l,4
	ld	a,(hl)
	add	a,0b0h
	ld	b,l
	ld	l,3
	call	l4dfe
	jp	nc,l4bcc
	ld	de,l4bcc
	push	de
	ld	l,0
	push	hl
	ld	b,4
	ld	l,3
	jp	l4de1
l4bcc:
	ld	a,'0'
	call	l4ba2
	ld	l,0
	ld	a,(hl)
	rlca
	rlca
	rlca
	rlca
	call	l4ff6
	ld	a,'.'
	call	l4ffa		; Give decimal point
	call	l4ff5
l4be3:
	inc	l
	call	l4fed
	ld	a,l
	cp	3
	jp	nz,l4be3
	ld	a,'E'
	call	l4ffa		; Give exponent
	ld	a,0c0h
	call	l4ba2
	inc	l
	call	l4fed
	ld	a,0dh
	jp	l4ffa		; Give new line
;
; **** END OF USER SUPPLIED 1ST OUTPUT ROUTINE ****
;
; Convert register L to real memory address
;
l4c00::
	push	de
	ld	h,0		; Force zero
	add	hl,hl		; Register * 8
	add	hl,hl
	add	hl,hl
	ld	de,l4400
	add	hl,de		; Add memory address
	pop	de
	ret
;
; Copy register D to register 0 and register E to register 1
;
l4c0c:
	ld	c,l		; Save register L
	push	de
	ld	e,d		; Get register D
	ld	l,_r0
	call	l4c17		; Copy register E to register 0
	pop	de
	ld	l,_r1		; Then copy register E to register 1
;
; Copy register E to register L
;
l4c17::
	call	l4c00		; Convert register L to real memory address
;
; Copy register E to ^HL
;
l4c1a:
	ex	de,hl
	call	l4c00		; Convert register L to real memory address
;
; Copy number ^HL to ^DE
;
l4c1e:
	ld	b,numlen	; Set length
l4c20:
	ld	a,(hl)
	ld	(de),a		; Unpack number
	inc	l
	inc	e
	dec	b
	jp	nz,l4c20
	ld	h,d
	ret
;
;
;
l4c2a:
	ld	l,1fh
	ld	(hl),1
	dec	l
	ld	(hl),0
;
; ^HL and ^DE point to numbers, reg C hold sign bits
;
l4c31:
	ld	a,(de)		; Get sign of 1st number
	xor	c		; Toggle bits
	xor	(hl)		; Get from 2nd number
	inc	hl		; Advance pointers to exponent
	inc	de
	ld	a,(de)
	jp	m,l4c49		; Got same signs
	add	a,(hl)		; Add exponents
	daa
l4c3c:
	ld	b,a
	push	af
	dec	l
	dec	e
	ld	a,(de)
	xor	c
	and	0c0h
	ld	c,a
	pop	af
	ret	nz
	ld	c,a
	ret
l4c49:
	cp	(hl)
	jp	nc,l4c50
	ex	de,hl
	ld	c,0
l4c50:
	ex	de,hl
	ld	a,(de)
	cpl
	add	a,9bh
	add	a,(hl)
	daa
	ccf
	ex	de,hl
	jp	l4c3c
;
;
;
l4c5c:
	ld	d,0
l4c5e:
	ld	a,(hl)
	rlca
	rlca
	rlca
	rlca
	ld	e,a
	and	0f0h
	add	a,d
	ld	(hl),a
	ld	a,e
	and	0fh
	ld	d,a
	dec	l
	dec	b
	jp	nz,l4c5e
	ld	d,h
	ret
l4c73:
	ld	d,4
l4c75:
	sub	a
l4c76:
	ld	l,e
	ld	c,b
l4c78:
	ld	a,(hl)
	rra
	ld	(hl),a
	inc	l
	dec	c
	jp	nz,l4c78
	dec	d
	jp	nz,l4c75
	ld	d,h
	ret

	nop
	nop
;
; Normalize number in register 0 
;
l4c88::
	ld	l,0
	call	l4c00		; Convert register L to real memory address
	ld	d,h
	ld	e,l
l4c8f:
	ld	a,(hl)
	and	a
	jp	nz,l4ca1
	inc	l
	ld	a,l
	sub	6
	jp	nz,l4c8f
	inc	a
	ld	(hl),a
	dec	a
	inc	l
	ld	(hl),a
	ret
l4ca1:
	ld	a,l
	add	a,l
	ld	c,a
	jp	z,l4cb4
l4ca7:
	ld	a,(hl)
	ld	(de),a
	ld	(hl),0
	inc	e
	inc	l
	ld	a,l
	sub	6
	jp	nz,l4ca7
	ld	l,a
l4cb4:
	ld	a,(hl)
	and	0f0h
	jp	nz,l4cc2
	ld	l,5
	ld	b,6
	call	l4c5c
	inc	c
l4cc2:
	ld	l,6
	ld	a,(hl)
	and	0fh
	dec	a
	sub	c
	ld	c,0
	jp	p,l4cd2
	ld	c,0c0h
	cpl
	inc	a
l4cd2:
	add	a,0
	daa
	ld	e,1fh
	ld	(de),a
	dec	e
	sub	a
	ld	(de),a
	ld	a,(hl)
	and	0f0h
	inc	a
	ld	(hl),a
	push	hl
	call	l4c31
	jp	l4ceb
l4ce7:
	push	de
	call	l4c2a
l4ceb:
	pop	hl
	jp	c,l4f5e		; Error
	ld	a,(hl)
	and	'?'
	or	c
	ld	(hl),a
	inc	l
	ld	(hl),b
	ret

	nop
	nop
	nop
;
; Register L:=Register D - Register E
;
l4cfa::
	call	l4c0c		; Copy register D to register 0 and register E to register 1
	ld	l,ra1+NUMSTA	; Point to sign of register 1
	ld	a,(hl)		; Get sign
	xor	MANSGN		; Toggle sign of mantissa
	ld	(hl),a
	jp	l4d09		; Then add
;
; Register L:=Register D + Register E
;
l4d06::
	call	l4c0c		; Copy register D to register 0 and register E to register 1
l4d09:
	push	bc
	ld	l,ra0		; Point to register 0
	ld	a,(hl)		; Get first byte
	and	a		; Test zero
	jp	nz,l4d17	; Nope
l4d11:
	ld	e,_r1		; If zero take register 1 for result
l4d13:
	pop	hl
	jp	l4c17		; Copy register E to register L
l4d17:
	ld	e,ra1		; Point to register 1
	ld	a,(de)		; Get first byte
	and	a		; Test zero
	jp	nz,l4d23	; Nope
l4d1e:
	ld	e,_r0
	jp	l4d13		; If zero take register 0 for result
l4d23:
	ld	l,ra0+NUMSTA	; Load number pointers
	ld	e,ra1+NUMSTA
	ld	c,EXPSGN	; Init bits
	call	l4c31
	push	af
	ld	a,(de)
	and	a
	jp	p,l4d33
	ex	de,hl
l4d33:
	ld	a,(de)
	and	EXPSGN		; Get sign of exponent
	ld	c,a
	push	hl
	ld	l,_r0+NUMSTA
	ld	a,(hl)		; Fetch status bits
	and	MANSGN+DIGBITS	; Get sign of mantissa an decimal point
	or	c		; Insert exponent's sign
	ld	(hl),a
	inc	e		; Point to exponent
	inc	l
	ld	a,(de)
	ld	(hl),a		; Set result
	pop	hl
	pop	af
	jp	nc,l4d51
l4d48:
	ld	a,l
	cp	_r0+NUMSTA	; Test pointer
	jp	z,l4d11		; Return register 1
	jp	l4d1e		; Return register 0
l4d51:
	cp	12h		; Test range
	jp	nc,l4d48
	cp	10h
	jp	c,l4d5d
	sub	6
l4d5d:
	and	a
	jp	z,l4d92
	ld	b,a
	dec	l
	ld	a,l
	sub	5
	ld	e,a
	ld	a,b
	rra
	ld	b,a
	push	hl
	push	bc
	ld	b,6
	call	c,l4c73
	pop	bc
	pop	hl
	ld	a,b
	and	a
	jp	z,l4d92
	push	hl
	ld	a,l
	sub	b
	ld	e,a
	ld	a,6
	push	bc
	sub	b
	ld	b,a
l4d81:
	ld	a,(de)
	ld	(hl),a
	dec	e
	dec	l
	dec	b
	jp	nz,l4d81
	pop	bc
l4d8a:
	ld	(hl),0
	dec	l
	dec	b
	jp	nz,l4d8a
	pop	hl
l4d92:
	ld	l,6
	ld	e,0eh
	ld	a,(de)
	xor	(hl)
	and	'0'
	dec	hl
	dec	de
	jp	z,l4dd0
l4d9f:
	ld	a,(de)
	sbc	a,(hl)
	dec	e
	dec	l
	jp	p,l4d9f
	ld	l,6
	ld	e,0eh
	ld	c,l
	jp	c,l4db8
	ld	a,(hl)
	and	0cfh
	ld	b,a
	ld	a,(de)
	and	'0'
	or	b
	ld	(hl),a
	ex	de,hl
l4db8:
	dec	l
	dec	e
	dec	c
	ld	b,h
	scf
l4dbd:
	ld	a,(de)
	cpl
	adc	a,9ah
	add	a,(hl)
	daa
	ld	(bc),a
	dec	l
	dec	e
	dec	c
	jp	p,l4dbd
	call	l4c88		; Normalize number in register 0 
	jp	l4d1e
l4dd0:
	sub	a
l4dd1:
	ld	a,(de)
	adc	a,(hl)
	daa
	ld	(hl),a
	dec	e
	dec	l
	jp	p,l4dd1
	jp	nc,l4d1e
	ld	b,6
	ld	l,5
l4de1:
	ld	de,l0400
	ld	a,(hl)
	push	af
	call	l4c76
	pop	af
	and	0fh
	add	a,0fbh
	dec	l
	call	l4dfc
	ld	e,6
	call	l4ce7
	jp	l4d1e
	add	a,0b0h
l4dfc:
	ld	b,6
l4dfe:
	ld	a,0
	adc	a,(hl)
	daa
	ld	(hl),a
	dec	l
	dec	b
	jp	nz,l4dfe
	ret
;
; Register L:=Register D * Register E
;
l4e09::
	push	hl
	ld	l,_r4
	call	l4c00		; Convert register 4 to real memory address
	dec	hl		; Fix for register 3
l4e10:
	ld	(hl),0
	dec	l		; Clear registers 0..3
	jp	p,l4e10
	ld	c,d		; Save register D
	ld	l,_r1
	call	l4c17		; Copy register E to register 1
	ld	e,c		; Get back register D
	push	de
	ld	l,16h
	call	l4c1a		; Copy register E to ^HL
	pop	de
	ld	l,8
	ld	a,(hl)
	and	a
	jp	z,l4d11
	ld	l,16h
	ld	a,(hl)
	and	a
	jp	z,l4d13
	ld	l,1bh
l4e34:
	push	hl
	sub	a
	ld	a,l
	rra
	ld	e,a
	ld	a,(de)
	jp	c,l4e41
	rrca
	rrca
	rrca
	rrca
l4e41:
	and	0fh
	ld	c,a
	jp	z,l4e63
	ld	a,10h
	sub	e
	ld	b,a
l4e4b:
	push	bc
	ld	l,7
	ld	e,18h
	ld	a,(de)
	add	a,0b0h
	dec	e
l4e54:
	ld	a,(de)
	adc	a,(hl)
	daa
	ld	(hl),a
	dec	l
	dec	e
	dec	b
	jp	nz,l4e54
	pop	bc
	dec	c
	jp	nz,l4e4b
l4e63:
	pop	hl
	ld	a,l
	cp	10h
	jp	z,l4e79
	rra
	dec	l
	push	hl
	add	a,0eh
	ld	l,a
	ld	b,7
	call	l4c5c
	pop	hl
	jp	l4e34
l4e79:
	ld	l,0
	ld	a,(hl)
	and	0f0h
	jp	nz,l4eb0
	ld	l,6
	ld	b,7
	call	l4c5c
l4e88:
	ld	e,0eh
	ld	l,1ch
	ld	bc,l0601
l4e8f:
	push	bc
	call	l4c31
	jp	c,l4f5e		; Error
	ld	a,(de)
	xor	(hl)
	and	'0'
	inc	a
	or	c
	pop	de
	ld	l,d
	ld	(hl),a
	inc	l
	ld	(hl),b
	dec	e
	jp	z,l4d1e
	ld	d,h
	ld	e,15h
	pop	hl
	call	l4c00		; Convert register L to real memory address
	ex	de,hl
	jp	l4c1e		; Copy number ^HL to ^DE
l4eb0:
	ld	e,0eh
	call	l4ce7
	jp	l4e88
;
; Register L:=Register D / Register E
;
l4eb8::
	push	hl
	ld	c,d		; Save register D
	ld	l,1
	call	l4c00		; Convert register L to real memory address
	inc	hl
	inc	hl
	call	l4c1a		; Copy register E to ^HL
	ld	e,c		; Get back register D
	ld	l,1
	call	l4c1a		; Copy register E to ^HL
	ld	e,c
	ld	l,9
	ld	(hl),0
	inc	l
	ld	a,(hl)
	and	a
	jp	z,l4f5e		; Error
	ld	l,0
	ld	(hl),0
	inc	l
	ld	a,(hl)
	and	a
	jp	z,l4d13
	ld	l,'*'
	push	hl
l4ee2:
	ld	c,0
l4ee4:
	ld	e,0fh
	ld	l,6
	ld	b,9ah
	inc	scf
l4eeb:
	ld	a,(de)
	cpl
	adc	a,b
	add	a,(hl)
	daa
	ld	(hl),a
	dec	e
	dec	l
	jp	p,l4eeb
	jp	c,l4f09
	ld	e,6
	ld	l,0fh
l4efd:
	ld	a,(de)
	adc	a,(hl)
	daa
	ld	(de),a
	dec	l
	dec	e
	jp	p,l4efd
	jp	l4f10
l4f09:
	inc	c
	ld	a,c
	cp	9
	jp	nz,l4ee4
l4f10:
	pop	hl
	ld	a,l
	sub	'*'
	add	a,c
	ld	a,l
	jp	nz,l4f22
	push	hl
	ld	e,10h
	call	l4ce7
	jp	l4f3a
l4f22:
	inc	l
	push	hl
	ld	e,a
	and	a
	rra
	ld	l,a
	ld	a,c
	jp	c,l4f32
	rrca
	rrca
	rrca
	rrca
	ld	(hl),0
l4f32:
	add	a,(hl)
	ld	(hl),a
	ld	a,e
	cp	'5'
	jp	z,l4f44
l4f3a:
	ld	b,7
	ld	l,6
	call	l4c5c
	jp	l4ee2
l4f44:
	pop	hl
	ld	l,7
	ld	e,10h
	ld	bc,l1bc0
	jp	l4e8f
;
; Load immediate constant to register L
;
l4f4f::
	call	l4c00		; Convert register L to real memory address
	pop	de
	push	de		; Mark caller
	ex	de,hl
	call	l4c1e		; Copy number ^HL to ^DE
	pop	hl		; Get back caller
	ld	bc,numlen
	add	hl,bc		; Skip over constant
	jp	(hl)		; Exit
;
; Error routine
;
l4f5e:
	ld	sp,l43fd	; Set local stack
	ld	a,'E'
	call	l4ffa		; Indicate error
	call	l4091		; Enter monitor
;
; **** START OF USER SUPPLIED INPUT ROUTINE ****
;
l4f69:
	ld	a,b
	inc	a
	ret	nz
	ld	b,c
	ret
;
; Input a number to Register L
;
l4f6e::
	push	hl		; Save resulting register
	ld	l,4
	call	l4c00		; Convert register L to real memory address
l4f74:
	dec	l
	ld	(hl),0		; Clear area
	jp	nz,l4f74
	ld	l,10h		; Init buffer address
	ld	b,l		; Set max input
;
; Get B characters from keyboard to ^HL
;
l4f7d::
	call	l0b40		; Test character available
	jp	z,l4f7d		; Nope
	ld	(hl),a		; Unpack it
	inc	l		; Advance buffer
	dec	b		; Count down
	jp	z,l4f5e		; Error on overflow
	cp	cr		; Test end of input
	jp	nz,l4f7d	; Nope
	ld	d,h
	ld	e,10h		; Reset buffer pointer
	ld	c,0		; Init register 0
	ld	b,0ffh
	ld	l,MANSGN	; Init sign bits
l4f97:
	ld	a,(de)		; Get 1st character
	cp	'-'		; Test sign
	jp	nz,l4fa6	; Nope
	push	bc
	ld	c,l		; Get sign bits
	inc	e		; Skip sign
	ld	l,6		; Point to sign byte
	ld	a,(hl)		; Get sign
	or	c		; Insert new one
	ld	(hl),a
	pop	bc
;
; Main input loop
;
l4fa6:
	ld	a,(de)		; Get next character
	cp	'E'		; Test exponent
	jp	z,l4fd1		; Yeap
	cp	cr		; Test end of input
	jp	z,l4fdc		; Yeap
	cp	'.'		; Test decimal point
	jp	nz,l4fba	; Nope
	call	l4f69
	inc	e
l4fba:
	ld	a,(de)		; Get digit
	and	DIGBITS		; Mask it
	ld	(de),a		; Bring back B.C.D.
	ld	a,c		; Get register pointer
	and	a
	rra
	ld	l,a		; Set address
	ld	a,(de)		; Get digit
	jp	c,l4fca		; Skip if low part in progress
	rrca			; Shift bits into upper posotion
	rrca
	rrca
	rrca
l4fca:
	add	a,(hl)		; Insert bits
	ld	(hl),a		; Store result
	inc	c		; Update pointers
	inc	e
	jp	l4fa6
;
; Got 'E'xponent
;
l4fd1:
	call	l4f69
	inc	e
	ld	l,0c0h
	ld	c,0eh
	jp	l4f97
;
; End of input
;
l4fdc:
	call	l4f69
	ld	l,6
	ld	a,(hl)
	or	b
	ld	(hl),a
	call	l4c88		; Normalize number in register 0 
	pop	hl		; Get back resulting register
	ld	e,0
	jp	l4c17		; Copy register E to register L (result)
;
; **** END OF USER SUPPLIED INPUT ROUTINE ****
;
; **** START OF USER SUPPLIED 2ND OUTPUT ROUTINE ****
;
l4fed:
	ld	a,(hl)
	rlca
	rlca
	rlca
	rlca
	call	l4ff6
l4ff5:
	ld	a,(hl)
l4ff6:
	and	0fh
	add	a,'0'
;
; Put character in Accu to console
;
l4ffa:
	rst	10h
	nop
	nop
	ret

	nop
	nop
;
; **** END OF USER SUPPLIED 2ND OUTPUT ROUTINE ****
;
	.dephase

	end