File : a-sytaco-raven-vxworks.ads
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 -- S p e c --
8 -- --
9 -- Copyright (C) 1992-2015, 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 VxWorks/Cert version of this package
37
38 with System.OS_Interface;
39
40 package Ada.Synchronous_Task_Control with
41 SPARK_Mode
42 is
43 pragma Preelaborate;
44 -- In accordance with Ada 2005 AI-362
45
46 type Suspension_Object is limited private with
47 Default_Initial_Condition;
48
49 procedure Set_True (S : in out Suspension_Object) with
50 Global => null,
51 Depends => (S => null,
52 null => S);
53
54 procedure Set_False (S : in out Suspension_Object) with
55 Global => null,
56 Depends => (S => null,
57 null => S);
58
59 -- function Current_State (S : Suspension_Object) return Boolean;
60 -- This function is removed from the Cert version, because its use involves
61 -- a fundamental race condition if multiple tasks are involved, so it is
62 -- not considered safe in the Cert environment.
63
64 procedure Suspend_Until_True (S : in out Suspension_Object) with
65 Global => null,
66 Depends => (S => null,
67 null => S);
68
69 private
70 pragma SPARK_Mode (Off);
71
72 -- Implement with a VxWorks binary semaphore. A second semaphore
73 -- is used to avoid a race condition related to the implementation of
74 -- the STC requirement to raise Program_Error when Suspend_Until_True is
75 -- called with a task already pending on the suspension object.
76
77 pragma Warnings (Off);
78 -- Allow non-static constants in Ada 2005 mode where this package will be
79 -- implicitly categorized as Preelaborate. See AI-362 for details. It is
80 -- safe in the context of the run-time to violate the rules.
81
82 type Suspension_Object is record
83 Sema : System.OS_Interface.SEM_ID :=
84 System.OS_Interface.semBCreate
85 (System.OS_Interface.SEM_Q_FIFO,
86 System.OS_Interface.SEM_EMPTY);
87 Mutex : System.OS_Interface.SEM_ID :=
88 System.OS_Interface.semBCreate
89 (System.OS_Interface.SEM_Q_FIFO,
90 System.OS_Interface.SEM_FULL);
91 end record;
92
93 pragma Warnings (On);
94
95 end Ada.Synchronous_Task_Control;