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

	PR ada/14538
	* ada/5rosinte.adb: Remove fake mprotect() body.
	* ada/5rosinte.ads: Add SA_SIGINFO.  Make pthread_key_t a type
	which can be set since Finalize_TCB in 7staprop.adb does not
	go through the Set_Specific interface.
	* 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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-3_4-branch@80515 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 64 insertions, 207 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 26911e569f5..95de07a80e1 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,16 @@
+2004-04-08  Joel Sherrill <joel@oarcorp.com>
+
+	PR ada/14538
+	* ada/5rosinte.adb: Remove fake mprotect() body.
+	* ada/5rosinte.ads: Add SA_SIGINFO.  Make pthread_key_t a type
+	which can be set since Finalize_TCB in 7staprop.adb does not
+	go through the Set_Specific interface.
+	* 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
diff --git a/gcc/ada/5rosinte.adb b/gcc/ada/5rosinte.adb
index f4bfca54766..1bb1ae50a8b 100644
--- a/gcc/ada/5rosinte.adb
+++ b/gcc/ada/5rosinte.adb
@@ -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;
diff --git a/gcc/ada/5rosinte.ads b/gcc/ada/5rosinte.ads
index 710176c1222..d3b05492b99 100644
--- a/gcc/ada/5rosinte.ads
+++ b/gcc/ada/5rosinte.ads
@@ -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;
@@ -229,7 +231,7 @@ package System.OS_Interface is
    type pthread_attr_t      is limited private;
    type pthread_mutexattr_t is limited private;
    type pthread_condattr_t  is limited private;
-   type pthread_key_t       is private;
+   type pthread_key_t       is new Interfaces.C.unsigned;
 
    PTHREAD_CREATE_DETACHED : constant := 0;
 
@@ -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  --
@@ -520,6 +522,4 @@ private
 
    type pthread_cond_t is new rtems_id;
 
-   type pthread_key_t is new rtems_id;
-
 end System.OS_Interface;
diff --git a/gcc/ada/5rtpopsp.adb b/gcc/ada/5rtpopsp.adb
index cdc3c844e64..c75356fdaeb 100644
--- a/gcc/ada/5rtpopsp.adb
+++ b/gcc/ada/5rtpopsp.adb
@@ -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);
+   end Initialize;
 
-      --  Create a free ATCB for use on the Fake_ATCB_List.
+   -------------------
+   -- Is_Valid_Task --
+   -------------------
 
-      Next_Fake_ATCB := new Fake_ATCB;
-   end Initialize;
+   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.
-
-   --  (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.
+   --  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 new ATCB will be "detached" from the normal Ada task
-   --  master hierarchy, much like the existing implicitly created
-   --  signal-server tasks.
+   --  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.
 
-   --  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;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 734a482bdcc..6d0480da9e2 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -352,6 +352,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) */
 /****************************************/
@@ -1782,22 +1798,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