[multiple changes]

2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Add_Inlined_Body): Adjust check for library-level inlined
	functions to previous change.  Reorganize code slightly.

2011-08-02  Geert Bosch  <bosch@adacore.com>

	* back_end.ads (Register_Type_Proc): New call back procedure type for
	allowing the back end to provide information about available types.
	(Register_Back_End_Types): New procedure to register back end types.
	* back_end.adb (Register_Back_End_Types): Call the back end to enumerate
	available types.
	* cstand.adb (Back_End_Float_Types): New list for floating point types
	supported by the back end.
	(Build_Float_Type): Add extra parameter for Float_Rep_Kind.
	(Copy_Float_Type): New procedure to make new copies of predefined types.
	(Register_Float_Type): New call back procedure to populate the BEFT list
	(Find_Back_End_Float_Type): New procedure to find a BEFT by name
	(Create_Back_End_Float_Types): New procedure to populate the BEFT list.
	(Create_Float_Types): New procedure to create entities for floating
	point types predefined in Standard, and put these and any remaining
	BEFTs on the Predefined_Float_Types list.
	* stand.ads (Predefined_Float_Types): New list for predefined floating
	point types that do not have declarations in package Standard.

From-SVN: r177137

6 files changed, 298 insertions, 61 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 596668d..5cd284e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,30 @@
 2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* inline.adb (Add_Inlined_Body): Adjust check for library-level inlined
+	functions to previous change.  Reorganize code slightly.
+
+2011-08-02  Geert Bosch  <bosch@adacore.com>
+
+	* back_end.ads (Register_Type_Proc): New call back procedure type for
+	allowing the back end to provide information about available types.
+	(Register_Back_End_Types): New procedure to register back end types.
+	* back_end.adb (Register_Back_End_Types): Call the back end to enumerate
+	available types.
+	* cstand.adb (Back_End_Float_Types): New list for floating point types
+	supported by the back end.
+	(Build_Float_Type): Add extra parameter for Float_Rep_Kind.
+	(Copy_Float_Type): New procedure to make new copies of predefined types.
+	(Register_Float_Type): New call back procedure to populate the BEFT list
+	(Find_Back_End_Float_Type): New procedure to find a BEFT by name
+	(Create_Back_End_Float_Types): New procedure to populate the BEFT list.
+	(Create_Float_Types): New procedure to create entities for floating
+	point types predefined in Standard, and put these and any remaining
+	BEFTs on the Predefined_Float_Types list.
+	* stand.ads (Predefined_Float_Types): New list for predefined floating
+	point types that do not have declarations in package Standard.
+
+2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* inline.adb (Get_Code_Unit_Entity): New local function.  Returns the
 	entity node for the unit containing the parameter.
 	(Add_Inlined_Body): Use it to find the unit containing the subprogram.
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index 7172696..3bcf848 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -325,4 +325,16 @@ package body Back_End is
          Next_Arg := Next_Arg + 1;
       end loop;
    end Scan_Compiler_Arguments;
+
+   -----------------------------
+   -- Register_Back_End_Types --
+   -----------------------------
+
+   procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
+      procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
+      pragma Import (C, Enumerate_Modes, "enumerate_modes");
+
+   begin
+      Enumerate_Modes (Call_Back);
+   end Register_Back_End_Types;
 end Back_End;
diff --git a/gcc/ada/back_end.ads b/gcc/ada/back_end.ads
index 93e1ba6..430f2c9 100644
--- a/gcc/ada/back_end.ads
+++ b/gcc/ada/back_end.ads
@@ -26,6 +26,8 @@
 --  Call the back end with all the information needed. Also contains other
 --  back-end specific interfaces required by the front end.
 
