;Low level floating point package for Embedded Pascal for the AVR
;
;This package is based on a modified IEEE single floating point format.
;It follows the same layout as IEEE but uses a 7 bit exponent instead of
;a 8 bit exponent.
;This has several advantages when used with small CPUs and systems as no
;packing/unpacking is required resulting in less code space required and
;better performance.

;	fpnorm	- passed a floating point number in LA - returns with it normalized.
;
;	Points to note:
;	Normalization consists of shifting the mantissa until there
;	is a 1 bit in the MSB of the mantissa.
;

;Register usage:
;This package uses R0,R1,R2,R3,R4,R5,R15,LA,LB,R25,R26
;
;The format consists of 32 bits as follows:
;
;	msb	-> 	lsb
;IEEE 	-> 1 bit sign, 8 bit exponent, 23 bit mantissa
;Here	-> 1 bit sign, 7 bit exponent, 24 bit mantissa
;
;With the format as used here, the msb of the mantissa is
;allways "1", except if the value of the number is 0.
;The mantissa is allways stored normalized. Normalizing
;consists of left shifting until a "1" bit is present at
;the msb of the mantissa with the exponent adjusted accordingly
;
;Please note that, as with any other binary floating point
;format, rounding errors from/to decimal representation are
;present, thus you must not use this for financial work of
;any kind.

	code

 global __AddSingle,__SubSingle,__MultSingle,__DivSingle
 global	FP_Normalize, Neg_Mant,__NotSingle
 global	SL_To_FP, L_To_FP, SW_To_FP, W_To_FP, SB_To_FP, B_To_FP,
 global @IntToSingle,IntToSingle|A,@Round,Round|A,@Int,Int|A
 global @SplitSingle,SplitSingle|exp,SplitSingle|Value,SplitSingle|s
 global	@GetAndResetExp,GetAndResetExp|A,GetAndResetExp|B
 global @SetExp,SetExp|A,SetExp|B,__SingleABS
 Global @Trunc,Trunc|A,@RoundStr,RoundStr|s,RoundStr|d
 Global __SingleLess,__SingleGreater,__SingleLessOrEQU,__SingleGreaterOrEQU

 extern __mod32,__div32,__LintToStr,__NotLint,__NotInt

	ifref __SingleABS
	RegUse #__SingleABS
__SingleABS:
	sbrs R19,7	;negative ?
	ret		;noop if no
	RegAdd ##,#__NotSingle
	endif
	RegEnd

	ifref __NotSingle
	RegUse #__NotSingle
__NotSingle:
	ldi R25,$80
	eor R19,R25
	ret
	endif
	RegEnd

	ifref FP_Normalize
	RegUse FP_Normalize
FP_Normalize:	
	mov R24,R16	;Check for zero mantissa
	or R24,R17
	or R24,R18
	breq fpzero	;make is a clean zero
	mov R24,R19	;get exponent and sign
	andi R24,$7F	;reset the sign bit
2b:	
	mov R25,R18	;test the MSB of the mantissa
	andi R25,$80
	brne 3f		;if set no more shifting required
	dec R24		;decrement exponent
	add R16,R16	;shift exponent left
	adc R17,R17
	adc R18,R18
	rjmp 2b		;loop and test again
3f:		
	mov R25,R19	;test sign
	andi R25,$80
	breq 4f		;skip if clear
	ori R24,$80	;set new sign bit

4f:	mov R19,R24	;put new exponent and sign back
	ret		;finished
	endif
	RegEnd


;	Set the floating overflow flag and return zero. Floating execptions
;	may be caught by the application software.

	ifref fpovrflw
	RegUse fpovrflw
fpovrflw:
	;ldi R16,1
	;sts FloatError,R16
	RegAdd ##,fpZero
	endif
	RegEnd

	ifref fpovrflw,fpzero
	RegUse fpzero
fpzero:
	clr R16
	clr R17
	clr R18
	clr R19
	ret
	endif
	RegEnd

;	Negate the mantissa in R16,R17,R18.

	ifref Neg_Mant
	RegUse Neg_Mant
Neg_Mant:
	clr R0
	clr R1
	clr R2
	sub R0,R16
	sbc R1,R17
	sbc R2,R18
	mov R16,R0
	mov R17,R1
	mov R18,R2
	ret			;and return
	endif
	RegEnd

	ifref SwapArgs
	RegUse SwapArgs
