Here is the issue I've run into:
My program handles doubles, with the option to save and load them from external files. I've been writing them and reading them back as strings using StrD/ValD. However lately I have been using very small numbers, on the order of 4e-18 or so, and was having problems. The cause of course turned out to be StrD was saving them as 0.000....
The obvious solution is WriteDouble/ReadDouble, rather than strings. But due to the nature of my program it's very handy to be able to edit the data files in a text editor. So my new idea is to write them in exponential form, such as "5.438e-20".
But I can't figure out a correct method to extract the base/exponent from the binary double. Assuming PB uses the format on Wikipedia (http://en.wikipedia.org/wiki/Double_float), does anyone know how to extract them?
I'll keep working, and post my code eventually...
Extract base and exponent from a double?
Maybe you can klurge this klurge to get something?
http://www.purebasic.fr/english/viewtop ... ent#122731
Hope it is useful.
http://www.purebasic.fr/english/viewtop ... ent#122731
Hope it is useful.
Dare2 cut down to size
here's routine I clobbered together to output an 80 bit float, at present am too lazy/tired to adapt to double, but you are welcome to play with the code.
Code: Select all
Structure r10
StructureUnion
fl.l[3]
fw.w[6]
tb.b[12]
EndStructureUnion
EndStructure
Global ctrlwrd.w = 4927;&B0001001100111111
Procedure.l xSign(*x.r10) ;returns -1 if x<0, 0 if x=0, 1 if x>0
;by paul dixon
! mov edx,[p.p_x]
! fld tword [edx]
! ftst
! fstsw ax
! mov al,ah
! shr al,6
! Xor ah,1
! Xor ah,al
! shl ah,1
! Or al,ah
! And eax,3
! dec eax
ProcedureReturn
EndProcedure
Procedure.l nInt(*x.r10)
oldcw.l ;esp+0
newcw.l ;esp+4
! mov ecx,[p.p_x] ;x
! lea edx,[p.v_oldcw] ;oldcw
! lea edi,[p.v_newcw] ;newcw
! fstcw word [edx]
! mov ax,[edx]
! Or ax,000000000000b
! mov [edi],ax
! fldcw word [edi]
! fld tword [ecx]
! frndint
! lea eax,[esp+4]
! fistp dword [eax]
! mov dword eax,[eax]
! fldcw word [edx]
ProcedureReturn
EndProcedure
Procedure xiPower(*y.r10,*x.r10, e.l)
! mov eax,[p.v_e];e
! mov ebx,eax
! rxpower_abseax:
! neg eax
! js rxpower_abseax
! fld1 ; z:=1.0
! fld1
! mov edx,[p.p_x];x
! fld tword [edx] ;load st0 with x
! cmp eax,0 ;while e>0
! rxpower_while1:
! jle rxpower_wend1
! rxpower_while2:
! bt eax,0 ;test for odd/even
! jc rxpower_wend2 ;jump if odd
; while y is even
! sar eax,1 ;eax=eax/2
! fmul st0,st0 ;x=x*x
! jmp rxpower_while2
! rxpower_wend2:
! sub eax,1
! fmul st1,st0 ;z=z*x ;st1=st1*st0
! jmp rxpower_while1
! rxpower_wend1:
! fstp st0 ;cleanup fpu stack
! fstp st1 ;" " "
! cmp ebx,0 ;test to see if y<0
! jge rxpower_noinv ;skip reciprocal if not less than 0
; if y<0 take reciprocal
! fld1
! fdivrp st1,st0
! rxpower_noinv:
! mov eax,[p.p_y]
! fstp tword [eax] ;store z (st0)
! fstp tword st0 ;clear fpu stack
! fstp tword st0 ;clear fpu stack
ProcedureReturn
EndProcedure
Procedure xTrunc(*y.r10,*x.r10) ;y=trunc(x)
oldcw.l ;esp+0
newcw.l ;esp+4
! mov ecx,[p.p_x] ;x
! lea edx,[p.v_oldcw] ;oldcw
! lea edi,[p.v_newcw] ;newcw
! fstcw word [edx]
! mov ax,[edx]
! Or ax,110000000000b
! mov [edi],ax
! fldcw word [edi]
! fld tword [ecx]
! frndint
! mov eax,[p.p_y]
! fstp tword [eax]
! fldcw word [edx]
ProcedureReturn
EndProcedure
Procedure xiMul(*y.r10,*x.r10,z.l);y=x*z
! fldcw [v_ctrlwrd] ; this guarantees extended precision
! mov ebx,[p.p_x] ;x
! lea ecx,[p.v_z] ;z
! mov eax,[p.p_y] ;y
! fld tword [ebx] ;x
! fild dword [ecx];z
! fmulp st1,st0
! fstp tword [eax]
ProcedureReturn
EndProcedure
Procedure xSub(*z.r10,*x.r10,*y.r10);z=x-y
! fldcw [v_ctrlwrd] ; this guarantees extended precision
! mov edx,[p.p_x] ;x
! mov ebx,[p.p_y];y
! mov eax,[p.p_z];z
! fld tword [edx];x
! fld tword [ebx];y
! fsubp st1,st0 ;x-y
! fstp tword [eax];z
ProcedureReturn
EndProcedure
Procedure.s xFtoA(*x.r10)
temp.r10 ;esp
y.r10 ;esp+12
ex.l=10 ;esp+24
t.l ;esp+28
v.l ;esp+32
s.l=xSign(*x);esp+36
z.r10 ;esp+40
w.r10 ;esp+52
f.s ;esp+64
vl$="" ;esp+68
c.w ;esp+72
hi.w ;esp+76
lo.w ;esp+80
v=*x\fw[4]&$FFFF
zz.l=*x\fw[3]&$FFFF
s=*x\fw[4]>>15
If ((v=0) Or (v=32768)) And (zz=0)
vl$=" 0.000000000000000000e+0000"
If s=-1
vl$="-0.000000000000000000e+0000"
EndIf
Goto ftoa_end
EndIf
If (((v=65535) Or (v=32767)) And (zz=49152))
vl$=" NaN"
Goto ftoa_end
EndIf
If ((v=32767) And (zz=32768))
vl$=" Inf"
Goto ftoa_end
EndIf
If ((v=65535) And (zz=32768))
vl$="-Inf"
Goto ftoa_end
EndIf
! mov ebx,[p.p_x] ;x
! lea ecx,[p.v_temp] ;temp
! lea edi,[p.v_y] ;y
! lea edx,[p.v_ex] ;ex
! fldcw [v_ctrlwrd] ; this guarantees extended precision
! fld tword [ebx] ;x
! fabs ;abs(x)
! lea esi,[p.v_z] ;z
! fstp tword [esi] ;z=abs(x)
! fild dword [edx] ;load value 10 from ex
! fld st0 ;dup
! lea edx,[p.v_w] ;w
! fstp tword [edx] ;w=10
! fstp tword [ecx] ;temp=ex, = 10
! fldlg2 ;load log10(2)
! fld tword [esi]
! fyl2x ; st1*log2(x)
! fstp tword [edi] ;y=log10(x)
;ex=xFloor(@y)
ex=nInt(@y)
xiPower(@temp,@temp,17-ex)
! lea ebx,[p.v_z] ;z
! lea ecx,[p.v_temp] ;temp
! fld tword [ecx] ;temp
! fld tword [ebx] ;z
! fmulp st1,st0
! fstp tword [ecx] ;temp
xTrunc(@w,@temp)
! lea edi,[p.v_y] ;y
! lea edx,[p.v_w] ;w
! fld tword [edx] ;w
! fbstp tword [edi];y
c=y\tb[8] & $FF
hi=c>>4
lo=c-hi<<4
If hi=0
xiMul(@temp,@temp,10)
ex=ex-1
EndIf
xTrunc(@y,@temp)
xSub(@temp,@temp,@y)
xiMul(@temp,@temp,10)
! lea ecx,[p.v_temp] ;temp
! lea edi,[p.v_y] ;y
! lea edx,[p.v_w] ;w
! fld tword [edi] ;y
! fbstp tword [edi];y
! fld tword [ecx] ;temp
! fbstp tword [edx];w
c=y\tb[8] & $FF
hi=c>>4
lo=c-hi<<4
hb$=Chr(hi+48)
lb$=Chr(lo+48)
vl$=hb$+"."+lb$
i.l=7
While i>=0
c=y\tb[i] & $FF
hi=c>>4
lo=c-hi<<4
hb$=Chr(hi+48)
lb$=Chr(lo+48)
vl$=vl$+hb$+lb$
i=i-1
Wend
c=w\tb[0] & $FF
hi=c>>4
lo=c-hi<<4
lb$=Chr(lo+48)
vl$=vl$+lb$
If s=-1
vl$="-"+vl$
Else
vl$=" "+vl$
EndIf
f=Str(Abs(ex))
f=RSet(f,4,"0")
If ex<0
f="e-"+f
Else
f="e+"+f
EndIf
vl$=vl$+f
ftoa_end:
ProcedureReturn vl$
EndProcedure
Extract:
Note: The Exponent-Base is 2!
For (decimal-)Exponential-Output see:http://forums.purebasic.com/german/view ... hp?p=78868.
Gruss
Helle
Code: Select all
Global D.d ;Value Input-Double-Value
Global M.d ;Mantissa is Double! 1.0>=|M|<2.0
Global E.l ;Exponent is Integer! Base is 2 (2^E)!
Input$ = InputRequester("Input", "Value :", "")
If Input$ > ""
D = ValD(Input$)
Else
End
EndIf
;without Saves
!fninit ;Or Not ;-)
!fld qword[v_D] ;Load Value
!fxtract ;Extract Value in Mantissa (st0) and Exponent (st1)
!fstp qword[v_M] ;Mantissa
!fistp [v_E] ;Exponent
X$ = "Result for " + Input$ + " is : " + #CRLF$ + #CRLF$ + "Mantissa : " + StrD(M) + #CRLF$ + "Exponent : " + Str(E) + #CRLF$ + #CRLF$
Y$ = "(" + StrD(M) + " * 2^" + Str(E) + " = " + StrD(D) + ")"
MessageRequester("Extract Double in Mantissa and Exponent", X$ + Y$)
For (decimal-)Exponential-Output see:http://forums.purebasic.com/german/view ... hp?p=78868.
Gruss
Helle