Skip to content

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

[multiple changes] 

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
	information: no need for full scope check.
	(Eliminate_Error): Do not emit error in a generic context.

2009-04-29  Ed Falis  <falis@adacore.com>

	* adaint.c (__gnat_rmdir): return error code if VTHREADS is defined.
	VxWorks 653 POS does not support rmdir.

2009-04-29  Matteo Bordin  <bordin@adacore.com>

	* s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way
	results are printed.

From-SVN: r146943
parent 91c2cbdb
Showing with 61 additions and 70 deletions
gcc/ada/ChangeLog
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
information: no need for full scope check.
(Eliminate_Error): Do not emit error in a generic context.
2009-04-29 Ed Falis <falis@adacore.com>
* adaint.c (__gnat_rmdir): return error code if VTHREADS is defined.
VxWorks 653 POS does not support rmdir.
2009-04-29 Matteo Bordin <bordin@adacore.com>
* s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way
results are printed.
2009-04-29 Arnaud Charlet <charlet@adacore.com>
* s-taskin.adb (Initialize): Remove pragma Warnings Off and remove
......
gcc/ada/adaint.c
......@@ -747,6 +747,9 @@ __gnat_rmdir (char *path)
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _trmdir (wpath);
}
#elif defined (VTHREADS)
/* rmdir not available */
return -1;
#else
return rmdir (path);
#endif
......
gcc/ada/s-stausa.adb
......@@ -173,7 +173,7 @@ package body System.Stack_Usage is
Index_Str : constant String := "Index";
Task_Name_Str : constant String := "Task Name";
Stack_Size_Str : constant String := "Stack Size";
Actual_Size_Str : constant String := "Stack usage [Value +/- Variation]";
Actual_Size_Str : constant String := "Stack usage";
function Get_Usage_Range (Result : Task_Result) return String;
-- Return string representing the range of possible result of stack usage
......@@ -203,10 +203,10 @@ package body System.Stack_Usage is
Result_Array := new Result_Array_Type (1 .. Buffer_Size);
Result_Array.all :=
(others =>
(Task_Name => (others => ASCII.NUL),
(Task_Name => (others => ASCII.NUL),
Variation => 0,
Value => 0,
Max_Size => 0));
Value => 0,
Max_Size => 0));
-- Set the Is_Enabled flag to true, so that the task wrapper knows that
-- it has to handle dynamic stack analysis
......@@ -327,12 +327,11 @@ package body System.Stack_Usage is
-- 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.Stack_Size := My_Stack_Size;
Analyzer.Pattern_Size := Max_Pattern_Size;
Analyzer.Pattern := Pattern;
Analyzer.Result_Id := Next_Id;
Analyzer.Task_Name := (others => ' ');
-- Compute the task name, and truncate if bigger than Task_Name_Length
......@@ -415,10 +414,11 @@ package body System.Stack_Usage is
function Get_Usage_Range (Result : Task_Result) return String is
Variation_Used_Str : constant String :=
Natural'Image (Result.Variation);
Value_Used_Str : constant String := Natural'Image (Result.Value);
Natural'Image (Result.Variation);
Value_Used_Str : constant String :=
Natural'Image (Result.Value);
begin
return "[" & Value_Used_Str & " +/- " & Variation_Used_Str & "]";
return Value_Used_Str & " +/- " & Variation_Used_Str;
end Get_Usage_Range;
---------------------
......@@ -488,8 +488,8 @@ package body System.Stack_Usage is
for J in Result_Array'Range loop
exit when J >= Next_Id;
if Result_Array (J).Value
> Result_Array (Max_Actual_Use_Result_Id).Value
if Result_Array (J).Value >
Result_Array (Max_Actual_Use_Result_Id).Value
then
Max_Actual_Use_Result_Id := J;
end if;
......@@ -569,15 +569,18 @@ package body System.Stack_Usage is
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).
Min := Analyzer.Stack_Size - Overflow_Guard;
Max := Analyzer.Stack_Size;
else
Min := Stack_Size
(Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack);
Min :=
Stack_Size
(Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack);
Max := Min + Overflow_Guard;
end if;
......
gcc/ada/sem_elim.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -26,6 +26,7 @@
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Sem; use Sem;
......@@ -234,29 +235,6 @@ package body Sem_Elim is
Scop : Entity_Id;
Form : Entity_Id;
function Original_Chars (S : Entity_Id) return Name_Id;
-- If the candidate subprogram is a protected operation of a single
-- protected object, the scope of the operation is the created
-- protected type, and we have to retrieve the original name of
-- the object.
--------------------
-- Original_Chars --
--------------------
function Original_Chars (S : Entity_Id) return Name_Id is
begin
if Ekind (S) /= E_Protected_Type
or else Comes_From_Source (S)
then
return Chars (S);
else
return Chars (Defining_Identifier (Original_Node (Parent (S))));
end if;
end Original_Chars;
-- Start of processing for Check_Eliminated
begin
if No_Elimination then
return;
......@@ -308,33 +286,9 @@ package body Sem_Elim is
goto Continue;
end if;
-- Then we need to see if the static scope matches within the
-- compilation unit.
-- At the moment, gnatelim does not consider block statements as
-- scopes (even if a block is named)
-- Find enclosing unit.
Scop := Scope (E);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if Elmt.Entity_Scope /= null then
for J in reverse Elmt.Entity_Scope'Range loop
if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
goto Continue;
end if;
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if not Is_Compilation_Unit (Scop) and then J = 1 then
goto Continue;
end if;
end loop;
end if;
Scop := Cunit_Entity (Current_Sem_Unit);
-- Now see if compilation unit matches
......@@ -673,7 +627,10 @@ package body Sem_Elim is
Enclosing_Subp : Entity_Id;
begin
if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then
if Is_Eliminated (Ultimate_Subp)
and then not Inside_A_Generic
and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
then
Enclosing_Subp := Current_Subprogram;
while Present (Enclosing_Subp) loop
if Is_Eliminated (Enclosing_Subp) then
......@@ -701,9 +658,21 @@ package body Sem_Elim is
end if;
end loop;
-- Should never fall through, since entry should be in table
-- If this is an internal operation generated for a protected operation.
-- its name does not match the source name, so just report the error.
if not Comes_From_Source (E)
and then Present (First_Entity (E))
and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
then
Error_Msg_NE
("cannot reference eliminated protected subprogram", N, E);
raise Program_Error;
-- Otherwise should not fall through, entry should be in table
else
raise Program_Error;
end if;
end Eliminate_Error_Msg;
----------------
......
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