SwapArgs:
	mov R0,R16		;swap arguments
	mov R16,R20
	mov R20,R0
	mov R0,R17
	mov R17,R21
	mov R21,R0
	mov R0,R18
	mov R18,R22
	mov R22,R0
	mov R0,R19
	mov R19,R23
	mov R23,R0
	ret
	endif
	RegEnd

;	Floating subtraction. The value in LB is subtracted from the
;	value in LA. To simplify matters, we do it thus:
;
;	A-B == A+-B

	ifref __SubSingle
	RegUse #__SubSingle
__SubSingle:
	ldi R25,$80
	eor R23,R25		;toggle the sign of LB
	RegAdd #__SubSingle,#__AddSingle
	endif
	RegEnd
	
	;fall through to fladd

;	Floating addition:
;	Add the value in LA to the value in LB

	ifref __AddSingle,__SubSingle
	RegUse #__AddSingle
__AddSingle:
	mov R24,R16		;check 1st operand for zero
	or R24,R17
	or R24,R18		;only need to check mantissa
	breq Ret2nd		;if 1st operand 0, just return 2nd
	mov R24,R20
	or R24,R21
	or R24,R22		;check for zero 2nd arg
	brne snz		;if zero, just return the 1st operand
	ret
Ret2nd:
	mov R16,R20
	mov R17,R21
	mov R18,R22
	mov R19,R23
	ret
snz:	
	mov R24,R19		;exponent LA
	mov R25,R23		;exponent LB
	andi R24,$7F
	andi R25,$7F		;reset signs
	sub R25,R24		;find difference
	brcc 1f
	neg R25
	rcall SwapArgs
	RegAdd ##,SwapArgs
1f:
	cpi R25,24		;if less than 24 bits difference,
	brcs 2f			;we can do the add
	rjmp SwapArgs		;otherwise just return the larger value
2f:
	tst R25			;check for zero difference
	breq 2fa
	rcall fpadjust		;adjust till equal
	RegAdd ##,fpadjust
2fa:	mov R3,R19		;save exponent of result
	andi R19,$80		;test sign, do we need to negate?
	ldi R19,0		;zero fill in case +ve
	breq 1ff		;no
	rcall Neg_Mant		;yes
	RegAdd ##,Neg_Mant
	ldi R19,0ffh		;1 fill top byte
1ff:
	andi R23,$80		;test sign, do we need to negate?
	ldi R23,0		;zero fill in case +ve
	breq 1fff		;no
	call swapArgs
	rcall Neg_Mant		;yes
	ldi R19,0ffh		;1 fill top byte
1fff:

	add R16,R20
	adc R17,R21
	adc R18,R22
	adc R19,R23

	mov R0,R19		;get msb of R19 into carry
	rol R0
	ror R19			;now shift down 1 bit to compensate
	ror R18			;propogate the shift
	ror R17
	bst R16,0		;store current lsb for rounding in T
	ror R16
	
	mov R23,R3
	andi R23,$7F		;clear sign from exponent
	inc R23			;increment to compensate for shift above
	andi R19,$80		;mask off low bits
	or R19,R23		;or in exponent
	brpl 1fa
	rcall Neg_Mant		;restore mantissa to positive if required
1fa:	brtc 1fb
	rcall round		;round up if necessary
1fb:	rjmp FP_Normalize		;normalize and return!!
	RegAdd ##,FP_Normalize

	endif
	RegEnd

;	Round the number in LA up by one, because of a shift of bits out
;	earlier
	IfRef round
	RegUse round
round:
	ldi R25,1
	add R16,R25
	clr R25
	adc R17,R25
	adc R18,R25
	brcc 2gf		;no carry. All OK.

	lsr R19			;shift right
	ror R18
	ror R17
	ror R16

	mov R25,R19		;inc exponent. Keep sign
	andi R25,$80		;sign
	andi R19,$7F
	inc R19
	or R19,R25		;put sign back
2gf:
	ret
	endif
	RegEnd

;	Adjust the floating number in LA by increasing the exponent by the
;	contents of R25. The mantissa must be shifted right to compensate.

	ifref fpadjust
	RegUse fpadjust

