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-2020, 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 34package body System.OS_Interface is 35 36 use Interfaces.C; 37 38 ----------------- 39 -- To_Duration -- 40 ----------------- 41 42 function To_Duration (TS : timespec) return Duration is 43 begin 44 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 45 end To_Duration; 46 47 ------------------------ 48 -- To_Target_Priority -- 49 ------------------------ 50 51 function To_Target_Priority 52 (Prio : System.Any_Priority) return Interfaces.C.int 53 is 54 Dispatching_Policy : Character; 55 pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); 56 57 Time_Slice_Val : Integer; 58 pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); 59 60 begin 61 -- For the case SCHED_OTHER the only valid priority across all supported 62 -- versions of AIX is 1 (note that the scheduling policy can be set 63 -- with the pragma Task_Dispatching_Policy or setting the time slice 64 -- value). Otherwise, for SCHED_RR and SCHED_FIFO, the system defines 65 -- priorities in the range 1 .. 127. This means that we must map 66 -- System.Any_Priority in the range 0 .. 126 to 1 .. 127. 67 68 if Dispatching_Policy = ' ' and then Time_Slice_Val < 0 then 69 return 1; 70 else 71 return Interfaces.C.int (Prio) + 1; 72 end if; 73 end To_Target_Priority; 74 75 ----------------- 76 -- To_Timespec -- 77 ----------------- 78 79 function To_Timespec (D : Duration) return timespec is 80 S : time_t; 81 F : Duration; 82 83 begin 84 S := time_t (Long_Long_Integer (D)); 85 F := D - Duration (S); 86 87 -- If F is negative due to a round-up, adjust for positive F value 88 89 if F < 0.0 then 90 S := S - 1; 91 F := F + 1.0; 92 end if; 93 94 return timespec'(tv_sec => S, 95 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 96 end To_Timespec; 97 98 ----------------- 99 -- sched_yield -- 100 ----------------- 101 102 -- AIX Thread does not have sched_yield; 103 104 function sched_yield return int is 105 procedure pthread_yield; 106 pragma Import (C, pthread_yield, "sched_yield"); 107 begin 108 pthread_yield; 109 return 0; 110 end sched_yield; 111 112 -------------------- 113 -- Get_Stack_Base -- 114 -------------------- 115 116 function Get_Stack_Base (thread : pthread_t) return Address is 117 pragma Warnings (Off, thread); 118 begin 119 return Null_Address; 120 end Get_Stack_Base; 121 122 -------------------------- 123 -- PTHREAD_PRIO_INHERIT -- 124 -------------------------- 125 126 AIX_Version : Integer := 0; 127 -- AIX version in the form xy for AIX version x.y (0 means not set) 128 129 SYS_NMLN : constant := 32; 130 -- AIX system constant used to define utsname, see sys/utsname.h 131 132 subtype String_NMLN is String (1 .. SYS_NMLN); 133 134 type utsname is record 135 sysname : String_NMLN; 136 nodename : String_NMLN; 137 release : String_NMLN; 138 version : String_NMLN; 139 machine : String_NMLN; 140 procserial : String_NMLN; 141 end record; 142 pragma Convention (C, utsname); 143 144 procedure uname (name : out utsname); 145 pragma Import (C, uname); 146 147 function PTHREAD_PRIO_INHERIT return int is 148 name : utsname; 149 150 function Val (C : Character) return Integer; 151 -- Transform a numeric character ('0' .. '9') to an integer 152 153 --------- 154 -- Val -- 155 --------- 156 157 function Val (C : Character) return Integer is 158 begin 159 return Character'Pos (C) - Character'Pos ('0'); 160 end Val; 161 162 -- Start of processing for PTHREAD_PRIO_INHERIT 163 164 begin 165 if AIX_Version = 0 then 166 167 -- Set AIX_Version 168 169 uname (name); 170 AIX_Version := Val (name.version (1)) * 10 + Val (name.release (1)); 171 end if; 172 173 if AIX_Version < 53 then 174 175 -- Under AIX < 5.3, PTHREAD_PRIO_INHERIT is defined as 0 in pthread.h 176 177 return 0; 178 179 else 180 -- Under AIX >= 5.3, PTHREAD_PRIO_INHERIT is defined as 3 181 182 return 3; 183 end if; 184 end PTHREAD_PRIO_INHERIT; 185 186end System.OS_Interface; 187