* [Ada] Implement RT_Resolution properly
@ 2015-01-07 10:23 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2015-01-07 10:23 UTC (permalink / raw)
To: gcc-patches; +Cc: Douglas B. Rupp
[-- Attachment #1: Type: text/plain, Size: 1098 bytes --]
Previously RT_Resolution was returning a hard coded dummy value.
With this change we now use the relevant system call to compute the
clock resolution.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 7429 bytes --]
Index: s-linux-android.ads
===================================================================
--- s-linux-android.ads (revision 219191)
+++ s-linux-android.ads (working copy)
@@ -47,6 +47,7 @@
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;
Index: s-osinte-aix.ads
===================================================================
--- s-osinte-aix.ads (revision 219191)
+++ s-osinte-aix.ads (working copy)
@@ -206,6 +206,11 @@
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);
Index: s-osinte-android.ads
===================================================================
--- s-osinte-android.ads (revision 219191)
+++ s-osinte-android.ads (working copy)
@@ -211,6 +211,11 @@
(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);
Index: s-osinte-darwin.adb
===================================================================
--- s-osinte-darwin.adb (revision 219191)
+++ s-osinte-darwin.adb (working copy)
@@ -129,6 +129,36 @@
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 --
-----------------
Index: s-osinte-darwin.ads
===================================================================
--- s-osinte-darwin.ads (revision 219191)
+++ s-osinte-darwin.ads (working copy)
@@ -189,6 +189,10 @@
(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);
Index: s-osinte-freebsd.ads
===================================================================
--- s-osinte-freebsd.ads (revision 219191)
+++ s-osinte-freebsd.ads (working copy)
@@ -202,6 +202,11 @@
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)
Index: s-osinte-mingw.ads
===================================================================
--- s-osinte-mingw.ads (revision 219191)
+++ s-osinte-mingw.ads (working copy)
@@ -53,6 +53,8 @@
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 @@
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 --
-------------
Index: s-osinte-solaris-posix.ads
===================================================================
--- s-osinte-solaris-posix.ads (revision 219191)
+++ s-osinte-solaris-posix.ads (working copy)
@@ -189,6 +189,11 @@
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;
Index: s-taprop-mingw.adb
===================================================================
--- s-taprop-mingw.adb (revision 219191)
+++ s-taprop-mingw.adb (working copy)
@@ -1076,8 +1076,10 @@
-------------------
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;
----------------
Index: s-taprop-posix.adb
===================================================================
--- s-taprop-posix.adb (revision 219191)
+++ s-taprop-posix.adb (working copy)
@@ -743,8 +743,13 @@
-------------------
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;
------------
Index: s-taprop-solaris.adb
===================================================================
--- s-taprop-solaris.adb (revision 219191)
+++ s-taprop-solaris.adb (working copy)
@@ -785,8 +785,13 @@
-------------------
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;
-----------
Index: thread.c
===================================================================
--- thread.c (revision 219191)
+++ thread.c (working copy)
@@ -54,3 +54,35 @@
}
#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;
+}
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2015-01-07 10:23 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-01-07 10:23 [Ada] Implement RT_Resolution properly Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).