FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR ada/14538 (*-rtems broken for gnat)

Browse source 
2004-04-08  Joel Sherrill <joel@oarcorp.com>

	PR ada/14538
	* ada/5rosinte.adb: Remove fake mprotect() body.
	* ada/5rosinte.ads: Add SA_SIGINFO.
	* ada/5rtpopsp.adb: Rewrite to use new interface.
	* ada/init.c: Reorder so the simple single OS conditional __rtems__
	is tested before more complex ones which mix UNIX and embedded
	systems in the conditional.

From-SVN: r80517
This commit is contained in:
Joel Sherrill 2004-04-08 17:54:03 +00:00 • committed by Joel Sherrill
parent 4afae4b9c8
commit c00e272ed3
5 changed files with 61 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gcc/ChangeLog
View file

@ -1,3 +1,13 @@
2004-04-08 Joel Sherrill <joel@oarcorp.com>
PR ada/14538
* ada/5rosinte.adb: Remove fake mprotect() body.
* ada/5rosinte.ads: Add SA_SIGINFO.
* ada/5rtpopsp.adb: Rewrite to use new interface.
* ada/init.c: Reorder so the simple single OS conditional __rtems__
is tested before more complex ones which mix UNIX and embedded
systems in the conditional.
2004-04-08 Joel Sherrill <joel@oarcorp.com>
PR ada/14665

6
gcc/ada/5rosinte.adb
View file

@ -118,10 +118,4 @@ package body System.OS_Interface is
return 0;
end Get_Page_Size;
function mprotect
(addr : Address; len : size_t; prot : int) return int is
begin
return 0;
end mprotect;
end System.OS_Interface;

4
gcc/ada/5rosinte.ads
View file

@ -139,6 +139,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#02#;
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
@ -261,7 +263,7 @@ package System.OS_Interface is
PROT_OFF : constant := 0;
function mprotect (addr : Address; len : size_t; prot : int) return int;
-- Do nothing on RTEMS.
pragma Import (C, mprotect);
-----------------------------------------
-- Nonstandard Thread Initialization --

