5rosinte.ads: Add SIGXCPU.

2003-01-29	Joel Sherrill <joel@OARcorp.com>

	* 5rosinte.ads: Add SIGXCPU.
	* 5rtpopsp.adb: New file.
	* Make-lang.in: Do not build gnatpsta and gnatpsys when cross.
	* Makefile.in: Recognize more RTEMS targets and add the RTEMS
	specific file 5rtpopsp.adb.
	* adaint.h: Add include of <stdio.h> when target is RTEMS.  This
	is likely needed for all newlib targets.
	* init.c: Add RTEMS specific version of __gnat_initialize().

From-SVN: r62098
This commit is contained in:
Joel Sherrill 2003-01-29 17:43:57 +00:00 committed by Joel Sherrill
parent 204c43d642
commit c4039eb00f
7 changed files with 303 additions and 5 deletions

View File

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- --
-- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- --
-- 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- --
@ -106,6 +106,7 @@ package System.OS_Interface is
SIGTERM : constant := 15; -- software termination signal from kill
SIGUSR1 : constant := 16; -- user defined signal 1
SIGUSR2 : constant := 17; -- user defined signal 2
SIGXCPU : constant := 0; -- XCPU
SIGADAABORT : constant := SIGABRT;

266
gcc/ada/5rtpopsp.adb Normal file
View File

@ -0,0 +1,266 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S . --
-- S P E C I F I C --
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $
-- --
-- Copyright (C) 1991-2003, 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 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
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
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;
---------
-- Set --
---------
procedure Set (Self_Id : Task_ID) is
begin
RTEMS_Ada_Self := To_Address (Self_Id);
end Set;
----------
-- 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.
-- (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
Result : System.Address;
begin
Result := RTEMS_Ada_Self;
-- If the key value is Null, then it is a non-Ada task.
if Result = System.Null_Address then
return New_Fake_ATCB;
end if;
return To_Task_ID (Result);
end Self;
end Specific;

View File

@ -1,3 +1,14 @@
2003-01-29 Joel Sherrill <joel@OARcorp.com>
* 5rosinte.ads: Add SIGXCPU.
* 5rtpopsp.adb: New file.
* Make-lang.in: Do not build gnatpsta and gnatpsys when cross.
* Makefile.in: Recognize more RTEMS targets and add the RTEMS
specific file 5rtpopsp.adb.
* adaint.h: Add include of <stdio.h> when target is RTEMS. This
is likely needed for all newlib targets.
* init.c: Add RTEMS specific version of __gnat_initialize().
2003-01-28 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE>
* adaint.c, adaint.h, gmem.c, init.c: Update copyright year.

View File

@ -1,5 +1,5 @@
# Top level makefile fragment for GNU Ada (GNAT).
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
# Free Software Foundation, Inc.
#This file is part of GNU CC.

View File

@ -1,5 +1,5 @@
# Makefile for GNU Ada Compiler (GNAT).
# Copyright (C) 1994-2002 Free Software Foundation, Inc.
# Copyright (C) 1994-2003 Free Software Foundation, Inc.
#This file is part of GNU CC.
@ -875,7 +875,7 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
endif
endif
ifeq ($(strip $(filter-out rtems,$(osys))),)
ifeq ($(strip $(filter-out rtems rtemself rtemsaout rtemscoff,$(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<4rintnam.ads \
s-inmaop.adb<7sinmaop.adb \
@ -886,7 +886,7 @@ ifeq ($(strip $(filter-out rtems,$(osys))),)
s-parame.adb<5rparame.adb \
s-taprop.adb<7staprop.adb \
s-taspri.ads<7staspri.ads \
s-tpopsp.adb<5atpopsp.adb
s-tpopsp.adb<5rtpopsp.adb
endif
ifeq ($(strip $(filter-out go32 msdos,$(osys))),)

View File

@ -31,6 +31,10 @@
* *
****************************************************************************/
#if defined(__rtems__)
#include <stdio.h>
#endif
#include <dirent.h>
extern int __gnat_max_path_len;

View File

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