1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF --
10 -- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
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. --
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. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This is a Solaris Sparc (native) version of this package.
37 with System
.Machine_Code
;
40 separate (System
.Task_Primitives
.Operations
)
46 -- For Solaris version of RTS, we use a short cut to get the self
47 -- information faster:
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.
56 -- There are two things to take care in this trick.
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
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#).
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
78 -- So, we now take advantage of the code that recognizes foreign
79 -- threads (see below) for the main task.
81 -- NOTE: What we are doing here is ABSOLUTELY for Solaris 2.4, 2.5 and 2.6
84 -- We need to make sure this is OK when we move to other versions
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.
91 -- This code happens to work with Solaris 2.5.1 too, but with gcc
92 -- 2.8.0, this offset is different.
94 -- ??? Try to rethink the approach here to get a more flexible
95 -- solution at run time ?
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.
101 -- function Self return Task_ID is
102 -- Temp : aliased System.Address;
103 -- Result : Interfaces.C.int;
106 -- Result := thr_getspecific (ATCB_Key, Temp'Unchecked_Access);
107 -- pragma Assert (Result = 0);
108 -- return To_Task_ID (Temp);
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.
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.)
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
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.
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.
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
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.
145 type Iptr
is access Interfaces
.C
.unsigned
;
146 function To_Iptr
is new Unchecked_Conversion
(Interfaces
.C
.unsigned
, Iptr
);
148 type Ptr
is access Task_ID
;
149 function To_Ptr
is new Unchecked_Conversion
(Interfaces
.C
.unsigned
, Ptr
);
152 Result
: Interfaces
.C
.int
;
154 function Get_G7
return Interfaces
.C
.unsigned
;
155 pragma Inline
(Get_G7
);
157 use System
.Machine_Code
;
163 function Get_G7
return Interfaces
.C
.unsigned
is
164 Result
: Interfaces
.C
.unsigned
;
167 Asm
("mov %%g7,%0", Interfaces
.C
.unsigned
'Asm_Output ("=r", Result
));
171 -- Start of processing for Self
174 if To_Iptr
(Get_G7
- 120).all /=
175 Interfaces
.C
.unsigned
(ATCB_Magic_Code
)
177 -- Check whether this is a thread we have seen before (e.g the
179 -- 120 = 116 + Magic_Type'Size/System.Storage_Unit
182 Unknown_Task
: aliased System
.Address
;
186 thr_getspecific
(ATCB_Key
, Unknown_Task
'Unchecked_Access);
188 pragma Assert
(Result
= 0);
190 if Unknown_Task
= System
.Null_Address
then
192 -- We are seeing this thread for the first time.
194 return New_Fake_ATCB
(Get_G7
);
197 return To_Task_ID
(Unknown_Task
);
202 X
:= To_Ptr
(Get_G7
- 116);