File : s-osinte-vxworks.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . O S _ I N T E R F A C E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
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 -- --
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 is the VxWorks version
33
34 -- This package encapsulates all direct interfaces to OS services that are
35 -- needed by children of System.
36
37 pragma Polling (Off);
38 -- Turn off polling, we do not want ATC polling to take place during tasking
39 -- operations. It causes infinite loops and other problems.
40
41 package body System.OS_Interface is
42
43 use type Interfaces.C.int;
44
45 Low_Priority : constant := 255;
46 -- VxWorks native (default) lowest scheduling priority
47
48 -----------------
49 -- To_Duration --
50 -----------------
51
52 function To_Duration (TS : timespec) return Duration is
53 begin
54 return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
55 end To_Duration;
56
57 -----------------
58 -- To_Timespec --
59 -----------------
60
61 function To_Timespec (D : Duration) return timespec is
62 S : time_t;
63 F : Duration;
64
65 begin
66 S := time_t (Long_Long_Integer (D));
67 F := D - Duration (S);
68
69 -- If F is negative due to a round-up, adjust for positive F value
70
71 if F < 0.0 then
72 S := S - 1;
73 F := F + 1.0;
74 end if;
75
76 return timespec'(ts_sec => S,
77 ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
78 end To_Timespec;
79
80 -------------------------
81 -- To_VxWorks_Priority --
82 -------------------------
83
84 function To_VxWorks_Priority (Priority : int) return int is
85 begin
86 return Low_Priority - Priority;
87 end To_VxWorks_Priority;
88
89 --------------------
90 -- To_Clock_Ticks --
91 --------------------
92
93 -- ??? - For now, we'll always get the system clock rate since it is
94 -- allowed to be changed during run-time in VxWorks. A better method would
95 -- be to provide an operation to set it that so we can always know its
96 -- value.
97
98 -- Another thing we should probably allow for is a resultant tick count
99 -- greater than int'Last. This should probably be a procedure with two
100 -- output parameters, one in the range 0 .. int'Last, and another
101 -- representing the overflow count.
102
103 function To_Clock_Ticks (D : Duration) return int is
104 Ticks : Long_Long_Integer;
105 Rate_Duration : Duration;
106 Ticks_Duration : Duration;
107
108 begin
109 if D < 0.0 then
110 return ERROR;
111 end if;
112
113 -- Ensure that the duration can be converted to ticks
114 -- at the current clock tick rate without overflowing.
115
116 Rate_Duration := Duration (sysClkRateGet);
117
118 if D > (Duration'Last / Rate_Duration) then
119 Ticks := Long_Long_Integer (int'Last);
120 else
121 Ticks_Duration := D * Rate_Duration;
122 Ticks := Long_Long_Integer (Ticks_Duration);
123
124 if Ticks_Duration > Duration (Ticks) then
125 Ticks := Ticks + 1;
126 end if;
127
128 if Ticks > Long_Long_Integer (int'Last) then
129 Ticks := Long_Long_Integer (int'Last);
130 end if;
131 end if;
132
133 return int (Ticks);
134 end To_Clock_Ticks;
135
136 -----------------------------
137 -- Binary_Semaphore_Create --
138 -----------------------------
139
140 function Binary_Semaphore_Create return Binary_Semaphore_Id is
141 begin
142 return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY));
143 end Binary_Semaphore_Create;
144
145 -----------------------------
146 -- Binary_Semaphore_Delete --
147 -----------------------------
148
149 function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
150 begin
151 return semDelete (SEM_ID (ID));
152 end Binary_Semaphore_Delete;
153
154 -----------------------------
155 -- Binary_Semaphore_Obtain --
156 -----------------------------
157
158 function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
159 begin
160 return semTake (SEM_ID (ID), WAIT_FOREVER);
161 end Binary_Semaphore_Obtain;
162
163 ------------------------------
164 -- Binary_Semaphore_Release --
165 ------------------------------
166
167 function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
168 begin
169 return semGive (SEM_ID (ID));
170 end Binary_Semaphore_Release;
171
172 ----------------------------
173 -- Binary_Semaphore_Flush --
174 ----------------------------
175
176 function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
177 begin
178 return semFlush (SEM_ID (ID));
179 end Binary_Semaphore_Flush;
180
181 ----------
182 -- kill --
183 ----------
184
185 function kill (pid : t_id; sig : Signal) return int is
186 begin
187 return System.VxWorks.Ext.kill (pid, int (sig));
188 end kill;
189
190 -----------------------
191 -- Interrupt_Connect --
192 -----------------------
193
194 function Interrupt_Connect
195 (Vector : Interrupt_Vector;
196 Handler : Interrupt_Handler;
197 Parameter : System.Address := System.Null_Address) return int is
198 begin
199 return
200 System.VxWorks.Ext.Interrupt_Connect
201 (System.VxWorks.Ext.Interrupt_Vector (Vector),
202 System.VxWorks.Ext.Interrupt_Handler (Handler),
203 Parameter);
204 end Interrupt_Connect;
205
206 -----------------------
207 -- Interrupt_Context --
208 -----------------------
209
210 function Interrupt_Context return int is
211 begin
212 return System.VxWorks.Ext.Interrupt_Context;
213 end Interrupt_Context;
214
215 --------------------------------
216 -- Interrupt_Number_To_Vector --
217 --------------------------------
218
219 function Interrupt_Number_To_Vector
220 (intNum : int) return Interrupt_Vector
221 is
222 begin
223 return Interrupt_Vector
224 (System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum));
225 end Interrupt_Number_To_Vector;
226
227 -----------------
228 -- Current_CPU --
229 -----------------
230
231 function Current_CPU return Multiprocessors.CPU is
232 begin
233 -- ??? Should use vxworks multiprocessor interface
234
235 return Multiprocessors.CPU'First;
236 end Current_CPU;
237
238 end System.OS_Interface;