[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:
parent
544e7c17b5
commit
e42bcfa38c
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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));
|
||||
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
-- ???
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue