s-tasinf-irix-athread.adb [plain text]
with Interfaces.C;
with System.OS_Interface;
with System;
with Unchecked_Conversion;
package body System.Task_Info is
use System.OS_Interface;
use type Interfaces.C.int;
function To_Resource_T is new
Unchecked_Conversion (Resource_Vector_T, resource_t);
MP_NPROCS : constant := 1;
function Sysmp (Cmd : Integer) return Integer;
pragma Import (C, Sysmp);
function Num_Processors (Cmd : Integer := MP_NPROCS) return Integer
renames Sysmp;
function Geteuid return Integer;
pragma Import (C, Geteuid);
Locking_Map : constant array (Page_Locking) of Interfaces.C.int :=
(NOLOCK => 0,
PROCLOCK => 1,
TXTLOCK => 2,
DATLOCK => 4);
package body Resource_Vector_Functions is
function "+" (R : Resource_T) return Resource_Vector_T is
Result : Resource_Vector_T := NO_RESOURCES;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+" (R1, R2 : Resource_T) return Resource_Vector_T is
Result : Resource_Vector_T := NO_RESOURCES;
begin
Result (Resource_T'Pos (R1)) := True;
Result (Resource_T'Pos (R2)) := True;
return Result;
end "+";
function "+"
(R : Resource_T;
S : Resource_Vector_T) return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+"
(S : Resource_Vector_T;
R : Resource_T) return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := True;
return Result;
end "+";
function "+" (S1, S2 : Resource_Vector_T) return Resource_Vector_T is
Result : Resource_Vector_T;
begin
Result := S1 or S2;
return Result;
end "+";
function "-"
(S : Resource_Vector_T;
R : Resource_T) return Resource_Vector_T
is
Result : Resource_Vector_T := S;
begin
Result (Resource_T'Pos (R)) := False;
return Result;
end "-";
end Resource_Vector_Functions;
function New_Sproc (Attr : Sproc_Attributes) return sproc_t is
Sproc_Attr : aliased sproc_attr_t;
Sproc : aliased sproc_t;
Status : int;
begin
Status := sproc_attr_init (Sproc_Attr'Unrestricted_Access);
if Status = 0 then
Status := sproc_attr_setresources
(Sproc_Attr'Unrestricted_Access,
To_Resource_T (Attr.Sproc_Resources));
if Attr.CPU /= ANY_CPU then
if Attr.CPU > Num_Processors then
raise Invalid_CPU_Number;
end if;
Status := sproc_attr_setcpu
(Sproc_Attr'Unrestricted_Access,
int (Attr.CPU));
end if;
if Attr.Resident /= NOLOCK then
if Geteuid /= 0 then
raise Permission_Error;
end if;
Status := sproc_attr_setresident
(Sproc_Attr'Unrestricted_Access,
Locking_Map (Attr.Resident));
end if;
if Attr.NDPRI /= NDP_NONE then
Status :=
sproc_attr_setprio
(Sproc_Attr'Unrestricted_Access, int (Attr.NDPRI));
end if;
Status :=
sproc_create
(Sproc'Unrestricted_Access,
Sproc_Attr'Unrestricted_Access,
null,
System.Null_Address);
if Status /= 0 then
Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
raise Sproc_Create_Error;
end if;
Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
end if;
if Status /= 0 then
raise Sproc_Create_Error;
end if;
return Sproc;
end New_Sproc;
function New_Sproc
(Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE) return sproc_t
is
Attr : constant Sproc_Attributes :=
(Sproc_Resources, CPU, Resident, NDPRI);
begin
return New_Sproc (Attr);
end New_Sproc;
function Unbound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0) return Thread_Attributes
is
begin
return (False, Thread_Resources, Thread_Timeslice);
end Unbound_Thread_Attributes;
function Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc : sproc_t)
return Thread_Attributes
is
begin
return (True, Thread_Resources, Thread_Timeslice, Sproc);
end Bound_Thread_Attributes;
function Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return Thread_Attributes
is
Sproc : constant sproc_t := New_Sproc
(Sproc_Resources, CPU, Resident, NDPRI);
begin
return (True, Thread_Resources, Thread_Timeslice, Sproc);
end Bound_Thread_Attributes;
function New_Unbound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0) return Task_Info_Type
is
begin
return new Thread_Attributes'
(False, Thread_Resources, Thread_Timeslice);
end New_Unbound_Thread_Attributes;
function New_Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc : sproc_t) return Task_Info_Type
is
begin
return new Thread_Attributes'
(True, Thread_Resources, Thread_Timeslice, Sproc);
end New_Bound_Thread_Attributes;
function New_Bound_Thread_Attributes
(Thread_Resources : Resource_Vector_T := NO_RESOURCES;
Thread_Timeslice : Duration := 0.0;
Sproc_Resources : Resource_Vector_T := NO_RESOURCES;
CPU : CPU_Number := ANY_CPU;
Resident : Page_Locking := NOLOCK;
NDPRI : Non_Degrading_Priority := NDP_NONE)
return Task_Info_Type
is
Sproc : constant sproc_t := New_Sproc
(Sproc_Resources, CPU, Resident, NDPRI);
begin
return new Thread_Attributes'
(True, Thread_Resources, Thread_Timeslice, Sproc);
end New_Bound_Thread_Attributes;
end System.Task_Info;