From 4b8ae2b07254fc6a7b963c5213dafd5ef7eddef2 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 16 Oct 2015 15:25:00 +0200 Subject: [PATCH] [multiple changes] 2015-10-16 Gary Dismukes * prj.adb, sem_util.adb, exp_ch6.adb: Minor reformatting. 2015-10-16 Ed Schonberg * exp_ch5.adb (Expand_Formal_Container_Element_Loop): Modify expansion to allow element iteration over formal containers whose elements are indefinite types. 2015-10-16 Doug Rupp * s-taprop-linux.adb (Monotonic_Clock): Call clock_gettime instead of gettimeofday. * s-osinte-linux.ads (clock_gettime): New imported subprogram. From-SVN: r228901 --- gcc/ada/ChangeLog | 16 ++++++++ gcc/ada/exp_ch5.adb | 76 +++++++++++++++++++++++++++----------- gcc/ada/exp_ch6.adb | 6 +-- gcc/ada/prj.adb | 2 +- gcc/ada/s-osinte-linux.ads | 4 ++ gcc/ada/s-taprop-linux.adb | 30 +++------------ gcc/ada/sem_util.adb | 12 +++--- 7 files changed, 90 insertions(+), 56 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a4696b5ad4e..c62e7a21d1a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2015-10-16 Gary Dismukes + + * prj.adb, sem_util.adb, exp_ch6.adb: Minor reformatting. + +2015-10-16 Ed Schonberg + + * exp_ch5.adb (Expand_Formal_Container_Element_Loop): Modify + expansion to allow element iteration over formal containers + whose elements are indefinite types. + +2015-10-16 Doug Rupp + + * s-taprop-linux.adb (Monotonic_Clock): Call clock_gettime + instead of gettimeofday. + * s-osinte-linux.ads (clock_gettime): New imported subprogram. + 2015-10-16 Hristian Kirtchev * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c0cd6044180..29113e5c863 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2899,8 +2899,23 @@ package body Exp_Ch5 is -- Cursor := Next (Container, Cursor); -- end loop; + -- However this expansion is not legal if the element is indefinite. + -- In that case we create a block to hold a variable declaration + -- initialized with a call to Element, and generate: + + -- Cursor : Cursor_type := First (Container); + -- while Has_Element (Cursor, Container) loop + -- declare + -- Elmt : Element-Type := Element (Container, Cursor); + -- begin + -- + -- Cursor := Next (Container, Cursor); + -- end; + -- end loop; + Build_Formal_Container_Iteration (N, Container, Cursor, Init, Advance, New_Loop); + Append_To (Stats, Advance); Set_Ekind (Cursor, E_Variable); Insert_Action (N, Init); @@ -2912,33 +2927,50 @@ package body Exp_Ch5 is Defining_Identifier => Element, Object_Definition => New_Occurrence_Of (Etype (Element_Op), Loc)); - -- The element is only modified in expanded code, so it appears as - -- unassigned to the warning machinery. We must suppress this spurious - -- warning explicitly. + if not Is_Constrained (Etype (Element_Op)) then + Set_Expression (Elmt_Decl, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Element_Op, Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Container, Loc), + New_Occurrence_Of (Cursor, Loc)))); + + Set_Statements (New_Loop, + New_List + (Make_Block_Statement (Loc, + Declarations => New_List (Elmt_Decl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stats)))); - Set_Warnings_Off (Element); + else + Elmt_Ref := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Element, Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Element_Op, Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Container, Loc), + New_Occurrence_Of (Cursor, Loc)))); - Elmt_Ref := - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Element, Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Element_Op, Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Container, Loc), - New_Occurrence_Of (Cursor, Loc)))); + Prepend (Elmt_Ref, Stats); - Prepend (Elmt_Ref, Stats); - Append_To (Stats, Advance); + -- The loop is rewritten as a block, to hold the element declaration - -- The loop is rewritten as a block, to hold the element declaration + New_Loop := + Make_Block_Statement (Loc, + Declarations => New_List (Elmt_Decl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List (New_Loop))); + end if; - New_Loop := - Make_Block_Statement (Loc, - Declarations => New_List (Elmt_Decl), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (New_Loop))); + -- The element is only modified in expanded code, so it appears as + -- unassigned to the warning machinery. We must suppress this spurious + -- warning explicitly. + + Set_Warnings_Off (Element); Rewrite (N, New_Loop); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4733eb4f83a..0a3095338af 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8979,8 +8979,8 @@ package body Exp_Ch6 is Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - -- The allocation for indefinite library level objects occurs on the - -- heap as opposed to the secondary stack. This accomodates DLLs where + -- The allocation for indefinite library-level objects occurs on the + -- heap as opposed to the secondary stack. This accommodates DLLs where -- the secondary stack is destroyed after each library unload. This is -- a hybrid mechanism where a stack-allocated object lives on the heap. @@ -8993,7 +8993,7 @@ package body Exp_Ch6 is -- Create a finalization master for the access result type to ensure -- that the heap allocation can properly chain the object and later - -- finalize it when the library unit does out of scope. + -- finalize it when the library unit goes out of scope. if Needs_Finalization (Etype (Func_Call)) then Build_Finalization_Master diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 3d71bde3874..d1c0b169f06 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -599,7 +599,7 @@ package body Prj is -- This set is needed to ensure that we do not handle the same -- project twice in the context of aggregate libraries. -- Since duplicate project names are possible in the context of - -- aggregated projects, we need to check the full paths + -- aggregated projects, we need to check the full paths. procedure Recursive_Check (Project : Project_Id; diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index 8dfbbe83044..2bcf56e500d 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -224,6 +224,10 @@ package System.OS_Interface is subtype timeval is System.Linux.timeval; subtype clockid_t is System.Linux.clockid_t; + function clock_gettime + (clock_id : clockid_t; tp : access timespec) return int; + pragma Import (C, clock_gettime, "clock_gettime"); + function clock_getres (clock_id : clockid_t; res : access timespec) return int; diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index a43133a9dee..2aad75ebead 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -39,7 +39,6 @@ pragma Polling (Off); -- operations. It causes infinite loops and other problems. with Interfaces.C; -with Interfaces.C.Extensions; with System.Task_Info; with System.Tasking.Debug; @@ -64,7 +63,6 @@ package body System.Task_Primitives.Operations is use System.Tasking.Debug; use System.Tasking; use Interfaces.C; - use Interfaces.C.Extensions; use System.OS_Interface; use System.Parameters; use System.OS_Primitives; @@ -629,30 +627,14 @@ package body System.Task_Primitives.Operations is --------------------- function Monotonic_Clock return Duration is - use Interfaces; - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access C.Extensions.long_long; - usec : not null access C.long); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased C.Extensions.long_long; - usec : aliased C.long; - TV : aliased timeval; + TS : aliased timespec; Result : int; - - function gettimeofday - (Tv : access timeval; - Tz : System.Address := System.Null_Address) return int; - pragma Import (C, gettimeofday, "gettimeofday"); - begin - Result := gettimeofday (TV'Access, System.Null_Address); + Result := clock_gettime + (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); pragma Assert (Result = 0); - timeval_to_duration (TV'Access, sec'Access, usec'Access); - return Duration (sec) + Duration (usec) / Micro; + + return To_Duration (TS); end Monotonic_Clock; ------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index bd47c150a83..214ec62ad7f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11504,7 +11504,7 @@ package body Sem_Util is then return Is_EVF_Expression (Expression (N)); - -- Attributes 'Loop_Entry, 'Old and 'Update are an EVF expression when + -- Attributes 'Loop_Entry, 'Old, and 'Update are EVF expressions when -- their prefix denotes an EVF expression. elsif Nkind (N) = N_Attribute_Reference @@ -14214,8 +14214,8 @@ package body Sem_Util is -- Start of processing Mark_Coextensions begin - -- An allocator that appears on the right hand side of an assignment is - -- treated as a potentially dynamic coextension when the right hand side + -- An allocator that appears on the right-hand side of an assignment is + -- treated as a potentially dynamic coextension when the right-hand side -- is an allocator or a qualified expression. -- Obj := new ...'(new Coextension ...); @@ -14227,7 +14227,7 @@ package body Sem_Util is -- An allocator that appears within the expression of a simple return -- statement is treated as a potentially dynamic coextension when the - -- expression is either aggregate, allocator or qualified expression. + -- expression is either aggregate, allocator, or qualified expression. -- return (new Coextension ...); -- return new ...'(new Coextension ...); @@ -14257,8 +14257,8 @@ package body Sem_Util is or else Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement; - -- This routine should not be called with constructs which may not - -- contain coextensions. + -- This routine should not be called with constructs that cannot contain + -- coextensions. else raise Program_Error; -- 2.30.2