瀏覽代碼

+ proper (i.e. not broken) implementation of arctan() for the 8087 and 80287

git-svn-id: trunk@26226 -
nickysn 11 年之前
父節點
當前提交
a7b4953795
共有 2 個文件被更改,包括 105 次插入7 次删除
  1. 9 0
      compiler/x86/nx86inl.pas
  2. 96 7
      rtl/i8086/math.inc

+ 9 - 0
compiler/x86/nx86inl.pas

@@ -103,6 +103,15 @@ implementation
 
 
      function tx86inlinenode.first_arctan_real : tnode;
      function tx86inlinenode.first_arctan_real : tnode;
       begin
       begin
+{$ifdef i8086}
+        { FPATAN's range is limited to (0 <= value < 1) on the 8087 and 80287,
+          so we need to use the RTL helper on these FPUs }
+        if current_settings.cputype < cpu_386 then
+          begin
+            result := inherited;
+            exit;
+          end;
+{$endif i8086}
         if (tfloatdef(pbestrealtype^).floattype=s80real) then
         if (tfloatdef(pbestrealtype^).floattype=s80real) then
           begin
           begin
             expectloc:=LOC_FPUREGISTER;
             expectloc:=LOC_FPUREGISTER;

+ 96 - 7
rtl/i8086/math.inc

@@ -75,13 +75,6 @@
       runerror(207);
       runerror(207);
       result:=0;
       result:=0;
     end;
     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}
     {$define FPC_SYSTEM_HAS_LN}
     function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
     function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
     begin
     begin
@@ -90,6 +83,102 @@
       result:=0;
       result:=0;
     end;
     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}
     {$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