From 5d3d5a890a91d3adeb2f6c18ef9dda732740ac14 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 23 Mar 2009 01:26:51 +0000 Subject: [PATCH] record per-thread milliseconds svn: r14224 --- collects/scribblings/reference/time.scrbl | 10 +++++++--- doc/release-notes/mzscheme/HISTORY.txt | 1 + src/mzscheme/include/mzscheme.exp | 1 + src/mzscheme/include/mzscheme3m.exp | 1 + src/mzscheme/include/mzwin.def | 1 + src/mzscheme/include/mzwin3m.def | 1 + src/mzscheme/include/scheme.h | 3 +++ src/mzscheme/src/fun.c | 24 +++++++++++++++++++++-- src/mzscheme/src/schemef.h | 1 + src/mzscheme/src/schemex.h | 1 + src/mzscheme/src/schemex.inc | 1 + src/mzscheme/src/schemexm.h | 1 + src/mzscheme/src/thread.c | 18 +++++++++++++++++ 13 files changed, 59 insertions(+), 5 deletions(-) diff --git a/collects/scribblings/reference/time.scrbl b/collects/scribblings/reference/time.scrbl index ca72c8637b..2c28abea77 100644 --- a/collects/scribblings/reference/time.scrbl +++ b/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.} diff --git a/doc/release-notes/mzscheme/HISTORY.txt b/doc/release-notes/mzscheme/HISTORY.txt index ea3c16984c..6713c0f407 100644 --- a/doc/release-notes/mzscheme/HISTORY.txt +++ b/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 diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index ac24cae8e5..7c3ff49e19 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/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 diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index ac6876fdc3..8a0104b167 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/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 diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index e52df5313c..63c7fbd1a0 100644 --- a/src/mzscheme/include/mzwin.def +++ b/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 diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 9e2f1bd4ef..c85242740b 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/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 diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index 41b06f0eee..57fdb5866a 100644 --- a/src/mzscheme/include/scheme.h +++ b/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 */ diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index a768c6c5a4..74810fb41d 100644 --- a/src/mzscheme/src/fun.c +++ b/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) diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 0a52678a7e..6856587fc4 100644 --- a/src/mzscheme/src/schemef.h +++ b/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); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index 6a3224ac99..dfaec8a86b 100644 --- a/src/mzscheme/src/schemex.h +++ b/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, diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 0753e7a6eb..a1eb923619 100644 --- a/src/mzscheme/src/schemex.inc +++ b/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; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index fec4281b78..bb7e3dd2eb 100644 --- a/src/mzscheme/src/schemexm.h +++ b/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) diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 0561f29992..dde50e7cf7 100644 --- a/src/mzscheme/src/thread.c +++ b/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