Skip to content

R
riscv-gcc-1
Commit 6cbd45e4 by Pierre-Marie de Rodat
Options

[multiple changes] 

2017-12-05  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Use the SLOC of the
	iteration scheme throughout, except for the new loop statement(s).

2017-12-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Gen_Assign): Do not analyze the expressionn of the
	assignment if it is part of an Iterated_Component_Association: the
	analysis needs to take place once the loop structure is analyzed and
	the loop parameter made visible, because references to it typically
	appear in the corresponding expression.  This is necessary if the
	expression is an aggregate, because previous pre-analysis of the
	expression does not handle nested aggregates properly.

2017-12-05  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Resolve_Allocator): Avoid coextension processing for an
	allocator that is the expansion of a build-in-place function call.

2017-12-05  Olivier Hainque  <hainque@adacore.com>

libgnat/
	* s-trasym__dwarf.adb (spec of Module_Name.Get): Instead of
	possibly adjusting the lookup address by a load address, expect
	a extra argument through which the load address can be conveyed
	separately.
	(Multi_Module_Symbolic_Traceback): Adjust accordingly. Pass the
	retrieved load address to Init_Module.
	* s-tsmona__linux.adb (Get): Honor the new interface.
	* s-tsmona__mingw.adb (Get): Likewise.
	* s-dwalin.ads: Adjust comments to be explicit about which
	addresses are from module info and which are run-time addresses,
	offsetted by the module load address.
	* s-dwalin.adb (Set_Load_Address): Simply set C.Load_Slide.
	Do not alter the module Low and High (relative) addresses.
	(Is_Inside): Improve documentation regarding the kinds of addresses
	at hand and correct the test.
	(Symbolic_Traceback): Use separate variables with explicit names
	for the address in traceback (run-time value) and the address to
	lookup within the shared object (module-relative). Adjust the
	computation of address passed to Symbolic_Address for symbolization.

