diff --git a/Changes b/Changes index 795831731abe..e5e0f439ec86 100644 --- a/Changes +++ b/Changes @@ -140,6 +140,10 @@ Working version - #13740: Improve performance of Weak.find_aux (Josh Berdine, review by Gabriel Scherer) +- #?????: Fix caml_win32_clock overflowing if wall-clock time exceeds + 24.8 days. + (Antonin Décimo, review by ???) + ### Other libraries: * #13376: Allow Dynlink.loadfile_private to load bytecode libraries with diff --git a/otherlibs/unix/times_unix.c b/otherlibs/unix/times_unix.c index 025eb33257f4..ef4fdf83fa82 100644 --- a/otherlibs/unix/times_unix.c +++ b/otherlibs/unix/times_unix.c @@ -60,7 +60,8 @@ CAMLprim value caml_unix_times(value unit) value res; struct tms buffer; - times(&buffer); + clock_t ret = times(&buffer); + if (ret == (clock_t) (-1)) caml_uerror("times", Nothing); res = caml_alloc_small(4 * Double_wosize, Double_array_tag); Store_double_flat_field(res, 0, (double) buffer.tms_utime / CLK_TCK); Store_double_flat_field(res, 1, (double) buffer.tms_stime / CLK_TCK); diff --git a/otherlibs/unix/times_win32.c b/otherlibs/unix/times_win32.c index 311d20e7744f..81dc408d31b5 100644 --- a/otherlibs/unix/times_win32.c +++ b/otherlibs/unix/times_win32.c @@ -13,12 +13,11 @@ /* */ /**************************************************************************/ +#define CAML_INTERNALS #include #include #include "caml/unixsupport.h" #include - -#define CAML_INTERNALS #include value caml_unix_times(value unit) { @@ -33,8 +32,8 @@ value caml_unix_times(value unit) { } res = caml_alloc_small(4 * Double_wosize, Double_array_tag); - Store_double_flat_field(res, 0, (double)(utime.ul / 1e7)); - Store_double_flat_field(res, 1, (double)(stime.ul / 1e7)); + Store_double_flat_field(res, 0, (double) utime.ul / (NSEC_PER_SEC / 100)); + Store_double_flat_field(res, 1, (double) stime.ul / (NSEC_PER_SEC / 100)); Store_double_flat_field(res, 2, 0); Store_double_flat_field(res, 3, 0); return res; diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h index 5dd42bbd8b3b..91c29321647a 100644 --- a/runtime/caml/osdeps.h +++ b/runtime/caml/osdeps.h @@ -133,6 +133,7 @@ CAMLextern int caml_win32_isatty(int fd); CAMLextern void caml_expand_command_line (int *, wchar_t ***); CAMLextern clock_t caml_win32_clock(void); +CAMLextern uint64_t caml_win32_clock_100nsec(void); CAMLextern value caml_win32_xdg_defaults(void); diff --git a/runtime/sys.c b/runtime/sys.c index 9ad5bc6acb32..3d7db5506c8b 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -543,7 +543,7 @@ CAMLprim value caml_sys_system_command(value command) double caml_sys_time_include_children_unboxed(value include_children) { -#ifdef HAS_GETRUSAGE +#if defined(HAS_GETRUSAGE) struct rusage ru; double sec = 0.; @@ -558,28 +558,31 @@ double caml_sys_time_include_children_unboxed(value include_children) } return sec; -#else - #ifdef HAS_TIMES - #ifndef CLK_TCK - #ifdef HZ - #define CLK_TCK HZ - #else - #define CLK_TCK 60 - #endif +#elif defined(HAS_TIMES) + #ifndef CLK_TCK + #ifdef HZ + #define CLK_TCK HZ + #else + #define CLK_TCK 60 #endif - struct tms t; - clock_t acc = 0; - times(&t); - acc += t.tms_utime + t.tms_stime; - if (Bool_val(include_children)) { - acc += t.tms_cutime + t.tms_cstime; - } - return (double)acc / CLK_TCK; - #else - /* clock() is standard ANSI C. We have no way of getting - subprocess times in this branch. */ - return (double)clock_os() / CLOCKS_PER_SEC; #endif + struct tms t; + clock_t ticks = times(&t); + if (ticks == (clock_t) (-1)) return -1.; + ticks = t.tms_utime + t.tms_stime; + if (Bool_val(include_children)) { + ticks += t.tms_cutime + t.tms_cstime; + } + return (double) ticks / CLK_TCK; +#elif defined(_WIN32) + /* We have no way of getting subprocess times in this branch. */ + uint64_t t = caml_win32_clock_100nsec(); + return t == UINT64_MAX ? -1. : (double) t / (NSEC_PER_SEC / 100); +#else + /* clock() is standard ANSI C. We have no way of getting subprocess + times in this branch. */ + clock_t ticks = clock_os(); + return ticks == (clock_t) (-1) ? -1. : (double) ticks / CLOCKS_PER_SEC; #endif } diff --git a/runtime/win32.c b/runtime/win32.c index 1ead90d3d5d3..24bf4915c473 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -1135,16 +1135,30 @@ CAMLexport clock_t caml_win32_clock(void) { FILETIME _creation, _exit; CAML_ULONGLONG_FILETIME stime, utime; - ULONGLONG clocks_per_sec; if (!(GetProcessTimes(GetCurrentProcess(), &_creation, &_exit, &stime.ft, &utime.ft))) { - return (clock_t)(-1); + return (clock_t) (-1); } /* total in 100-nanosecond intervals (1e7 / CLOCKS_PER_SEC) */ - clocks_per_sec = 10000000ULL / (ULONGLONG)CLOCKS_PER_SEC; - return (clock_t)((stime.ul + utime.ul) / clocks_per_sec); + uint64_t ticks = + (stime.ul + utime.ul) / (NSEC_PER_SEC / 100 / CLOCKS_PER_SEC); + return ticks >= LONG_MAX ? (clock_t) (-1) : (clock_t) ticks; +} + +CAMLexport uint64_t caml_win32_clock_100nsec(void) +{ + FILETIME _creation, _exit; + CAML_ULONGLONG_FILETIME stime, utime; + + if (!(GetProcessTimes(GetCurrentProcess(), &_creation, &_exit, + &stime.ft, &utime.ft))) { + return UINT64_MAX; + } + + /* total in 100-nanosecond intervals */ + return stime.ul + utime.ul; } static double clock_period_nsec = 0;