File : s-tpopsp-posix-raven-cert.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2012, Free Software Foundation, Inc. --
10 -- --
11 -- GNARL 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 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is a POSIX-like version of this package
33
34 separate (System.Task_Primitives.Operations)
35 package body Specific is
36
37 ATCB_Key : aliased pthread_key_t;
38 -- Key used to find the Ada Task_Id associated with a thread
39
40 ----------------
41 -- Initialize --
42 ----------------
43
44 procedure Initialize is
45 Result : Interfaces.C.int;
46 begin
47 Result := pthread_key_create (ATCB_Key'Access, null);
48 pragma Assert (Result = 0);
49 end Initialize;
50
51 ---------
52 -- Set --
53 ---------
54
55 procedure Set (Self_Id : Task_Id) is
56 Result : Interfaces.C.int;
57 begin
58 Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id));
59 pragma Assert (Result = 0);
60 end Set;
61
62 ----------
63 -- Self --
64 ----------
65
66 function Self return Task_Id is
67 begin
68 return To_Task_Id (pthread_getspecific (ATCB_Key));
69 end Self;
70
71 end Specific;