fpadjust:
	andi R25,31		;mask of hi bits - irrelevant
1br:
	lsr R18
	ror R17
	ror R16
	inc R19			;increment exponent - it will not overflow
	dec R25
	brne 1br		;loop if more
	ret			;done
	
	endif
	RegEnd

;	Floating multiplication. The number in LA is multiplied by the
;	number in LB. 
;	This uses a modified multiplication algorithm allowing 24*24 bit
;	multiplication with a 32 bit result where the result is the most
;	significant 32 bit portion.
;	Multiplication is achieved by multiplying the mantissas and adding
;	the exponents with adjusting of the signes.
;	This routine requires normaized fp numbers on entry in LA and LB and 
;	will return the result in LA normalized.

	ifref __MultSingle
	RegUse #__MultSingle
__MultSingle:
	mov R0,R19		;keep copy of original exponent and sign
	mov R1,R23		;same for right argument

;	mov R2,R20
;	mov R20,R22
;	mov R22,R2

	clr R23
	clr R19

	mov R15,R16
	rcall mult26		;do 8 bits of multiply
	mov R15,R17
	rcall mult8		;next 8 bits
	mov R15,R18		;next 8 bits
	rcall mult8
	clr R24
	clr R15
	rjmp 1af		;skip forward
2bb:
	lsr R5			;adjust result to fit in 24 bits
	ror R4
	ror R3
	ror R2
	ror R15			;keep shifted out bits for rounding later
	inc R24
1af:
	tst R5			;hi byte zero yet?
	brne 2bb		;no, keep shifting down

	mov R16,R2		;result mantissa thus far	
	mov R17,R3
	mov R18,R4

	sbrs R4,7		;check for zero mantissa
	rjmp fpzero		;return a clean zero if so
	RegAdd ##,fpZero
	mov R25,R0		;exponent left argument
	andi R25,$7F		;mask off sign
	subi R25,$41		;remove bias, allow one bit shift
	add  R25,R24		;add in shift count
	subi R25,6		;compensate for shift up earlier
	mov R26,R1		;the other
	andi R26,$7F		;mask off signs
	add R25,R26		;add them together
	sbrc R25,7
	rjmp fpovrflw		;overflow in exponent
	RegAdd ##,fpovrflw
	mov R19,R25		;put exponent in
	eor R0,R1		;now check signs
	sbrs R0,7
	ret			;return if +ve
	ori R19,$80		;set sign flag
	sbrs R15,7		;top bit from earier set ?
	ret
	rjmp round		;round it
	RegAdd ##,round
	
;mult R16,17,18 * R15. R15 to be set to R20 before call
;result in R2,3,4,5 (32 bits)

mult26:
	clr R2
	clr R3
	clr R4
	clr R5
	clr R25
	ldi R24,6		;for 6 bits we will use a normal
3b:	lsr R15			;multiply
	brcc 1bf
	add R2,R20
	adc R3,R21
	adc R4,R22
	adc R5,R23
1bf:	lsl R20			;shift multiplicand left
	rol R21
	rol R22
	rol R23
	dec R24		
	brne 3b			;more ?
	ldi R24,2		;do remaining two bits with reduced
	rjmp 4ef		;precision as we only require 24 bits of result

;Multiply for remaining bits. Called twice with R15=Multiplier
;on entry R25 must be zero

mult8:
	ldi R24,8		;eight bits to go
3ab:
	lsr R5			;shift product down 1 bit
	ror R4
	ror R3
	ror R2
4ef:
	lsr R15			;shift LSB into carry
	brcc 1cf
	add R2,R20
	adc R3,R21
	adc R4,R22
	adc R5,R23
1cf:
	dec R24
	brne 3ab		;more?
	ret			;no, return as is

	endif
	RegEnd

;	Floating division. The number in LA is divided by the
;	number in LB. The result is returned in HLDE.

	ifref __DivSingle
	RegUse #__DivSingle
__DivSingle:
	mov R0,R19		;keep copy of original exponent and sign
	mov R1,R23		;same for right argument
	ldi R19,0		;zero top byte of dividend
	ldi R23,0		;zero top byte of divisor
	clr R2
	clr R3
	clr R4
	clr R5			;zero low word of quotient
	ldi R24,24+6		;number of bits in dividend and then some

