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