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) 1991-1994, Florida State University            --
10--                     Copyright (C) 1995-2019, AdaCore                     --
11--                                                                          --
12-- GNAT is free software;  you can  redistribute it  and/or modify it under --
13-- terms of the  GNU General Public License as published  by the Free Soft- --
14-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
16-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
17-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
18--                                                                          --
19-- As a special exception under Section 7 of GPL version 3, you are granted --
20-- additional permissions described in the GCC Runtime Library Exception,   --
21-- version 3.1, as published by the Free Software Foundation.               --
22--                                                                          --
23-- You should have received a copy of the GNU General Public License and    --
24-- a copy of the GCC Runtime Library Exception along with this program;     --
25-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26-- <http://www.gnu.org/licenses/>.                                          --
27--                                                                          --
28-- GNARL was developed by the GNARL team at Florida State University.       --
29-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
30--                                                                          --
31------------------------------------------------------------------------------
32
33--  This is a DCE version of this package.
34--  Currently HP-UX and SNI use this file
35
36pragma Polling (Off);
37--  Turn off polling, we do not want ATC polling to take place during
38--  tasking operations. It causes infinite loops and other problems.
39
40--  This package encapsulates all direct interfaces to OS services
41--  that are needed by children of System.
42
43with Interfaces.C; use Interfaces.C;
44
45package body System.OS_Interface is
46
47   -----------------
48   -- To_Duration --
49   -----------------
50
51   function To_Duration (TS : timespec) return Duration is
52   begin
53      return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
54   end To_Duration;
55
56   -----------------
57   -- To_Timespec --
58   -----------------
59
60   function To_Timespec (D : Duration) return timespec is
61      S : time_t;
62      F : Duration;
63
64   begin
65      S := time_t (Long_Long_Integer (D));
66      F := D - Duration (S);
67
68      --  If F has negative value due to a round-up, adjust for positive F
69      --  value.
70      if F < 0.0 then
71         S := S - 1;
72         F := F + 1.0;
73      end if;
74
75      return timespec'(tv_sec => S,
76                       tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
77   end To_Timespec;
78
79   -------------------------
80   -- POSIX.1c  Section 3 --
81   -------------------------
82
83   function sigwait
84     (set : access sigset_t;
85      sig : access Signal) return int
86   is
87      Result : int;
88
89   begin
90      Result := sigwait (set);
91
92      if Result = -1 then
93         sig.all := 0;
94         return errno;
95      end if;
96
97      sig.all := Signal (Result);
98      return 0;
99   end sigwait;
100
101   --  DCE_THREADS does not have pthread_kill. Instead, we just ignore it
102
103   function pthread_kill (thread : pthread_t; sig : Signal) return int is
104      pragma Unreferenced (thread, sig);
105   begin
106      return 0;
107   end pthread_kill;
108
109   --------------------------
110   -- POSIX.1c  Section 11 --
111   --------------------------
112
113   --  For all following functions, DCE Threads has a non standard behavior.
114   --  It sets errno but the standard Posix requires it to be returned.
115
116   function pthread_mutexattr_init
117     (attr : access pthread_mutexattr_t) return int
118   is
119      function pthread_mutexattr_create
120        (attr : access pthread_mutexattr_t) return int;
121      pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
122
123   begin
124      if pthread_mutexattr_create (attr) /= 0 then
125         return errno;
126      else
127         return 0;
128      end if;
129   end pthread_mutexattr_init;
130
131   function pthread_mutexattr_destroy
132     (attr : access pthread_mutexattr_t) return int
133   is
134      function pthread_mutexattr_delete
135        (attr : access pthread_mutexattr_t) return int;
136      pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
137
138   begin
139      if pthread_mutexattr_delete (attr) /= 0 then
140         return errno;
141      else
142         return 0;
143      end if;
144   end pthread_mutexattr_destroy;
145
146   function pthread_mutex_init
147     (mutex : access pthread_mutex_t;
148      attr  : access pthread_mutexattr_t) return int
149   is
150      function pthread_mutex_init_base
151        (mutex : access pthread_mutex_t;
152         attr  : pthread_mutexattr_t) return int;
153      pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
154
155   begin
156      if pthread_mutex_init_base (mutex, attr.all) /= 0 then
157         return errno;
158      else
159         return 0;
160      end if;
161   end pthread_mutex_init;
162
163   function pthread_mutex_destroy
164     (mutex : access pthread_mutex_t) return int
165   is
166      function pthread_mutex_destroy_base
167        (mutex : access pthread_mutex_t) return int;
168      pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
169
170   begin
171      if pthread_mutex_destroy_base (mutex) /= 0 then
172         return errno;
173      else
174         return 0;
175      end if;
176   end pthread_mutex_destroy;
177
178   function pthread_mutex_lock
179     (mutex : access pthread_mutex_t) return int
180   is
181      function pthread_mutex_lock_base
182        (mutex : access pthread_mutex_t) return int;
183      pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
184
185   begin
186      if pthread_mutex_lock_base (mutex) /= 0 then
187         return errno;
188      else
189         return 0;
190      end if;
191   end pthread_mutex_lock;
192
193   function pthread_mutex_unlock
194     (mutex : access pthread_mutex_t) return int
195   is
196      function pthread_mutex_unlock_base
197        (mutex : access pthread_mutex_t) return int;
198      pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
199
200   begin
201      if pthread_mutex_unlock_base (mutex) /= 0 then
202         return errno;
203      else
204         return 0;
205      end if;
206   end pthread_mutex_unlock;
207
208   function pthread_condattr_init
209     (attr : access pthread_condattr_t) return int
210   is
211      function pthread_condattr_create
212        (attr : access pthread_condattr_t) return int;
213      pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
214
215   begin
216      if pthread_condattr_create (attr) /= 0 then
217         return errno;
218      else
219         return 0;
220      end if;
221   end pthread_condattr_init;
222
223   function pthread_condattr_destroy
224     (attr : access pthread_condattr_t) return int
225   is
226      function pthread_condattr_delete
227        (attr : access pthread_condattr_t) return int;
228      pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
229
230   begin
231      if pthread_condattr_delete (attr) /= 0 then
232         return errno;
233      else
234         return 0;
235      end if;
236   end pthread_condattr_destroy;
237
238   function pthread_cond_init
239     (cond : access pthread_cond_t;
240      attr : access pthread_condattr_t) return int
241   is
242      function pthread_cond_init_base
243        (cond : access pthread_cond_t;
244         attr : pthread_condattr_t) return int;
245      pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
246
247   begin
248      if pthread_cond_init_base (cond, attr.all) /= 0 then
249         return errno;
250      else
251         return 0;
252      end if;
253   end pthread_cond_init;
254
255   function pthread_cond_destroy
256     (cond : access pthread_cond_t) return int
257   is
258      function pthread_cond_destroy_base
259        (cond : access pthread_cond_t) return int;
260      pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
261
262   begin
263      if pthread_cond_destroy_base (cond) /= 0 then
264         return errno;
265      else
266         return 0;
267      end if;
268   end pthread_cond_destroy;
269
270   function pthread_cond_signal
271     (cond : access pthread_cond_t) return int
272   is
273      function pthread_cond_signal_base
274        (cond : access pthread_cond_t) return int;
275      pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
276
277   begin
278      if pthread_cond_signal_base (cond) /= 0 then
279         return errno;
280      else
281         return 0;
282      end if;
283   end pthread_cond_signal;
284
285   function pthread_cond_wait
286     (cond  : access pthread_cond_t;
287      mutex : access pthread_mutex_t) return int
288   is
289      function pthread_cond_wait_base
290        (cond  : access pthread_cond_t;
291         mutex : access pthread_mutex_t) return int;
292      pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
293
294   begin
295      if pthread_cond_wait_base (cond, mutex) /= 0 then
296         return errno;
297      else
298         return 0;
299      end if;
300   end pthread_cond_wait;
301
302   function pthread_cond_timedwait
303     (cond    : access pthread_cond_t;
304      mutex   : access pthread_mutex_t;
305      abstime : access timespec) return int
306   is
307      function pthread_cond_timedwait_base
308        (cond    : access pthread_cond_t;
309         mutex   : access pthread_mutex_t;
310         abstime : access timespec) return int;
311      pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
312
313   begin
314      if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
315         return (if errno = EAGAIN then ETIMEDOUT else errno);
316      else
317         return 0;
318      end if;
319   end pthread_cond_timedwait;
320
321   ----------------------------
322   --  POSIX.1c  Section 13  --
323   ----------------------------
324
325   function pthread_setschedparam
326     (thread : pthread_t;
327      policy : int;
328      param  : access struct_sched_param) return int
329   is
330      function pthread_setscheduler
331        (thread   : pthread_t;
332         policy   : int;
333         priority : int) return int;
334      pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
335
336   begin
337      if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
338         return errno;
339      else
340         return 0;
341      end if;
342   end pthread_setschedparam;
343
344   function sched_yield return int is
345      procedure pthread_yield;
346      pragma Import (C, pthread_yield, "pthread_yield");
347   begin
348      pthread_yield;
349      return 0;
350   end sched_yield;
351
352   -----------------------------
353   --  P1003.1c - Section 16  --
354   -----------------------------
355
356   function pthread_attr_init
357     (attributes : access pthread_attr_t) return int
358   is
359      function pthread_attr_create
360        (attributes : access pthread_attr_t) return int;
361      pragma Import (C, pthread_attr_create, "pthread_attr_create");
362
363   begin
364      if pthread_attr_create (attributes) /= 0 then
365         return errno;
366      else
367         return 0;
368      end if;
369   end pthread_attr_init;
370
371   function pthread_attr_destroy
372     (attributes : access pthread_attr_t) return int
373   is
374      function pthread_attr_delete
375        (attributes : access pthread_attr_t) return int;
376      pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
377
378   begin
379      if pthread_attr_delete (attributes) /= 0 then
380         return errno;
381      else
382         return 0;
383      end if;
384   end pthread_attr_destroy;
385
386   function pthread_attr_setstacksize
387     (attr      : access pthread_attr_t;
388      stacksize : size_t) return int
389   is
390      function pthread_attr_setstacksize_base
391        (attr      : access pthread_attr_t;
392         stacksize : size_t) return int;
393      pragma Import (C, pthread_attr_setstacksize_base,
394                     "pthread_attr_setstacksize");
395
396   begin
397      if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
398         return errno;
399      else
400         return 0;
401      end if;
402   end pthread_attr_setstacksize;
403
404   function pthread_create
405     (thread        : access pthread_t;
406      attributes    : access pthread_attr_t;
407      start_routine : Thread_Body;
408      arg           : System.Address) return int
409   is
410      function pthread_create_base
411        (thread        : access pthread_t;
412         attributes    : pthread_attr_t;
413         start_routine : Thread_Body;
414         arg           : System.Address) return int;
415      pragma Import (C, pthread_create_base, "pthread_create");
416
417   begin
418      if pthread_create_base
419        (thread, attributes.all, start_routine, arg) /= 0
420      then
421         return errno;
422      else
423         return 0;
424      end if;
425   end pthread_create;
426
427   --------------------------
428   -- POSIX.1c  Section 17 --
429   --------------------------
430
431   function pthread_setspecific
432     (key   : pthread_key_t;
433      value : System.Address) return int
434   is
435      function pthread_setspecific_base
436        (key   : pthread_key_t;
437         value : System.Address) return int;
438      pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
439
440   begin
441      if pthread_setspecific_base (key, value) /= 0 then
442         return errno;
443      else
444         return 0;
445      end if;
446   end pthread_setspecific;
447
448   function pthread_getspecific (key : pthread_key_t) return System.Address is
449      function pthread_getspecific_base
450        (key   : pthread_key_t;
451         value : access System.Address) return  int;
452      pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
453      Addr : aliased System.Address;
454
455   begin
456      if pthread_getspecific_base (key, Addr'Access) /= 0 then
457         return System.Null_Address;
458      else
459         return Addr;
460      end if;
461   end pthread_getspecific;
462
463   function pthread_key_create
464     (key        : access pthread_key_t;
465      destructor : destructor_pointer) return int
466   is
467      function pthread_keycreate
468        (key        : access pthread_key_t;
469         destructor : destructor_pointer) return int;
470      pragma Import (C, pthread_keycreate, "pthread_keycreate");
471
472   begin
473      if pthread_keycreate (key, destructor) /= 0 then
474         return errno;
475      else
476         return 0;
477      end if;
478   end pthread_key_create;
479
480   function Get_Stack_Base (thread : pthread_t) return Address is
481      pragma Warnings (Off, thread);
482   begin
483      return Null_Address;
484   end Get_Stack_Base;
485
486   procedure pthread_init is
487   begin
488      null;
489   end pthread_init;
490
491   function intr_attach (sig : int; handler : isr_address) return long is
492      function c_signal (sig : int; handler : isr_address) return long;
493      pragma Import (C, c_signal, "signal");
494   begin
495      return c_signal (sig, handler);
496   end intr_attach;
497
498end System.OS_Interface;
499