paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 09:06:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 8087/80287 fixes in fpc_exp_real

Browse Source 
git-svn-id: trunk@26203 -
This commit is contained in:
nickysn 2013-12-10 00:02:20 +00:00
parent 67c21b3a5e
commit 775619ef8b
1 changed files with 36 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
rtl/i8086/math.inc
View File

@ -93,28 +93,45 @@
{$define FPC_SYSTEM_HAS_EXP} {$define FPC_SYSTEM_HAS_EXP}
function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc; function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
var var
cw1,cw2: word; sw1: word;
asm asm
// comes from DJ GPP // comes from DJ GPP
fld tbyte[d] { fixed for 8087 and 80287 by nickysn
fldl2e notable differences between 8087/80287 and 80387:
fmulp st(1), st f2xm1 on 8087/80287 requires that 0<=st(0)<=0.5
fstcw CW1 f2xm1 on 80387+ requires that -1<=st(0)<=1
fstcw CW2 fscale on 8087/80287 requires that -2**15<=st(1)<=0 or 1<=st(1)<2**15
fscale on 80387+ has no restrictions
}
fld tbyte[d] // d
fldl2e // l2e d
fmulp st(1), st // l2e*d
fld st(0) // l2e*d l2e*d
frndint // round(l2e*d) l2e*d
fxch st(1) // l2e*d round(l2e*d)
fsub st, st(1) // l2e*d-round(l2e*d) round(l2e*d)
ftst // l2e*d-round(l2e*d)<0?
fstsw sw1
fwait fwait
and CW2, $f3ff mov ah, [sw1 + 1]
or CW2, $0400 sahf
fldcw CW2 jb @@negative
fld st(0)
frndint f2xm1 // 2**(l2e*d-round(l2e*d))-1 round(l2e*d)
fldcw CW1 fld1 // 1 2**(l2e*d-round(l2e*d))-1 round(l2e*d)
fxch st(1) faddp st(1), st // 2**(l2e*d-round(l2e*d)) round(l2e*d)
fsub st, st(1) jmp @@common
f2xm1
fld1 @@negative:
faddp st(1), st fchs // -l2e*d+round(l2e*d) round(l2e*d)
fscale f2xm1 // 2**(-l2e*d+round(l2e*d))-1 round(l2e*d)
fstp st(1) fld1 // 1 2**(-l2e*d+round(l2e*d))-1 round(l2e*d)
fadd st(1), st // 1 2**(-l2e*d+round(l2e*d)) round(l2e*d)
fdivrp st(1), st // 2**(l2e*d-round(l2e*d)) round(l2e*d)
@@common:
fscale // (2**(l2e*d-round(l2e*d)))*(2**round(l2e*d)) round(l2e*d)
fstp st(1) // (2**(l2e*d-round(l2e*d)))*(2**round(l2e*d))
end; end;
{$define FPC_SYSTEM_HAS_FRAC} {$define FPC_SYSTEM_HAS_FRAC}