Skip to content

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

[multiple changes] 

2012-10-29  Tristan Gingold  <gingold@adacore.com>

	* gnat_rm.texi: Document implementation advice for Pragma
	Partition_Elaboration_Policy.

2012-10-29  Yannick Moy  <moy@adacore.com>

	* s-bignum.adb (Div_Rem): Reference that Algorithm_D is from
	the second edition of TAOCP from Knuth, since the algo changed
	in the third edition. Also correct the definition of 'd' which
	could overflow.

2012-10-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Initialization_Call): Create static strings
	which denote entry [family] names and associate them with the
	object's Protection_Entries or ATCB.
	(Build_Init_Statements):
	Remove local variable Names. Do not generate the entry [family]
	names inside the init proc because they are now static.
	* exp_ch9.adb (Build_Entry_Names): Reimplemented. The strings
	which denote entry [family] names are now generated statically
	and associated with the concurrent object's Protection_Entries
	or ATCB during initialization.
	* exp_ch9.ads (Build_Entry_Names): Change subprogram profile
	and associated comment on usage.
	* rtsfind.ads: Add the following entries to tables RE_Id and
	RE_Unit_Table:

	RE_Protected_Entry_Names_Array RE_Task_Entry_Names_Array
	RO_PE_Number_Of_Entries RO_PE_Set_Entry_Names
	RO_ST_Number_Of_Entries RO_ST_Set_Entry_Names

	Remove the following entries from tables RE_Id and RE_Unit_Table:

	RO_PE_Set_Entry_Name RO_TS_Set_Entry_Name

	* s-taskin.adb: Remove with clause for Ada.Unchecked_Deallocation.
	(Free_Entry_Names_Array): Removed.
	(Number_Of_Entries): New routine.
	(Set_Entry_Names): New routine.
	* s-taskin.ads: Rename type Entry_Names_Array to
	Task_Entry_Names_Array. Rename type Entry_Names_Array_Access
	to Task_Entry_Names_Access. Update the type of ACTB field
	Entry_Names and add a comment on its protection status.
	(Free_Entry_Names_Array): Removed.
	(Number_Of_Entries): New routine.
	(Set_Entry_Names): New routine.
	* s-tassta.adb (Create_Task): Remove formal parameter
	Build_Entry_Names. Do not allocate an array to hold the
	string names of entries and families.
	(Free_Entry_Names): Removed.
	(Free_Task): Remove the call to Free_Entry_Names.
	(Set_Entry_Name): Removed.
	(Vulnerable_Free_Task): Remove the call to Free_Entry_Names.
	* s-tassta.ads (Create_Task): Remove formal parameter
	Build_Entry_Names along with associated comment.
	(Set_Entry_Name): Removed.
	* s-tpoben.adb: Remove with clause for Ada.Unchecked_Deallocation.
	(Finalize): Remove the call to Free_Entry_Names.
	(Free_Entry_Names): Removed.
	(Initialize_Protection_Entries):
	Remove formal parameter Build_Entry_Names. Do not allocate
	an array to hold the string names of entries and families.
	(Number_Of_Entries): New routine.
	(Set_Entry_Name): Removed.
	(Set_Entry_Names): New routine.
	* s-tpoben.ads: Add types Protected_Entry_Names_Array and
	Protected_Entry_Names_Access. Update the type of Protection_Enties
	field Entry_Names.
	(Initialize_Protection_Entries): Remove
	formal parameter Build_Entry_Names along with associated comment.
	(Number_Of_Entries): New routine.
	(Set_Entry_Name): Removed.
	(Set_Entry_Names): New routine.

2012-10-29  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi: Minor typo fix.

