]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
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 | -- -- | |
bcea76b6 | 9 | -- Copyright (C) 1999-2002 Free Software Foundation, Inc. -- |
84481f76 RK |
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 2, or (at your option) any later ver- -- | |
14 | -- sion. GNARL 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. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNARL; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
71ff80dc | 29 | -- GNARL was developed by the GNARL team at Florida State University. -- |
fbf5a39b | 30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- |
84481f76 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is a UnixWare (Native) version of this package | |
35 | ||
36 | pragma 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 | with Interfaces.C; | |
41 | ||
42 | package body System.OS_Interface is | |
43 | ||
44 | use Interfaces.C; | |
45 | ||
46 | ----------------- | |
47 | -- To_Duration -- | |
48 | ----------------- | |
49 | ||
50 | function To_Duration (TS : timespec) return Duration is | |
51 | begin | |
52 | return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; | |
53 | end To_Duration; | |
54 | ||
55 | function To_Duration (TV : struct_timeval) return Duration is | |
56 | begin | |
57 | return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; | |
58 | end To_Duration; | |
59 | ||
60 | ----------------- | |
61 | -- To_Timespec -- | |
62 | ----------------- | |
63 | ||
64 | function To_Timespec (D : Duration) return timespec is | |
65 | S : time_t; | |
66 | F : Duration; | |
67 | ||
68 | begin | |
69 | S := time_t (Long_Long_Integer (D)); | |
70 | F := D - Duration (S); | |
71 | ||
72 | -- If F has negative value due to a round-up, adjust for positive F | |
73 | -- value. | |
74 | ||
75 | if F < 0.0 then | |
76 | S := S - 1; | |
77 | F := F + 1.0; | |
78 | end if; | |
79 | ||
bcea76b6 GB |
80 | return timespec'(tv_sec => S, |
81 | tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); | |
84481f76 RK |
82 | end To_Timespec; |
83 | ||
84 | ---------------- | |
85 | -- To_Timeval -- | |
86 | ---------------- | |
87 | ||
88 | function To_Timeval (D : Duration) return struct_timeval is | |
89 | S : long; | |
90 | F : Duration; | |
91 | ||
92 | begin | |
93 | S := long (Long_Long_Integer (D)); | |
94 | F := D - Duration (S); | |
95 | ||
96 | -- If F has negative value due to a round-up, adjust for positive F | |
97 | -- value. | |
98 | ||
99 | if F < 0.0 then | |
100 | S := S - 1; | |
101 | F := F + 1.0; | |
102 | end if; | |
103 | ||
bcea76b6 GB |
104 | return |
105 | struct_timeval' | |
106 | (tv_sec => S, | |
107 | tv_usec => long (Long_Long_Integer (F * 10#1#E6))); | |
84481f76 RK |
108 | end To_Timeval; |
109 | ||
110 | ------------------- | |
111 | -- clock_gettime -- | |
112 | ------------------- | |
113 | ||
114 | function clock_gettime | |
115 | (clock_id : clockid_t; | |
bcea76b6 GB |
116 | tp : access timespec) |
117 | return int | |
84481f76 | 118 | is |
bcea76b6 GB |
119 | pragma Warnings (Off, clock_id); |
120 | ||
84481f76 RK |
121 | Result : int; |
122 | tv : aliased struct_timeval; | |
123 | ||
124 | function gettimeofday | |
bcea76b6 GB |
125 | (tv : access struct_timeval; |
126 | tz : System.Address := System.Null_Address) | |
127 | return int; | |
84481f76 RK |
128 | pragma Import (C, gettimeofday, "gettimeofday"); |
129 | ||
130 | begin | |
131 | Result := gettimeofday (tv'Unchecked_Access); | |
132 | tp.all := To_Timespec (To_Duration (tv)); | |
133 | return Result; | |
134 | end clock_gettime; | |
135 | ||
136 | --------------------------- | |
137 | -- POSIX.1c Section 3 -- | |
138 | --------------------------- | |
139 | ||
140 | function sigwait (set : access sigset_t; sig : access Signal) return int is | |
141 | Result : int; | |
142 | ||
143 | function sigwait (set : access sigset_t) return int; | |
144 | pragma Import (C, sigwait, "sigwait"); | |
145 | ||
146 | begin | |
147 | Result := sigwait (set); | |
148 | ||
149 | if Result < 0 then | |
150 | sig.all := 0; | |
151 | return errno; | |
152 | end if; | |
153 | ||
154 | sig.all := Signal (Result); | |
155 | return 0; | |
156 | end sigwait; | |
157 | ||
158 | function pthread_kill (thread : pthread_t; sig : Signal) return int is | |
159 | function pthread_kill_base | |
160 | (thread : access pthread_t; sig : access Signal) return int; | |
161 | pragma Import (C, pthread_kill_base, "pthread_kill"); | |
162 | ||
163 | thr : aliased pthread_t := thread; | |
164 | signo : aliased Signal := sig; | |
165 | ||
166 | begin | |
167 | return pthread_kill_base (thr'Unchecked_Access, signo'Unchecked_Access); | |
168 | end pthread_kill; | |
169 | ||
170 | function Get_Stack_Base (thread : pthread_t) return Address is | |
bcea76b6 GB |
171 | pragma Warnings (Off, thread); |
172 | ||
84481f76 RK |
173 | begin |
174 | return Null_Address; | |
175 | end Get_Stack_Base; | |
176 | ||
177 | procedure pthread_init is | |
178 | begin | |
179 | null; | |
180 | end pthread_init; | |
181 | ||
182 | end System.OS_Interface; |