summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclCompile.h31
-rw-r--r--generic/tclExecute.c32
-rw-r--r--generic/tclInt.h8
-rw-r--r--generic/tclOOCall.c43
-rwxr-xr-xlibrary/clock.tcl248
-rw-r--r--tools/cgannotate.tcl24
-rw-r--r--tools/microoptimization/clockformatscan.tcl5
-rw-r--r--tools/microoptimization/generalbytecode.tcl13
-rw-r--r--tools/microoptimization/oocreate.tcl13
-rw-r--r--tools/microoptimization/oodispatch.tcl11
-rw-r--r--win/tclWinPort.h3
12 files changed, 339 insertions, 95 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 3cd90a9..be40368 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 f99c07c..7603761 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1505,6 +1505,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/tclExecute.c b/generic/tclExecute.c
index 3f57333..9422f5e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3194,20 +3194,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 49a299c..6fac1c0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4642,7 +4642,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/library/clock.tcl b/library/clock.tcl
index 535a67d..a192cc2 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/win/tclWinPort.h b/win/tclWinPort.h
index ca6b2bf..c952b1a 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -92,6 +92,9 @@ typedef DWORD_PTR * PDWORD_PTR;
#include <process.h>
#include <signal.h>
#include <limits.h>
+#if HAVE_STDINT_H
+# include <stdint.h>
+#endif
#ifndef __GNUC__
# define strncasecmp _strnicmp
generated by cgit v0.12 at 2025-05-31 23:56:53 (GMT)