From-SVN: r255411
parent f4ac86dd
Showing with 172 additions and 92 deletions
gcc/ada/ChangeLog
2017-12-05 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Use the SLOC of the
iteration scheme throughout, except for the new loop statement(s).
2017-12-05 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Gen_Assign): Do not analyze the expressionn of the
assignment if it is part of an Iterated_Component_Association: the
analysis needs to take place once the loop structure is analyzed and
the loop parameter made visible, because references to it typically
appear in the corresponding expression. This is necessary if the
expression is an aggregate, because previous pre-analysis of the
expression does not handle nested aggregates properly.
2017-12-05 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Allocator): Avoid coextension processing for an
allocator that is the expansion of a build-in-place function call.
2017-12-05 Olivier Hainque <hainque@adacore.com>
libgnat/
* s-trasym__dwarf.adb (spec of Module_Name.Get): Instead of
possibly adjusting the lookup address by a load address, expect
a extra argument through which the load address can be conveyed
separately.
(Multi_Module_Symbolic_Traceback): Adjust accordingly. Pass the
retrieved load address to Init_Module.
* s-tsmona__linux.adb (Get): Honor the new interface.
* s-tsmona__mingw.adb (Get): Likewise.
* s-dwalin.ads: Adjust comments to be explicit about which
addresses are from module info and which are run-time addresses,
offsetted by the module load address.
* s-dwalin.adb (Set_Load_Address): Simply set C.Load_Slide.
Do not alter the module Low and High (relative) addresses.
(Is_Inside): Improve documentation regarding the kinds of addresses
at hand and correct the test.
(Symbolic_Traceback): Use separate variables with explicit names
for the address in traceback (run-time value) and the address to
lookup within the shared object (module-relative). Adjust the
computation of address passed to Symbolic_Address for symbolization.
2017-12-05 Arnaud Charlet <charlet@adacore.com> 2017-12-05 Arnaud Charlet <charlet@adacore.com>
* opt.ads (Expand_Nonbinary_Modular_Ops): New flag. * opt.ads (Expand_Nonbinary_Modular_Ops): New flag.
......
gcc/ada/exp_aggr.adb
...@@ -1533,7 +1533,14 @@ package body Exp_Aggr is ...@@ -1533,7 +1533,14 @@ package body Exp_Aggr is
-- the analysis of non-array aggregates now in order to get the -- the analysis of non-array aggregates now in order to get the
-- value of Expansion_Delayed flag for the inner aggregate ??? -- value of Expansion_Delayed flag for the inner aggregate ???
if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) then -- In the case of an iterated component association, the analysis
-- of the generated loop will analyze the expression in the
-- proper context, in which the loop parameter is visible.
if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ)
and then
Nkind (Parent (Expr_Q)) /= N_Iterated_Component_Association
then
Analyze_And_Resolve (Expr_Q, Comp_Typ); Analyze_And_Resolve (Expr_Q, Comp_Typ);
end if; end if;
...@@ -5366,6 +5373,10 @@ package body Exp_Aggr is ...@@ -5366,6 +5373,10 @@ package body Exp_Aggr is
Expr : Node_Id; Expr : Node_Id;
begin begin
if Nkind (Parent (Aggr)) = N_Iterated_Component_Association then
return False;
end if;
if Present (Expressions (Aggr)) then if Present (Expressions (Aggr)) then
Expr := First (Expressions (Aggr)); Expr := First (Expressions (Aggr));
while Present (Expr) loop while Present (Expr) loop
......
gcc/ada/exp_ch5.adb
...@@ -3673,7 +3673,7 @@ package body Exp_Ch5 is ...@@ -3673,7 +3673,7 @@ package body Exp_Ch5 is
Array_Typ : constant Entity_Id := Base_Type (Etype (Array_Node)); Array_Typ : constant Entity_Id := Base_Type (Etype (Array_Node));
Array_Dim : constant Pos := Number_Dimensions (Array_Typ); Array_Dim : constant Pos := Number_Dimensions (Array_Typ);
Id : constant Entity_Id := Defining_Identifier (I_Spec); Id : constant Entity_Id := Defining_Identifier (I_Spec);
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (Isc);
Stats : constant List_Id := Statements (N); Stats : constant List_Id := Statements (N);
Core_Loop : Node_Id; Core_Loop : Node_Id;
Dim1 : Int; Dim1 : Int;
...@@ -3734,7 +3734,7 @@ package body Exp_Ch5 is ...@@ -3734,7 +3734,7 @@ package body Exp_Ch5 is
end if; end if;
Core_Loop := Core_Loop :=
Make_Loop_Statement (Loc, Make_Loop_Statement (Sloc (N),
Iteration_Scheme => Iteration_Scheme =>
Make_Iteration_Scheme (Loc, Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification => Loop_Parameter_Specification =>
...@@ -3771,7 +3771,7 @@ package body Exp_Ch5 is ...@@ -3771,7 +3771,7 @@ package body Exp_Ch5 is
-- end loop; -- end loop;
Core_Loop := Core_Loop :=
Make_Loop_Statement (Loc, Make_Loop_Statement (Sloc (N),
Iteration_Scheme => Iteration_Scheme =>
Make_Iteration_Scheme (Loc, Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification => Loop_Parameter_Specification =>
......
gcc/ada/libgnat/s-dwalin.adb
...@@ -372,7 +372,8 @@ package body System.Dwarf_Lines is ...@@ -372,7 +372,8 @@ package body System.Dwarf_Lines is
function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is
begin begin
return Addr >= C.Low and Addr <= C.High; return (Addr >= To_Address (To_Integer (C.Low) + C.Load_Slide)
and Addr <= To_Address (To_Integer (C.High) + C.Load_Slide));
end Is_Inside; end Is_Inside;
--------- ---------
...@@ -771,15 +772,7 @@ package body System.Dwarf_Lines is ...@@ -771,15 +772,7 @@ package body System.Dwarf_Lines is
procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address) is procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address) is
begin begin
if Addr = Null_Address then C.Load_Slide := To_Integer (Addr);
return;
else
C.Load_Slide :=
To_Integer (Addr) - Integer_Address (Get_Load_Address (C.Obj.all));
C.Low := To_Address (To_Integer (C.Low) + C.Load_Slide);
C.High := To_Address (To_Integer (C.High) + C.Load_Slide);
end if;
end Set_Load_Address; end Set_Load_Address;
------------------ ------------------
...@@ -1523,8 +1516,10 @@ package body System.Dwarf_Lines is ...@@ -1523,8 +1516,10 @@ package body System.Dwarf_Lines is
Res : in out System.Bounded_Strings.Bounded_String) Res : in out System.Bounded_Strings.Bounded_String)
is is
use Ada.Characters.Handling; use Ada.Characters.Handling;
C : Dwarf_Context := Cin; C : Dwarf_Context := Cin;
Addr : Address;
Addr_In_Traceback : Address;
Addr_To_Lookup : Address;
Dir_Name : Str_Access; Dir_Name : Str_Access;
File_Name : Str_Access; File_Name : Str_Access;
...@@ -1543,10 +1538,14 @@ package body System.Dwarf_Lines is ...@@ -1543,10 +1538,14 @@ package body System.Dwarf_Lines is
-- If the buffer is full, no need to do any useless work -- If the buffer is full, no need to do any useless work
exit when Is_Full (Res); exit when Is_Full (Res);
Addr := PC_For (Traceback (J)); Addr_In_Traceback := PC_For (Traceback (J));
Addr_To_Lookup := To_Address
(To_Integer (Addr_In_Traceback) - C.Load_Slide);
Symbolic_Address Symbolic_Address
(C, (C,
To_Address (To_Integer (Addr) + C.Load_Slide), Addr_To_Lookup,
Dir_Name, Dir_Name,
File_Name, File_Name,
Subprg_Name, Subprg_Name,
...@@ -1608,7 +1607,7 @@ package body System.Dwarf_Lines is ...@@ -1608,7 +1607,7 @@ package body System.Dwarf_Lines is
if Suppress_Hex then if Suppress_Hex then
Append (Res, "..."); Append (Res, "...");
else else
Append_Address (Res, Addr); Append_Address (Res, Addr_In_Traceback);
end if; end if;
if Subprg_Name.Len > 0 then if Subprg_Name.Len > 0 then
......
gcc/ada/libgnat/s-dwalin.ads
...@@ -73,11 +73,11 @@ package System.Dwarf_Lines is ...@@ -73,11 +73,11 @@ package System.Dwarf_Lines is
function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean; function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean;
pragma Inline (Is_Inside); pragma Inline (Is_Inside);
-- Return true iff Addr is within the module -- Return true iff a run-time address Addr is within the module
function Low (C : Dwarf_Context) return Address; function Low (C : Dwarf_Context) return Address;
pragma Inline (Low); pragma Inline (Low);
-- Return the lowest address of C -- Return the lowest address of C, from the module object file
procedure Dump (C : in out Dwarf_Context); procedure Dump (C : in out Dwarf_Context);
-- Dump each row found in the object's .debug_lines section to standard out -- Dump each row found in the object's .debug_lines section to standard out
...@@ -165,7 +165,7 @@ private ...@@ -165,7 +165,7 @@ private
type Dwarf_Context (In_Exception : Boolean := False) is record type Dwarf_Context (In_Exception : Boolean := False) is record
Load_Slide : System.Storage_Elements.Integer_Address := 0; Load_Slide : System.Storage_Elements.Integer_Address := 0;
Low, High : Address; Low, High : Address;
-- Bounds of the module -- Bounds of the module, per the module object file
Obj : SOR.Object_File_Access; Obj : SOR.Object_File_Access;
-- The object file containing dwarf sections -- The object file containing dwarf sections
......
gcc/ada/libgnat/s-trasym__dwarf.adb
...@@ -132,10 +132,12 @@ package body System.Traceback.Symbolic is ...@@ -132,10 +132,12 @@ package body System.Traceback.Symbolic is
procedure Build_Cache_For_All_Modules; procedure Build_Cache_For_All_Modules;
-- Create the cache for all current modules -- Create the cache for all current modules
function Get (Addr : access System.Address) return String; function Get (Addr : System.Address;
-- Returns the module name for the given address, Addr may be updated Load_Addr : access System.Address) return String;
-- to be set relative to a shared library. This depends on the platform. -- Returns the module name for the given address Addr, or an empty
-- Returns an empty string for the main executable. -- string for the main executable. Load_Addr is set to the shared
-- library load address if this information is available, or to
-- System.Null_Address otherwise.
function Is_Supported return Boolean; function Is_Supported return Boolean;
pragma Inline (Is_Supported); pragma Inline (Is_Supported);
...@@ -499,12 +501,14 @@ package body System.Traceback.Symbolic is ...@@ -499,12 +501,14 @@ package body System.Traceback.Symbolic is
-- Otherwise, try a shared library -- Otherwise, try a shared library
declare declare
Addr : aliased System.Address := Traceback (F); Load_Addr : aliased System.Address;
M_Name : constant String := Module_Name.Get (Addr'Access); M_Name : constant String :=
Module_Name.Get (Addr => Traceback (F),
Load_Addr => Load_Addr'Access);
Module : Module_Cache; Module : Module_Cache;
Success : Boolean; Success : Boolean;
begin begin
Init_Module (Module, Success, M_Name, System.Null_Address); Init_Module (Module, Success, M_Name, Load_Addr);
if Success then if Success then
Multi_Module_Symbolic_Traceback Multi_Module_Symbolic_Traceback
(Traceback, (Traceback,
......
gcc/ada/libgnat/s-tsmona__linux.adb
...@@ -32,8 +32,6 @@ ...@@ -32,8 +32,6 @@
-- This is the GNU/Linux specific version of this package -- This is the GNU/Linux specific version of this package
with Interfaces.C; use Interfaces.C; with Interfaces.C; use Interfaces.C;
with System.Address_Operations; use System.Address_Operations;
separate (System.Traceback.Symbolic) separate (System.Traceback.Symbolic)
package body Module_Name is package body Module_Name is
...@@ -134,7 +132,10 @@ package body Module_Name is ...@@ -134,7 +132,10 @@ package body Module_Name is
-- Get -- -- Get --
--------- ---------
function Get (Addr : access System.Address) return String is function Get (Addr : System.Address;
Load_Addr : access System.Address)
return String
is
-- Dl_info record for Linux, used to get sym reloc offset -- Dl_info record for Linux, used to get sym reloc offset
...@@ -154,13 +155,15 @@ package body Module_Name is ...@@ -154,13 +155,15 @@ package body Module_Name is
info : aliased Dl_info; info : aliased Dl_info;
begin begin
if dladdr (Addr.all, info'Access) /= 0 then Load_Addr.all := System.Null_Address;
if dladdr (Addr, info'Access) /= 0 then
-- If we have a shared library we need to adjust the address to -- If we have a shared library we need to adjust the address to
-- be relative to the base address of the library. -- be relative to the base address of the library.
if Is_Shared_Lib (info.dli_fbase) then if Is_Shared_Lib (info.dli_fbase) then
Addr.all := SubA (Addr.all, info.dli_fbase); Load_Addr.all := info.dli_fbase;
end if; end if;
return Value (info.dli_fname); return Value (info.dli_fname);
......
gcc/ada/libgnat/s-tsmona__mingw.adb
...@@ -50,15 +50,20 @@ package body Module_Name is ...@@ -50,15 +50,20 @@ package body Module_Name is
-- Get -- -- Get --
--------- ---------
function Get (Addr : access System.Address) return String is function Get (Addr : System.Address;
Load_Addr : access System.Address)
return String
is
Res : DWORD; Res : DWORD;
hModule : aliased HANDLE; hModule : aliased HANDLE;
Path : String (1 .. 1_024); Path : String (1 .. 1_024);
begin begin
Load_Addr.all := System.Null_Address;
if GetModuleHandleEx if GetModuleHandleEx
(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
Addr.all, Addr,
hModule'Access) = Win32.TRUE hModule'Access) = Win32.TRUE
then then
Res := GetModuleFileName (hModule, Path'Address, Path'Length); Res := GetModuleFileName (hModule, Path'Address, Path'Length);
......
gcc/ada/sem_res.adb
...@@ -5116,76 +5116,91 @@ package body Sem_Res is ...@@ -5116,76 +5116,91 @@ package body Sem_Res is
-- statement. -- statement.
if Nkind (N) = N_Allocator then if Nkind (N) = N_Allocator then
-- Avoid coextension processing for an allocator that is the
-- expansion of a build-in-place function call.
if Nkind (Original_Node (N)) = N_Allocator
and then Nkind (Expression (Original_Node (N))) =
N_Qualified_Expression
and then Nkind (Expression (Expression (Original_Node (N)))) =
N_Function_Call
and then Is_Expanded_Build_In_Place_Call
(Expression (Expression (Original_Node (N))))
then
null; -- b-i-p function call case
-- An anonymous access discriminant is the definition of a else
-- coextension. -- An anonymous access discriminant is the definition of a
-- coextension.
if Ekind (Typ) = E_Anonymous_Access_Type if Ekind (Typ) = E_Anonymous_Access_Type
and then Nkind (Associated_Node_For_Itype (Typ)) = and then Nkind (Associated_Node_For_Itype (Typ)) =
N_Discriminant_Specification N_Discriminant_Specification
then then
declare declare
Discr : constant Entity_Id := Discr : constant Entity_Id :=
Defining_Identifier (Associated_Node_For_Itype (Typ)); Defining_Identifier (Associated_Node_For_Itype (Typ));
begin begin
Check_Restriction (No_Coextensions, N); Check_Restriction (No_Coextensions, N);
-- Ada 2012 AI05-0052: If the designated type of the allocator -- Ada 2012 AI05-0052: If the designated type of the
-- is limited, then the allocator shall not be used to define -- allocator is limited, then the allocator shall not
-- the value of an access discriminant unless the discriminated -- be used to define the value of an access discriminant
-- type is immutably limited. -- unless the discriminated type is immutably limited.
if Ada_Version >= Ada_2012 if Ada_Version >= Ada_2012
and then Is_Limited_Type (Desig_T) and then Is_Limited_Type (Desig_T)
and then not Is_Limited_View (Scope (Discr)) and then not Is_Limited_View (Scope (Discr))
then then
Error_Msg_N Error_Msg_N
("only immutably limited types can have anonymous " ("only immutably limited types can have anonymous "
& "access discriminants designating a limited type", N); & "access discriminants designating a limited type",
end if; N);
end; end if;
end;
-- Avoid marking an allocator as a dynamic coextension if it is -- Avoid marking an allocator as a dynamic coextension if it is
-- within a static construct. -- within a static construct.
if not Is_Static_Coextension (N) then if not Is_Static_Coextension (N) then
Set_Is_Dynamic_Coextension (N); Set_Is_Dynamic_Coextension (N);
-- ??? We currently do not handle finalization and deallocation -- ??? We currently do not handle finalization and
-- of coextensions properly so let's at least warn the user -- deallocation of coextensions properly so let's at
-- about it. -- least warn the user about it.
if Is_Controlled (Desig_T) then if Is_Controlled (Desig_T) then
Error_Msg_N Error_Msg_N
("??coextension will not be finalized when its " ("??coextension will not be finalized when its "
& "associated owner is deallocated or finalized", N); & "associated owner is deallocated or finalized", N);
else else
Error_Msg_N Error_Msg_N
("??coextension will not be deallocated when its " ("??coextension will not be deallocated when its "
& "associated owner is deallocated", N); & "associated owner is deallocated", N);
end if;
end if; end if;
end if;
-- Cleanup for potential static coextensions -- Cleanup for potential static coextensions
else else
Set_Is_Dynamic_Coextension (N, False); Set_Is_Dynamic_Coextension (N, False);
Set_Is_Static_Coextension (N, False); Set_Is_Static_Coextension (N, False);
-- ??? It seems we also do not properly finalize anonymous -- ??? It seems we also do not properly finalize anonymous
-- access-to-controlled objects within their declared scope and -- access-to-controlled objects within their declared scope and
-- instead finalize them with their associated unit. Warn the -- instead finalize them with their associated unit. Warn the
-- user about it here. -- user about it here.
if Ekind (Typ) = E_Anonymous_Access_Type if Ekind (Typ) = E_Anonymous_Access_Type
and then Is_Controlled_Active (Desig_T) and then Is_Controlled_Active (Desig_T)
then then
Error_Msg_N Error_Msg_N
("??object designated by anonymous access object might not " ("??object designated by anonymous access object might "
& "be finalized until its enclosing library unit goes out " & "not be finalized until its enclosing library unit "
& "of scope", N); & "goes out of scope", N);
Error_Msg_N ("\use named access type instead", N); Error_Msg_N ("\use named access type instead", N);
end if;
end if; end if;
end if; end if;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment