+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):
------------------------------------------------------------------------------
+------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
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;");
procedure Gen_Elab_Calls_Ada is
Check_Elab_Flag : Boolean;
+
begin
for E in Elab_Order.First .. Elab_Order.Last loop
declare
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");
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 ");
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.
-- 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;");
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;
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 :=
and then Nkind (Alt) = N_Case_Statement_Alternative
loop
Process_Statements_For_Controlled_Objects (Alt);
-
Next (Alt);
end loop;
end;
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;
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;
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,
function Are_Wrapped (L : List_Id) return Boolean is
Stmt : constant Node_Id := First (L);
-
begin
return
Present (Stmt)
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
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
new String'("-F=" & Get_Name_String (Mapping_Path));
end if;
end if;
-
end if;
begin
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
----------------
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
-- 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);
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
for J in reverse Pattern'Range loop
Pattern (J) := Analyzer.Pattern;
end loop;
+
else
for J in Pattern'Range loop
Pattern (J) := Analyzer.Pattern;
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;
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);
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;
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;
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);
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
-------------------
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;
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.
-- 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???
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
-- 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
-- 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;
-- 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;
-- 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;
-- 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
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;
projects / gcc.git / commitdiff