PureBasic Forums - English

Posted: **Tue Apr 01, 2008 11:39 pm**

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...

Posted: **Wed Apr 02, 2008 12:32 am**

Maybe you can klurge this klurge to get something?

http://www.purebasic.fr/english/viewtop ... ent#122731

Hope it is useful.

Posted: **Wed Apr 02, 2008 10:51 pm**

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

Posted: **Thu Apr 03, 2008 12:01 pm**

Extract:

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$)

Note: The Exponent-Base is 2!
For (decimal-)Exponential-Output see:http://forums.purebasic.com/german/view ... hp?p=78868.

Gruss
Helle

PureBasic Forums - English

Extract base and exponent from a double?

Extract base and exponent from a double?