; FLTOUT.ASM
; ----------
;
; See FALCONER.WS4 for doc.
;
; (Retyped by Emmanuel ROCHE.)
;
;--------------------------------
; External calls required
;
	extrn	derc,dten	   ; in INTARITH
	extrn	fdivt,fload,fmult  ; in FLTARITH
;
;--------------------------------
; External connectors to list and console drivers
;
	extrn	lout,cout	; Undefined in system,
				;   output (C), Set (A) := (C).
;
;--------------------------------
; Entry points allowed
;
	entry	lflt,tflt,oflt,fmat
;
;--------------------------------
; Entry points to utility routines
;
	entry	exdg,otcbk,otccl
	entry	opt,oneg,odzs
;
;--------------------------------
; Macro definitions
;--------------------------------
;
; Load (reg) from TOS and leave on stack (reg)
;
ltos	macro	reg
	pop	reg
	push	reg
	endm
;
; "Return" and check stacl level zero
;
rtn	macro
	if	.lvl
	error	"0"+.lvl
.lvl	set	0
	endif
	ret
	endm
;
; Trade (A) digits, leave LSB in Carry (A,F)
;
tdig	macro
	rlc
	rlc
	rlc
	rlc
	endm
;
;--------------------------------
Š; Utility routines
;--------------------------------
;
; Output blank to console/lister
; Use lister if (A) sign bit=1; else console
; A,F,C
;
otcbk:	mvi	c,' '		; 
;
; Output a character
; Use lister if (A) sign bit=1; else console
; A,F,C
;
otccl:	rlc			; 
	jc	lout		; 
	jmp	cout		; On console
;
; Output (A) blanks
; Use lister if (A) sign bit=1; else console
; A,F
;
hblk:	push	b		; 
	mov	b,a		; 
	jmp	hblk2		; Check for zero
hblk1:	mov	a,b		; 
	call	otcbk		; 
	dcr	b		; 
	mov	a,b		; 
hblk2:	ani	7FH		; 
	jnz	hblk1		; 
	pop	b		; 
	rtn			; 
;
; Output a decimal point
; Use lister if (A) sign bit=1; else console
; A,F,C
;
opt:	mvi	c,'.'		; Decimal point
	jmp	otccl		; 
;
; Output "-"
; Use lister if (A) sign bit=1; else console
; A,F,C
;
oneg:	mvi	c,'-'		; Negative sign
	jmp	otccl		; 
;
; Output (HL) in decimal, suppress leading zeros
; Use lister if (A) sign bit=1; else console
;
odzs:	push	b		; 
	mvi	b,5		; 
	push	psw		; Preserve
odzs2:	call	exdg		; Extract a digit
	jnz	odzs4		; Non-zero, end suppress
	dcr	b		; 
	jnz	odzs2		; Continue suppression
	inr	b		; Re-extract final zero and output
odzs3:	call	exdg		; Get next digit
odzs4:	ltos	psw		; 
Š	call	otccl		; Output to console or lister
	dcr	b		; 
	jnz	odzs3		; 
	pop	psw		; 
	pop	b		; 
	rtn			; 
;
; Extract a decimal digit, 10^((B)-1), from (HL).
; ASCII digit returned in (C) and (A)
;   with Zero flag for digit=zero.
; A,F,C
;
exdg:	push	h		; 
	push	b		; 
exdg1:	call	dten		; 
	dcr	b		; 
	jnz	exdg1		; 
	adi	'0'		; 
	cpi	'0'		; 
	pop	b		; 
	pop	h		; 
	mov	c,a		; 
	rtn			; 
;
;--------------------------------
; End utility routines
;--------------------------------
;
; "Fixed" point representation consist 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 "real" format to "fixed" format
; A,F,D,E,H
;
fix:	mov	a,h		; 
	ora	a		; 
	jnz	fix1		; Value not zero
	mvi	h,40H		; 00000
	lxi	d,0		; 
	rtn			; 
fix1:	cpi	91H		; 
	push	b		; 
	mvi	b,40H		; Decimal exponent
@01	set	.lvl		; 
	jnc	fix5		; > 65535, integer
	cpi	8EH		; 
	jnc	fix6		; Treat as left shifted integer
fix2:	call	fmult		; < 32768
	dcr	b		; 
	mov	a,h		; 
	sui	90H		; 
	jc	fix2		; Still fractional segment
	jnz	fix5		; Not now integer
fix3:	mov	a,d		; 
	ani	80H		; Extract sign
	ora	b		; 
