Commit bde73c6b by Arnaud Charlet

[multiple changes]

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

	* sem_util.adb, exp_ch4.adb, exp_ch6.adb, sem_ch6.adb: Minor
	reformatting.

2012-03-07  Sergey Rybin  <rybin@adacore.com frybin>

	* gnat_ugn.texi: gnatpp: fix paragraph about sources with
	preprocessor directives.

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

	* s-osinte-linux.ads, s-taprop-linux.adb (prctl): New function.
	(Enter_Task): Call prctl when relevant.

2012-03-07  Tristan Gingold  <gingold@adacore.com>

	* s-osinte-vms.ads: pthread_mutex_setname_np: new function.

From-SVN: r185065
parent b0d623bb
2012-03-07 Robert Dewar <dewar@adacore.com>
* sem_util.adb, exp_ch4.adb, exp_ch6.adb, sem_ch6.adb: Minor
reformatting.
2012-03-07 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi: gnatpp: fix paragraph about sources with
preprocessor directives.
2012-03-07 Arnaud Charlet <charlet@adacore.com>
* s-osinte-linux.ads, s-taprop-linux.adb (prctl): New function.
(Enter_Task): Call prctl when relevant.
2012-03-07 Tristan Gingold <gingold@adacore.com>
* s-osinte-vms.ads: pthread_mutex_setname_np: new function.
2012-03-07 Ed Schonberg <schonberg@adacore.com> 2012-03-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Process_Formals): a generic subprogram with * sem_ch6.adb (Process_Formals): a generic subprogram with
......
...@@ -3537,9 +3537,7 @@ package body Exp_Ch4 is ...@@ -3537,9 +3537,7 @@ package body Exp_Ch4 is
-- Do not set this attribute on .NET/JVM since those targets do not -- Do not set this attribute on .NET/JVM since those targets do not
-- support pools. -- support pools.
if No (Associated_Storage_Pool (PtrT)) if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then
and then VM_Target = No_VM
then
Set_Associated_Storage_Pool Set_Associated_Storage_Pool
(PtrT, Get_Global_Pool_For_Access_Type (PtrT)); (PtrT, Get_Global_Pool_For_Access_Type (PtrT));
end if; end if;
......
...@@ -2290,12 +2290,11 @@ package body Exp_Ch6 is ...@@ -2290,12 +2290,11 @@ package body Exp_Ch6 is
-------------------------- --------------------------
function In_Unfrozen_Instance (E : Entity_Id) return Boolean is function In_Unfrozen_Instance (E : Entity_Id) return Boolean is
S : Entity_Id := E; S : Entity_Id;
begin begin
while Present (S) S := E;
and then S /= Standard_Standard while Present (S) and then S /= Standard_Standard loop
loop
if Is_Generic_Instance (S) if Is_Generic_Instance (S)
and then Present (Freeze_Node (S)) and then Present (Freeze_Node (S))
and then not Analyzed (Freeze_Node (S)) and then not Analyzed (Freeze_Node (S))
...@@ -2353,9 +2352,7 @@ package body Exp_Ch6 is ...@@ -2353,9 +2352,7 @@ package body Exp_Ch6 is
Res : constant Node_Id := Duplicate_Subexpr (From); Res : constant Node_Id := Duplicate_Subexpr (From);
begin begin
if Is_Access_Type (Etype (From)) then if Is_Access_Type (Etype (From)) then
return return Make_Explicit_Dereference (Sloc (From), Prefix => Res);
Make_Explicit_Dereference (Sloc (From),
Prefix => Res);
else else
return Res; return Res;
end if; end if;
...@@ -3702,7 +3699,6 @@ package body Exp_Ch6 is ...@@ -3702,7 +3699,6 @@ package body Exp_Ch6 is
-- Handle inlining (old semantics) -- Handle inlining (old semantics)
if Is_Inlined (Subp) and then not Debug_Flag_Dot_K then if Is_Inlined (Subp) and then not Debug_Flag_Dot_K then
Inlined_Subprogram : declare Inlined_Subprogram : declare
Bod : Node_Id; Bod : Node_Id;
Must_Inline : Boolean := False; Must_Inline : Boolean := False;
...@@ -4078,7 +4074,7 @@ package body Exp_Ch6 is ...@@ -4078,7 +4074,7 @@ package body Exp_Ch6 is
Targ : Node_Id; Targ : Node_Id;
-- The target of the call. If context is an assignment statement then -- The target of the call. If context is an assignment statement then
-- this is the left-hand side of the assignment; else it is a temporary -- this is the left-hand side of the assignment, else it is a temporary
-- to which the return value is assigned prior to rewriting the call. -- to which the return value is assigned prior to rewriting the call.
Targ1 : Node_Id; Targ1 : Node_Id;
...@@ -4115,8 +4111,8 @@ package body Exp_Ch6 is ...@@ -4115,8 +4111,8 @@ package body Exp_Ch6 is
procedure Reset_Dispatching_Calls (N : Node_Id); procedure Reset_Dispatching_Calls (N : Node_Id);
-- In subtree N search for occurrences of dispatching calls that use the -- In subtree N search for occurrences of dispatching calls that use the
-- Ada 2005 Object.Operation notation and the object is a formal of the -- Ada 2005 Object.Operation notation and the object is a formal of the
-- inlined subprogram; in all the found occurrences reset the entity -- inlined subprogram. Reset the entity associated with Operation in all
-- associated with Operation. -- the found occurrences.
procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id); procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id);
-- If the function body is a single expression, replace call with -- If the function body is a single expression, replace call with
...@@ -4355,9 +4351,10 @@ package body Exp_Ch6 is ...@@ -4355,9 +4351,10 @@ package body Exp_Ch6 is
procedure Reset_Dispatching_Calls (N : Node_Id) is procedure Reset_Dispatching_Calls (N : Node_Id) is
function Do_Reset (N : Node_Id) return Traverse_Result; function Do_Reset (N : Node_Id) return Traverse_Result;
-- Comment required ???
-------------- --------------
-- Do_Check -- -- Do_Reset --
-------------- --------------
function Do_Reset (N : Node_Id) return Traverse_Result is function Do_Reset (N : Node_Id) return Traverse_Result is
...@@ -4377,10 +4374,13 @@ package body Exp_Ch6 is ...@@ -4377,10 +4374,13 @@ package body Exp_Ch6 is
function Do_Reset_Calls is new Traverse_Func (Do_Reset); function Do_Reset_Calls is new Traverse_Func (Do_Reset);
-- Start of processing for Reset_Dispatching_Calls -- Local variables
Dummy : constant Traverse_Result := Do_Reset_Calls (N); Dummy : constant Traverse_Result := Do_Reset_Calls (N);
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
-- Start of processing for Reset_Dispatching_Calls
begin begin
null; null;
end Reset_Dispatching_Calls; end Reset_Dispatching_Calls;
...@@ -5073,8 +5073,7 @@ package body Exp_Ch6 is ...@@ -5073,8 +5073,7 @@ package body Exp_Ch6 is
if Is_Unc_Decl then if Is_Unc_Decl then
-- No action needed since the return statement has been already -- No action needed since return statement has been already removed!
-- removed!
null; null;
......
...@@ -13045,12 +13045,8 @@ semantically legal. ...@@ -13045,12 +13045,8 @@ semantically legal.
If this condition is not met, @command{gnatpp} will terminate with an If this condition is not met, @command{gnatpp} will terminate with an
error message; no output file will be generated. error message; no output file will be generated.
If the source files presented to @command{gnatpp} contain @command{gnatpp} cannot process sources that contain
preprocessing directives, then the output file will preprocessing directives.
correspond to the generated source after all
preprocessing is carried out. There is no way
using @command{gnatpp} to obtain pretty printed files that
include the preprocessing directives.
If the compilation unit If the compilation unit
contained in the input source depends semantically upon units located contained in the input source depends semantically upon units located
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1995-2012, Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -255,6 +255,12 @@ package System.OS_Interface is ...@@ -255,6 +255,12 @@ package System.OS_Interface is
function getpid return pid_t; function getpid return pid_t;
pragma Import (C, getpid, "getpid"); pragma Import (C, getpid, "getpid");
PR_SET_NAME : constant := 15;
function prctl
(option : int; arg2, arg3, arg4, arg5 : unsigned_long := 0) return int;
pragma Import (C, prctl);
------------- -------------
-- Threads -- -- Threads --
------------- -------------
......
...@@ -449,6 +449,12 @@ package System.OS_Interface is ...@@ -449,6 +449,12 @@ package System.OS_Interface is
function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK"); pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK");
function pthread_mutex_setname_np
(attr : access pthread_mutex_t;
name : System.Address;
mbz : System.Address) return int;
pragma Import (C, pthread_mutex_setname_np, "PTHREAD_MUTEX_SETNAME_NP");
function pthread_condattr_init function pthread_condattr_init
(attr : access pthread_condattr_t) return int; (attr : access pthread_condattr_t) return int;
pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT"); pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT");
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -767,6 +767,22 @@ package body System.Task_Primitives.Operations is ...@@ -767,6 +767,22 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.Thread := pthread_self;
Self_ID.Common.LL.LWP := lwp_self; Self_ID.Common.LL.LWP := lwp_self;
if Self_ID.Common.Task_Image_Len > 0 then
declare
Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1);
Result : int;
begin
-- Set thread name to ease debugging
Task_Name (1 .. Self_ID.Common.Task_Image_Len) :=
Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len);
Task_Name (Self_ID.Common.Task_Image_Len + 1) := ASCII.NUL;
Result := prctl (PR_SET_NAME, unsigned_long (Task_Name'Address));
pragma Assert (Result = 0);
end;
end if;
Specific.Set (Self_ID); Specific.Set (Self_ID);
if Use_Alternate_Stack if Use_Alternate_Stack
......
...@@ -4119,7 +4119,8 @@ package body Sem_Ch6 is ...@@ -4119,7 +4119,8 @@ package body Sem_Ch6 is
(Msg : String; (Msg : String;
N : Node_Id; N : Node_Id;
Subp : Entity_Id; Subp : Entity_Id;
Is_Serious : Boolean := False) is Is_Serious : Boolean := False)
is
begin begin
pragma Assert (Msg (Msg'Last) = '?'); pragma Assert (Msg (Msg'Last) = '?');
......
...@@ -9397,8 +9397,7 @@ package body Sem_Util is ...@@ -9397,8 +9397,7 @@ package body Sem_Util is
begin begin
return Optimization_Level = 0 return Optimization_Level = 0
and then Has_Pragma_Inline (Subp) and then Has_Pragma_Inline (Subp)
and then (Has_Pragma_Inline_Always (Subp) and then (Has_Pragma_Inline_Always (Subp) or else Front_End_Inlining);
or else Front_End_Inlining);
end Must_Inline; end Must_Inline;
---------------------- ----------------------
......
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