File : s-osinte-darwin.adb
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) 1999-2015, 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 -- --
19 -- --
20 -- --
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 a Darwin Threads version of this package
33
34 pragma Polling (Off);
35 -- Turn off polling, we do not want ATC polling to take place during
36 -- tasking operations. It causes infinite loops and other problems.
37
38 with Interfaces.C.Extensions;
39
40 package body System.OS_Interface is
41 use Interfaces.C;
42 use Interfaces.C.Extensions;
43
44 -----------------
45 -- To_Duration --
46 -----------------
47
48 function To_Duration (TS : timespec) return Duration is
49 begin
50 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
51 end To_Duration;
52
53 ------------------------
54 -- To_Target_Priority --
55 ------------------------
56
57 function To_Target_Priority
58 (Prio : System.Any_Priority) return Interfaces.C.int
59 is
60 begin
61 return Interfaces.C.int (Prio);
62 end To_Target_Priority;
63
64 -----------------
65 -- To_Timespec --
66 -----------------
67
68 function To_Timespec (D : Duration) return timespec is
69 S : time_t;
70 F : Duration;
71
72 begin
73 S := time_t (Long_Long_Integer (D));
74 F := D - Duration (S);
75
76 -- If F has negative value due to a round-up, adjust for positive F
77 -- value.
78
79 if F < 0.0 then
80 S := S - 1;
81 F := F + 1.0;
82 end if;
83
84 return timespec'(tv_sec => S,
85 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
86 end To_Timespec;
87
88 -------------------
89 -- clock_gettime --
90 -------------------
91
92 function clock_gettime
93 (clock_id : clockid_t;
94 tp : access timespec) return int
95 is
96 pragma Unreferenced (clock_id);
97
98 -- Darwin Threads don't have clock_gettime, so use gettimeofday
99
100 use Interfaces;
101
102 type timeval is array (1 .. 3) of C.long;
103 -- The timeval array is sized to contain long_long sec and long usec.
104 -- If long_long'Size = long'Size then it will be overly large but that
105 -- won't effect the implementation since it's not accessed directly.
106
107 procedure timeval_to_duration
108 (T : not null access timeval;
109 sec : not null access C.Extensions.long_long;
110 usec : not null access C.long);
111 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
112
113 Micro : constant := 10**6;
114 sec : aliased C.Extensions.long_long;
115 usec : aliased C.long;
116 TV : aliased timeval;
117 Result : int;
118
119 function gettimeofday
120 (Tv : access timeval;
121 Tz : System.Address := System.Null_Address) return int;
122 pragma Import (C, gettimeofday, "gettimeofday");
123
124 begin
125 Result := gettimeofday (TV'Access, System.Null_Address);
126 pragma Assert (Result = 0);
127 timeval_to_duration (TV'Access, sec'Access, usec'Access);
128 tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro);
129 return Result;
130 end clock_gettime;
131
132 ------------------
133 -- clock_getres --
134 ------------------
135
136 function clock_getres
137 (clock_id : clockid_t;
138 res : access timespec) return int
139 is
140 pragma Unreferenced (clock_id);
141
142 -- Darwin Threads don't have clock_getres.
143
144 Nano : constant := 10**9;
145 nsec : int := 0;
146 Result : int := -1;
147
148 function clock_get_res return int;
149 pragma Import (C, clock_get_res, "__gnat_clock_get_res");
150
151 begin
152 nsec := clock_get_res;
153 res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano);
154
155 if nsec > 0 then
156 Result := 0;
157 end if;
158
159 return Result;
160 end clock_getres;
161
162 -----------------
163 -- sched_yield --
164 -----------------
165
166 function sched_yield return int is
167 procedure sched_yield_base (arg : System.Address);
168 pragma Import (C, sched_yield_base, "pthread_yield_np");
169
170 begin
171 sched_yield_base (System.Null_Address);
172 return 0;
173 end sched_yield;
174
175 ------------------
176 -- pthread_init --
177 ------------------
178
179 procedure pthread_init is
180 begin
181 null;
182 end pthread_init;
183
184 ----------------
185 -- Stack_Base --
186 ----------------
187
188 function Get_Stack_Base (thread : pthread_t) return Address is
189 pragma Unreferenced (thread);
190 begin
191 return System.Null_Address;
192 end Get_Stack_Base;
193
194 end System.OS_Interface;