3cb:
	sub R16,R20		;try a subtraction
	sbc R17,R21
	sbc R18,R22
	sbc R19,R23
        brcc 4af		;skip if no carry
	add R16,R20
	adc R17,R21
	adc R18,R22
	adc R19,R23		;restore dividend
	clc
	rjmp 5af
4af:	sec			;complement carry bit
5aF:	rol R2
	rol R3
	rol R4
	rol R5			;shift into quotient
	lsl R16			;shift dividend left
	rol R17
	rol R18
	rol R19
	dec R24			;decrement loop count
	brne 3cb

	clr R24
	clr R15
	rjmp 1df		;skip forward
2db:
	lsr R5			;adjust result to fit in 24 bits
	ror R4
	ror R3
	ror R2
	ror R15			;keep shifted out bits for rounding later
	inc R24
1df:
	tst R5			;hi byte zero yet?
	brne 2db		;no, keep shifting down

	mov R16,R2
	mov R17,R3
	mov R18,R4		;get quotient

	mov R25,R0
	andi R25,$7F
	mov R26,R1
	andi R26,$7F
	sub R25,R26
	subi R25,$C5		;same as addi R25,41h-6
	add R25,R24
	mov R19,R25

	eor R0,R1
	sbrc R0,7
	ori R19,$80

	sbrc R15,7		;top bit from earier set ?
	rcall round		;round if necessary
	RegAdd ##,round
	rjmp FP_Normalize	;normalize it and return
	RegAdd ##,FP_Normalize
	endif
	RegEnd

;@IntToSingle:
;Convert longint in IntToSingle|A to float. Return result on stack

	IfRef @IntToSingle
	RegUse #@IntToSingle
@IntToSingle:
	lds R16,IntToSingle|A
	lds R17,IntToSingle|A+1
	lds R18,IntToSingle|A+2
	lds R19,IntToSingle|A+3
	.call SL_To_FP
	RegAdd ##,SL_To_FP
	ret
	endif
	RegEnd

;B_To_FP: convert a byte to float. Byte in R16

	ifref B_To_FP
	RegUse B_To_FP	
B_To_FP:
	clr R17
	RegAdd ##,W_To_FP
	endif
	RegEnd

;W_To_FP: convert a word to float. word in R16,R17

	ifref B_To_FP,W_To_FP
	RegUse W_To_FP
W_To_FP:
	clr R18		;zero top byte
	RegAdd ##,b3tof
	endif
	RegEnd

;b3tof: convert a 3 byte word to float. In R16,17,18

	ifref B_To_FP,W_To_FP,b3tof
	RegUse b3tof
b3tof:
	ldi R19,64+24
	rjmp FP_Normalize
	RegAdd ##,FP_Normalize
	endif
	RegEnd

;SB_To_FP: convert a 8 bit integer to float. Integer in R16

	ifref SB_To_FP
	RegUse SB_To_FP
SB_To_FP:
	clr R17
	sbrs R16,7
	rjmp SW_To_FP	;is positive
	ser R17		;else is negative	
	RegAdd ##,SW_To_FP
	endif
	RegEnd

;SW_To_FP: convert a 16 bit integer to float. Integer in R16,R17

	ifref SW_To_FP
	RegUse SW_To_FP
SW_To_FP:
	sbrs R17,7		;negative?
	rjmp W_To_FP		;no, treat as unsigned
	.call __NotInt		;in Intlib libray
	RegAdd ##,#__NotInt
	rcall W_To_FP
	RegAdd ##,W_To_FP
	ori R19,$80		;set sign flag
	ret
	endif
	RegEnd

;L_To_FP: convert 32 bit word to float. Word in LA.

	ifref L_To_FP
	RegUse L_To_FP
L_To_FP:
	tst R19			;anything in top byte?
        brne L_To_FP1
	rjmp b3tof		;no, just do 3 bytes
	RegAdd ##,b3tof
L_To_FP1:	
	mov R16,R17		;shift down 8 bits
	mov R17,R18
	mov R18,R19
	ldi R19,64+24+8		;the 8 compensates for the shift
	rjmp FP_Normalize	;and normalize it
	RegAdd ##,FP_Normalize
	endif
	RegEnd

;SL_To_FP: convert 32 bit integer to float. Word in LA.

	ifref SL_To_FP
	RegUse SL_To_FP
