Browse Source

* compiler handled round/trunc for x86

git-svn-id: trunk@6827 -
florian 18 years ago
parent
commit
1cd41b68f7
4 changed files with 141 additions and 26 deletions
  1. 15 0
      compiler/ncginl.pas
  2. 9 5
      compiler/ninl.pas
  3. 101 1
      compiler/x86/nx86inl.pas
  4. 16 20
      rtl/i386/math.inc

+ 15 - 0
compiler/ncginl.pas

@@ -51,6 +51,8 @@ interface
           procedure second_get_caller_frame;virtual;
           procedure second_get_caller_frame;virtual;
           procedure second_get_caller_addr;virtual;
           procedure second_get_caller_addr;virtual;
           procedure second_prefetch; virtual;
           procedure second_prefetch; virtual;
+          procedure second_round_real; virtual;
+          procedure second_trunc_real; virtual;
        end;
        end;
 
 
 implementation
 implementation
@@ -107,6 +109,10 @@ implementation
               second_arctan_real;
               second_arctan_real;
             in_abs_real:
             in_abs_real:
               second_abs_real;
               second_abs_real;
+            in_round_real:
+              second_round_real;
+            in_trunc_real:
+              second_trunc_real;
             in_sqr_real:
             in_sqr_real:
               second_sqr_real;
               second_sqr_real;
             in_sqrt_real:
             in_sqrt_real:
@@ -649,6 +655,15 @@ implementation
         internalerror(20020718);
         internalerror(20020718);
       end;
       end;
 
 
+    procedure tcginlinenode.second_round_real;
+      begin
+        internalerror(20020718);
+      end;
+
+    procedure tcginlinenode.second_trunc_real;
+      begin
+        internalerror(20020718);
+      end;
 
 
     procedure tcginlinenode.second_sqr_real;
     procedure tcginlinenode.second_sqr_real;
       begin
       begin

+ 9 - 5
compiler/ninl.pas

@@ -409,7 +409,7 @@ implementation
                 if Tfloatdef(para.left.resultdef).floattype=s64currency then
                 if Tfloatdef(para.left.resultdef).floattype=s64currency then
                   name := procprefixes[do_read]+'currency'
                   name := procprefixes[do_read]+'currency'
                 else
                 else
-                  begin 
+                  begin
                     name := procprefixes[do_read]+'float';
                     name := procprefixes[do_read]+'float';
                     readfunctype:=pbestrealtype^;
                     readfunctype:=pbestrealtype^;
                   end;
                   end;
@@ -582,7 +582,7 @@ implementation
                               s32inttype,true),nil);
                               s32inttype,true),nil);
                         end;
                         end;
                     end;
                     end;
-                  if para.left.resultdef.typ=enumdef then 
+                  if para.left.resultdef.typ=enumdef then
                     begin
                     begin
                       {To write(ln) an enum we need a some extra parameters.}
                       {To write(ln) an enum we need a some extra parameters.}
                       {Insert a reference to the ord2string index.}
                       {Insert a reference to the ord2string index.}
@@ -605,7 +605,7 @@ implementation
               else
               else
                 begin
                 begin
                   {To read(ln) an enum we need a an extra parameter.}
                   {To read(ln) an enum we need a an extra parameter.}
