1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . T A S K _ I N F O --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 -- This package body contains the routines associated with the implementation
36 -- of the Task_Info pragma.
38 -- This is the SGI specific version of this module.
41 with System
.OS_Interface
;
43 with Unchecked_Conversion
;
45 package body System
.Task_Info
is
47 use System
.OS_Interface
;
48 use type Interfaces
.C
.int
;
50 function To_Resource_T
is new
51 Unchecked_Conversion
(Resource_Vector_T
, resource_t
);
53 MP_NPROCS
: constant := 1;
55 function Sysmp
(Cmd
: Integer) return Integer;
56 pragma Import
(C
, Sysmp
);
58 function Num_Processors
(Cmd
: Integer := MP_NPROCS
) return Integer
61 function Geteuid
return Integer;
62 pragma Import
(C
, Geteuid
);
64 Locking_Map
: constant array (Page_Locking
) of Interfaces
.C
.int
:=
70 -------------------------------
71 -- Resource_Vector_Functions --
72 -------------------------------
74 package body Resource_Vector_Functions
is
80 function "+" (R
: Resource_T
) return Resource_Vector_T
is
81 Result
: Resource_Vector_T
:= NO_RESOURCES
;
84 Result
(Resource_T
'Pos (R
)) := True;
88 function "+" (R1
, R2
: Resource_T
) return Resource_Vector_T
is
89 Result
: Resource_Vector_T
:= NO_RESOURCES
;
92 Result
(Resource_T
'Pos (R1
)) := True;
93 Result
(Resource_T
'Pos (R2
)) := True;
99 S
: Resource_Vector_T
)
100 return Resource_Vector_T
102 Result
: Resource_Vector_T
:= S
;
105 Result
(Resource_T
'Pos (R
)) := True;
110 (S
: Resource_Vector_T
;
112 return Resource_Vector_T
114 Result
: Resource_Vector_T
:= S
;
117 Result
(Resource_T
'Pos (R
)) := True;
121 function "+" (S1
, S2
: Resource_Vector_T
) return Resource_Vector_T
is
122 Result
: Resource_Vector_T
;
130 (S
: Resource_Vector_T
;
132 return Resource_Vector_T
134 Result
: Resource_Vector_T
:= S
;
137 Result
(Resource_T
'Pos (R
)) := False;
141 end Resource_Vector_Functions
;
147 function New_Sproc
(Attr
: Sproc_Attributes
) return sproc_t
is
148 Sproc_Attr
: aliased sproc_attr_t
;
149 Sproc
: aliased sproc_t
;
153 Status
:= sproc_attr_init
(Sproc_Attr
'Unrestricted_Access);
156 Status
:= sproc_attr_setresources
157 (Sproc_Attr
'Unrestricted_Access,
158 To_Resource_T
(Attr
.Sproc_Resources
));
160 if Attr
.CPU
/= ANY_CPU
then
161 if Attr
.CPU
> Num_Processors
then
162 raise Invalid_CPU_Number
;
165 Status
:= sproc_attr_setcpu
166 (Sproc_Attr
'Unrestricted_Access,
170 if Attr
.Resident
/= NOLOCK
then
172 raise Permission_Error
;
175 Status
:= sproc_attr_setresident
176 (Sproc_Attr
'Unrestricted_Access,
177 Locking_Map
(Attr
.Resident
));
180 if Attr
.NDPRI
/= NDP_NONE
then
181 -- ??? why is that comment out, should it be removed ?
182 -- if Geteuid /= 0 then
183 -- raise Permission_Error;
186 Status
:= sproc_attr_setprio
187 (Sproc_Attr
'Unrestricted_Access,
191 Status
:= sproc_create
192 (Sproc
'Unrestricted_Access,
193 Sproc_Attr
'Unrestricted_Access,
195 System
.Null_Address
);
198 Status
:= sproc_attr_destroy
(Sproc_Attr
'Unrestricted_Access);
199 raise Sproc_Create_Error
;
202 Status
:= sproc_attr_destroy
(Sproc_Attr
'Unrestricted_Access);
207 raise Sproc_Create_Error
;
218 (Sproc_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
219 CPU
: CPU_Number
:= ANY_CPU
;
220 Resident
: Page_Locking
:= NOLOCK
;
221 NDPRI
: Non_Degrading_Priority
:= NDP_NONE
)
224 Attr
: Sproc_Attributes
:=
225 (Sproc_Resources
, CPU
, Resident
, NDPRI
);
228 return New_Sproc
(Attr
);
231 -------------------------------
232 -- Unbound_Thread_Attributes --
233 -------------------------------
235 function Unbound_Thread_Attributes
236 (Thread_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
237 Thread_Timeslice
: Duration := 0.0)
238 return Thread_Attributes
241 return (False, Thread_Resources
, Thread_Timeslice
);
242 end Unbound_Thread_Attributes
;
244 -----------------------------
245 -- Bound_Thread_Attributes --
246 -----------------------------
248 function Bound_Thread_Attributes
249 (Thread_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
250 Thread_Timeslice
: Duration := 0.0;
252 return Thread_Attributes
255 return (True, Thread_Resources
, Thread_Timeslice
, Sproc
);
256 end Bound_Thread_Attributes
;
258 -----------------------------
259 -- Bound_Thread_Attributes --
260 -----------------------------
262 function Bound_Thread_Attributes
263 (Thread_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
264 Thread_Timeslice
: Duration := 0.0;
265 Sproc_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
266 CPU
: CPU_Number
:= ANY_CPU
;
267 Resident
: Page_Locking
:= NOLOCK
;
268 NDPRI
: Non_Degrading_Priority
:= NDP_NONE
)
269 return Thread_Attributes
271 Sproc
: sproc_t
:= New_Sproc
272 (Sproc_Resources
, CPU
, Resident
, NDPRI
);
275 return (True, Thread_Resources
, Thread_Timeslice
, Sproc
);
276 end Bound_Thread_Attributes
;
278 -----------------------------------
279 -- New_Unbound_Thread_Attributes --
280 -----------------------------------
282 function New_Unbound_Thread_Attributes
283 (Thread_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
284 Thread_Timeslice
: Duration := 0.0)
285 return Task_Info_Type
288 return new Thread_Attributes
'
289 (False, Thread_Resources, Thread_Timeslice);
290 end New_Unbound_Thread_Attributes;
292 ---------------------------------
293 -- New_Bound_Thread_Attributes --
294 ---------------------------------
296 function New_Bound_Thread_Attributes
297 (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
298 Thread_Timeslice : Duration := 0.0;
300 return Task_Info_Type
303 return new Thread_Attributes'
304 (True, Thread_Resources
, Thread_Timeslice
, Sproc
);
305 end New_Bound_Thread_Attributes
;
307 ---------------------------------
308 -- New_Bound_Thread_Attributes --
309 ---------------------------------
311 function New_Bound_Thread_Attributes
312 (Thread_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
313 Thread_Timeslice
: Duration := 0.0;
314 Sproc_Resources
: Resource_Vector_T
:= NO_RESOURCES
;
315 CPU
: CPU_Number
:= ANY_CPU
;
316 Resident
: Page_Locking
:= NOLOCK
;
317 NDPRI
: Non_Degrading_Priority
:= NDP_NONE
)
318 return Task_Info_Type
320 Sproc
: sproc_t
:= New_Sproc
321 (Sproc_Resources
, CPU
, Resident
, NDPRI
);
324 return new Thread_Attributes
'
325 (True, Thread_Resources, Thread_Timeslice, Sproc);
326 end New_Bound_Thread_Attributes;
328 end System.Task_Info;