2005-11-14 Robert Dewar <dewar@adacore.com>

	* exp_vfpt.adb: Handle /= case
	(Expand_Vax_Conversion): Properly recognize Conversion_OK flag
	so that we do not get duplicate scaling for fixed point conversions.

	* s-vaflop.ads, s-vaflop.adb: (Ne_F): New function



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106951 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 90 insertions, 33 deletions

diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb
index 98b2b075ce0..de2fae10459 100644
--- a/gcc/ada/exp_vfpt.adb
+++ b/gcc/ada/exp_vfpt.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -196,6 +196,13 @@ package body Exp_VFpt is
                Func := RE_Lt_G;
             end if;
 
+         when N_Op_Ne =>
+            if Typc = 'F' then
+               Func := RE_Ne_F;
+            else
+               Func := RE_Ne_G;
+            end if;
+
          when others =>
             Func := RE_Null;
             raise Program_Error;
@@ -295,14 +302,16 @@ package body Exp_VFpt is
          end if;
       end Call_Type;
 
+      -------------------------------------------------
+      -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
+      -------------------------------------------------
+
       function Equivalent_Integer_Type (T : Entity_Id) return Entity_Id is
       begin
          if Esize (T) = Esize (Standard_Long_Long_Integer) then
             return Standard_Long_Long_Integer;
-
          elsif Esize (T) = Esize (Standard_Long_Integer) then
             return  Standard_Long_Integer;
-
          else
             return Standard_Integer;
          end if;
@@ -320,38 +329,62 @@ package body Exp_VFpt is
          Rewrite (N,
            Unchecked_Convert_To (T_Typ, Expr));
 
+      --  Case of conversion of fixed-point type to Vax_Float type
+
       elsif Is_Fixed_Point_Type (S_Typ) then
 
-         --  convert the scaled integer value to the target type, and multiply
-         --  by 'Small of type.
+         --  If Conversion_OK set, then we introduce an intermediate IEEE
+         --  target type since we are expecting the code generator to handle
+         --  the case of integer to IEEE float.
 
-         Rewrite (N,
-            Make_Op_Multiply (Loc,
-              Left_Opnd =>
-                Make_Type_Conversion (Loc,
-                  Subtype_Mark => New_Occurrence_Of (T_Typ, Loc),
-                  Expression   =>
-                    Unchecked_Convert_To (
-                      Equivalent_Integer_Type (S_Typ), Expr)),
-              Right_Opnd =>
-                Make_Real_Literal (Loc, Realval => Small_Value (S_Typ))));
+         if Conversion_OK (N) then
+            Rewrite (N,
+              Convert_To (T_Typ, OK_Convert_To (Universal_Real, Expr)));
+
+         --  Otherwise, convert the scaled integer value to the target type,
+         --  and multiply by 'Small of type.
+
+         else
+            Rewrite (N,
+               Make_Op_Multiply (Loc,
+                 Left_Opnd =>
+                   Make_Type_Conversion (Loc,
+                     Subtype_Mark => New_Occurrence_Of (T_Typ, Loc),
+                     Expression   =>
+                       Unchecked_Convert_To (
+                         Equivalent_Integer_Type (S_Typ), Expr)),
+                 Right_Opnd =>
+                   Make_Real_Literal (Loc, Realval => Small_Value (S_Typ))));
+         end if;
+
+      --  Case of conversion of Vax_Float type to fixed-point type
 
       elsif Is_Fixed_Point_Type (T_Typ) then
 
-         --  multiply value by 'small of type, and convert to the corresponding
-         --  integer type.
+         --  If Conversion_OK set, then we introduce an intermediate IEEE
+         --  target type, since we are expecting the code generator to handle
+         --  the case of IEEE float to integer.
 
-         Rewrite (N,
-           Unchecked_Convert_To (T_Typ,
-             Make_Type_Conversion (Loc,
-               Subtype_Mark =>
-                 New_Occurrence_Of (Equivalent_Integer_Type (T_Typ), Loc),
-               Expression =>
-                 Make_Op_Multiply (Loc,
-                   Left_Opnd => Expr,
-                   Right_Opnd =>
-                     Make_Real_Literal (Loc,
-                       Realval => Ureal_1 / Small_Value (T_Typ))))));
+         if Conversion_OK (N) then
+            Rewrite (N,
+              OK_Convert_To (T_Typ, Convert_To (Universal_Real, Expr)));
+
+         --  Otherwise, multiply value by 'small of type, and convert to the
+         --  corresponding integer type.
+
+         else
+            Rewrite (N,
+              Unchecked_Convert_To (T_Typ,
+                Make_Type_Conversion (Loc,
+                  Subtype_Mark =>
+                    New_Occurrence_Of (Equivalent_Integer_Type (T_Typ), Loc),
+                  Expression =>
+                    Make_Op_Multiply (Loc,
+                      Left_Opnd => Expr,
+                      Right_Opnd =>
+                        Make_Real_Literal (Loc,
+                          Realval => Ureal_1 / Small_Value (T_Typ))))));
+         end if;
 
       --  All other cases
 
diff --git a/gcc/ada/s-vaflop.adb b/gcc/ada/s-vaflop.adb
index ae721cfa33d..3cf96e26e93 100644
--- a/gcc/ada/s-vaflop.adb
+++ b/gcc/ada/s-vaflop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -310,6 +310,24 @@ package body System.Vax_Float_Operations is
       return X * Y;
    end Mul_G;
 
+   ----------
+   -- Ne_F --
+   ----------
+
+   function Ne_F (X, Y : F) return Boolean is
+   begin
+      return X /= Y;
+   end Ne_F;
+
+   ----------
+   -- Ne_G --
+   ----------
+
+   function Ne_G (X, Y : G) return Boolean is
+   begin
+      return X /= Y;
+   end Ne_G;
+
    -----------
    -- Neg_F --
    -----------
@@ -426,7 +444,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_D (Arg : D) return Boolean is
-      Val : T := G_To_T (D_To_G (Arg));
+      Val : constant T := G_To_T (D_To_G (Arg));
    begin
       return Val'Valid;
    end Valid_D;
@@ -439,7 +457,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_F (Arg : F) return Boolean is
-      Val : S := F_To_S (Arg);
+      Val : constant S := F_To_S (Arg);
    begin
       return Val'Valid;
    end Valid_F;
@@ -452,7 +470,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_G (Arg : G) return Boolean is
-      Val : T := G_To_T (Arg);
+      Val : constant T := G_To_T (Arg);
    begin
       return Val'Valid;
    end Valid_G;
diff --git a/gcc/ada/s-vaflop.ads b/gcc/ada/s-vaflop.ads
index a7bfc9319ae..9f205d48338 100644
--- a/gcc/ada/s-vaflop.ads
+++ b/gcc/ada/s-vaflop.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -139,6 +139,10 @@ package System.Vax_Float_Operations is
    function Lt_G (X, Y : G) return Boolean;
    --  Compares for X < Y
 
+   function Ne_F (X, Y : F) return Boolean;
+   function Ne_G (X, Y : G) return Boolean;
+   --  Compares for X /= Y
+
    ----------------------------------
    -- Routines for Valid Attribute --
    ----------------------------------
@@ -218,6 +222,8 @@ private
    pragma Inline (Le_G);
    pragma Inline (Lt_F);
    pragma Inline (Lt_G);
+   pragma Inline (Ne_F);
+   pragma Inline (Ne_G);
 
    pragma Inline (Valid_D);
    pragma Inline (Valid_F);