File : s-osinte-aix.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) 1997-2013, 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 AIX (Native) version of this package
33
34 pragma 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
38 package 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 -- sched_yield --
104 -----------------
105
106 -- AIX Thread does not have sched_yield;
107
108 function sched_yield return int is
109 procedure pthread_yield;
110 pragma Import (C, pthread_yield, "sched_yield");
111 begin
112 pthread_yield;
113 return 0;
114 end sched_yield;
115
116 --------------------
117 -- Get_Stack_Base --
118 --------------------
119
120 function Get_Stack_Base (thread : pthread_t) return Address is
121 pragma Warnings (Off, thread);
122 begin
123 return Null_Address;
124 end Get_Stack_Base;
125
126 --------------------------
127 -- PTHREAD_PRIO_INHERIT --
128 --------------------------
129
130 AIX_Version : Integer := 0;
131 -- AIX version in the form xy for AIX version x.y (0 means not set)
132
133 SYS_NMLN : constant := 32;
134 -- AIX system constant used to define utsname, see sys/utsname.h
135
136 subtype String_NMLN is String (1 .. SYS_NMLN);
137
138 type utsname is record
139 sysname : String_NMLN;
140 nodename : String_NMLN;
141 release : String_NMLN;
142 version : String_NMLN;
143 machine : String_NMLN;
144 procserial : String_NMLN;
145 end record;
146 pragma Convention (C, utsname);
147
148 procedure uname (name : out utsname);
149 pragma Import (C, uname);
150
151 function PTHREAD_PRIO_INHERIT return int is
152 name : utsname;
153
154 function Val (C : Character) return Integer;
155 -- Transform a numeric character ('0' .. '9') to an integer
156
157 ---------
158 -- Val --
159 ---------
160
161 function Val (C : Character) return Integer is
162 begin
163 return Character'Pos (C) - Character'Pos ('0');
164 end Val;
165
166 -- Start of processing for PTHREAD_PRIO_INHERIT
167
168 begin
169 if AIX_Version = 0 then
170
171 -- Set AIX_Version
172
173 uname (name);
174 AIX_Version := Val (name.version (1)) * 10 + Val (name.release (1));
175 end if;
176
177 if AIX_Version < 53 then
178
179 -- Under AIX < 5.3, PTHREAD_PRIO_INHERIT is defined as 0 in pthread.h
180
181 return 0;
182
183 else
184 -- Under AIX >= 5.3, PTHREAD_PRIO_INHERIT is defined as 3
185
186 return 3;
187 end if;
188 end PTHREAD_PRIO_INHERIT;
189
190 end System.OS_Interface;