瀏覽代碼

* sqr(real) and sqrt(real): remove typeconv node inserted by initial call processing (see explanation in comments), allowing these functions to be evaluated using precision of argument. In particular, sqrt(single) and sqrt(double) now emit 'sqrtss' and 'sqrtsd' instructions on x86 targets with -Cfsse3. Non-x86 targets already have the necessary support in code generators.
* abs(real): handle the same way as sqrt and sqr, i.e. without casting to bestreal and back.

git-svn-id: trunk@27808 -

sergei 11 年之前
父節點
當前提交
fc5f45f65c
共有 2 個文件被更改,包括 28 次插入2 次删除
  1. 21 2
      compiler/ninl.pas
  2. 7 0
      rtl/i386/math.inc

+ 21 - 2
compiler/ninl.pas

@@ -2469,8 +2469,27 @@ implementation
     function tinlinenode.pass_typecheck:tnode;
     function tinlinenode.pass_typecheck:tnode;
 
 
       procedure setfloatresultdef;
       procedure setfloatresultdef;
+        var
+          hnode: tnode;
         begin
         begin
-          if (left.resultdef.typ=floatdef) and
+          { System unit declares internal functions like this:
+              function foo(x: valreal): valreal; [internproc: number];
+            Calls to such functions are initially processed by callnode,
+            which typechecks the arguments, possibly inserting conversion to valreal.
+            To handle smaller types without excess precision, we need to remove
+            these extra typecasts. }
+          if (left.nodetype=typeconvn) and
+            (ttypeconvnode(left).left.resultdef.typ=floatdef) and
+            (left.flags*[nf_explicit,nf_internal]=[]) and
+            (tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
+            begin
+              hnode:=ttypeconvnode(left).left;
+              ttypeconvnode(left).left:=nil;
+              left.free;
+              left:=hnode;
+              resultdef:=left.resultdef;
+            end
+          else if (left.resultdef.typ=floatdef) and
             (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
             (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
             resultdef:=left.resultdef
             resultdef:=left.resultdef
           else
           else
@@ -3093,7 +3112,6 @@ implementation
               in_cos_real,
               in_cos_real,
               in_sin_real,
               in_sin_real,
               in_arctan_real,
               in_arctan_real,
-              in_abs_real,
               in_ln_real :
               in_ln_real :
                 begin
                 begin
                   set_varstate(left,vs_read,[vsf_must_be_valid]);
                   set_varstate(left,vs_read,[vsf_must_be_valid]);
@@ -3137,6 +3155,7 @@ implementation
                   resultdef:=s32inttype;
                   resultdef:=s32inttype;
                 end;
                 end;
 
 
+              in_abs_real,
               in_sqr_real,
               in_sqr_real,
               in_sqrt_real :
               in_sqrt_real :
                 begin
                 begin

+ 7 - 0
rtl/i386/math.inc

@@ -41,6 +41,13 @@
                             FPU Control word
                             FPU Control word
  ****************************************************************************}
  ****************************************************************************}
 
 
+{$push}
+{$codealign constmin=16}
+const
+  FPC_ABSMASK_SINGLE: array[0..1] of qword=($7fffffff7fffffff,$7fffffff7fffffff); cvar; public;
+  FPC_ABSMASK_DOUBLE: array[0..1] of qword=($7fffffffffffffff,$7fffffffffffffff); cvar; public;
+{$pop}
+
     procedure Set8087CW(cw:word);
     procedure Set8087CW(cw:word);
       begin
       begin
         { pic-safe ; cw will not be a regvar because it's accessed from }
         { pic-safe ; cw will not be a regvar because it's accessed from }