* powerpc/powerpc64: Fixed floating point compares to be IEEE-754 compliant. Mantis #9362.

git-svn-id: trunk@27604 -

compiler/powerpc/cpubase.pas

@@ -211,7 +211,10 @@ uses
 *****************************************************************************}
 
     type
-      TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX);
+      TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX,
+                       { For IEEE-compliant floating-point compares, only <= and >=
+                         are actually needed but the other two are for inverse. }
+                       F_FA,F_FAE,F_FB,F_FBE);
       TResFlags = record
         cr: RS_CR0..RS_CR7;
         flag: TResFlagsEnum;
@@ -444,8 +447,15 @@ implementation
       const
         inv_flags: array[F_EQ..F_GE] of TResFlagsEnum =
           (F_NE,F_EQ,F_GE,F_GE,F_LE,F_LT);
+        inv_fpuflags: array[F_FA..F_FBE] of TResFlagsEnum =
+          (F_FBE,F_FB,F_FAE,F_FA);
       begin
-        r.flag := inv_flags[r.flag];
+        if r.flag in [F_EQ..F_GE] then
+          r.flag := inv_flags[r.flag]
+        else if r.flag in [F_FA..F_FBE] then
+          r.flag := inv_fpuflags[r.flag]
+        else
+          internalerror(2014041901);
       end;
 
 

compiler/powerpc64/cpubase.pas

@@ -229,8 +229,11 @@ const
   *****************************************************************************}
 
 type
-  TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX,
-    F_OX);
+  TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX,F_OX,
+                   { For IEEE-compliant floating-point compares, only <= and >=
+                     are actually needed but the other two are for inverse. }
+                   F_FA,F_FAE,F_FB,F_FBE);
+
   TResFlags = record
     cr: RS_CR0..RS_CR7;
     flag: TResFlagsEnum;
@@ -445,8 +448,15 @@ procedure inverse_flags(var r: TResFlags);
 const
   inv_flags: array[F_EQ..F_GE] of TResFlagsEnum =
   (F_NE, F_EQ, F_GE, F_GE, F_LE, F_LT);
+  inv_fpuflags: array[F_FA..F_FBE] of TResFlagsEnum =
+  (F_FBE,F_FB,F_FAE,F_FA);
 begin
-  r.flag := inv_flags[r.flag];
+  if r.flag in [F_EQ..F_GE] then
+    r.flag := inv_flags[r.flag]
+  else if r.flag in [F_FA..F_FBE] then
+    r.flag := inv_fpuflags[r.flag]
+  else
+    internalerror(2014041901);
 end;
 
 function inverse_cond(const c: TAsmCond): Tasmcond;

compiler/ppcgen/cgppc.pas

@@ -677,8 +677,28 @@ unit cgppc;
   procedure tcgppcgen.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
     var
       c: tasmcond;
+      f2: TResFlags;
+      testbit: longint;
     begin
-      c := flags_to_cond(f);
+      f2:=f;
+      testbit:=(f.cr-RS_CR0)*4;
+      case f.flag of
+        F_FA:
+          f2.flag:=F_GT;
+        F_FAE:
+          begin
+            list.concat(taicpu.op_const_const_const(A_CROR,testbit+1,testbit+1,testbit+2));
+            f2.flag:=F_GT;
+          end;
+        F_FB:
+          f2.flag:=F_LT;
+        F_FBE:
+          begin
+            list.concat(taicpu.op_const_const_const(A_CROR,testbit,testbit,testbit+2));
+            f2.flag:=F_LT;
+          end;
+      end;
+      c := flags_to_cond(f2);
       a_jmp(list,A_BC,c.cond,c.cr-RS_CR0,l);
     end;
 
@@ -1017,7 +1037,11 @@ unit cgppc;
       var
         testbit: byte;
         bitvalue: boolean;
+        hreg: tregister;
+        needsecondreg: boolean;
       begin
+        hreg:=NR_NO;
+        needsecondreg:=false;
         { get the bit to extract from the conditional register + its requested value (0 or 1) }
         testbit := ((f.cr - RS_CR0) * 4);
         case f.flag of
