File : a-synbar-posix.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S Y N C H R O N O U S _ B A R R I E R S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
10 -- --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
14 -- --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
21 -- --
22 -- --
23 -- --
24 -- --
25 -- --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
30 -- --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 -- --
34 ------------------------------------------------------------------------------
35
36 -- This is the body of this package using POSIX barriers
37
38 with Interfaces.C; use Interfaces.C;
39
40 package body Ada.Synchronous_Barriers is
41
42 --------------------
43 -- POSIX barriers --
44 --------------------
45
46 function pthread_barrier_init
47 (barrier : not null access pthread_barrier_t;
48 attr : System.Address := System.Null_Address;
49 count : unsigned) return int;
50 pragma Import (C, pthread_barrier_init, "pthread_barrier_init");
51 -- Initialize barrier with the attributes in attr. The barrier is opened
52 -- when count waiters arrived. If attr is null the default barrier
53 -- attributes are used.
54
55 function pthread_barrier_destroy
56 (barrier : not null access pthread_barrier_t) return int;
57 pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy");
58 -- Destroy a previously dynamically initialized barrier
59
60 function pthread_barrier_wait
61 (barrier : not null access pthread_barrier_t) return int;
62 pragma Import (C, pthread_barrier_wait, "pthread_barrier_wait");
63 -- Wait on barrier
64
65 --------------
66 -- Finalize --
67 --------------
68
69 overriding procedure Finalize (Barrier : in out Synchronous_Barrier) is
70 Result : int;
71 begin
72 Result := pthread_barrier_destroy (Barrier.POSIX_Barrier'Access);
73 pragma Assert (Result = 0);
74 end Finalize;
75
76 overriding procedure Initialize (Barrier : in out Synchronous_Barrier) is
77 Result : int;
78 begin
79 Result :=
80 pthread_barrier_init
81 (barrier => Barrier.POSIX_Barrier'Access,
82 attr => System.Null_Address,
83 count => unsigned (Barrier.Release_Threshold));
84 pragma Assert (Result = 0);
85 end Initialize;
86
87 ----------------------
88 -- Wait_For_Release --
89 ----------------------
90
91 procedure Wait_For_Release
92 (The_Barrier : in out Synchronous_Barrier;
93 Notified : out Boolean)
94 is
95 Result : int;
96
97 PTHREAD_BARRIER_SERIAL_THREAD : constant := -1;
98 -- Value used to indicate the task which receives the notification for
99 -- the barrier open.
100
101 begin
102 Result :=
103 pthread_barrier_wait
104 (barrier => The_Barrier.POSIX_Barrier'Access);
105 pragma Assert
106 (Result = 0 or else Result = PTHREAD_BARRIER_SERIAL_THREAD);
107
108 Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD);
109 end Wait_For_Release;
110
111 end Ada.Synchronous_Barriers;