; FLTINPUT.ASM
; ------------
;
; See FALCONER.WS4 for doc.
;
; (Retyped by Emmanuel ROCHE.)
;
;--------------------------------
; External routines required
;
	extrn	fdivt,flotd,fmult	; in FLTARITH.ASM
	extrn	mul10			; in INTARITH.ASM
;
;--------------------------------
; Entry points allowed
; --------------------
;
; Utility routines
;
	entry	deblk,jbc,qmax,qnum
;
; Numeric input
;
	entry	ival,ivalc
;
;--------------------------------
; Macro definitions
;--------------------------------
;
; Execute routine at (BC) [normally get next character]
;
getch	macro
	call	jbc
	endm
;
; Change sign of real operand B or D
;
fsign	macro	reg
	if	reg*(reg-d)
	error	"R"
	endif
	mov	a,reg
	xri	80H
	mov	reg,a
	endm
;
; Reload (BC.L), stored by PUSH B, PUSH H sequence
;
reload	macro	reg
bc.l	equ	b
	if	reg-b
	error	"R"
	db	0,0,0
	endif
	if	reg-b=0		; Was IFZ
	pop	b
	mov	l,c
	pop	b
	endif
	endm
;
; "Return" and check stacl level zero
;
rtn	macro
	if	.lvl
	error	'0'+.lvl
.lvl	set	0
	endif
	ret
	endm
;
; Save (BC.L), to be restored by RELOAD BC.L later
;
save	macro	reg
	bc.l	equ	b
	if	reg-b
	error	'R'
	db	0,0
	endif
	if	reg-b=0		; Was IFZ
	push	b
	push	h
	endif
	endm
;
;--------------------------------
; Start the code
;--------------------------------
;
; Check (A) to be in range 0-9 (ASCII)
; Return Carry for non-numeric character
; F
;
qnum:	cpi	'9'+1		; This first to speed exit
	cmc			;   for alpha.
	rc			; < 0, non-numeric
	cpi	'0'		; 
	rtn			; 
;
; Check (HL) for value < 6554
; Set Carry if greater
; F
;
qmax:	push	b		; 
	mov	b,a		; 
	mov	a,l		; 
	sui	6554 MOD 256	; 
	mov	a,h		; 
	sbi	6554/256	; 
	cmc			; 
	mov	a,b		; 
	pop	b		; 
	rtn			; 
;
; Transfer control to (BC)
;
jbc:	push	b		; Set address on stack
.lvl	set	.lvl-1		; Compensate for stacked addr
	rtn			; Go excute
;
; Input a character, ignoring blanks
; A,F
;
deblk:	getch			; 
	cpi	' '		; 
	rnz			; 
	jmp	deblk		; Bypass a blank
;
; Input a floating point value from a char string
; At entry:
;  (BC) => character input routine
; At exit:
;  (A)=(L) = character following numerical string
;  (DE.H)  = value
; If error, (A) = error code, (L) = exit char, Carry set
; Carry for overflow or illegal first char
; A,F,D,E,H,L
;
ival:	call	deblk		; Bypass leading blanks
;
; Alternate entry with first char in (A)
;
ivalc:	cpi	' '		; 
	jz	ival		; Ignore leading spaces
	cpi	'+'		; 
	jz	ival		; Ignore unary +
	call	qnum		; 
	lxi	h,0		; Clear acc
	mvi	d,40H		;   and exponent.
	jnc	ival6		; Initial numeric entry
	cpi	'.'		; 
	jz	ival1		; Initial decimal point
	cpi	'-'		; 
	stc			; 
	mov	l,a		;   (A) is illegal char.
	rnz			; Error, return 0 and Carry,
	call	ival		; Recursive unary -
	push	psw		; Save exit char
	fsign	d		; 
	pop	psw		; 
	rtn			; 
ival1:	getch			; After initial decimal point
	call	qnum		; 
	jnc	ival4		; Got the required digit
	mov	l,a		; Exit char to (L)
	stc			; 
	rtn			; Illegal initial char
ival2:	inr	d		; Incorporate digit
	getch			; Get next digit
	call	qnum		; 
	jnc	ival2		; Still digit string
	cpi	'.'		; Will be ignored
	jnz	ival8		; Check for exponent
ival3:	getch			; Digits after decimal point
	call	qnum		; 
	jc	ival8		; Non-digit
	call	qmax		; 
	jc	ival3		; No room, ignore
	call	mul10		; 
ival4:	ani	0FH		; Mask off digit
	dcr	d		; Modify exponent digits after
	add	l		;   decimal point.
	mov	l,a		; 
	mov	a,h		; 
	aci	00H		; 
	mov	h,a		; 
	jnc	ival3		; No overflow
	lxi	h,6554		; Set max
	inr	d		; 
	jmp	ival3		; 
