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;