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