+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . T A S K _ I N F O --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.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. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- 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;
projects / msp430-gcc.git / blobdiff