|
111
|
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 -- --
|
|
145
|
9 -- Copyright (C) 1998-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNARL 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 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
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 VxWorks targets
|
|
|
33
|
|
|
34 with System.OS_Interface;
|
|
|
35 -- Since the thread library is part of the VxWorks 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 System.OS_Constants;
|
|
|
41 with Interfaces.C;
|
|
|
42
|
|
|
43 package body System.OS_Primitives is
|
|
|
44
|
|
|
45 use System.OS_Interface;
|
|
|
46 use type Interfaces.C.int;
|
|
|
47
|
|
|
48 package OSC renames System.OS_Constants;
|
|
|
49
|
|
|
50 ------------------------
|
|
|
51 -- Internal functions --
|
|
|
52 ------------------------
|
|
|
53
|
|
|
54 function To_Clock_Ticks (D : Duration) return int;
|
|
|
55 -- Convert a duration value (in seconds) into clock ticks.
|
|
|
56 -- Note that this routine is duplicated from System.OS_Interface since
|
|
|
57 -- as explained above, we do not want to depend on libgnarl
|
|
|
58
|
|
|
59 function To_Clock_Ticks (D : Duration) return int is
|
|
|
60 Ticks : Long_Long_Integer;
|
|
|
61 Rate_Duration : Duration;
|
|
|
62 Ticks_Duration : Duration;
|
|
|
63
|
|
|
64 begin
|
|
|
65 if D < 0.0 then
|
|
|
66 return -1;
|
|
|
67 end if;
|
|
|
68
|
|
|
69 -- Ensure that the duration can be converted to ticks
|
|
|
70 -- at the current clock tick rate without overflowing.
|
|
|
71
|
|
|
72 Rate_Duration := Duration (sysClkRateGet);
|
|
|
73
|
|
|
74 if D > (Duration'Last / Rate_Duration) then
|
|
|
75 Ticks := Long_Long_Integer (int'Last);
|
|
|
76 else
|
|
|
77 Ticks_Duration := D * Rate_Duration;
|
|
|
78 Ticks := Long_Long_Integer (Ticks_Duration);
|
|
|
79
|
|
|
80 if Ticks_Duration > Duration (Ticks) then
|
|
|
81 Ticks := Ticks + 1;
|
|
|
82 end if;
|
|
|
83
|
|
|
84 if Ticks > Long_Long_Integer (int'Last) then
|
|
|
85 Ticks := Long_Long_Integer (int'Last);
|
|
|
86 end if;
|
|
|
87 end if;
|
|
|
88
|
|
|
89 return int (Ticks);
|
|
|
90 end To_Clock_Ticks;
|
|
|
91
|
|
|
92 -----------
|
|
|
93 -- Clock --
|
|
|
94 -----------
|
|
|
95
|
|
|
96 function Clock return Duration is
|
|
|
97 TS : aliased timespec;
|
|
|
98 Result : int;
|
|
|
99 begin
|
|
|
100 Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
|
|
|
101 pragma Assert (Result = 0);
|
|
|
102 return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
|
|
|
103 end Clock;
|
|
|
104
|
|
|
105 -----------------
|
|
|
106 -- Timed_Delay --
|
|
|
107 -----------------
|
|
|
108
|
|
|
109 procedure Timed_Delay
|
|
|
110 (Time : Duration;
|
|
|
111 Mode : Integer)
|
|
|
112 is
|
|
|
113 Rel_Time : Duration;
|
|
|
114 Abs_Time : Duration;
|
|
|
115 Base_Time : constant Duration := Clock;
|
|
|
116 Check_Time : Duration := Base_Time;
|
|
|
117 Ticks : int;
|
|
|
118
|
|
|
119 Result : int;
|
|
|
120 pragma Unreferenced (Result);
|
|
|
121
|
|
|
122 begin
|
|
|
123 if Mode = Relative then
|
|
|
124 Rel_Time := Time;
|
|
|
125 Abs_Time := Time + Check_Time;
|
|
|
126 else
|
|
|
127 Rel_Time := Time - Check_Time;
|
|
|
128 Abs_Time := Time;
|
|
|
129 end if;
|
|
|
130
|
|
|
131 if Rel_Time > 0.0 then
|
|
|
132 loop
|
|
|
133 Ticks := To_Clock_Ticks (Rel_Time);
|
|
|
134
|
|
|
135 if Mode = Relative and then Ticks < int'Last then
|
|
|
136 -- The first tick will delay anytime between 0 and
|
|
|
137 -- 1 / sysClkRateGet seconds, so we need to add one to
|
|
|
138 -- be on the safe side.
|
|
|
139
|
|
|
140 Ticks := Ticks + 1;
|
|
|
141 end if;
|
|
|
142
|
|
|
143 Result := taskDelay (Ticks);
|
|
|
144 Check_Time := Clock;
|
|
|
145
|
|
|
146 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
|
|
|
147
|
|
|
148 Rel_Time := Abs_Time - Check_Time;
|
|
|
149 end loop;
|
|
|
150 end if;
|
|
|
151 end Timed_Delay;
|
|
|
152
|
|
|
153 ----------------
|
|
|
154 -- Initialize --
|
|
|
155 ----------------
|
|
|
156
|
|
|
157 procedure Initialize is
|
|
|
158 begin
|
|
|
159 null;
|
|
|
160 end Initialize;
|
|
|
161
|
|
|
162 end System.OS_Primitives;
|
