* 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).
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178551
138bc75d-0d04-0410-961f-
82ee72b054a4
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,
Finalize_Address_Ptr)): Renamed to Set_Heterogeneous_Finalize_Address.
(Set_Finalize_Address (in out Finalization_Master,
-- 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
-- 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
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;
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));
-- 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,
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;
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;
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
-- 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:
-- --
-- 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- --
STPO.Unlock_RTS;
end if;
- Lock_Entries (Test_PO, Ceiling_Violation);
+ Lock_Entries_With_Status (Test_PO, Ceiling_Violation);
-- ???
-- 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);
-- --
-- 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- --
-- 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
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 --
-- --
-- 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- --
-- 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
-- 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
-- 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;
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);
projects / platform / upstream / linaro-gcc.git / commitdiff