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-2011, 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-- 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 is the VxWorks version
33
34--  This package encapsulates all direct interfaces to OS services that are
35--  needed by children of System.
36
37pragma 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
41package 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   -- sigwait --
50   -------------
51
52   function sigwait
53     (set : access sigset_t;
54      sig : access Signal) return int
55   is
56      Result : int;
57
58      function sigwaitinfo
59        (set : access sigset_t; sigvalue : System.Address) return int;
60      pragma Import (C, sigwaitinfo, "sigwaitinfo");
61
62   begin
63      Result := sigwaitinfo (set, System.Null_Address);
64
65      if Result /= -1 then
66         sig.all := Signal (Result);
67         return OK;
68      else
69         sig.all := 0;
70         return errno;
71      end if;
72   end sigwait;
73
74   -----------------
75   -- To_Duration --
76   -----------------
77
78   function To_Duration (TS : timespec) return Duration is
79   begin
80      return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
81   end To_Duration;
82
83   -----------------
84   -- To_Timespec --
85   -----------------
86
87   function To_Timespec (D : Duration) return timespec is
88      S : time_t;
89      F : Duration;
90
91   begin
92      S := time_t (Long_Long_Integer (D));
93      F := D - Duration (S);
94
95      --  If F is negative due to a round-up, adjust for positive F value
96
97      if F < 0.0 then
98         S := S - 1;
99         F := F + 1.0;
100      end if;
101
102      return timespec'(ts_sec  => S,
103                       ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
104   end To_Timespec;
105
106   -------------------------
107   -- To_VxWorks_Priority --
108   -------------------------
109
110   function To_VxWorks_Priority (Priority : int) return int is
111   begin
112      return Low_Priority - Priority;
113   end To_VxWorks_Priority;
114
115   --------------------
116   -- To_Clock_Ticks --
117   --------------------
118
119   --  ??? - For now, we'll always get the system clock rate since it is
120   --  allowed to be changed during run-time in VxWorks. A better method would
121   --  be to provide an operation to set it that so we can always know its
122   --  value.
123
124   --  Another thing we should probably allow for is a resultant tick count
125   --  greater than int'Last. This should probably be a procedure with two
126   --  output parameters, one in the range 0 .. int'Last, and another
127   --  representing the overflow count.
128
129   function To_Clock_Ticks (D : Duration) return int is
130      Ticks          : Long_Long_Integer;
131      Rate_Duration  : Duration;
132      Ticks_Duration : Duration;
133
134   begin
135      if D < 0.0 then
136         return ERROR;
137      end if;
138
139      --  Ensure that the duration can be converted to ticks
140      --  at the current clock tick rate without overflowing.
141
142      Rate_Duration := Duration (sysClkRateGet);
143
144      if D > (Duration'Last / Rate_Duration) then
145         Ticks := Long_Long_Integer (int'Last);
146      else
147         Ticks_Duration := D * Rate_Duration;
148         Ticks := Long_Long_Integer (Ticks_Duration);
149
150         if Ticks_Duration > Duration (Ticks) then
151            Ticks := Ticks + 1;
152         end if;
153
154         if Ticks > Long_Long_Integer (int'Last) then
155            Ticks := Long_Long_Integer (int'Last);
156         end if;
157      end if;
158
159      return int (Ticks);
160   end To_Clock_Ticks;
161
162   -----------------------------
163   -- Binary_Semaphore_Create --
164   -----------------------------
165
166   function Binary_Semaphore_Create return Binary_Semaphore_Id is
167   begin
168      return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY));
169   end Binary_Semaphore_Create;
170
171   -----------------------------
172   -- Binary_Semaphore_Delete --
173   -----------------------------
174
175   function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
176   begin
177      return semDelete (SEM_ID (ID));
178   end Binary_Semaphore_Delete;
179
180   -----------------------------
181   -- Binary_Semaphore_Obtain --
182   -----------------------------
183
184   function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
185   begin
186      return semTake (SEM_ID (ID), WAIT_FOREVER);
187   end Binary_Semaphore_Obtain;
188
189   ------------------------------
190   -- Binary_Semaphore_Release --
191   ------------------------------
192
193   function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
194   begin
195      return semGive (SEM_ID (ID));
196   end Binary_Semaphore_Release;
197
198   ----------------------------
199   -- Binary_Semaphore_Flush --
200   ----------------------------
201
202   function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
203   begin
204      return semFlush (SEM_ID (ID));
205   end Binary_Semaphore_Flush;
206
207   ----------
208   -- kill --
209   ----------
210
211   function kill (pid : t_id; sig : Signal) return int is
212   begin
213      return System.VxWorks.Ext.kill (pid, int (sig));
214   end kill;
215
216   -----------------------
217   -- Interrupt_Connect --
218   -----------------------
219
220   function Interrupt_Connect
221     (Vector    : Interrupt_Vector;
222      Handler   : Interrupt_Handler;
223      Parameter : System.Address := System.Null_Address) return int is
224   begin
225      return
226        System.VxWorks.Ext.Interrupt_Connect
227        (System.VxWorks.Ext.Interrupt_Vector (Vector),
228         System.VxWorks.Ext.Interrupt_Handler (Handler),
229         Parameter);
230   end Interrupt_Connect;
231
232   -----------------------
233   -- Interrupt_Context --
234   -----------------------
235
236   function Interrupt_Context return int is
237   begin
238      return System.VxWorks.Ext.Interrupt_Context;
239   end Interrupt_Context;
240
241   --------------------------------
242   -- Interrupt_Number_To_Vector --
243   --------------------------------
244
245   function Interrupt_Number_To_Vector
246     (intNum : int) return Interrupt_Vector
247   is
248   begin
249      return Interrupt_Vector
250        (System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum));
251   end Interrupt_Number_To_Vector;
252
253   -----------------
254   -- Current_CPU --
255   -----------------
256
257   function Current_CPU return Multiprocessors.CPU is
258   begin
259      --  ??? Should use vxworks multiprocessor interface
260
261      return Multiprocessors.CPU'First;
262   end Current_CPU;
263
264end System.OS_Interface;
265