-                  if para.left.resultdef.typ=enumdef then 
+                  if para.left.resultdef.typ=enumdef then
                     begin
                     begin
                       {Insert a reference to the string2ord index.}
                       {Insert a reference to the string2ord index.}
                       indexpara:=Ccallparanode.create(Caddrnode.create_internal(
                       indexpara:=Ccallparanode.create(Caddrnode.create_internal(
@@ -622,7 +622,7 @@ implementation
                   if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then
                   if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then
                     special_handling:=true;
                     special_handling:=true;
                 end;
                 end;
-              if special_handling then 
+              if special_handling then
                 begin
                 begin
                   { create the parameter list: the temp ... }
                   { create the parameter list: the temp ... }
                   temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false);
                   temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false);
@@ -1175,7 +1175,7 @@ implementation
           Use a trick to prevent a type size mismatch warning to be generated by the
           Use a trick to prevent a type size mismatch warning to be generated by the
           assignment node. First convert implicitly to the resultdef. This will insert
           assignment node. First convert implicitly to the resultdef. This will insert
           the range check. The Second conversion is done explicitly to hide the implicit conversion
           the range check. The Second conversion is done explicitly to hide the implicit conversion
-          for the assignment node and therefor preventing the warning (PFV) 
+          for the assignment node and therefor preventing the warning (PFV)
 
 
           The implicit conversion is avoided for enums because implicit conversion between
           The implicit conversion is avoided for enums because implicit conversion between
           longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
           longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
@@ -2116,7 +2116,9 @@ implementation
                   else
                   else
                     begin
                     begin
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
+                      { for direct rounding, no best real type cast should be necessary
                       inserttypeconv(left,pbestrealtype^);
                       inserttypeconv(left,pbestrealtype^);
+                      }
                       resultdef:=s64inttype;
                       resultdef:=s64inttype;
                     end;
                     end;
                 end;
                 end;
@@ -2137,7 +2139,9 @@ implementation
                   else
                   else
                     begin
                     begin
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
+                      { for direct rounding, no best real type cast should be necessary
                       inserttypeconv(left,pbestrealtype^);
                       inserttypeconv(left,pbestrealtype^);
+                      }
                       resultdef:=s64inttype;
                       resultdef:=s64inttype;
                     end;
                     end;
                 end;
                 end;

+ 101 - 1
compiler/x86/nx86inl.pas

@@ -42,16 +42,20 @@ interface
           function first_ln_real: tnode; override;
           function first_ln_real: tnode; override;
           function first_cos_real: tnode; override;
           function first_cos_real: tnode; override;
           function first_sin_real: tnode; override;
           function first_sin_real: tnode; override;
+          function first_round_real: tnode; override;
+          function first_trunc_real: tnode; override;
           { second pass override to generate these nodes }
           { second pass override to generate these nodes }
           procedure second_IncludeExclude;override;
           procedure second_IncludeExclude;override;
           procedure second_pi; override;
           procedure second_pi; override;
           procedure second_arctan_real; override;
           procedure second_arctan_real; override;
           procedure second_abs_real; override;
           procedure second_abs_real; override;
+          procedure second_round_real; override;
           procedure second_sqr_real; override;
           procedure second_sqr_real; override;
           procedure second_sqrt_real; override;
           procedure second_sqrt_real; override;
           procedure second_ln_real; override;
           procedure second_ln_real; override;
           procedure second_cos_real; override;
           procedure second_cos_real; override;
           procedure second_sin_real; override;
           procedure second_sin_real; override;
+          procedure second_trunc_real; override;
 
 
           procedure second_prefetch;override;
           procedure second_prefetch;override;
        private
        private
@@ -62,7 +66,7 @@ implementation
 
 
     uses
     uses
       systems,
       systems,
-      globals,
+      globtype,globals,
       cutils,verbose,
       cutils,verbose,
       symconst,
       symconst,
       defutil,
       defutil,
@@ -71,6 +75,7 @@ implementation
       cgbase,pass_2,
       cgbase,pass_2,
       cpuinfo,cpubase,paramgr,
       cpuinfo,cpubase,paramgr,
       nbas,ncon,ncal,ncnv,nld,ncgutil,
       nbas,ncon,ncal,ncnv,nld,ncgutil,
+      tgobj,
       cga,cgutils,cgx86,cgobj;
       cga,cgutils,cgx86,cgobj;
 
 
 
 
@@ -172,6 +177,35 @@ implementation
       end;
       end;
 
 
 
 
+     function tx86inlinenode.first_round_real : tnode;
+      begin
+        expectloc:=LOC_FPUREGISTER;
+        registersint:=left.registersint;
+        registersfpu:=max(left.registersfpu,1);
+{$ifdef SUPPORT_MMX}
+        registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+        result:=nil;
+      end;
+
+
+     function tx86inlinenode.first_trunc_real: tnode;
+       begin
+         if cs_opt_size in current_settings.optimizerswitches then
+           result:=inherited
+         else
+           begin
+             expectloc:=LOC_FPUREGISTER;
+             registersint:=left.registersint;
+             registersfpu:=max(left.registersfpu,1);
+{$ifdef SUPPORT_MMX}
+             registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+             result:=nil;
+           end;
+       end;
+
+
      procedure tx86inlinenode.second_Pi;
      procedure tx86inlinenode.second_Pi;
        begin
        begin
          location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
          location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
@@ -246,6 +280,71 @@ implementation
        end;
        end;
 
 
 
 
+     procedure tx86inlinenode.second_round_real;
+       var
+         href : treference;
+       begin
+       {
+         if use_sse(left.resultdef) then
+           begin
+             secondpass(left);
+             location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
+             location.loc:=LOC_REFERENCE;
+             current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg_const(A_PSHUFD,S_XMM,location.left.register,location.left.register))
+             current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg_const(A_PSHUFD,S_XMM,location.left.register,location.left.register))
+
+             tg.GetTempTyped(current_asmdata.CurrAsmList,left.resultdef,tt_normal,location.reference);
+           end
+         else
+       }
+          begin
+             load_fpu_location;
+             location.loc:=LOC_REFERENCE;
+             tg.GetTempTyped(current_asmdata.CurrAsmList,resultdef,tt_normal,location.reference);
+             emit_ref(A_FISTP,S_Q,location.reference);
+             emit_none(A_FWAIT,S_NO);
+           end;
+       end;
+
+
+     procedure tx86inlinenode.second_trunc_real;
+       var
+         href : treference;
+         oldcw : treference;
+         tempreg : tregister;
+       begin
+       {
+         if use_sse(left.resultdef) then
+           begin
+             secondpass(left);
+             location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
+             location.loc:=LOC_REFERENCE;
+             current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg_const(A_PSHUFD,S_XMM,location.left.register,location.left.register))
+             current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg_const(A_PSHUFD,S_XMM,location.left.register,location.left.register))
+
+             tg.GetTempTyped(current_asmdata.CurrAsmList,left.resultdef,tt_normal,location.reference);
+           end
+         else
+       }
+          begin
+            tg.GetTemp(current_asmdata.CurrAsmList,2,tt_normal,oldcw);
+            emit_ref(A_FNSTCW,S_NO,oldcw);
+            tempreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_16);
+            cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_16,OS_16,oldcw,tempreg);
+            emit_const_ref(A_OR,S_W,$0f00,oldcw);
+            load_fpu_location;
+            emit_ref(A_FLDCW,S_NO,oldcw);
+            location.loc:=LOC_REFERENCE;
+            tg.GetTempTyped(current_asmdata.CurrAsmList,resultdef,tt_normal,location.reference);
+            cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_16,OS_16,tempreg,oldcw);
+            emit_ref(A_FISTP,S_Q,location.reference);
+            emit_ref(A_FLDCW,S_NO,oldcw);
+            emit_none(A_FWAIT,S_NO);
+            tg.UnGetTemp(current_asmdata.CurrAsmList,oldcw);
+           end;
+       end;
+
+
      procedure tx86inlinenode.second_sqr_real;
      procedure tx86inlinenode.second_sqr_real;
 
 
        begin
        begin
