Add 'subprocesses mode to current-process-milliseconds

pkgs/racket-pkgs/racket-doc/scribblings/inside/misc.scrbl

@@ -326,7 +326,11 @@ Returns the current ``time'' in milliseconds, just like
 @function[(intptr_t scheme_get_process_milliseconds)]{
 
 Returns the current process ``time'' in milliseconds, just like
-@racket[current-process-milliseconds].}
+@racket[(current-process-milliseconds)].}
+
+@function[(intptr_t scheme_get_process_children_milliseconds)]{
+Returns the current process group ``time'' in milliseconds just like
+@racket[(current-process-milliseconds 'subprocesses)].}
 
 @function[(char* scheme_banner)]{
 

pkgs/racket-pkgs/racket-doc/scribblings/reference/time.scrbl

@@ -99,18 +99,34 @@ Like @racket[current-inexact-milliseconds], but coerced to a
 reasonably long) time on a 32-bit platform.}
 
 
-@defproc[(current-process-milliseconds [thread (or/c thread? #f)]) 
+@defproc[(current-process-milliseconds [scope (or/c #f thread? 'subprocesses) #f]) 
          exact-integer?]{
 
-Returns an amount of processor time in @tech{fixnum} milliseconds
-that has been consumed by the Racket process on the underlying
-operating system. (On @|AllUnix|, this includes both user and
-system time.)  If @racket[thread] is @racket[#f], the reported time
-is for all Racket threads, otherwise the result is specific to the
-time while @racket[thread] ran.
+Returns an amount of processor time in @tech{fixnum} milliseconds that
+has been consumed by on the underlying operating system, including
+both user and system time.
+
+@itemlist[
+
+ @item{If @racket[scope] is @racket[#f], the reported time is for all
+       Racket threads and @tech{places}.}
+
+ @item{If @racket[scope] is a thread, the result is specific to the
+       time while the thread ran, but it may include time for other
+       @tech{places}.}
+
+ @item{If @racket[scope] is @racket['subprocesses], the result is the
+       sum of process times for known-completed subprocesses (see
+       @secref["subprocess"])---and known-completed children of the
+       subprocesses, etc., on @|AllUnix|---across all @tech{places}.}
+
+]
+
 The precision of the result is platform-specific, and
 since the result is a @tech{fixnum}, the value increases only over a
-limited (though reasonably long) time on a 32-bit platform.}
+limited (though reasonably long) time on a 32-bit platform.
+
+@history[#:changed "6.1.1.4" @elem{Added @racket['subprocesses] mode.}]}
 
 
 @defproc[(current-gc-milliseconds) exact-integer?]{

pkgs/racket-pkgs/racket-test/tests/racket/thread.rktl

@@ -1545,6 +1545,12 @@
   (kill-thread t)
   (test #t positive? s))
 
+(test #t integer? (current-process-milliseconds))
+(test #t integer? (current-process-milliseconds #f))
+(test #t integer? (current-process-milliseconds (thread void)))
+(test #t integer? (current-process-milliseconds 'subprocesses))
+(err/rt-test (current-process-milliseconds 'other))
+
 ; --------------------
 
 (report-errs)

racket/src/racket/include/mzwin.def

@@ -613,6 +613,7 @@ EXPORTS
  scheme_get_milliseconds
  scheme_get_inexact_milliseconds
  scheme_get_process_milliseconds
+ scheme_get_process_children_milliseconds
  scheme_get_thread_milliseconds
  scheme_banner
  scheme_version

racket/src/racket/include/mzwin3m.def

@@ -629,6 +629,7 @@ EXPORTS
  scheme_get_milliseconds
  scheme_get_inexact_milliseconds
  scheme_get_process_milliseconds
+ scheme_get_process_children_milliseconds
  scheme_get_thread_milliseconds
  scheme_banner
  scheme_version

racket/src/racket/include/racket.exp

@@ -629,6 +629,7 @@ scheme_get_seconds
 scheme_get_milliseconds
 scheme_get_inexact_milliseconds
 scheme_get_process_milliseconds
+scheme_get_process_children_milliseconds
 scheme_get_thread_milliseconds
 scheme_banner
 scheme_version

racket/src/racket/include/racket3m.exp

@@ -636,6 +636,7 @@ scheme_get_seconds
 scheme_get_milliseconds
 scheme_get_inexact_milliseconds
 scheme_get_process_milliseconds
+scheme_get_process_children_milliseconds
 scheme_get_thread_milliseconds
 scheme_banner
 scheme_version

racket/src/racket/src/fun.c

@@ -64,6 +64,9 @@
 #   ifdef WINDOWS_GET_PROCESS_TIMES
 #    include <Windows.h>
 #   endif
+#   if !defined(USE_GETRUSAGE) && !defined(WINDOWS_GET_PROCESS_TIMES) && !defined(USER_TIME_IS_CLOCK)
+#    include <sys/times.h>
+#   endif
 #  endif /* USE_PALMTIME */
 # endif /* USE_MACTIME */
 #endif /* TIME_SYNTAX */
@@ -102,6 +105,7 @@ ROSYM static Scheme_Object *transparent_symbol;
 ROSYM static Scheme_Object *transparent_binding_symbol;
 ROSYM static Scheme_Object *opaque_symbol;
 ROSYM static Scheme_Object *none_symbol;
+ROSYM static Scheme_Object *subprocesses_symbol;
 ROSYM static Scheme_Object *is_method_symbol;
 ROSYM static Scheme_Object *cont_key; /* uninterned */
 ROSYM static Scheme_Object *barrier_prompt_key; /* uninterned */
@@ -124,6 +128,10 @@ THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow);
 THREAD_LOCAL_DECL(int scheme_cont_capture_count);
 THREAD_LOCAL_DECL(static int scheme_prompt_capture_count);
 
+#ifdef WINDOWS_GET_PROCESS_TIMES
+SHARED_OK volatile uintptr_t scheme_process_children_msecs;
+#endif
+
 /* locals */
 static Scheme_Object *procedure_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *apply (int argc, Scheme_Object *argv[]);
@@ -652,6 +660,9 @@ scheme_init_fun (Scheme_Env *env)
   opaque_symbol              = scheme_intern_symbol("opaque");
   none_symbol                = scheme_intern_symbol("none");
 
+  REGISTER_SO(subprocesses_symbol);
+  subprocesses_symbol = scheme_intern_symbol("subprocesses");
+
   REGISTER_SO(is_method_symbol);
   REGISTER_SO(cont_key);
   REGISTER_SO(barrier_prompt_key);
@@ -9393,6 +9404,37 @@ intptr_t scheme_get_process_milliseconds(void)
 #endif
 }
 
+intptr_t scheme_get_process_children_milliseconds(void)
+  XFORM_SKIP_PROC
+{
+#ifdef USER_TIME_IS_CLOCK
+  return 0;
+#else
+# ifdef USE_GETRUSAGE
+  struct rusage use;
+  intptr_t s, u;
+  
+  do {
+    if (!getrusage(RUSAGE_CHILDREN, &use))
+      break;
+  } while (errno == EINTR);
+
+  s = use.ru_utime.tv_sec + use.ru_stime.tv_sec;
+  u = use.ru_utime.tv_usec + use.ru_stime.tv_usec;
+
+  return (s * 1000 + u / 1000);
+# else
+#  ifdef WINDOWS_GET_PROCESS_TIMES
+  return (intptr_t)scheme_process_children_msecs;
+#  else
+  clock_t t;
+  times(&t);
+  return (t.tms_cutime + t.tms_cstime) * 1000 / CLK_TCK;
+#  endif
+# endif
+#endif
+}
+
 intptr_t scheme_get_thread_milliseconds(Scheme_Object *thrd)
   XFORM_SKIP_PROC
 {
@@ -9845,10 +9887,12 @@ static Scheme_Object *current_process_milliseconds(int argc, Scheme_Object **arg
 {
   if (!argc || SCHEME_FALSEP(argv[0]))
     return scheme_make_integer(scheme_get_process_milliseconds());
+  else if (SAME_OBJ(argv[0], subprocesses_symbol))
+    return scheme_make_integer(scheme_get_process_children_milliseconds());
   else {
     if (SCHEME_THREADP(argv[0]))
       return scheme_make_integer(scheme_get_thread_milliseconds(argv[0]));
-    scheme_wrong_contract("current-process-milliseconds", "thread?", 0, argc, argv);
+    scheme_wrong_contract("current-process-milliseconds", "(or/c #f thread? 'subprocesses)", 0, argc, argv);
     return NULL;
   }
 }

racket/src/racket/src/port.c

@@ -198,6 +198,9 @@ typedef struct Scheme_Subprocess {
 #if defined(MZ_PLACES_WAITPID)
   short done;
   int status;
+#endif
+#ifdef WINDOWS_GET_PROCESS_TIMES
+  int got_time;
 #endif
   Scheme_Custodian_Reference *mref;
 } Scheme_Subprocess;
@@ -9128,6 +9131,35 @@ static Scheme_Object *redirect_get_or_peek_bytes_k(void)
 
 #if defined(UNIX_PROCESSES) || defined(WINDOWS_PROCESSES)
 
+#if defined(WINDOWS_PROCESSES)
+static void collect_process_time(DWORD w, Scheme_Subprocess *sp)
+{
+  if ((w != STILL_ACTIVE) && !sp->got_time) {
+    FILETIME cr, ex, kr, us;
+    if (GetProcessTimes(sp->handle, &cr, &ex, &kr, &us)) {
+      mzlonglong v;
+      uintptr_t msecs;
+      v = ((((mzlonglong)kr.dwHighDateTime << 32) + kr.dwLowDateTime)
+	   + (((mzlonglong)us.dwHighDateTime << 32) + us.dwLowDateTime));
+      msecs = (uintptr_t)(v / 10000);
+
+#if defined(MZ_USE_PLACES)
+      {
+        int set = 0;
+        while (!set) {
+          uintptr_t old_val = scheme_process_children_msecs;
+          set = mzrt_cas(&scheme_process_children_msecs, old_val, old_val + msecs);
+        }
+      }
+#else
+      scheme_process_children_msecs += msecs;
+#endif
+    }
+    sp->got_time = 1;
+  }
+}
+#endif
+
 static void child_mref_done(Scheme_Subprocess *sp)
 {
   if (sp->mref) {
@@ -9176,9 +9208,10 @@ static int subp_done(Scheme_Object *so)
     HANDLE sci = (HANDLE) ((Scheme_Subprocess *)sp)->handle;
     DWORD w;
     if (sci) {
-      if (GetExitCodeProcess(sci, &w))
-        return w != STILL_ACTIVE;
-      else
+      if (GetExitCodeProcess(sci, &w)) {
+        collect_process_time(w, (Scheme_Subprocess *)sp);
+        return (w != STILL_ACTIVE);
+      } else
         return 1;
     } else
       return 1;
@@ -9236,6 +9269,7 @@ static Scheme_Object *subprocess_status(int argc, Scheme_Object **argv)
     DWORD w;
     if (sp->handle) {
       if (GetExitCodeProcess((HANDLE)sp->handle, &w)) {
+        collect_process_time(w, sp);
 	if (w == STILL_ACTIVE)
 	  going = 1;
 	else
@@ -9362,6 +9396,7 @@ static Scheme_Object *do_subprocess_kill(Scheme_Object *_sp, Scheme_Object *kill
       if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, sp->pid))
         return scheme_void;
     } else if (GetExitCodeProcess((HANDLE)sp->handle, &w)) {
+      collect_process_time(w, sp);
       if (w != STILL_ACTIVE)
         return scheme_void;
       if (TerminateProcess((HANDLE)sp->handle, 1))

racket/src/racket/src/schemef.h

@@ -1191,6 +1191,7 @@ MZ_EXTERN intptr_t scheme_get_seconds(void);
 XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_milliseconds(void);
 XFORM_NONGCING MZ_EXTERN double scheme_get_inexact_milliseconds(void);
 XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_process_milliseconds(void);
+XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_process_children_milliseconds(void);
 XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_thread_milliseconds(Scheme_Object *thrd);
 
 MZ_EXTERN char *scheme_banner(void);

racket/src/racket/src/schemex.h

@@ -975,6 +975,7 @@ intptr_t (*scheme_get_seconds)(void);
 intptr_t (*scheme_get_milliseconds)(void);
 double (*scheme_get_inexact_milliseconds)(void);
 intptr_t (*scheme_get_process_milliseconds)(void);
+intptr_t (*scheme_get_process_children_milliseconds)(void);
 intptr_t (*scheme_get_thread_milliseconds)(Scheme_Object *thrd);
 char *(*scheme_banner)(void);
 char *(*scheme_version)(void);

racket/src/racket/src/schemex.inc

@@ -702,6 +702,7 @@
   scheme_extension_table->scheme_get_milliseconds = scheme_get_milliseconds;
   scheme_extension_table->scheme_get_inexact_milliseconds = scheme_get_inexact_milliseconds;
   scheme_extension_table->scheme_get_process_milliseconds = scheme_get_process_milliseconds;
+  scheme_extension_table->scheme_get_process_children_milliseconds = scheme_get_process_children_milliseconds;
   scheme_extension_table->scheme_get_thread_milliseconds = scheme_get_thread_milliseconds;
   scheme_extension_table->scheme_banner = scheme_banner;
   scheme_extension_table->scheme_version = scheme_version;

racket/src/racket/src/schemexm.h

@@ -702,6 +702,7 @@
 #define scheme_get_milliseconds (scheme_extension_table->scheme_get_milliseconds)
 #define scheme_get_inexact_milliseconds (scheme_extension_table->scheme_get_inexact_milliseconds)
 #define scheme_get_process_milliseconds (scheme_extension_table->scheme_get_process_milliseconds)
+#define scheme_get_process_children_milliseconds (scheme_extension_table->scheme_get_process_children_milliseconds)
 #define scheme_get_thread_milliseconds (scheme_extension_table->scheme_get_thread_milliseconds)
 #define scheme_banner (scheme_extension_table->scheme_banner)
 #define scheme_version (scheme_extension_table->scheme_version)

racket/src/racket/src/schpriv.h

@@ -645,6 +645,9 @@ void scheme_block_child_signals(int block);
 void scheme_check_child_done(void);
 int scheme_extract_child_status(int status);
 #endif
+#ifdef WINDOWS_GET_PROCESS_TIMES
+extern volatile uintptr_t scheme_process_children_msecs;
+#endif
 
 void scheme_prepare_this_thread_for_GC(Scheme_Thread *t);