From f8726f2b03e034a7928323e78fbc87b705c3c388 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 14:36:58 +0200 Subject: [PATCH] [multiple changes] 2011-08-02 Eric Botcazou * inline.adb (Add_Inlined_Body): Adjust check for library-level inlined functions to previous change. Reorganize code slightly. 2011-08-02 Geert Bosch * 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 --- gcc/ada/ChangeLog | 25 +++++ gcc/ada/back_end.adb | 12 +++ gcc/ada/back_end.ads | 21 ++++ gcc/ada/cstand.adb | 248 ++++++++++++++++++++++++++++++++++++------- gcc/ada/inline.adb | 39 +++---- gcc/ada/stand.ads | 14 ++- 6 files changed, 298 insertions(+), 61 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 596668dbd03..5cd284e9414 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2011-08-02 Eric Botcazou + + * inline.adb (Add_Inlined_Body): Adjust check for library-level inlined + functions to previous change. Reorganize code slightly. + +2011-08-02 Geert Bosch + + * 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 * inline.adb (Get_Code_Unit_Entity): New local function. Returns the diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index 7172696b5e1..3bcf8488029 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 93e1ba64381..430f2c9449f 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 d93d96c4618..fe3bf4530bb 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 339c01fbaf1..6678057ff02 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); + declare + Pack : constant Entity_Id := Get_Code_Unit_Entity (E); - if Must_Inline - and then Ekind (Pack) = E_Package - then - Set_Is_Called (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 46bbe4cb8d3..1c93078f20c 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.