|
@@ -75,13 +75,6 @@
|
|
|
runerror(207);
|
|
|
result:=0;
|
|
|
end;
|
|
|
- {$define FPC_SYSTEM_HAS_ARCTAN}
|
|
|
- function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;
|
|
|
- begin
|
|
|
- { Function is handled internal in the compiler }
|
|
|
- runerror(207);
|
|
|
- result:=0;
|
|
|
- end;
|
|
|
{$define FPC_SYSTEM_HAS_LN}
|
|
|
function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
|
|
|
begin
|
|
@@ -90,6 +83,102 @@
|
|
|
result:=0;
|
|
|
end;
|
|
|
|
|
|
+
|
|
|
+
|
|
|
+ const
|
|
|
+ { the exact binary representation of pi (as generated by the fldpi instruction),
|
|
|
+ and then divided by 2 and 4. I've tested the following FPUs and they produce
|
|
|
+ the exact same values:
|
|
|
+ i8087
|
|
|
+ Pentium III (Coppermine)
|
|
|
+ Athlon 64 (K8)
|
|
|
+ }
|
|
|
+ Extended_PIO2: array [0..4] of word=($C235,$2168,$DAA2,$C90F,$3FFF); { pi/2 }
|
|
|
+ Extended_PIO4: array [0..4] of word=($C235,$2168,$DAA2,$C90F,$3FFE); { pi/4 }
|
|
|
+
|
|
|
+ {$define FPC_SYSTEM_HAS_ARCTAN}
|
|
|
+ function fpc_arctan_real(d : ValReal) : ValReal;assembler;compilerproc;
|
|
|
+ var
|
|
|
+ sw: word;
|
|
|
+ asm
|
|
|
+ { the fpatan instruction on the 8087 and 80287 has the following restrictions:
|
|
|
+ 0 <= ST(1) < ST(0) < +inf
|
|
|
+ which makes it useful only for calculating arctan in the range:
|
|
|
+ 0 <= d < 1
|
|
|
+ so in order to cover the full range, we use the following properties of arctan:
|
|
|
+ arctan(1) = pi/4
|
|
|
+ arctan(-d) = -arctan(d)
|
|
|
+ arctan(d) = pi/2 - arctan(1/d), if d>0
|
|
|
+ }
|
|
|
+ fld tbyte [d]
|
|
|
+ ftst
|
|
|
+ fstsw sw
|
|
|
+ mov ah, [sw + 1]
|
|
|
+ sahf
|
|
|
+ jb @@negative
|
|
|
+
|
|
|
+ { d >= 0 }
|
|
|
+ fld1 // 1 d
|
|
|
+ fcom
|
|
|
+ fstsw sw
|
|
|
+ mov ah, [sw + 1]
|
|
|
+ sahf
|
|
|
+ jb @@greater_than_one
|
|
|
+ jz @@equal_to_one
|
|
|
+
|
|
|
+ { 0 <= d < 1 }
|
|
|
+ fpatan
|
|
|
+ jmp @@done
|
|
|
+
|
|
|
+@@greater_than_one:
|
|
|
+ { d > 1 }
|
|
|
+ fdivr st(1), st // 1 1/d
|
|
|
+ fpatan // arctan(1/d)
|
|
|
+ fld tbyte [Extended_PIO2] // pi/2 arctan(1/d)
|
|
|
+ fsubrp st(1), st // pi/2-arctan(1/d)
|
|
|
+ jmp @@done
|
|
|
+
|
|
|
+@@equal_to_one:
|
|
|
+ { d = 1, return pi/4 }
|
|
|
+ fstp st
|
|
|
+ fstp st
|
|
|
+ fld tbyte [Extended_PIO4]
|
|
|
+ jmp @@done
|
|
|
+
|
|
|
+@@negative:
|
|
|
+ { d < 0; -d > 0 }
|
|
|
+ fchs // -d
|
|
|
+ fld1 // 1 -d
|
|
|
+ fcom
|
|
|
+ fstsw sw
|
|
|
+ mov ah, [sw + 1]
|
|
|
+ sahf
|
|
|
+ jb @@less_than_minus_one
|
|
|
+ jz @@equal_to_minus_one
|
|
|
+
|
|
|
+ { -1 < d < 0; 0 < -d < 1 }
|
|
|
+ fpatan // arctan(-d)
|
|
|
+ fchs // -arctan(-d)
|
|
|
+ jmp @@done
|
|
|
+
|
|
|
+@@equal_to_minus_one:
|
|
|
+ { d = -1, return -pi/4 }
|
|
|
+ fstp st
|
|
|
+ fstp st
|
|
|
+ fld tbyte [Extended_PIO4]
|
|
|
+ fchs
|
|
|
+ jmp @@done
|
|
|
+
|
|
|
+@@less_than_minus_one:
|
|
|
+ { d < -1; -d > 1 }
|
|
|
+ fdivr st(1), st // 1 -1/d
|
|
|
+ fpatan // arctan(-1/d)
|
|
|
+ fld tbyte [Extended_PIO2] // pi/2 arctan(-1/d)
|
|
|
+ fsubp st(1), st // arctan(-1/d)-pi/2
|
|
|
+
|
|
|
+@@done:
|
|
|
+ end;
|
|
|
+
|
|
|
{$define FPC_SYSTEM_HAS_EXP}
|
|
|
function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
|
|
|
var
|