+2015-10-16 Gary Dismukes <dismukes@adacore.com>
+
+ * prj.adb, sem_util.adb, exp_ch6.adb: Minor reformatting.
+
+2015-10-16 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <rupp@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
-- 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
+ -- <original loop statements>
+ -- 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);
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);
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.
-- 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
-- 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;
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;
-- --
-- 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- --
-- operations. It causes infinite loops and other problems.
with Interfaces.C;
-with Interfaces.C.Extensions;
with System.Task_Info;
with System.Tasking.Debug;
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;
---------------------
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;
-------------------
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
-- 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 ...);
-- 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 ...);
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;
projects / gcc.git / commitdiff