[multiple changes]
2014-08-01 Robert Dewar <dewar@adacore.com> * inline.adb, s-os_lib.ads: Minor reformatting. 2014-08-01 Arnaud Charlet <charlet@adacore.com> * s-tasdeb.ads, s-tasdeb.adb (Master_Hook, Master_Completed_Hook): New. * s-tassta.adb (Task_Wrapper, Vulnerable_Complete_Master): Call new hooks. From-SVN: r213444
This commit is contained in:
parent
39521a94f8
commit
3fe5ceadbb
@ -1,3 +1,13 @@
|
|||||||
|
2014-08-01 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* inline.adb, s-os_lib.ads: Minor reformatting.
|
||||||
|
|
||||||
|
2014-08-01 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
|
* s-tasdeb.ads, s-tasdeb.adb (Master_Hook, Master_Completed_Hook): New.
|
||||||
|
* s-tassta.adb (Task_Wrapper, Vulnerable_Complete_Master): Call new
|
||||||
|
hooks.
|
||||||
|
|
||||||
2014-08-01 Yannick Moy <moy@adacore.com>
|
2014-08-01 Yannick Moy <moy@adacore.com>
|
||||||
|
|
||||||
* inline.adb (Cannot_Inline): Issue info message instead of
|
* inline.adb (Cannot_Inline): Issue info message instead of
|
||||||
|
@ -1239,10 +1239,14 @@ package body Inline is
|
|||||||
and then Msg (Msg'First .. Msg'First + 12) = "cannot inline"
|
and then Msg (Msg'First .. Msg'First + 12) = "cannot inline"
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
Len1 : constant Positive := 13; -- length of "cannot inline"
|
Len1 : constant Positive := 13;
|
||||||
|
-- Length of "cannot inline"
|
||||||
|
|
||||||
Len2 : constant Positive := 31;
|
Len2 : constant Positive := 31;
|
||||||
-- lenth of "info: no contextual analysis of"
|
-- Length of "info: no contextual analysis of"
|
||||||
|
|
||||||
New_Msg : String (1 .. Msg'Length + Len2 - Len1);
|
New_Msg : String (1 .. Msg'Length + Len2 - Len1);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
New_Msg (1 .. Len2) := "info: no contextual analysis of";
|
New_Msg (1 .. Len2) := "info: no contextual analysis of";
|
||||||
New_Msg (Len2 + 1 .. Msg'Length + Len2 - Len1) :=
|
New_Msg (Len2 + 1 .. Msg'Length + Len2 - Len1) :=
|
||||||
|
@ -426,7 +426,9 @@ package System.OS_Lib is
|
|||||||
-- to the current position (origin = SEEK_CUR), end of file (origin =
|
-- to the current position (origin = SEEK_CUR), end of file (origin =
|
||||||
-- SEEK_END), or start of file (origin = SEEK_SET).
|
-- SEEK_END), or start of file (origin = SEEK_SET).
|
||||||
|
|
||||||
type Large_File_Size is range -2 ** 63 .. 2 ** 63 - 1;
|
type Large_File_Size is range -2**63 .. 2**63 - 1;
|
||||||
|
-- Maximum supported size for a file (8 exabytes = 8 million terabytes,
|
||||||
|
-- should be enough to accomodate all possible needs for quite a while).
|
||||||
|
|
||||||
function File_Length (FD : File_Descriptor) return Long_Integer;
|
function File_Length (FD : File_Descriptor) return Long_Integer;
|
||||||
pragma Import (C, File_Length, "__gnat_file_length_long");
|
pragma Import (C, File_Length, "__gnat_file_length_long");
|
||||||
|
@ -437,4 +437,34 @@ package body System.Tasking.Debug is
|
|||||||
(Fd, S'Address, System.CRTL.size_t (Count));
|
(Fd, S'Address, System.CRTL.size_t (Count));
|
||||||
end Write;
|
end Write;
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
-- Master_Hook --
|
||||||
|
-----------------
|
||||||
|
|
||||||
|
procedure Master_Hook
|
||||||
|
(Dependent : Task_Id;
|
||||||
|
Parent : Task_Id;
|
||||||
|
Master_Level : Integer)
|
||||||
|
is
|
||||||
|
pragma Inspection_Point (Dependent);
|
||||||
|
pragma Inspection_Point (Parent);
|
||||||
|
pragma Inspection_Point (Master_Level);
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end Master_Hook;
|
||||||
|
|
||||||
|
---------------------------
|
||||||
|
-- Master_Completed_Hook --
|
||||||
|
---------------------------
|
||||||
|
|
||||||
|
procedure Master_Completed_Hook
|
||||||
|
(Self_ID : Task_Id;
|
||||||
|
Master_Level : Integer)
|
||||||
|
is
|
||||||
|
pragma Inspection_Point (Self_ID);
|
||||||
|
pragma Inspection_Point (Master_Level);
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end Master_Completed_Hook;
|
||||||
|
|
||||||
end System.Tasking.Debug;
|
end System.Tasking.Debug;
|
||||||
|
@ -145,4 +145,21 @@ package System.Tasking.Debug is
|
|||||||
-- Enable or disable tracing for Flag. By default, flags in the range
|
-- Enable or disable tracing for Flag. By default, flags in the range
|
||||||
-- 'A' .. 'Z' are disabled, others are enabled.
|
-- 'A' .. 'Z' are disabled, others are enabled.
|
||||||
|
|
||||||
|
---------------------------------
|
||||||
|
-- Hooks for Valgrind/Helgrind --
|
||||||
|
---------------------------------
|
||||||
|
|
||||||
|
procedure Master_Hook
|
||||||
|
(Dependent : Task_Id;
|
||||||
|
Parent : Task_Id;
|
||||||
|
Master_Level : Integer);
|
||||||
|
-- Indicate to Valgrind/Helgrind that the master of Dependent
|
||||||
|
-- is Parent + Master_Level.
|
||||||
|
|
||||||
|
procedure Master_Completed_Hook
|
||||||
|
(Self_ID : Task_Id;
|
||||||
|
Master_Level : Integer);
|
||||||
|
-- Indicate to Valgrind/Helgrind that Self_ID has completed
|
||||||
|
-- the master Master_Level.
|
||||||
|
|
||||||
end System.Tasking.Debug;
|
end System.Tasking.Debug;
|
||||||
|
@ -1119,6 +1119,9 @@ package body System.Tasking.Stages is
|
|||||||
begin
|
begin
|
||||||
pragma Assert (Self_ID.Deferral_Level = 1);
|
pragma Assert (Self_ID.Deferral_Level = 1);
|
||||||
|
|
||||||
|
Debug.Master_Hook
|
||||||
|
(Self_ID, Self_ID.Common.Parent, Self_ID.Master_of_Task);
|
||||||
|
|
||||||
-- Assume a size of the stack taken at this stage
|
-- Assume a size of the stack taken at this stage
|
||||||
|
|
||||||
if not Parameters.Sec_Stack_Dynamic then
|
if not Parameters.Sec_Stack_Dynamic then
|
||||||
@ -1985,6 +1988,8 @@ package body System.Tasking.Stages is
|
|||||||
-- since the value is only updated by each task for itself.
|
-- since the value is only updated by each task for itself.
|
||||||
|
|
||||||
Self_ID.Master_Within := CM - 1;
|
Self_ID.Master_Within := CM - 1;
|
||||||
|
|
||||||
|
Debug.Master_Completed_Hook (Self_ID, CM);
|
||||||
end Vulnerable_Complete_Master;
|
end Vulnerable_Complete_Master;
|
||||||
|
|
||||||
------------------------------
|
------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user