@@ -263,6 +362,7 @@ implementation
            end;
            end;
        end;
        end;
 
 
+
      procedure tx86inlinenode.second_sqrt_real;
      procedure tx86inlinenode.second_sqrt_real;
        begin
        begin
          if use_sse(resultdef) then
          if use_sse(resultdef) then

+ 16 - 20
rtl/i386/math.inc

@@ -34,7 +34,7 @@
         fnstcw (%esp)
         fnstcw (%esp)
         popl %eax
         popl %eax
       end;
       end;
-      
+
 
 
     procedure SetSSECSR(w : dword);
     procedure SetSSECSR(w : dword);
       var
       var
@@ -45,8 +45,8 @@
           ldmxcsr _w
           ldmxcsr _w
         end;
         end;
       end;
       end;
-    
-    
+
+
     function GetSSECSR : dword;
     function GetSSECSR : dword;
       var
       var
         _w : dword;
         _w : dword;
@@ -191,31 +191,27 @@
       end;
       end;
 
 
 
 
-
     {$define FPC_SYSTEM_HAS_TRUNC}
     {$define FPC_SYSTEM_HAS_TRUNC}
     function fpc_trunc_real(d : ValReal) : int64;assembler;compilerproc;
     function fpc_trunc_real(d : ValReal) : int64;assembler;compilerproc;
-      var
-        oldcw,
-        newcw : word;
-        res   : int64;
       asm
       asm
-        fnstcw oldcw
-        fwait
-        movw oldcw,%cx
-        orw $0x0f00,%cx
-        movw %cx,newcw
-        fldcw newcw
+        subl $12,%esp
         fldt d
         fldt d
-        fistpq res
+        fnstcw (%esp)
+        movw (%esp),%cx
+        orw $0x0f00,(%esp)
+        fldcw (%esp)
+        movw %cx,(%esp)
+        fistpq 4(%esp)
+        fldcw (%esp)
         fwait
         fwait
-        movl res,%eax
-        movl res+4,%edx
-        fldcw oldcw
+        movl 4(%esp),%eax
+        movl 8(%esp),%edx
       end;
       end;
 
 
 
 
     {$define FPC_SYSTEM_HAS_ROUND}
     {$define FPC_SYSTEM_HAS_ROUND}
-    function fpc_round_real(d : ValReal) : int64;assembler;compilerproc;
+    { keep for bootstrapping with 2.0.x }
+    function fpc_round_real(d : ValReal) : int64;compilerproc;assembler;
       var
       var
         res   : int64;
         res   : int64;
       asm
       asm
@@ -225,7 +221,7 @@
         movl res,%eax
         movl res,%eax
         movl res+4,%edx
         movl res+4,%edx
       end;
       end;
-
+    
 
 
     {$define FPC_SYSTEM_HAS_POWER}
     {$define FPC_SYSTEM_HAS_POWER}
    function power(bas,expo : ValReal) : ValReal;
    function power(bas,expo : ValReal) : ValReal;