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) 1997-2009, 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-- 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. -- 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 AIX (Native) version of this package 33 34pragma Polling (Off); 35-- Turn off polling, we do not want ATC polling to take place during tasking 36-- operations. It causes infinite loops and other problems. 37 38package body System.OS_Interface is 39 40 use Interfaces.C; 41 42 ----------------- 43 -- To_Duration -- 44 ----------------- 45 46 function To_Duration (TS : timespec) return Duration is 47 begin 48 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 49 end To_Duration; 50 51 ------------------------ 52 -- To_Target_Priority -- 53 ------------------------ 54 55 function To_Target_Priority 56 (Prio : System.Any_Priority) return Interfaces.C.int 57 is 58 Dispatching_Policy : Character; 59 pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); 60 61 Time_Slice_Val : Integer; 62 pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); 63 64 begin 65 -- For the case SCHED_OTHER the only valid priority across all supported 66 -- versions of AIX is 1 (note that the scheduling policy can be set 67 -- with the pragma Task_Dispatching_Policy or setting the time slice 68 -- value). Otherwise, for SCHED_RR and SCHED_FIFO, the system defines 69 -- priorities in the range 1 .. 127. This means that we must map 70 -- System.Any_Priority in the range 0 .. 126 to 1 .. 127. 71 72 if Dispatching_Policy = ' ' and then Time_Slice_Val < 0 then 73 return 1; 74 else 75 return Interfaces.C.int (Prio) + 1; 76 end if; 77 end To_Target_Priority; 78 79 ----------------- 80 -- To_Timespec -- 81 ----------------- 82 83 function To_Timespec (D : Duration) return timespec is 84 S : time_t; 85 F : Duration; 86 87 begin 88 S := time_t (Long_Long_Integer (D)); 89 F := D - Duration (S); 90 91 -- If F is negative due to a round-up, adjust for positive F value 92 93 if F < 0.0 then 94 S := S - 1; 95 F := F + 1.0; 96 end if; 97 98 return timespec'(tv_sec => S, 99 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 100 end To_Timespec; 101 102 ------------------- 103 -- clock_gettime -- 104 ------------------- 105 106 function clock_gettime 107 (clock_id : clockid_t; 108 tp : access timespec) 109 return int 110 is 111 pragma Unreferenced (clock_id); 112 113 -- Older AIX don't have clock_gettime, so use gettimeofday 114 115 use Interfaces; 116 117 type timeval is array (1 .. 2) of C.long; 118 119 procedure timeval_to_duration 120 (T : not null access timeval; 121 sec : not null access C.long; 122 usec : not null access C.long); 123 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); 124 125 Micro : constant := 10**6; 126 sec : aliased C.long; 127 usec : aliased C.long; 128 TV : aliased timeval; 129 Result : int; 130 131 function gettimeofday 132 (Tv : access timeval; 133 Tz : System.Address := System.Null_Address) return int; 134 pragma Import (C, gettimeofday, "gettimeofday"); 135 136 begin 137 Result := gettimeofday (TV'Access, System.Null_Address); 138 pragma Assert (Result = 0); 139 timeval_to_duration (TV'Access, sec'Access, usec'Access); 140 tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro); 141 return Result; 142 end clock_gettime; 143 144 ----------------- 145 -- sched_yield -- 146 ----------------- 147 148 -- AIX Thread does not have sched_yield; 149 150 function sched_yield return int is 151 procedure pthread_yield; 152 pragma Import (C, pthread_yield, "sched_yield"); 153 begin 154 pthread_yield; 155 return 0; 156 end sched_yield; 157 158 -------------------- 159 -- Get_Stack_Base -- 160 -------------------- 161 162 function Get_Stack_Base (thread : pthread_t) return Address is 163 pragma Warnings (Off, thread); 164 begin 165 return Null_Address; 166 end Get_Stack_Base; 167 168 -------------------------- 169 -- PTHREAD_PRIO_INHERIT -- 170 -------------------------- 171 172 AIX_Version : Integer := 0; 173 -- AIX version in the form xy for AIX version x.y (0 means not set) 174 175 SYS_NMLN : constant := 32; 176 -- AIX system constant used to define utsname, see sys/utsname.h 177 178 subtype String_NMLN is String (1 .. SYS_NMLN); 179 180 type utsname is record 181 sysname : String_NMLN; 182 nodename : String_NMLN; 183 release : String_NMLN; 184 version : String_NMLN; 185 machine : String_NMLN; 186 procserial : String_NMLN; 187 end record; 188 pragma Convention (C, utsname); 189 190 procedure uname (name : out utsname); 191 pragma Import (C, uname); 192 193 function PTHREAD_PRIO_INHERIT return int is 194 name : utsname; 195 196 function Val (C : Character) return Integer; 197 -- Transform a numeric character ('0' .. '9') to an integer 198 199 --------- 200 -- Val -- 201 --------- 202 203 function Val (C : Character) return Integer is 204 begin 205 return Character'Pos (C) - Character'Pos ('0'); 206 end Val; 207 208 -- Start of processing for PTHREAD_PRIO_INHERIT 209 210 begin 211 if AIX_Version = 0 then 212 213 -- Set AIX_Version 214 215 uname (name); 216 AIX_Version := Val (name.version (1)) * 10 + Val (name.release (1)); 217 end if; 218 219 if AIX_Version < 53 then 220 221 -- Under AIX < 5.3, PTHREAD_PRIO_INHERIT is defined as 0 in pthread.h 222 223 return 0; 224 225 else 226 -- Under AIX >= 5.3, PTHREAD_PRIO_INHERIT is defined as 3 227 228 return 3; 229 end if; 230 end PTHREAD_PRIO_INHERIT; 231 232end System.OS_Interface; 233