271 lines
9.7 KiB
Ada
271 lines
9.7 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S Y S T E M . T A S K _ I N F O --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision: 1.2 $ --
|
|
-- --
|
|
-- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- As a special exception, if other files instantiate generics from this --
|
|
-- unit, or you link this unit with other files to produce an executable, --
|
|
-- this unit does not by itself cause the resulting executable to be --
|
|
-- covered by the GNU General Public License. This exception does not --
|
|
-- however invalidate any other reasons why the executable file might be --
|
|
-- covered by the GNU Public License. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This package body contains the routines associated with the implementation
|
|
-- of the Task_Info pragma.
|
|
|
|
-- This is the SGI specific version of this module.
|
|
|
|
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
|
|
-- if Geteuid /= 0 then
|
|
-- raise Permission_Error;
|
|
-- end if;
|
|
|
|
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 : 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 : 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 : 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;
|