PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

80 bit variables

https://www.purebasic.fr/english/viewtopic.php?t=19402

Page 1 of 3

80 bit variables

Posted: Fri Feb 10, 2006 3:50 pm
by El_Choni
I guess this won't make it into PB any time soon, but I think it's a reasonable request. It would give the maximum precision provided by the x86 FPU so, why not use it?

Posted: Fri Feb 10, 2006 4:17 pm
by ts-soft
currency is a good idea !

Re: 80 bit variables

Posted: Fri Feb 10, 2006 9:41 pm
by Psychophanta
El_Choni wrote:I guess this won't make it into PB any time soon, but I think it's a reasonable request. It would give the maximum precision provided by the x86 FPU so, why not use it?
I asked it myself before.
But probably the answer is because some of the fpu commands don't allow 80bit floats, and it is hard to do a compilation for it.

Posted: Fri Feb 10, 2006 11:12 pm
by jack
i think the only complication is that some windows system dll's (don't know which) set the precision to 64 bit's, do a search on the PowerBasic forum to find out more.

Posted: Sat Feb 11, 2006 12:12 am
by El_Choni
The FPU internal format is 80 bits, so no conversion is needed (when operating with floats), unlike with 64 and 32 bits. I think this internal format can't be set or unset, it's just how the FPU works. And all the FPU memory instructions can use dword, qword or tword, so it's only a question of implementing it (which may be hard, of course).

My suggestion for these new datatypes would be .t (tword) for signed integers, .e (extended precision floats) for floats.

Just my 2 cents, regards,

Posted: Sat Feb 11, 2006 1:09 am
by jack
see http://www.powerbasic.com/support/forum ... 00027.html
apparently message box function sets the fpu precision to double

Posted: Sat Feb 11, 2006 2:16 am
by jack
ok, here's proof.

Code: Select all

Structure ext
  StructureUnion
    fw.w[6]
    tb.b[12]     
  EndStructureUnion
EndStructure

Declare xiPower(*x.ext, e.l, *y.ext) ;y=x^e
Declare xSign(*x.ext)                ;returns integer: -1 if x<0, 0 if x=0, 1 if x>0
Declare xFloor(*x.ext)               ;returns integer rounded to minus Infinity
Declare xTrunc(*x.ext,*y.ext)        ;y=trunc(x), (chop)
Declare nInt(*x.ext)                 ;returns integer rounded to nearest
Declare xiMul(*x.ext,z.l,*y.ext)     ;y=x*z
Declare xSub(*x.ext,*y.ext,*z.ext)   ;z=x-y
Declare xAtoF(float$, *x.ext)        ;string to ext 
Declare.s xFtoA(*x.ext)              ;ext to string

OpenConsole()
x.ext
a$="3.141592653589793238462"
xAtoF(a$,@x)

PrintN("should = 3.141592653589793238  "+xFtoA(@x))
MessageRequester("ASM Example", "test the effects of message box on the fpu", 0)
PrintN("should = 3.141592653589793238  "+xFtoA(@x))
PrintN("                                                  ^^")
Print("press return to end")
Input()
CloseConsole()
End