@@ -1026,14 +1050,25 @@ unit cgppc;
               inc(testbit, 2);
               bitvalue := f.flag = F_EQ;
             end;
-          F_LT, F_GE:
+          F_LT, F_GE, F_FB:
+            begin
+              bitvalue := f.flag in [F_LT,F_FB];
+            end;
+          F_GT, F_LE, F_FA:
             begin
-              bitvalue := f.flag = F_LT;
+              inc(testbit);
+              bitvalue := f.flag in [F_GT,F_FA];
             end;
-          F_GT, F_LE:
+          F_FAE:
             begin
               inc(testbit);
-              bitvalue := f.flag = F_GT;
+              bitvalue:=true;
+              needsecondreg:=true;
+            end;
+          F_FBE:
+            begin
+              bitvalue:=true;
+              needsecondreg:=true;
             end;
         else
           internalerror(200112261);
@@ -1042,12 +1077,23 @@ unit cgppc;
         list.concat(taicpu.op_reg(A_MFCR, reg));
         { we will move the bit that has to be tested to bit 0 by rotating left }
         testbit := (testbit + 1) and 31;
+
+        { for floating-point >= and <=, extract equality bit first }
+        if needsecondreg then
+          begin
+            hreg:=getintregister(list,OS_INT);
+            list.concat(taicpu.op_reg_reg_const_const_const(
+              A_RLWINM,hreg,reg,(((f.cr-RS_CR0)*4)+3) and 31,31,31));
+          end;
+
         { extract bit }
         list.concat(taicpu.op_reg_reg_const_const_const(
           A_RLWINM,reg,reg,testbit,31,31));
 
+        if needsecondreg then
+          list.concat(taicpu.op_reg_reg_reg(A_OR,reg,hreg,reg))
         { if we need the inverse, xor with 1 }
-        if not bitvalue then
+        else if not bitvalue then
           list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1));
       end;
 

compiler/ppcgen/ngppcadd.pas

@@ -134,28 +134,54 @@ implementation
     function tgenppcaddnode.getresflags : tresflags;
       begin
         if (left.resultdef.typ <> floatdef) then
-          result.cr := RS_CR0
-        else
-          result.cr := RS_CR1;
-        case nodetype of
-          equaln : result.flag:=F_EQ;
-          unequaln : result.flag:=F_NE;
-        else
-          if nf_swapped in flags then
+          begin
+            result.cr := RS_CR0;
             case nodetype of
-              ltn : result.flag:=F_GT;
-              lten : result.flag:=F_GE;
-              gtn : result.flag:=F_LT;
-              gten : result.flag:=F_LE;
+              equaln : result.flag:=F_EQ;
+              unequaln : result.flag:=F_NE;
+            else
+              if nf_swapped in flags then
+                case nodetype of
+                  ltn : result.flag:=F_GT;
+                  lten : result.flag:=F_GE;
+                  gtn : result.flag:=F_LT;
+                  gten : result.flag:=F_LE;
+                end
+              else
+                case nodetype of
+                  ltn : result.flag:=F_LT;
+                  lten : result.flag:=F_LE;
+                  gtn : result.flag:=F_GT;
+                  gten : result.flag:=F_GE;
+                end;
             end
-          else
-            case nodetype of
-              ltn : result.flag:=F_LT;
-              lten : result.flag:=F_LE;
-              gtn : result.flag:=F_GT;
-              gten : result.flag:=F_GE;
-            end;
-        end
+          end
+        else
+          begin
+            result.cr := RS_CR1;
+            if (nodetype=equaln) then
+              result.flag:=F_EQ
+            else if (nodetype=unequaln) then
+              result.flag:=F_NE
+            else if (nf_swapped in flags) then
+              case nodetype of
+                ltn : result.flag:=F_FA;
+                lten : result.flag:=F_FAE;
+                gtn : result.flag:=F_FB;
+                gten : result.flag:=F_FBE;
+              else
+                internalerror(2014031902);
+              end
+            else
+              case nodetype of
+                ltn : result.flag:=F_FB;
+                lten : result.flag:=F_FBE;
+                gtn : result.flag:=F_FA;
+                gten : result.flag:=F_FAE;
+              else
+                internalerror(2014031903);
+              end;
+          end;
       end;