Š	mov	h,a		; 
	mov	a,d		; 
	ori	80H		; Set MSbit, range 32768/65535
	mov	d,a		; 
	pop	b		; 
	rtn			; 
.lvl	set	@01		; 
fix5:	call	fdivt		; Integer > 65535
	inr	b		; 
	mov	a,h		; 
fix6:	sui	90H		; 
	jz	fix3		; Now integer representation
	jnc	fix5		; 
	mov	h,a		; Range -1 to -4
	mov	a,d		; 
	ani	80H		; Result sign
	ora	b		; 
	mov	b,a		; 
	mov	a,d		; 
	ori	80H		; 
	mov	d,a		; 
fix7:	ora	a		; Reset Carry
	call	derc		; 
	inr	h		; 
	jnz	fix7		; Shift off fractional segment
	jnc	fix8		; No rounding needed
	inx	d		; 
fix8:	mov	h,b		; 
	pop	b		; 
	ora	a		; Reset Carry
	rtn			; 
;
; ***** Output routines *****
;
; Output (DE.H) in "fixed" form
; Suppress leading zeroes
; If A >= 0, to console. If a < 0, to lister.
; A,F,B,C,D,E,H,L
;
ofix:	push	psw		; 
	mov	a,h		; 
	ani	80H		; 
	jp	ofix1		; Positive
	ltos	psw		; Output "-" sign
	call	oneg		; Send a "-" sign
ofix1:	mov	a,h		; 
	ani	7FH		; Remove sign
	sui	40H-6		; Signed decimal exponent
	mov	h,a		; 
	xchg			; Value in HL, exponent in D
	mvi	b,6		; First digit
ofix2:	dcr	b		; 
@01	set	.lvl		; 
	jz	ofixa		; Done, all digits 0
	dcr	d		; 
	jz	ofix7		; Decimal point here
	jm	ofix7		;  xxxxE-xx
	call	exdg		; 
	jz	ofix2		; Suppress a zero
ofix3:	ltos	psw		; 
	call	otccl		; List a digit
Š	dcr	d		; 
	jnz	ofix4		; 
	ltos	psw		; 
	call	opt		; Decimal point here
ofix4:	dcr	b		; 
	jz	ofix5		; All digits listed
	call	exdg		; 
	jmp	ofix3		; List next digit
ofix5:	xra	a		; 
	sub	d		; 
	jp	ofixb		; Not xxxx.E+xx
	adi	3		; 
	jm	ofix6		; > 9999000
	mvi	c,"0"		; 
	ltos	psw		; 
	call	otccl		; 
	dcr	d		; 
	jmp	ofix5		; 
ofix6:	mvi	c,'E'		; 
	ltos	psw		; 
	call	otccl		; 
	mov	l,d		; 
	mvi	h,0		; 
	pop	psw		; 
	jmp	odzs		; List exponent
.lvl	set	@01		; 
ofix7:	ltos	psw		; 
	call	opt		; .xxxxE-xx
ofix8:	mov	a,d		; 
	ora	a		; 
	jz	ofix9		; Zero exponent
	adi	3		; 
	jm	ofix9		; Range -1 to -3, insert 0's
	mvi	c,"0"		; 
	ltos	psw		; 
	call	otccl		; 
	inr	d		; 
	jmp	ofix8		; Check for more 0's
ofix9:	call	exdg		; 
	ltos	psw		; 
	call	otccl		; 
	dcr	b		; 
	jnz	ofix9		; 
	xra	a		; 
	mov	h,a		; 
	sub	d		; 
	mov	l,a		; 
	jz	ofixb		; Ignore zero exponent
	mvi	c,'E'		; 
	ltos	psw		; 
	call	otccl		; 
	ltos	psw		; 
	call	oneg		; 
	pop	psw		; 
	jmp	odzs		; List exponent and exit
.lvl	set	@01		; 
ofixa:	ltos	psw		; 
	call	otccl		; List a zero
ofixb:	pop	psw		; 
	rtn			; 
;
; Output "real" (DE.H) to lister
Š;
lflt:	push	psw		; 
	mvi	a,-1		; Identify as lister output
	call	oflt		; 
	pop	psw		; 
	rtn			; 
;
; Output "real" (DE.H) to console
;
tflt:	push	psw		; 
	mvi	a,0		; Identify as console output
	call	oflt		; 
	pop	psw		; 
	rtn			; 