+with Einfo; use Einfo;
+
 package Back_End is
 
    type Back_End_Mode_Type is (
@@ -44,6 +46,25 @@ package Back_End is
    pragma Convention (C, Back_End_Mode_Type);
    for Back_End_Mode_Type use (0, 1, 2);
 
+   type C_String is array (0 .. 255) of aliased Character;
+   pragma Convention (C, C_String);
+
+   type Register_Type_Proc is access procedure
+     (C_Name    : C_String; -- Nul-terminated string with name of type
+      Digs      : Natural;  -- Nr or digits for floating point, 0 otherwise
+      Complex   : Boolean;  -- True iff type has real and imaginary parts
+      Count     : Natural;  -- Number of elements in vector, 0 otherwise
+      Float_Rep : Float_Rep_Kind; -- Representation used for fpt type
+      Size      : Positive; -- Size of representation in bits
+      Alignment : Natural); -- Required alignment in bits
+   pragma Convention (C, Register_Type_Proc);
+   --  Call back procedure for Register_Back_End_Types. This is to be used by
+   --  Create_Standard to create predefined types for all types supported by
+   --  the back end.
+
+   procedure Register_Back_End_Types (Call_Back : Register_Type_Proc);
+   --  Calls the Call_Back function with information for each supported type.
+
    procedure Call_Back_End (Mode : Back_End_Mode_Type);
    --  Call back end, i.e. make call to driver traversing the tree and
    --  outputting code. This call is made with all tables locked.
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index d93d96c..fe3bf45 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -24,6 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Back_End; use Back_End;
 with Csets;    use Csets;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -51,14 +52,25 @@ package body CStand is
    Staloc : constant Source_Ptr := Standard_ASCII_Location;
    --  Standard abbreviations used throughout this package
 
+   Back_End_Float_Types : List_Id := No_List;
+   --  List used for any floating point supported by the back end. This needs
+   --  to be at the library level, because the call back procedures retrieving
+   --  this information are at that level.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
 
-   procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);
+   procedure Build_Float_Type
+     (E    : Entity_Id;
+      Siz  : Int;
+      Rep  : Float_Rep_Kind;
+      Digs : Int);
    --  Procedure to build standard predefined float base type. The first
-   --  parameter is the entity for the type, and the second parameter
-   --  is the size in bits. The third parameter is the digits value.
+   --  parameter is the entity for the type, and the second parameter is the
+   --  size in bits. The third parameter indicates the kind of representation
+   --  to be used. The fourth parameter is the digits value. Each type
+   --  is added to the list of predefined floating point types.
 
    procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);
    --  Procedure to build standard predefined signed integer subtype. The
@@ -66,6 +78,11 @@ package body CStand is
    --  is the size in bits. The corresponding base type is not built by
    --  this routine but instead must be built by the caller where needed.
 
+   procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id);
+   --  Build a floating point type, copying representation details from From.
+   --  This is used to create predefined floating point types based on
+   --  available types in the back end.
+
    procedure Create_Operators;
    --  Make entries for each of the predefined operators in Standard
 
@@ -89,6 +106,12 @@ package body CStand is
    --  bounds, but do not statically match, since a subtype with constraints
    --  never matches a subtype with no constraints.
 
+   function Find_Back_End_Float_Type (Name : String) return Entity_Id;
+   --  Return the first float type in Back_End_Float_Types with the given name.
+   --  Names of entities in back end types, are either type names of C
+   --  predefined types (all lower case), or mode names (upper case).
+   --  These are not generally valid identifier names.
+
    function Identifier_For (S : Standard_Entity_Type) return Node_Id;
    --  Returns an identifier node with the same name as the defining
    --  identifier corresponding to the given Standard_Entity_Type value
@@ -121,6 +144,20 @@ package body CStand is
    procedure Print_Standard;
    --  Print representation of package Standard if switch set
 
