2009-04-27 Basile Starynkevitch <basile@starynkevitch.net>

	MERGED WITH TRUNK r146824::
	* gcc/basilys.h: all GTY goes before the identifiers.
	* gcc/basilys.c: removed errors.h include.
	* gcc/run-basilys.h: ditto.



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

1 files changed, 63 insertions, 23 deletions

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index d28cb7e42d2..76e3740277d 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -6,25 +6,23 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2008, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2009, 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- --
--- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT 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,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
 --                                                                          --
--- 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.                                      --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University.       --
 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
@@ -302,7 +300,7 @@ package body System.Tasking.Stages is
             --  racing ahead.
 
             if Success then
-               C.Common.State := Runnable;
+               C.Common.State := Activating;
                C.Awake_Count := 1;
                C.Alive_Count := 1;
                P.Awake_Count := P.Awake_Count + 1;
@@ -315,6 +313,21 @@ package body System.Tasking.Stages is
                   P.Common.Wait_Count := P.Common.Wait_Count + 1;
                end if;
 
+               for J in System.Tasking.Debug.Known_Tasks'Range loop
+                  if System.Tasking.Debug.Known_Tasks (J) = null then
+                     System.Tasking.Debug.Known_Tasks (J) := C;
+                     C.Known_Tasks_Index := J;
+                     exit;
+                  end if;
+               end loop;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Activating, C);
+               end if;
+
+               C.Common.State := Runnable;
+
                Unlock (C);
                Unlock (P);
 
@@ -502,8 +515,7 @@ package body System.Tasking.Stages is
          raise Program_Error with "potentially blocking operation";
       end if;
 
-      pragma Debug
-        (Debug.Trace (Self_ID, "Create_Task", 'C'));
+      pragma Debug (Debug.Trace (Self_ID, "Create_Task", 'C'));
 
       if Priority = Unspecified_Priority then
          Base_Priority := Self_ID.Common.Base_Priority;
@@ -609,14 +621,18 @@ package body System.Tasking.Stages is
          T.Common.Task_Image_Len := Len;
       end if;
 
+      Unlock (Self_ID);
+      Unlock_RTS;
+
+      --  Note: we should not call 'new' while holding locks since new
+      --  may use locks (e.g. RTS_Lock under Windows) itself and cause a
+      --  deadlock.
+
       if Build_Entry_Names then
          T.Entry_Names :=
            new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
       end if;
 
-      Unlock (Self_ID);
-      Unlock_RTS;
-
       --  Create TSD as early as possible in the creation of a task, since it
       --  may be used by the operation of Ada code within the task.
 
@@ -925,7 +941,7 @@ package body System.Tasking.Stages is
       Initialization.Undefer_Abort (Self_ID);
    end Move_Activation_Chain;
 
-   --  Compiler interface only. Do not call from within the RTS.
+   --  Compiler interface only. Do not call from within the RTS
 
    --------------------
    -- Set_Entry_Name --
@@ -1098,8 +1114,7 @@ package body System.Tasking.Stages is
       Stack_Guard (Self_ID, True);
 
       --  Initialize low-level TCB components, that cannot be initialized by
-      --  the creator. Enter_Task sets Self_ID.Known_Tasks_Index and also
-      --  Self_ID.LL.Thread
+      --  the creator. Enter_Task sets Self_ID.LL.Thread
 
       Enter_Task (Self_ID);
 
@@ -1132,6 +1147,11 @@ package body System.Tasking.Stages is
          Self_ID.Deferral_Level := 0;
       end if;
 
+      if Global_Task_Debug_Event_Set then
+         Debug.Signal_Debug_Event
+          (Debug.Debug_Event_Run, Self_ID);
+      end if;
+
       begin
          --  We are separating the following portion of the code in order to
          --  place the exception handlers in a different block. In this way,
@@ -1170,8 +1190,18 @@ package body System.Tasking.Stages is
 
             if Self_ID.Terminate_Alternative then
                Cause := Normal;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Terminated, Self_ID);
+               end if;
             else
                Cause := Abnormal;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Abort_Terminated, Self_ID);
+               end if;
             end if;
          when others =>
             --  ??? Using an E : others here causes CD2C11A to fail on Tru64
@@ -1196,7 +1226,13 @@ package body System.Tasking.Stages is
             --  procedure, as well as the associated Exception_Occurrence.
 
             Cause := Unhandled_Exception;
+
             Save_Occurrence (EO, SSL.Get_Current_Excep.all.all);
+
+            if Global_Task_Debug_Event_Set then
+               Debug.Signal_Debug_Event
+                 (Debug.Debug_Event_Exception_Terminated, Self_ID);
+            end if;
       end;
 
       --  Look for a task termination handler. This code is for all tasks but
@@ -1390,6 +1426,9 @@ package body System.Tasking.Stages is
       --  unwound. The common notification routine has been called at the
       --  raise point already.
 
+      --  Lock to prevent unsynchronized output
+
+      Initialization.Task_Lock (Self_Id);
       To_Stderr ("task ");
 
       if Self_Id.Common.Task_Image_Len /= 0 then
@@ -1402,6 +1441,7 @@ package body System.Tasking.Stages is
       To_Stderr (" terminated by unhandled exception");
       To_Stderr ((1 => ASCII.LF));
       To_Stderr (Tailored_Exception_Information (Excep.all));
+      Initialization.Task_Unlock (Self_Id);
    end Trace_Unhandled_Exception_In_Task;
 
    ------------------------------------