Skip to content

R
riscv-gcc-1
Commit e57ab550 by Arnaud Charlet
Options

[multiple changes] 

2010-10-18  Vincent Celier  <celier@adacore.com>

	* prj.ads (Source_Data): New Boolean flag In_The_Queue.

2010-10-18  Tristan Gingold  <gingold@adacore.com>

	* s-stausa.ads: Add the Top parameter to Initialize_Analyzer.
	* s-stausa.adb: Use the top parameter.  In Fill_Stack, use the
	stack top if known.
	* s-tassta.adb (Task_Wrapper): Call Initialize_Analyzer after Enter_Task
	so that Pri_Stack_Info.Limit can be set and used.

2010-10-18  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Minor reformatting.
	* sem_res.adb (Resolve_Allocator): Add test for violating
	No_Anonymous_Allocators.

From-SVN: r165624
parent 468ee96a
Showing with 145 additions and 79 deletions
gcc/ada/ChangeLog
2010-10-18 Vincent Celier <celier@adacore.com>
* prj.ads (Source_Data): New Boolean flag In_The_Queue.
2010-10-18 Tristan Gingold <gingold@adacore.com>
* s-stausa.ads: Add the Top parameter to Initialize_Analyzer.
* s-stausa.adb: Use the top parameter. In Fill_Stack, use the
stack top if known.
* s-tassta.adb (Task_Wrapper): Call Initialize_Analyzer after Enter_Task
so that Pri_Stack_Info.Limit can be set and used.
2010-10-18 Robert Dewar <dewar@adacore.com>
* einfo.ads: Minor reformatting.
* sem_res.adb (Resolve_Allocator): Add test for violating
No_Anonymous_Allocators.
2010-10-18 Robert Dewar <dewar@adacore.com>
* prj-nmsc.adb, prj.adb, sem_res.adb: Minor reformatting.
......
gcc/ada/einfo.ads
......@@ -3778,15 +3778,14 @@ package Einfo is
-- E_Access_Subtype is for an access subtype created by a subtype
-- declaration.
-- In addition, we define the kind E_Allocator_Type to label
-- allocators. This is because special resolution rules apply to this
-- construct. Eventually the constructs are labeled with the access
-- type imposed by the context. Gigi should never see the type
-- E_Allocator.
-- Similarly, the type E_Access_Attribute_Type is used as the initial
-- kind associated with an access attribute. After resolution a specific
-- access type will be established as determined by the context.
-- In addition, we define the kind E_Allocator_Type to label allocators.
-- This is because special resolution rules apply to this construct.
-- Eventually the constructs are labeled with the access type imposed by
-- the context. Gigi should never see the type E_Allocator.
-- Similarly, the type E_Access_Attribute_Type is used as the initial kind
-- associated with an access attribute. After resolution a specific access
-- type will be established as determined by the context.
-- Finally, the type Any_Access is used to label -null- during type
-- resolution. Any_Access is also replaced by the context type after
......
gcc/ada/prj.ads
......@@ -710,6 +710,9 @@ package Prj is
-- Updated at the first call to Is_Compilable. Yes if source file is
-- compilable.
In_The_Queue : Boolean := False;
-- True if the source has been put in the queue
Locally_Removed : Boolean := False;
-- True if the source has been "excluded"
......@@ -793,6 +796,7 @@ package Prj is
Index => 0,
Locally_Removed => False,
Compilable => Unknown,
In_The_Queue => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
......
gcc/ada/s-stausa.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -232,7 +232,8 @@ package body System.Stack_Usage is
"ENVIRONMENT TASK",
My_Stack_Size,
My_Stack_Size,
System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address),
0);
Fill_Stack (Environment_Task_Analyzer);
......@@ -259,56 +260,90 @@ package body System.Stack_Usage is
Stack_Used_When_Filling : Integer;
Current_Stack_Level : aliased Integer;
Guard : constant Integer := 256;
-- Guard space between the Current_Stack_Level'Address and the last
-- allocated byte on the stack.
begin
-- Readjust the pattern size. When we arrive in this function, there is
-- already a given amount of stack used, that we won't analyze.
if Analyzer.Top_Pattern_Mark /= 0 then
-- Easiest and most accurate method: the top of the stack is known.
Stack_Used_When_Filling :=
Stack_Size
(Analyzer.Bottom_Of_Stack,
To_Stack_Address (Current_Stack_Level'Address))
+ Natural (Current_Stack_Level'Size);
Analyzer.Pattern_Size :=
Stack_Size (Analyzer.Top_Pattern_Mark,
To_Stack_Address (Current_Stack_Level'Address))
- Guard;
if Stack_Used_When_Filling > Analyzer.Pattern_Size then
-- In this case, the known size of the stack is too small, we've
-- already taken more than expected, so there's no possible
-- computation
if System.Parameters.Stack_Grows_Down then
Analyzer.Stack_Overlay_Address :=
To_Address (Analyzer.Top_Pattern_Mark);
else
Analyzer.Stack_Overlay_Address :=
To_Address (Analyzer.Top_Pattern_Mark
- Stack_Address (Analyzer.Pattern_Size));
end if;
Analyzer.Pattern_Size := 0;
else
Analyzer.Pattern_Size :=
Analyzer.Pattern_Size - Stack_Used_When_Filling;
end if;
declare
Pattern : aliased Stack_Slots
(1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
for Pattern'Address use Analyzer.Stack_Overlay_Address;
begin
if System.Parameters.Stack_Grows_Down then
for I in reverse Pattern'Range loop
Pattern (I) := Analyzer.Pattern;
end loop;
Analyzer.Bottom_Pattern_Mark :=
To_Stack_Address (Pattern (Pattern'Last)'Address);
else
for I in Pattern'Range loop
Pattern (I) := Analyzer.Pattern;
end loop;
Analyzer.Bottom_Pattern_Mark :=
To_Stack_Address (Pattern (Pattern'First)'Address);
end if;
end;
declare
Stack : aliased Stack_Slots
(1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
else
-- Readjust the pattern size. When we arrive in this function, there
-- is already a given amount of stack used, that we won't analyze.
begin
Stack := (others => Analyzer.Pattern);
Stack_Used_When_Filling :=
Stack_Size (Analyzer.Bottom_Of_Stack,
To_Stack_Address (Current_Stack_Level'Address));
Analyzer.Stack_Overlay_Address := Stack'Address;
if Stack_Used_When_Filling > Analyzer.Pattern_Size then
-- In this case, the known size of the stack is too small, we've
-- already taken more than expected, so there's no possible
-- computation
if Analyzer.Pattern_Size /= 0 then
Analyzer.Bottom_Pattern_Mark :=
To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address);
Analyzer.Top_Pattern_Mark :=
To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address);
Analyzer.Pattern_Size := 0;
else
Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address);
Analyzer.Top_Pattern_Mark := To_Stack_Address (Stack'Address);
Analyzer.Pattern_Size :=
Analyzer.Pattern_Size - Stack_Used_When_Filling;
end if;
-- If Arr has been packed, the following assertion must be true (we
-- add the size of the element whose address is:
-- Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
declare
Stack : aliased Stack_Slots
(1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
pragma Assert
(Analyzer.Pattern_Size = 0 or else
Analyzer.Pattern_Size =
Stack_Size
(Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
end;
begin
Stack := (others => Analyzer.Pattern);
Analyzer.Stack_Overlay_Address := Stack'Address;
if Analyzer.Pattern_Size /= 0 then
Analyzer.Bottom_Pattern_Mark :=
To_Stack_Address
(Stack (Bottom_Slot_Index_In (Stack))'Address);
Analyzer.Top_Pattern_Mark :=
To_Stack_Address
(Stack (Top_Slot_Index_In (Stack))'Address);
else
Analyzer.Bottom_Pattern_Mark :=
To_Stack_Address (Stack'Address);
Analyzer.Top_Pattern_Mark :=
To_Stack_Address (Stack'Address);
end if;
end;
end if;
end Fill_Stack;
-------------------------
......@@ -321,17 +356,19 @@ package body System.Stack_Usage is
My_Stack_Size : Natural;
Max_Pattern_Size : Natural;
Bottom : Stack_Address;
Top : Stack_Address;
Pattern : Unsigned_32 := 16#DEAD_BEEF#)
is
begin
-- Initialize the analyzer fields
Analyzer.Bottom_Of_Stack := Bottom;
Analyzer.Stack_Size := My_Stack_Size;
Analyzer.Pattern_Size := Max_Pattern_Size;
Analyzer.Pattern := Pattern;
Analyzer.Result_Id := Next_Id;
Analyzer.Task_Name := (others => ' ');
Analyzer.Bottom_Of_Stack := Bottom;
Analyzer.Stack_Size := My_Stack_Size;
Analyzer.Pattern_Size := Max_Pattern_Size;
Analyzer.Pattern := Pattern;
Analyzer.Result_Id := Next_Id;
Analyzer.Task_Name := (others => ' ');
Analyzer.Top_Pattern_Mark := Top;
-- Compute the task name, and truncate if bigger than Task_Name_Length
......
gcc/ada/s-stausa.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -218,10 +218,11 @@ package System.Stack_Usage is
-- | of Fill_Stack | |
-- | (deallocated at | |
-- | the end of the call) | |
-- ^ | |
-- Analyzer.Bottom_Of_Stack ^ |
-- Analyzer.Bottom_Pattern_Mark ^
-- Analyzer.Top_Pattern_Mark
-- ^ | ^
-- Analyzer.Bottom_Of_Stack | Analyzer.Top_Pattern_Mark
-- ^
-- Analyzer.Bottom_Pattern_Mark
--
procedure Initialize_Analyzer
(Analyzer : in out Stack_Analyzer;
......@@ -229,6 +230,7 @@ package System.Stack_Usage is
My_Stack_Size : Natural;
Max_Pattern_Size : Natural;
Bottom : Stack_Address;
Top : Stack_Address;
Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
-- Should be called before any use of a Stack_Analyzer, to initialize it.
-- Max_Pattern_Size is the size of the pattern zone, might be smaller than
......
gcc/ada/s-tassta.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -1093,11 +1093,6 @@ package body System.Tasking.Stages is
-- Assume a size of the stack taken at this stage
Overflow_Guard :=
(if Size < Small_Stack_Limit
then Small_Overflow_Guard
else Big_Overflow_Guard);
if not Parameters.Sec_Stack_Dynamic then
Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
Secondary_Stack'Address;
......@@ -1109,9 +1104,24 @@ package body System.Tasking.Stages is
Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address;
end if;
Size := Size - Overflow_Guard;
-- Set the guard page at the bottom of the stack. The call to unprotect
-- the page is done in Terminate_Task
Stack_Guard (Self_ID, True);
-- Initialize low-level TCB components, that cannot be initialized by
-- the creator. Enter_Task sets Self_ID.LL.Thread
Enter_Task (Self_ID);
-- Initialize dynamic stack usage
if System.Stack_Usage.Is_Enabled then
Overflow_Guard :=
(if Size < Small_Stack_Limit
then Small_Overflow_Guard
else Big_Overflow_Guard);
STPO.Lock_RTS;
Initialize_Analyzer
(Self_ID.Common.Analyzer,
......@@ -1119,22 +1129,14 @@ package body System.Tasking.Stages is
(1 .. Self_ID.Common.Task_Image_Len),
Natural
(Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size),
Size,
SSE.To_Integer (Bottom_Of_Stack'Address));
Size - Overflow_Guard,
SSE.To_Integer (Bottom_Of_Stack'Address),
SSE.To_Integer
(Self_ID.Common.Compiler_Data.Pri_Stack_Info.Limit));
STPO.Unlock_RTS;
Fill_Stack (Self_ID.Common.Analyzer);
end if;
-- Set the guard page at the bottom of the stack. The call to unprotect
-- the page is done in Terminate_Task
Stack_Guard (Self_ID, True);
-- Initialize low-level TCB components, that cannot be initialized by
-- the creator. Enter_Task sets Self_ID.LL.Thread
Enter_Task (Self_ID);
-- We setup the SEH (Structured Exception Handling) handler if supported
-- on the target.
......
gcc/ada/sem_res.adb
......@@ -4324,6 +4324,10 @@ package body Sem_Res is
(Typ, Associated_Storage_Pool (Etype (Parent (N))));
end if;
if Ekind (Etype (N)) = E_Anonymous_Access_Type then
Check_Restriction (No_Anonymous_Allocators, N);
end if;
-- An erroneous allocator may be rewritten as a raise Program_Error
-- statement.
......
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