]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
38cbfe40 RK |
4 | -- -- |
5 | -- G N A T . T H R E A D S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1998-2020, AdaCore -- |
38cbfe40 RK |
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- -- | |
607d0635 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
38cbfe40 RK |
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 -- | |
607d0635 AC |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
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. -- | |
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/>. -- | |
38cbfe40 | 26 | -- -- |
fbf5a39b AC |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
38cbfe40 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | with Ada.Task_Identification; use Ada.Task_Identification; | |
33 | with System.Task_Primitives.Operations; | |
34 | with System.Tasking; | |
fbf5a39b | 35 | with System.Tasking.Stages; use System.Tasking.Stages; |
65e5747e | 36 | with System.Tasking.Utilities; |
fbf5a39b AC |
37 | with System.OS_Interface; use System.OS_Interface; |
38 | with System.Soft_Links; use System.Soft_Links; | |
cecaf88a | 39 | with Ada.Unchecked_Conversion; |
38cbfe40 RK |
40 | |
41 | package body GNAT.Threads is | |
42 | ||
43 | use System; | |
44 | ||
fbf5a39b AC |
45 | package STPO renames System.Task_Primitives.Operations; |
46 | ||
47 | type Thread_Id_Ptr is access all Thread_Id; | |
48 | ||
8a6a52dc AC |
49 | pragma Warnings (Off); |
50 | -- The following unchecked conversions are aliasing safe, since they | |
51 | -- are never used to create pointers to improperly aliased data. | |
52 | ||
cecaf88a RD |
53 | function To_Addr is new Ada.Unchecked_Conversion (Task_Id, Address); |
54 | function To_Id is new Ada.Unchecked_Conversion (Address, Task_Id); | |
55 | function To_Id is new Ada.Unchecked_Conversion (Address, Tasking.Task_Id); | |
56 | function To_Tid is new Ada.Unchecked_Conversion | |
fbf5a39b | 57 | (Address, Ada.Task_Identification.Task_Id); |
cecaf88a | 58 | function To_Thread is new Ada.Unchecked_Conversion (Address, Thread_Id_Ptr); |
38cbfe40 | 59 | |
8a6a52dc AC |
60 | pragma Warnings (On); |
61 | ||
38cbfe40 RK |
62 | type Code_Proc is access procedure (Id : Address; Parm : Void_Ptr); |
63 | ||
64 | task type Thread | |
65 | (Stsz : Natural; | |
66 | Prio : Any_Priority; | |
67 | Parm : Void_Ptr; | |
68 | Code : Code_Proc) | |
69 | is | |
70 | pragma Priority (Prio); | |
71 | pragma Storage_Size (Stsz); | |
72 | end Thread; | |
73 | ||
74 | task body Thread is | |
75 | begin | |
76 | Code.all (To_Addr (Current_Task), Parm); | |
77 | end Thread; | |
78 | ||
79 | type Tptr is access Thread; | |
80 | ||
81 | ------------------- | |
82 | -- Create_Thread -- | |
83 | ------------------- | |
84 | ||
85 | function Create_Thread | |
86 | (Code : Address; | |
87 | Parm : Void_Ptr; | |
88 | Size : Natural; | |
efdfd311 | 89 | Prio : Integer) return System.Address |
38cbfe40 RK |
90 | is |
91 | TP : Tptr; | |
92 | ||
cecaf88a | 93 | function To_CP is new Ada.Unchecked_Conversion (Address, Code_Proc); |
38cbfe40 RK |
94 | |
95 | begin | |
96 | TP := new Thread (Size, Prio, Parm, To_CP (Code)); | |
97 | return To_Addr (TP'Identity); | |
98 | end Create_Thread; | |
99 | ||
fbf5a39b AC |
100 | --------------------- |
101 | -- Register_Thread -- | |
102 | --------------------- | |
103 | ||
104 | function Register_Thread return System.Address is | |
105 | begin | |
106 | return Task_Primitives.Operations.Register_Foreign_Thread.all'Address; | |
107 | end Register_Thread; | |
108 | ||
109 | ----------------------- | |
110 | -- Unregister_Thread -- | |
111 | ----------------------- | |
112 | ||
113 | procedure Unregister_Thread is | |
b5e792e2 | 114 | Self_Id : constant Tasking.Task_Id := Task_Primitives.Operations.Self; |
fbf5a39b AC |
115 | begin |
116 | Self_Id.Common.State := Tasking.Terminated; | |
117 | Destroy_TSD (Self_Id.Common.Compiler_Data); | |
118 | Free_Task (Self_Id); | |
119 | end Unregister_Thread; | |
120 | ||
121 | -------------------------- | |
122 | -- Unregister_Thread_Id -- | |
123 | -------------------------- | |
124 | ||
125 | procedure Unregister_Thread_Id (Thread : System.Address) is | |
126 | Thr : constant Thread_Id := To_Thread (Thread).all; | |
b5e792e2 | 127 | T : Tasking.Task_Id; |
fbf5a39b | 128 | |
b5e792e2 | 129 | use type Tasking.Task_Id; |
954c111a HK |
130 | -- This use clause should be removed once a visibility problem |
131 | -- with the MaRTE run time has been fixed. ??? | |
132 | ||
133 | pragma Warnings (Off); | |
bfc8aa81 | 134 | use type System.OS_Interface.Thread_Id; |
954c111a | 135 | pragma Warnings (On); |
fbf5a39b AC |
136 | |
137 | begin | |
138 | STPO.Lock_RTS; | |
139 | ||
140 | T := Tasking.All_Tasks_List; | |
141 | loop | |
142 | exit when T = null or else STPO.Get_Thread_Id (T) = Thr; | |
143 | ||
144 | T := T.Common.All_Tasks_Link; | |
145 | end loop; | |
146 | ||
147 | STPO.Unlock_RTS; | |
148 | ||
149 | if T /= null then | |
150 | T.Common.State := Tasking.Terminated; | |
151 | Destroy_TSD (T.Common.Compiler_Data); | |
152 | Free_Task (T); | |
153 | end if; | |
154 | end Unregister_Thread_Id; | |
155 | ||
38cbfe40 RK |
156 | -------------------- |
157 | -- Destroy_Thread -- | |
158 | -------------------- | |
159 | ||
160 | procedure Destroy_Thread (Id : Address) is | |
fbf5a39b | 161 | Tid : constant Task_Id := To_Id (Id); |
38cbfe40 RK |
162 | begin |
163 | Abort_Task (Tid); | |
164 | end Destroy_Thread; | |
165 | ||
166 | ---------------- | |
167 | -- Get_Thread -- | |
168 | ---------------- | |
169 | ||
170 | procedure Get_Thread (Id : Address; Thread : Address) is | |
38cbfe40 | 171 | begin |
a1a8b172 AC |
172 | To_Thread (Thread).all := |
173 | Task_Primitives.Operations.Get_Thread_Id (To_Id (Id)); | |
174 | end Get_Thread; | |
175 | ||
176 | procedure Get_Thread (Id : Task_Id; Thread : Address) is | |
177 | begin | |
178 | Get_Thread (To_Addr (Id), Thread); | |
38cbfe40 RK |
179 | end Get_Thread; |
180 | ||
65e5747e PMR |
181 | ---------------------- |
182 | -- Make_Independent -- | |
183 | ---------------------- | |
184 | ||
185 | function Make_Independent return Boolean is | |
186 | begin | |
187 | return System.Tasking.Utilities.Make_Independent; | |
188 | end Make_Independent; | |
189 | ||
fbf5a39b AC |
190 | ---------------- |
191 | -- To_Task_Id -- | |
192 | ---------------- | |
193 | ||
194 | function To_Task_Id | |
cecaf88a | 195 | (Id : System.Address) return Ada.Task_Identification.Task_Id |
fbf5a39b AC |
196 | is |
197 | begin | |
198 | return To_Tid (Id); | |
199 | end To_Task_Id; | |
200 | ||
38cbfe40 | 201 | end GNAT.Threads; |