diff options
Diffstat (limited to 'gcc/ada/s-tasinf-irix-athread.adb')
| -rw-r--r-- | gcc/ada/s-tasinf-irix-athread.adb | 312 |
1 files changed, 312 insertions, 0 deletions
diff --git a/gcc/ada/s-tasinf-irix-athread.adb b/gcc/ada/s-tasinf-irix-athread.adb new file mode 100644 index 00000000000..5413ebf8830 --- /dev/null +++ b/gcc/ada/s-tasinf-irix-athread.adb @@ -0,0 +1,312 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . T A S K _ I N F O -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2004 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); + + ------------------------------- + -- Resource_Vector_Functions -- + ------------------------------- + + 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; + + --------------- + -- New_Sproc -- + --------------- + + 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 + +-- ??? why is this commented out, should it be removed ? +-- 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; + + --------------- + -- 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; + + ------------------------------- + -- Unbound_Thread_Attributes -- + ------------------------------- + + 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; + + ----------------------------- + -- Bound_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; + + ----------------------------- + -- 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; + + ----------------------------------- + -- New_Unbound_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; + + --------------------------------- + -- New_Bound_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; + + --------------------------------- + -- 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; |