From d9504ba9f92205956e0b4aa1fa79e44b10a9d68d Mon Sep 17 00:00:00 2001 From: das Date: Mon, 21 Aug 2006 01:08:41 +0000 Subject: * generic/tclClock.c (ClockClicksObjCmd): add support for Darwin * generic/tclCmdMZ.c (Tcl_TimeObjCmd): nanosecond resolution timer * generic/tclInt.h: to [clock clicks] and [time] * unix/configure.in (Darwin): when TCL_WIDE_CLICKS defined. * unix/tclUnixTime.c (TclpGetWideClicks, TclpWideClicksToNanoseconds): * unix/configure: autoconf-2.59 * unix/tclConfig.h.in: autoheader-2.59 --- generic/tclClock.c | 9 +++-- generic/tclCmdMZ.c | 22 ++++++++++--- generic/tclInt.h | 6 +++- unix/configure | 5 +++ unix/configure.in | 4 ++- unix/tclConfig.h.in | 3 ++ unix/tclUnixTime.c | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 7 files changed, 133 insertions(+), 10 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1abd1e1..35bae5b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclClock.c,v 1.56 2006/08/10 13:07:43 dkf Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.57 2006/08/21 01:08:41 das Exp $ */ #include "tclInt.h" @@ -1689,7 +1689,12 @@ ClockClicksObjCmd( break; case CLICKS_NATIVE: Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) - TclpGetClicks())); +#ifndef TCL_WIDE_CLICKS + TclpGetClicks() +#else + TclpGetWideClicks() +#endif + )); break; case CLICKS_MICROS: Tcl_GetTime(&now); diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d955691..a77431c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.134 2005/12/19 19:03:16 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.135 2006/08/21 01:08:41 das Exp $ */ #include "tclInt.h" @@ -2921,7 +2921,11 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) register int i, result; int count; double totalMicroSec; +#ifndef TCL_WIDE_CLICKS Tcl_Time start, stop; +#else + Tcl_WideInt start, stop; +#endif if (objc == 2) { count = 1; @@ -2937,17 +2941,25 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) objPtr = objv[1]; i = count; +#ifndef TCL_WIDE_CLICKS Tcl_GetTime(&start); +#else + start = TclpGetWideClicks(); +#endif while (i-- > 0) { result = Tcl_EvalObjEx(interp, objPtr, 0); if (result != TCL_OK) { return result; } } +#ifndef TCL_WIDE_CLICKS Tcl_GetTime(&stop); - - totalMicroSec = (((double) (stop.sec - start.sec))*1.0e6 - + (stop.usec - start.usec)); + totalMicroSec = ((double) (stop.sec - start.sec))*1.0e6 + + (stop.usec - start.usec); +#else + stop = TclpGetWideClicks(); + totalMicroSec = ((double) TclpWideClicksToNanoseconds(stop - start))/1.0e3; +#endif if (count <= 1) { /* @@ -2961,7 +2973,7 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) /* * Construct the result as a list because many programs have always parsed - * at such (extracting the first element, typically). + * as such (extracting the first element, typically). */ objs[1] = Tcl_NewStringObj("microseconds", -1); diff --git a/generic/tclInt.h b/generic/tclInt.h index ecc7615..0f34ea5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.274 2006/07/21 14:56:14 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.275 2006/08/21 01:08:41 das Exp $ */ #ifndef _TCLINT @@ -2232,6 +2232,10 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclpFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +#ifdef TCL_WIDE_CLICKS +MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); +MODULE_SCOPE Tcl_WideInt TclpWideClicksToNanoseconds(Tcl_WideInt clicks); +#endif /* *---------------------------------------------------------------- diff --git a/unix/configure b/unix/configure index 6ae76a6..65ff57e 100755 --- a/unix/configure +++ b/unix/configure @@ -14564,6 +14564,11 @@ cat >>confdefs.h <<\_ACEOF _ACEOF +cat >>confdefs.h <<\_ACEOF +#define TCL_WIDE_CLICKS 1 +_ACEOF + + for ac_header in AvailabilityMacros.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` diff --git a/unix/configure.in b/unix/configure.in index 3ffccf3..6c3ff2a 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.143 2006/07/20 06:18:38 das Exp $ +# RCS: @(#) $Id: configure.in,v 1.144 2006/08/21 01:08:42 das Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) @@ -438,6 +438,8 @@ if test "`uname -s`" = "Darwin" ; then [Are we to override what our default encoding is?]) AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1, [Can this platform load code from memory?]) + AC_DEFINE(TCL_WIDE_CLICKS, 1, + [Does this platform have wide high-resolution clicks?]) AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index b61ddfb..501c83f 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -316,6 +316,9 @@ /* Do we allow unloading of shared libraries? */ #undef TCL_UNLOAD_DLLS +/* Does this platform have wide high-resolution clicks? */ +#undef TCL_WIDE_CLICKS + /* Are wide integers to be implemented with C 'long's? */ #undef TCL_WIDE_INT_IS_LONG diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 12ba965..09003a7 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -9,11 +9,15 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixTime.c,v 1.26 2005/11/02 23:26:50 dkf Exp $ + * RCS: @(#) $Id: tclUnixTime.c,v 1.27 2006/08/21 01:08:42 das Exp $ */ #include "tclInt.h" #include +#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) +#include +#endif + #define TM_YEAR_BASE 1900 #define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0)) @@ -129,6 +133,94 @@ TclpGetClicks(void) return now; } +#ifdef TCL_WIDE_CLICKS + +/* + *----------------------------------------------------------------------------- + * + * TclpGetWideClicks -- + * + * This procedure returns a WideInt value that represents the highest + * resolution clock available on the system. There are no garantees on + * what the resolution will be. In Tcl we will call this value a "click". + * The start time is also system dependant. + * + * Results: + * Number of WideInt clicks from some start time. + * + * Side effects: + * None. + * + *----------------------------------------------------------------------------- + */ + +Tcl_WideInt +TclpGetWideClicks(void) +{ + Tcl_WideInt now; + + if (tclGetTimeProcPtr != NativeGetTime) { + Tcl_Time time; + + (*tclGetTimeProcPtr) (&time, tclTimeClientData); + now = (Tcl_WideInt) (time.sec*1000000 + time.usec); + } else { +#ifdef MAC_OSX_TCL + now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX); +#else +#error Wide high-resolution clicks not implemented on this platform +#endif + } + + return now; +} + +/* + *----------------------------------------------------------------------------- + * + * TclpWideClicksToNanoseconds -- + * + * This procedure converts click values from the TclpGetWideClicks native + * resolution to nanosecond resolution. + * + * Results: + * Number of nanoseconds from some start time. + * + * Side effects: + * None. + * + *----------------------------------------------------------------------------- + */ + +Tcl_WideInt +TclpWideClicksToNanoseconds(Tcl_WideInt clicks) +{ + Tcl_WideInt nsec; + + if (tclGetTimeProcPtr != NativeGetTime) { + nsec = clicks * 1000; + } else { +#ifdef MAC_OSX_TCL + static mach_timebase_info_data_t tb; + static uint64_t maxClicksForUInt64; + + if (!tb.denom) { + mach_timebase_info(&tb); + maxClicksForUInt64 = UINT64_MAX / tb.numer; + } + if ((uint64_t) clicks < maxClicksForUInt64) { + nsec = (Tcl_WideInt) ((uint64_t) clicks * tb.numer / tb.denom); + } else { + nsec = (Tcl_WideInt) ((long double) clicks * tb.numer / tb.denom); + } +#else +#error Wide high-resolution clicks not implemented on this platform +#endif + } + + return nsec; +} +#endif /* TCL_WIDE_CLICKS */ /* *---------------------------------------------------------------------- -- cgit v0.12