Skip to content

R
riscv-gcc-1
Commit 15d8a51d by Arnaud Charlet
Options

[multiple changes] 

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb, exp_ch7.adb, exp_util.adb, bindgen.adb, sem_prag.adb,
	s-tassta.adb, exp_ch4.adb, exp_disp.adb, s-stausa.adb: Minor
	reformatting.

2011-08-04  Arnaud Charlet  <charlet@adacore.com>

	* make.adb (Linking_Phase): Set source search path before calling
	gnatlink in CodePeer mode.

From-SVN: r177388
parent f46faa08
Showing with 110 additions and 74 deletions
gcc/ada/ChangeLog
2011-08-04 Robert Dewar <dewar@adacore.com>
* exp_ch5.adb, exp_ch7.adb, exp_util.adb, bindgen.adb, sem_prag.adb,
s-tassta.adb, exp_ch4.adb, exp_disp.adb, s-stausa.adb: Minor
reformatting.
2011-08-04 Arnaud Charlet <charlet@adacore.com>
* make.adb (Linking_Phase): Set source search path before calling
gnatlink in CodePeer mode.
2011-08-04 Javier Miranda <miranda@adacore.com>
* exp_ch7.adb (Expand_N_Package_Body, Expand_N_Package_Declaration):
......
gcc/ada/bindgen.adb
-----------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
......@@ -467,8 +467,8 @@ package body Bindgen is
end if;
-- Pragma Import C cannot be used on virtual machine targets, therefore
-- call the runtime finalization routine directly.
-- Similarly in CodePeer mode, where imported functions are ignored.
-- call the runtime finalization routine directly. Similarly in CodePeer
-- mode, where imported functions are ignored.
else
WBI (" System.Standard_Library.Adafinal;");
......@@ -1406,6 +1406,7 @@ package body Bindgen is
procedure Gen_Elab_Calls_Ada is
Check_Elab_Flag : Boolean;
begin
for E in Elab_Order.First .. Elab_Order.Last loop
declare
......@@ -1478,9 +1479,9 @@ package body Bindgen is
elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then
Check_Elab_Flag :=
not CodePeer_Mode
and then (Force_Checking_Of_Elaboration_Flags
or Interface_Library_Unit
or not Bind_Main_Program);
and then (Force_Checking_Of_Elaboration_Flags
or Interface_Library_Unit
or not Bind_Main_Program);
if Check_Elab_Flag then
Set_String (" if E");
......@@ -2179,6 +2180,7 @@ package body Bindgen is
Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
-- Strip trailing "%b"
begin
if ALIs.Table (ALIs.First).Main_Program = Proc then
WBI (" procedure " & CodePeer_Wrapper_Name & " is ");
......@@ -2277,6 +2279,7 @@ package body Bindgen is
if ALIs.Table (ALIs.First).Main_Program = Func then
WBI (" Result : Integer;");
end if;
else
-- To call the main program, we declare it using a pragma Import
-- Ada with the right link name.
......@@ -2330,7 +2333,7 @@ package body Bindgen is
-- with a pragma Volatile in order to tell the compiler to preserve
-- this variable at any level of optimization.
if Bind_Main_Program and then not CodePeer_Mode then
if Bind_Main_Program and not CodePeer_Mode then
WBI
(" Ensure_Reference : aliased System.Address := " &
"Ada_Main_Program_Name'Address;");
......@@ -3312,8 +3315,8 @@ package body Bindgen is
Gen_Adainit_Ada;
if Bind_Main_Program and then VM_Target = No_VM then
-- For CodePeer, declare a wrapper for the
-- user-defined main program.
-- For CodePeer, declare a wrapper for the user-defined main program
if CodePeer_Mode then
Gen_CodePeer_Wrapper;
......
gcc/ada/exp_ch4.adb
......@@ -659,8 +659,7 @@ package body Exp_Ch4 is
Attribute_Name => Name_Tag);
if Tagged_Type_Expansion then
New_Node :=
Build_Get_Access_Level (Loc, New_Node);
New_Node := Build_Get_Access_Level (Loc, New_Node);
elsif VM_Target /= No_VM then
New_Node :=
......
gcc/ada/exp_ch5.adb
......@@ -2462,7 +2462,6 @@ package body Exp_Ch5 is
and then Nkind (Alt) = N_Case_Statement_Alternative
loop
Process_Statements_For_Controlled_Objects (Alt);
Next (Alt);
end loop;
end;
......
gcc/ada/exp_ch7.adb
......@@ -3936,8 +3936,8 @@ package body Exp_Ch7 is
if Tagged_Type_Expansion
and then (Is_Compilation_Unit (Id)
or else (Is_Generic_Instance (Id)
and then Is_Library_Level_Entity (Id)))
or else (Is_Generic_Instance (Id)
and then Is_Library_Level_Entity (Id)))
then
Build_Static_Dispatch_Tables (N);
end if;
......
gcc/ada/exp_disp.adb
......@@ -6649,7 +6649,7 @@ package body Exp_Disp is
Name => New_Reference_To (RTE (RE_Check_TSD), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (TSD, Loc),
Prefix => New_Reference_To (TSD, Loc),
Attribute_Name => Name_Unrestricted_Access))));
end if;
......@@ -6661,7 +6661,7 @@ package body Exp_Disp is
Name => New_Reference_To (RTE (RE_Register_TSD), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (TSD, Loc),
Prefix => New_Reference_To (TSD, Loc),
Attribute_Name => Name_Unrestricted_Access))));
-- Populate the two auxiliary tables used for dispatching asynchronous,
......
gcc/ada/exp_util.adb
......@@ -5468,7 +5468,6 @@ package body Exp_Util is
function Are_Wrapped (L : List_Id) return Boolean is
Stmt : constant Node_Id := First (L);
begin
return
Present (Stmt)
......@@ -5494,15 +5493,14 @@ package body Exp_Util is
begin
case Nkind (N) is
when N_Elsif_Part |
N_If_Statement |
N_Conditional_Entry_Call |
N_Selective_Accept =>
when N_Elsif_Part |
N_If_Statement |
N_Conditional_Entry_Call |
N_Selective_Accept =>
-- Check the "then statements" for elsif parts and if statements
if Nkind_In (N, N_Elsif_Part,
N_If_Statement)
if Nkind_In (N, N_Elsif_Part, N_If_Statement)
and then not Is_Empty_List (Then_Statements (N))
and then not Are_Wrapped (Then_Statements (N))
and then Requires_Cleanup_Actions
......
gcc/ada/make.adb
......@@ -4357,16 +4357,16 @@ package body Make is
end if;
end;
end if;
end if;
-- Put the object directories in ADA_OBJECTS_PATH
-- Ditto for source directories in ADA_INCLUDE_PATH in CodePeer mode
Prj.Env.Set_Ada_Paths
(Main_Project,
Project_Tree,
Including_Libraries => False,
Include_Path => False);
Include_Path => CodePeer_Mode);
-- Check for attributes Linker'Linker_Options in projects other than
-- the main project
......@@ -4581,7 +4581,6 @@ package body Make is
new String'("-F=" & Get_Name_String (Mapping_Path));
end if;
end if;
end if;
begin
......
gcc/ada/s-stausa.adb
......@@ -129,8 +129,8 @@ package body System.Stack_Usage is
Result_Array := new Result_Array_Type (1 .. Buffer_Size);
Result_Array.all :=
(others =>
(Task_Name => (others => ASCII.NUL),
Value => 0,
(Task_Name => (others => ASCII.NUL),
Value => 0,
Stack_Size => 0));
-- Set the Is_Enabled flag to true, so that the task wrapper knows that
......@@ -176,6 +176,7 @@ package body System.Stack_Usage is
----------------
procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
-- Change the local variables and parameters of this function with
-- super-extra care. The more the stack frame size of this function is
-- big, the more an "instrumentation threshold at writing" error is
......@@ -188,21 +189,23 @@ package body System.Stack_Usage is
-- allocated byte on the stack.
begin
if Parameters.Stack_Grows_Down then
if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size)
> To_Stack_Address (Current_Stack_Level'Address) - Guard
if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) >
To_Stack_Address (Current_Stack_Level'Address) - Guard
then
-- No room for a pattern
Analyzer.Pattern_Size := 0;
return;
end if;
Analyzer.Pattern_Limit := Analyzer.Stack_Base
- Stack_Address (Analyzer.Pattern_Size);
Analyzer.Pattern_Limit :=
Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size);
if Analyzer.Stack_Base >
To_Stack_Address (Current_Stack_Level'Address) - Guard
To_Stack_Address (Current_Stack_Level'Address) - Guard
then
-- Reduce pattern size to prevent local frame overwrite
Analyzer.Pattern_Size :=
Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard
- Analyzer.Pattern_Limit);
......@@ -211,35 +214,39 @@ package body System.Stack_Usage is
Analyzer.Pattern_Overlay_Address :=
To_Address (Analyzer.Pattern_Limit);
else
if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size)
< To_Stack_Address (Current_Stack_Level'Address) + Guard
if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) <
To_Stack_Address (Current_Stack_Level'Address) + Guard
then
-- No room for a pattern
Analyzer.Pattern_Size := 0;
return;
end if;
Analyzer.Pattern_Limit := Analyzer.Stack_Base
+ Stack_Address (Analyzer.Pattern_Size);
Analyzer.Pattern_Limit :=
Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size);
if Analyzer.Stack_Base <
To_Stack_Address (Current_Stack_Level'Address) + Guard
then
-- Reduce pattern size to prevent local frame overwrite
Analyzer.Pattern_Size := Integer
(Analyzer.Pattern_Limit
- (To_Stack_Address (Current_Stack_Level'Address) + Guard));
Analyzer.Pattern_Size :=
Integer
(Analyzer.Pattern_Limit -
(To_Stack_Address (Current_Stack_Level'Address) + Guard));
end if;
Analyzer.Pattern_Overlay_Address :=
To_Address (Analyzer.Pattern_Limit
- Stack_Address (Analyzer.Pattern_Size));
To_Address (Analyzer.Pattern_Limit -
Stack_Address (Analyzer.Pattern_Size));
end if;
-- Declare and fill the pattern buffer
declare
Pattern : aliased Stack_Slots
(1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
(1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
for Pattern'Address use Analyzer.Pattern_Overlay_Address;
begin
......@@ -247,6 +254,7 @@ package body System.Stack_Usage is
for J in reverse Pattern'Range loop
Pattern (J) := Analyzer.Pattern;
end loop;
else
for J in Pattern'Range loop
Pattern (J) := Analyzer.Pattern;
......@@ -284,7 +292,7 @@ package body System.Stack_Usage is
else
Analyzer.Task_Name :=
Task_Name (Task_Name'First ..
Task_Name'First + Task_Name_Length - 1);
Task_Name'First + Task_Name_Length - 1);
end if;
Next_Id := Next_Id + 1;
......@@ -322,6 +330,7 @@ package body System.Stack_Usage is
begin
-- Value if the pattern was not modified
if Parameters.Stack_Grows_Down then
Analyzer.Topmost_Touched_Mark :=
Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size);
......@@ -341,8 +350,8 @@ package body System.Stack_Usage is
if System.Parameters.Stack_Grows_Down then
for J in Stack'Range loop
if Stack (J) /= Analyzer.Pattern then
Analyzer.Topmost_Touched_Mark
:= To_Stack_Address (Stack (J)'Address);
Analyzer.Topmost_Touched_Mark :=
To_Stack_Address (Stack (J)'Address);
exit;
end if;
end loop;
......@@ -350,8 +359,8 @@ package body System.Stack_Usage is
else
for J in reverse Stack'Range loop
if Stack (J) /= Analyzer.Pattern then
Analyzer.Topmost_Touched_Mark
:= To_Stack_Address (Stack (J)'Address);
Analyzer.Topmost_Touched_Mark :=
To_Stack_Address (Stack (J)'Address);
exit;
end if;
end loop;
......@@ -407,8 +416,9 @@ package body System.Stack_Usage is
Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0;
Task_Name_Blanks : constant
String (1 .. Task_Name_Length - Task_Name_Str'Length) :=
(others => ' ');
String
(1 .. Task_Name_Length - Task_Name_Str'Length) :=
(others => ' ');
begin
Set_Output (Standard_Error);
......@@ -444,12 +454,14 @@ package body System.Stack_Usage is
declare
Stack_Size_Blanks : constant
String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) :=
(others => ' ');
String (1 .. Max_Stack_Size_Len -
Stack_Size_Str'Length) :=
(others => ' ');
Stack_Usage_Blanks : constant
String (1 .. Max_Actual_Use_Len - Actual_Size_Str'Length) :=
(others => ' ');
String (1 .. Max_Actual_Use_Len -
Actual_Size_Str'Length) :=
(others => ' ');
begin
if Stack_Size_Str'Length > Max_Stack_Size_Len then
......@@ -491,14 +503,14 @@ package body System.Stack_Usage is
-------------------
procedure Report_Result (Analyzer : Stack_Analyzer) is
Result : Task_Result := (Task_Name => Analyzer.Task_Name,
Stack_Size => Analyzer.Stack_Size,
Value => 0);
Result : Task_Result := (Task_Name => Analyzer.Task_Name,
Stack_Size => Analyzer.Stack_Size,
Value => 0);
begin
if Analyzer.Pattern_Size = 0 then
-- If we have that result, it means that we didn't do any computation
-- at all. In other words, we used at least everything (and possibly
-- more).
-- at all (i.e. we used at least everything (and possibly more).
Result.Value := Analyzer.Stack_Size;
......
gcc/ada/s-tassta.adb
......@@ -1115,7 +1115,7 @@ package body System.Tasking.Stages is
if System.Stack_Usage.Is_Enabled then
declare
Guard_Page_Size : constant := 12 * 1024;
Guard_Page_Size : constant := 12 * 1024;
-- Part of the stack used as a guard page. This is an OS dependent
-- value, so we need to use the maximum. This value is only used
-- when the stack address is known, that is currently Windows.
......@@ -1125,9 +1125,9 @@ package body System.Tasking.Stages is
-- smaller values resulted in segmentation faults from dynamic
-- stack analysis.
Big_Overflow_Guard : constant := 16 * 1024;
Small_Stack_Limit : constant := 64 * 1024;
-- ??? These three values are experimental, and seems to work on
Big_Overflow_Guard : constant := 16 * 1024;
Small_Stack_Limit : constant := 64 * 1024;
-- ??? These three values are experimental, and seem to work on
-- most platforms. They still need to be analyzed further. They
-- also need documentation, what are they???
......@@ -1137,22 +1137,27 @@ package body System.Tasking.Stages is
Stack_Base : Address;
-- Address of the base of the stack
begin
Stack_Base := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base;
if Stack_Base = Null_Address then
-- On many platforms, we don't know the real stack base
-- address. Estimate it using an address in the frame.
Stack_Base := Bottom_Of_Stack'Address;
-- Also reduce the size of the stack to take into account the
-- secondary stack array declared in this frame. This is for
-- sure very conservative.
if not Parameters.Sec_Stack_Dynamic then
Pattern_Size :=
Pattern_Size - Natural (Secondary_Stack_Size);
end if;
-- Adjustments for inner frames
Pattern_Size := Pattern_Size -
(if Pattern_Size < Small_Stack_Limit
then Small_Overflow_Guard
......
gcc/ada/sem_prag.adb
......@@ -426,7 +426,9 @@ package body Sem_Prag is
-- Checks that the given argument has an identifier, and if so, requires
-- it to match one of the given identifier names. If there is no
-- identifier, or a non-matching identifier, then an error message is
-- given and Pragma_Exit is raised.
-- given and Pragma_Exit is raised. ??? why is this needed, why isnt
-- Check_Arg_Is_One_Of good enough. At the very least explain this
-- odd apparent redundancy
procedure Check_In_Main_Program;
-- Common checks for pragmas that appear within a main program
......@@ -6843,9 +6845,9 @@ package body Sem_Prag is
-- Check --
-----------
-- pragma Check ([Name =>] Identifier,
-- [Check =>] Boolean_Expression
-- [,[Message =>] String_Expression]);
-- pragma Check ([Name =>] IDENTIFIER,
-- [Check =>] Boolean_EXPRESSION
-- [,[Message =>] String_EXPRESSION]);
when Pragma_Check => Check : declare
Expr : Node_Id;
......@@ -11527,8 +11529,8 @@ package body Sem_Prag is
-- Postcondition --
-------------------
-- pragma Postcondition ([Check =>] Boolean_Expression
-- [,[Message =>] String_Expression]);
-- pragma Postcondition ([Check =>] Boolean_EXPRESSION
-- [,[Message =>] String_EXPRESSION]);
when Pragma_Postcondition => Postcondition : declare
In_Body : Boolean;
......@@ -11550,8 +11552,8 @@ package body Sem_Prag is
-- Precondition --
------------------
-- pragma Precondition ([Check =>] Boolean_Expression
-- [,[Message =>] String_Expression]);
-- pragma Precondition ([Check =>] Boolean_EXPRESSION
-- [,[Message =>] String_EXPRESSION]);
when Pragma_Precondition => Precondition : declare
In_Body : Boolean;
......@@ -13262,10 +13264,14 @@ package body Sem_Prag is
-- Test_Case --
---------------
-- pragma Test_Case ([Name =>] String_Expression
-- pragma Test_Case ([Name =>] String_EXPRESSION
-- ,[Mode =>] (Normal | Robustness)
-- [, Requires => Boolean_Expression]
-- [, Ensures => Boolean_Expression]);
-- [, Requires => Boolean_EXPRESSION]
-- [, Ensures => Boolean_EXPRESSION]);
-- ??? Why is Name not static_string_EXPRESSION??? Seems very
-- weird to require it to be a string literal, and if we DO want
-- that restriction the grammar should make this clear.
when Pragma_Test_Case => Test_Case : declare
......@@ -13280,10 +13286,14 @@ package body Sem_Prag is
Check_Arg_Is_String_Literal (Arg1);
Check_Optional_Identifier (Arg2, Name_Mode);
Check_Arg_Is_One_Of (Arg2, Name_Normal, Name_Robustness);
if Arg_Count = 4 then
Check_Identifier (Arg3, Name_Requires);
Check_Identifier (Arg4, Name_Ensures);
else
-- ??? why not Check_Arg_Is_One_Of, very odd!!! At the very
-- least needs an explanation!
Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
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