2012-03-07 Tristan Gingold <gingold@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 7 Mar 2012 14:51:44 +0000 (14:51 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 7 Mar 2012 14:51:44 +0000 (14:51 +0000)
* s-taprop-vms.adb (Create_Task): set thread name.
* s-osinte-vms.ads (pthread_attr_setname_np): Declare.

2012-03-07  Arnaud Charlet  <charlet@adacore.com>

* g-trasym.adb: Minor reformatting.

2012-03-07  Robert Dewar  <dewar@adacore.com>

* a-ngrear.ads: Minor addition of ??? comment.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@185052 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/a-ngrear.ads
gcc/ada/g-trasym.adb
gcc/ada/s-osinte-vms.ads
gcc/ada/s-taprop-vms.adb

index e92726a..1403e28 100644 (file)
@@ -1,3 +1,16 @@
+2012-03-07  Tristan Gingold  <gingold@adacore.com>
+
+       * s-taprop-vms.adb (Create_Task): set thread name.
+       * s-osinte-vms.ads (pthread_attr_setname_np): Declare.
+
+2012-03-07  Arnaud Charlet  <charlet@adacore.com>
+
+       * g-trasym.adb: Minor reformatting.
+
+2012-03-07  Robert Dewar  <dewar@adacore.com>
+
+       * a-ngrear.ads: Minor addition of ??? comment.
+
 2012-03-07  Gary Dismukes  <dismukes@adacore.com>
 
        * exp_ch4.adb (Apply_Accessibility_Check): Call
index f03ee37..f849996 100644 (file)
@@ -125,6 +125,9 @@ private
    --  front end always inline these, the expense of the unconstrained returns
    --  can be avoided.
 
+   --  Confusing comment above, why does the front end always inline
+   --  these functions ???
+
    pragma Inline ("+");
    pragma Inline ("-");
    pragma Inline ("*");
index ac2444e..2957ae0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1999-2011, AdaCore                     --
+--                     Copyright (C) 1999-2012, AdaCore                     --
 --                                                                          --
 -- GNAT 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- --
@@ -42,12 +42,10 @@ package body GNAT.Traceback.Symbolic is
    -- Symbolic_Traceback --
    ------------------------
 
-   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
-   is
+   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
    begin
       if Traceback'Length = 0 then
          return "";
-
       else
          declare
             Img : String := System.Address_Image (Traceback (Traceback'First));
@@ -70,8 +68,7 @@ package body GNAT.Traceback.Symbolic is
       end if;
    end Symbolic_Traceback;
 
-   function Symbolic_Traceback (E : Exception_Occurrence) return String
-   is
+   function Symbolic_Traceback (E : Exception_Occurrence) return String is
    begin
       return Symbolic_Traceback (Tracebacks (E));
    end Symbolic_Traceback;
index e325d0e..e24980e 100644 (file)
@@ -520,6 +520,12 @@ package System.OS_Interface is
       sched_param : int) return int;
    pragma Import (C, pthread_attr_setschedparam, "PTHREAD_ATTR_SETSCHEDPARAM");
 
+   function pthread_attr_setname_np
+     (attr : access pthread_attr_t;
+      name : System.Address;
+      mbz  : System.Address) return int;
+   pragma Import (C, pthread_attr_setname_np, "PTHREAD_ATTR_SETNAME_NP");
+
    function sched_yield return int;
 
    --------------------------
index 67cf363..3c500c5 100644 (file)
@@ -780,6 +780,7 @@ package body System.Task_Primitives.Operations is
       function Thread_Body_Access is new
         Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
 
+      Task_Name : String (1 .. System.Parameters.Max_Task_Image_Length + 1);
    begin
       --  Since the initial signal mask of a thread is inherited from the
       --  creator, we need to set our local signal mask to mask all signals
@@ -809,6 +810,18 @@ package body System.Task_Primitives.Operations is
           (Attributes'Access, PTHREAD_EXPLICIT_SCHED);
       pragma Assert (Result = 0);
 
+      if T.Common.Task_Image_Len > 0 then
+         --  Set thread name to ease debugging
+
+         Task_Name (1 .. T.Common.Task_Image_Len) :=
+           T.Common.Task_Image (1 .. T.Common.Task_Image_Len);
+         Task_Name (T.Common.Task_Image_Len + 1) := ASCII.NUL;
+
+         Result := pthread_attr_setname_np
+           (Attributes'Access, Task_Name'Address, Null_Address);
+         pragma Assert (Result = 0);
+      end if;
+
       --  Note: the use of Unrestricted_Access in the following call is needed
       --  because otherwise we have an error of getting a access-to-volatile
       --  value which points to a non-volatile object. But in this case it is