gcc/ada/5stpopse.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
   4 --                                                                          --
   5 --                   SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF                 --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --            Copyright (C) 1992-2002, Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNARL 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. GNARL 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 GNARL; 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 -- GNARL was developed by the GNARL team at Florida State University.       --
  30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  This is a Solaris Sparc (native) version of this package.
  35
  36 with System.Machine_Code;
  37 --  used for Asm
  38
  39 separate (System.Task_Primitives.Operations)
  40
  41 ----------
  42 -- Self --
  43 ----------
  44
  45 --  For Solaris version of RTS, we use a short cut to get the self
  46 --  information faster:
  47
  48 --  We have noticed that on Sparc Solaris, the register g7 always
  49 --  contains the address near the frame pointer (fp) of the active
  50 --  thread (fixed offset). This means, if we declare a variable near
  51 --  the top of the stack for each threads (in our case in the task wrapper)
  52 --  and let the variable hold the Task_ID information, we can get the
  53 --  value without going through the thr_getspecific kernel call.
  54 --
  55 --  There are two things to take care in this trick.
  56 --
  57 --  1) We need to calculate the offset between the g7 value and the
  58 --     local variable address.
  59 --     Possible Solutions :
  60 --        a) Use gdb to figure out the offset.
  61 --        b) Figure it out during the elaboration of RTS by, say,
  62 --           creating a dummy task.
  63 --     We used solution a) mainly because it is more efficient and keeps
  64 --     the RTS from being cluttered with stuff that we won't be used
  65 --     for all environments (i.e., we would have to at least introduce
  66 --     new interfaces).
  67 --
  68 --     On Sparc Solaris the offset was #10#108# (= #16#6b#) with gcc 2.7.2.
  69 --     With gcc 2.8.0, the offset is #10#116# (= #16#74#).
  70 --
  71 --  2) We can not use the same offset business for the main thread
  72 --     because we do not use a wrapper for the main thread.
  73 --     Previousely, we used the difference between g7 and fp to determine
  74 --     wether a task was the main task or not. But this was obviousely
  75 --     wrong since it worked only for tasks that use small amount of
  76 --     stack.
  77 --     So, we now take advantage of the code that recognizes foreign
  78 --     threads (see below) for the main task.
  79 --
  80 --  NOTE: What we are doing here is ABSOLUTELY for Solaris 2.4, 2.5 and 2.6
  81 --        on Sun.
  82
  83 --        We need to make sure this is OK when we move to other versions
  84 --        of the same OS.
  85
  86 --        We always can go back to the old way of doing this and we include
  87 --        the code which use thr_getspecifics. Also, look for %%%%%
  88 --        in comments for other necessary modifications.
  89
  90 --        This code happens to work with Solaris 2.5.1 too, but with gcc
  91 --        2.8.0, this offset is different.
  92
  93 --        ??? Try to rethink the approach here to get a more flexible
  94 --        solution at run time ?
  95
  96 --        One other solution (close to 1-b) would be to add some scanning
  97 --        routine in Enter_Task to compute the offset since now we have
  98 --        a magic number at the beginning of the task code.
  99
 100 --  function Self return Task_ID is
 101 --     Temp   : aliased System.Address;
 102 --     Result : Interfaces.C.int;
 103 --
 104 --  begin
 105 --     Result := thr_getspecific (ATCB_Key, Temp'Unchecked_Access);
 106 --     pragma Assert (Result = 0);
 107 --     return To_Task_ID (Temp);
 108 --  end Self;
 109
 110 --  To make Ada tasks and C threads interoperate better, we have
 111 --  added some functionality to Self.  Suppose a C main program
 112 --  (with threads) calls an Ada procedure and the Ada procedure
 113 --  calls the tasking run-time system.  Eventually, a call will be
 114 --  made to self.  Since the call is not coming from an Ada task,
 115 --  there will be no corresponding ATCB.
 116
 117 --  (The entire Ada run-time system may not have been elaborated,
 118 --  either, but that is a different problem, that we will need to
 119 --  solve another way.)
 120
 121 --  What we do in Self is to catch references that do not come
 122 --  from recognized Ada tasks, and create an ATCB for the calling
 123 --  thread.
 124
 125 --  The new ATCB will be "detached" from the normal Ada task
 126 --  master hierarchy, much like the existing implicitly created
 127 --  signal-server tasks.
 128
 129 --  We will also use such points to poll for disappearance of the
 130 --  threads associated with any implicit ATCBs that we created
 131 --  earlier, and take the opportunity to recover them.
 132
 133 --  A nasty problem here is the limitations of the compilation
 134 --  order dependency, and in particular the GNARL/GNULLI layering.
 135 --  To initialize an ATCB we need to assume System.Tasking has
 136 --  been elaborated.
 137
 138 function Self return Task_ID is
 139    ATCB_Magic_Code : constant := 16#ADAADAAD#;
 140    --  This is used to allow us to catch attempts to call Self
 141    --  from outside an Ada task, with high probability.
 142    --  For an Ada task, Task_Wrapper.Magic_Number = ATCB_Magic_Code.
 143
 144    type Iptr is access Interfaces.C.unsigned;
 145    function To_Iptr is new Unchecked_Conversion (Interfaces.C.unsigned, Iptr);
 146
 147    type Ptr is access Task_ID;
 148    function To_Ptr is new Unchecked_Conversion (Interfaces.C.unsigned, Ptr);
 149
 150    X      : Ptr;
 151    Result : Interfaces.C.int;
 152
 153    function Get_G7 return Interfaces.C.unsigned;
 154    pragma Inline (Get_G7);
 155
 156    use System.Machine_Code;
 157
 158    ------------
 159    -- Get_G7 --
 160    ------------
 161
 162    function Get_G7 return Interfaces.C.unsigned is
 163       Result : Interfaces.C.unsigned;
 164
 165    begin
 166       Asm ("mov %%g7,%0", Interfaces.C.unsigned'Asm_Output ("=r", Result));
 167       return Result;
 168    end Get_G7;
 169
 170 --  Start of processing for Self
 171
 172 begin
 173    if To_Iptr (Get_G7 - 120).all /=
 174      Interfaces.C.unsigned (ATCB_Magic_Code)
 175    then
 176       --  Check whether this is a thread we have seen before (e.g the
 177       --  main task).
 178       --  120 = 116 + Magic_Type'Size/System.Storage_Unit
 179
 180       declare
 181          Unknown_Task : aliased System.Address;
 182
 183       begin
 184          Result :=
 185            thr_getspecific (ATCB_Key, Unknown_Task'Unchecked_Access);
 186
 187          pragma Assert (Result = 0);
 188
 189          if Unknown_Task = System.Null_Address then
 190
 191             --  We are seeing this thread for the first time.
 192
 193             return New_Fake_ATCB (Get_G7);
 194
 195          else
 196             return To_Task_ID (Unknown_Task);
 197          end if;
 198       end;
 199    end if;
 200
 201    X := To_Ptr (Get_G7 - 116);
 202    return X.all;
 203
 204 end Self;