;
; Output "real"
; If A < 0, to lister. If A >= 0, to console.
; A
;
oflt:	push	b		; 
	push	d		; 
	push	h		; 
	push	psw		; 
	call	fix		; 
	pop	psw		; Get destination
	call	ofix		; 
	pop	h		; 
	pop	d		; 
	pop	b		; 
	rtn			; 
;
; Output (DE.H) with format specification in (A)
;
; (A) bit field	    Meaning
; -------------     -------
;  0:1 (LH bit)     1=to lister, 0=to console
;  1:3 (3 bits)     Places to left of decimal point
;  4:1 (1 bit)      Use free format, ignore places spec
;  5:3 (3 RH bits)  Places to right of decimal point
;
fmat:	push	psw		; 
	push	b		; 
	push	d		; 
	push	h		; 
	push	psw		; Save places
	call	fix		; 
	ltos	psw		; 
	call	ajfx		; Adjust on right of dec point
	call	tpsn		; Position the field
	pop	psw		; For list/console destination
	call	ofix		; Output the data
	pop	h		;   and restore registers.
	pop	d		; 
	pop	b		; 
	pop	psw		; 
	rtn			; 
;
; Adjust "fixed" format for (A) digits after decimal point
; Max digits=7, 8 bit for floating format
; Round the result
; D,E,H
Š;
ajfx:	push	psw		; 
	push	b		; 
	push	h		; Save BC.L
	ani	15		; 
	cpi	8		; 
	jnc	ajfx4		; Floating format, no adjust
	ani	7		; 7 digits max
	mov	c,a		; Digits required
ajfx1:	mov	a,h		; 
	ani	7FH		; Remove sign
	sui	40H		; 
	add	c		; 
	jp	ajfx4		; No excess fractional segment
	mov	b,a		; 
	xchg			; 
ajfx2:	call	dten		; Remove a digit
	inr	d		; Adjust decimal exponent
	inr	b		; 
	jm	ajfx2		; Remove more
	cpi	5		; 
	jc	ajfx3		; No rounding
	inx	h		; 
ajfx3:	xchg			; 
	jmp	ajfx1		; In case rounding added digit
ajfx4:	pop	b		; Reload BC.L
	mov	l,c		; 
	pop	b		; 
	pop	psw		; 
	rtn			; 
;
; Control leading blanks via bits 1:3 of (A)
; Bit 4:1 specifies free format else output blanks
;   required to place the decimal point at the
;   field position to right of starting point.
;
tpsn:	push	psw		; 
	push	b		; 
	push	psw		; 
	ani	8		; 
	jnz	tpsn9		; Free format
	pop	psw		; 
	ani	0F0H		; 
	mov	b,a		; 
	ani	70H		; 
	tdig			; 
	mov	c,a		; Count of places needed
	push	b		; 
	mov	a,h		; 
	ani	7FH		; 
	sui	40H		; Form dp loc wrt right digit
	jm	tpsn5		; Fract segment
	inr	a		; 
	cmp	b		; 
	jnc	tpsn9		; Too large, use free format
	mvi	a,0		; Use value zero?
tpsn5:	mov	b,a		; Negative value
	call	ndig		; Count of sig digits in value
	add	b		;   to left of decimal point
	jp	tpsn6		; There are some
Š	mvi	a,0		; One + zeroes after dec point
tpsn6:	pop	b		; 
	cma			; 
	inr	a		; 
	add	c		; Spaces required
	jp	tpsn8		; 
	mvi	a,0		; Can't allow negative count
tpsn8:	mov	c,a		; 
	mov	a,h		; 
	ora	a		; 
	jp	tpsn7		; Positive value
	dcr	c		; Allow for - sign
	jp	tpsn7		; Room
	inr	c		; No room, move all right
tpsn7:	mov	a,b		; 
	ani	80H		; File flag
	ora	c		; 
	call	hblk		; Space as required
	push	psw		; 
tpsn9:	pop	psw		; 
	pop	b		; 
	pop	psw		; 
	rtn			; 
;
; Return count of significant digits in (DE)
; Treating (DE) as decimal integer with leading
;   zeroes suppressed. Return 1 for value 00000.
; A,F
;
ndig:	push	b		; 
	push	d		; 
	xchg			; 
	mvi	b,0		; 
ndig1:	inr	b		; 
	call	dten		; 
	mov	a,h		; 
	ora	l		; 
	jnz	ndig1		; More digits left
	mov	a,b		; 
	xchg			; 
	pop	d		; 
	pop	b		; 
	rtn			; 
;
;--------------------------------
;
	end			; of FLTOUT.ASM