% Author M. Ruckert
% printing floating point numbers the quick and simple way

	LOC	Data_Segment
	GREG	@
NL	BYTE	10,0
1H	BYTE	"123.4",0
1H	BYTE	"+123.4",0
1H	BYTE	"-123.4",0
1H	BYTE	"-120.034",0
1H	BYTE	"1.0e+3",0
1H	BYTE	"12345.0e+32",0
1H	BYTE	"12345.0e32",0
1H	BYTE	"-12345.0e32",0
1H	BYTE	"12345.0e-3",0
1H	BYTE	"12345.0e-132",0
1H	BYTE	"12345.0e-32",0


Buffer	IS	1B
	LOC	#100

Main	LDA	$255,Buffer
	TRAP	0,Fputs,StdOut
	LDA	$255,NL
	TRAP	0,Fputs,StdOut

	LDA	$2,Buffer
	PUSHJ	$1,stof

	LDA	$2,Buffer
	PUSHJ	$0,ftos

	LDA	$255,Buffer
	TRAP	0,Fputs,StdOut
	LDA	$255,NL
	TRAP	0,Fputs,StdOut

	SET	$255,0
	TRAP	0,Halt,0
	


	PREFIX	:ftos:

x	IS	$0
str	IS	$1

s	IS	$2		sign
f	IS	$3		mantissa
e	IS	$4		exponent
k	IS	$5
h	IS	$6
b	IS	$7
i	IS	$8
t	IS	$9


:seven	GREG	#416312d000000000		10.0^7
:fourtynine	GREG	#4a1b5e7e08ca3a8f	10^49
:ten	GREG	#4024000000000000		10
:one	GREG	#3ff0000000000000		1

:ftos	SETH	s,#8000
	AND	s,s,x
	BZ	s,1F
	SET	t,'-'
	STB	t,str,0
	ADD	str,str,1	
1H	ANDN	x,x,s		clear sign bit
	BZ	x,zero
	SET	k,0
	FCMP	t,x,:one
	BN	t,small
large	FCMP	t,x,:fourtynine
	BN	t,med
	FDIV	x,x,:fourtynine
	ADD	k,k,49
	JMP	large
med	FCMP	t,x,:seven
	BN	t,ok
	FDIV	x,x,:seven
	ADD	k,k,7
	JMP	med
ok	FCMP	t,x,:ten
	BN	t,convert
	FDIV	x,x,:ten
	ADD	k,k,1
	JMP	ok
	% here we have k and 1<=x<10
convert	SRU	e,x,52			excess
	SET	t,1023
	SUB	e,e,t			exponent
	ANDNH	x,#FFF0			remove excess and sign
	ORH	x,#0010			add hidden bit
	SLU	x,x,e			apply exponent to e
1H	SRU	h,x,52
	CMP	t,h,10
	BN	t,1F
	DIV	x,x,10
	ADD	k,k,1			
	JMP	1B

1H	SLU	x,x,12
	SET	i,8
	SET	b,0			
	% now h.x*10^k is the number	0<=h<10
	BZ	h,1F
	ADD	h,h,'0'
	SET	b,h
	SET	i,7
1H	MULU	x,x,10
	GET	h,:rH
	ADD	h,h,'0'
	SLU	b,b,8
	OR	b,b,h
	SUB	i,i,1
	BP	i,1B
	
output  	SET	i,7
	BN	k,withE
	CMP	t,k,7
	BP	t,withE
noE	SRU	t,b,56
	SLU	b,b,8
	STBU	t,str,0
	ADD	str,str,1
	BNZ	k,1F
	SET	t,'.'
	STBU	t,str,0
	ADD	str,str,1
1H	SUB	k,k,1
	SUB	i,i,1
	BNN	i,noE
	POP	0,0


withE SRU	t,b,56
	SLU	b,b,8
	STBU	t,str,0
	SUB	i,i,1
	ADD	str,str,1
	SET	t,'.'
	STBU	t,str,0
	ADD	str,str,1
