gcc/ada/5gtasinf.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                     S Y S T E M . T A S K _ I N F O                      --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.2 $                              --
  10 --                                                                          --
  11 --          Copyright (C) 1992-1998 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT was originally developed  by the GNAT team at  New York University. --
  32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 --  This package body contains the routines associated with the implementation
  37 --  of the Task_Info pragma.
  38
  39 --  This is the SGI specific version of this module.
  40
  41 with Interfaces.C;
  42 with System.OS_Interface;
  43 with System;
  44 with Unchecked_Conversion;
  45 package body System.Task_Info is
  46
  47    use System.OS_Interface;
  48    use type Interfaces.C.int;
  49
  50    function To_Resource_T is new
  51      Unchecked_Conversion (Resource_Vector_T, resource_t);
  52
  53    MP_NPROCS : constant := 1;
  54
  55    function Sysmp (Cmd : Integer) return Integer;
  56    pragma Import (C, Sysmp);
  57
  58    function Num_Processors (Cmd : Integer := MP_NPROCS) return Integer
  59      renames Sysmp;
  60
  61    function Geteuid return Integer;
  62    pragma Import (C, Geteuid);
  63
  64    Locking_Map : constant array (Page_Locking) of Interfaces.C.int :=
  65      (NOLOCK   => 0,
  66       PROCLOCK => 1,
  67       TXTLOCK  => 2,
  68       DATLOCK  => 4);
  69
  70    package body Resource_Vector_Functions is
  71
  72       function "+" (R : Resource_T)
  73         return Resource_Vector_T is
  74          Result  : Resource_Vector_T  := NO_RESOURCES;
  75       begin
  76          Result (Resource_T'Pos (R)) := True;
  77          return Result;
  78       end "+";
  79
  80       function "+" (R1, R2 : Resource_T)
  81         return Resource_Vector_T is
  82          Result  : Resource_Vector_T  := NO_RESOURCES;
  83       begin
  84          Result (Resource_T'Pos (R1)) := True;
  85          Result (Resource_T'Pos (R2)) := True;
  86          return Result;
  87       end "+";
  88
  89       function "+" (R : Resource_T; S : Resource_Vector_T)
  90         return Resource_Vector_T is
  91          Result  : Resource_Vector_T := S;
  92       begin
  93          Result (Resource_T'Pos (R)) := True;
  94          return Result;
  95       end "+";
  96
  97       function "+" (S : Resource_Vector_T; R : Resource_T)
  98         return Resource_Vector_T is
  99          Result  : Resource_Vector_T :=  S;
 100       begin
 101          Result (Resource_T'Pos (R)) := True;
 102          return Result;
 103       end "+";
 104
 105       function "+" (S1, S2 : Resource_Vector_T)
 106         return Resource_Vector_T is
 107          Result  : Resource_Vector_T;
 108       begin
 109          Result :=  S1 or S2;
 110          return Result;
 111       end "+";
 112
 113       function "-" (S : Resource_Vector_T; R : Resource_T)
 114         return Resource_Vector_T is
 115          Result  : Resource_Vector_T := S;
 116       begin
 117          Result (Resource_T'Pos (R)) := False;
 118          return Result;
 119       end "-";
 120
 121    end Resource_Vector_Functions;
 122
 123    function New_Sproc (Attr : Sproc_Attributes) return sproc_t is
 124       Sproc_Attr : aliased sproc_attr_t;
 125       Sproc      : aliased sproc_t;
 126       Status     : int;
 127    begin
 128       Status := sproc_attr_init (Sproc_Attr'Unrestricted_Access);
 129       if Status = 0 then
 130
 131          Status := sproc_attr_setresources
 132            (Sproc_Attr'Unrestricted_Access,
 133             To_Resource_T (Attr.Sproc_Resources));
 134
 135          if Attr.CPU /= ANY_CPU then
 136             if Attr.CPU > Num_Processors then
 137                raise Invalid_CPU_Number;
 138             end if;
 139             Status := sproc_attr_setcpu
 140               (Sproc_Attr'Unrestricted_Access,
 141                int (Attr.CPU));
 142          end if;
 143
 144          if Attr.Resident /= NOLOCK then
 145
 146             if Geteuid /= 0 then
 147                raise Permission_Error;
 148             end if;
 149
 150             Status := sproc_attr_setresident
 151               (Sproc_Attr'Unrestricted_Access,
 152                 Locking_Map (Attr.Resident));
 153          end if;
 154
 155          if Attr.NDPRI /= NDP_NONE then
 156 --          if Geteuid /= 0 then
 157 --             raise Permission_Error;
 158 --          end if;
 159
 160             Status := sproc_attr_setprio
 161               (Sproc_Attr'Unrestricted_Access,
 162                int (Attr.NDPRI));
 163          end if;
 164
 165          Status := sproc_create
 166            (Sproc'Unrestricted_Access,
 167             Sproc_Attr'Unrestricted_Access,
 168             null,
 169             System.Null_Address);
 170
 171          if Status /= 0 then
 172             Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
 173             raise Sproc_Create_Error;
 174          end if;
 175
 176          Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
 177
 178       end if;
 179
 180       if Status /= 0 then
 181          raise Sproc_Create_Error;
 182       end if;
 183
 184       return Sproc;
 185    end New_Sproc;
 186
 187    function New_Sproc
 188      (Sproc_Resources : Resource_Vector_T      := NO_RESOURCES;
 189       CPU             : CPU_Number             := ANY_CPU;
 190       Resident        : Page_Locking           := NOLOCK;
 191       NDPRI           : Non_Degrading_Priority := NDP_NONE)
 192       return            sproc_t is
 193
 194       Attr : Sproc_Attributes :=
 195         (Sproc_Resources, CPU, Resident, NDPRI);
 196
 197    begin
 198       return New_Sproc (Attr);
 199    end New_Sproc;
 200
 201    function Unbound_Thread_Attributes
 202      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 203       Thread_Timeslice : Duration          := 0.0)
 204       return             Thread_Attributes is
 205    begin
 206       return (False, Thread_Resources, Thread_Timeslice);
 207    end Unbound_Thread_Attributes;
 208
 209    function Bound_Thread_Attributes
 210      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 211       Thread_Timeslice : Duration          := 0.0;
 212       Sproc            : sproc_t)
 213       return             Thread_Attributes is
 214    begin
 215       return (True, Thread_Resources, Thread_Timeslice, Sproc);
 216    end Bound_Thread_Attributes;
 217
 218    function Bound_Thread_Attributes
 219      (Thread_Resources : Resource_Vector_T      := NO_RESOURCES;
 220       Thread_Timeslice : Duration               := 0.0;
 221       Sproc_Resources  : Resource_Vector_T      := NO_RESOURCES;
 222       CPU              : CPU_Number             := ANY_CPU;
 223       Resident         : Page_Locking           := NOLOCK;
 224       NDPRI            : Non_Degrading_Priority := NDP_NONE)
 225       return             Thread_Attributes is
 226
 227       Sproc : sproc_t := New_Sproc
 228         (Sproc_Resources, CPU, Resident, NDPRI);
 229
 230    begin
 231       return (True, Thread_Resources, Thread_Timeslice, Sproc);
 232    end Bound_Thread_Attributes;
 233
 234    function New_Unbound_Thread_Attributes
 235      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 236       Thread_Timeslice : Duration          := 0.0)
 237       return             Task_Info_Type is
 238    begin
 239       return new Thread_Attributes'
 240         (False, Thread_Resources, Thread_Timeslice);
 241    end New_Unbound_Thread_Attributes;
 242
 243    function New_Bound_Thread_Attributes
 244      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 245       Thread_Timeslice : Duration          := 0.0;
 246       Sproc            : sproc_t)
 247       return             Task_Info_Type is
 248    begin
 249       return new Thread_Attributes'
 250         (True, Thread_Resources, Thread_Timeslice, Sproc);
 251    end  New_Bound_Thread_Attributes;
 252
 253    function New_Bound_Thread_Attributes
 254      (Thread_Resources : Resource_Vector_T      := NO_RESOURCES;
 255       Thread_Timeslice : Duration               := 0.0;
 256       Sproc_Resources  : Resource_Vector_T      := NO_RESOURCES;
 257       CPU              : CPU_Number             := ANY_CPU;
 258       Resident         : Page_Locking           := NOLOCK;
 259       NDPRI            : Non_Degrading_Priority := NDP_NONE)
 260       return             Task_Info_Type is
 261
 262       Sproc : sproc_t := New_Sproc
 263         (Sproc_Resources, CPU, Resident, NDPRI);
 264
 265    begin
 266       return new Thread_Attributes'
 267         (True, Thread_Resources, Thread_Timeslice, Sproc);
 268    end  New_Bound_Thread_Attributes;
 269
 270 end System.Task_Info;