Procedure xAtoF(value.s,*x.ext)
  
  y.ext  ;esp+4
  pw.ext ;esp+16
  t.l=10 ;esp+28
  j.l=1  ;esp+32
  s=1    ;esp+36
  d=0    ;esp+40
  e=0    ;esp+44
  ep=0   ;esp+48
  ex=0   ;esp+52
  es=1   ;esp+56
  i=0    ;esp+60
  f=0    ;esp+64
  fp=0   ;esp+68
  
  value=UCase(value)
  fln=Len(value)
  f=FindString(value,"NaN",1)
  If f>0
    *x\fw[4]=$FFFF
    *x\fw[3]=$C000
    *x\fw[2]=0
    *x\fw[1]=0
    *x\fw[0]=0
    Goto atof_end
  EndIf
  f=FindString(value,"Inf",1)
  If f>0
    *x\fw[4]=$7FFF
    *x\fw[3]=$8000
    *x\fw[2]=0
    *x\fw[1]=0
    *x\fw[0]=0
    Goto atof_end
  EndIf
  f=FindString(value,"-Inf",1)
  If f>0
    *x\fw[4]=$FFFF
    *x\fw[3]=$8000
    *x\fw[2]=0
    *x\fw[1]=0
    *x\fw[0]=0
    Goto atof_end
  EndIf
  
  f1$=""
  f2$=""
  f3$=""
  ! lea ebx,[esp+16]
  ! lea edx,[esp+28]
  ! finit
  ! fild dword [edx]
  ! fstp tword [ebx]
  While j<=fln
    c$=Mid(value,j,1)
    If ep=1
      If c$=" "
        Goto atof1nxtch
      EndIf
      If c$="-"
        es=-es
        c$=""
      EndIf
      If c$="+"
        Goto atof1nxtch
      EndIf
      If (c$="0") And (f3$="")
        Goto atof1nxtch
      EndIf
      If (c$>"/") And (c$<":") ;c$ is digit between 0 and 9
        f3$=f3$+c$
        ex=10*ex+(Asc(c$)-48)
        Goto atof1nxtch
      EndIf
    EndIf
    
    If c$=" "
      Goto atof1nxtch
    EndIf
    If c$="-"
      s=-s
      Goto atof1nxtch
    EndIf
    If c$="+"
      Goto atof1nxtch
    EndIf
    If c$="."
      If d=1
        Goto atof1nxtch
      EndIf
      d=1
    EndIf
    If (c$>"/") And (c$<":") ;c$ is digit between 0 and 9
      If ((c$="0") And (i=0))
        If d=0
          Goto atof1nxtch
        EndIf
        If (d=1) And (f=0)
          e=e-1
          Goto atof1nxtch
        EndIf
      EndIf
      If d=0
        f1$=f1$+c$
        i=i+1
      Else
        If (c$>"0")
          fp=1
        EndIf
        f2$=f2$+c$
        f=f+1
      EndIf
    EndIf
    If c$="E"
      ep=1
    EndIf
    atof1nxtch:
    j=j+1
  Wend
  If fp=0
    f=0
    f2$=""
  EndIf
  
  ex=es*ex-18+i+e ;(es*ex)-(18-i)+e
  f1$=f1$+f2$
  fln=Len(f1$)
  If Len(f1$)>20
    f1$=Mid(f1$,1,20)
  EndIf
  While Len(f1$)<20
    f1$=f1$+"0"
  Wend
  
  *x\tb[9]=0 ;alway zero for positive bcd number
  i=1
  j=8
  While i<18
    c.w=16*(Asc(Mid(f1$,i,1))-48)
    i=i+1
    c.w=c+(Asc(Mid(f1$,i,1))-48)
    i=i+1
    *x\tb[j]=c
    j=j-1
  Wend
  
  ;put the last two digits into y
  For i=1 To 9
    y\tb[i]=0
  Next
  c.w=16*(Asc(Mid(f1$,19,1))-48)
  c.w=c+(Asc(Mid(f1$,20,1))-48)
  y\tb[0]=c
  t=100
  ! lea edx,[esp+28];t
  ! lea ebx,[esp+4] ;y
  ! fbld tword [ebx]
  ! fild dword [edx]
  ! fdivp st1,st0   ;y/100
  ! mov eax,[p.p_x] ;x
  ! fbld tword [eax]
  ! faddp st1,st0   ;x+y/100
  ! fstp tword [eax]
  xiPower(@pw,ex,@pw);10^(ex+2)
  ! lea ebx,[esp+16];pw
  ! mov eax,[p.p_x] ;x
  ! fld tword [ebx]
  ! fld tword [eax]
  ! fmulp st1,st0   ;x=x*pw
  If s<0
    ! fchs
  EndIf
  ! mov eax,[p.p_x]
  ! fstp tword [eax]
  atof_end:
  ! mov eax,[p.p_x]
  ProcedureReturn
EndProcedure

Procedure.s xFtoA(*x.ext)
  
  temp.ext  ;esp
  y.ext     ;esp+12
  ex.l=10   ;esp+24
  t.l       ;esp+28
  v.l       ;esp+32
  s.l=xSign(*x);esp+36
  z.ext     ;esp+40
  w.ext     ;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,[esp]  ;temp
  ! lea edi,[esp+12] ;y
  ! lea edx,[esp+24] ;ex
;  ! finit
  ! fld tword [ebx]  ;x
  ! fabs             ;abs(x)
  ! lea esi,[esp+40] ;z
  ! fstp tword [esi] ;z=abs(x)
  ! fild dword [edx] ;load value 10 from ex
  ! fld st0          ;dup
  ! lea edx,[esp+52] ;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=nInt(@y);xFloor(@y)
  xiPower(@temp,17-ex,@temp)
  ! lea ebx,[esp+40] ;z
  ! lea ecx,[esp]  ;temp
  ! fld tword [ecx]  ;temp
  ! fld tword [ebx]  ;z
  ! fmulp st1,st0
  ! fstp tword [ecx] ;temp
  xTrunc(@temp,@w)
  ! lea edi,[esp+12] ;y
  ! lea edx,[esp+52] ;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,10,@temp)
    ex=ex-1
  EndIf
  xTrunc(@temp,@y)
  xSub(@temp,@y,@temp)
  xiMul(@temp,10,@temp)
  ! lea ecx,[esp]  ;temp
  ! lea edi,[esp+12] ;y
  ! lea edx,[esp+52] ;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

