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;