+2011-08-02 Javier Miranda <miranda@adacore.com>
+
+ * exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine
+ in CodePeer mode.
+
+2011-08-02 Geert Bosch <bosch@adacore.com>
+
+ * 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 <dewar@adacore.com>
+
+ * 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 <dismukes@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Don't append the private
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;
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.
------------------------
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;
-------------------------------
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;
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
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
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;
----------------------
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;
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)
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 --
--------------------------
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 --
------------------------
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
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
return False;
end Might_Inline_Subp;
- Save_Style_Check : constant Boolean := Style_Check;
-
-- Start of processing for Analyze_Package_Instantiation
begin
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
end if;
end Analyze_Instance_And_Renamings;
- Save_Style_Check : constant Boolean := Style_Check;
-
-- Start of processing for Analyze_Subprogram_Instantiation
begin
-- 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 --
---------------------
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
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
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;
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.
-- 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