[multiple changes]
2015-01-07 Robert Dewar <dewar@adacore.com> * s-taprop-linux.adb, clean.adb: Minor reformatting. 2015-01-07 Arnaud Charlet <charlet@adacore.com> * s-tassta.adb: Relax some overzealous assertions. 2015-01-07 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Analyze_Return_Type): An call that returns a limited view of a type is legal when context is a thunk generated for operation inherited from an interface. * exp_ch6.adb (Expand_Simple_Function_Return): If context is a thunk and return type is an incomplete type do not continue expansion; thunk will be fully elaborated when generating code. 2015-01-07 Doug Rupp <rupp@adacore.com> * s-osinte-mingw.ads (LARGE_INTEGR): New subtype. (QueryPerformanceFrequency): New imported procedure. * s-taprop-mingw.adb (RT_Resolution): Call above and return resolution vice a hardcoded value. * s-taprop-solaris.adb (RT_Resolution): Call clock_getres and return resolution vice a hardcoded value. * s-linux-android.ads (clockid_t): New subtype. * s-osinte-aix.ads (clock_getres): New imported subprogram. * s-osinte-android.ads (clock_getres): Likewise. * s-osinte-freebsd.ads (clock_getres): Likewise. * s-osinte-solaris-posix.ads (clock_getres): Likewise. * s-osinte-darwin.ads (clock_getres): New subprogram. * s-osinte-darwin.adb (clock_getres): New subprogram. * thread.c (__gnat_clock_get_res) [__APPLE__]: New function. * s-taprop-posix.adb (RT_Resolution): Call clock_getres to calculate resolution vice hard coded value. 2015-01-07 Ed Schonberg <schonberg@adacore.com> * exp_util.adb (Make_CW_Equivalent_Type): If root type is a limited view, use non-limited view when available to create equivalent record type. 2015-01-07 Vincent Celier <celier@adacore.com> * gnatcmd.adb: Remove command Sync and any data and processing related to this command. Remove project processing for gnatstack. * prj-attr.adb: Remove package Synchonize and its attributes. From-SVN: r219291
This commit is contained in:
parent
6a989c79d4
commit
ed09416ff9
|
@ -1,3 +1,51 @@
|
|||
2015-01-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* s-taprop-linux.adb, clean.adb: Minor reformatting.
|
||||
|
||||
2015-01-07 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* s-tassta.adb: Relax some overzealous assertions.
|
||||
|
||||
2015-01-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Analyze_Return_Type): An call that returns a limited
|
||||
view of a type is legal when context is a thunk generated for
|
||||
operation inherited from an interface.
|
||||
* exp_ch6.adb (Expand_Simple_Function_Return): If context is
|
||||
a thunk and return type is an incomplete type do not continue
|
||||
expansion; thunk will be fully elaborated when generating code.
|
||||
|
||||
2015-01-07 Doug Rupp <rupp@adacore.com>
|
||||
|
||||
* s-osinte-mingw.ads (LARGE_INTEGR): New subtype.
|
||||
(QueryPerformanceFrequency): New imported procedure.
|
||||
* s-taprop-mingw.adb (RT_Resolution): Call above and return
|
||||
resolution vice a hardcoded value.
|
||||
* s-taprop-solaris.adb (RT_Resolution): Call clock_getres and return
|
||||
resolution vice a hardcoded value.
|
||||
* s-linux-android.ads (clockid_t): New subtype.
|
||||
* s-osinte-aix.ads (clock_getres): New imported subprogram.
|
||||
* s-osinte-android.ads (clock_getres): Likewise.
|
||||
* s-osinte-freebsd.ads (clock_getres): Likewise.
|
||||
* s-osinte-solaris-posix.ads (clock_getres): Likewise.
|
||||
* s-osinte-darwin.ads (clock_getres): New subprogram.
|
||||
* s-osinte-darwin.adb (clock_getres): New subprogram.
|
||||
* thread.c (__gnat_clock_get_res) [__APPLE__]: New function.
|
||||
* s-taprop-posix.adb (RT_Resolution): Call clock_getres to
|
||||
calculate resolution vice hard coded value.
|
||||
|
||||
2015-01-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_util.adb (Make_CW_Equivalent_Type): If root type is a
|
||||
limited view, use non-limited view when available to create
|
||||
equivalent record type.
|
||||
|
||||
2015-01-07 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb: Remove command Sync and any data and processing
|
||||
related to this command. Remove project processing for gnatstack.
|
||||
* prj-attr.adb: Remove package Synchonize and its attributes.
|
||||
|
||||
2015-01-07 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* clean.adb: Minor error message change.
|
||||
|
|
|
@ -897,9 +897,9 @@ package body Clean is
|
|||
-- object directory.
|
||||
|
||||
if (Unit.File_Names (Impl) /= null
|
||||
and then
|
||||
In_Extension_Chain
|
||||
(Unit.File_Names (Impl).Project, Project))
|
||||
and then
|
||||
In_Extension_Chain
|
||||
(Unit.File_Names (Impl).Project, Project))
|
||||
or else
|
||||
(Unit.File_Names (Spec) /= null
|
||||
and then
|
||||
|
@ -1387,8 +1387,8 @@ package body Clean is
|
|||
|
||||
if Project_File_Name /= null then
|
||||
Put_Line
|
||||
("warning: gnatclean -P is obsolete and will not be available " &
|
||||
"in the next release; use gprclean instead.");
|
||||
("warning: gnatclean -P is obsolete and will not be available "
|
||||
& "in the next release; use gprclean instead.");
|
||||
end if;
|
||||
|
||||
-- A project file was specified by a -P switch
|
||||
|
@ -1655,8 +1655,9 @@ package body Clean is
|
|||
|
||||
case Arg (2) is
|
||||
when '-' =>
|
||||
if Arg'Length > Subdirs_Option'Length and then
|
||||
Arg (1 .. Subdirs_Option'Length) = Subdirs_Option
|
||||
if Arg'Length > Subdirs_Option'Length
|
||||
and then
|
||||
Arg (1 .. Subdirs_Option'Length) = Subdirs_Option
|
||||
then
|
||||
Subdirs :=
|
||||
new String'
|
||||
|
@ -1790,7 +1791,8 @@ package body Clean is
|
|||
declare
|
||||
Prj : constant String := Arg (3 .. Arg'Last);
|
||||
begin
|
||||
if Prj'Length > 1 and then Prj (Prj'First) = '='
|
||||
if Prj'Length > 1
|
||||
and then Prj (Prj'First) = '='
|
||||
then
|
||||
Project_File_Name :=
|
||||
new String'
|
||||
|
|
|
@ -5914,6 +5914,14 @@ package body Exp_Ch6 is
|
|||
elsif Is_Thunk (Current_Scope) and then Is_Interface (Exptyp) then
|
||||
null;
|
||||
|
||||
-- If the call is within a thunk and the type is a limited view, the
|
||||
-- backend will eventually see the non-limited view of the type.
|
||||
|
||||
elsif Is_Thunk (Current_Scope)
|
||||
and then Is_Incomplete_Type (Exptyp)
|
||||
then
|
||||
return;
|
||||
|
||||
elsif not Requires_Transient_Scope (R_Type) then
|
||||
|
||||
-- Mutable records with no variable length components are not
|
||||
|
|
|
@ -6074,6 +6074,16 @@ package body Exp_Util is
|
|||
or else Is_Constrained (Root_Typ)
|
||||
then
|
||||
Constr_Root := Root_Typ;
|
||||
|
||||
-- At this point in the expansion, non-limited view of the type
|
||||
-- must be available, otherwise the error will be reported later.
|
||||
|
||||
if From_Limited_With (Constr_Root)
|
||||
and then Present (Non_Limited_View (Constr_Root))
|
||||
then
|
||||
Constr_Root := Non_Limited_View (Constr_Root);
|
||||
end if;
|
||||
|
||||
else
|
||||
Constr_Root := Make_Temporary (Loc, 'R');
|
||||
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -326,12 +326,6 @@ package body Prj.Attr is
|
|||
"Ladefault_switches#" &
|
||||
"LbOswitches#" &
|
||||
|
||||
-- package Synchronize
|
||||
|
||||
"Psynchronize#" &
|
||||
"Ladefault_switches#" &
|
||||
"LbOswitches#" &
|
||||
|
||||
-- package Eliminate
|
||||
|
||||
"Peliminate#" &
|
||||
|
|
|
@ -47,6 +47,7 @@ package System.Linux is
|
|||
subtype long is Interfaces.C.long;
|
||||
subtype suseconds_t is Interfaces.C.long;
|
||||
subtype time_t is Interfaces.C.long;
|
||||
subtype clockid_t is Interfaces.C.int;
|
||||
|
||||
type timespec is record
|
||||
tv_sec : time_t;
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1991-1994, Florida State University --
|
||||
-- Copyright (C) 1995-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1995-2014, 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- --
|
||||
|
@ -206,6 +206,11 @@ package System.OS_Interface is
|
|||
tp : access timespec) return int;
|
||||
pragma Import (C, clock_gettime, "clock_gettime");
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int;
|
||||
pragma Import (C, clock_getres, "clock_getres");
|
||||
|
||||
function To_Duration (TS : timespec) return Duration;
|
||||
pragma Inline (To_Duration);
|
||||
|
||||
|
|
|
@ -211,6 +211,11 @@ package System.OS_Interface is
|
|||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int;
|
||||
pragma Import (C, clock_getres, "clock_getres");
|
||||
|
||||
function To_Duration (TS : timespec) return Duration;
|
||||
pragma Inline (To_Duration);
|
||||
|
||||
|
|
|
@ -129,6 +129,36 @@ package body System.OS_Interface is
|
|||
return Result;
|
||||
end clock_gettime;
|
||||
|
||||
------------------
|
||||
-- clock_getres --
|
||||
------------------
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int
|
||||
is
|
||||
pragma Unreferenced (clock_id);
|
||||
|
||||
-- Darwin Threads don't have clock_getres.
|
||||
|
||||
Nano : constant := 10**9;
|
||||
nsec : int := 0;
|
||||
Result : int := -1;
|
||||
|
||||
function clock_get_res return int;
|
||||
pragma Import (C, clock_get_res, "__gnat_clock_get_res");
|
||||
|
||||
begin
|
||||
nsec := clock_get_res;
|
||||
res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano);
|
||||
|
||||
if nsec > 0 then
|
||||
Result := 0;
|
||||
end if;
|
||||
|
||||
return Result;
|
||||
end clock_getres;
|
||||
|
||||
-----------------
|
||||
-- sched_yield --
|
||||
-----------------
|
||||
|
|
|
@ -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-2014, 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- --
|
||||
|
@ -189,6 +189,10 @@ package System.OS_Interface is
|
|||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int;
|
||||
|
||||
function To_Duration (TS : timespec) return Duration;
|
||||
pragma Inline (To_Duration);
|
||||
|
||||
|
|
|
@ -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-2014, 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- --
|
||||
|
@ -202,6 +202,11 @@ package System.OS_Interface is
|
|||
|
||||
type clockid_t is new int;
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int;
|
||||
pragma Import (C, clock_getres, "clock_getres");
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : clockid_t;
|
||||
tp : access timespec)
|
||||
|
|
|
@ -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-2014, 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- --
|
||||
|
@ -53,6 +53,8 @@ package System.OS_Interface is
|
|||
subtype int is Interfaces.C.int;
|
||||
subtype long is Interfaces.C.long;
|
||||
|
||||
subtype LARGE_INTEGER is System.Win32.LARGE_INTEGER;
|
||||
|
||||
-------------------
|
||||
-- General Types --
|
||||
-------------------
|
||||
|
@ -104,6 +106,18 @@ package System.OS_Interface is
|
|||
procedure kill (sig : Signal);
|
||||
pragma Import (C, kill, "raise");
|
||||
|
||||
------------
|
||||
-- Clock --
|
||||
------------
|
||||
|
||||
procedure QueryPerformanceFrequency
|
||||
(lpPerformanceFreq : access LARGE_INTEGER);
|
||||
pragma Import
|
||||
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
|
||||
|
||||
-- According to the spec, on XP and later than function cannot fail,
|
||||
-- so we ignore the return value and import it as a procedure.
|
||||
|
||||
-------------
|
||||
-- Threads --
|
||||
-------------
|
||||
|
|
|
@ -189,6 +189,11 @@ package System.OS_Interface is
|
|||
|
||||
type clockid_t is new int;
|
||||
|
||||
function clock_getres
|
||||
(clock_id : clockid_t;
|
||||
res : access timespec) return int;
|
||||
pragma Import (C, clock_getres, "clock_getres");
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
|
|
|
@ -662,6 +662,7 @@ package body System.Task_Primitives.Operations is
|
|||
function RT_Resolution return Duration is
|
||||
TS : aliased timespec;
|
||||
Result : int;
|
||||
|
||||
begin
|
||||
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
|
|
@ -1076,8 +1076,10 @@ package body System.Task_Primitives.Operations is
|
|||
-------------------
|
||||
|
||||
function RT_Resolution return Duration is
|
||||
Ticks_Per_Second : aliased LARGE_INTEGER;
|
||||
begin
|
||||
return 0.000_001; -- 1 micro-second
|
||||
QueryPerformanceFrequency (Ticks_Per_Second'Access);
|
||||
return Duration (1.0 / Ticks_Per_Second);
|
||||
end RT_Resolution;
|
||||
|
||||
----------------
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
@ -743,8 +743,13 @@ package body System.Task_Primitives.Operations is
|
|||
-------------------
|
||||
|
||||
function RT_Resolution return Duration is
|
||||
TS : aliased timespec;
|
||||
Result : Interfaces.C.int;
|
||||
begin
|
||||
return 10#1.0#E-6;
|
||||
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
||||
return To_Duration (TS);
|
||||
end RT_Resolution;
|
||||
|
||||
------------
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
@ -785,8 +785,13 @@ package body System.Task_Primitives.Operations is
|
|||
-------------------
|
||||
|
||||
function RT_Resolution return Duration is
|
||||
TS : aliased timespec;
|
||||
Result : Interfaces.C.int;
|
||||
begin
|
||||
return 10#1.0#E-6;
|
||||
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
||||
return To_Duration (TS);
|
||||
end RT_Resolution;
|
||||
|
||||
-----------
|
||||
|
|
|
@ -989,7 +989,7 @@ package body System.Tasking.Stages is
|
|||
return;
|
||||
end if;
|
||||
|
||||
Initialization.Defer_Abort (Self_ID);
|
||||
Initialization.Defer_Abort_Nestable (Self_ID);
|
||||
|
||||
-- Loop through the From chain, changing their Master_of_Task fields,
|
||||
-- and to find the end of the chain.
|
||||
|
@ -1009,7 +1009,7 @@ package body System.Tasking.Stages is
|
|||
|
||||
From.all.T_ID := null;
|
||||
|
||||
Initialization.Undefer_Abort (Self_ID);
|
||||
Initialization.Undefer_Abort_Nestable (Self_ID);
|
||||
end Move_Activation_Chain;
|
||||
|
||||
------------------
|
||||
|
@ -2011,9 +2011,9 @@ package body System.Tasking.Stages is
|
|||
(Self_ID.Deferral_Level > 0
|
||||
or else not System.Restrictions.Abort_Allowed);
|
||||
pragma Assert (Self_ID = Self);
|
||||
pragma Assert (Self_ID.Master_Within = Self_ID.Master_of_Task + 1
|
||||
or else
|
||||
Self_ID.Master_Within = Self_ID.Master_of_Task + 2);
|
||||
pragma Assert
|
||||
(Self_ID.Master_Within in
|
||||
Self_ID.Master_of_Task + 1 .. Self_ID.Master_of_Task + 3);
|
||||
pragma Assert (Self_ID.Common.Wait_Count = 0);
|
||||
pragma Assert (Self_ID.Open_Accepts = null);
|
||||
pragma Assert (Self_ID.ATC_Nesting_Level = 1);
|
||||
|
|
|
@ -2094,6 +2094,14 @@ package body Sem_Ch6 is
|
|||
elsif Is_Tagged_Type (Typ) then
|
||||
null;
|
||||
|
||||
-- Use is legal in a thunk generated for an operation
|
||||
-- inherited from a progenitor.
|
||||
|
||||
elsif Is_Thunk (Designator)
|
||||
and then Present (Non_Limited_View (Typ))
|
||||
then
|
||||
null;
|
||||
|
||||
elsif Nkind (Parent (N)) = N_Subprogram_Body
|
||||
or else Nkind_In (Parent (Parent (N)), N_Accept_Statement,
|
||||
N_Entry_Body)
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 2011-2013, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 2011-2014, 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- *
|
||||
|
@ -54,3 +54,35 @@ __gnat_pthread_condattr_setup (void *attr) {
|
|||
}
|
||||
|
||||
#endif
|
||||
|
||||
#if defined (__APPLE__)
|
||||
#include <mach/mach.h>
|
||||
#include <mach/clock.h>
|
||||
#endif
|
||||
|
||||
/* Return the clock ticks per nanosecond for Posix systems lacking the
|
||||
Posix extension function clock_getres, or else 0 nsecs on error. */
|
||||
|
||||
int
|
||||
__gnat_clock_get_res (void)
|
||||
{
|
||||
#if defined (__APPLE__)
|
||||
clock_serv_t clock_port;
|
||||
mach_msg_type_number_t count;
|
||||
int nsecs;
|
||||
int result;
|
||||
|
||||
count = 1;
|
||||
result = host_get_clock_service
|
||||
(mach_host_self (), SYSTEM_CLOCK, &clock_port);
|
||||
|
||||
if (result == KERN_SUCCESS)
|
||||
result = clock_get_attributes (clock_port, CLOCK_GET_TIME_RES,
|
||||
(clock_attr_t) &nsecs, &count);
|
||||
|
||||
if (result == KERN_SUCCESS)
|
||||
return nsecs;
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue