summaryrefslogtreecommitdiff
path: root/gcc/ada/5stpopse.adb
blob: c041c16489ee9a1414d048358e1f6c9c2e0137ef (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
------------------------------------------------------------------------------
--                                                                          --
--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
--                                                                          --
--                   SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF                 --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--                             $Revision: 1.2 $                             --
--                                                                          --
--            Copyright (C) 1991-1998, Florida State University             --
--                                                                          --
-- GNARL is free software; you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNARL; see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com).                                  --
--                                                                          --
------------------------------------------------------------------------------

--  This is a Solaris Sparc (native) version of this package.

with System.Machine_Code;
--  used for Asm

separate (System.Task_Primitives.Operations)

----------
-- Self --
----------

--  For Solaris version of RTS, we use a short cut to get the self
--  information faster:

--  We have noticed that on Sparc Solaris, the register g7 always
--  contains the address near the frame pointer (fp) of the active
--  thread (fixed offset). This means, if we declare a variable near
--  the top of the stack for each threads (in our case in the task wrapper)
--  and let the variable hold the Task_ID information, we can get the
--  value without going through the thr_getspecific kernel call.
--
--  There are two things to take care in this trick.
--
--  1) We need to calculate the offset between the g7 value and the
--     local variable address.
--     Possible Solutions :
--        a) Use gdb to figure out the offset.
--        b) Figure it out during the elaboration of RTS by, say,
--           creating a dummy task.
--     We used solution a) mainly because it is more efficient and keeps
--     the RTS from being cluttered with stuff that we won't be used
--     for all environments (i.e., we would have to at least introduce
--     new interfaces).
--
--     On Sparc Solaris the offset was #10#108# (= #16#6b#) with gcc 2.7.2.
--     With gcc 2.8.0, the offset is #10#116# (= #16#74#).
--
--  2) We can not use the same offset business for the main thread
--     because we do not use a wrapper for the main thread.
--     Previousely, we used the difference between g7 and fp to determine
--     wether a task was the main task or not. But this was obviousely
--     wrong since it worked only for tasks that use small amount of
--     stack.
--     So, we now take advantage of the code that recognizes foreign
--     threads (see below) for the main task.
--
--  NOTE: What we are doing here is ABSOLUTELY for Solaris 2.4, 2.5 and 2.6
--        on Sun.

--        We need to make sure this is OK when we move to other versions
--        of the same OS.

--        We always can go back to the old way of doing this and we include
--        the code which use thr_getspecifics. Also, look for %%%%%
--        in comments for other necessary modifications.

--        This code happens to work with Solaris 2.5.1 too, but with gcc
--        2.8.0, this offset is different.

--        ??? Try to rethink the approach here to get a more flexible
--        solution at run time ?

--        One other solution (close to 1-b) would be to add some scanning
--        routine in Enter_Task to compute the offset since now we have
--        a magic number at the beginning of the task code.

--  function Self return Task_ID is
--     Temp   : aliased System.Address;
--     Result : Interfaces.C.int;
--
--  begin
--     Result := thr_getspecific (ATCB_Key, Temp'Unchecked_Access);
--     pragma Assert (Result = 0);
--     return To_Task_ID (Temp);
--  end Self;

--  To make Ada tasks and C threads interoperate better, we have
--  added some functionality to Self.  Suppose a C main program
--  (with threads) calls an Ada procedure and the Ada procedure
--  calls the tasking run-time system.  Eventually, a call will be
--  made to self.  Since the call is not coming from an Ada task,
--  there will be no corresponding ATCB.

--  (The entire Ada run-time system may not have been elaborated,
--  either, but that is a different problem, that we will need to
--  solve another way.)

--  What we do in Self is to catch references that do not come
--  from recognized Ada tasks, and create an ATCB for the calling
--  thread.

--  The new ATCB will be "detached" from the normal Ada task
--  master hierarchy, much like the existing implicitly created
--  signal-server tasks.

--  We will also use such points to poll for disappearance of the
--  threads associated with any implicit ATCBs that we created
--  earlier, and take the opportunity to recover them.

--  A nasty problem here is the limitations of the compilation
--  order dependency, and in particular the GNARL/GNULLI layering.
--  To initialize an ATCB we need to assume System.Tasking has
--  been elaborated.

function Self return Task_ID is
   X      : Ptr;
   Result : Interfaces.C.int;

   function Get_G7 return Interfaces.C.unsigned;
   pragma Inline (Get_G7);

   use System.Machine_Code;

   ------------
   -- Get_G7 --
   ------------

   function Get_G7 return Interfaces.C.unsigned is
      Result : Interfaces.C.unsigned;

   begin
      Asm ("mov %%g7,%0", Interfaces.C.unsigned'Asm_Output ("=r", Result));
      return Result;
   end Get_G7;

--  Start of processing for Self

begin
   if To_Iptr (Get_G7 - 120).all /=
     Interfaces.C.unsigned (ATCB_Magic_Code)
   then
      --  Check whether this is a thread we have seen before (e.g the
      --  main task).
      --  120 = 116 + Magic_Type'Size/System.Storage_Unit

      declare
         Unknown_Task : aliased System.Address;

      begin
         Result :=
           thr_getspecific (ATCB_Key, Unknown_Task'Unchecked_Access);

         pragma Assert (Result = 0);

         if Unknown_Task = System.Null_Address then

            --  We are seeing this thread for the first time.

            return New_Fake_ATCB (Get_G7);

         else
            return To_Task_ID (Unknown_Task);
         end if;
      end;
   end if;

   X := To_Ptr (Get_G7 - 116);
   return X.all;

end Self;