[multiple changes]

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.

From-SVN: r177144
This commit is contained in:
Arnaud Charlet 2011-08-02 15:08:34 +02:00
parent 0f1af8814b
commit 70c34e1c94
9 changed files with 135 additions and 59 deletions

View File

@ -1,3 +1,28 @@
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

View File

@ -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;

View File

@ -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)

View File

@ -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 --
------------------------

View File

@ -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

View File

@ -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

View File

@ -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);
-- Find a suitable type to derive from or complain and use a substitute
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));
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

View File

@ -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.

View File

@ -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