1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . T A S K _ T E R M I N A T I O N --
9 -- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
33 with System.Task_Primitives.Operations;
34 with System.Parameters;
35 with System.Soft_Links;
37 with Ada.Unchecked_Conversion;
39 package body Ada.Task_Termination is
41 use type Ada.Task_Identification.Task_Id;
43 package STPO renames System.Task_Primitives.Operations;
44 package SSL renames System.Soft_Links;
46 use System.Parameters;
48 -----------------------
49 -- Local subprograms --
50 -----------------------
52 function To_TT is new Ada.Unchecked_Conversion
53 (System.Tasking.Termination_Handler, Termination_Handler);
55 function To_ST is new Ada.Unchecked_Conversion
56 (Termination_Handler, System.Tasking.Termination_Handler);
58 function To_Task_Id is new Ada.Unchecked_Conversion
59 (Ada.Task_Identification.Task_Id, System.Tasking.Task_Id);
61 -----------------------------------
62 -- Current_Task_Fallback_Handler --
63 -----------------------------------
65 function Current_Task_Fallback_Handler return Termination_Handler is
67 -- There is no need for explicit protection against race conditions
68 -- for this function because this function can only be executed by
69 -- Self, and the Fall_Back_Handler can only be modified by Self.
71 return To_TT (STPO.Self.Common.Fall_Back_Handler);
72 end Current_Task_Fallback_Handler;
74 -------------------------------------
75 -- Set_Dependents_Fallback_Handler --
76 -------------------------------------
78 procedure Set_Dependents_Fallback_Handler
79 (Handler : Termination_Handler)
81 Self : constant System.Tasking.Task_Id := STPO.Self;
90 STPO.Write_Lock (Self);
92 Self.Common.Fall_Back_Handler := To_ST (Handler);
100 SSL.Abort_Undefer.all;
101 end Set_Dependents_Fallback_Handler;
103 --------------------------
104 -- Set_Specific_Handler --
105 --------------------------
107 procedure Set_Specific_Handler
108 (T : Ada.Task_Identification.Task_Id;
109 Handler : Termination_Handler)
112 -- Tasking_Error is raised if the task identified by T has already
113 -- terminated. Program_Error is raised if the value of T is
116 if T = Ada.Task_Identification.Null_Task_Id then
118 elsif Ada.Task_Identification.Is_Terminated (T) then
122 Target : constant System.Tasking.Task_Id := To_Task_Id (T);
131 STPO.Write_Lock (Target);
133 Target.Common.Specific_Handler := To_ST (Handler);
135 STPO.Unlock (Target);
141 SSL.Abort_Undefer.all;
144 end Set_Specific_Handler;
146 ----------------------
147 -- Specific_Handler --
148 ----------------------
150 function Specific_Handler
151 (T : Ada.Task_Identification.Task_Id) return Termination_Handler
154 -- Tasking_Error is raised if the task identified by T has already
155 -- terminated. Program_Error is raised if the value of T is
158 if T = Ada.Task_Identification.Null_Task_Id then
160 elsif Ada.Task_Identification.Is_Terminated (T) then
164 Target : constant System.Tasking.Task_Id := To_Task_Id (T);
165 TH : Termination_Handler;
174 STPO.Write_Lock (Target);
176 TH := To_TT (Target.Common.Specific_Handler);
178 STPO.Unlock (Target);
184 SSL.Abort_Undefer.all;
189 end Specific_Handler;
191 end Ada.Task_Termination;