1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . O S _ I N T E R F A C E --
9 -- Copyright (C) 1997-2009, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 -- This is a AIX (Native) version of this package
35 -- Turn off polling, we do not want ATC polling to take place during tasking
36 -- operations. It causes infinite loops and other problems.
38 package body System.OS_Interface is
46 function To_Duration (TS : timespec) return Duration is
48 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
51 function To_Duration (TV : struct_timeval) return Duration is
53 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
56 ------------------------
57 -- To_Target_Priority --
58 ------------------------
60 function To_Target_Priority
61 (Prio : System.Any_Priority) return Interfaces.C.int
63 Dispatching_Policy : Character;
64 pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
66 Time_Slice_Val : Integer;
67 pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
70 -- For the case SCHED_OTHER the only valid priority across all supported
71 -- versions of AIX is 1 (note that the scheduling policy can be set
72 -- with the pragma Task_Dispatching_Policy or setting the time slice
73 -- value). Otherwise, for SCHED_RR and SCHED_FIFO, the system defines
74 -- priorities in the range 1 .. 127. This means that we must map
75 -- System.Any_Priority in the range 0 .. 126 to 1 .. 127.
77 if Dispatching_Policy = ' ' and then Time_Slice_Val < 0 then
80 return Interfaces.C.int (Prio) + 1;
82 end To_Target_Priority;
88 function To_Timespec (D : Duration) return timespec is
93 S := time_t (Long_Long_Integer (D));
94 F := D - Duration (S);
96 -- If F is negative due to a round-up, adjust for positive F value
103 return timespec'(tv_sec => S,
104 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
111 function To_Timeval (D : Duration) return struct_timeval is
116 S := long (Long_Long_Integer (D));
117 F := D - Duration (S);
119 -- If F is negative due to a round-up, adjust for positive F value
129 tv_usec => long (Long_Long_Integer (F * 10#1#E6)));
136 function clock_gettime
137 (clock_id : clockid_t;
138 tp : access timespec)
141 pragma Warnings (Off, clock_id);
144 tv : aliased struct_timeval;
146 function gettimeofday
147 (tv : access struct_timeval;
148 tz : System.Address := System.Null_Address)
150 pragma Import (C, gettimeofday, "gettimeofday");
153 Result := gettimeofday (tv'Unchecked_Access);
154 tp.all := To_Timespec (To_Duration (tv));
162 -- AIX Thread does not have sched_yield;
164 function sched_yield return int is
165 procedure pthread_yield;
166 pragma Import (C, pthread_yield, "sched_yield");
176 function Get_Stack_Base (thread : pthread_t) return Address is
177 pragma Warnings (Off, thread);
182 --------------------------
183 -- PTHREAD_PRIO_INHERIT --
184 --------------------------
186 AIX_Version : Integer := 0;
187 -- AIX version in the form xy for AIX version x.y (0 means not set)
189 SYS_NMLN : constant := 32;
190 -- AIX system constant used to define utsname, see sys/utsname.h
192 subtype String_NMLN is String (1 .. SYS_NMLN);
194 type utsname is record
195 sysname : String_NMLN;
196 nodename : String_NMLN;
197 release : String_NMLN;
198 version : String_NMLN;
199 machine : String_NMLN;
200 procserial : String_NMLN;
202 pragma Convention (C, utsname);
204 procedure uname (name : out utsname);
205 pragma Import (C, uname);
207 function PTHREAD_PRIO_INHERIT return int is
210 function Val (C : Character) return Integer;
211 -- Transform a numeric character ('0' .. '9') to an integer
217 function Val (C : Character) return Integer is
219 return Character'Pos (C) - Character'Pos ('0');
222 -- Start of processing for PTHREAD_PRIO_INHERIT
225 if AIX_Version = 0 then
230 AIX_Version := Val (name.version (1)) * 10 + Val (name.release (1));
233 if AIX_Version < 53 then
235 -- Under AIX < 5.3, PTHREAD_PRIO_INHERIT is defined as 0 in pthread.h
240 -- Under AIX >= 5.3, PTHREAD_PRIO_INHERIT is defined as 3
244 end PTHREAD_PRIO_INHERIT;
246 end System.OS_Interface;