J ai trouve sur le forum anglais une series de procedure pr travailler avec les nombres a virgules flottantes 80 bits.
Je les ai integre ds mon test :
Code : Tout sélectionner
Structure lf ; Nouveau type LongFloat (80 bits)
StructureUnion
fword.w[5]
tbyte.b[10]
EndStructureUnion
EndStructure
;
;Declare lf procedures
Declare lfacos(*x.lf,*y.lf); x=acos(y)
Declare lfadd(*x.lf,*y.lf,*z.lf); x=y+z
Declare lfantilog(*x.lf,*y.lf); x=10^y
Declare lfasin(*x.lf,*y.lf); x=asin(y)
Declare lfatan(*x.lf,*y.lf); x=atan(y)
Declare LFLD(*x.lf,a$); string to lf
Declare lfcopy(*x.lf,*y.lf); x=y
Declare.l lfcomp(*x.lf,*y.lf); compare x and y
Declare lfcos(*x.lf,*y.lf); x=cos(y)
Declare lfdiv(*x.lf,*y.lf,*z.lf); x=y/z
Declare lfrecip(*x.lf,*y.lf); x=1/y
Declare lfexp(*x.lf,*y.lf); x=e^y
Declare lffrac(*x.lf,*y.lf); x=frac(y)
Declare.s StrLF(*x.lf,format.l); lf to string
Declare lfint(*x.lf,*y.lf); x=int(y)
Declare lfln(*x.lf,*y.lf); x=ln(y)
Declare lflog10(*x.lf,*y.lf); x=log10(y)
Declare lfmul(*x.lf,*y.lf,*z.lf); x=y*z
Declare lfpi(*x.lf); x=Pi
Declare lfpower(*x.lf,e.w); x=x^(y.w)
Declare lfsin(*x.lf,*y.lf); x=sin(y)
Declare lfsqrt(*x.lf,*y.lf); x=sqrt(y)
Declare lfsub(*x.lf,*y.lf,*z.lf); x=y-z
Declare lftan(*x.lf,*y.lf); x=tan(y)
Declare lfxtoy(*x.lf,*y.lf,*z.lf);x=y^z
;
;Define lf constants
Global lften.lf;used by 10^x
Global lfe.lf;used by e^x
LFLD(@lften,"10")
LFLD(@lfe,"2.71828182845904523")
;
;
;*****************************
;- Boucle Test
;*****************************
Global f.lf,v.lf
Time1.l = GetTickCount_()
FINIT
LFLD(@f,"1")
LFLD(@v,"1.00003")
MOV ebx,v
! fld tword [ebx]
FST st1
MOV ebx,f
! fld tword [ebx]
For t.l =1 To 100000000
FMUL st0,st1
Next
MOV ebx,f
! fstp tword [ebx]
Time2.l = GetTickCount_()
If OpenWindow(1,200,200,400,60,#PB_Window_SystemMenu,"Programme de test")
Repeat
Repeat
EventID.l = WaitWindowEvent()
Until EventID <> 0
If EventID = #PB_EventRepaint
StartDrawing(WindowOutput())
BackColor(50,100,50)
Box(0,0,WindowWidth(),WindowHeight(),RGB(50,100,50))
FrontColor(250,250,250)
Locate(20,10):DrawText("Durée (en ms) :")
Locate(150,10):DrawText(Str(Time2-Time1))
Locate(20,30):DrawText("Résultat :")
Locate(150,30):DrawText(StrLF(@f,19))
StopDrawing()
EndIf
Until EventID = #PB_EventCloseWindow
EndIf
;*****************************
;lf procedures in alphabetical order
Procedure lfacos(*x.lf,*y.lf);x=acos(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
FLD1
! FLD st1
! FMUL st0,st0
! FSUBP st1,st0
FSQRT
FXCH
FPATAN
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfadd(*x.lf,*y.lf,*z.lf);x=y+z
FINIT
MOV ebx,*z
! fld tword [ebx]
FST st1
MOV ebx,*y
! fld tword [ebx]
FADD st0,st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfantilog(*x.lf,*y.lf);x=10^y
lfxtoy(*x,@lften,*y)
EndProcedure
;
Procedure lfasin(*x.lf,*y.lf);x=asin(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
FLD1
FLD st1
FMUL st0,st0
! FSUBP st1,st0
FSQRT
FPATAN
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfatan(*x.lf,*y.lf);x=atan(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
FLD1
FPATAN ;
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure LFLD(*x.lf,afloat$);string to lf var x
;afloat should be string representation of valid number
tenx.lf
tenxptr=@tenx
ten.l=10
tenptr=@ten
f1$=UCase(afloat$)
f$=""
;
;remove invalid chars
For i=1 To Len(f1$)
a=Asc(Mid(f1$,i,1))
If (a>47 And a<58) Or a=69 Or a=46 Or a=45
f$=f$+Chr(a)
EndIf
Next i
;
;separate mantissa and exponent
p=FindString(f$,"E",1)
If p>0
e$=Right(f$,Len(f$)-p)
f$=Trim(Left(f$,p-1))
Else
e$="0"
f$=Trim(f$)
EndIf
;
;remove sign of mantissa
If Left(f$,1)="+"
f$=Right(f$,Len(f$)-1)
s=0
ElseIf Left(f$,1)="-"
f$=Right(f$,Len(f$)-1)
s=-1
EndIf
;
;add decimal point to mantissa if missing
p=FindString(f$,".",1)
If p=0: f$=f$+".0": EndIf
;
;remove leading zeros before mantissa decimal point
i=0
Repeat: i=i+1: Until Mid(f$,i,1)<>"0"
f$=Right(f$,Len(f$)-i+1)
;
;if mantissa <0 remove leading zeros after decimal point
ex.w=0
If Left(f$,1)="."
i=1
Repeat: i=i+1: Until Mid(f$,i,1)<>"0" Or i>Len(f$)
f$=Right(f$,Len(f$)-i+1)
ex.w=2-i
EndIf
;
;create 18 decimal digit mantissa and exponent word
p=FindString(f$,".",1)
a$=Left(f$,p-1)
b$=Right(f$,Len(f$)-p)
ex=ex+Len(a$)+Val(e$);exponent
f1$=a$+b$
While Len(f1$)<18: f1$=f1$+"0": Wend
If Len(f1$)>18
l.w=Len(a$)
f1$=Left(f1$,18)
EndIf
;example of variables so far:
;if string was "-.00000000001234e-33"
;then f1 would now hold; "123400000000000000", s=-1 (sign)
;ex now holds -43 ie exponent as in 0.1234e-43
;
;we now convert f1$ to a packed BCD number and store
;it in *x, then divide *x by 10^(18-ex).
*x\tbyte[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\tbyte[j]=c
j=j-1
Wend
;now divide number by 10^x to get proper float
ex=18-ex
FINIT
MOV ebx,tenptr;load 10 into ebx
! fild word [ebx];load int at *ebx and convert to float in st0
MOV ebx,tenxptr;load address of tenx into ebx
! fstp tword [ebx];store float 10 into tenx
lfpower(@tenx,ex);raise tenx to ex power
FINIT
MOV ebx,tenxptr
! fld tword [ebx];load tenx^ex into st0
FST st1;store into st1
MOV ebx,*x
! fbld tword [ebx];
;fbld converts the packed BCD integer into double extended precision
;floating point format and pushes this value onto the FPU stack
FDIV st0,st1 ;the number is divided by tenx^ex
If s=-1 ;if number sign was '-' then change the sign in float
FCHS
EndIf
MOV ebx,*x
! fstp tword [ebx] ;put float into *x
EndProcedure
;
Procedure.l lfcomp(*x.lf,*y.lf);compare x and y
;returns 1 if x>y 0 if x=y -1 if x<y
ccode.l
ccodeptr=@ccode
FINIT
MOV ebx,*y
! fld tword [ebx]
FST st1
MOV ebx,*x
! fld tword [ebx]
FCOM st1
FSTSW [eax]
MOV eax,ccodeptr
ccode=ccode & $4500
If ccode=$4000
ProcedureReturn 0
ElseIf ccode=$100
ProcedureReturn -1
Else;ccode=0
ProcedureReturn 1
EndIf
EndProcedure
;
Procedure lfcopy(*x.lf,*y.lf);x=y
*x\fword[4]=*y\fword[4]
*x\fword[3]=*y\fword[3]
*x\fword[2]=*y\fword[2]
*x\fword[1]=*y\fword[1]
*x\fword[0]=*y\fword[0]
EndProcedure
;
Procedure lfcos(*x.lf,*y.lf);x=cos(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
! fcos
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfdiv(*x.lf,*y.lf,*z.lf);x=y/z
FINIT
MOV ebx,*z
! fld tword [ebx]
FST st1
MOV ebx,*y
! fld tword [ebx]
FDIV st0,st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfexp(*x.lf,*y.lf);x=e^y
lfxtoy(*x,@lfe,*y)
EndProcedure
;
Procedure lffrac(*x.lf,*y.lf) ;x=frac(y)
MaskedCW.l
mcw.l=@MaskedCW.l
SaveCW.l
scw.l=@SaveCW.l
FINIT
MOV ebx,mcw
! fstcw [ebx]
SaveCW=MaskedCW
MaskedCW=MaskedCW|%110000000000
MOV ebx,mcw
! FLDCW [ebx]
MOV ebx,*y
! fld tword [ebx]
FRNDINT
MOV ebx,*y
! fld tword [ebx]
FSUB st0,st1
MOV ebx,*x
! fstp tword [ebx]
MOV ebx,scw
! fldcw [ebx]
EndProcedure
;
Procedure.s StrLF(*x.lf,format.l)
;convert lf float to string
;
;FORMAT OPTIONS
;format=0 original tejon format
;format=19 fixed length scientific format
;format=1 to 18 output rounded to give 1 to 18 sig figs
;format=-1 to -40 output rounded to give 1 to 40 decimal places
;
xtem.lf
lfcopy(@xtem,*x);save *x because bcd pack uses it
z.w=*x\fword[4]
zz.w=*x\fword[3]
If (format<-40) Or (format>19):format=19:EndIf
If (z=0) And (zz=0)
If format=0
f$="0.00000000000000000"
ElseIf format=19
f$="+0.00000000000000000e+0000"
ElseIf format>0
f$="0"
Else
f$=LSet("0.",2-format,"0")
EndIf
ProcedureReturn f$
EndIf
bex.w=(*x\fword[4]&%111111111111111)-$3ffe
s.w=*x\fword[4]>>15
ex.w=Int(0.30103*bex);initial guess at decimal exponent
exp=@bex
ex1.w=17-ex
tenx.lf
tenxptr=@tenx
t.l=10
tptr=@t
FINIT
MOV ebx,tptr ;load 10 into ebx
! fild word [ebx] ;load integer 10, convert to float in st0
MOV ebx,tenxptr ;load address of tenx into ebx
! fstp tword [ebx] ;store float 10 into tenx
lfpower(@tenx,ex1) ;raise tenx to ex power
FINIT
MOV ebx,tenxptr
! fld tword [ebx] ;load tenx^ex into st0
FST st1 ;store into st1
MOV ebx,*x
! fld tword [ebx];
FMUL st0,st1 ;the number is multiplied by tenx^ex
FST st1
! fbstp [ebx] ;BCD pack float into *x
;multiply *x by 10 if most sig BCD digit is zero
;this happens when next BCD digit is 8 or 9
If (*x\tbyte[8]&$ff)<10
FST st1
MOV ebx,tptr ;load 10 into ebx
! fild word [ebx] ;load integer 10, convert to float in st0
FMUL st0,st1
ex=ex-1
EndIf
If s=-1 ;if number -ve then change the sign in float
; FCHS ; not needed
EndIf
MOV ebx,*x
! fbstp tword [ebx] ;BCD pack float into *x
c.w=*x\tbyte[8]&$ff
h.w=c>>4
l.w=c-h<<4
If l>10;FBSTP value for FPU exception
f$="INVALID"
If format=19:f$=f$+Space(19)+"":EndIf
ProcedureReturn f$
EndIf
i=8
While i>=0;load 18 digit mantissa to f$
c.w=*x\tbyte[i] & $ff
h.w=c>>4
l.w=c-h<<4
f$=f$+Chr(h+48)+Chr(l+48)
i=i-1
Wend
;
;create output string using 18 digits in f$, s and ex
If format=0;tejon format
f$=Left(f$,1)+"."+Right(f$,Len(f$)-1)
If Abs(ex)>0: f$=f$+"e"+Str(ex): EndIf
If s=-1: f$="-"+f$:EndIf
ElseIf format=19;fixed length scientific format
f$=Left(f$,1)+"."+Right(f$,Len(f$)-1)
If ex<0
a$="e-"+ RSet(Str(-ex),4,"0")
Else
a$="e+"+ RSet(Str(ex),4,"0")
EndIf
f$=f$+a$
If s=-1
f$="-"+f$
Else
f$="+"+f$
EndIf
ElseIf format<0;fixed decimal digit format
d=ex+1-format;number of digits of f$ that will be used
If d<=0
f$=""
ElseIf d<18;need to round number to digits needed
a$=Left(f$,d);create integer string
a$=a$+"."+Mid(f$,d+1,1);add digit to be rounded
tem.lf
tem2.lf
LFLD(@tem,a$)
LFLD(@tem2,"0.5")
lfadd(@tem,@tem,@tem2);add 0.5
lfint(@tem2,@tem);and take int, ie round
b$=StrLF(@tem2,19);re-entrant call to this procedure
; this is OK because format 19 won't re-enter again
If Mid(b$,2,1)="1" And Left(a$,1)="9"
d=d+1;one more digit eg 9.999 rounded to 10.000
EndIf
f$=Mid(b$,2,1)+Mid(b$,4,d-1);rounded digits
Else;d>=18 so need to add extra digits
f$=LSet(f$,d,"0")
EndIf
If d<=-format;no digits before decimal
f$=RSet(f$,-format,"0");add leading zeros after decimal
f$="0."+ f$
Else;digits before decimal
f$=Left(f$,d+format)+"."+Right(f$,-format)
EndIf
If s=-1: f$="-"+f$:EndIf
ElseIf format>0;significant figures format
If format<18;need to round to digits needed
a$=Left(f$,format);create integer string
a$=a$+"."+Mid(f$,format+1,1);add digit to be rounded
tem.lf
tem2.lf
LFLD(@tem,a$)
LFLD(@tem2,"0.5")
lfadd(@tem,@tem,@tem2);add 0.5
lfint(@tem2,@tem);and take int, ie round
b$=StrLF(@tem2,19);re-entrant call to this procedure
; this is OK because format 19 won't re-enter again
If Mid(b$,2,1)="1" And Left(a$,1)="9"
ex=ex+1;one more digit eg 9.999 rounded to 10.000
EndIf
f$=Mid(b$,2,1)+Mid(b$,4,format-1);rounded digits
EndIf
If ex>8 Or ex<-3
f$=Left(f$,1)+"."+Right(f$,Len(f$)-1)
f$=f$+"e"+Str(ex)
ElseIf ex<0
f$="0."+RSet(f$,Len(f$)-1-ex,"0")
Else;ie ex 0 to 8
a$=f$+"00000000"
a$=Left(a$,ex+1)
If format>(ex+1)
a$=a$+"."+Mid(f$,ex+2,format-ex-1)
EndIf
f$=a$
EndIf
EndIf
lfcopy(*x,@xtem);restore *x after use by bcd pack
ProcedureReturn f$
EndProcedure
;
Procedure lfint(*x.lf,*y.lf) ;x=int(y)
MaskedCW.l
mcw.l=@MaskedCW.l
SaveCW.l
scw.l=@SaveCW.l
FINIT
MOV ebx,mcw
! fstcw [ebx]
SaveCW=MaskedCW
MaskedCW=MaskedCW|%010000000000;round toward -inf
MOV ebx,mcw
! FLDCW [ebx]
MOV ebx,*y
! fld tword [ebx]
FRNDINT
MOV ebx,*x
! fstp tword [ebx]
MOV ebx,scw
! fldcw [ebx]
EndProcedure
;
Procedure lfln(*x.lf,*y.lf);x=ln(y)
FINIT
! fldln2 ;load loge(2)
FST st1
MOV ebx,*y
! FLD tword [ebx]
! FYL2X ;st1*log2(x)
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lflog10(*x.lf,*y.lf);x=log10(y)
FINIT
! fldlg2 ;load Log10(2)
FST st1
MOV ebx,*y
! FLD tword [ebx]
! fyl2x ; st1*log2(x)
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfmul(*x.lf,*y.lf,*z.lf);x=y*z
FINIT
MOV ebx,*z
! fld tword [ebx]
FST st1
MOV ebx,*y
! fld tword [ebx]
FMUL st0,st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfpi(*x.lf);x=Pi
! fldpi;
MOV ebx,*x
! fstp tword [ebx];
EndProcedure
;
Procedure lfpower(*x.lf,e.w);x=x^e.w ie integer power
;this proc is only used by LFLD() and StrLF()
;x must be an address of a lf variable
e1.w=Abs(e)
;take x To an integer power
FINIT
FLD1 ; z:=1.0
FST st1
MOV ebx,*x
! fld tword [ebx];load st0 with x
While e1>0
While (e1&1)=0;while e is even
e1=e1 >> 1;e1=e1/2
FMUL st0,st0;x=x*x
Wend
e1=e1-1
FMUL st1,st0;z=z*x ;st1=st1*st0
Wend
FXCH st1;exchange st0 and st1
If e<0;if power is negative, take reciprocal
FLD1
FDIV st0,st1
EndIf
MOV ebx,*x
! fstp tword [ebx];store z (st0) into x
EndProcedure
;
Procedure lfrecip(*x.lf,*y.lf);x=1/y
FINIT
MOV ebx,*y
! fld tword [ebx]
FST st1
FLD1
FDIV st0,st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfsin(*x.lf,*y.lf);x=sin(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
FSIN
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfsqrt(*x.lf,*y.lf);x=sqrt(y)
FINIT
MOV ebx,*y
! FLD tword [ebx]
FSQRT
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfsub(*x.lf,*y.lf,*z.lf);x=y-z
FINIT
MOV ebx,*z
! fld tword [ebx]
FST st1
MOV ebx,*y
! fld tword [ebx]
FSUB st0,st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lftan(*x.lf,*y.lf);x=tan(y)
FINIT
MOV ebx,*y
! fld tword [ebx]
! fptan
FXCH st1
MOV ebx,*x
! fstp tword [ebx]
EndProcedure
;
Procedure lfxtoy(*x.lf,*y.lf,*z.lf);x=y^z
FINIT
MOV ebx,*z
! fld tword [ebx]
MOV ebx,*y
! fld tword [ebx]
FYL2X
FLD st0
FRNDINT
FSUB st1, st0
FLD1
FSCALE
FXCH
FXCH st2
F2XM1
FLD1
!FADDP st1, st0
!FMULP st1, st0
MOV ebx,*x
! fstp tword [ebx]
EndProcedure DUREE : 265 ms
Maintenant en Delphi :
Code : Tout sélectionner
procedure TForm1.OnPaint(Sender: TObject);
var
f: Extended;
t: Integer;
Time1: Integer;
begin
Time1 := GetTickCount();
f := 1;
for t:= 1 to 100000000 do
f := f * 1.00003;
Canvas.TextOut(0,0,IntToStr(GetTickCount()-Time1));
Canvas.TextOut(0,20,FloatToStr(f));
end;
DUREE : 1313 ms
CONCLUSION : Maintenant on peu faire de Grand Calcul Scientifique
avec PureBasic.Et comme on est oblige d utiliser l ASM on est plus performant que les autres...
