Commit 207aaeda by Arnaud Charlet

[multiple changes]

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.

From-SVN: r185052
parent e761d11c
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> 2012-03-07 Gary Dismukes <dismukes@adacore.com>
* exp_ch4.adb (Apply_Accessibility_Check): Call * exp_ch4.adb (Apply_Accessibility_Check): Call
......
...@@ -125,6 +125,9 @@ private ...@@ -125,6 +125,9 @@ private
-- front end always inline these, the expense of the unconstrained returns -- front end always inline these, the expense of the unconstrained returns
-- can be avoided. -- can be avoided.
-- Confusing comment above, why does the front end always inline
-- these functions ???
pragma Inline ("+"); pragma Inline ("+");
pragma Inline ("-"); pragma Inline ("-");
pragma Inline ("*"); pragma Inline ("*");
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,12 +42,10 @@ package body GNAT.Traceback.Symbolic is ...@@ -42,12 +42,10 @@ package body GNAT.Traceback.Symbolic is
-- Symbolic_Traceback -- -- Symbolic_Traceback --
------------------------ ------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
is
begin begin
if Traceback'Length = 0 then if Traceback'Length = 0 then
return ""; return "";
else else
declare declare
Img : String := System.Address_Image (Traceback (Traceback'First)); Img : String := System.Address_Image (Traceback (Traceback'First));
...@@ -70,8 +68,7 @@ package body GNAT.Traceback.Symbolic is ...@@ -70,8 +68,7 @@ package body GNAT.Traceback.Symbolic is
end if; end if;
end Symbolic_Traceback; end Symbolic_Traceback;
function Symbolic_Traceback (E : Exception_Occurrence) return String function Symbolic_Traceback (E : Exception_Occurrence) return String is
is
begin begin
return Symbolic_Traceback (Tracebacks (E)); return Symbolic_Traceback (Tracebacks (E));
end Symbolic_Traceback; end Symbolic_Traceback;
......
...@@ -520,6 +520,12 @@ package System.OS_Interface is ...@@ -520,6 +520,12 @@ package System.OS_Interface is
sched_param : int) return int; sched_param : int) return int;
pragma Import (C, pthread_attr_setschedparam, "PTHREAD_ATTR_SETSCHEDPARAM"); 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; function sched_yield return int;
-------------------------- --------------------------
......
...@@ -780,6 +780,7 @@ package body System.Task_Primitives.Operations is ...@@ -780,6 +780,7 @@ package body System.Task_Primitives.Operations is
function Thread_Body_Access is new function Thread_Body_Access is new
Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body); Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
Task_Name : String (1 .. System.Parameters.Max_Task_Image_Length + 1);
begin begin
-- Since the initial signal mask of a thread is inherited from the -- 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 -- creator, we need to set our local signal mask to mask all signals
...@@ -809,6 +810,18 @@ package body System.Task_Primitives.Operations is ...@@ -809,6 +810,18 @@ package body System.Task_Primitives.Operations is
(Attributes'Access, PTHREAD_EXPLICIT_SCHED); (Attributes'Access, PTHREAD_EXPLICIT_SCHED);
pragma Assert (Result = 0); 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 -- Note: the use of Unrestricted_Access in the following call is needed
-- because otherwise we have an error of getting a access-to-volatile -- 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 -- value which points to a non-volatile object. But in this case it is
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment