diff options
-rw-r--r-- | generic/tcl.h | 3 | ||||
-rw-r--r-- | generic/tclCompile.h | 31 | ||||
-rw-r--r-- | generic/tclEvent.c | 3 | ||||
-rw-r--r-- | generic/tclExecute.c | 59 | ||||
-rw-r--r-- | generic/tclInt.h | 12 | ||||
-rw-r--r-- | generic/tclOOCall.c | 43 | ||||
-rw-r--r-- | generic/tclStringObj.c | 4 | ||||
-rw-r--r-- | generic/tclUtf.c | 17 | ||||
-rwxr-xr-x | library/clock.tcl | 248 | ||||
-rw-r--r-- | tools/cgannotate.tcl | 24 | ||||
-rw-r--r-- | tools/microoptimization/clockformatscan.tcl | 5 | ||||
-rw-r--r-- | tools/microoptimization/generalbytecode.tcl | 13 | ||||
-rw-r--r-- | tools/microoptimization/oocreate.tcl | 13 | ||||
-rw-r--r-- | tools/microoptimization/oodispatch.tcl | 11 | ||||
-rw-r--r-- | unix/tclUnixThrd.c | 27 | ||||
-rw-r--r-- | win/tclWinThrd.c | 33 |
16 files changed, 395 insertions, 151 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index a08edde..d778e19 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -144,6 +144,7 @@ extern "C" { #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) +# define TCL_NOINLINE __attribute__ ((noinline)) # if defined(BUILD_tcl) || defined(BUILD_tk) # define TCL_NORETURN1 __attribute__ ((noreturn)) # else @@ -153,8 +154,10 @@ extern "C" { # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) # define TCL_NORETURN _declspec(noreturn) +# define TCL_NOINLINE __declspec(noinline) # else # define TCL_NORETURN /* nothing */ +# define TCL_NOINLINE /* nothing */ # endif # define TCL_NORETURN1 /* nothing */ #endif diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0a34e34..eba506a 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1401,6 +1401,37 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, (*((p)+3))) /* + * Override TclGetUInt4AtPtr or TclGetInt4AtPtr macros if + * a known better version exists. + */ +#ifdef WORDS_BIGENDIAN +#define OVERRIDE_INT4(i) (i) +#elif defined(__GNUC__) && (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 3)) +#define OVERRIDE_INT4(i) __builtin_bswap32(i) +#elif defined(_MSC_VER) && _MSC_VER>=1300 +#define OVERRIDE_INT4(i) _byteswap_ulong(i) +#endif + +#ifdef OVERRIDE_INT4 +#undef TclGetUInt4AtPtr +static inline unsigned int +TclGetUInt4AtPtr(const unsigned char *p) +{ + uint32_t i; + memcpy(&i,p,4); + return OVERRIDE_INT4(i); +} +#undef TclGetInt4AtPtr +static inline signed int +TclGetInt4AtPtr(const unsigned char *p) +{ + int32_t i; + memcpy(&i,p,4); + return OVERRIDE_INT4(i); +} +#endif /* OVERRIDE_INT4 */ + +/* * Macros used to compute the minimum and maximum of two integers. The ANSI C * "prototypes" for these macros are: * diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 8305410..d62850b 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1043,6 +1043,9 @@ TclInitSubsystems(void) #if USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ #endif +#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) + TclpInitThreadAlloc(); +#endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* Process wide mutex init */ #endif diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c5e267d..6f0b103 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -34,14 +34,14 @@ #endif /* - * A mask (should be 2**n-1) that is used to work out when the bytecode engine - * should call Tcl_AsyncReady() to see whether there is a signal that needs - * handling. + * A counter that is used to work out when the bytecode engine should call + * Tcl_AsyncReady() to see whether there is a signal that needs handling, and + * other expensive periodic operations. */ -#ifndef ASYNC_CHECK_COUNT_MASK -# define ASYNC_CHECK_COUNT_MASK 63 -#endif /* !ASYNC_CHECK_COUNT_MASK */ +#ifndef ASYNC_CHECK_COUNT +# define ASYNC_CHECK_COUNT 64 +#endif /* !ASYNC_CHECK_COUNT */ /* * Boolean flag indicating whether the Tcl bytecode interpreter has been @@ -2131,8 +2131,14 @@ TEBCresume( * sporadically: no special need for speed. */ - int instructionCount = 0; /* Counter that is used to work out when to - * call Tcl_AsyncReady() */ + unsigned interruptCounter = 1; + /* Counter that is used to work out when to + * call Tcl_AsyncReady(). This must be 1 + * initially so that we call the async-check + * stanza early, otherwise there are command + * sequences that can make the interpreter + * busy-loop without an opportunity to + * recognise an interrupt. */ const char *curInstName; #ifdef TCL_COMPILE_DEBUG int traceInstructions; /* Whether we are doing instruction-level @@ -2331,10 +2337,11 @@ TEBCresume( /* * Check for asynchronous handlers [Bug 746722]; we do the check every - * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1). + * ASYNC_CHECK_COUNT instructions. */ - if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) { + if ((--interruptCounter) == 0) { + interruptCounter = ASYNC_CHECK_COUNT; DECACHE_STACK_INFO(); if (TclAsyncReady(iPtr)) { result = Tcl_AsyncInvoke(interp, result); @@ -3164,20 +3171,28 @@ TEBCresume( case INST_LOAD_SCALAR1: instLoadScalar1: + /* + * micro-optimization by drh: eliminate a compare-and-jump on the + * hottest path (no var link), at the cost of adding a few comparisons + * in the less frequent cases (var links: upvar, global, + * variable). We used to follow links first (causing a C&J in the + * non-link case), now we check for direct-readability first + */ + opnd = TclGetUInt1AtPtr(pc+1); varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - TRACE(("%u => ", opnd)); - if (TclIsVarDirectReadable(varPtr)) { - /* - * No errors, no traces: just get the value. - */ - - objResultPtr = varPtr->value.objPtr; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(2, 0, 1); + while (1) { + if (TclIsVarDirectReadable(varPtr)) { + TRACE(("%u => ", opnd)); + objResultPtr = varPtr->value.objPtr; + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(2, 0, 1); + } + if (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + continue; + } + break; } pcAdjustment = 2; cleanup = 0; diff --git a/generic/tclInt.h b/generic/tclInt.h index fd03155..c9b85b2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3123,6 +3123,7 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); +MODULE_SCOPE int TclUtfCount(Tcl_UniChar ch); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, @@ -3136,6 +3137,9 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); +#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) +MODULE_SCOPE void TclpInitThreadAlloc(void); +#endif MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS @@ -4617,7 +4621,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; # ifdef NO_ISNAN # define TclIsNaN(d) ((d) != (d)) # else -# define TclIsNaN(d) (isnan(d)) +/* + * This is called a lot for double-using code and isnan() is a noticable + * slowdown, so we stay with the comparison operation here. It should only + * make a difference for signalling NaN and those should not happen anyway. + */ +# define TclIsNaN(d) ((d) != (d)) +/*# define TclIsNaN(d) (isnan(d))*/ # endif #endif diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index facf90d..fa16a6e 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -726,6 +726,14 @@ AddSimpleChainToCallContext( * ---------------------------------------------------------------------- */ +static TCL_NOINLINE void +AddMethodToCallChainCore( + Method *const mPtr, + struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters, + Class *const filterDecl, + int flags); + static inline void AddMethodToCallChain( Method *const mPtr, /* Actual method implementation to add to call @@ -748,20 +756,43 @@ AddMethodToCallChain( * looking to add things from a mixin and have * not passed a mixin. */ { - register CallChain *callPtr = cbPtr->callChainPtr; - int i; - /* - * Return if this is just an entry used to record whether this is a public + * Check if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to * the call chain. * * This is also where we enforce mixin-consistency. */ - if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) { - return; + if (mPtr && mPtr->typePtr && MIXIN_CONSISTENT(flags)) { + AddMethodToCallChainCore(mPtr, cbPtr, doneFilters, filterDecl, flags); } +} + +static TCL_NOINLINE void +AddMethodToCallChainCore( + Method *const mPtr, /* Actual method implementation to add to call + * chain (or NULL, a no-op). */ + struct ChainBuilder *const cbPtr, + /* The call chain to add the method + * implementation to. */ + Tcl_HashTable *const doneFilters, + /* Where to record what filters have been + * processed. If NULL, not processing filters. + * Note that this function does not update + * this hashtable. */ + Class *const filterDecl, /* The class that declared the filter. If + * NULL, either the filter was declared by the + * object or this isn't a filter. */ + int flags) /* Used to check if we're mixin-consistent + * only. Mixin-consistent means that either + * we're looking to add things from a mixin + * and we have passed a mixin, or we're not + * looking to add things from a mixin and have + * not passed a mixin. */ +{ + register CallChain *callPtr = cbPtr->callChainPtr; + int i; /* * Enforce real private method handling here. We will skip adding this diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 8d70d20..1974079 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3097,7 +3097,7 @@ ExtendStringRepWithUnicode( */ int i, origLength, size = 0; - char *dst, buf[TCL_UTF_MAX]; + char *dst; String *stringPtr = GET_STRING(objPtr); if (numChars < 0) { @@ -3123,7 +3123,7 @@ ExtendStringRepWithUnicode( } for (i = 0; i < numChars && size >= 0; i++) { - size += Tcl_UniCharToUtf((int) unicode[i], buf); + size += TclUtfCount(unicode[i]); } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); diff --git a/generic/tclUtf.c b/generic/tclUtf.c index b878149..f585c03 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -89,12 +89,11 @@ static const unsigned char totalBytes[256] = { * Functions used only in this module. */ -static int UtfCount(int ch); /* *--------------------------------------------------------------------------- * - * UtfCount -- + * TclUtfCount -- * * Find the number of bytes in the Utf character "ch". * @@ -107,9 +106,9 @@ static int UtfCount(int ch); *--------------------------------------------------------------------------- */ -INLINE static int -UtfCount( - int ch) /* The Tcl_UniChar whose size is returned. */ +INLINE int +TclUtfCount( + Tcl_UniChar ch) /* The Tcl_UniChar whose size is returned. */ { if ((ch > 0) && (ch < UNICODE_SELF)) { return 1; @@ -829,7 +828,7 @@ Tcl_UtfToUpper( * char to dst if its size is <= the original char. */ - if (bytes < UtfCount(upChar)) { + if (bytes < TclUtfCount(upChar)) { memcpy(dst, src, (size_t) bytes); dst += bytes; } else { @@ -882,7 +881,7 @@ Tcl_UtfToLower( * char to dst if its size is <= the original char. */ - if (bytes < UtfCount(lowChar)) { + if (bytes < TclUtfCount(lowChar)) { memcpy(dst, src, (size_t) bytes); dst += bytes; } else { @@ -932,7 +931,7 @@ Tcl_UtfToTitle( bytes = TclUtfToUniChar(src, &ch); titleChar = Tcl_UniCharToTitle(ch); - if (bytes < UtfCount(titleChar)) { + if (bytes < TclUtfCount(titleChar)) { memcpy(dst, src, (size_t) bytes); dst += bytes; } else { @@ -944,7 +943,7 @@ Tcl_UtfToTitle( bytes = TclUtfToUniChar(src, &ch); lowChar = Tcl_UniCharToLower(ch); - if (bytes < UtfCount(lowChar)) { + if (bytes < TclUtfCount(lowChar)) { memcpy(dst, src, (size_t) bytes); dst += bytes; } else { diff --git a/library/clock.tcl b/library/clock.tcl index 8e4b657..01759dd 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -647,7 +647,7 @@ proc ::tcl::clock::Initialize {} { # that renders the given format } ::tcl::clock::Initialize - + #---------------------------------------------------------------------- # # clock format -- @@ -696,7 +696,7 @@ proc ::tcl::clock::format { args } { return [$procName $clockval $timezone] } - + #---------------------------------------------------------------------- # # ParseClockFormatFormat -- @@ -735,7 +735,7 @@ proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { set didLocaleEra 0 set didLocaleNumerals 0 - set preFormatCode \ + set prefixCode \ [string map [list @GREGORIAN_CHANGE_DATE@ \ [mc GREGORIAN_CHANGE_DATE]] \ { @@ -744,9 +744,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { $TZData($timezone) \ @GREGORIAN_CHANGE_DATE@] }] + set preFormatCode {} set formatString {} set substituents {} set state {} + set fields {} set format [LocalizeFormat $locale $format] @@ -772,8 +774,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list @DAYS_OF_WEEK_ABBREV@ \ [list [mc DAYS_OF_WEEK_ABBREV]]] \ { [lindex @DAYS_OF_WEEK_ABBREV@ \ - [expr {[dict get $date dayOfWeek] \ - % 7}]]}] + [expr {$dayOfWeek % 7}]]}] + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } A { # Day of week, spelt out. append formatString %s @@ -782,8 +786,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list @DAYS_OF_WEEK_FULL@ \ [list [mc DAYS_OF_WEEK_FULL]]] \ { [lindex @DAYS_OF_WEEK_FULL@ \ - [expr {[dict get $date dayOfWeek] \ - % 7}]]}] + [expr {$dayOfWeek % 7}]]}] + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } b - h { # Name of month, abbreviated. append formatString %s @@ -792,7 +798,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list @MONTHS_ABBREV@ \ [list [mc MONTHS_ABBREV]]] \ { [lindex @MONTHS_ABBREV@ \ - [expr {[dict get $date month]-1}]]}] + [expr {$month-1}]]}] + dict set fields month { + set month [dict get $date month] + } } B { # Name of month, spelt out append formatString %s @@ -801,20 +810,31 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list @MONTHS_FULL@ \ [list [mc MONTHS_FULL]]] \ { [lindex @MONTHS_FULL@ \ - [expr {[dict get $date month]-1}]]}] + [expr {$month-1}]]}] + dict set fields month { + set month [dict get $date month] + } } C { # Century number append formatString %02d - append substituents \ - { [expr {[dict get $date year] / 100}]} + append substituents { [expr {$year / 100}]} + dict set fields year { + set year [dict get $date year] + } } d { # Day of month, with leading zero append formatString %02d - append substituents { [dict get $date dayOfMonth]} + append substituents { $dayOfMonth} + dict set fields dayOfMonth { + set dayOfMonth [dict get $date dayOfMonth] + } } e { # Day of month, without leading zero append formatString %2d - append substituents { [dict get $date dayOfMonth]} + append substituents { $dayOfMonth} + dict set fields dayOfMonth { + set dayOfMonth [dict get $date dayOfMonth] + } } E { # Format group in a locale-dependent # alternative era @@ -840,33 +860,45 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { g { # Two-digit year relative to ISO8601 # week number append formatString %02d - append substituents \ - { [expr { [dict get $date iso8601Year] % 100 }]} + append substituents { [expr { $iso8601Year % 100 }]} + dict set fields iso8601Year { + set iso8601Year [dict get $date iso8601Year] + } } G { # Four-digit year relative to ISO8601 # week number append formatString %02d - append substituents { [dict get $date iso8601Year]} + append substituents { $iso8601Year} + dict set fields iso8601Year { + set iso8601Year [dict get $date iso8601Year] + } } H { # Hour in the 24-hour day, leading zero append formatString %02d append substituents \ - { [expr { [dict get $date localSeconds] \ - / 3600 % 24}]} + { [expr { $localSeconds / 3600 % 24}]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } I { # Hour AM/PM, with leading zero append formatString %02d append substituents \ - { [expr { ( ( ( [dict get $date localSeconds] \ - % 86400 ) \ + { [expr { ( ( ($localSeconds % 86400) \ + 86400 \ - 3600 ) \ / 3600 ) \ % 12 + 1 }] } + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } j { # Day of year (001-366) append formatString %03d - append substituents { [dict get $date dayOfYear]} + append substituents { $dayOfYear} + dict set fields dayOfYear { + set dayOfYear [dict get $date dayOfYear] + } } J { # Julian Day Number append formatString %07ld @@ -875,37 +907,47 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { k { # Hour (0-23), no leading zero append formatString %2d append substituents \ - { [expr { [dict get $date localSeconds] - / 3600 - % 24 }]} + { [expr { $localSeconds / 3600 % 24 }]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } l { # Hour (12-11), no leading zero append formatString %2d append substituents \ - { [expr { ( ( ( [dict get $date localSeconds] - % 86400 ) + { [expr { ( ( ( $localSeconds % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1 }]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } m { # Month number, leading zero append formatString %02d - append substituents { [dict get $date month]} + append substituents { $month} + dict set fields month { + set month [dict get $date month] + } } M { # Minute of the hour, leading zero append formatString %02d append substituents \ - { [expr { [dict get $date localSeconds] - / 60 - % 60 }]} + { [expr { $localSeconds / 60 % 60 }]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } n { # A literal newline append formatString \n } N { # Month number, no leading zero append formatString %2d - append substituents { [dict get $date month]} + append substituents { $month} + dict set fields month { + set month [dict get $date month] + } } O { # A format group in the locale's # alternative numerals @@ -924,9 +966,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list set AM [string toupper [mc AM]]] \n \ [list set PM [string toupper [mc PM]]] \n append substituents \ - { [expr {(([dict get $date localSeconds] - % 86400) < 43200) ? + { [expr {(($localSeconds % 86400) < 43200) ? $AM : $PM}]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } P { # Localized 'AM' or 'PM' indicator append formatString %s @@ -934,10 +978,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { [list set am [mc AM]] \n \ [list set pm [mc PM]] \n append substituents \ - { [expr {(([dict get $date localSeconds] - % 86400) < 43200) ? + { [expr {(($localSeconds % 86400) < 43200) ? $am : $pm}]} - + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } Q { # Hi, Jeff! append formatString %s @@ -945,70 +990,95 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { } s { # Seconds from the Posix Epoch append formatString %s - append substituents { [dict get $date seconds]} + append substituents { $seconds} + dict set fields seconds { + set seconds [dict get $date seconds] + } } S { # Second of the minute, with # leading zero append formatString %02d - append substituents \ - { [expr { [dict get $date localSeconds] - % 60 }]} + append substituents { [expr { $localSeconds % 60 }]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } t { # A literal tab character append formatString \t } u { # Day of the week (1-Monday, 7-Sunday) append formatString %1d - append substituents { [dict get $date dayOfWeek]} + append substituents { $dayOfWeek } + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } U { # Week of the year (00-53). The # first Sunday of the year is the # first day of week 01 append formatString %02d append preFormatCode { - set dow [dict get $date dayOfWeek] + set dow $dayOfWeek if { $dow == 7 } { set dow 0 } incr dow set UweekNumber \ - [expr { ( [dict get $date dayOfYear] - - $dow + 7 ) - / 7 }] + [expr { ( $dayOfYear - $dow + 7 ) / 7 }] } append substituents { $UweekNumber} + dict set fields dayOfYear { + set dayOfYear [dict get $date dayOfYear] + } + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } V { # The ISO8601 week number append formatString %02d - append substituents { [dict get $date iso8601Week]} + append substituents { $iso8601Week} + dict set fields iso8601Week { + set iso8601Week [dict get $date iso8601Week] + } } w { # Day of the week (0-Sunday, # 6-Saturday) append formatString %1d append substituents \ - { [expr { [dict get $date dayOfWeek] % 7 }]} + { [expr { $dayOfWeek % 7 }]} + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } W { # Week of the year (00-53). The first # Monday of the year is the first day # of week 01. append preFormatCode { set WweekNumber \ - [expr { ( [dict get $date dayOfYear] - - [dict get $date dayOfWeek] - + 7 ) - / 7 }] + [expr { ($dayOfYear - $dayOfWeek + 7) / 7 }] } append formatString %02d append substituents { $WweekNumber} + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } + dict set fields dayOfMonth { + set dayOfMonth [dict get $date dayOfMonth] + } } y { # The two-digit year of the century append formatString %02d - append substituents \ - { [expr { [dict get $date year] % 100 }]} + append substituents { [expr { $year % 100 }]} + dict set fields year { + set year [dict get $date year] + } } Y { # The four-digit year append formatString %04d - append substituents { [dict get $date year]} + append substituents { $year} + dict set fields year { + set year [dict get $date year] + } } z { # The time zone as hours and minutes # east (+) or west (-) of Greenwich @@ -1018,7 +1088,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { } Z { # The name of the time zone append formatString %s - append substituents { [dict get $date tzName]} + append substituents { $tzName} + dict set fields tzName { + set tzName [dict get $date tzName] + } } % { # A literal percent character append formatString %% @@ -1068,72 +1141,91 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { # numerals append formatString %s append substituents \ - { [lindex $localeNumerals \ - [dict get $date dayOfMonth]]} + { [lindex $localeNumerals $dayOfMonth]} + dict set fields dayOfMonth { + set dayOfMonth [dict get $date dayOfMonth] + } } H - k { # Hour of the day in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - / 3600 - % 24 }]]} + [expr { $localSeconds / 3600 % 24 }]]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } I - l { # Hour (12-11) AM/PM in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { ( ( ( [dict get $date localSeconds] - % 86400 ) + [expr { ( ( ( $localSeconds % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1 }]]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } m { # Month number in alternative numerals append formatString %s append substituents \ - { [lindex $localeNumerals [dict get $date month]]} + { [lindex $localeNumerals $month]} + dict set fields month { + set month [dict get $date month] + } } M { # Minute of the hour in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - / 60 - % 60 }]]} + [expr { $localSeconds / 60 % 60 }]]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } S { # Second of the minute in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - % 60 }]]} + [expr { $localSeconds % 60 }]]} + dict set fields localSeconds { + set localSeconds [dict get $date localSeconds] + } } u { # Day of the week (Monday=1,Sunday=7) # in alternative numerals append formatString %s append substituents \ - { [lindex $localeNumerals \ - [dict get $date dayOfWeek]]} + { [lindex $localeNumerals $dayOfWeek]} + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] } + } w { # Day of the week (Sunday=0,Saturday=6) # in alternative numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { [dict get $date dayOfWeek] % 7 }]]} + [expr { $dayOfWeek % 7 }]]} + dict set fields dayOfWeek { + set dayOfWeek [dict get $date dayOfWeek] + } } y { # Year of the century in alternative # numerals append formatString %s append substituents \ { [lindex $localeNumerals \ - [expr { [dict get $date year] % 100 }]]} + [expr { $year % 100 }]]} + dict set fields year { + set year [dict get $date year] + } } default { # Unknown format group append formatString %%O $char @@ -1157,7 +1249,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { } } + set extractCode [join [dict values $fields] ";"] + proc $procName {clockval timezone} " + $prefixCode + $extractCode $preFormatCode return \[::format [list $formatString] $substituents\] " @@ -1166,7 +1262,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { return $procName } - + #---------------------------------------------------------------------- # # clock scan -- @@ -1931,7 +2027,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { # Build the procedure set procBody {} - append procBody "variable ::tcl::clock::TZData" \n + append procBody "variable TZData" \n append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->" for { set i 1 } { $i <= $captureCount } { incr i } { append procBody " " field $i @@ -1958,7 +2054,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { } } append procBody { - ::tcl::clock::SetupTimeZone $timeZone + SetupTimeZone $timeZone } } @@ -1991,7 +2087,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { # Finally, convert the date to local time append procBody { - set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \ + set date [ConvertLocalToUTC $date[set date {}] \ $TZData($timeZone) $changeover] } } diff --git a/tools/cgannotate.tcl b/tools/cgannotate.tcl new file mode 100644 index 0000000..f8b9b7d --- /dev/null +++ b/tools/cgannotate.tcl @@ -0,0 +1,24 @@ +#!/usr/bin/tclsh +# +# A wrapper around cg_annotate that sets appropriate command-line options +# and rearranges the output so that annotated files occur in a consistent +# sorted order. +# + +set in [open |[list cg_annotate --show=Ir --auto=yes --context=40 {*}$argv] r] +set dest ! +set out(!) {} +while {![eof $in]} { + set line [string map {\t { }} [gets $in]] + if {[regexp {^-- Auto-annotated source: (.*)} $line all name]} { + set dest $name + } elseif {[regexp {^-- line \d+ ------} $line]} { + set line [lreplace $line 2 2 {#}] + } elseif {[regexp {^The following files chosen for } $line]} { + set dest ! + } + append out($dest) $line\n +} +foreach x [lsort [array names out]] { + puts $out($x) +} diff --git a/tools/microoptimization/clockformatscan.tcl b/tools/microoptimization/clockformatscan.tcl new file mode 100644 index 0000000..c7cec46 --- /dev/null +++ b/tools/microoptimization/clockformatscan.tcl @@ -0,0 +1,5 @@ +apply {{{limit 5000}} { + for {set i 0} {$i < $limit} {incr i} { + clock scan [clock format $i -format %T] -format %T + } +}} {*}$argv diff --git a/tools/microoptimization/generalbytecode.tcl b/tools/microoptimization/generalbytecode.tcl new file mode 100644 index 0000000..2471943 --- /dev/null +++ b/tools/microoptimization/generalbytecode.tcl @@ -0,0 +1,13 @@ +apply {{{limit1 100} {limit2 1000}} { + for {set i 0} {$i < $limit1} {incr i} { + apply {limit2 { + set a {} + set b {} + for {set i 0} {$i < $limit2} {incr i} { + lappend a $i + dict set b $i [expr {$i*$i}] + } + return [string length $a],[string length $b] + }} $limit2 + } +}} {*}$argv diff --git a/tools/microoptimization/oocreate.tcl b/tools/microoptimization/oocreate.tcl new file mode 100644 index 0000000..0a5d3dc --- /dev/null +++ b/tools/microoptimization/oocreate.tcl @@ -0,0 +1,13 @@ +oo::class create foo { + method bar {} { + return abc + } +} +apply {{{iter 10000}} { + for {set i 0} {$i < $iter} {incr i} { + set obj1 [foo new] + set obj2 [foo create inst] + $obj1 destroy + $obj2 destroy + } +}} {*}$argv diff --git a/tools/microoptimization/oodispatch.tcl b/tools/microoptimization/oodispatch.tcl new file mode 100644 index 0000000..041c8e3 --- /dev/null +++ b/tools/microoptimization/oodispatch.tcl @@ -0,0 +1,11 @@ +oo::class create foo { + method bar {} { + return abc + } +} +foo create inst +apply {{{iter 100000}} { + for {set i 0} {$i < $iter} {incr i} { + inst bar + } +}} {*}$argv diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index ea03332..0f4a8a3 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -680,7 +680,6 @@ TclpInetNtoa( */ #ifdef USE_THREAD_ALLOC -static volatile int initialized = 0; static pthread_key_t key; typedef struct allocMutex { @@ -727,29 +726,23 @@ TclpFreeAllocCache( TclFreeAllocCache(ptr); pthread_setspecific(key, NULL); - - } else if (initialized) { - /* - * Called by us in TclFinalizeThreadAlloc() during the library - * finalization initiated from Tcl_Finalize() - */ - + + } else { pthread_key_delete(key); - initialized = 0; } } +void +TclpInitThreadAlloc(void) +{ + pthread_mutex_lock(allocLockPtr); + pthread_key_create(&key, TclpFreeAllocCache); + pthread_mutex_unlock(allocLockPtr); +} + void * TclpGetAllocCache(void) { - if (!initialized) { - pthread_mutex_lock(allocLockPtr); - if (!initialized) { - pthread_key_create(&key, TclpFreeAllocCache); - initialized = 1; - } - pthread_mutex_unlock(allocLockPtr); - } return pthread_getspecific(key); } diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 1c9d483..a2fc226 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -122,7 +122,6 @@ typedef struct WinCondition { */ #ifdef USE_THREAD_ALLOC -static int once; static DWORD tlsKey; typedef struct allocMutex { @@ -971,24 +970,24 @@ TclpFreeAllocMutex( free(lockPtr); } +void +TclpInitThreadAlloc(void) +{ + /* + * We need to make sure that TclpFreeAllocCache is called on each + * thread that calls this, but only on threads that call this. + */ + + tlsKey = TlsAlloc(); + if (tlsKey == TLS_OUT_OF_INDEXES) { + Tcl_Panic("could not allocate thread local storage"); + } +} + void * TclpGetAllocCache(void) { void *result; - - if (!once) { - /* - * We need to make sure that TclpFreeAllocCache is called on each - * thread that calls this, but only on threads that call this. - */ - - tlsKey = TlsAlloc(); - once = 1; - if (tlsKey == TLS_OUT_OF_INDEXES) { - Tcl_Panic("could not allocate thread local storage"); - } - } - result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { Tcl_Panic("TlsGetValue failed from TclpGetAllocCache"); @@ -1024,7 +1023,7 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache"); } - } else if (once) { + } else { /* * Called by us in TclFinalizeThreadAlloc() during the library * finalization initiated from Tcl_Finalize() @@ -1034,9 +1033,7 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); } - once = 0; /* reset for next time. */ } - } #endif /* USE_THREAD_ALLOC */ |