[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:
parent
0f1af8814b
commit
70c34e1c94
9 changed files with 135 additions and 59 deletions
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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 --
|
||||
------------------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue