File : s-osprim-linux-xenomai.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --                  S Y S T E M . O S _ P R I M I T I V E S                 --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --          Copyright (C) 1998-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 -- GNARL was developed by the GNARL team at Florida State University.       --
  28 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  This version is for GNU/Linux (Xenomai)
  33 
  34 with System.OS_Interface;
  35 --  Since the task library is part of the Xenomai kernel, using OS_Interface
  36 --  is not a problem here, as long as we only use System.OS_Interface as a
  37 --  set of C imported routines: using Ada routines from this package would
  38 --  create a dependency on libgnarl in libgnat, which is not desirable.
  39 
  40 with Interfaces.C;
  41 
  42 with Ada.Unchecked_Conversion;
  43 
  44 package body System.OS_Primitives is
  45 
  46    use System.OS_Interface;
  47    use type Interfaces.C.int;
  48 
  49    function To_Duration (T : RTime) return Duration;
  50    pragma Inline (To_Duration);
  51 
  52    function To_RTime (D : Duration) return RTime;
  53    pragma Inline (To_RTime);
  54 
  55    -----------------
  56    -- To_Duration --
  57    -----------------
  58 
  59    function To_Duration (T : RTime) return Duration is
  60       function To_Duration is new Ada.Unchecked_Conversion (SRTime, Duration);
  61       --  Duration and SRTime are both 64-bits types containing a count of
  62       --  nanoseconds so we can do unchecked conversions between them.
  63 
  64    begin
  65       return To_Duration (timer_ticks2ns (SRTime (T)));
  66    end To_Duration;
  67 
  68    --------------
  69    -- To_RTime --
  70    --------------
  71 
  72    function To_RTime (D : Duration) return RTime is
  73       Result : RTime;
  74 
  75       function To_SRTime is new Ada.Unchecked_Conversion (Duration, SRTime);
  76       --  Duration and SRTime are both 64-bits types containing a count of
  77       --  nanoseconds so we can do unchecked conversions between them.
  78 
  79    begin
  80       Result := RTime (timer_ns2ticks (To_SRTime (D)));
  81 
  82       --  The value RTime'(0) has an special meaning (infinite) so we must
  83       --  avoid this value in the translation.
  84 
  85       if Result = 0 then
  86          Result := 1;
  87       end if;
  88 
  89       return Result;
  90    end To_RTime;
  91 
  92    -----------
  93    -- Clock --
  94    -----------
  95 
  96    function Clock return Duration is
  97    begin
  98       return To_Duration (timer_read);
  99    end Clock;
 100 
 101    -----------------
 102    -- Timed_Delay --
 103    -----------------
 104 
 105    procedure Timed_Delay
 106      (Time : Duration;
 107       Mode : Integer)
 108    is
 109       Now      : Duration := Clock;
 110       Abs_Time : Duration;
 111       Ticks    : RTime;
 112       Result   : int;
 113 
 114    begin
 115       if Mode = Relative then
 116          if Time > 0.0 then
 117             Abs_Time := Now + Time;
 118             Ticks := To_RTime (Time);
 119 
 120          --  Ticks equal to zero indicates that the expiration time has
 121          --  already passed and no delay is needed.
 122 
 123          else
 124             Abs_Time := Now;
 125             Ticks := 0;
 126          end if;
 127 
 128       --  Absolute delay
 129 
 130       else
 131          Abs_Time := Time;
 132 
 133          if Abs_Time > Now then
 134             Ticks := To_RTime (Abs_Time - Now);
 135 
 136          --  Ticks equal to zero indicates that the expiration time has
 137          --  already passed and no delay is needed.
 138 
 139          else
 140             Ticks := 0;
 141          end if;
 142       end if;
 143 
 144       if Ticks /= 0 then
 145          loop
 146             Result := task_sleep (Ticks);
 147             pragma Assert (Result = 0 or else Result = EINTR);
 148 
 149             Now := Clock;
 150 
 151             exit when Abs_Time <= Now;
 152 
 153             Ticks := To_RTime (Abs_Time - Now);
 154          end loop;
 155       end if;
 156    end Timed_Delay;
 157 
 158    ----------------
 159    -- Initialize --
 160    ----------------
 161 
 162    procedure Initialize is
 163    begin
 164       null;
 165    end Initialize;
 166 
 167 end System.OS_Primitives;