214
gcc/ada/5rtpopsp.adb
View file

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $
-- $Revision: 1.2 $
-- --
-- Copyright (C) 1991-2003, Florida State University --
-- --
@ -35,183 +35,48 @@
-- --
------------------------------------------------------------------------------
-- This is a POSIX version of this package where foreign threads are
-- recognized.
-- Currently, DEC Unix, SCO UnixWare 7 and RTEMS use this version.
with System.Soft_Links;
-- used to initialize TSD for a C thread, in function Self
-- This is a RTEMS version of this package which uses a special
-- variable for Ada self which is contexted switch implicitly by RTEMS.
--
-- This is the same as the POSIX version except that an RTEMS variable
-- is used instead of a POSIX key.
separate (System.Task_Primitives.Operations)
package body Specific is
------------------
-- Local Data --
------------------
-- The followings are logically constants, but need to be initialized
-- at run time.
-- The following gives the Ada run-time direct access to a variable
-- context switched by RTEMS at the lowest level.
RTEMS_Ada_Self : System.Address;
pragma Import (C, RTEMS_Ada_Self, "rtems_ada_self");
-- The following are used to allow the Self function to
-- automatically generate ATCB's for C threads that happen to call
-- Ada procedure, which in turn happen to call the Ada runtime system.
type Fake_ATCB;
type Fake_ATCB_Ptr is access Fake_ATCB;
type Fake_ATCB is record
Stack_Base : Interfaces.C.unsigned := 0;
-- A value of zero indicates the node is not in use.
Next : Fake_ATCB_Ptr;
Real_ATCB : aliased Ada_Task_Control_Block (0);
end record;
Fake_ATCB_List : Fake_ATCB_Ptr;
-- A linear linked list.
-- The list is protected by All_Tasks_L;
-- Nodes are added to this list from the front.
-- Once a node is added to this list, it is never removed.
Fake_Task_Elaborated : aliased Boolean := True;
-- Used to identified fake tasks (i.e., non-Ada Threads).
Next_Fake_ATCB : Fake_ATCB_Ptr;
-- Used to allocate one Fake_ATCB in advance. See comment in New_Fake_ATCB
-----------------------
-- Local Subprograms --
-----------------------
---------------------------------
-- Support for New_Fake_ATCB --
---------------------------------
function New_Fake_ATCB return Task_ID;
-- Allocate and Initialize a new ATCB. This code can safely be called from
-- a foreign thread, as it doesn't access implicitely or explicitely
-- "self" before having initialized the new ATCB.
-------------------
-- New_Fake_ATCB --
-------------------
function New_Fake_ATCB return Task_ID is
Self_ID : Task_ID;
P, Q : Fake_ATCB_Ptr;
Succeeded : Boolean;
begin
-- This section is ticklish.
-- We dare not call anything that might require an ATCB, until
-- we have the new ATCB in place.
Write_Lock (All_Tasks_L'Access);
Q := null;
P := Fake_ATCB_List;
while P /= null loop
if P.Stack_Base = 0 then
Q := P;
end if;
P := P.Next;
end loop;
if Q = null then
-- Create a new ATCB with zero entries.
Self_ID := Next_Fake_ATCB.Real_ATCB'Access;
Next_Fake_ATCB.Stack_Base := 1;
Next_Fake_ATCB.Next := Fake_ATCB_List;
Fake_ATCB_List := Next_Fake_ATCB;
Next_Fake_ATCB := null;
else
-- Reuse an existing fake ATCB.
Self_ID := Q.Real_ATCB'Access;
Q.Stack_Base := 1;
end if;
-- Record this as the Task_ID for the current thread.
Self_ID.Common.LL.Thread := pthread_self;
RTEMS_Ada_Self := To_Address (Self_ID);
-- Do the standard initializations
System.Tasking.Initialize_ATCB
(Self_ID, null, Null_Address, Null_Task, Fake_Task_Elaborated'Access,
System.Priority'First, Task_Info.Unspecified_Task_Info, 0, Self_ID,
Succeeded);
pragma Assert (Succeeded);
-- Finally, it is safe to use an allocator in this thread.
if Next_Fake_ATCB = null then
Next_Fake_ATCB := new Fake_ATCB;
end if;
Self_ID.Common.State := Runnable;
Self_ID.Awake_Count := 1;
-- Since this is not an ordinary Ada task, we will start out undeferred
Self_ID.Deferral_Level := 0;
System.Soft_Links.Create_TSD (Self_ID.Common.Compiler_Data);
-- ????
-- The following call is commented out to avoid dependence on
-- the System.Tasking.Initialization package.
-- It seems that if we want Ada.Task_Attributes to work correctly
-- for C threads we will need to raise the visibility of this soft
-- link to System.Soft_Links.
-- We are putting that off until this new functionality is otherwise
-- stable.
-- System.Tasking.Initialization.Initialize_Attributes_Link.all (T);
for J in Known_Tasks'Range loop
if Known_Tasks (J) = null then
Known_Tasks (J) := Self_ID;
Self_ID.Known_Tasks_Index := J;
exit;
end if;
end loop;
-- Must not unlock until Next_ATCB is again allocated.
Unlock (All_Tasks_L'Access);
return Self_ID;
end New_Fake_ATCB;
----------------
-- Initialize --
----------------
procedure Initialize (Environment_Task : Task_ID) is
pragma Warnings (Off, Environment_Task);
Result : Interfaces.C.int;
begin
RTEMS_Ada_Self := To_Address (Environment_Task);
-- Create a free ATCB for use on the Fake_ATCB_List.
Next_Fake_ATCB := new Fake_ATCB;
end Initialize;
-------------------
-- Is_Valid_Task --
-------------------
function Is_Valid_Task return Boolean is
begin
return RTEMS_Ada_Self /= System.Null_Address;
end Is_Valid_Task;
---------
-- Set --
---------
procedure Set (Self_Id : Task_ID) is
Result : Interfaces.C.int;
begin
RTEMS_Ada_Self := To_Address (Self_Id);
end Set;
@ -220,33 +85,18 @@ package body Specific is
-- 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 runtime 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.
-- 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 runtime 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.
-- 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.
-- The new ATCB will be "detached" from the normal Ada task master
-- hierarchy, much like the existing implicitly created signal-server
-- tasks.
function Self return Task_ID is
Result : System.Address;
@ -256,11 +106,11 @@ package body Specific is
-- If the key value is Null, then it is a non-Ada task.
if Result = System.Null_Address then
return New_Fake_ATCB;
if Result /= System.Null_Address then
return To_Task_Id (Result);
else
return Register_Foreign_Thread;
end if;
return To_Task_ID (Result);
end Self;
end Specific;

32
gcc/ada/init.c
View file

@ -359,6 +359,22 @@ __gnat_initialize (void)
{
}
/***************************************/
/* __gnat_initialize (RTEMS version) */
/***************************************/
#elif defined(__rtems__)
extern void __gnat_install_handler (void);
/* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
void
__gnat_initialize (void)
{
__gnat_install_handler ();
}
/****************************************/
/* __gnat_initialize (Dec Unix Version) */
/****************************************/
@ -1887,22 +1903,6 @@ __gnat_initialize (void)
__gnat_init_float ();
}
/***************************************/
/* __gnat_initialize (RTEMS version) */
/***************************************/
#elif defined(__rtems__)
extern void __gnat_install_handler (void);
/* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
void
__gnat_initialize (void)
{
__gnat_install_handler ();
}
#else
/* For all other versions of GNAT, the initialize routine and handler