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