SL_To_FP:
	sbrs R19,7		;negative?
	rjmp L_To_FP		;no, treat as unsigned
	.call __NotLint		;in Intlib library
	RegAdd ##,#__NotLint
	rcall L_To_FP
	RegAdd ##,L_To_FP
	ori R19,$80		;set sign flag
	ret
	endif
	RegEnd

;	Round the argument to an integral value, return as a float

	ifref @Int
	RegUse #@Int
@Int:
	lds R16,Int|a
	lds R17,Int|a+1
	lds R18,Int|a+2
	lds R19,Int|a+3
	clt		;no rounding
	rcall FtoL
	RegAdd ##,FtoL
	rcall SL_To_FP
	RegAdd ##,SL_To_FP
	ret
	endif
	RegEnd

;	ftol - convert floating to long, by using lower bits can also
;	be used to convert from float to int or char

	ifref @Round
	RegUse #@Round
@Round:
	lds R16,Round|a
	lds R17,Round|a+1
	lds R18,Round|a+2
	lds R19,Round|a+3
	set			;do rounding
	rcall FtoL
	RegAdd ##,FtoL
	ret
	endif
	RegEnd

	ifref @Trunc
	RegUse #@Trunc
@Trunc:
	lds R16,Trunc|a
	lds R17,Trunc|a+1
	lds R18,Trunc|a+2
	lds R19,Trunc|a+3
	clt			;no rounding
	call FtoL
	RegAdd ##,FtoL
	ret	
	endif
	RegEnd
	
	ifref FtoL
	RegUse FtoL
FtoL:	sbrc R19,7		;test sign
	rcall Neg_Mant		;negate mantissa if required
	RegAdd ##,Neg_Mant
	mov R20,R19		;get exponent
	andi R20,$7F		;mask sign off
	subi R20,64+24		;remove offset, now shift count
	lsl R19
	sbc R19,R19		;sign extend
	sbrs R20,7		;test sign of shift count
	rjmp allsh		;shift it left
	neg R20			;make +ve
	dec R20			;and reduce it one
	breq FtoL1
	rcall alrsh		;shift right
FtoL1:	brts FtoL2
	rjmp NoRounding
FtoL2:	ldi R21,1		;add a one
	clr R22
	add R16,R21
	adc R17,R22
	adc R18,R22
	adc R19,R22		;and shift down one more
NoRounding:
	ldi R20,1
alrsh:	cpi R20,32
	brcc ret0
alrsh1:	mov R0,R19
	lsl R0
	ror R19
	ror R18
	ror R17
	ror R16
	dec R20
	brne alrsh1
	ret
allsh:	cpi R20,32
	brcc ret0
allsh1:	lsl R16
	rol R17
	rol R18
	rol R19
	dec R20
	brne allsh1
 	ret
ret0:	rjmp FPZero
	RegAdd ##,FPZero
	endif
	RegEnd

	ifref hasfrac
	RegUse hasfrac
hasfrac:
	clr R20			;zero number
	mov R0,R16
	tst R0			;check low 8 bits
	brne e1fa		;non zero bit in low 8 bits
	ldi R20,8		;bump count
	mov R0,R17		;check next 8 bits
	tst R0
	brne e1fa		;yup
	ldi R20,16
	mov R0,R18		;now check next 8 bits
e1fa:
	lsr R0			;shift bottom bit out
	brcs e2fa		;found a bit!
	inc R20			;increment count
	rjmp e1fa		;and loop

e2fa:
	mov R21,R19		;get exponent
	andi R21,$7F		;clear sign bit - should be zero anyway
	subi R21,64+24		;normalize - remove bias
	add R20,R21		;add in bit position
	ret			;return with value in R20 and flags set
	endif
	RegEnd

;on entry: hlde is x. Address of exponent (16 bit integer) is in ix
;ascii result is returned on the stack as string
;uses R12 as temporary storage locations
	
	ifref @SplitSingle
	reguse #@SplitSingle

@SplitSingle:
	lds R16,SplitSingle|Value
	lds R17,SplitSingle|Value+1
	lds R18,SplitSingle|Value+2
	lds R19,SplitSingle|Value+3

	clr R12

	lds R26,SplitSingle|exp	;X
	lds R27,SplitSingle|exp+1
	st X+,R12		;and the returned exp value
	st X,R12

	andi R19,$7F
	brne e1f		;return if x = 0.0
	clr R16
	clr R17
	clr R18
	clr R19			;zero number just in case
	rjmp sbcd		;return with mantissa = 0, exponent = 0
