Commit f4ac86dd by Pierre-Marie de Rodat

[multiple changes]

2017-12-05  Arnaud Charlet  <charlet@adacore.com>

	* opt.ads (Expand_Nonbinary_Modular_Ops): New flag.
	* exp_ch4.adb (Expand_Nonbinary_Modular_Op): Use
	Expand_Nonbinary_Modular_Ops instead of Modify_Tree_For_C, so that
	other back-ends can also benefit from the front-end expansion. Remove
	test for Modify_Tree_For_C in all callers to better share code.
	* gnat1drv.adb (Adjust_Global_Switches): Set
	Expand_Nonbinary_Modular_Ops when generating C code.

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

	* exp_ch5.adb (Expand_Formal_Container_Loop): Ensure that the loop
	parameter becomes invisible after analyzing the loop, which has been
	rewritten as a while-loop.

2017-12-05  Doug Rupp  <rupp@adacore.com>

	* vxaddr2line.adb: Revise and enhance for new ports, remove dead ports,
	and update for 64bit ports.

From-SVN: r255410
parent 16d92641
2017-12-05 Arnaud Charlet <charlet@adacore.com>
* opt.ads (Expand_Nonbinary_Modular_Ops): New flag.
* exp_ch4.adb (Expand_Nonbinary_Modular_Op): Use
Expand_Nonbinary_Modular_Ops instead of Modify_Tree_For_C, so that
other back-ends can also benefit from the front-end expansion. Remove
test for Modify_Tree_For_C in all callers to better share code.
* gnat1drv.adb (Adjust_Global_Switches): Set
Expand_Nonbinary_Modular_Ops when generating C code.
2017-12-05 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Formal_Container_Loop): Ensure that the loop
parameter becomes invisible after analyzing the loop, which has been
rewritten as a while-loop.
2017-12-05 Doug Rupp <rupp@adacore.com>
* vxaddr2line.adb: Revise and enhance for new ports, remove dead ports,
and update for 64bit ports.
2017-12-05 Bob Duff <duff@adacore.com> 2017-12-05 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Build_In_Place_Formal): Search for the formal by suffix * exp_ch6.adb (Build_In_Place_Formal): Search for the formal by suffix
......
...@@ -4172,10 +4172,10 @@ package body Exp_Ch4 is ...@@ -4172,10 +4172,10 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Nonbinary_Modular_Op -- Start of processing for Expand_Nonbinary_Modular_Op
begin begin
-- No action needed if we are not generating C code for a nonbinary -- No action needed if front-end expansion is not required or if we
-- modular operand. -- have a binary modular operand.
if not Modify_Tree_For_C if not Expand_Nonbinary_Modular_Ops
or else not Non_Binary_Modulus (Typ) or else not Non_Binary_Modulus (Typ)
then then
return; return;
...@@ -6899,12 +6899,7 @@ package body Exp_Ch4 is ...@@ -6899,12 +6899,7 @@ package body Exp_Ch4 is
Check_Float_Op_Overflow (N); Check_Float_Op_Overflow (N);
-- When generating C code, convert nonbinary modular additions into code Expand_Nonbinary_Modular_Op (N);
-- that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Add; end Expand_N_Op_Add;
--------------------- ---------------------
...@@ -6930,12 +6925,7 @@ package body Exp_Ch4 is ...@@ -6930,12 +6925,7 @@ package body Exp_Ch4 is
Expand_Intrinsic_Call (N, Entity (N)); Expand_Intrinsic_Call (N, Entity (N));
end if; end if;
-- When generating C code, convert nonbinary modular operators into code Expand_Nonbinary_Modular_Op (N);
-- that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_And; end Expand_N_Op_And;
------------------------ ------------------------
...@@ -7178,12 +7168,7 @@ package body Exp_Ch4 is ...@@ -7178,12 +7168,7 @@ package body Exp_Ch4 is
Check_Float_Op_Overflow (N); Check_Float_Op_Overflow (N);
-- When generating C code, convert nonbinary modular divisions into code Expand_Nonbinary_Modular_Op (N);
-- that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Divide; end Expand_N_Op_Divide;
-------------------- --------------------
...@@ -8687,12 +8672,7 @@ package body Exp_Ch4 is ...@@ -8687,12 +8672,7 @@ package body Exp_Ch4 is
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
end if; end if;
-- When generating C code, convert nonbinary modular minus into code Expand_Nonbinary_Modular_Op (N);
-- that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Minus; end Expand_N_Op_Minus;
--------------------- ---------------------
...@@ -9170,12 +9150,7 @@ package body Exp_Ch4 is ...@@ -9170,12 +9150,7 @@ package body Exp_Ch4 is
Check_Float_Op_Overflow (N); Check_Float_Op_Overflow (N);
-- When generating C code, convert nonbinary modular multiplications Expand_Nonbinary_Modular_Op (N);
-- into code that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Multiply; end Expand_N_Op_Multiply;
-------------------- --------------------
...@@ -9487,12 +9462,7 @@ package body Exp_Ch4 is ...@@ -9487,12 +9462,7 @@ package body Exp_Ch4 is
Expand_Intrinsic_Call (N, Entity (N)); Expand_Intrinsic_Call (N, Entity (N));
end if; end if;
-- When generating C code, convert nonbinary modular operators into code Expand_Nonbinary_Modular_Op (N);
-- that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Or; end Expand_N_Op_Or;
---------------------- ----------------------
...@@ -9926,12 +9896,7 @@ package body Exp_Ch4 is ...@@ -9926,12 +9896,7 @@ package body Exp_Ch4 is
Check_Float_Op_Overflow (N); Check_Float_Op_Overflow (N);
-- When generating C code, convert nonbinary modular subtractions into Expand_Nonbinary_Modular_Op (N);
-- code that relies on the front-end expansion of operator Mod.
if Modify_Tree_For_C then
Expand_Nonbinary_Modular_Op (N);
end if;
end Expand_N_Op_Subtract; end Expand_N_Op_Subtract;
--------------------- ---------------------
...@@ -9955,7 +9920,6 @@ package body Exp_Ch4 is ...@@ -9955,7 +9920,6 @@ package body Exp_Ch4 is
elsif Is_Intrinsic_Subprogram (Entity (N)) then elsif Is_Intrinsic_Subprogram (Entity (N)) then
Expand_Intrinsic_Call (N, Entity (N)); Expand_Intrinsic_Call (N, Entity (N));
end if; end if;
end Expand_N_Op_Xor; end Expand_N_Op_Xor;
......
...@@ -3135,6 +3135,7 @@ package body Exp_Ch5 is ...@@ -3135,6 +3135,7 @@ package body Exp_Ch5 is
Advance : Node_Id; Advance : Node_Id;
Init_Decl : Node_Id; Init_Decl : Node_Id;
Init_Name : Entity_Id;
New_Loop : Node_Id; New_Loop : Node_Id;
begin begin
...@@ -3169,7 +3170,8 @@ package body Exp_Ch5 is ...@@ -3169,7 +3170,8 @@ package body Exp_Ch5 is
-- the loop. -- the loop.
Analyze (Init_Decl); Analyze (Init_Decl);
Set_Ekind (Defining_Identifier (Init_Decl), E_Loop_Parameter); Init_Name := Defining_Identifier (Init_Decl);
Set_Ekind (Init_Name, E_Loop_Parameter);
-- The cursor was marked as a loop parameter to prevent user assignments -- The cursor was marked as a loop parameter to prevent user assignments
-- to it, however this renders the advancement step illegal as it is not -- to it, however this renders the advancement step illegal as it is not
...@@ -3182,9 +3184,11 @@ package body Exp_Ch5 is ...@@ -3182,9 +3184,11 @@ package body Exp_Ch5 is
-- Because we have to analyze the initial declaration of the loop -- Because we have to analyze the initial declaration of the loop
-- parameter multiple times its scope is incorrectly set at this point -- parameter multiple times its scope is incorrectly set at this point
-- to the one surrounding the block statement - so set the scope -- to the one surrounding the block statement - so set the scope
-- manually to be the actual block statement. -- manually to be the actual block statement, and indicate that it is
-- not visible after the block has been analyzed.
Set_Scope (Defining_Identifier (Init_Decl), Entity (Identifier (N))); Set_Scope (Init_Name, Entity (Identifier (N)));
Set_Is_Immediately_Visible (Init_Name, False);
end Expand_Formal_Container_Loop; end Expand_Formal_Container_Loop;
------------------------------------------ ------------------------------------------
......
...@@ -167,6 +167,7 @@ procedure Gnat1drv is ...@@ -167,6 +167,7 @@ procedure Gnat1drv is
Modify_Tree_For_C := True; Modify_Tree_For_C := True;
Unnest_Subprogram_Mode := True; Unnest_Subprogram_Mode := True;
Minimize_Expression_With_Actions := True; Minimize_Expression_With_Actions := True;
Expand_Nonbinary_Modular_Ops := True;
-- Set operating mode to Generate_Code to benefit from full front-end -- Set operating mode to Generate_Code to benefit from full front-end
-- expansion (e.g. generics). -- expansion (e.g. generics).
......
...@@ -640,6 +640,10 @@ package Opt is ...@@ -640,6 +640,10 @@ package Opt is
-- Set to True to store tracebacks in exception occurrences and enable -- Set to True to store tracebacks in exception occurrences and enable
-- symbolic tracebacks (-Es). -- symbolic tracebacks (-Es).
Expand_Nonbinary_Modular_Ops : Boolean := False;
-- Set to True to convert nonbinary modular additions into code
-- that relies on the front-end expansion of operator Mod.
Extensions_Allowed : Boolean := False; Extensions_Allowed : Boolean := False;
-- GNAT -- GNAT
-- Set to True by switch -gnatX if GNAT specific language extensions -- Set to True by switch -gnatX if GNAT specific language extensions
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2002-2014, AdaCore -- -- Copyright (C) 2002-2017, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -74,7 +74,7 @@ with GNAT.Regpat; use GNAT.Regpat; ...@@ -74,7 +74,7 @@ with GNAT.Regpat; use GNAT.Regpat;
procedure VxAddr2Line is procedure VxAddr2Line is
package Unsigned_32_IO is new Modular_IO (Unsigned_32); package Unsigned_64_IO is new Modular_IO (Unsigned_64);
-- Instantiate Modular_IO to have Put -- Instantiate Modular_IO to have Put
Ref_Symbol : constant String := "adainit"; Ref_Symbol : constant String := "adainit";
...@@ -83,17 +83,20 @@ procedure VxAddr2Line is ...@@ -83,17 +83,20 @@ procedure VxAddr2Line is
-- All supported architectures -- All supported architectures
type Architecture is type Architecture is
(DEC_ALPHA, (LINUX_AARCH64,
LINUX_ARM,
LINUX_E500V2, LINUX_E500V2,
LINUX_I586, LINUX_I586,
LINUX_POWERPC, LINUX_POWERPC,
LINUX_POWERPC64,
LINUX_X86_64,
WINDOWS_AARCH64,
WINDOWS_ARM,
WINDOWS_E500V2, WINDOWS_E500V2,
WINDOWS_I586, WINDOWS_I586,
WINDOWS_M68K,
WINDOWS_POWERPC, WINDOWS_POWERPC,
SOLARIS_E500V2, WINDOWS_POWERPC64,
SOLARIS_I586, WINDOWS_X86_64);
SOLARIS_POWERPC);
type Arch_Record is record type Arch_Record is record
Addr2line_Binary : String_Access; Addr2line_Binary : String_Access;
...@@ -110,7 +113,7 @@ procedure VxAddr2Line is ...@@ -110,7 +113,7 @@ procedure VxAddr2Line is
-- which will avoid computational overflows. Typically only useful when -- which will avoid computational overflows. Typically only useful when
-- 64bit addresses are provided. -- 64bit addresses are provided.
Bt_Offset_From_Call : Unsigned_32; Bt_Offset_From_Call : Unsigned_64;
-- Offset from a backtrace address to the address of the corresponding -- Offset from a backtrace address to the address of the corresponding
-- call instruction. This should always be 0, except on platforms where -- call instruction. This should always be 0, except on platforms where
-- the backtrace addresses actually correspond to return and not call -- the backtrace addresses actually correspond to return and not call
...@@ -119,11 +122,16 @@ procedure VxAddr2Line is ...@@ -119,11 +122,16 @@ procedure VxAddr2Line is
-- Configuration for each of the architectures -- Configuration for each of the architectures
Arch_List : array (Architecture'Range) of Arch_Record := Arch_List : array (Architecture'Range) of Arch_Record :=
(DEC_ALPHA => (LINUX_AARCH64 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 8, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => 0), Bt_Offset_From_Call => -2),
LINUX_ARM =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2),
LINUX_E500V2 => LINUX_E500V2 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
...@@ -139,21 +147,26 @@ procedure VxAddr2Line is ...@@ -139,21 +147,26 @@ procedure VxAddr2Line is
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4), Bt_Offset_From_Call => -4),
SOLARIS_E500V2 => LINUX_POWERPC64 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4), Bt_Offset_From_Call => -4),
SOLARIS_I586 => LINUX_X86_64 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2), Bt_Offset_From_Call => -2),
SOLARIS_POWERPC => WINDOWS_AARCH64 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4), Bt_Offset_From_Call => -2),
WINDOWS_ARM =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2),
WINDOWS_E500V2 => WINDOWS_E500V2 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
...@@ -164,16 +177,21 @@ procedure VxAddr2Line is ...@@ -164,16 +177,21 @@ procedure VxAddr2Line is
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2), Bt_Offset_From_Call => -2),
WINDOWS_M68K => WINDOWS_POWERPC =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4), Bt_Offset_From_Call => -4),
WINDOWS_POWERPC => WINDOWS_POWERPC64 =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4),
WINDOWS_X86_64 =>
(Addr2line_Binary => null, (Addr2line_Binary => null,
Nm_Binary => null, Nm_Binary => null,
Addr_Digits_To_Skip => 0, Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4) Bt_Offset_From_Call => -2)
); );
-- Current architecture -- Current architecture
...@@ -193,14 +211,14 @@ procedure VxAddr2Line is ...@@ -193,14 +211,14 @@ procedure VxAddr2Line is
procedure Usage; procedure Usage;
-- Displays the short help message and then terminates the program -- Displays the short help message and then terminates the program
function Get_Reference_Offset return Unsigned_32; function Get_Reference_Offset return Unsigned_64;
-- Computes the static offset of the reference symbol by calling nm -- Computes the static offset of the reference symbol by calling nm
function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32; function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64;
-- Threats the argument number Arg as a C-style hexadecimal literal -- Threats the argument number Arg as a C-style hexadecimal literal
-- and returns its integer value -- and returns its integer value
function Hex_Image (Value : Unsigned_32) return String_Access; function Hex_Image (Value : Unsigned_64) return String_Access;
-- Returns access to a string that contains hexadecimal image of Value -- Returns access to a string that contains hexadecimal image of Value
-- Separate functions that provide build-time customization: -- Separate functions that provide build-time customization:
...@@ -228,16 +246,11 @@ procedure VxAddr2Line is ...@@ -228,16 +246,11 @@ procedure VxAddr2Line is
return; return;
end if; end if;
if Proc = "alpha" then -- Let's detect a Linux or Windows host.
Cur_Arch := DEC_ALPHA; if Directory_Separator = '/' then
Cur_Arch := Architecture'Value ("linux_" & Proc);
else else
-- Let's detect the host. Cur_Arch := Architecture'Value ("windows_" & Proc);
-- ??? A naive implementation that can't distinguish between Unixes
if Directory_Separator = '/' then
Cur_Arch := Architecture'Value ("solaris_" & Proc);
else
Cur_Arch := Architecture'Value ("windows_" & Proc);
end if;
end if; end if;
if Arch_List (Cur_Arch).Addr2line_Binary = null then if Arch_List (Cur_Arch).Addr2line_Binary = null then
...@@ -271,7 +284,7 @@ procedure VxAddr2Line is ...@@ -271,7 +284,7 @@ procedure VxAddr2Line is
-- Get_Reference_Offset -- -- Get_Reference_Offset --
-------------------------- --------------------------
function Get_Reference_Offset return Unsigned_32 is function Get_Reference_Offset return Unsigned_64 is
Nm_Cmd : constant String_Access := Nm_Cmd : constant String_Access :=
Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all); Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);
...@@ -306,11 +319,11 @@ procedure VxAddr2Line is ...@@ -306,11 +319,11 @@ procedure VxAddr2Line is
declare declare
Match_String : constant String := Expect_Out_Match (Pd); Match_String : constant String := Expect_Out_Match (Pd);
Matches : Match_Array (0 .. 1); Matches : Match_Array (0 .. 1);
Value : Unsigned_32; Value : Unsigned_64;
begin begin
Match (Reference, Match_String, Matches); Match (Reference, Match_String, Matches);
Value := Unsigned_32'Value Value := Unsigned_64'Value
("16#" ("16#"
& Match_String (Matches (1).First .. Matches (1).Last) & "#"); & Match_String (Matches (1).First .. Matches (1).Last) & "#");
...@@ -346,7 +359,7 @@ procedure VxAddr2Line is ...@@ -346,7 +359,7 @@ procedure VxAddr2Line is
-- Get_Value_From_Hex_Arg -- -- Get_Value_From_Hex_Arg --
---------------------------- ----------------------------
function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32 is function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64 is
Cur_Arg : constant String := Argument (Arg); Cur_Arg : constant String := Argument (Arg);
Offset : Natural; Offset : Natural;
...@@ -365,7 +378,7 @@ procedure VxAddr2Line is ...@@ -365,7 +378,7 @@ procedure VxAddr2Line is
-- Convert to value -- Convert to value
return Unsigned_32'Value return Unsigned_64'Value
("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#"); ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");
exception exception
...@@ -379,12 +392,12 @@ procedure VxAddr2Line is ...@@ -379,12 +392,12 @@ procedure VxAddr2Line is
-- Hex_Image -- -- Hex_Image --
--------------- ---------------
function Hex_Image (Value : Unsigned_32) return String_Access is function Hex_Image (Value : Unsigned_64) return String_Access is
Result : String (1 .. 20); Result : String (1 .. 20);
Start_Pos : Natural; Start_Pos : Natural;
begin begin
Unsigned_32_IO.Put (Result, Value, 16); Unsigned_64_IO.Put (Result, Value, 16);
Start_Pos := Index (Result, "16#") + 3; Start_Pos := Index (Result, "16#") + 3;
return new String'(Result (Start_Pos .. Result'Last - 1)); return new String'(Result (Start_Pos .. Result'Last - 1));
end Hex_Image; end Hex_Image;
...@@ -402,7 +415,7 @@ procedure VxAddr2Line is ...@@ -402,7 +415,7 @@ procedure VxAddr2Line is
OS_Exit (1); OS_Exit (1);
end Usage; end Usage;
Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_32; Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_64;
Addr2line_Cmd : String_Access; Addr2line_Cmd : String_Access;
......
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