OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finmas.adb (Set_Finalize_Address): Explain the reason
	for the synchronization. Move the test for null from
	s-stposu.Allocate_Any_Controlled to this routine since the check
	needs to be protected too.
	(Set_Heterogeneous_Finalize_Address): Explain the reason for the
	synchronization code.
	* s-finmas.ads (Set_Heterogeneous_Finalize_Address): Add comment
	explaining the context in which this routine is used.
	* s-stposu.adb (Allocate_Any_Controlled): Move the test for null
	to s-finmas.Set_Finalize_Address.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads: Document that itypes have no parent field.

2011-09-05  Robert Dewar  <dewar@adacore.com>

	* rtsfind.adb (Check_CRT): Check for overloaded entity
	* rtsfind.ads: Document that entities to be found by rtsfind
	cannot be overloaded
	* s-taenca.adb, s-tasren.adb, s-tpobop.adb, s-tpoben.ads, s-tpoben.adb
	(Lock_Entries_With_Status): New name for Lock_Entries with two
	arguments (changed to meet rtsfind no overloading rule).

From-SVN: r178551
This commit is contained in:
Arnaud Charlet 2011-09-05 16:30:30 +02:00
parent 544e7c17b5
commit e42bcfa38c
12 changed files with 102 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
* s-finmas.adb (Set_Finalize_Address): Explain the reason
for the synchronization. Move the test for null from
s-stposu.Allocate_Any_Controlled to this routine since the check
needs to be protected too.
(Set_Heterogeneous_Finalize_Address): Explain the reason for the
synchronization code.
* s-finmas.ads (Set_Heterogeneous_Finalize_Address): Add comment
explaining the context in which this routine is used.
* s-stposu.adb (Allocate_Any_Controlled): Move the test for null
to s-finmas.Set_Finalize_Address.
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* einfo.ads: Document that itypes have no parent field.
2011-09-05 Robert Dewar <dewar@adacore.com>
* rtsfind.adb (Check_CRT): Check for overloaded entity
* rtsfind.ads: Document that entities to be found by rtsfind
cannot be overloaded
* s-taenca.adb, s-tasren.adb, s-tpobop.adb, s-tpoben.ads, s-tpoben.adb
(Lock_Entries_With_Status): New name for Lock_Entries with two
arguments (changed to meet rtsfind no overloading rule).
2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
* s-finmas.adb (Set_Finalize_Address (Address,

5
gcc/ada/einfo.ads
View File

@ -442,6 +442,11 @@ package Einfo is
-- declaration, the associated_node_for_itype is the discriminant
-- specification. For an access parameter it is the enclosing subprogram
-- declaration.
--
-- Itypes have no explicit declaration, and therefore are not attached to
-- the tree: their Parent field is always empty. The Associated_Node_For_
-- Itype is the only way to determine the construct that leads to the
-- creation of a given itype entity.
-- Associated_Storage_Pool (Node22) [root type only]
-- Present in simple and general access type entities. References the

22
gcc/ada/rtsfind.adb
View File

@ -135,7 +135,7 @@ package body Rtsfind is
-- Check entity Eid to ensure that configurable run-time restrictions are
-- met. May generate an error message (if RTE_Available_Call is false) and
-- raise RE_Not_Available if entity E does not exist (e.g. Eid is Empty).
-- Above documentation not clear ???
-- Also check that entity is not overloaded.
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the run-time
@ -233,6 +233,22 @@ package body Rtsfind is
raise RE_Not_Available;
end if;
-- Check entity is not overloaded, checking for special exceptions
if Has_Homonym (Eid)
and then E /= RE_Save_Occurrence
then
Set_Standard_Error;
Write_Str ("Run-time configuration error (");
Write_Str ("rtsfind entity """);
Get_Decoded_Name_String (Chars (Eid));
Set_Casing (Mixed_Case);
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Str (""" is overloaded)");
Write_Eol;
raise Unrecoverable_Error;
end if;
-- Otherwise entity is accessible
return Eid;
@ -414,8 +430,8 @@ package body Rtsfind is
return E1 = E2;
end if;
-- If the unit containing E is not loaded, we already know that
-- the entity we have cannot have come from this unit.
-- If the unit containing E is not loaded, we already know that the
-- entity we have cannot have come from this unit.
E_Unit_Name := Get_Unit_Name (RE_Unit_Table (E));

8
gcc/ada/rtsfind.ads
View File

@ -498,6 +498,14 @@ package Rtsfind is
-- value is required syntactically, but no real entry is required or
-- needed. Use of this value will cause a fatal error in an RTE call.
-- Note that under no circumstances can any of these entities be defined
-- more than once in a given package, i.e. no overloading is allowed for
-- any entity that is found using rtsfind. A fatal error is given if this
-- rule is violated. The one exception is for Save_Occurrence, where the
-- RM mandates the overloading. In this case, the compiler only uses the
-- procedure, not the function, and the procedure must come first so that
-- the compiler finds it and not the function.
type RE_Id is (
RE_Null,

14
gcc/ada/s-finmas.adb
View File

@ -463,8 +463,17 @@ package body System.Finalization_Masters is
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
-- TSS primitive Finalize_Address is set at the point of allocation,
-- either through Allocate_Any_Controlled or through this routine.
-- Since multiple tasks can allocate on the same finalization master,
-- access to this attribute must be protected.
Lock_Task.all;
Master.Finalize_Address := Fin_Addr_Ptr;
if Master.Finalize_Address = null then
Master.Finalize_Address := Fin_Addr_Ptr;
end if;
Unlock_Task.all;
end Set_Finalize_Address;
@ -477,6 +486,9 @@ package body System.Finalization_Masters is
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
-- Protected access is required in this case because
-- Finalize_Address_Table is a global data structure.
Lock_Task.all;
Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
Unlock_Task.all;

5
gcc/ada/s-finmas.ads
View File

@ -124,7 +124,10 @@ package System.Finalization_Masters is
procedure Set_Heterogeneous_Finalize_Address
(Obj : System.Address;
Fin_Addr_Ptr : Finalize_Address_Ptr);
-- Add a relation pair object - Finalize_Address to the internal hash table
-- Add a relation pair object - Finalize_Address to the internal hash
-- table. This is done in the context of allocation on a heterogeneous
-- finalization master where a single master services multiple anonymous
-- access-to-controlled types.
procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
-- Mark the master as being a heterogeneous collection of objects

4
gcc/ada/s-stposu.adb
View File

@ -276,9 +276,7 @@ package body System.Storage_Pools.Subpools is
-- 3) Most cases of anonymous access types usage
if Master.Is_Homogeneous then
if Finalize_Address (Master.all) = null then
Set_Finalize_Address (Master.all, Fin_Address);
end if;
Set_Finalize_Address (Master.all, Fin_Address);
-- Heterogeneous masters service the following:

4
gcc/ada/s-taenca.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -216,7 +216,7 @@ package body System.Tasking.Entry_Calls is
STPO.Unlock_RTS;
end if;
Lock_Entries (Test_PO, Ceiling_Violation);
Lock_Entries_With_Status (Test_PO, Ceiling_Violation);
-- ???

2
gcc/ada/s-tasren.adb
View File

@ -628,7 +628,7 @@ package body System.Tasking.Rendezvous is
-- Requeue to a protected entry
Called_PO := POE.To_Protection (Entry_Call.Called_PO);
STPE.Lock_Entries (Called_PO, Ceiling_Violation);
STPE.Lock_Entries_With_Status (Called_PO, Ceiling_Violation);
if Ceiling_Violation then
pragma Assert (Ex = Ada.Exceptions.Null_Id);

33
gcc/ada/s-tpoben.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2011, 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- --
@ -261,7 +261,22 @@ package body System.Tasking.Protected_Objects.Entries is
-- Lock_Entries --
------------------
procedure Lock_Entries
procedure Lock_Entries (Object : Protection_Entries_Access) is
Ceiling_Violation : Boolean;
begin
Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
end if;
end Lock_Entries;
------------------------------
-- Lock_Entries_With_Status --
------------------------------
procedure Lock_Entries_With_Status
(Object : Protection_Entries_Access;
Ceiling_Violation : out Boolean)
is
@ -316,19 +331,7 @@ package body System.Tasking.Protected_Objects.Entries is
Self_Id.Common.Protected_Action_Nesting + 1;
end;
end if;
end Lock_Entries;
procedure Lock_Entries (Object : Protection_Entries_Access) is
Ceiling_Violation : Boolean;
begin
Lock_Entries (Object, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
end if;
end Lock_Entries;
end Lock_Entries_With_Status;
----------------------------
-- Lock_Read_Only_Entries --

4
gcc/ada/s-tpoben.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -183,7 +183,7 @@ package System.Tasking.Protected_Objects.Entries is
-- Unlock has been made by the caller. Program_Error is raised in case of
-- ceiling violation.
procedure Lock_Entries
procedure Lock_Entries_With_Status
(Object : Protection_Entries_Access;
Ceiling_Violation : out Boolean);
-- Same as above, but return the ceiling violation status instead of

6
gcc/ada/s-tpobop.adb
View File

@ -568,7 +568,7 @@ package body System.Tasking.Protected_Objects.Operations is
-- where abort is already deferred.
Initialization.Defer_Abort_Nestable (Self_ID);
Lock_Entries (Object, Ceiling_Violation);
Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
@ -722,7 +722,7 @@ package body System.Tasking.Protected_Objects.Operations is
-- Requeue is to different PO
Lock_Entries (New_Object, Ceiling_Violation);
Lock_Entries_With_Status (New_Object, Ceiling_Violation);
if Ceiling_Violation then
Object.Call_In_Progress := null;
@ -966,7 +966,7 @@ package body System.Tasking.Protected_Objects.Operations is
end if;
Initialization.Defer_Abort_Nestable (Self_Id);
Lock_Entries (Object, Ceiling_Violation);
Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
Initialization.Undefer_Abort (Self_Id);