e1f:
	andi R19,$7F		;test mantissa sign
e2b:
	call hasfrac		;any fractional part?
	RegAdd ##,hasfrac
	sbrc R20,7
	rjmp e1fx		;negative if there is fractional part
	ldi R20,0CDH
	ldi R21,0CCH
	ldi R22,0CCH
	ldi R23,03DH 		;0.1
	rcall __MultSingle	;returns with value in LA
	RegAdd ##,#__MultSingle
	inc R12			;increment exponent
	rjmp e2b		;now check again
e1fx:
	ldi R20,000H
	ldi R21,000H
	ldi R22,0A0H
	ldi R23,044H 		;10.0
	rcall __MultSingle	;multiply it
	dec R12			;decrement exponent
	call hasfrac		;check for fractional part
	sbrc R20,7
	rjmp e1fx		;loop if still fractional
	mov R20,R19		;get exponent
	clr R19			;zero top byte
	subi R20,64+24		;offset exponent
e2bx:
	tst R20			;check for zero
	breq e3f		;return if finished
	sbrs R20,7
	rjmp e4f
	lsr R18			;shift l down
	ror R17			;rotate the rest
	ror R16
	inc R20			;increment count
	rjmp e2bx
e4f:
	lsl R16
	rol R17
	rol R18
	rol R19
	dec R20
	rjmp e2bx
e3f:
	lds R26,SplitSingle|exp	;X
	lds R27,SplitSingle|exp+1
	st X+,R12		;store exponent
	clr R21
	sbrc R12,7
	ser R21			;sign extend it
	st X,R21

sbcd:	rjmp __LintToStr
	RegAdd ##,#__LintToStr

	endif
	RegEnd

;	These functions allow the mantissa and exponent of floating
;	numbers to be manipulate separately.

;function GetAndResetExp(A: Single; var B: Integer): Single;
;B will get exponent with bias removed
;Return mantissa unchanged with exponent=0 (bias added) (+ original sign)

	ifRef @GetAndResetExp
	RegUse #@GetAndResetExp
@GetAndResetExp:
	lds R20,GetAndResetExp|A+3 ;get old exponent
	mov R21,R20	;save sign bit
	andi R20,80h	;mask it out
	subi R20,192	;same as addi R20,64 - add in bias
	mov R19,R20	;store new exponent back
	andi R21,7Fh	;clear sign bit
	subi R21,64	;remove bias
	lds R30,GetAndResetExp|B	;get pointer
	lds R31,GetAndResetExp|B+1
	st Z+,R21
	clr R24
	sbrc R21,7
	ser R24 	;sign extend
	st Z,R24	;store upper byte
	lds R16,GetAndResetExp|A
	lds R17,GetAndResetExp|A+1
	lds R18,GetAndResetExp|A+2
	ret
	endif
	RegEnd

;function SetExp(A: Single; var B: Integer): Single;
;Adds Exponent passed in B to exponent in A
	ifref @SetExp
	RegUse #@SetExp
@SetExp:
	lds R20,SetExp|B
	andi R20,7Fh
	lds R16,SetExp|A
	lds R17,SetExp|A+1
	lds R18,SetExp|A+2
	lds R19,SetExp|A+3
	mov R21,R19
	andi R21,80h 	;keep sign
	add R19,R20
	andi R19,7Fh
	or R19,R21
	ret
	endif
	RegEnd

	ifref @RoundStr
	RegUse #@RoundStr
@RoundStr:
	lds R30,RoundStr|S
	lds R31,RoundStr|S+1
	mov R26,R30
	mov R27,R31
	ld R20,Z+
	clr R21
Rnd1:	ld R16,Z+
	inc R21
	cpi R16,2Eh
	brne Rnd1
			;R21=current char position of '.'
			;R20=length(s);
	lds R16,RoundStr|D
	mov R22,R16
	add R16,R21
	sub R16,R20
	brcc Rnd5	;>>decs requested>=length of string

	mov R16,R22 	;decs requested
	add R16,R21	;c=char pos of '.'
	st X,R16	;new length of string
	mov R21,R16	;need to keep track
	subi R21,$FE	;same as addi R21,2
	mov R16,R22	;decs requested
	clr R17
	add R30,R16
	adc R31,R17	;point one char past

	ld R16,Z
	cpi R16,35H
	brcc rnd3	
	rjmp rndu2 	;done
