File : a-sytaco-xi.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2016, 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 the generic bare board version of this package
33
34 with System.Task_Primitives.Operations;
35
36 package body Ada.Synchronous_Task_Control with
37 SPARK_Mode => Off
38 is
39
40 protected body Suspension_Object is
41
42 --------------
43 -- Get_Open --
44 --------------
45
46 function Get_Open return Boolean is
47 begin
48 return Open;
49 end Get_Open;
50
51 ---------------
52 -- Set_False --
53 ---------------
54
55 procedure Set_False is
56 begin
57 Open := False;
58 end Set_False;
59
60 --------------
61 -- Set_True --
62 --------------
63
64 procedure Set_True is
65 begin
66 Open := True;
67 end Set_True;
68
69 ----------
70 -- Wait --
71 ----------
72
73 entry Wait when Open is
74 begin
75 Open := False;
76 end Wait;
77
78 end Suspension_Object;
79
80 -------------------
81 -- Current_State --
82 -------------------
83
84 function Current_State (S : Suspension_Object) return Boolean is
85 begin
86 return S.Get_Open;
87 end Current_State;
88
89 ---------------
90 -- Set_False --
91 ---------------
92
93 procedure Set_False (S : in out Suspension_Object) is
94 begin
95 S.Set_False;
96 end Set_False;
97
98 --------------
99 -- Set_True --
100 --------------
101
102 procedure Set_True (S : in out Suspension_Object) is
103 begin
104 S.Set_True;
105 end Set_True;
106
107 ------------------------
108 -- Suspend_Until_True --
109 ------------------------
110
111 procedure Suspend_Until_True (S : in out Suspension_Object) is
112 begin
113 S.Wait;
114 end Suspend_Until_True;
115
116 end Ada.Synchronous_Task_Control;