+   procedure Register_Float_Type
+     (Name      : C_String; -- Nul-terminated string with name of type
+      Digs      : Natural;  -- Nr or digits for floating point, 0 otherwise
+      Complex   : Boolean;  -- True iff type has real and imaginary parts
+      Count     : Natural;  -- Number of elements in vector, 0 otherwise
+      Float_Rep : Float_Rep_Kind; -- Representation used for fpt type
+      Size      : Positive; -- Size of representation in bits
+      Alignment : Natural); -- Required alignment in bits
+   pragma Convention (C, Register_Float_Type);
+   --  Call back to allow the back end to register available types.
+   --  This call back currently creates predefined floating point base types
+   --  for any floating point types reported by the back end, and adds them
+   --  to the list of predefined float types.
+
    procedure Set_Integer_Bounds
      (Id  : Entity_Id;
       Typ : Entity_Id;
@@ -135,7 +172,12 @@ package body CStand is
    -- Build_Float_Type --
    ----------------------
 
-   procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int) is
+   procedure Build_Float_Type
+     (E    : Entity_Id;
+      Siz  : Int;
+      Rep  : Float_Rep_Kind;
+      Digs : Int)
+   is
    begin
       Set_Type_Definition (Parent (E),
         Make_Floating_Point_Definition (Stloc,
@@ -143,13 +185,7 @@ package body CStand is
 
       Set_Ekind                      (E, E_Floating_Point_Type);
       Set_Etype                      (E, E);
-
-      if AAMP_On_Target then
-         Set_Float_Rep (E, AAMP);
-      else
-         Set_Float_Rep (E, IEEE_Binary);
-      end if;
-
+      Set_Float_Rep (E, Rep);
       Init_Size                      (E, Siz);
       Set_Elem_Alignment             (E);
       Init_Digits_Value              (E, Digs);
@@ -159,6 +195,21 @@ package body CStand is
       Set_Size_Known_At_Compile_Time (E);
    end Build_Float_Type;
 
+   ------------------------
+   -- Find_Back_End_Float_Type --
+   ------------------------
+
+   function Find_Back_End_Float_Type (Name : String) return Entity_Id is
+      N    : Node_Id := First (Back_End_Float_Types);
+
+   begin
+      while Present (N) and then Get_Name_String (Chars (N)) /= Name loop
+         Next (N);
+      end loop;
+
+      return Entity_Id (N);
+   end Find_Back_End_Float_Type;
+
    -------------------------------
    -- Build_Signed_Integer_Type --
    -------------------------------
@@ -185,6 +236,16 @@ package body CStand is
       Set_Size_Known_At_Compile_Time (E);
    end Build_Signed_Integer_Type;
 
+   ---------------------
+   -- Copy_Float_Type --
+   ---------------------
+
+   procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id) is
+   begin
+      Build_Float_Type (To, UI_To_Int (Esize (From)), Float_Rep (From),
+                        UI_To_Int (Digits_Value (From)));
+   end Copy_Float_Type;
+
    ----------------------
    -- Create_Operators --
    ----------------------
@@ -306,10 +367,11 @@ package body CStand is
 
    --  The tree for the package Standard is prefixed to all compilations.
    --  Several entities required by semantic analysis are denoted by global
-   --  variables that are initialized to point to the corresponding
-   --  occurrences in STANDARD. The visible entities of STANDARD are
-   --  created here. The private entities defined in STANDARD are created
-   --  by Initialize_Standard in the semantics module.
+   --  variables that are initialized to point to the corresponding occurrences
+   --  in Standard. The visible entities of Standard are created here. Special
+   --  entities maybe created here as well or may be created from the semantics
+   --  module. By not adding them to the Decls list of Standard they will not
+   --  be visible to Ada programs.
 
    procedure Create_Standard is
       Decl_S : constant List_Id := New_List;
@@ -330,6 +392,14 @@ package body CStand is
       procedure Build_Exception (S : Standard_Entity_Type);
       --  Procedure to declare given entity as an exception
 
+      procedure Create_Back_End_Float_Types;
+      --  Initialize the Back_End_Float_Types list by having the back end
+      --  enumerate all available types and building type entities for them.
+
+      procedure Create_Float_Types;
+      --  Creates entities for all predefined floating point types, and
+      --  adds these to the Predefined_Float_Types list in package Standard.
+
       procedure Pack_String_Type (String_Type : Entity_Id);
       --  Generate proper tree for pragma Pack that applies to given type, and
       --  mark type as having the pragma.
@@ -351,6 +421,78 @@ package body CStand is
          Append (Decl, Decl_S);
       end Build_Exception;
 
+      ---------------------------
+      -- Create_Back_End_Float_Types --
+      ---------------------------
+
+      procedure Create_Back_End_Float_Types is
+      begin
+         Back_End_Float_Types := No_List;
+         Register_Back_End_Types (Register_Float_Type'Access);
+      end Create_Back_End_Float_Types;
+
+      ------------------------
+      -- Create_Float_Types --
+      ------------------------
+
+      procedure Create_Float_Types is
+      begin
+         --  Create type definition nodes for predefined float types
+
+         Copy_Float_Type (Standard_Short_Float,
+           Find_Back_End_Float_Type ("float"));
+
+         Copy_Float_Type (Standard_Float, Standard_Short_Float);
+
+         Copy_Float_Type (Standard_Long_Float,
+           Find_Back_End_Float_Type ("double"));
+
+         Predefined_Float_Types := New_List
+           (Standard_Short_Float, Standard_Float, Standard_Long_Float);
+
+         --  ??? For now, we don't have a good way to tell the widest float
+         --  type with hardware support. Basically, GCC knows the size of that
+         --  type, but on x86-64 there often are two or three 128-bit types,
+         --  one double extended that has 18 decimal digits, a 128-bit quad
+         --  precision type with 33 digits and possibly a 128-bit decimal float
+         --  type with 34 digits. As a workaround, we define Long_Long_Float as
+         --  C's "long double" if that type exists and has at most 18 digits,
+         --  or otherwise the same as Long_Float.
+
+         declare
+            Max_HW_Digs : constant := 18;
+            LF_Digs     : constant Pos :=
+                            UI_To_Int (Digits_Value (Standard_Long_Float));
+            LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
+            N   : Node_Id := First (Back_End_Float_Types);
+
+         begin
+            if Digits_Value (LLF) > Max_HW_Digs then
+               LLF := Empty;
+            end if;
+
+            while No (LLF) and then Present (N) loop
+               if UI_To_Int (Digits_Value (N)) in LF_Digs + 1 .. Max_HW_Digs
+                 and then Machine_Radix_Value (N) = Uint_2
+               then
+                  LLF := N;
+               end if;
+
+               Next (N);
+            end loop;
+
+            if No (LLF) then
+               LLF := Standard_Long_Float;
+            end if;
+
+            Copy_Float_Type (Standard_Long_Long_Float, LLF);
+
+            Append (Standard_Long_Long_Float, Predefined_Float_Types);
+         end;
+
+         Append_List (Back_End_Float_Types, To => Predefined_Float_Types);
+      end Create_Float_Types;
+
       ----------------------
       -- Pack_String_Type --
       ----------------------
@@ -431,6 +573,8 @@ package body CStand is
          Append (Decl, Decl_S);
       end loop;
 
+      Create_Back_End_Float_Types;
+
       --  Create type definition node for type Boolean. The Size is set to
       --  1 as required by Ada 95 and current ARG interpretations for Ada/83.
 
@@ -539,27 +683,7 @@ package body CStand is
       Create_Unconstrained_Base_Type
         (Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
 
-      --  Create type definition nodes for predefined float types
-
-      Build_Float_Type
-        (Standard_Short_Float,
-         Standard_Short_Float_Size,
-         Standard_Short_Float_Digits);
-
-      Build_Float_Type
-        (Standard_Float,
-         Standard_Float_Size,
-         Standard_Float_Digits);
-
-      Build_Float_Type
-        (Standard_Long_Float,
-         Standard_Long_Float_Size,
-         Standard_Long_Float_Digits);
-
-      Build_Float_Type
-        (Standard_Long_Long_Float,
-         Standard_Long_Long_Float_Size,
-         Standard_Long_Long_Float_Digits);
+      Create_Float_Types;
 
       --  Create type definition node for type Character. Note that we do not
       --  set the Literals field, since type Character is handled with special
@@ -1209,10 +1333,7 @@ package body CStand is
       Set_Defining_Identifier (Decl, Universal_Real);
       Make_Name (Universal_Real, "universal_real");
       Set_Scope (Universal_Real, Standard_Standard);
-      Build_Float_Type
-        (Universal_Real,
-         Standard_Long_Long_Float_Size,
-         Standard_Long_Long_Float_Digits);
+      Copy_Float_Type (Universal_Real, Standard_Long_Long_Float);
 
       --  Note: universal fixed, unlike universal integer and universal real,
       --  is never used at runtime, so it does not need to have bounds set.
@@ -1874,6 +1995,53 @@ package body CStand is
       P ("end Standard;");
    end Print_Standard;
 
+   -------------------------
+   -- Register_Float_Type --
+   -------------------------
+
+   procedure Register_Float_Type
+     (Name      : C_String;
+      Digs      : Natural;
+      Complex   : Boolean;
+      Count     : Natural;
+      Float_Rep : Float_Rep_Kind;
+      Size      : Positive;
+      Alignment : Natural)
+   is
+      Last : Natural := Name'First - 1;
+
+   begin
+      for J in Name'Range loop
+         if Name (J) = ASCII.NUL then
+            Last := J - 1;
+            exit;
+         end if;
+      end loop;
+
+      if Digs > 0 and then not Complex and then Count = 0 then
+         declare
+            Ent   : constant Entity_Id := New_Standard_Entity;
+            Esize : constant Pos := Pos ((Size + Alignment - 1)
+                                           / Alignment * Alignment);
+         begin
+            Set_Defining_Identifier
+              (New_Node (N_Full_Type_Declaration, Stloc), Ent);
+            Make_Name (Ent, String (Name (Name'First .. Last)));
+            Set_Scope (Ent, Standard_Standard);
+            Build_Float_Type (Ent, Esize, Float_Rep, Pos (Digs));
+            Set_RM_Size (Ent, UI_From_Int (Int (Size)));
+            Set_Alignment (Ent, UI_From_Int (Int (Alignment / 8)));
+
+            if No (Back_End_Float_Types) then
+               Back_End_Float_Types := New_List (Ent);
+
+            else
+               Append (Ent, Back_End_Float_Types);
+            end if;
+         end;
+      end if;
+   end Register_Float_Type;
+
    ----------------------
    -- Set_Float_Bounds --
    ----------------------
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 339c01f..6678057 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -236,7 +236,6 @@ package body Inline is
    ----------------------
 
    procedure Add_Inlined_Body (E : Entity_Id) is
-      Pack : Entity_Id;
 
       function Must_Inline return Boolean;
       --  Inlining is only done if the call statement N is in the main unit,
@@ -318,35 +317,39 @@ package body Inline is
       --  no enclosing package to retrieve. In this case, it is the body of
       --  the function that will have to be loaded.
 
-      if not Is_Abstract_Subprogram (E) and then not Is_Nested (E)
+      if not Is_Abstract_Subprogram (E)
+        and then not Is_Nested (E)
         and then Convention (E) /= Convention_Protected
+        and then Must_Inline
       then
-         Pack := Get_Code_Unit_Entity (E);
-
-         if Must_Inline
-           and then Ekind (Pack) = E_Package
-         then
-            Set_Is_Called (E);
+         declare
+            Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
 
-            if Pack = Standard_Standard then
+         begin
+            if Pack = E then
 
                --  Library-level inlined function. Add function itself to
                --  list of needed units.
 
+               Set_Is_Called (E);
                Inlined_Bodies.Increment_Last;
                Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
 
-            elsif Is_Generic_Instance (Pack) then
-               null;
+            elsif Ekind (Pack) = E_Package then
+               Set_Is_Called (E);
 
-            elsif not Is_Inlined (Pack)
-              and then not Has_Completion (E)
-            then
-               Set_Is_Inlined (Pack);
-               Inlined_Bodies.Increment_Last;
-               Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
+               if Is_Generic_Instance (Pack) then
+                  null;
+
+               elsif not Is_Inlined (Pack)
+                 and then not Has_Completion (E)
+               then
+                  Set_Is_Inlined (Pack);
+                  Inlined_Bodies.Increment_Last;
+                  Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
+               end if;
             end if;
-         end if;
+         end;
       end if;
    end Add_Inlined_Body;
 
diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads
index 46bbe4c..1c93078 100644
--- a/gcc/ada/stand.ads
+++ b/gcc/ada/stand.ads
@@ -229,9 +229,9 @@ package Stand is
    type Standard_Entity_Array_Type is array (Standard_Entity_Type) of Node_Id;
 
    Standard_Entity : Standard_Entity_Array_Type;
-   --  This array contains pointers to the Defining Identifier nodes
-   --  for each of the entities defined in Standard_Entities_Type. It
-   --  is initialized by the Create_Standard procedure.
+   --  This array contains pointers to the Defining Identifier nodes for
+   --  each of the visible entities defined in Standard_Entities_Type. It is
+   --  initialized by the Create_Standard procedure.
 
    Standard_Package_Node : Node_Id;
    --  Points to the N_Package_Declaration node for standard. Also
@@ -343,6 +343,14 @@ package Stand is
    --  A zero-size subtype of Integer, used as the type of variables used
    --  to provide the debugger with name encodings for renaming declarations.
 
+   Predefined_Float_Types : List_Id;
+   --  Entities for predefined floating point types. These are used by
+   --  the semantic phase to select appropriate types for floating point
+   --  declarations. This list is ordered by preference. All types up to
+   --  Long_Long_Float_Type are considered for plain "digits N" declarations,
+   --  while selection of later types requires a range specification and
+   --  possibly other attributes or pragmas.
+
    --  The entities labeled Any_xxx are used in situations where the full
    --  characteristics of an entity are not yet known, e.g. Any_Character
    --  is used to label a character literal before resolution is complete.