===================================================================
@@ -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;
===================================================================
@@ -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);
===================================================================
@@ -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);
===================================================================
@@ -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 --
-----------------
===================================================================
@@ -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);
===================================================================
@@ -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)
===================================================================
@@ -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 --
-------------
===================================================================
@@ -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;
===================================================================
@@ -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;
----------------
===================================================================
@@ -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;
------------
===================================================================
@@ -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;
-----------
===================================================================
@@ -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;
+}