From 70c34e1c94f276d6f306ed92b892cbe7340acd65 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 15:08:34 +0200 Subject: [PATCH] [multiple changes] 2011-08-02 Javier Miranda * exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine in CodePeer mode. 2011-08-02 Geert Bosch * cstand.adb (Back_End_Float_Types): Use Elist instead of Nlist (Find_Back_End_Float_Type): Likewise (Create_Back_End_Float_Types): Likewise (Create_Float_Types): Likewise (Register_Float_Type): Likewise * sem_ch3.adb (Floating_Point_Type_Declaration): Use Elist instead of Nlist and split out type selection in new local Find_Base_Type function. * sem_prag.adb (Process_Import_Predefined_Type): Use Elist instead of Nlist * stand.ads (Predefined_Float_Types): Use Elist instead of Nlist 2011-08-02 Robert Dewar * inline.adb: Minor code reorganization (put Get_Code_Unit_Entity in alpha order). * opt.ads: Minor comment change. * sem_ch12.adb: Minor code reorganization. From-SVN: r177144 --- gcc/ada/ChangeLog | 25 ++++++++++++++++ gcc/ada/cstand.adb | 51 +++++++++++++++++++++----------- gcc/ada/exp_pakd.adb | 7 +++++ gcc/ada/inline.adb | 18 ++++++------ gcc/ada/opt.ads | 2 ++ gcc/ada/sem_ch12.adb | 10 ++++--- gcc/ada/sem_ch3.adb | 70 ++++++++++++++++++++++++++++---------------- gcc/ada/sem_prag.adb | 9 ++++-- gcc/ada/stand.ads | 2 +- 9 files changed, 135 insertions(+), 59 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7495e774ef7..7954c558409 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2011-08-02 Javier Miranda + + * exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine + in CodePeer mode. + +2011-08-02 Geert Bosch + + * cstand.adb (Back_End_Float_Types): Use Elist instead of Nlist + (Find_Back_End_Float_Type): Likewise + (Create_Back_End_Float_Types): Likewise + (Create_Float_Types): Likewise + (Register_Float_Type): Likewise + * sem_ch3.adb (Floating_Point_Type_Declaration): Use Elist instead of + Nlist and split out type selection in new local Find_Base_Type function. + * sem_prag.adb (Process_Import_Predefined_Type): Use Elist instead of + Nlist + * stand.ads (Predefined_Float_Types): Use Elist instead of Nlist + +2011-08-02 Robert Dewar + + * inline.adb: Minor code reorganization (put Get_Code_Unit_Entity in + alpha order). + * opt.ads: Minor comment change. + * sem_ch12.adb: Minor code reorganization. + 2011-08-02 Gary Dismukes * sem_ch3.adb (Complete_Private_Subtype): Don't append the private diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 26b19afd525..ad79aabd360 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -28,6 +28,7 @@ with Back_End; use Back_End; with Csets; use Csets; with Debug; use Debug; with Einfo; use Einfo; +with Elists; use Elists; with Layout; use Layout; with Namet; use Namet; with Nlists; use Nlists; @@ -52,7 +53,7 @@ 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; + Back_End_Float_Types : Elist_Id := No_Elist; -- 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. @@ -200,14 +201,15 @@ package body CStand is ------------------------ function Find_Back_End_Float_Type (Name : String) return Entity_Id is - N : Node_Id := First (Back_End_Float_Types); + N : Elmt_Id := First_Elmt (Back_End_Float_Types); begin - while Present (N) and then Get_Name_String (Chars (N)) /= Name loop - Next (N); + while Present (N) and then Get_Name_String (Chars (Node (N))) /= Name + loop + Next_Elmt (N); end loop; - return Entity_Id (N); + return Node (N); end Find_Back_End_Float_Type; ------------------------------- @@ -427,7 +429,7 @@ package body CStand is procedure Create_Back_End_Float_Types is begin - Back_End_Float_Types := No_List; + Back_End_Float_Types := No_Elist; Register_Back_End_Types (Register_Float_Type'Access); end Create_Back_End_Float_Types; @@ -447,8 +449,10 @@ package body CStand is 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); + Predefined_Float_Types := New_Elmt_List; + Append_Elmt (Standard_Short_Float, Predefined_Float_Types); + Append_Elmt (Standard_Float, Predefined_Float_Types); + Append_Elmt (Standard_Long_Float, Predefined_Float_Types); -- ??? 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 @@ -464,21 +468,23 @@ package body CStand is 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); + E : Elmt_Id := First_Elmt (Back_End_Float_Types); + N : Node_Id; begin if Present (LLF) and then Digits_Value (LLF) > Max_HW_Digs then LLF := Empty; end if; - while No (LLF) and then Present (N) loop + while No (LLF) and then Present (E) loop + N := Node (E); 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); + Next_Elmt (E); end loop; if No (LLF) then @@ -487,10 +493,22 @@ package body CStand is Copy_Float_Type (Standard_Long_Long_Float, LLF); - Append (Standard_Long_Long_Float, Predefined_Float_Types); + Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types); end; - Append_List (Back_End_Float_Types, To => Predefined_Float_Types); + -- Any other back end types are appended at the end of the list of + -- predefined float types, and will only be selected if the none of + -- the types in Standard is suitable, or if a specific named type is + -- requested through a pragma Import. + + while not Is_Empty_Elmt_List (Back_End_Float_Types) loop + declare + E : constant Elmt_Id := First_Elmt (Back_End_Float_Types); + begin + Append_Elmt (Node (E), To => Predefined_Float_Types); + Remove_Elmt (Back_End_Float_Types, E); + end; + end loop; end Create_Float_Types; ---------------------- @@ -2095,11 +2113,10 @@ package body CStand is 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); + Back_End_Float_Types := New_Elmt_List; end if; + + Append_Elmt (Ent, Back_End_Float_Types); end; end if; end Register_Float_Type; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 4d3ea068819..9367e939192 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1932,6 +1932,13 @@ package body Exp_Pakd is Arg : Node_Id; begin + -- Disable this routine in CodePeer mode since the expansion of packed + -- arrays confuses the gnat2scil back end. + + if CodePeer_Mode then + return; + end if; + -- If not bit packed, we have the enumeration case, which is easily -- dealt with (just adjust the subscripts of the indexed component) diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 6678057ff02..c4937976be2 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -982,6 +982,15 @@ package body Inline is end loop; end Cleanup_Scopes; + -------------------------- + -- Get_Code_Unit_Entity -- + -------------------------- + + function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is + begin + return Cunit_Entity (Get_Code_Unit (E)); + end Get_Code_Unit_Entity; + -------------------------- -- Has_Initialized_Type -- -------------------------- @@ -1165,15 +1174,6 @@ package body Inline is end loop; end Remove_Dead_Instance; - -------------------------- - -- Get_Code_Unit_Entity -- - -------------------------- - - function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is - begin - return Cunit_Entity (Get_Code_Unit (E)); - end Get_Code_Unit_Entity; - ------------------------ -- Scope_In_Main_Unit -- ------------------------ diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index bd97c0df807..b05dda45b12 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1080,6 +1080,8 @@ package Opt is Preprocessing_Symbol_Defs : String_List_Access := new String_List (1 .. 4); -- An extensible array to temporarily stores symbol definitions specified -- on the command line with -gnateD switches. + -- What is this magic constant 4 ??? + -- What is extensible about this fixed length array ??? Preprocessing_Symbol_Last : Natural := 0; -- Index of last symbol definition in array Symbol_Definitions diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 218028f7ddf..3d0bc99d329 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2927,6 +2927,9 @@ package body Sem_Ch12 is Needs_Body : Boolean; Inline_Now : Boolean := False; + Save_Style_Check : constant Boolean := Style_Check; + -- Save style check mode for restore on exit + procedure Delay_Descriptors (E : Entity_Id); -- Delay generation of subprogram descriptors for given entity @@ -2975,8 +2978,6 @@ package body Sem_Ch12 is return False; end Might_Inline_Subp; - Save_Style_Check : constant Boolean := Style_Check; - -- Start of processing for Analyze_Package_Instantiation begin @@ -3958,6 +3959,9 @@ package body Sem_Ch12 is Parent_Installed : Boolean := False; Renaming_List : List_Id; + Save_Style_Check : constant Boolean := Style_Check; + -- Save style check mode for restore on exit + procedure Analyze_Instance_And_Renamings; -- The instance must be analyzed in a context that includes the mappings -- of generic parameters into actuals. We create a package declaration @@ -4116,8 +4120,6 @@ package body Sem_Ch12 is end if; end Analyze_Instance_And_Renamings; - Save_Style_Check : constant Boolean := Style_Check; - -- Start of processing for Analyze_Subprogram_Instantiation begin diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 30fb8782d2e..6517f70f6ae 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15056,6 +15056,10 @@ package body Sem_Ch3 is -- Find if given digits value, and possibly a specified range, allows -- derivation from specified type + function Find_Base_Type return Entity_Id; + -- Find a predefined base type that Def can derive from, or generate + -- an error and substitute Long_Long_Float if none exists. + --------------------- -- Can_Derive_From -- --------------------- @@ -15085,6 +15089,45 @@ package body Sem_Ch3 is return True; end Can_Derive_From; + -------------------- + -- Find_Base_Type -- + -------------------- + + function Find_Base_Type return Entity_Id is + Choice : Elmt_Id := First_Elmt (Predefined_Float_Types); + + begin + -- Iterate over the predefined types in order, returning the first + -- one that Def can derive from. + + while Present (Choice) loop + if Can_Derive_From (Node (Choice)) then + return Node (Choice); + end if; + + Next_Elmt (Choice); + end loop; + + -- If we can't derive from any existing type, use Long_Long_Float + -- and give appropriate message explaining the problem. + + if Digs_Val > Max_Digs_Val then + -- It might be the case that there is a type with the requested + -- range, just not the combination of digits and range. + + Error_Msg_N + ("no predefined type has requested range and precision", + Real_Range_Specification (Def)); + + else + Error_Msg_N + ("range too large for any predefined type", + Real_Range_Specification (Def)); + end if; + + return Standard_Long_Long_Float; + end Find_Base_Type; + -- Start of processing for Floating_Point_Type_Declaration begin @@ -15127,32 +15170,9 @@ package body Sem_Ch3 is end; end if; - Base_Typ := First (Predefined_Float_Types); - - while Present (Base_Typ) and then not Can_Derive_From (Base_Typ) loop - Next (Base_Typ); - end loop; - - -- If we can't derive from any existing type, use Long_Long_Float - -- and give appropriate message explaining the problem. - - if No (Base_Typ) then - Base_Typ := Standard_Long_Long_Float; - - if Digs_Val > Max_Digs_Val then - -- It might be the case that there is a type with the requested - -- range, just not the combination of digits and range. - - Error_Msg_N - ("no predefined type has requested range and precision", - Real_Range_Specification (Def)); + -- Find a suitable type to derive from or complain and use a substitute - else - Error_Msg_N - ("range too large for any predefined type", - Real_Range_Specification (Def)); - end if; - end if; + Base_Typ := Find_Base_Type; -- If there are bounds given in the declaration use them as the bounds -- of the type, otherwise use the bounds of the predefined base type diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 27264662c46..ec7c44c28c0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3865,7 +3865,8 @@ package body Sem_Prag is procedure Process_Import_Predefined_Type is Loc : constant Source_Ptr := Sloc (N); - Ftyp : Node_Id := First (Predefined_Float_Types); + Elmt : Elmt_Id := First_Elmt (Predefined_Float_Types); + Ftyp : Node_Id := Empty; Decl : Node_Id; Def : Node_Id; Nam : Name_Id; @@ -3873,10 +3874,12 @@ package body Sem_Prag is String_To_Name_Buffer (Strval (Expression (Arg3))); Nam := Name_Find; - while Present (Ftyp) and then Chars (Ftyp) /= Nam loop - Next (Ftyp); + while Present (Elmt) and then Chars (Node (Elmt)) /= Nam loop + Next_Elmt (Elmt); end loop; + Ftyp := Node (Elmt); + if Present (Ftyp) then -- Don't build a derived type declaration, because predefined C -- types have no declaration anywhere, so cannot really be named. diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index 1c93078f20c..b9dac00655d 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -343,7 +343,7 @@ 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; + Predefined_Float_Types : Elist_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 -- 2.30.2