record per-thread milliseconds

svn: r14224

collects/scribblings/reference/time.scrbl

@@ -72,12 +72,16 @@ Like @scheme[current-milliseconds], but the result never decreases
 (until the machine is turned off).}
 
 
-@defproc[(current-process-milliseconds) exact-integer?]{
+@defproc[(current-process-milliseconds [thread (or/c thread? #f)]) 
+         exact-integer?]{
 
-Returns the amount of processor time in @tech{fixnum} milliseconds
+Returns an amount of processor time in @tech{fixnum} milliseconds
 that has been consumed by the Scheme process on the underlying
 operating system. (Under @|AllUnix|, this includes both user and
-system time.)  The precision of the result is platform-specific, and
+system time.)  If @scheme[thread] is @scheme[#f], the reported time
+is for all Scheme threads, otherwise the result is specific to the
+time while @scheme[thread] ran.
+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.}
 

doc/release-notes/mzscheme/HISTORY.txt

@@ -6,6 +6,7 @@ Add 'not-free-identifier=? syntax property to disable free-identifier=?
 Add prop:rename-transformer and prop:set!-transformer
 Fix scheme/local so that local syntax bindings are visible to later
  local definitions
+Changed current-process-milliseconds to accept a thread argument
 
 Version 4.1.5.2
 Changed expander to detect a reaname transformer and install a

src/mzscheme/include/mzscheme.exp

@@ -562,6 +562,7 @@ scheme_get_seconds
 scheme_get_milliseconds
 scheme_get_inexact_milliseconds
 scheme_get_process_milliseconds
+scheme_get_thread_milliseconds
 scheme_banner
 scheme_version
 scheme_check_proc_arity

src/mzscheme/include/mzscheme3m.exp

@@ -574,6 +574,7 @@ scheme_get_seconds
 scheme_get_milliseconds
 scheme_get_inexact_milliseconds
 scheme_get_process_milliseconds
+scheme_get_thread_milliseconds
 scheme_banner
 scheme_version
 scheme_check_proc_arity

src/mzscheme/include/mzwin.def

@@ -550,6 +550,7 @@ EXPORTS
  scheme_get_milliseconds
  scheme_get_inexact_milliseconds
  scheme_get_process_milliseconds
+ scheme_get_thread_milliseconds
  scheme_banner
  scheme_version
  scheme_check_proc_arity

src/mzscheme/include/mzwin3m.def

@@ -566,6 +566,7 @@ EXPORTS
  scheme_get_milliseconds
  scheme_get_inexact_milliseconds
  scheme_get_process_milliseconds
+ scheme_get_thread_milliseconds
  scheme_banner
  scheme_version
  scheme_check_proc_arity

src/mzscheme/include/scheme.h

@@ -1081,6 +1081,9 @@ typedef struct Scheme_Thread {
   long gmp_tls[6];
   void *gmp_tls_data;
 
+  long accum_process_msec;
+  long current_start_process_msec;
+
   struct Scheme_Thread_Custodian_Hop *mr_hop;
   Scheme_Custodian_Reference *mref;
   Scheme_Object *extra_mrefs; /* More owning custodians */

src/mzscheme/src/fun.c

@@ -447,7 +447,7 @@ scheme_init_fun (Scheme_Env *env)
   scheme_add_global_constant("current-process-milliseconds",
 			     scheme_make_prim_w_arity(current_process_milliseconds,
 						      "current-process-milliseconds",
-						      0, 0),
+						      0, 1),
 			     env);
   scheme_add_global_constant("current-gc-milliseconds",
 			     scheme_make_prim_w_arity(current_gc_milliseconds,
@@ -7986,6 +7986,19 @@ long scheme_get_process_milliseconds(void)
 #endif
 }
 
+long scheme_get_thread_milliseconds(Scheme_Object *thrd)
+{
+  Scheme_Thread *t = thrd ? (Scheme_Thread *)thrd : scheme_current_thread;
+
+  if (t == scheme_current_thread) {
+    long cpm;
+    cpm = scheme_get_process_milliseconds();
+    return t->accum_process_msec + (cpm - t->current_start_process_msec);
+  } else {
+    return t->accum_process_msec;
+  }
+}
+
 #ifdef MZ_XFORM
 END_XFORM_SKIP;
 #endif
@@ -8272,7 +8285,14 @@ static Scheme_Object *current_inexact_milliseconds(int argc, Scheme_Object **arg
 
 static Scheme_Object *current_process_milliseconds(int argc, Scheme_Object **argv)
 {
-  return scheme_make_integer(scheme_get_process_milliseconds());
+  if (!argc || SCHEME_FALSEP(argv[0]))
+    return scheme_make_integer(scheme_get_process_milliseconds());
+  else {
+    if (SCHEME_THREADP(argv[0]))
+      return scheme_make_integer(scheme_get_thread_milliseconds(argv[0]));
+    scheme_wrong_type("current-process-milliseconds", "thread", 0, argc, argv);
+    return NULL;
+  }
 }
 
 static Scheme_Object *current_gc_milliseconds(int argc, Scheme_Object **argv)

src/mzscheme/src/schemef.h

@@ -1071,6 +1071,7 @@ MZ_EXTERN long scheme_get_seconds(void);
 MZ_EXTERN long scheme_get_milliseconds(void);
 MZ_EXTERN double scheme_get_inexact_milliseconds(void);
 MZ_EXTERN long scheme_get_process_milliseconds(void);
+MZ_EXTERN long scheme_get_thread_milliseconds(Scheme_Object *thrd);
 
 MZ_EXTERN char *scheme_banner(void);
 MZ_EXTERN char *scheme_version(void);

src/mzscheme/src/schemex.h

@@ -886,6 +886,7 @@ long (*scheme_get_seconds)(void);
 long (*scheme_get_milliseconds)(void);
 double (*scheme_get_inexact_milliseconds)(void);
 long (*scheme_get_process_milliseconds)(void);
+long (*scheme_get_thread_milliseconds)(Scheme_Object *thrd);
 char *(*scheme_banner)(void);
 char *(*scheme_version)(void);
 int (*scheme_check_proc_arity)(const char *where, int a,

src/mzscheme/src/schemex.inc

@@ -620,6 +620,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_thread_milliseconds = scheme_get_thread_milliseconds;
   scheme_extension_table->scheme_banner = scheme_banner;
   scheme_extension_table->scheme_version = scheme_version;
   scheme_extension_table->scheme_check_proc_arity = scheme_check_proc_arity;

src/mzscheme/src/schemexm.h

@@ -620,6 +620,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_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)
 #define scheme_check_proc_arity (scheme_extension_table->scheme_check_proc_arity)

src/mzscheme/src/thread.c

@@ -2532,6 +2532,12 @@ static void do_swap_thread()
       scheme_takeover_stacks(scheme_current_thread);
     }
 
+    {
+      long cpm;
+      cpm = scheme_get_process_milliseconds();
+      scheme_current_thread->current_start_process_msec = cpm;
+    }
+
     if (scheme_current_thread->return_marks_to) {
       stash_current_marks();
       goto start;
@@ -2539,6 +2545,12 @@ static void do_swap_thread()
   } else {
     Scheme_Thread *new_thread = swap_target;
 
+    {
+      long cpm;
+      cpm = scheme_get_process_milliseconds();
+      scheme_current_thread->accum_process_msec += (cpm - scheme_current_thread->current_start_process_msec);
+    }
+
     swap_target = NULL;
 
     swap_no_setjmp = 0;
@@ -2846,6 +2858,12 @@ static void start_child(Scheme_Thread * volatile child,
       }
     }
 
+    {
+      long cpm;
+      cpm = scheme_get_process_milliseconds();
+      scheme_current_thread->current_start_process_msec = cpm;
+    }
+
     RESETJMP(child);
 
 #if WATCH_FOR_NESTED_SWAPS