rnd3:	sbiw R30,1
	dec R21
	breq rndu1	;underflow. Need to prefix "1"
	ld R16,Z
	cpi R16,'.'
	brne rnd4
	sbiw R30,1
	dec R21
	breq rndu1
	ld R16,Z
rnd4:	inc R16
	cpi R16,3AH
	st Z,R16
	brcs rndu2
	ldi R16,30H
	st Z,R16
	rjmp rnd3

rndu1:  ldi R16,1
	ret
rndu2:	clr R16
rndu2a:	ret
Rnd5:	breq rndu2
	lds R30,RoundStr|S
	lds R31,RoundStr|S+1
	clr R17
	inc R21
	add R30,R21
	adc R31,R17
	mov R21,R16
	ldi R17,$30
Rnd6:	st Z+,R17
	dec R21
	brne Rnd6
	rjmp rndu2

	endif
	RegEnd

;FP compare routines. First argument (left) is in R20,R21,R22,R23, second (right) in R16,R17,R18,R19
;return boolean in R16
;Note: for "=" and "<>" longint routines are used
 	
	ifref __SingleLess
	RegUse #__SingleLess
	
__SingleLess:
	RegAdd ##,_SingleCMP
	call _SingleCMP
	cpi R16,2
	ldi R16,1
	breq _Ll1
	dec R16
_Ll1:	tst R16
	ret

	RegEnd
	endif
	
	ifref __SingleGreater
	RegUse #__SingleGreater
	
__SingleGreater:
	RegAdd ##,_SingleCMP
	call _SingleCMP
	cpi R16,1
	ldi R16,1
	breq _Lg1
	dec R16
_Lg1:	tst R16
	ret
	
	RegEnd
	endif
	
	ifref __SingleLessOrEQU
	RegUse #__SingleLessOrEQU
	
__SingleLessOrEQU:
	RegAdd ##,_SingleCMP
	call _SingleCMP
	tst R16
	breq _Lle1
	cpi R16,2
	breq _Lle1
	clr R16
	ret
_Lle1:	ldi R16,1
	tst R16
	ret

	RegEnd
	endif

	ifref __SingleGreaterOrEQU
	RegUse #__SingleGreaterOrEQU

__SingleGreaterOrEQU:
	RegAdd ##,_SingleCMP
	call _SingleCMP
	tst R16
	breq _Lge1
	cpi R16,1
	breq _Lge1
	clr R16
	ret
_Lge1:	ldi R16,1
	tst R16
	ret

	RegEnd
	endif

;compare two singles. LA and LB
;result in R16: 0=equal, 1= LB>LA 2= LB<LA

        ifref _SingleCMP
	RegUse _SingleCMP

_SingleCMP:
	sbrc R23,7
	rjmp _Lc1		;>>stack arg is negative
	sbrc R19,7
	rjmp _Lc2		;>>stack arg is positive, R2345 is negative
	
_Lc5:	sub R23,R19
	brcs _Lc3
	brne _Lc2
	sub R22,R18
	brcs _Lc3
	brne _Lc2
	sub R21,R17
	brcs _Lc3
	brne _Lc2
	sub R20,R16
	brcs _Lc3
	brne _Lc2
	ldi R16,0
	ret		

_Lc1:	sbrs R19,7
	rjmp _Lc3	;>>stack arg negative, R2345 positive
			;both negative
	rjmp _Lc5

_Lc2:	ldi R16,1	;Stack arg>R2345
	ret
_Lc3:   ldi R16,2	;Stack arg<R2345
	ret

	RegEnd
	endif

	data

SetExp|A:
GetAndResetExp|A:
Int|A:
Round|A:
Trunc|A:
SplitSingle|Value:
IntToSingle|A:
RoundStr|s:	ds 4
SetExp|B:
RoundStr|d:
GetAndResetExp|B:
SplitSingle|exp: ds 2
SplitSingle|s: ds 2

	end
