gcc/ada/s-tasinf-irix-athread.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-2004 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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       begin
  82          Result (Resource_T'Pos (R)) := True;
  83          return Result;
  84       end "+";
  85
  86       function "+" (R1, R2 : Resource_T) return Resource_Vector_T is
  87          Result : Resource_Vector_T  := NO_RESOURCES;
  88       begin
  89          Result (Resource_T'Pos (R1)) := True;
  90          Result (Resource_T'Pos (R2)) := True;
  91          return Result;
  92       end "+";
  93
  94       function "+"
  95         (R : Resource_T;
  96          S : Resource_Vector_T) return Resource_Vector_T
  97       is
  98          Result : Resource_Vector_T := S;
  99       begin
 100          Result (Resource_T'Pos (R)) := True;
 101          return Result;
 102       end "+";
 103
 104       function "+"
 105         (S : Resource_Vector_T;
 106          R : Resource_T) return Resource_Vector_T
 107       is
 108          Result : Resource_Vector_T :=  S;
 109       begin
 110          Result (Resource_T'Pos (R)) := True;
 111          return Result;
 112       end "+";
 113
 114       function "+" (S1, S2 : Resource_Vector_T) return Resource_Vector_T is
 115          Result : Resource_Vector_T;
 116       begin
 117          Result :=  S1 or S2;
 118          return Result;
 119       end "+";
 120
 121       function "-"
 122         (S : Resource_Vector_T;
 123          R : Resource_T) return Resource_Vector_T
 124       is
 125          Result : Resource_Vector_T := S;
 126       begin
 127          Result (Resource_T'Pos (R)) := False;
 128          return Result;
 129       end "-";
 130
 131    end Resource_Vector_Functions;
 132
 133    ---------------
 134    -- New_Sproc --
 135    ---------------
 136
 137    function New_Sproc (Attr : Sproc_Attributes) return sproc_t is
 138       Sproc_Attr : aliased sproc_attr_t;
 139       Sproc      : aliased sproc_t;
 140       Status     : int;
 141
 142    begin
 143       Status := sproc_attr_init (Sproc_Attr'Unrestricted_Access);
 144
 145       if Status = 0 then
 146          Status := sproc_attr_setresources
 147            (Sproc_Attr'Unrestricted_Access,
 148             To_Resource_T (Attr.Sproc_Resources));
 149
 150          if Attr.CPU /= ANY_CPU then
 151             if Attr.CPU > Num_Processors then
 152                raise Invalid_CPU_Number;
 153             end if;
 154
 155             Status := sproc_attr_setcpu
 156               (Sproc_Attr'Unrestricted_Access,
 157                int (Attr.CPU));
 158          end if;
 159
 160          if Attr.Resident /= NOLOCK then
 161             if Geteuid /= 0 then
 162                raise Permission_Error;
 163             end if;
 164
 165             Status := sproc_attr_setresident
 166               (Sproc_Attr'Unrestricted_Access,
 167                 Locking_Map (Attr.Resident));
 168          end if;
 169
 170          if Attr.NDPRI /= NDP_NONE then
 171
 172 --  ??? why is this commented out, should it be removed ?
 173 --          if Geteuid /= 0 then
 174 --             raise Permission_Error;
 175 --          end if;
 176
 177             Status :=
 178               sproc_attr_setprio
 179                 (Sproc_Attr'Unrestricted_Access, int (Attr.NDPRI));
 180          end if;
 181
 182          Status :=
 183            sproc_create
 184              (Sproc'Unrestricted_Access,
 185               Sproc_Attr'Unrestricted_Access,
 186               null,
 187               System.Null_Address);
 188
 189          if Status /= 0 then
 190             Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
 191             raise Sproc_Create_Error;
 192          end if;
 193
 194          Status := sproc_attr_destroy (Sproc_Attr'Unrestricted_Access);
 195       end if;
 196
 197       if Status /= 0 then
 198          raise Sproc_Create_Error;
 199       end if;
 200
 201       return Sproc;
 202    end New_Sproc;
 203
 204    ---------------
 205    -- New_Sproc --
 206    ---------------
 207
 208    function New_Sproc
 209      (Sproc_Resources : Resource_Vector_T      := NO_RESOURCES;
 210       CPU             : CPU_Number             := ANY_CPU;
 211       Resident        : Page_Locking           := NOLOCK;
 212       NDPRI           : Non_Degrading_Priority := NDP_NONE) return sproc_t
 213    is
 214       Attr : constant Sproc_Attributes :=
 215                (Sproc_Resources, CPU, Resident, NDPRI);
 216    begin
 217       return New_Sproc (Attr);
 218    end New_Sproc;
 219
 220    -------------------------------
 221    -- Unbound_Thread_Attributes --
 222    -------------------------------
 223
 224    function Unbound_Thread_Attributes
 225      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 226       Thread_Timeslice : Duration          := 0.0) return Thread_Attributes
 227    is
 228    begin
 229       return (False, Thread_Resources, Thread_Timeslice);
 230    end Unbound_Thread_Attributes;
 231
 232    -----------------------------
 233    -- Bound_Thread_Attributes --
 234    -----------------------------
 235
 236    function Bound_Thread_Attributes
 237      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 238       Thread_Timeslice : Duration          := 0.0;
 239       Sproc            : sproc_t)
 240       return             Thread_Attributes
 241    is
 242    begin
 243       return (True, Thread_Resources, Thread_Timeslice, Sproc);
 244    end Bound_Thread_Attributes;
 245
 246    -----------------------------
 247    -- Bound_Thread_Attributes --
 248    -----------------------------
 249
 250    function Bound_Thread_Attributes
 251      (Thread_Resources : Resource_Vector_T      := NO_RESOURCES;
 252       Thread_Timeslice : Duration               := 0.0;
 253       Sproc_Resources  : Resource_Vector_T      := NO_RESOURCES;
 254       CPU              : CPU_Number             := ANY_CPU;
 255       Resident         : Page_Locking           := NOLOCK;
 256       NDPRI            : Non_Degrading_Priority := NDP_NONE)
 257       return Thread_Attributes
 258    is
 259       Sproc : constant sproc_t := New_Sproc
 260                 (Sproc_Resources, CPU, Resident, NDPRI);
 261    begin
 262       return (True, Thread_Resources, Thread_Timeslice, Sproc);
 263    end Bound_Thread_Attributes;
 264
 265    -----------------------------------
 266    -- New_Unbound_Thread_Attributes --
 267    -----------------------------------
 268
 269    function New_Unbound_Thread_Attributes
 270      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 271       Thread_Timeslice : Duration          := 0.0) return Task_Info_Type
 272    is
 273    begin
 274       return new Thread_Attributes'
 275         (False, Thread_Resources, Thread_Timeslice);
 276    end New_Unbound_Thread_Attributes;
 277
 278    ---------------------------------
 279    -- New_Bound_Thread_Attributes --
 280    ---------------------------------
 281
 282    function New_Bound_Thread_Attributes
 283      (Thread_Resources : Resource_Vector_T := NO_RESOURCES;
 284       Thread_Timeslice : Duration          := 0.0;
 285       Sproc            : sproc_t) return Task_Info_Type
 286    is
 287    begin
 288       return new Thread_Attributes'
 289         (True, Thread_Resources, Thread_Timeslice, Sproc);
 290    end  New_Bound_Thread_Attributes;
 291
 292    ---------------------------------
 293    -- New_Bound_Thread_Attributes --
 294    ---------------------------------
 295
 296    function New_Bound_Thread_Attributes
 297      (Thread_Resources : Resource_Vector_T      := NO_RESOURCES;
 298       Thread_Timeslice : Duration               := 0.0;
 299       Sproc_Resources  : Resource_Vector_T      := NO_RESOURCES;
 300       CPU              : CPU_Number             := ANY_CPU;
 301       Resident         : Page_Locking           := NOLOCK;
 302       NDPRI            : Non_Degrading_Priority := NDP_NONE)
 303       return Task_Info_Type
 304    is
 305       Sproc : constant sproc_t := New_Sproc
 306                 (Sproc_Resources, CPU, Resident, NDPRI);
 307    begin
 308       return new Thread_Attributes'
 309         (True, Thread_Resources, Thread_Timeslice, Sproc);
 310    end  New_Bound_Thread_Attributes;
 311
 312 end System.Task_Info;