Procedure xSign(*x.ext)   ;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 xFloor(*x.ext)
  oldcw.l  ;esp+0
  newcw.l  ;esp+4
  ! mov ecx,[p.p_x]   ;x
  ! lea edx,[esp] ;oldcw
  ! lea edi,[esp+4] ;newcw
  ! fstcw word [edx] 
  ! mov ax,[edx] 
  ! Or ax,010000000000b
  ! mov [edi],ax
  ! fldcw word [edi] 
  ! fld tword [ecx] 
  ! frndint 
  ! fistp dword [edi] 
  ! mov eax,[edi]
  ! fldcw word [edx]
  ProcedureReturn
EndProcedure

Procedure xTrunc(*x.ext,*y.ext) ;y=trunc(x)
  oldcw.l  ;esp+0
  newcw.l  ;esp+4
  ! mov ecx,[p.p_x]   ;x
  ! lea edx,[esp] ;oldcw
  ! lea edi,[esp+4] ;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.l nInt(*x.ext)
  oldcw.l  ;esp+0
  newcw.l  ;esp+4
  ! mov ecx,[p.p_x]   ;x
  ! lea edx,[esp] ;oldcw
  ! lea edi,[esp+4] ;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 xSub(*x.ext,*y.ext,*z.ext);z=x-y
  ! finit
  ! 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 xiMul(*x.ext,z.l,*y.ext);y=x*z 
  ! finit
  ! 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 xiPower(*x.ext, e.l, *y.ext)
  ! 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)
  ProcedureReturn
EndProcedure

Posted: Sat Feb 11, 2006 10:57 am
by El_Choni
Your code outputs this here:

Code: Select all

should = 3.141592653589793238   3.141592653589793238e+0000
should = 3.141592653589793238   3.141592653589793238e+0000
                                                  ^^
press return to end
So, as I thought, the API doesn't change the FPU precision, because it can't be changed; internally, it's 80 bits. Or I'm missing something here?

Nice code snippet, BTW ;)

Posted: Sat Feb 11, 2006 11:13 am
by Psychophanta
El_Choni wrote:...all the FPU memory instructions can use dword, qword or tword
That's not true.
Take a look to ASM manual.
For example fadd instruction can't manage 80bit float addresses, and most of asm FPU commands niether.
D8 /0 FADD m32real Add m32real to ST(0) and store result in ST(0)
DC /0 FADD m64real Add m64real to ST(0) and store result in ST(0)

DA /0 FIADD m32int Add m32int to ST(0) and store result in ST(0)
DE /0 FIADD m16int Add m16int to ST(0) and store result in ST(0)

Posted: Sat Feb 11, 2006 11:27 am
by El_Choni
Psychophatnta: you're not supposed to look up the FPU manual. That's cheating, you know... :mrgreen:

(OTOH, it's still possible to operate with 80 bit variables in the FPU stack, just not in memory).

Posted: Sat Feb 11, 2006 11:34 am
by Psychophanta
El_Choni wrote:(OTOH, it's still possible to operate with 80 bit variables in the FPU stack, just not in memory).
I know, as real width of FPU registers are 80bit, but tell me how to do this:

Code: Select all

a.e=6.938827757238428549483e-9
b.e=0.57823984700423848847388532e-11
c.e=a.e+b.e
Would to truncate 64bit and ignore 8 of all the 80bit?
Else you must perform some operations which will make PB to be sloooow.

Posted: Sat Feb 11, 2006 12:36 pm
by jack
El_Choni wrote:Your code outputs this here:

Code: Select all

should = 3.141592653589793238   3.141592653589793238e+0000
should = 3.141592653589793238   3.141592653589793238e+0000
                                                  ^^
press return to end
El_Choni that's odd, because i get

Code: Select all

should = 3.141592653589793238   3.141592653589793238e+0000
should = 3.141592653589793238   3.141592653589793280e+0000
                                                  ^^
press return to end

Posted: Sat Feb 11, 2006 12:44 pm
by El_Choni
Odd indeed! :shock:

Posted: Sat Feb 11, 2006 12:59 pm
by jack
yes, i wonder what result others may have, btw that's why my code has all these "! finit", to ensure 80 bit.

Posted: Sat Feb 11, 2006 1:09 pm
by Dare2
jack, I get this:

Code: Select all

should = 3.141592653589793238   3.141592653589793238e+0000
should = 3.141592653589793238   3.141592653589793238e+0000
using debug (with print still used), and

Code: Select all

should = 3.141592653589793238   3.141592653589793238e+0000
should = 3.141592653589793238   3.141592653589793280e+0000

without debug. So without debug, same as you.
All times are UTC+01:00
Page 1 of 3

Powered by phpBB® Forum Software © phpBB Limited