2004-07-06 Vincent Celier <celier@gnat.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / s-tarest.adb

diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb
index 2cd2e16..3d4a0fd 100644 (file)
--- a/gcc/ada/s-tarest.adb
+++ b/gcc/ada/s-tarest.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1999-2001, Free Software Foundation, Inc.          --
+--         Copyright (C) 1999-2004, 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- --
@@ -26,8 +26,8 @@
 -- 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. (http://www.gnat.com).     --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -51,7 +51,6 @@ with System.Parameters;
 
 with System.Task_Info;
 --  used for Task_Info_Type
---           Task_Image_Type
 
 with System.Task_Primitives.Operations;
 --  used for Enter_Task
@@ -106,6 +105,8 @@ package body System.Tasking.Restricted.Stages is
    --  all nested locks must be released before other tasks competing for the
    --  tasking lock are released.
 
+   --  See s-tasini.adb for more information on the following functions.
+
    function Get_Jmpbuf_Address return Address;
    procedure Set_Jmpbuf_Address (Addr : Address);
 
@@ -119,17 +120,17 @@ package body System.Tasking.Restricted.Stages is
 
    procedure Timed_Delay_T (Time : Duration; Mode : Integer);
 
-   ------------------------
-   --  Local Subprograms --
-   ------------------------
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
 
-   procedure Task_Wrapper (Self_ID : Task_ID);
+   procedure Task_Wrapper (Self_ID : Task_Id);
    --  This is the procedure that is called by the GNULL from the
    --  new context when a task is created. It waits for activation
    --  and then calls the task body procedure. When the task body
    --  procedure completes, it terminates the task.
 
-   procedure Terminate_Task (Self_ID : Task_ID);
+   procedure Terminate_Task (Self_ID : Task_Id);
    --  Terminate the calling task.
    --  This should only be called by the Task_Wrapper procedure.
 
@@ -209,10 +210,14 @@ package body System.Tasking.Restricted.Stages is
    --  of the current thread, since it should be at a fixed offset from the
    --  stack base.
 
-   procedure Task_Wrapper (Self_ID : Task_ID) is
-      ID : Task_ID := Self_ID;
+   procedure Task_Wrapper (Self_ID : Task_Id) is
+      ID : Task_Id := Self_ID;
       pragma Volatile (ID);
 
+      pragma Warnings (Off, ID);
+      --  Turn off warnings (stand alone volatile constant has to be
+      --  imported, so we cannot just make ID constant).
+
       --  Do not delete this variable.
       --  In some targets, we need this variable to implement a fast Self.
 
@@ -283,8 +288,8 @@ package body System.Tasking.Restricted.Stages is
    procedure Activate_Restricted_Tasks
      (Chain_Access : Activation_Chain_Access)
    is
-      Self_ID       : constant Task_ID := STPO.Self;
-      C             : Task_ID;
+      Self_ID       : constant Task_Id := STPO.Self;
+      C             : Task_Id;
       Activate_Prio : System.Any_Priority;
       Success       : Boolean;
 
@@ -372,8 +377,8 @@ package body System.Tasking.Restricted.Stages is
    --  activator.
 
    procedure Complete_Restricted_Activation is
-      Self_ID   : constant Task_ID := STPO.Self;
-      Activator : constant Task_ID := Self_ID.Common.Activator;
+      Self_ID   : constant Task_Id := STPO.Self;
+      Activator : constant Task_Id := Self_ID.Common.Activator;
 
    begin
       if Single_Lock then
@@ -437,11 +442,11 @@ package body System.Tasking.Restricted.Stages is
       Discriminants : System.Address;
       Elaborated    : Access_Boolean;
       Chain         : in out Activation_Chain;
-      Task_Image    : System.Task_Info.Task_Image_Type;
-      Created_Task  : out Task_ID)
+      Task_Image    : String;
+      Created_Task  : out Task_Id)
    is
-      T             : Task_ID;
-      Self_ID       : constant Task_ID := STPO.Self;
+      T             : Task_Id;
+      Self_ID       : constant Task_Id := STPO.Self;
       Base_Priority : System.Any_Priority;
       Success       : Boolean;
 
@@ -482,7 +487,11 @@ package body System.Tasking.Restricted.Stages is
       end if;
 
       T.Entry_Calls (1).Self := T;
-      T.Common.Task_Image    := Task_Image;
+
+      T.Common.Task_Image_Len :=
+        Integer'Min (T.Common.Task_Image'Length, Task_Image'Length);
+      T.Common.Task_Image (1 .. T.Common.Task_Image_Len) := Task_Image;
+
       Unlock (Self_ID);
 
       if Single_Lock then
@@ -507,7 +516,8 @@ package body System.Tasking.Restricted.Stages is
    --  forever, since none of the dependent tasks are expected to terminate
 
    procedure Finalize_Global_Tasks is
-      Self_ID : constant Task_ID := STPO.Self;
+      Self_ID : constant Task_Id := STPO.Self;
+
    begin
       pragma Assert (Self_ID = STPO.Environment_Task);
 
@@ -532,7 +542,7 @@ package body System.Tasking.Restricted.Stages is
    -- Restricted_Terminated --
    ---------------------------
 
-   function Restricted_Terminated (T : Task_ID) return Boolean is
+   function Restricted_Terminated (T : Task_Id) return Boolean is
    begin
       return T.Common.State = Terminated;
    end Restricted_Terminated;
@@ -541,7 +551,7 @@ package body System.Tasking.Restricted.Stages is
    -- Terminate_Task --
    --------------------
 
-   procedure Terminate_Task (Self_ID : Task_ID) is
+   procedure Terminate_Task (Self_ID : Task_Id) is
    begin
       Self_ID.Common.State := Terminated;
    end Terminate_Task;