From-SVN: r192933
parent 8d9ef58e
Showing with 230 additions and 200 deletions
gcc/ada/ChangeLog
2012-10-29 Tristan Gingold <gingold@adacore.com>
* gnat_rm.texi: Document implementation advice for Pragma
Partition_Elaboration_Policy.
2012-10-29 Yannick Moy <moy@adacore.com>
* s-bignum.adb (Div_Rem): Reference that Algorithm_D is from
the second edition of TAOCP from Knuth, since the algo changed
in the third edition. Also correct the definition of 'd' which
could overflow.
2012-10-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_Initialization_Call): Create static strings
which denote entry [family] names and associate them with the
object's Protection_Entries or ATCB.
(Build_Init_Statements):
Remove local variable Names. Do not generate the entry [family]
names inside the init proc because they are now static.
* exp_ch9.adb (Build_Entry_Names): Reimplemented. The strings
which denote entry [family] names are now generated statically
and associated with the concurrent object's Protection_Entries
or ATCB during initialization.
* exp_ch9.ads (Build_Entry_Names): Change subprogram profile
and associated comment on usage.
* rtsfind.ads: Add the following entries to tables RE_Id and
RE_Unit_Table:
RE_Protected_Entry_Names_Array RE_Task_Entry_Names_Array
RO_PE_Number_Of_Entries RO_PE_Set_Entry_Names
RO_ST_Number_Of_Entries RO_ST_Set_Entry_Names
Remove the following entries from tables RE_Id and RE_Unit_Table:
RO_PE_Set_Entry_Name RO_TS_Set_Entry_Name
* s-taskin.adb: Remove with clause for Ada.Unchecked_Deallocation.
(Free_Entry_Names_Array): Removed.
(Number_Of_Entries): New routine.
(Set_Entry_Names): New routine.
* s-taskin.ads: Rename type Entry_Names_Array to
Task_Entry_Names_Array. Rename type Entry_Names_Array_Access
to Task_Entry_Names_Access. Update the type of ACTB field
Entry_Names and add a comment on its protection status.
(Free_Entry_Names_Array): Removed.
(Number_Of_Entries): New routine.
(Set_Entry_Names): New routine.
* s-tassta.adb (Create_Task): Remove formal parameter
Build_Entry_Names. Do not allocate an array to hold the
string names of entries and families.
(Free_Entry_Names): Removed.
(Free_Task): Remove the call to Free_Entry_Names.
(Set_Entry_Name): Removed.
(Vulnerable_Free_Task): Remove the call to Free_Entry_Names.
* s-tassta.ads (Create_Task): Remove formal parameter
Build_Entry_Names along with associated comment.
(Set_Entry_Name): Removed.
* s-tpoben.adb: Remove with clause for Ada.Unchecked_Deallocation.
(Finalize): Remove the call to Free_Entry_Names.
(Free_Entry_Names): Removed.
(Initialize_Protection_Entries):
Remove formal parameter Build_Entry_Names. Do not allocate
an array to hold the string names of entries and families.
(Number_Of_Entries): New routine.
(Set_Entry_Name): Removed.
(Set_Entry_Names): New routine.
* s-tpoben.ads: Add types Protected_Entry_Names_Array and
Protected_Entry_Names_Access. Update the type of Protection_Enties
field Entry_Names.
(Initialize_Protection_Entries): Remove
formal parameter Build_Entry_Names along with associated comment.
(Number_Of_Entries): New routine.
(Set_Entry_Name): Removed.
(Set_Entry_Names): New routine.
2012-10-29 Arnaud Charlet <charlet@adacore.com>
* gnat_ugn.texi: Minor typo fix.
2012-10-29 Yannick Moy <moy@adacore.com>
* debug.adb Associate debug switch -gnatd.V to extensions for
......
gcc/ada/exp_ch3.adb
......@@ -1704,6 +1704,18 @@ package body Exp_Ch3 is
end if;
end if;
-- When the object is either protected or a task, create static strings
-- which denote the names of entries and families. Associate the strings
-- with the concurrent object's Protection_Entries or ATCB. This is a
-- VMS Debug feature.
if OpenVMS_On_Target
and then Is_Concurrent_Type (Typ)
and then Entry_Names_OK
then
Build_Entry_Names (Id_Ref, Typ, Res);
end if;
return Res;
exception
......@@ -2665,7 +2677,6 @@ package body Exp_Ch3 is
Decl : Node_Id;
Has_POC : Boolean;
Id : Entity_Id;
Names : Node_Id;
Stmts : List_Id;
Typ : Entity_Id;
......@@ -3009,17 +3020,6 @@ package body Exp_Ch3 is
Append_To (Stmts, Make_Task_Create_Call (Rec_Type));
-- Generate the statements which map a string entry name to a
-- task entry index. Note that the task may not have entries.
if Entry_Names_OK then
Names := Build_Entry_Names (Rec_Type);
if Present (Names) then
Append_To (Stmts, Names);
end if;
end if;
declare
Task_Type : constant Entity_Id :=
Corresponding_Concurrent_Type (Rec_Type);
......@@ -3073,18 +3073,6 @@ package body Exp_Ch3 is
if Is_Protected_Record_Type (Rec_Type) then
Append_List_To (Stmts,
Make_Initialize_Protection (Rec_Type));
-- Generate the statements which map a string entry name to a
-- protected entry index. Note that the protected type may not
-- have entries.
if Entry_Names_OK then
Names := Build_Entry_Names (Rec_Type);
if Present (Names) then
Append_To (Stmts, Names);
end if;
end if;
end if;
-- Second pass: components with per-object constraints
......
gcc/ada/exp_ch9.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -55,10 +55,15 @@ package Exp_Ch9 is
-- interface, ensure that the designated type has a _master and generate
-- a renaming of the said master to service the access type.
function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
-- Create the statements which populate the entry names array of a task or
-- protected type. The statements are wrapped inside a block due to a local
-- declaration.
procedure Build_Entry_Names
(Obj_Ref : Node_Id;
Obj_Typ : Entity_Id;
Stmts : List_Id);
-- Given a concurrent object, create static string names for all entries
-- and entry families. Associate each name with the Protection_Entries or
-- ATCB field of the object. Obj_Ref is a reference to the concurrent
-- object. Obj_Typ is the type of the object. Stmts is the list where all
-- generated code is attached.
procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id);
-- Given the name of an object or a type which is either a task, contains
......
gcc/ada/gnat_rm.texi
......@@ -9422,6 +9422,18 @@ accuracy in some portions of the domain.
@end cartouche
Followed.
@cindex Sequential elaboration policy
@unnumberedsec H.6(15/2): Pragma Partition_Elaboration_Policy
@sp 1
@cartouche
If the partition elaboration policy is @code{Sequential} and the
Environment task becomes permanently blocked during elaboration then the
partition is deadlocked and it is recommended that the partition be
immediately terminated.
@end cartouche
Not followed.
@c -----------------------------------------
@node Implementation Defined Characteristics
@chapter Implementation Defined Characteristics
......
gcc/ada/gnat_ugn.texi
......@@ -19150,7 +19150,7 @@ only.
@item -fada-spec-parent=@var{unit}
@cindex -fada-spec-parent (@command{gcc})
Specifies that all files generated by @option{-fdump-ada-spec-slim} are
Specifies that all files generated by @option{-fdump-ada-spec*} are
to be child units of the specified parent unit.
@item -C
gcc/ada/rtsfind.ads
......@@ -1502,6 +1502,9 @@ package Rtsfind is
RE_Unspecified_Task_Info, -- System.Task_Info
RE_Task_Procedure_Access, -- System.Tasking
RE_Task_Entry_Names_Array, -- System.Tasking
RO_ST_Number_Of_Entries, -- System.Tasking
RO_ST_Set_Entry_Names, -- System.Tasking
RO_ST_Task_Id, -- System.Tasking
RO_ST_Null_Task, -- System.Tasking
......@@ -1687,14 +1690,16 @@ package Rtsfind is
RE_Dispatching_Domain, -- Dispatching_Domains
RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries
RE_Protected_Entry_Names_Array, -- Tasking.Protected_Objects.Entries
RE_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Protection_Entries_Access, -- Tasking.Protected_Objects.Entries
RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Entries, -- Tasking.Protected_Objects.Entries
RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Number_Of_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Entry_Name, -- Tasking.Protected_Objects.Entries
RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Entry_Names, -- Tasking.Protected_Objects.Entries
RE_Communication_Block, -- Protected_Objects.Operations
RE_Protected_Entry_Call, -- Protected_Objects.Operations
......@@ -1769,7 +1774,6 @@ package Rtsfind is
RE_Free_Task, -- System.Tasking.Stages
RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages
RE_Move_Activation_Chain, -- System_Tasking_Stages
RO_TS_Set_Entry_Name, -- System.Tasking.Stages
RE_Terminated); -- System.Tasking.Stages
-- The following declarations build a table that is indexed by the RTE
......@@ -2749,6 +2753,9 @@ package Rtsfind is
RE_Unspecified_Task_Info => System_Task_Info,
RE_Task_Procedure_Access => System_Tasking,
RE_Task_Entry_Names_Array => System_Tasking,
RO_ST_Number_Of_Entries => System_Tasking,
RO_ST_Set_Entry_Names => System_Tasking,
RO_ST_Task_Id => System_Tasking,
RO_ST_Null_Task => System_Tasking,
......@@ -2937,6 +2944,8 @@ package Rtsfind is
RE_Protected_Entry_Body_Array =>
System_Tasking_Protected_Objects_Entries,
RE_Protected_Entry_Names_Array =>
System_Tasking_Protected_Objects_Entries,
RE_Protection_Entries =>
System_Tasking_Protected_Objects_Entries,
RE_Protection_Entries_Access =>
......@@ -2945,13 +2954,15 @@ package Rtsfind is
System_Tasking_Protected_Objects_Entries,
RE_Lock_Entries =>
System_Tasking_Protected_Objects_Entries,
RE_Unlock_Entries =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Get_Ceiling =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Ceiling =>
RO_PE_Number_Of_Entries =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Entry_Name =>
RO_PE_Set_Ceiling =>
System_Tasking_Protected_Objects_Entries,
RE_Unlock_Entries =>
RO_PE_Set_Entry_Names =>
System_Tasking_Protected_Objects_Entries,
RE_Communication_Block =>
......@@ -3054,7 +3065,6 @@ package Rtsfind is
RE_Free_Task => System_Tasking_Stages,
RE_Expunge_Unactivated_Tasks => System_Tasking_Stages,
RE_Move_Activation_Chain => System_Tasking_Stages,
RO_TS_Set_Entry_Name => System_Tasking_Stages,
RE_Terminated => System_Tasking_Stages);
--------------------------------
......
gcc/ada/s-bignum.adb
......@@ -728,8 +728,9 @@ package body System.Bignums is
-- The complex full multi-precision case. We will employ algorithm
-- D defined in the section "The Classical Algorithms" (sec. 4.3.1)
-- of Donald Knuth's "The Art of Computer Programming", Vol. 2. The
-- terminology is adjusted for this section to match that reference.
-- of Donald Knuth's "The Art of Computer Programming", Vol. 2, 2nd
-- edition. The terminology is adjusted for this section to match that
-- reference.
-- We are dividing X.Len digits of X (called u here) by Y.Len digits
-- of Y (called v here), developing the quotient and remainder. The
......@@ -775,12 +776,12 @@ package body System.Bignums is
v (J) := Y.D (J);
end loop;
-- [Division of nonnegative integers]. Given nonnegative integers u
-- [Division of nonnegative integers.] Given nonnegative integers u
-- = (ul,u2..um+n) and v = (v1,v2..vn), where v1 /= 0 and n > 1, we
-- form the quotient u / v = (q0,ql..qm) and the remainder u mod v =
-- (r1,r2..rn).
pragma Assert (v (1) /= 0);
pragma Assert (v1 /= 0);
pragma Assert (n > 1);
-- Dl. [Normalize.] Set d = b/(vl + 1). Then set (u0,u1,u2..um+n)
......@@ -789,7 +790,7 @@ package body System.Bignums is
-- u0 at the left of u1; if d = 1 all we need to do in this step is
-- to set u0 = 0.
d := b / DD (v1 + 1);
d := b / (DD (v1) + 1);
if d = 1 then
u0 := 0;
......@@ -826,15 +827,15 @@ package body System.Bignums is
-- D2. [Initialize j.] Set j = 0. The loop on j, steps D2 through D7,
-- will be essentially a division of (uj, uj+1..uj+n) by (v1,v2..vn)
-- to get a single quotient digit qj;
-- to get a single quotient digit qj.
j := 0;
-- Loop through digits
loop
-- D3. [Calculate qhat] If uj = v1, set qhat to b-l; otherwise set
-- qhat to (uj,uj+1)/v1.
-- D3. [Calculate qhat.] If uj = v1, set qhat to b-l; otherwise
-- set qhat to (uj,uj+1)/v1.
if u (j) = v1 then
qhat := -1;
......
gcc/ada/s-taskin.adb
......@@ -33,8 +33,6 @@ pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with Ada.Unchecked_Deallocation;
with System.Task_Primitives.Operations;
with System.Storage_Elements;
......@@ -42,19 +40,6 @@ package body System.Tasking is
package STPO renames System.Task_Primitives.Operations;
----------------------------
-- Free_Entry_Names_Array --
----------------------------
procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array) is
procedure Free_String is new
Ada.Unchecked_Deallocation (String, String_Access);
begin
for Index in Obj'Range loop
Free_String (Obj (Index));
end loop;
end Free_Entry_Names_Array;
---------------------
-- Detect_Blocking --
---------------------
......@@ -70,6 +55,15 @@ package body System.Tasking is
return GL_Detect_Blocking = 1;
end Detect_Blocking;
-----------------------
-- Number_Of_Entries --
-----------------------
function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index is
begin
return Self_Id.Entry_Num;
end Number_Of_Entries;
----------
-- Self --
----------
......@@ -257,4 +251,16 @@ package body System.Tasking is
T.Entry_Calls (1).Self := T;
end Initialize;
---------------------
-- Set_Entry_Names --
---------------------
procedure Set_Entry_Names
(Self_Id : Task_Id;
Names : Task_Entry_Names_Access)
is
begin
Self_Id.Entry_Names := Names;
end Set_Entry_Names;
end System.Tasking;
gcc/ada/s-taskin.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -252,13 +252,10 @@ package System.Tasking is
type String_Access is access all String;
type Entry_Names_Array is
array (Entry_Index range <>) of String_Access;
type Task_Entry_Names_Array is
array (Task_Entry_Index range <>) of String_Access;
type Entry_Names_Array_Access is access all Entry_Names_Array;
procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array);
-- Deallocate all string names contained in an entry names array
type Task_Entry_Names_Access is access all Task_Entry_Names_Array;
----------------------------------
-- Entry_Call_Record definition --
......@@ -968,10 +965,13 @@ package System.Tasking is
-- associated with protected objects or task entries, and are protected
-- by the protected object lock or Acceptor.L, respectively.
Entry_Names : Entry_Names_Array_Access := null;
Entry_Names : Task_Entry_Names_Access := null;
-- An array of string names which denotes entry [family member] names.
-- The structure is indexed by task entry index and contains Entry_Num
-- components.
--
-- Protection: The array is populated during task initialization, before
-- the task has been activated. No protection is required in this case.
New_Base_Priority : System.Any_Priority;
-- New value for Base_Priority (for dynamic priorities package)
......@@ -1203,4 +1203,13 @@ private
-- registered for removal (Expunge_Unactivated_Tasks). The "limited" forces
-- Activation_Chain to be a by-reference type; see RM-6.2(4).
function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index;
-- Given a task, return the number of entries it contains
procedure Set_Entry_Names
(Self_Id : Task_Id;
Names : Task_Entry_Names_Access);
-- Associate an array of string that denote entry [family] names with a
-- task.
end System.Tasking;
gcc/ada/s-tassta.adb
......@@ -91,9 +91,6 @@ package body System.Tasking.Stages is
procedure Free is new
Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
procedure Free_Entry_Names (T : Task_Id);
-- Deallocate all string names associated with task entries
procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id);
-- This procedure outputs the task specific message for exception
-- tracing purposes.
......@@ -487,8 +484,7 @@ package body System.Tasking.Stages is
Elaborated : Access_Boolean;
Chain : in out Activation_Chain;
Task_Image : String;
Created_Task : out Task_Id;
Build_Entry_Names : Boolean)
Created_Task : out Task_Id)
is
T, P : Task_Id;
Self_ID : constant Task_Id := STPO.Self;
......@@ -706,14 +702,6 @@ package body System.Tasking.Stages is
Dispatching_Domain_Tasks (Base_CPU) + 1;
end if;
-- Note: we should not call 'new' while holding locks since new may use
-- locks (e.g. RTS_Lock under Windows) itself and cause a deadlock.
if Build_Entry_Names then
T.Entry_Names :=
new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
end if;
-- Create TSD as early as possible in the creation of a task, since it
-- may be used by the operation of Ada code within the task.
......@@ -942,26 +930,6 @@ package body System.Tasking.Stages is
end Finalize_Global_Tasks;
----------------------
-- Free_Entry_Names --
----------------------
procedure Free_Entry_Names (T : Task_Id) is
Names : Entry_Names_Array_Access := T.Entry_Names;
procedure Free_Entry_Names_Array_Access is new
Ada.Unchecked_Deallocation
(Entry_Names_Array, Entry_Names_Array_Access);
begin
if Names = null then
return;
end if;
Free_Entry_Names_Array (Names.all);
Free_Entry_Names_Array_Access (Names);
end Free_Entry_Names;
---------------
-- Free_Task --
---------------
......@@ -983,7 +951,6 @@ package body System.Tasking.Stages is
Initialization.Task_Unlock (Self_Id);
Free_Entry_Names (T);
System.Task_Primitives.Operations.Finalize_TCB (T);
else
......@@ -1041,23 +1008,6 @@ package body System.Tasking.Stages is
Initialization.Undefer_Abort (Self_ID);
end Move_Activation_Chain;
-- Compiler interface only. Do not call from within the RTS
--------------------
-- Set_Entry_Name --
--------------------
procedure Set_Entry_Name
(T : Task_Id;
Pos : Task_Entry_Index;
Val : String_Access)
is
begin
pragma Assert (T.Entry_Names /= null);
T.Entry_Names (Entry_Index (Pos)) := Val;
end Set_Entry_Name;
------------------
-- Task_Wrapper --
------------------
......@@ -2119,7 +2069,6 @@ package body System.Tasking.Stages is
Unlock_RTS;
end if;
Free_Entry_Names (T);
System.Task_Primitives.Operations.Finalize_TCB (T);
end Vulnerable_Free_Task;
......
gcc/ada/s-tassta.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -180,8 +180,7 @@ package System.Tasking.Stages is
Elaborated : Access_Boolean;
Chain : in out Activation_Chain;
Task_Image : String;
Created_Task : out Task_Id;
Build_Entry_Names : Boolean);
Created_Task : out Task_Id);
-- Compiler interface only. Do not call from within the RTS.
-- This must be called to create a new task.
--
......@@ -212,8 +211,6 @@ package System.Tasking.Stages is
-- run time can store to ease the debugging and the
-- Ada.Task_Identification facility.
-- Created_Task is the resulting task.
-- Build_Entry_Names is a flag which controls the allocation of the data
-- structure which stores all entry names.
--
-- This procedure can raise Storage_Error if the task creation failed.
......@@ -285,13 +282,6 @@ package System.Tasking.Stages is
-- that doesn't happen, they will never be activated, and will become
-- terminated on leaving the return statement.
procedure Set_Entry_Name
(T : Task_Id;
Pos : Task_Entry_Index;
Val : String_Access);
-- This is called by the compiler to map a string which denotes an entry
-- name to a task entry index.
function Terminated (T : Task_Id) return Boolean;
-- This is called by the compiler to implement the 'Terminated attribute.
-- Though is not required to be so by the ARM, we choose to synchronize
......
gcc/ada/s-tpoben.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2012, 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- --
......@@ -41,8 +41,6 @@
-- Note: the compiler generates direct calls to this interface, via Rtsfind
with Ada.Unchecked_Deallocation;
with System.Task_Primitives.Operations;
with System.Restrictions;
with System.Parameters;
......@@ -58,13 +56,6 @@ package body System.Tasking.Protected_Objects.Entries is
use Parameters;
use Task_Primitives.Operations;
-----------------------
-- Local Subprograms --
-----------------------
procedure Free_Entry_Names (Object : Protection_Entries);
-- Deallocate all string names associated with protected entries
----------------
-- Local Data --
----------------
......@@ -141,8 +132,6 @@ package body System.Tasking.Protected_Objects.Entries is
end loop;
end loop;
Free_Entry_Names (Object);
Object.Finalized := True;
if Single_Lock then
......@@ -154,26 +143,6 @@ package body System.Tasking.Protected_Objects.Entries is
STPO.Finalize_Lock (Object.L'Unrestricted_Access);
end Finalize;
----------------------
-- Free_Entry_Names --
----------------------
procedure Free_Entry_Names (Object : Protection_Entries) is
Names : Entry_Names_Array_Access := Object.Entry_Names;
procedure Free_Entry_Names_Array_Access is new
Ada.Unchecked_Deallocation
(Entry_Names_Array, Entry_Names_Array_Access);
begin
if Names = null then
return;
end if;
Free_Entry_Names_Array (Names.all);
Free_Entry_Names_Array_Access (Names);
end Free_Entry_Names;
-----------------
-- Get_Ceiling --
-----------------
......@@ -202,12 +171,11 @@ package body System.Tasking.Protected_Objects.Entries is
-----------------------------------
procedure Initialize_Protection_Entries
(Object : Protection_Entries_Access;
Ceiling_Priority : Integer;
Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access;
Build_Entry_Names : Boolean)
(Object : Protection_Entries_Access;
Ceiling_Priority : Integer;
Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access)
is
Init_Priority : Integer := Ceiling_Priority;
Self_ID : constant Task_Id := STPO.Self;
......@@ -250,11 +218,6 @@ package body System.Tasking.Protected_Objects.Entries is
Object.Entry_Queues (E).Head := null;
Object.Entry_Queues (E).Tail := null;
end loop;
if Build_Entry_Names then
Object.Entry_Names :=
new Entry_Names_Array (1 .. Entry_Index (Object.Num_Entries));
end if;
end Initialize_Protection_Entries;
------------------
......@@ -391,6 +354,17 @@ package body System.Tasking.Protected_Objects.Entries is
end if;
end Lock_Read_Only_Entries;
-----------------------
-- Number_Of_Entries --
-----------------------
function Number_Of_Entries
(Object : Protection_Entries_Access) return Protected_Entry_Index
is
begin
return Object.Num_Entries;
end Number_Of_Entries;
-----------------
-- Set_Ceiling --
-----------------
......@@ -402,20 +376,17 @@ package body System.Tasking.Protected_Objects.Entries is
Object.New_Ceiling := Prio;
end Set_Ceiling;
--------------------
-- Set_Entry_Name --
--------------------
---------------------
-- Set_Entry_Names --
---------------------
procedure Set_Entry_Name
(Object : Protection_Entries'Class;
Pos : Protected_Entry_Index;
Val : String_Access)
procedure Set_Entry_Names
(Object : Protection_Entries_Access;
Names : Protected_Entry_Names_Access)
is
begin
pragma Assert (Object.Entry_Names /= null);
Object.Entry_Names (Entry_Index (Pos)) := Val;
end Set_Entry_Name;
Object.Entry_Names := Names;
end Set_Entry_Names;
--------------------
-- Unlock_Entries --
......
gcc/ada/s-tpoben.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -67,6 +67,14 @@ package System.Tasking.Protected_Objects.Entries is
type Protected_Entry_Queue_Array is
array (Protected_Entry_Index range <>) of Entry_Queue;
-- A data structure which contains the string names of entries and entry
-- family members.
type Protected_Entry_Names_Array is
array (Protected_Entry_Index range <>) of String_Access;
type Protected_Entry_Names_Access is access all Protected_Entry_Names_Array;
-- This type contains the GNARL state of a protected object. The
-- application-defined portion of the state (i.e. private objects)
-- is maintained by the compiler-generated code.
......@@ -136,7 +144,7 @@ package System.Tasking.Protected_Objects.Entries is
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
Entry_Names : Entry_Names_Array_Access := null;
Entry_Names : Protected_Entry_Names_Access := null;
-- An array of string names which denotes entry [family member] names.
-- The structure is indexed by protected entry index and contains Num_
-- Entries components.
......@@ -167,12 +175,11 @@ package System.Tasking.Protected_Objects.Entries is
-- System.Tasking.Protected_Objects.Initialize_Protection.
procedure Initialize_Protection_Entries
(Object : Protection_Entries_Access;
Ceiling_Priority : Integer;
Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access;
Build_Entry_Names : Boolean);
(Object : Protection_Entries_Access;
Ceiling_Priority : Integer;
Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access);
-- Initialize the Object parameter so that it can be used by the runtime
-- to keep track of the runtime state of a protected object.
......@@ -201,17 +208,20 @@ package System.Tasking.Protected_Objects.Entries is
-- possible future use. At the current time, everyone uses Lock for both
-- read and write locks.
function Number_Of_Entries
(Object : Protection_Entries_Access) return Protected_Entry_Index;
-- Return the number of entries of a protected object
procedure Set_Ceiling
(Object : Protection_Entries_Access;
Prio : System.Any_Priority);
-- Sets the new ceiling priority of the protected object
procedure Set_Entry_Name
(Object : Protection_Entries'Class;
Pos : Protected_Entry_Index;
Val : String_Access);
-- This is called by the compiler to map a string which denotes an entry
-- name to a protected entry index.
procedure Set_Entry_Names
(Object : Protection_Entries_Access;
Names : Protected_Entry_Names_Access);
-- Associate an array of string that denote entry [family] names with a
-- protected object.
procedure Unlock_Entries (Object : Protection_Entries_Access);
-- Relinquish ownership of the lock for the object represented by the
......
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