From 5b85391873109227e93f052b95e05c64b69510be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 17 Jan 2025 15:37:00 +0100 Subject: [PATCH 1/4] Fix caml_win32_clock overflowing if wall-clock exceeds 24.8 days From the docs: https://learn.microsoft.com/en-us/cpp/c-runtime-library/reference/clock?view=msvc-170 > Given enough time, the value returned by `clock` can exceed the > maximum positive value of `clock_t`. When the process has run > longer, the value returned by `clock` is always `(clock_t)(-1)`, as > specified by the ISO C99 standard (7.23.2.1) and ISO C11 > standard (7.27.2.1). Microsoft implements `clock_t` as a `long`, a > signed 32-bit integer, and the `CLOCKS_PER_SEC` macro is defined as > 1000. This macro gives a maximum `clock` function return value of > 2147483.647 seconds, or about 24.8 days. Don't rely on the value > returned by `clock` in processes that have run for longer than this > amount of time. --- Changes | 4 ++++ runtime/win32.c | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) 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/runtime/win32.c b/runtime/win32.c index 1ead90d3d5d3..333f7f559b75 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -1135,16 +1135,16 @@ 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; } static double clock_period_nsec = 0; From 5fe35da4ead4721bed2a289a6ad005e59ff411b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 24 Jan 2025 13:08:28 +0100 Subject: [PATCH 2/4] Minor refactor of caml_sys_time_include_children_unboxed and others --- otherlibs/unix/times_win32.c | 7 +++---- runtime/sys.c | 40 +++++++++++++++++------------------- 2 files changed, 22 insertions(+), 25 deletions(-) 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/sys.c b/runtime/sys.c index 9ad5bc6acb32..9f590409a184 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,26 @@ 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 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 } From a1e11ea14ea894c0d0dd0422ef9b92d4d0a122cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 23 Jan 2025 09:47:08 +0100 Subject: [PATCH 3/4] Check success of clock and times for Sys.times and Unix.times Sys.times now returns -1 if POSIX clock or times fail on overflow. Unix.times now raises on Unix (it would raise only on Windows). times: https://pubs.opengroup.org/onlinepubs/9799919799/functions/times.html clock: https://pubs.opengroup.org/onlinepubs/9799919799/functions/clock.html --- otherlibs/unix/times_unix.c | 3 ++- runtime/sys.c | 13 +++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) 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/runtime/sys.c b/runtime/sys.c index 9f590409a184..0e8fe71b9350 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -567,17 +567,18 @@ double caml_sys_time_include_children_unboxed(value include_children) #endif #endif struct tms t; - clock_t acc = 0; - times(&t); - acc += t.tms_utime + t.tms_stime; + clock_t ticks = times(&t); + if (ticks == (clock_t) (-1)) return -1.; + ticks = t.tms_utime + t.tms_stime; if (Bool_val(include_children)) { - acc += t.tms_cutime + t.tms_cstime; + ticks += t.tms_cutime + t.tms_cstime; } - return (double)acc / CLK_TCK; + return (double) ticks / 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; + clock_t ticks = clock_os(); + return ticks == (clock_t) (-1) ? -1. : (double) ticks / CLOCKS_PER_SEC; #endif } From 5d3a42580f37b9697024f9928c8d3d678425db8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Thu, 23 Jan 2025 11:21:09 +0100 Subject: [PATCH 4/4] Add a long-running wall-clock for Windows caml_win32_clock can only run for 24.8 days before overflowing. If we use a uint64_t accounting for 100-nsec intervals, and convert to double (where the maximum integer value is 2**53), the function will report accurate running times for over 28 years. --- runtime/caml/osdeps.h | 1 + runtime/sys.c | 8 ++++++-- runtime/win32.c | 14 ++++++++++++++ 3 files changed, 21 insertions(+), 2 deletions(-) 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 0e8fe71b9350..3d7db5506c8b 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -574,9 +574,13 @@ double caml_sys_time_include_children_unboxed(value 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() 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 333f7f559b75..24bf4915c473 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -1147,6 +1147,20 @@ CAMLexport clock_t caml_win32_clock(void) 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; void caml_init_os_params(void)