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