ival5:	call	qmax		; Digits to left of decimal point
	jc	ival2		; No more digit room
	call	mul10		; 
ival6:	ani	0FH		; Mask off digit
	add	l		; 
	mov	l,a		; 
	mov	a,h		; 
	aci	00H		; 
	mov	h,a		; Incorporate digit
	jnc	ival7		; No overflow
	lxi	h,65535		; Max
ival7:	getch			; Get next digit/char
	call	qnum		; 
	jnc	ival5		; Digit
	cpi	'.'		; 
	jz	ival3		; Decimal point
ival8:	cpi	'E'		; 
	jz	ival9		; 
	cpi	'e'		; Lower case allowed
ival9:	xchg			; 
	stc			; 
	cmc			; Clear any Carry
	cz	rexp		; "E", read exponent
	mov	l,a		; Exit char
	cnc	unfix		; Convert format if no overflow yet
	rnc			; No overflow
	mvi	a,80H		; Overflow code
	rtn			; 
;
; "Fixed" point representation consists of a 16 bit positive
; integer (in the range 0 to 65535), and a 7 bit offset (by
; 40H) integer exponent, which represents a power of ten
; multiplier. The eighth exponent bit represents the sign
; of the mantissa. This representation is used for input/
; output only.
;
; Convert "fixed" format to "real"
; Carry for input out of range
; F,D,E,H
;
unfix:	save	bc.l		; 
	push	psw		; 
	mov	a,h		; 
	ani	80H		; 
	mov	b,a		; Sign of result
	mov	a,h		; 
	ani	7FH		; 
	sui	40H		; 
	mov	c,a		; Decimal point
	call	flotd		; 
	mov	a,h		; 
	ora	a		; 
	jz	unfix4		; Zero value
	mov	a,d		; 
	ora	b		; 
	mov	d,a		; Incorporate sign
	mov	a,c		; 
	ora	a		; 
@01	set	.lvl		; 
unfix1:	jz	unfix4		; Reduced to real
	jm	unfix3		; Negative exponent
	call	fmult		; Positive exponent
	dcr	c		; 
	jnc	unfix1		; In range
unfix2:	pop	psw		; 
	stc			; 
	jmp	unfix5		; 
.lvl	set	@01		; 
unfix3:	call	fdivt		; Negative exponent
	inr	c		; 
	jnc	unfix1		; Continue
	jmp	unfix2		; Underflow
unfix4:	pop	psw		; 
	ora	a		; Reset Carry, no overflow
unfix5:	reload	bc.l		; 
	rtn			; 
;
; Read 2 digit signed decimal exponent
;   to (A). Return exit character in (D).
; A,F,D,E
;
r2dc:	getch			; Get char
	call	qnum		; 
	jc	r2dc3		; Not digit
r2dc1:	lxi	d,0		; 
r2dc2:	dcr	d		; 
	inr	d		; 
	stc			; 
	rnz			; Overflow, 3 digits entered,
	mov	d,e		;   first non-zero.
	ani	0FH		; 
	mov	e,a		; 
	getch			; 
	call	qnum		; 
	jnc	r2dc2		; 
	push	psw		; 
	mov	a,d		; 
	add	a		; 
	add	a		; 4*
	add	d		; 
	add	a		; 10*
	add	e		; Value MOD 100
	pop	d		; 
	rtn			; 
r2dc3:	cpi	'+'		; 
	jz	r2dc		; Ignore unary +
	cpi	'-'		; 
	jnz	r2dc4		; Not unary -
	call	r2dc		; 
	cma			; 
	inr	a		; 
	rtn			; 
r2dc4:	mov	d,a		; 
	mvi	a,0		; Return 0, none came
	rtn			; 
;
; Read exponent and combine with "fixed" value
; Return exit char in (A)
; A,F,D
;
rexp:	push	d		; 
	call	r2dc		; Get exponent
	jc	rexp1		; Overflow
	push	d		; Save exit char
	mov	d,a		; Exponent
	mov	a,h		; 
	ani	80H		; 
	mov	e,a		; Sign
	mov	a,h		; 
	ani	7FH		; Exponent alone
	add	d		; 
	jp	rexp2		; No overflow
@01	set	.lvl		; 
	pop	psw		; Exit char
rexp1:	pop	d		; 
	stc			; Signal overflow
	rtn			; 
.lvl	set	@01		; 
rexp2:	ora	e		; Original sign
	mov	h,a		; Resultant exponent
	pop	psw		; Restore exit char
	pop	d		; Restore mantissa
	ora	a		; Clear Carry, no overflow
	rtn			; 
;
;--------------------------------
;
	end			; of FLTINPUT.ASM