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-- 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   -- 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
238end System.OS_Interface;
239