| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
