File : a-sytaco-raven-vxworks.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-2015, 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 VxWorks/Cert version of this package
33
34 with Interfaces.C;
35
36 package body Ada.Synchronous_Task_Control with
37 SPARK_Mode => Off
38 is
39 use System.OS_Interface;
40 use type Interfaces.C.int;
41
42 ---------------
43 -- Set_False --
44 ---------------
45
46 procedure Set_False (S : in out Suspension_Object) is
47 St : STATUS;
48 pragma Unreferenced (St);
49 begin
50 -- Need to get the semaphore into the "empty" state.
51 -- On return, this task will have made the semaphore
52 -- empty (St = OK) or have left it empty.
53
54 St := semTake (S.Sema, NO_WAIT);
55 end Set_False;
56
57 --------------
58 -- Set_True --
59 --------------
60
61 procedure Set_True (S : in out Suspension_Object) is
62 St : STATUS;
63 pragma Unreferenced (St);
64 begin
65 St := semGive (S.Sema);
66 end Set_True;
67
68 ------------------------
69 -- Suspend_Until_True --
70 ------------------------
71
72 procedure Suspend_Until_True (S : in out Suspension_Object) is
73 St : STATUS;
74 begin
75 -- Determine whether another task is pending on the suspension
76 -- object. Should never be called from an ISR. Therefore semTake can
77 -- be called on the mutex
78
79 St := semTake (S.Mutex, NO_WAIT);
80
81 if St = OK then
82 -- Wait for suspension object
83
84 St := semTake (S.Sema, WAIT_FOREVER);
85 St := semGive (S.Mutex);
86
87 else
88 -- Another task is pending on the suspension object
89
90 raise Program_Error;
91 end if;
92 end Suspend_Until_True;
93
94 end Ada.Synchronous_Task_Control;