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