File : a-taster-raven.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . T A S K _ T E R M I N A T I O N --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2005-2014, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is a simplified version of this package body to be used in when the
33 -- Ravenscar profile and there are no exception handlers present (either of
34 -- the restrictions No_Exception_Handlers or No_Exception_Propagation are in
35 -- effect). This means that the only task termination cause that need to be
36 -- taken into account is normal task termination (abort is not allowed by
37 -- the Ravenscar profile and the restricted exception support does not
38 -- include Exception_Occurrence).
39
40 with System.Tasking;
41 -- used for Task_Id
42 -- Self
43 -- Fall_Back_Handler
44
45 with System.Task_Primitives.Operations;
46 -- Used for Self
47 -- Set_Priority
48 -- Get_Priority
49
50 with Unchecked_Conversion;
51
52 package body Ada.Task_Termination is
53
54 use System.Task_Primitives.Operations;
55
56 use type Ada.Task_Identification.Task_Id;
57
58 function To_TT is new Unchecked_Conversion
59 (System.Tasking.Termination_Handler, Termination_Handler);
60
61 function To_ST is new Unchecked_Conversion
62 (Termination_Handler, System.Tasking.Termination_Handler);
63
64 -----------------------------------
65 -- Current_Task_Fallback_Handler --
66 -----------------------------------
67
68 function Current_Task_Fallback_Handler return Termination_Handler is
69 Self_Id : constant System.Tasking.Task_Id := Self;
70 Caller_Priority : constant System.Any_Priority := Get_Priority (Self_Id);
71
72 Result : Termination_Handler;
73
74 begin
75 -- Raise the priority to prevent race conditions when modifying
76 -- System.Tasking.Fall_Back_Handler.
77
78 Set_Priority (Self_Id, System.Any_Priority'Last);
79
80 Result := To_TT (System.Tasking.Fall_Back_Handler);
81
82 -- Restore the original priority
83
84 Set_Priority (Self_Id, Caller_Priority);
85
86 return Result;
87 end Current_Task_Fallback_Handler;
88
89 -------------------------------------
90 -- Set_Dependents_Fallback_Handler --
91 -------------------------------------
92
93 procedure Set_Dependents_Fallback_Handler (Handler : Termination_Handler) is
94 Self_Id : constant System.Tasking.Task_Id := Self;
95 Caller_Priority : constant System.Any_Priority := Get_Priority (Self_Id);
96
97 begin
98 -- Raise the priority to prevent race conditions when modifying
99 -- System.Tasking.Fall_Back_Handler.
100
101 Set_Priority (Self_Id, System.Any_Priority'Last);
102
103 System.Tasking.Fall_Back_Handler := To_ST (Handler);
104
105 -- Restore the original priority
106
107 Set_Priority (Self_Id, Caller_Priority);
108 end Set_Dependents_Fallback_Handler;
109
110 end Ada.Task_Termination;