1H	SRU	t,b,56
	SLU	b,b,8
	STBU	t,str,0
	ADD	str,str,1
	SUB	i,i,1
	BNN	i,1B
	% output exponent
	SET	t,'e'
	STBU	t,str,0
	ADD	str,str,1
	SET	t,'+'
	CSN	t,k,'-'
	STBU	t,str,0
	ADD	str,str,1
	NEG	t,k
	CSN	k,k,t
1H	DIV	k,k,100
	BZ	k,1F
	ADD	k,k,'0'
	STBU	k,str,0
	ADD	str,str,1
1H	GET	k,:rR
	DIV	t,k,10
	BZ	t,1F
	ADD	t,t,'0'
	STBU	t,str,0
	ADD	str,str,1
1H	GET	k,:rR
	ADD	k,k,'0'
	STBU	k,str,0
	ADD	str,str,1
	JMP	done


small	FMUL	x,x,:fourtynine
	SUB	k,k,49
	FCMP	t,x,:one
	BNN	t,med	
	JMP	small


zero	SET	t,'0'
	STBU	t,str,0
	STBU	t,str,2
	SET	t,'.'
	STBU	t,str,1
	ADD	str,str,3
done	SET	t,0
	STBU	t,str,0
	POP	0,0


	PREFIX	:stof:

str	IS	$0
b	IS	$1
s	IS	$2
n	IS	$3
k	IS	$4
e	IS	$5
es	IS	$6
t	IS	$7

:stof	SET	s,0		positiv
	SET	es,1
	SET	e,0
1H	LDBU	b,str,0
	ADD	str,str,1
	CMP	t,b,' '
	BZ	t,1B		skip spaces
	CMP	t,b,'+'
	BZ	t,skip
	CMP	t,b,'-'
	BNZ	t,digits
	SETH	s,#8000		negativ
skip	LDBU	b,str,0
	ADD	str,str,1

digits	SET	n,0
	SET	k,0
int	BZ	b,convert
	CMP	t,b,'e'
	BZ	t,exponent
	CMP	t,b,'E'
	BZ	t,exponent
	CMP	t,b,'.'		decimal point
	BZ	t,fraction
	SUB	b,b,'0'		integer part
	BN	b,fail
	CMP	t,b,9
	BP	t,fail
	SETH	t,#F000
	AND	t,t,n
	BNZ	t,big

	MUL	n,n,10
	ADD	n,n,b
1H	LDBU	b,str,0
	ADD	str,str,1
	JMP	int

big	ADD	k,k,1
	JMP	1B


fraction LDBU	b,str,0
	ADD	str,str,1
	BZ	b,convert
	CMP	t,b,'e'
	BZ	t,exponent
	CMP	t,b,'E'
	BZ	t,exponent

	SUB	b,b,'0'		integer part
	BN	b,fail
	CMP	t,b,9
	BP	t,fail
	SETH	t,#F000
	AND	t,t,n
	BNZ	t,fraction
	MUL	n,n,10
	ADD	n,n,b
	SUB	k,k,1
	JMP	fraction
	

exponent SET	es,1
	LDBU	b,str,0
	ADD	str,str,1
	CMP	t,b,'+'
	BZ	t,1F
	CMP	t,b,'-'
	BNZ	t,edigit
	NEG	es,1

1H	LDBU	b,str,0
	ADD	str,str,1

edigit	BZ	b,convert
	SUB	b,b,'0'		integer part
	BN	b,fail
	CMP	t,b,9
	BP	t,fail
	SETH	t,#F000
	AND	t,t,e
	BNZ	t,fail
	MUL	e,e,10
	ADD	e,e,b
	JMP	1B

	
convert	MUL	e,e,es
	ADD	k,k,e
	FLOT	n,n
	OR	n,n,s

1H	BN	k,small
	
2H	CMP	t,k,49
	BN	t,3F
	FMUL	n,n,:fourtynine
	SUB	k,k,49
	JMP	

3H	CMP	t,k,7
	BN	t,4F
	FMUL	n,n,:seven
	SUB	k,k,7
	JMP	3B

4H	BNP	k,5F
	FMUL	n,n,:ten
	SUB	k,k,1
	JMP	4B

5H	SET	$0,n
	POP	1,0


small	ADD	k,k,49
	FDIV	n,n,:fourtynine
	JMP	1B


fail	POP	0,0		return zero