Skip to content

R
riscv-gcc-1
Commit bde73c6b by Arnaud Charlet
Options

[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
Showing with 71 additions and 31 deletions
gcc/ada/ChangeLog
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>
* sem_ch6.adb (Process_Formals): a generic subprogram with
......
gcc/ada/exp_ch4.adb
......@@ -3529,17 +3529,15 @@ package body Exp_Ch4 is
-- Expand_Allocator_Expression inherit the proper type attributes.
if (Ekind (PtrT) = E_Anonymous_Access_Type
or else
(Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
or else
(Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
and then Needs_Finalization (Dtyp)
then
-- Anonymous access-to-controlled types allocate on the global pool.
-- Do not set this attribute on .NET/JVM since those targets do not
-- support pools.
if No (Associated_Storage_Pool (PtrT))
and then VM_Target = No_VM
then
if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then
Set_Associated_Storage_Pool
(PtrT, Get_Global_Pool_For_Access_Type (PtrT));
end if;
......
gcc/ada/exp_ch6.adb
......@@ -2290,12 +2290,11 @@ package body Exp_Ch6 is
--------------------------
function In_Unfrozen_Instance (E : Entity_Id) return Boolean is
S : Entity_Id := E;
S : Entity_Id;
begin
while Present (S)
and then S /= Standard_Standard
loop
S := E;
while Present (S) and then S /= Standard_Standard loop
if Is_Generic_Instance (S)
and then Present (Freeze_Node (S))
and then not Analyzed (Freeze_Node (S))
......@@ -2353,9 +2352,7 @@ package body Exp_Ch6 is
Res : constant Node_Id := Duplicate_Subexpr (From);
begin
if Is_Access_Type (Etype (From)) then
return
Make_Explicit_Dereference (Sloc (From),
Prefix => Res);
return Make_Explicit_Dereference (Sloc (From), Prefix => Res);
else
return Res;
end if;
......@@ -3702,7 +3699,6 @@ package body Exp_Ch6 is
-- Handle inlining (old semantics)
if Is_Inlined (Subp) and then not Debug_Flag_Dot_K then
Inlined_Subprogram : declare
Bod : Node_Id;
Must_Inline : Boolean := False;
......@@ -4078,7 +4074,7 @@ package body Exp_Ch6 is
Targ : Node_Id;
-- 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.
Targ1 : Node_Id;
......@@ -4115,8 +4111,8 @@ package body Exp_Ch6 is
procedure Reset_Dispatching_Calls (N : Node_Id);
-- 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
-- inlined subprogram; in all the found occurrences reset the entity
-- associated with Operation.
-- inlined subprogram. Reset the entity associated with Operation in all
-- the found occurrences.
procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id);
-- If the function body is a single expression, replace call with
......@@ -4355,9 +4351,10 @@ package body Exp_Ch6 is
procedure Reset_Dispatching_Calls (N : Node_Id) is
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
......@@ -4377,10 +4374,13 @@ package body Exp_Ch6 is
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);
pragma Unreferenced (Dummy);
-- Start of processing for Reset_Dispatching_Calls
begin
null;
end Reset_Dispatching_Calls;
......@@ -5073,8 +5073,7 @@ package body Exp_Ch6 is
if Is_Unc_Decl then
-- No action needed since the return statement has been already
-- removed!
-- No action needed since return statement has been already removed!
null;
......
gcc/ada/gnat_ugn.texi
......@@ -13045,12 +13045,8 @@ semantically legal.
If this condition is not met, @command{gnatpp} will terminate with an
error message; no output file will be generated.
If the source files presented to @command{gnatpp} contain
preprocessing directives, then the output file will
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.
@command{gnatpp} cannot process sources that contain
preprocessing directives.
If the compilation unit
contained in the input source depends semantically upon units located
......
gcc/ada/s-osinte-linux.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -255,6 +255,12 @@ package System.OS_Interface is
function getpid return pid_t;
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 --
-------------
......
gcc/ada/s-osinte-vms.ads
......@@ -449,6 +449,12 @@ package System.OS_Interface is
function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
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
(attr : access pthread_condattr_t) return int;
pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT");
......
gcc/ada/s-taprop-linux.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -767,6 +767,22 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := pthread_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);
if Use_Alternate_Stack
......
gcc/ada/sem_ch6.adb
......@@ -4119,7 +4119,8 @@ package body Sem_Ch6 is
(Msg : String;
N : Node_Id;
Subp : Entity_Id;
Is_Serious : Boolean := False) is
Is_Serious : Boolean := False)
is
begin
pragma Assert (Msg (Msg'Last) = '?');
......
gcc/ada/sem_util.adb
......@@ -9397,8 +9397,7 @@ package body Sem_Util is
begin
return Optimization_Level = 0
and then Has_Pragma_Inline (Subp)
and then (Has_Pragma_Inline_Always (Subp)
or else Front_End_Inlining);
and then (Has_Pragma_Inline_Always (Subp) or else Front_End_Inlining);
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