summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/regc_color.c15
-rw-r--r--generic/regc_cvec.c1
-rw-r--r--generic/regc_lex.c37
-rw-r--r--generic/regc_locale.c727
-rw-r--r--generic/regc_nfa.c1951
-rw-r--r--generic/regcomp.c246
-rw-r--r--generic/regcustom.h8
-rw-r--r--generic/rege_dfa.c29
-rw-r--r--generic/regerror.c4
-rw-r--r--generic/regerrs.h2
-rw-r--r--generic/regex.h62
-rw-r--r--generic/regexec.c1049
-rw-r--r--generic/regguts.h81
-rw-r--r--generic/tcl.decls14
-rw-r--r--generic/tcl.h121
-rw-r--r--generic/tclAlloc.c2
-rw-r--r--generic/tclAssembly.c45
-rw-r--r--generic/tclBasic.c645
-rw-r--r--generic/tclBinary.c382
-rw-r--r--generic/tclClock.c97
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclCmdIL.c129
-rw-r--r--generic/tclCmdMZ.c150
-rw-r--r--generic/tclCompCmds.c942
-rw-r--r--generic/tclCompCmdsGR.c746
-rw-r--r--generic/tclCompCmdsSZ.c975
-rw-r--r--generic/tclCompExpr.c196
-rw-r--r--generic/tclCompile.c1447
-rw-r--r--generic/tclCompile.h167
-rw-r--r--generic/tclDate.c8
-rw-r--r--generic/tclDecls.h53
-rw-r--r--generic/tclDictObj.c286
-rw-r--r--generic/tclDisassemble.c1503
-rw-r--r--generic/tclEncoding.c119
-rw-r--r--generic/tclEnsemble.c109
-rw-r--r--generic/tclEnv.c185
-rw-r--r--generic/tclEvent.c59
-rw-r--r--generic/tclExecute.c2112
-rw-r--r--generic/tclFCmd.c8
-rw-r--r--generic/tclFileName.c12
-rw-r--r--generic/tclFileSystem.h4
-rw-r--r--generic/tclHash.c2
-rw-r--r--generic/tclHistory.c4
-rw-r--r--generic/tclIO.c3694
-rw-r--r--generic/tclIO.h36
-rw-r--r--generic/tclIOCmd.c37
-rw-r--r--generic/tclIOGT.c198
-rw-r--r--generic/tclIORChan.c369
-rw-r--r--generic/tclIORTrans.c119
-rw-r--r--generic/tclIOSock.c40
-rw-r--r--generic/tclIOUtil.c187
-rw-r--r--generic/tclInt.decls11
-rw-r--r--generic/tclInt.h164
-rw-r--r--generic/tclIntDecls.h14
-rw-r--r--generic/tclIntPlatDecls.h30
-rw-r--r--generic/tclInterp.c59
-rw-r--r--generic/tclListObj.c44
-rw-r--r--generic/tclLiteral.c32
-rw-r--r--generic/tclLoad.c4
-rw-r--r--generic/tclLoadNone.c18
-rw-r--r--generic/tclMain.c9
-rw-r--r--generic/tclNamesp.c209
-rw-r--r--generic/tclNotify.c6
-rw-r--r--generic/tclOO.c147
-rw-r--r--generic/tclOO.decls20
-rw-r--r--generic/tclOO.h38
-rw-r--r--generic/tclOOBasic.c51
-rw-r--r--generic/tclOOCall.c99
-rw-r--r--generic/tclOODecls.h80
-rw-r--r--generic/tclOODefineCmds.c26
-rw-r--r--generic/tclOOInfo.c124
-rw-r--r--generic/tclOOInt.h5
-rw-r--r--generic/tclOOIntDecls.h41
-rw-r--r--generic/tclOOMethod.c75
-rw-r--r--generic/tclOOStubLib.c2
-rw-r--r--generic/tclObj.c92
-rw-r--r--generic/tclOptimize.c26
-rw-r--r--generic/tclPanic.c17
-rw-r--r--generic/tclParse.c121
-rw-r--r--generic/tclPathObj.c24
-rw-r--r--generic/tclPkg.c2
-rw-r--r--generic/tclPlatDecls.h14
-rw-r--r--generic/tclPreserve.c3
-rw-r--r--generic/tclProc.c480
-rw-r--r--generic/tclRegexp.c9
-rw-r--r--generic/tclResult.c4
-rw-r--r--generic/tclScan.c10
-rwxr-xr-xgeneric/tclStrToD.c46
-rw-r--r--generic/tclStringObj.c168
-rw-r--r--generic/tclStringRep.h97
-rw-r--r--generic/tclStringTrim.h43
-rw-r--r--generic/tclStubInit.c54
-rw-r--r--generic/tclTest.c162
-rw-r--r--generic/tclTestProcBodyObj.c4
-rw-r--r--generic/tclThread.c15
-rwxr-xr-xgeneric/tclThreadAlloc.c165
-rw-r--r--generic/tclThreadJoin.c4
-rw-r--r--generic/tclThreadStorage.c6
-rw-r--r--generic/tclThreadTest.c6
-rw-r--r--generic/tclTomMath.decls23
-rw-r--r--generic/tclTomMathDecls.h25
-rw-r--r--generic/tclTrace.c26
-rw-r--r--generic/tclUniData.c1701
-rw-r--r--generic/tclUtf.c125
-rw-r--r--generic/tclUtil.c184
-rw-r--r--generic/tclVar.c281
-rw-r--r--generic/tclZlib.c184
107 files changed, 15359 insertions, 9488 deletions
diff --git a/generic/regc_color.c b/generic/regc_color.c
index f5d6dfd..92e0aad 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -259,7 +259,7 @@ newcolor(
return COLORLESS; /* too many colors */
}
n = cm->ncds * 2;
- if (n < MAX_COLOR + 1) {
+ if (n > MAX_COLOR + 1) {
n = MAX_COLOR + 1;
}
if (cm->cd == cm->cdspace) {
@@ -777,18 +777,19 @@ dumpcolors(
}
/*
- * It's hard to do this more efficiently.
+ * Unfortunately, it's hard to do this next bit more efficiently.
+ *
+ * Spencer's original coding has the loop iterating from CHR_MIN
+ * to CHR_MAX, but that's utterly unusable for 32-bit chr, or
+ * even 16-bit. For debugging purposes it seems fine to print
+ * only chr codes up to 1000 or so.
*/
- for (c=CHR_MIN ; c<CHR_MAX ; c++) {
+ for (c=CHR_MIN ; c<1000 ; c++) {
if (GETCOLOR(cm, c) == co) {
dumpchr(c, f);
}
}
- assert(c == CHR_MAX);
- if (GETCOLOR(cm, c) == co) {
- dumpchr(c, f);
- }
fprintf(f, "\n");
}
}
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
index 0247521..d450d3e 100644
--- a/generic/regc_cvec.c
+++ b/generic/regc_cvec.c
@@ -81,6 +81,7 @@ addchr(
struct cvec *cv, /* character vector */
pchr c) /* character to add */
{
+ assert(cv->nchrs < cv->chrspace);
cv->chrs[cv->nchrs++] = (chr)c;
}
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 132e757..affcb48 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -256,20 +256,33 @@ static const chr brbacks[] = { /* \s within brackets */
CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
CHR(':'), CHR(']')
};
+
+#define PUNCT_CONN \
+ CHR('_'), \
+ 0x203f /* UNDERTIE */, \
+ 0x2040 /* CHARACTER TIE */,\
+ 0x2054 /* INVERTED UNDERTIE */,\
+ 0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \
+ 0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \
+ 0xfe4d /* DASHED LOW LINE */, \
+ 0xfe4e /* CENTRELINE LOW LINE */, \
+ 0xfe4f /* WAVY LOW LINE */, \
+ 0xff3f /* FULLWIDTH LOW LINE */
+
static const chr backw[] = { /* \w */
CHR('['), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+ CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr backW[] = { /* \W */
CHR('['), CHR('^'), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+ CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr brbackw[] = { /* \w within brackets */
CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_')
+ CHR(':'), CHR(']'), PUNCT_CONN
};
/*
@@ -1139,24 +1152,6 @@ newline(void)
}
/*
- - ch - return the chr sequence for regc_locale.c's fake collating element ch
- * This helps confine use of CHR to this source file. Beware that the caller
- * knows how long the sequence is.
- ^ #ifdef REG_DEBUG
- ^ static const chr *ch(NOPARMS);
- ^ #endif
- */
-#ifdef REG_DEBUG
-static const chr *
-ch(void)
-{
- static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
-
- return chstr;
-}
-#endif
-
-/*
- chrnamed - return the chr known by a given (chr string) name
* The code is a bit clumsy, but this routine gets only such specialized
* use that it hardly matters.
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index e79dff8..3c10cb6 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -118,7 +118,7 @@ static const struct cname {
* Unicode character-class tables.
*/
-typedef struct crange {
+typedef struct {
chr start;
chr end;
} crange;
@@ -137,21 +137,21 @@ static const crange alphaRangeTable[] = {
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
- {0x3f7, 0x481}, {0x48a, 0x527}, {0x531, 0x556}, {0x561, 0x587},
+ {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
- {0x800, 0x815}, {0x840, 0x858}, {0x8a2, 0x8ac}, {0x904, 0x939},
- {0x958, 0x961}, {0x971, 0x977}, {0x979, 0x97f}, {0x985, 0x98c},
- {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1},
- {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c},
- {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
- {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28},
- {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a},
- {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
- {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc33},
- {0xc35, 0xc39}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8},
- {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
- {0xd12, 0xd3a}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
+ {0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x904, 0x939},
+ {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8},
+ {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a},
+ {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74},
+ {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
+ {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
+ {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90},
+ {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c},
+ {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc58, 0xc5a},
+ {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
+ {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a},
+ {0xd5f, 0xd61}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
{0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46},
{0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0},
{0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c},
@@ -160,95 +160,113 @@ static const crange alphaRangeTable[] = {
{0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
{0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
{0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
- {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f4},
- {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
- {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
- {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877},
- {0x1880, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1950, 0x196d},
- {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16},
- {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0},
- {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d},
- {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15},
- {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
- {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
- {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
- {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113},
- {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f},
- {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4},
- {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96},
- {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
- {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
- {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa},
- {0x30fc, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
- {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c},
- {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
- {0xa67f, 0xa697}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
- {0xa78b, 0xa78e}, {0xa790, 0xa793}, {0xa7a0, 0xa7aa}, {0xa7f8, 0xa801},
- {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873},
- {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946},
- {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
- {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa80, 0xaaaf}, {0xaab9, 0xaabd},
+ {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5},
+ {0x13f8, 0x13fd}, {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a},
+ {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711},
+ {0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770},
+ {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, {0x18b0, 0x18f5},
+ {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
+ {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
+ {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
+ {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1},
+ {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
+ {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
+ {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3},
+ {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc},
+ {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d},
+ {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e},
+ {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25},
+ {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae},
+ {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce},
+ {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096},
+ {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312d},
+ {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5},
+ {0x4e00, 0x9fd5}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c},
+ {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5},
+ {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ad}, {0xa7b0, 0xa7b7},
+ {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822},
+ {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925},
+ {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4},
+ {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
+ {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd},
{0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
- {0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
- {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
- {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
- {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
- {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
- {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
- {0xffda, 0xffdc}
+ {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2}, {0xac00, 0xd7a3},
+ {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e},
+ {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e},
+ {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
+ {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36},
+ {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f},
+ {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc},
+ {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe}, {0xffc2, 0xffc7},
+ {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
- {0x10300, 0x1031e}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10380, 0x1039d},
- {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, {0x10800, 0x10805},
- {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10900, 0x10915}, {0x10920, 0x10939},
- {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
- {0x10a60, 0x10a7c}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
- {0x10c00, 0x10c48}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
- {0x11103, 0x11126}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11680, 0x116aa},
- {0x12000, 0x1236e}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
- {0x16f93, 0x16f9f}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
- {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
- {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
- {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
- {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
- {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
+ {0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
+ {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
+ {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
+ {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
+ {0x10860, 0x10876}, {0x10880, 0x1089e}, {0x108e0, 0x108f2}, {0x10900, 0x10915},
+ {0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17},
+ {0x10a19, 0x10a33}, {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7},
+ {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
+ {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
+ {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, {0x11103, 0x11126},
+ {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11200, 0x11211},
+ {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
+ {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, {0x11313, 0x11328},
+ {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, {0x11480, 0x114af},
+ {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
+ {0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12399},
+ {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
+ {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
+ {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
+ {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
+ {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
+ {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
+ {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
+ {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
+ {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
+ {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
{0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
{0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
{0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
- {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d}
+ {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1},
+ {0x2f800, 0x2fa1d}
#endif
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static const chr alphaCharTable[] = {
- 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x386, 0x38c,
- 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, 0x6ff,
- 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x8a0,
+ 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386,
+ 0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef,
+ 0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828,
0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38,
- 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xb0f,
- 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99,
- 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, 0xc58,
- 0xc59, 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
- 0xd3d, 0xd4e, 0xd60, 0xd61, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82,
- 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
- 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066,
- 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7,
- 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071,
- 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183,
- 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006,
- 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
- 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
+ 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9,
+ 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83,
+ 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d,
+ 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, 0xd3d,
+ 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88,
+ 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3, 0xebd,
+ 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7, 0x10cd,
+ 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf, 0x1cf5,
+ 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107,
+ 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3,
+ 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a,
+ 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0,
+ 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
- ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00,
- 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
- 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47,
- 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d,
- 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
+ ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
+ 0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
+ 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x16f50,
+ 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
+ 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
+ 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
+ 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};
@@ -259,18 +277,19 @@ static const chr alphaCharTable[] = {
*/
static const crange controlRangeTable[] = {
- {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f},
- {0x202a, 0x202e}, {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff},
+ {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
+ {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
{0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
- ,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd}
+ ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
+ {0x100000, 0x10fffd}
#endif
};
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
static const chr controlCharTable[] = {
- 0xad, 0x6dd, 0x70f, 0xfeff
+ 0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
,0x110bd, 0xe0001
#endif
@@ -286,15 +305,18 @@ static const crange digitRangeTable[] = {
{0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9},
{0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef},
{0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef},
- {0xd66, 0xd6f}, {0xe50, 0xe59}, {0xed0, 0xed9}, {0xf20, 0xf29},
- {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, {0x1810, 0x1819},
- {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, {0x1a90, 0x1a99},
- {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, {0x1c50, 0x1c59},
- {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, {0xa9d0, 0xa9d9},
- {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, {0xff10, 0xff19}
+ {0xd66, 0xd6f}, {0xde6, 0xdef}, {0xe50, 0xe59}, {0xed0, 0xed9},
+ {0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9},
+ {0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89},
+ {0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49},
+ {0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
+ {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
+ {0xff10, 0xff19}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
- {0x111d0, 0x111d9}, {0x116c0, 0x116c9}, {0x1d7ce, 0x1d7ff}
+ {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659},
+ {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69},
+ {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}
#endif
};
@@ -316,15 +338,19 @@ static const crange punctRangeTable[] = {
{0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad},
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
- {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, {0x29d8, 0x29db},
- {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, {0x3001, 0x3003},
- {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7},
- {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f},
- {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03},
- {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65}
+ {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
+ {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e42},
+ {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
+ {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
+ {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
+ {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
+ {0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
- ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d},
- {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473}
+ ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
+ {0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
+ {0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x115c1, 0x115d7},
+ {0x11641, 0x11643}, {0x1173c, 0x1173e}, {0x12470, 0x12474}, {0x16b37, 0x16b3b},
+ {0x1da87, 0x1da8b}
#endif
};
@@ -340,11 +366,13 @@ static const chr punctCharTable[] = {
0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d,
0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff,
0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e,
- 0xa8ce, 0xa8cf, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade, 0xaadf,
- 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a, 0xfe6b,
- 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
+ 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade,
+ 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a,
+ 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
- ,0x1039f, 0x103d0, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc
+ ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
+ 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5,
+ 0x16b44, 0x1bc9f
#endif
};
@@ -375,22 +403,25 @@ static const crange lowerRangeTable[] = {
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
- {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x1d00, 0x1d2b},
- {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
- {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
- {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
- {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
- {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
- {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
- {0xa771, 0xa778}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
+ {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
+ {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d},
+ {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37},
+ {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d},
+ {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4},
+ {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4},
+ {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25},
+ {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a},
+ {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
- ,{0x10428, 0x1044f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
- {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
- {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
- {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
- {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
- {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
- {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}
+ ,{0x10428, 0x1044f}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433},
+ {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537},
+ {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607},
+ {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da},
+ {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e},
+ {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2},
+ {0x1d7c4, 0x1d7c9}
#endif
};
@@ -426,39 +457,41 @@ static const chr lowerCharTable[] = {
0x4f1, 0x4f3, 0x4f5, 0x4f7, 0x4f9, 0x4fb, 0x4fd, 0x4ff, 0x501,
0x503, 0x505, 0x507, 0x509, 0x50b, 0x50d, 0x50f, 0x511, 0x513,
0x515, 0x517, 0x519, 0x51b, 0x51d, 0x51f, 0x521, 0x523, 0x525,
- 0x527, 0x1e01, 0x1e03, 0x1e05, 0x1e07, 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f,
- 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21,
- 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, 0x1e2d, 0x1e2f, 0x1e31, 0x1e33,
- 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, 0x1e3f, 0x1e41, 0x1e43, 0x1e45,
- 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, 0x1e51, 0x1e53, 0x1e55, 0x1e57,
- 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, 0x1e63, 0x1e65, 0x1e67, 0x1e69,
- 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, 0x1e75, 0x1e77, 0x1e79, 0x1e7b,
- 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, 0x1e87, 0x1e89, 0x1e8b, 0x1e8d,
- 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9,
- 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb,
- 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd,
- 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, 0x1ed9, 0x1edb, 0x1edd, 0x1edf,
- 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, 0x1eeb, 0x1eed, 0x1eef, 0x1ef1,
- 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe,
- 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x210a, 0x210e, 0x210f,
- 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, 0x213d, 0x214e, 0x2184, 0x2c61,
- 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, 0x2c71, 0x2c73, 0x2c74, 0x2c81,
- 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, 0x2c8d, 0x2c8f, 0x2c91, 0x2c93,
- 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5,
- 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7,
- 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9,
- 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb,
- 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, 0x2cec, 0x2cee, 0x2cf3, 0x2d27,
- 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, 0xa649, 0xa64b, 0xa64d, 0xa64f,
- 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, 0xa65b, 0xa65d, 0xa65f, 0xa661,
- 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, 0xa66d, 0xa681, 0xa683, 0xa685,
- 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, 0xa691, 0xa693, 0xa695, 0xa697,
- 0xa723, 0xa725, 0xa727, 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737,
- 0xa739, 0xa73b, 0xa73d, 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749,
- 0xa74b, 0xa74d, 0xa74f, 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b,
- 0xa75d, 0xa75f, 0xa761, 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d,
- 0xa76f, 0xa77a, 0xa77c, 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c,
- 0xa78e, 0xa791, 0xa793, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, 0xa7fa
+ 0x527, 0x529, 0x52b, 0x52d, 0x52f, 0x1e01, 0x1e03, 0x1e05, 0x1e07,
+ 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f, 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19,
+ 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21, 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b,
+ 0x1e2d, 0x1e2f, 0x1e31, 0x1e33, 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d,
+ 0x1e3f, 0x1e41, 0x1e43, 0x1e45, 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f,
+ 0x1e51, 0x1e53, 0x1e55, 0x1e57, 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61,
+ 0x1e63, 0x1e65, 0x1e67, 0x1e69, 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73,
+ 0x1e75, 0x1e77, 0x1e79, 0x1e7b, 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85,
+ 0x1e87, 0x1e89, 0x1e8b, 0x1e8d, 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1,
+ 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9, 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3,
+ 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb, 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5,
+ 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd, 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7,
+ 0x1ed9, 0x1edb, 0x1edd, 0x1edf, 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9,
+ 0x1eeb, 0x1eed, 0x1eef, 0x1ef1, 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb,
+ 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe, 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6,
+ 0x1ff7, 0x210a, 0x210e, 0x210f, 0x2113, 0x212f, 0x2134, 0x2139, 0x213c,
+ 0x213d, 0x214e, 0x2184, 0x2c61, 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c,
+ 0x2c71, 0x2c73, 0x2c74, 0x2c81, 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b,
+ 0x2c8d, 0x2c8f, 0x2c91, 0x2c93, 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d,
+ 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5, 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf,
+ 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7, 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1,
+ 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9, 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3,
+ 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb, 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4,
+ 0x2cec, 0x2cee, 0x2cf3, 0x2d27, 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647,
+ 0xa649, 0xa64b, 0xa64d, 0xa64f, 0xa651, 0xa653, 0xa655, 0xa657, 0xa659,
+ 0xa65b, 0xa65d, 0xa65f, 0xa661, 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b,
+ 0xa66d, 0xa681, 0xa683, 0xa685, 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f,
+ 0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727,
+ 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d,
+ 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
+ 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
+ 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
+ 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
+ 0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
+ 0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
,0x1d4bb, 0x1d7cb
#endif
@@ -475,19 +508,20 @@ static const crange upperRangeTable[] = {
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
- {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f},
- {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb},
- {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d},
- {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133},
- {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80},
- {0xff21, 0xff3a}
+ {0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
+ {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
+ {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
+ {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
+ {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
+ {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ad}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
- ,{0x10400, 0x10427}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
- {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
- {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
- {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
- {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
+ ,{0x10400, 0x10427}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419},
+ {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5},
+ {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
+ {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585},
+ {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655},
+ {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734},
+ {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
#endif
};
@@ -510,52 +544,53 @@ static const chr upperCharTable[] = {
0x20c, 0x20e, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21a, 0x21c,
0x21e, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22a, 0x22c, 0x22e,
0x230, 0x232, 0x23a, 0x23b, 0x23d, 0x23e, 0x241, 0x248, 0x24a,
- 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x386, 0x38c, 0x38e, 0x38f,
- 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, 0x3e6,
- 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, 0x460,
- 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, 0x472,
- 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, 0x48c,
- 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, 0x49e,
- 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, 0x4b0,
- 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, 0x4c1,
- 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, 0x4d4,
- 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, 0x4e6,
- 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, 0x4f8,
- 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, 0x50a,
- 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, 0x51c,
- 0x51e, 0x520, 0x522, 0x524, 0x526, 0x10c7, 0x10cd, 0x1e00, 0x1e02,
- 0x1e04, 0x1e06, 0x1e08, 0x1e0a, 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14,
- 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26,
- 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38,
- 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a,
- 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c,
- 0x1e5e, 0x1e60, 0x1e62, 0x1e64, 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e,
- 0x1e70, 0x1e72, 0x1e74, 0x1e76, 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80,
- 0x1e82, 0x1e84, 0x1e86, 0x1e88, 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92,
- 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac,
- 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe,
- 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0,
- 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2,
- 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4,
- 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f,
- 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x213e, 0x213f, 0x2145,
- 0x2183, 0x2c60, 0x2c67, 0x2c69, 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84,
- 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96,
- 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8,
- 0x2caa, 0x2cac, 0x2cae, 0x2cb0, 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba,
- 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc,
- 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde,
- 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646,
- 0xa648, 0xa64a, 0xa64c, 0xa64e, 0xa650, 0xa652, 0xa654, 0xa656, 0xa658,
- 0xa65a, 0xa65c, 0xa65e, 0xa660, 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a,
- 0xa66c, 0xa680, 0xa682, 0xa684, 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e,
- 0xa690, 0xa692, 0xa694, 0xa696, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a,
- 0xa72c, 0xa72e, 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e,
- 0xa740, 0xa742, 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750,
- 0xa752, 0xa754, 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762,
- 0xa764, 0xa766, 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d,
- 0xa77e, 0xa780, 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792,
- 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7aa
+ 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x37f, 0x386, 0x38c, 0x38e,
+ 0x38f, 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4,
+ 0x3e6, 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa,
+ 0x460, 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470,
+ 0x472, 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a,
+ 0x48c, 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c,
+ 0x49e, 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae,
+ 0x4b0, 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0,
+ 0x4c1, 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2,
+ 0x4d4, 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4,
+ 0x4e6, 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6,
+ 0x4f8, 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508,
+ 0x50a, 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a,
+ 0x51c, 0x51e, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52a, 0x52c,
+ 0x52e, 0x10c7, 0x10cd, 0x1e00, 0x1e02, 0x1e04, 0x1e06, 0x1e08, 0x1e0a,
+ 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, 0x1e16, 0x1e18, 0x1e1a, 0x1e1c,
+ 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e,
+ 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40,
+ 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, 0x1e4c, 0x1e4e, 0x1e50, 0x1e52,
+ 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, 0x1e5e, 0x1e60, 0x1e62, 0x1e64,
+ 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, 0x1e70, 0x1e72, 0x1e74, 0x1e76,
+ 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, 0x1e82, 0x1e84, 0x1e86, 0x1e88,
+ 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2,
+ 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4,
+ 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6,
+ 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8,
+ 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea,
+ 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, 0x1ef6, 0x1ef8, 0x1efa, 0x1efc,
+ 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124,
+ 0x2126, 0x2128, 0x213e, 0x213f, 0x2145, 0x2183, 0x2c60, 0x2c67, 0x2c69,
+ 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84, 0x2c86, 0x2c88, 0x2c8a, 0x2c8c,
+ 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96, 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e,
+ 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8, 0x2caa, 0x2cac, 0x2cae, 0x2cb0,
+ 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba, 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2,
+ 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc, 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4,
+ 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde, 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced,
+ 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646, 0xa648, 0xa64a, 0xa64c, 0xa64e,
+ 0xa650, 0xa652, 0xa654, 0xa656, 0xa658, 0xa65a, 0xa65c, 0xa65e, 0xa660,
+ 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a, 0xa66c, 0xa680, 0xa682, 0xa684,
+ 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, 0xa690, 0xa692, 0xa694, 0xa696,
+ 0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e,
+ 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
+ 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
+ 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
+ 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
+ 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
+ 0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
@@ -569,141 +604,163 @@ static const chr upperCharTable[] = {
*/
static const crange graphRangeTable[] = {
- {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37e},
- {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x527}, {0x531, 0x556},
- {0x559, 0x55f}, {0x561, 0x587}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
- {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
- {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x800, 0x82d},
- {0x830, 0x83e}, {0x840, 0x85b}, {0x8a2, 0x8ac}, {0x8e4, 0x8fe},
- {0x900, 0x977}, {0x979, 0x97f}, {0x981, 0x983}, {0x985, 0x98c},
- {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
- {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03},
- {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
- {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83},
- {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
- {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
- {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c},
- {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44},
- {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a},
- {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
- {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa},
- {0xc01, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
- {0xc2a, 0xc33}, {0xc35, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48},
- {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc7f},
- {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
- {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd},
- {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
+ {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
+ {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
+ {0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
+ {0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
+ {0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
+ {0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b4},
+ {0x8e3, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0},
+ {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3},
+ {0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28},
+ {0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c},
+ {0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
+ {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5},
+ {0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1},
+ {0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
+ {0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
+ {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
+ {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
+ {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
+ {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
+ {0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
+ {0xc66, 0xc6f}, {0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c},
+ {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
+ {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
+ {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
{0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e},
- {0xd60, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
+ {0xd5f, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
{0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4},
- {0xdd8, 0xddf}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b},
- {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9},
- {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9},
- {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97},
- {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5},
- {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
- {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
- {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
- {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399},
- {0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f0},
- {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
- {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
- {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877},
- {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1920, 0x192b},
- {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
- {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
- {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
- {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
- {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6},
- {0x1d00, 0x1de6}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
- {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
- {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
- {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
- {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0},
- {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a},
- {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e},
- {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67},
- {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
- {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
- {0x2dd8, 0x2dde}, {0x2de0, 0x2e3b}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3},
- {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096},
- {0x3099, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba},
- {0x31c0, 0x31e3}, {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5},
- {0x4dc0, 0x9fcc}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b},
- {0xa640, 0xa697}, {0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa793},
- {0xa7a0, 0xa7aa}, {0xa7f8, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
- {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fb}, {0xa900, 0xa953},
- {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xaa00, 0xaa36},
- {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 0xaac2},
+ {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a},
+ {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3},
+ {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd},
+ {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c},
+ {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda},
+ {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256},
+ {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0},
+ {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6},
+ {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c},
+ {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f},
+ {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714},
+ {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770},
+ {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d},
+ {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa}, {0x18b0, 0x18f5},
+ {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d},
+ {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da},
+ {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
+ {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
+ {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
+ {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5},
+ {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
+ {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4},
+ {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4},
+ {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e},
+ {0x2090, 0x209c}, {0x20a0, 0x20be}, {0x20d0, 0x20f0}, {0x2100, 0x218b},
+ {0x2190, 0x23fa}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
+ {0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1},
+ {0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
+ {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
+ {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
+ {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e42},
+ {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
+ {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312d},
+ {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
+ {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fd5}, {0xa000, 0xa48c},
+ {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ad},
+ {0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
+ {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
+ {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
+ {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
- {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabed}, {0xabf0, 0xabf9},
- {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d},
- {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36},
- {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f},
- {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe26},
- {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
+ {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
+ {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
+ {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
+ {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
+ {0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
+ {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
+ {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
+ {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
+ {0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
- {0x10137, 0x1018a}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
- {0x102a0, 0x102d0}, {0x10300, 0x1031e}, {0x10320, 0x10323}, {0x10330, 0x1034a},
- {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, {0x10400, 0x1049d},
- {0x104a0, 0x104a9}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
- {0x10857, 0x1085f}, {0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
- {0x10a00, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
- {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a7f},
- {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b7f},
- {0x10c00, 0x10c48}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
- {0x11080, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
- {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11180, 0x111c8}, {0x111d0, 0x111d9},
- {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x12000, 0x1236e}, {0x12400, 0x12462},
- {0x12470, 0x12473}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
- {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126},
- {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356},
- {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
- {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
- {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
- {0x1d7ce, 0x1d7ff}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
- {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
- {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
- {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
- {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0be}, {0x1f0c1, 0x1f0cf},
- {0x1f0d1, 0x1f0df}, {0x1f100, 0x1f10a}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
- {0x1f170, 0x1f19a}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248},
- {0x1f300, 0x1f320}, {0x1f330, 0x1f335}, {0x1f337, 0x1f37c}, {0x1f380, 0x1f393},
- {0x1f3a0, 0x1f3c4}, {0x1f3c6, 0x1f3ca}, {0x1f3e0, 0x1f3f0}, {0x1f400, 0x1f43e},
- {0x1f442, 0x1f4f7}, {0x1f4f9, 0x1f4fc}, {0x1f500, 0x1f53d}, {0x1f540, 0x1f543},
- {0x1f550, 0x1f567}, {0x1f5fb, 0x1f640}, {0x1f645, 0x1f64f}, {0x1f680, 0x1f6c5},
- {0x1f700, 0x1f773}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
- {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
+ {0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
+ {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a},
+ {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
+ {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563},
+ {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
+ {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af},
+ {0x108e0, 0x108f2}, {0x108fb, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
+ {0x109bc, 0x109cf}, {0x109d2, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17},
+ {0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58},
+ {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, {0x10aeb, 0x10af6}, {0x10b00, 0x10b35},
+ {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b91}, {0x10b99, 0x10b9c},
+ {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
+ {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
+ {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
+ {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111cd},
+ {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d},
+ {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a9},
+ {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303}, {0x11305, 0x1130c},
+ {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344},
+ {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374},
+ {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
+ {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
+ {0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
+ {0x11ac0, 0x11af8}, {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474},
+ {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
+ {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5},
+ {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77},
+ {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
+ {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
+ {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
+ {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371},
+ {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
+ {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
+ {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b},
+ {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6},
+ {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
+ {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
+ {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
+ {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
+ {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
+ {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a},
+ {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f579},
+ {0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f6d0}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3},
+ {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
+ {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f910, 0x1f918},
+ {0x1f980, 0x1f984}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
+ {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
- 0x38c, 0x589, 0x58a, 0x58f, 0x85e, 0x8a0, 0x98f, 0x990, 0x9b2,
- 0x9c7, 0x9c8, 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33,
- 0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e,
- 0xab2, 0xab3, 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48,
- 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c,
- 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58,
- 0xc59, 0xc82, 0xc83, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd02,
- 0xd03, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
- 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
- 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
- 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa9de,
- 0xa9df, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
+ 0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
+ 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
+ 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
+ 0xad0, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56,
+ 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e,
+ 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6,
+ 0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6,
+ 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7,
+ 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773,
+ 0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27,
+ 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc,
+ 0xfffd
#if TCL_UTF_MAX > 4
- ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, 0x109be, 0x109bf,
- 0x10a05, 0x10a06, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6,
- 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
- 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
- 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250,
- 0x1f251, 0x1f440
+ ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
+ 0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
+ 0x11347, 0x11348, 0x11350, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001,
+ 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
+ 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
+ 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
+ 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
#endif
};
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 42489dd..088c6c0 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -34,6 +34,9 @@
#define NISERR() VISERR(nfa->v)
#define NERR(e) VERR(nfa->v, (e))
+#define STACK_TOO_DEEP(x) (0)
+#define CANCEL_REQUESTED(x) (0)
+#define REG_CANCEL 777
/*
- newnfa - set up an NFA
@@ -49,6 +52,7 @@ newnfa(
nfa = (struct nfa *) MALLOC(sizeof(struct nfa));
if (nfa == NULL) {
+ ERR(REG_ESPACE);
return NULL;
}
@@ -58,7 +62,6 @@ newnfa(
nfa->nstates = 0;
nfa->cm = cm;
nfa->v = v;
- nfa->size = 0;
nfa->bos[0] = nfa->bos[1] = COLORLESS;
nfa->eos[0] = nfa->eos[1] = COLORLESS;
nfa->parent = parent; /* Precedes newfstate so parent is valid. */
@@ -86,61 +89,6 @@ newnfa(
}
/*
- - TooManyStates - checks if the max states exceeds the compile-time value
- ^ static int TooManyStates(struct nfa *);
- */
-static int
-TooManyStates(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
- size_t sz = nfa->size;
-
- while (parent != NULL) {
- sz = parent->size;
- parent = parent->parent;
- }
- if (sz > REG_MAX_STATES) {
- return 1;
- }
- return 0;
-}
-
-/*
- - IncrementSize - increases the tracked size of the NFA and its parents.
- ^ static void IncrementSize(struct nfa *);
- */
-static void
-IncrementSize(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
-
- nfa->size++;
- while (parent != NULL) {
- parent->size++;
- parent = parent->parent;
- }
-}
-
-/*
- - DecrementSize - increases the tracked size of the NFA and its parents.
- ^ static void DecrementSize(struct nfa *);
- */
-static void
-DecrementSize(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
-
- nfa->size--;
- while (parent != NULL) {
- parent->size--;
- parent = parent->parent;
- }
-}
-
-/*
- freenfa - free an entire NFA
^ static void freenfa(struct nfa *);
*/
@@ -176,20 +124,20 @@ newstate(
{
struct state *s;
- if (TooManyStates(nfa)) {
- /* XXX: add specific error for this */
- NERR(REG_ETOOBIG);
- return NULL;
- }
if (nfa->free != NULL) {
s = nfa->free;
nfa->free = s->next;
} else {
+ if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+ NERR(REG_ETOOBIG);
+ return NULL;
+ }
s = (struct state *) MALLOC(sizeof(struct state));
if (s == NULL) {
NERR(REG_ESPACE);
return NULL;
}
+ nfa->v->spaceused += sizeof(struct state);
s->oas.next = NULL;
s->free = NULL;
s->noas = 0;
@@ -213,12 +161,6 @@ newstate(
}
s->prev = nfa->slast;
nfa->slast = s;
-
- /*
- * Track the current size and the parent size.
- */
-
- IncrementSize(nfa);
return s;
}
@@ -289,7 +231,6 @@ freestate(
s->prev = NULL;
s->next = nfa->free; /* don't delete it, put it on the free list */
nfa->free = s;
- DecrementSize(nfa);
}
/*
@@ -308,11 +249,13 @@ destroystate(
for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
abnext = ab->next;
FREE(ab);
+ nfa->v->spaceused -= sizeof(struct arcbatch);
}
s->ins = NULL;
s->outs = NULL;
s->next = NULL;
FREE(s);
+ nfa->v->spaceused -= sizeof(struct state);
}
/*
@@ -320,6 +263,10 @@ destroystate(
^ static void newarc(struct nfa *, int, pcolor, struct state *,
^ struct state *);
*/
+/*
+ * This function checks to make sure that no duplicate arcs are created.
+ * In general we never want duplicates.
+ */
static void
newarc(
struct nfa *nfa,
@@ -332,16 +279,42 @@ newarc(
assert(from != NULL && to != NULL);
- /*
- * Check for duplicates.
- */
-
- for (a=from->outs ; a!=NULL ; a=a->outchain) {
- if (a->to == to && a->co == co && a->type == t) {
- return;
+ /* check for duplicate arc, using whichever chain is shorter */
+ if (from->nouts <= to->nins) {
+ for (a = from->outs; a != NULL; a = a->outchain) {
+ if (a->to == to && a->co == co && a->type == t) {
+ return;
+ }
+ }
+ } else {
+ for (a = to->ins; a != NULL; a = a->inchain) {
+ if (a->from == from && a->co == co && a->type == t) {
+ return;
+ }
}
}
+ /* no dup, so create the arc */
+ createarc(nfa, t, co, from, to);
+}
+
+/*
+ * createarc - create a new arc within an NFA
+ *
+ * This function must *only* be used after verifying that there is no existing
+ * identical arc (same type/color/from/to).
+ */
+static void
+createarc(
+ struct nfa * nfa,
+ int t,
+ pcolor co,
+ struct state * from,
+ struct state * to)
+{
+ struct arc *a;
+
+ /* the arc is physically allocated within its from-state */
a = allocarc(nfa, from);
if (NISERR()) {
return;
@@ -354,15 +327,21 @@ newarc(
a->from = from;
/*
- * Put the new arc on the beginning, not the end, of the chains. Not only
- * is this easier, it has the very useful side effect that deleting the
- * most-recently-added arc is the cheapest case rather than the most
- * expensive one.
+ * Put the new arc on the beginning, not the end, of the chains; it's
+ * simpler here, and freearc() is the same cost either way. See also the
+ * logic in moveins() and its cohorts, as well as fixempties().
*/
-
a->inchain = to->ins;
+ a->inchainRev = NULL;
+ if (to->ins) {
+ to->ins->inchainRev = a;
+ }
to->ins = a;
a->outchain = from->outs;
+ a->outchainRev = NULL;
+ if (from->outs) {
+ from->outs->outchainRev = a;
+ }
from->outs = a;
from->nouts++;
@@ -399,14 +378,19 @@ allocarc(
*/
if (s->free == NULL) {
- struct arcbatch *newAb = (struct arcbatch *)
- MALLOC(sizeof(struct arcbatch));
+ struct arcbatch *newAb;
int i;
+ if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+ NERR(REG_ETOOBIG);
+ return NULL;
+ }
+ newAb = (struct arcbatch *) MALLOC(sizeof(struct arcbatch));
if (newAb == NULL) {
NERR(REG_ESPACE);
return NULL;
}
+ nfa->v->spaceused += sizeof(struct arcbatch);
newAb->next = s->oas.next;
s->oas.next = newAb;
@@ -435,7 +419,7 @@ freearc(
{
struct state *from = victim->from;
struct state *to = victim->to;
- struct arc *a;
+ struct arc *predecessor;
assert(victim->type != 0);
@@ -452,16 +436,17 @@ freearc(
*/
assert(from != NULL);
- assert(from->outs != NULL);
- a = from->outs;
- if (a == victim) { /* simple case: first in chain */
+ predecessor = victim->outchainRev;
+ if (predecessor == NULL) {
+ assert(from->outs == victim);
from->outs = victim->outchain;
} else {
- for (; a!=NULL && a->outchain!=victim ; a=a->outchain) {
- continue;
- }
- assert(a != NULL);
- a->outchain = victim->outchain;
+ assert(predecessor->outchain == victim);
+ predecessor->outchain = victim->outchain;
+ }
+ if (victim->outchain != NULL) {
+ assert(victim->outchain->outchainRev == victim);
+ victim->outchain->outchainRev = predecessor;
}
from->nouts--;
@@ -470,86 +455,95 @@ freearc(
*/
assert(to != NULL);
- assert(to->ins != NULL);
- a = to->ins;
- if (a == victim) { /* simple case: first in chain */
+ predecessor = victim->inchainRev;
+ if (predecessor == NULL) {
+ assert(to->ins == victim);
to->ins = victim->inchain;
} else {
- for (; a->inchain!=victim ; a=a->inchain) {
- assert(a->inchain != NULL);
- continue;
- }
- a->inchain = victim->inchain;
+ assert(predecessor->inchain == victim);
+ predecessor->inchain = victim->inchain;
+ }
+ if (victim->inchain != NULL) {
+ assert(victim->inchain->inchainRev == victim);
+ victim->inchain->inchainRev = predecessor;
}
to->nins--;
/*
- * Clean up and place on free list.
+ * Clean up and place on from-state's free list.
*/
victim->type = 0;
victim->from = NULL; /* precautions... */
victim->to = NULL;
victim->inchain = NULL;
+ victim->inchainRev = NULL;
victim->outchain = NULL;
+ victim->outchainRev = NULL;
victim->freechain = from->free;
from->free = victim;
}
-
+
/*
- - hasnonemptyout - Does state have a non-EMPTY out arc?
- ^ static int hasnonemptyout(struct state *);
+ * changearctarget - flip an arc to have a different to state
+ *
+ * Caller must have verified that there is no pre-existing duplicate arc.
+ *
+ * Note that because we store arcs in their from state, we can't easily have
+ * a similar changearcsource function.
*/
-static int
-hasnonemptyout(
- struct state *s)
+static void
+changearctarget(struct arc * a, struct state * newto)
{
- struct arc *a;
+ struct state *oldto = a->to;
+ struct arc *predecessor;
- for (a = s->outs; a != NULL; a = a->outchain) {
- if (a->type != EMPTY) {
- return 1;
- }
+ assert(oldto != newto);
+
+ /* take it off old target's in-chain */
+ assert(oldto != NULL);
+ predecessor = a->inchainRev;
+ if (predecessor == NULL) {
+ assert(oldto->ins == a);
+ oldto->ins = a->inchain;
+ } else {
+ assert(predecessor->inchain == a);
+ predecessor->inchain = a->inchain;
}
- return 0;
-}
-
-/*
- - nonemptyouts - count non-EMPTY out arcs of a state
- ^ static int nonemptyouts(struct state *);
- */
-static int
-nonemptyouts(
- struct state *s)
-{
- int n = 0;
- struct arc *a;
+ if (a->inchain != NULL) {
+ assert(a->inchain->inchainRev == a);
+ a->inchain->inchainRev = predecessor;
+ }
+ oldto->nins--;
- for (a = s->outs; a != NULL; a = a->outchain) {
- if (a->type != EMPTY) {
- n++;
- }
+ a->to = newto;
+
+ /* prepend it to new target's in-chain */
+ a->inchain = newto->ins;
+ a->inchainRev = NULL;
+ if (newto->ins) {
+ newto->ins->inchainRev = a;
}
- return n;
+ newto->ins = a;
+ newto->nins++;
}
/*
- - nonemptyins - count non-EMPTY in arcs of a state
- ^ static int nonemptyins(struct state *);
+ - hasnonemptyout - Does state have a non-EMPTY out arc?
+ ^ static int hasnonemptyout(struct state *);
*/
static int
-nonemptyins(
+hasnonemptyout(
struct state *s)
{
- int n = 0;
struct arc *a;
- for (a = s->ins; a != NULL; a = a->inchain) {
+ for (a = s->outs; a != NULL; a = a->outchain) {
if (a->type != EMPTY) {
- n++;
+ return 1;
}
}
- return n;
+ return 0;
}
/*
@@ -587,13 +581,181 @@ cparc(
{
newarc(nfa, oa->type, oa->co, from, to);
}
+
+/*
+ * sortins - sort the in arcs of a state by from/color/type
+ */
+static void
+sortins(
+ struct nfa * nfa,
+ struct state * s)
+{
+ struct arc **sortarray;
+ struct arc *a;
+ int n = s->nins;
+ int i;
+
+ if (n <= 1) {
+ return; /* nothing to do */
+ }
+ /* make an array of arc pointers ... */
+ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *));
+ if (sortarray == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ i = 0;
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ sortarray[i++] = a;
+ }
+ assert(i == n);
+ /* ... sort the array */
+ qsort(sortarray, n, sizeof(struct arc *), sortins_cmp);
+ /* ... and rebuild arc list in order */
+ /* it seems worth special-casing first and last items to simplify loop */
+ a = sortarray[0];
+ s->ins = a;
+ a->inchain = sortarray[1];
+ a->inchainRev = NULL;
+ for (i = 1; i < n - 1; i++) {
+ a = sortarray[i];
+ a->inchain = sortarray[i + 1];
+ a->inchainRev = sortarray[i - 1];
+ }
+ a = sortarray[i];
+ a->inchain = NULL;
+ a->inchainRev = sortarray[i - 1];
+ FREE(sortarray);
+}
+
+static int
+sortins_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct arc *aa = *((const struct arc * const *) a);
+ const struct arc *bb = *((const struct arc * const *) b);
+
+ /* we check the fields in the order they are most likely to be different */
+ if (aa->from->no < bb->from->no) {
+ return -1;
+ }
+ if (aa->from->no > bb->from->no) {
+ return 1;
+ }
+ if (aa->co < bb->co) {
+ return -1;
+ }
+ if (aa->co > bb->co) {
+ return 1;
+ }
+ if (aa->type < bb->type) {
+ return -1;
+ }
+ if (aa->type > bb->type) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * sortouts - sort the out arcs of a state by to/color/type
+ */
+static void
+sortouts(
+ struct nfa * nfa,
+ struct state * s)
+{
+ struct arc **sortarray;
+ struct arc *a;
+ int n = s->nouts;
+ int i;
+
+ if (n <= 1) {
+ return; /* nothing to do */
+ }
+ /* make an array of arc pointers ... */
+ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *));
+ if (sortarray == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ i = 0;
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ sortarray[i++] = a;
+ }
+ assert(i == n);
+ /* ... sort the array */
+ qsort(sortarray, n, sizeof(struct arc *), sortouts_cmp);
+ /* ... and rebuild arc list in order */
+ /* it seems worth special-casing first and last items to simplify loop */
+ a = sortarray[0];
+ s->outs = a;
+ a->outchain = sortarray[1];
+ a->outchainRev = NULL;
+ for (i = 1; i < n - 1; i++) {
+ a = sortarray[i];
+ a->outchain = sortarray[i + 1];
+ a->outchainRev = sortarray[i - 1];
+ }
+ a = sortarray[i];
+ a->outchain = NULL;
+ a->outchainRev = sortarray[i - 1];
+ FREE(sortarray);
+}
+
+static int
+sortouts_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct arc *aa = *((const struct arc * const *) a);
+ const struct arc *bb = *((const struct arc * const *) b);
+
+ /* we check the fields in the order they are most likely to be different */
+ if (aa->to->no < bb->to->no) {
+ return -1;
+ }
+ if (aa->to->no > bb->to->no) {
+ return 1;
+ }
+ if (aa->co < bb->co) {
+ return -1;
+ }
+ if (aa->co > bb->co) {
+ return 1;
+ }
+ if (aa->type < bb->type) {
+ return -1;
+ }
+ if (aa->type > bb->type) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * Common decision logic about whether to use arc-by-arc operations or
+ * sort/merge. If there's just a few source arcs we cannot recoup the
+ * cost of sorting the destination arc list, no matter how large it is.
+ * Otherwise, limit the number of arc-by-arc comparisons to about 1000
+ * (a somewhat arbitrary choice, but the breakeven point would probably
+ * be machine dependent anyway).
+ */
+#define BULK_ARC_OP_USE_SORT(nsrcarcs, ndestarcs) \
+ ((nsrcarcs) < 4 ? 0 : ((nsrcarcs) > 32 || (ndestarcs) > 32))
/*
- moveins - move all in arcs of a state to another state
* You might think this could be done better by just updating the
- * existing arcs, and you would be right if it weren't for the desire
+ * existing arcs, and you would be right if it weren't for the need
* for duplicate suppression, which makes it easier to just make new
* ones to exploit the suppression built into newarc.
+ *
+ * However, if we have a whole lot of arcs to deal with, retail duplicate
+ * checks become too slow. In that case we proceed by sorting and merging
+ * the arc lists, and then we can indeed just update the arcs in-place.
+ *
^ static void moveins(struct nfa *, struct state *, struct state *);
*/
static void
@@ -602,38 +764,253 @@ moveins(
struct state *oldState,
struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- while ((a = oldState->ins) != NULL) {
- cparc(nfa, a, a->from, newState);
- freearc(nfa, a);
+ if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ while ((a = oldState->ins) != NULL) {
+ cparc(nfa, a, a->from, newState);
+ freearc(nfa, a);
+ }
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note changearctarget()
+ * will put the arc onto the front of newState's chain, so it does not
+ * break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortins(nfa, oldState);
+ sortins(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->ins;
+ na = newState->ins;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortins_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->inchain;
+
+ /*
+ * Rather than doing createarc+freearc, we can just unlink
+ * and relink the existing arc struct.
+ */
+ changearctarget(a, newState);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->inchain;
+ na = na->inchain;
+ /* ... and drop duplicate arc from oldState */
+ freearc(nfa, a);
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->inchain;
+ changearctarget(a, newState);
+ }
}
+
assert(oldState->nins == 0);
assert(oldState->ins == NULL);
}
/*
- copyins - copy in arcs of a state to another state
- * Either all arcs, or only non-empty ones as determined by all value.
^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
*/
static void
copyins(
struct nfa *nfa,
struct state *oldState,
- struct state *newState,
- int all)
+ struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- for (a=oldState->ins ; a!=NULL ; a=a->inchain) {
- if (all || a->type != EMPTY) {
+ if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ for (a = oldState->ins; a != NULL; a = a->inchain) {
cparc(nfa, a, a->from, newState);
}
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortins(nfa, oldState);
+ sortins(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->ins;
+ na = newState->ins;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortins_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->inchain;
+ createarc(nfa, a->type, a->co, a->from, newState);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->inchain;
+ na = na->inchain;
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->inchain;
+ createarc(nfa, a->type, a->co, a->from, newState);
+ }
+ }
+}
+
+/*
+ * mergeins - merge a list of inarcs into a state
+ *
+ * This is much like copyins, but the source arcs are listed in an array,
+ * and are not guaranteed unique. It's okay to clobber the array contents.
+ */
+static void
+mergeins(
+ struct nfa * nfa,
+ struct state * s,
+ struct arc ** arcarray,
+ int arccount)
+{
+ struct arc *na;
+ int i;
+ int j;
+
+ if (arccount <= 0) {
+ return;
+ }
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ /* Sort existing inarcs as well as proposed new ones */
+ sortins(nfa, s);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+
+ qsort(arcarray, arccount, sizeof(struct arc *), sortins_cmp);
+
+ /*
+ * arcarray very likely includes dups, so we must eliminate them. (This
+ * could be folded into the next loop, but it's not worth the trouble.)
+ */
+ j = 0;
+ for (i = 1; i < arccount; i++) {
+ switch (sortins_cmp(&arcarray[j], &arcarray[i])) {
+ case -1:
+ /* non-dup */
+ arcarray[++j] = arcarray[i];
+ break;
+ case 0:
+ /* dup */
+ break;
+ default:
+ /* trouble */
+ assert(NOTREACHED);
+ }
+ }
+ arccount = j + 1;
+
+ /*
+ * Now merge into s' inchain. Note that createarc() will put new arcs
+ * onto the front of s's chain, so it does not break our walk through the
+ * sorted part of the chain.
+ */
+ i = 0;
+ na = s->ins;
+ while (i < arccount && na != NULL) {
+ struct arc *a = arcarray[i];
+
+ switch (sortins_cmp(&a, &na)) {
+ case -1:
+ /* s does not have anything matching a */
+ createarc(nfa, a->type, a->co, a->from, s);
+ i++;
+ break;
+ case 0:
+ /* match, advance in both lists */
+ i++;
+ na = na->inchain;
+ break;
+ case +1:
+ /* advance only na; array might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (i < arccount) {
+ /* s does not have anything matching a */
+ struct arc *a = arcarray[i];
+
+ createarc(nfa, a->type, a->co, a->from, s);
+ i++;
}
}
@@ -647,36 +1024,153 @@ moveouts(
struct state *oldState,
struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- while ((a = oldState->outs) != NULL) {
- cparc(nfa, a, newState, a->to);
- freearc(nfa, a);
+ if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ while ((a = oldState->outs) != NULL) {
+ cparc(nfa, a, newState, a->to);
+ freearc(nfa, a);
+ }
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortouts(nfa, oldState);
+ sortouts(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->outs;
+ na = newState->outs;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortouts_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ freearc(nfa, a);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->outchain;
+ na = na->outchain;
+ /* ... and drop duplicate arc from oldState */
+ freearc(nfa, a);
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->outchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ freearc(nfa, a);
+ }
}
+
+ assert(oldState->nouts == 0);
+ assert(oldState->outs == NULL);
}
/*
- copyouts - copy out arcs of a state to another state
- * Either all arcs, or only non-empty ones as determined by all value.
^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
*/
static void
copyouts(
struct nfa *nfa,
struct state *oldState,
- struct state *newState,
- int all)
+ struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- for (a=oldState->outs ; a!=NULL ; a=a->outchain) {
- if (all || a->type != EMPTY) {
+ if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ for (a = oldState->outs; a != NULL; a = a->outchain) {
cparc(nfa, a, newState, a->to);
}
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortouts(nfa, oldState);
+ sortouts(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->outs;
+ na = newState->outs;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortouts_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->outchain;
+ na = na->outchain;
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->outchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ }
}
}
@@ -895,6 +1389,20 @@ specialcolors(
- optimize - optimize an NFA
^ static long optimize(struct nfa *, FILE *);
*/
+
+ /*
+ * The main goal of this function is not so much "optimization" (though it
+ * does try to get rid of useless NFA states) as reducing the NFA to a form
+ * the regex executor can handle. The executor, and indeed the cNFA format
+ * that is its input, can only handle PLAIN and LACON arcs. The output of
+ * the regex parser also includes EMPTY (do-nothing) arcs, as well as
+ * ^, $, AHEAD, and BEHIND constraint arcs, which we must get rid of here.
+ * We first get rid of EMPTY arcs and then deal with the constraint arcs.
+ * The hardest part of either job is to get rid of circular loops of the
+ * target arc type. We would have to do that in any case, though, as such a
+ * loop would otherwise allow the executor to cycle through the loop endlessly
+ * without making any progress in the input string.
+ */
static long /* re_info bits */
optimize(
struct nfa *nfa,
@@ -916,17 +1424,23 @@ optimize(
if (verbose) {
fprintf(f, "\nconstraints:\n");
}
+ fixconstraintloops(nfa, f); /* get rid of constraint loops */
pullback(nfa, f); /* pull back constraints backward */
pushfwd(nfa, f); /* push fwd constraints forward */
if (verbose) {
fprintf(f, "\nfinal cleanup:\n");
}
cleanup(nfa); /* final tidying */
+#ifdef REG_DEBUG
+ if (verbose) {
+ dumpnfa(nfa, f);
+ }
+#endif
return analyze(nfa); /* and analysis */
}
/*
- - pullback - pull back constraints backward to (with luck) eliminate them
+ - pullback - pull back constraints backward to eliminate them
^ static void pullback(struct nfa *, FILE *);
*/
static void
@@ -938,6 +1452,7 @@ pullback(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ struct state *intermediates;
int progress;
/*
@@ -948,15 +1463,27 @@ pullback(
progress = 0;
for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
nexts = s->next;
+ intermediates = NULL;
for (a=s->outs ; a!=NULL && !NISERR() ; a=nexta) {
nexta = a->outchain;
if (a->type == '^' || a->type == BEHIND) {
- if (pull(nfa, a)) {
+ if (pull(nfa, a, &intermediates)) {
progress = 1;
}
}
assert(nexta == NULL || s->no != FREESTATE);
}
+ /* clear tmp fields of intermediate states created here */
+ while (intermediates != NULL) {
+ struct state *ns = intermediates->tmp;
+
+ intermediates->tmp = NULL;
+ intermediates = ns;
+ }
+ /* if s is now useless, get rid of it */
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
+ }
}
if (progress && f != NULL) {
dumpnfa(nfa, f);
@@ -966,6 +1493,12 @@ pullback(
return;
}
+ /*
+ * Any ^ constraints we were able to pull to the start state can now be
+ * replaced by PLAIN arcs referencing the BOS or BOL colors. There should
+ * be no other ^ or BEHIND arcs left in the NFA, though we do not check
+ * that here (compact() will fail if so).
+ */
for (a=nfa->pre->outs ; a!=NULL ; a=nexta) {
nexta = a->outchain;
if (a->type == '^') {
@@ -978,15 +1511,28 @@ pullback(
/*
- pull - pull a back constraint backward past its source state
- * A significant property of this function is that it deletes at most
- * one state -- the constraint's from state -- and only if the constraint
- * was that state's last outarc.
+ *
+ * Returns 1 if successful (which it always is unless the source is the
+ * start state or we have an internal error), 0 if nothing happened.
+ *
+ * A significant property of this function is that it deletes no pre-existing
+ * states, and no outarcs of the constraint's from state other than the given
+ * constraint arc. This makes the loops in pullback() safe, at the cost that
+ * we may leave useless states behind. Therefore, we leave it to pullback()
+ * to delete such states.
+ *
+ * If the from state has multiple back-constraint outarcs, and/or multiple
+ * compatible constraint inarcs, we only need to create one new intermediate
+ * state per combination of predecessor and successor states. *intermediates
+ * points to a list of such intermediate states for this from state (chained
+ * through their tmp fields).
^ static int pull(struct nfa *, struct arc *);
*/
-static int /* 0 couldn't, 1 could */
+static int
pull(
struct nfa *nfa,
- struct arc *con)
+ struct arc *con,
+ struct state **intermediates)
{
struct state *from = con->from;
struct state *to = con->to;
@@ -994,10 +1540,7 @@ pull(
struct arc *nexta;
struct state *s;
- if (from == to) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
+ assert(from != to); /* should have gotten rid of this earlier */
if (from->flag) { /* can't pull back beyond start */
return 0;
}
@@ -1007,26 +1550,9 @@ pull(
}
/*
- * DGP 2007-11-15: Cloning a state with a circular constraint on its list
- * of outs can lead to trouble [Bug 1810038], so get rid of them first.
- */
-
- for (a = from->outs; a != NULL; a = nexta) {
- nexta = a->outchain;
- switch (a->type) {
- case '^':
- case '$':
- case BEHIND:
- case AHEAD:
- if (from == a->to) {
- freearc(nfa, a);
- }
- break;
- }
- }
-
- /*
- * First, clone from state if necessary to avoid other outarcs.
+ * First, clone from state if necessary to avoid other outarcs. This may
+ * seem wasteful, but it simplifies the logic, and we'll get rid of the
+ * clone state again at the bottom.
*/
if (from->nouts > 1) {
@@ -1034,10 +1560,12 @@ pull(
if (NISERR()) {
return 0;
}
- assert(to != from); /* con is not an inarc */
- copyins(nfa, from, s, 1); /* duplicate inarcs */
+ copyins(nfa, from, s); /* duplicate inarcs */
cparc(nfa, con, s, to); /* move constraint arc */
freearc(nfa, con);
+ if (NISERR()) {
+ return 0;
+ }
from = s;
con = from->outs;
}
@@ -1047,7 +1575,7 @@ pull(
* Propagate the constraint into the from state's inarcs.
*/
- for (a=from->ins ; a!=NULL ; a=nexta) {
+ for (a=from->ins ; a!=NULL && !NISERR(); a=nexta) {
nexta = a->inchain;
switch (combine(con, a)) {
case INCOMPATIBLE: /* destroy the arc */
@@ -1056,17 +1584,25 @@ pull(
case SATISFIED: /* no action needed */
break;
case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR()) {
- return 0;
+ /* need an intermediate state, but might have one already */
+ for (s = *intermediates; s != NULL; s = s->tmp) {
+ assert(s->nins > 0 && s->nouts > 0);
+ if (s->ins->from == a->from && s->outs->to == to) {
+ break;
+ }
}
- cparc(nfa, a, s, to); /* anticipate move */
- cparc(nfa, con, a->from, s);
- if (NISERR()) {
- return 0;
+ if (s == NULL) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ s->tmp = *intermediates;
+ *intermediates = s;
}
- freearc(nfa, a);
- break;
+ cparc(nfa, con, a->from, s);
+ cparc(nfa, a, s, to);
+ freearc(nfa, a);
+ break;
default:
assert(NOTREACHED);
break;
@@ -1078,12 +1614,13 @@ pull(
*/
moveins(nfa, from, to);
- dropstate(nfa, from); /* will free the constraint */
+ freearc(nfa, con);
+ /* from state is now useless, but we leave it to pullback() to clean up */
return 1;
}
/*
- - pushfwd - push forward constraints forward to (with luck) eliminate them
+ - pushfwd - push forward constraints forward to eliminate them
^ static void pushfwd(struct nfa *, FILE *);
*/
static void
@@ -1095,6 +1632,7 @@ pushfwd(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ struct state *intermediates;
int progress;
/*
@@ -1105,14 +1643,25 @@ pushfwd(
progress = 0;
for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
nexts = s->next;
+ intermediates = NULL;
for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
nexta = a->inchain;
if (a->type == '$' || a->type == AHEAD) {
- if (push(nfa, a)) {
+ if (push(nfa, a, &intermediates)) {
progress = 1;
}
}
- assert(nexta == NULL || s->no != FREESTATE);
+ }
+ /* clear tmp fields of intermediate states created here */
+ while (intermediates != NULL) {
+ struct state *ns = intermediates->tmp;
+
+ intermediates->tmp = NULL;
+ intermediates = ns;
+ }
+ /* if s is now useless, get rid of it */
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
}
}
if (progress && f != NULL) {
@@ -1123,6 +1672,12 @@ pushfwd(
return;
}
+ /*
+ * Any $ constraints we were able to push to the post state can now be
+ * replaced by PLAIN arcs referencing the EOS or EOL colors. There should
+ * be no other $ or AHEAD arcs left in the NFA, though we do not check
+ * that here (compact() will fail if so).
+ */
for (a = nfa->post->ins; a != NULL; a = nexta) {
nexta = a->inchain;
if (a->type == '$') {
@@ -1135,15 +1690,28 @@ pushfwd(
/*
- push - push a forward constraint forward past its destination state
- * A significant property of this function is that it deletes at most
- * one state -- the constraint's to state -- and only if the constraint
- * was that state's last inarc.
+ *
+ * Returns 1 if successful (which it always is unless the destination is the
+ * post state or we have an internal error), 0 if nothing happened.
+ *
+ * A significant property of this function is that it deletes no pre-existing
+ * states, and no inarcs of the constraint's to state other than the given
+ * constraint arc. This makes the loops in pushfwd() safe, at the cost that
+ * we may leave useless states behind. Therefore, we leave it to pushfwd()
+ * to delete such states.
+ *
+ * If the to state has multiple forward-constraint inarcs, and/or multiple
+ * compatible constraint outarcs, we only need to create one new intermediate
+ * state per combination of predecessor and successor states. *intermediates
+ * points to a list of such intermediate states for this to state (chained
+ * through their tmp fields).
^ static int push(struct nfa *, struct arc *);
*/
-static int /* 0 couldn't, 1 could */
+static int
push(
struct nfa *nfa,
- struct arc *con)
+ struct arc *con,
+ struct state **intermediates)
{
struct state *from = con->from;
struct state *to = con->to;
@@ -1151,10 +1719,7 @@ push(
struct arc *nexta;
struct state *s;
- if (to == from) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
+ assert(to != from); /* should have gotten rid of this earlier */
if (to->flag) { /* can't push forward beyond end */
return 0;
}
@@ -1164,29 +1729,9 @@ push(
}
/*
- * DGP 2007-11-15: Here we duplicate the same protections as appear
- * in pull() above to avoid troubles with cloning a state with a
- * circular constraint on its list of ins. It is not clear whether
- * this is necessary, or is protecting against a "can't happen".
- * Any test case that actually leads to a freearc() call here would
- * be a welcome addition to the test suite.
- */
-
- for (a = to->ins; a != NULL; a = nexta) {
- nexta = a->inchain;
- switch (a->type) {
- case '^':
- case '$':
- case BEHIND:
- case AHEAD:
- if (a->from == to) {
- freearc(nfa, a);
- }
- break;
- }
- }
- /*
- * First, clone to state if necessary to avoid other inarcs.
+ * First, clone to state if necessary to avoid other inarcs. This may
+ * seem wasteful, but it simplifies the logic, and we'll get rid of the
+ * clone state again at the bottom.
*/
if (to->nins > 1) {
@@ -1194,9 +1739,12 @@ push(
if (NISERR()) {
return 0;
}
- copyouts(nfa, to, s, 1); /* duplicate outarcs */
- cparc(nfa, con, from, s); /* move constraint */
+ copyouts(nfa, to, s); /* duplicate outarcs */
+ cparc(nfa, con, from, s); /* move constraint arc */
freearc(nfa, con);
+ if (NISERR()) {
+ return 0;
+ }
to = s;
con = to->ins;
}
@@ -1206,7 +1754,7 @@ push(
* Propagate the constraint into the to state's outarcs.
*/
- for (a = to->outs; a != NULL; a = nexta) {
+ for (a = to->outs; a != NULL && !NISERR(); a = nexta) {
nexta = a->outchain;
switch (combine(con, a)) {
case INCOMPATIBLE: /* destroy the arc */
@@ -1215,17 +1763,25 @@ push(
case SATISFIED: /* no action needed */
break;
case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR()) {
- return 0;
+ /* need an intermediate state, but might have one already */
+ for (s = *intermediates; s != NULL; s = s->tmp) {
+ assert(s->nins > 0 && s->nouts > 0);
+ if (s->ins->from == from && s->outs->to == a->to) {
+ break;
+ }
}
- cparc(nfa, con, s, a->to); /* anticipate move */
- cparc(nfa, a, from, s);
- if (NISERR()) {
- return 0;
+ if (s == NULL) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ s->tmp = *intermediates;
+ *intermediates = s;
}
- freearc(nfa, a);
- break;
+ cparc(nfa, con, s, a->to);
+ cparc(nfa, a, from, s);
+ freearc(nfa, a);
+ break;
default:
assert(NOTREACHED);
break;
@@ -1237,7 +1793,8 @@ push(
*/
moveouts(nfa, to, from);
- dropstate(nfa, to); /* will free the constraint */
+ freearc(nfa, con);
+ /* to state is now useless, but we leave it to pushfwd() to clean up */
return 1;
}
@@ -1315,6 +1872,12 @@ fixempties(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ int totalinarcs;
+ struct arc **inarcsorig;
+ struct arc **arcarray;
+ int arccount;
+ int prevnins;
+ int nskip;
/*
* First, get rid of any states whose sole out-arc is an EMPTY,
@@ -1345,7 +1908,7 @@ fixempties(
for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
nexts = s->next;
/* Ensure tmp fields are clear for next step */
- assert(s->tmp = NULL);
+ assert(s->tmp == NULL);
if (s->flag || s->nins != 1) {
continue;
}
@@ -1360,42 +1923,129 @@ fixempties(
dropstate(nfa, s);
}
+ if (NISERR()) {
+ return;
+ }
+
/*
- * For each remaining NFA state, find all other states that are
- * reachable from it by a chain of one or more EMPTY arcs. Then
- * generate new arcs that eliminate the need for each such chain.
+ * For each remaining NFA state, find all other states from which it is
+ * reachable by a chain of one or more EMPTY arcs. Then generate new arcs
+ * that eliminate the need for each such chain.
+ *
+ * We could replace a chain of EMPTY arcs that leads from a "from" state
+ * to a "to" state either by pushing non-EMPTY arcs forward (linking
+ * directly from "from"'s predecessors to "to") or by pulling them back
+ * (linking directly from "from" to "to"'s successors). We choose to
+ * always do the former; this choice is somewhat arbitrary, but the
+ * approach below requires that we uniformly do one or the other.
+ *
+ * Suppose we have a chain of N successive EMPTY arcs (where N can easily
+ * approach the size of the NFA). All of the intermediate states must
+ * have additional inarcs and outarcs, else they'd have been removed by
+ * the steps above. Assuming their inarcs are mostly not empties, we will
+ * add O(N^2) arcs to the NFA, since a non-EMPTY inarc leading to any one
+ * state in the chain must be duplicated to lead to all its successor
+ * states as well. So there is no hope of doing less than O(N^2) work;
+ * however, we should endeavor to keep the big-O cost from being even
+ * worse than that, which it can easily become without care. In
+ * particular, suppose we were to copy all S1's inarcs forward to S2, and
+ * then also to S3, and then later we consider pushing S2's inarcs forward
+ * to S3. If we include the arcs already copied from S1 in that, we'd be
+ * doing O(N^3) work. (The duplicate-arc elimination built into newarc()
+ * and its cohorts would get rid of the extra arcs, but not without cost.)
*
- * If we just do this straightforwardly, the algorithm gets slow in
- * complex graphs, because the same arcs get copied to all
- * intermediate states of an EMPTY chain, and then uselessly pushed
- * repeatedly to the chain's final state; we waste a lot of time in
- * newarc's duplicate checking. To improve matters, we decree that
- * any state with only EMPTY out-arcs is "doomed" and will not be
- * part of the final NFA. That can be ensured by not adding any new
- * out-arcs to such a state. Having ensured that, we need not update
- * the state's in-arcs list either; all arcs that might have gotten
- * pushed forward to it will just get pushed directly to successor
- * states. This eliminates most of the useless duplicate arcs.
+ * We can avoid this cost by treating only arcs that existed at the start
+ * of this phase as candidates to be pushed forward. To identify those,
+ * we remember the first inarc each state had to start with. We rely on
+ * the fact that newarc() and friends put new arcs on the front of their
+ * to-states' inchains, and that this phase never deletes arcs, so that
+ * the original arcs must be the last arcs in their to-states' inchains.
+ *
+ * So the process here is that, for each state in the NFA, we gather up
+ * all non-EMPTY inarcs of states that can reach the target state via
+ * EMPTY arcs. We then sort, de-duplicate, and merge these arcs into the
+ * target state's inchain. (We can safely use sort-merge for this as long
+ * as we update each state's original-arcs pointer after we add arcs to
+ * it; the sort step of mergeins probably changed the order of the old
+ * arcs.)
+ *
+ * Another refinement worth making is that, because we only add non-EMPTY
+ * arcs during this phase, and all added arcs have the same from-state as
+ * the non-EMPTY arc they were cloned from, we know ahead of time that any
+ * states having only EMPTY outarcs will be useless for lack of outarcs
+ * after we drop the EMPTY arcs. (They cannot gain non-EMPTY outarcs if
+ * they had none to start with.) So we need not bother to update the
+ * inchains of such states at all.
+ */
+
+ /* Remember the states' first original inarcs */
+ /* ... and while at it, count how many old inarcs there are altogether */
+ inarcsorig = (struct arc **) MALLOC(nfa->nstates * sizeof(struct arc *));
+ if (inarcsorig == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ totalinarcs = 0;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ inarcsorig[s->no] = s->ins;
+ totalinarcs += s->nins;
+ }
+
+ /*
+ * Create a workspace for accumulating the inarcs to be added to the
+ * current target state. totalinarcs is probably a considerable
+ * overestimate of the space needed, but the NFA is unlikely to be large
+ * enough at this point to make it worth being smarter.
*/
+ arcarray = (struct arc **) MALLOC(totalinarcs * sizeof(struct arc *));
+ if (arcarray == NULL) {
+ NERR(REG_ESPACE);
+ FREE(inarcsorig);
+ return;
+ }
+
+ /* And iterate over the target states */
for (s = nfa->states; s != NULL && !NISERR(); s = s->next) {
- for (s2 = emptyreachable(s, s); s2 != s && !NISERR();
- s2 = nexts) {
- /*
- * If s2 is doomed, we decide that (1) we will always push
- * arcs forward to it, not pull them back to s; and (2) we
- * can optimize away the push-forward, per comment above.
- * So do nothing.
- */
- if (s2->flag || hasnonemptyout(s2)) {
- replaceempty(nfa, s, s2);
+ /* Ignore target states without non-EMPTY outarcs, per note above */
+ if (!s->flag && !hasnonemptyout(s)) {
+ continue;
+ }
+
+ /* Find predecessor states and accumulate their original inarcs */
+ arccount = 0;
+ for (s2 = emptyreachable(nfa, s, s, inarcsorig); s2 != s; s2 = nexts) {
+ /* Add s2's original inarcs to arcarray[], but ignore empties */
+ for (a = inarcsorig[s2->no]; a != NULL; a = a->inchain) {
+ if (a->type != EMPTY) {
+ arcarray[arccount++] = a;
+ }
}
- /* Reset the tmp fields as we walk back */
- nexts = s2->tmp;
- s2->tmp = NULL;
+ /* Reset the tmp fields as we walk back */
+ nexts = s2->tmp;
+ s2->tmp = NULL;
+ }
+ s->tmp = NULL;
+ assert(arccount <= totalinarcs);
+
+ /* Remember how many original inarcs this state has */
+ prevnins = s->nins;
+
+ /* Add non-duplicate inarcs to target state */
+ mergeins(nfa, s, arcarray, arccount);
+
+ /* Now we must update the state's inarcsorig pointer */
+ nskip = s->nins - prevnins;
+ a = s->ins;
+ while (nskip-- > 0) {
+ a = a->inchain;
}
- s->tmp = NULL;
+ inarcsorig[s->no] = a;
}
+
+ FREE(arcarray);
+ FREE(inarcsorig);
+
if (NISERR()) {
return;
}
@@ -1431,89 +2081,604 @@ fixempties(
}
/*
- - emptyreachable - recursively find all states reachable from s by EMPTY arcs
+ - emptyreachable - recursively find all states that can reach s by EMPTY arcs
* The return value is the last such state found. Its tmp field links back
* to the next-to-last such state, and so on back to s, so that all these
* states can be located without searching the whole NFA.
+ *
+ * Since this is only used in fixempties(), we pass in the inarcsorig[] array
+ * maintained by that function. This lets us skip over all new inarcs, which
+ * are certainly not EMPTY arcs.
+ *
* The maximum recursion depth here is equal to the length of the longest
* loop-free chain of EMPTY arcs, which is surely no more than the size of
- * the NFA, and in practice will be a lot less than that.
+ * the NFA, and in practice will be less than that.
^ static struct state *emptyreachable(struct state *, struct state *);
*/
static struct state *
emptyreachable(
+ struct nfa *nfa,
struct state *s,
- struct state *lastfound)
+ struct state *lastfound,
+ struct arc **inarcsorig)
{
struct arc *a;
s->tmp = lastfound;
lastfound = s;
- for (a = s->outs; a != NULL; a = a->outchain) {
- if (a->type == EMPTY && a->to->tmp == NULL) {
- lastfound = emptyreachable(a->to, lastfound);
+ for (a = inarcsorig[s->no]; a != NULL; a = a->inchain) {
+ if (a->type == EMPTY && a->from->tmp == NULL) {
+ lastfound = emptyreachable(nfa, a->from, lastfound, inarcsorig);
}
}
return lastfound;
}
-
+
/*
- - replaceempty - replace an EMPTY arc chain with some non-empty arcs
- * The EMPTY arc(s) should be deleted later, but we can't do it here because
- * they may still be needed to identify other arc chains during fixempties().
- ^ static void replaceempty(struct nfa *, struct state *, struct state *);
+ * isconstraintarc - detect whether an arc is of a constraint type
+ */
+static inline int
+isconstraintarc(struct arc * a)
+{
+ switch (a->type)
+ {
+ case '^':
+ case '$':
+ case BEHIND:
+ case AHEAD:
+ case LACON:
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * hasconstraintout - does state have a constraint out arc?
+ */
+static int
+hasconstraintout(struct state * s)
+{
+ struct arc *a;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (isconstraintarc(a)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ * fixconstraintloops - get rid of loops containing only constraint arcs
+ *
+ * A loop of states that contains only constraint arcs is useless, since
+ * passing around the loop represents no forward progress. Moreover, it
+ * would cause infinite looping in pullback/pushfwd, so we need to get rid
+ * of such loops before doing that.
*/
static void
-replaceempty(
- struct nfa *nfa,
- struct state *from,
- struct state *to)
+fixconstraintloops(
+ struct nfa * nfa,
+ FILE *f) /* for debug output; NULL none */
{
- int fromouts;
- int toins;
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int hasconstraints;
+
+ /*
+ * In the trivial case of a state that loops to itself, we can just drop
+ * the constraint arc altogether. This is worth special-casing because
+ * such loops are far more common than loops containing multiple states.
+ * While we're at it, note whether any constraint arcs survive.
+ */
+ hasconstraints = 0;
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ /* while we're at it, ensure tmp fields are clear for next step */
+ assert(s->tmp == NULL);
+ for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+ nexta = a->outchain;
+ if (isconstraintarc(a)) {
+ if (a->to == s) {
+ freearc(nfa, a);
+ } else {
+ hasconstraints = 1;
+ }
+ }
+ }
+ /* If we removed all the outarcs, the state is useless. */
+ if (s->nouts == 0 && !s->flag) {
+ dropstate(nfa, s);
+ }
+ }
- assert(from != to);
+ /* Nothing to do if no remaining constraint arcs */
+ if (NISERR() || !hasconstraints) {
+ return;
+ }
/*
- * Create replacement arcs that bypass the need for the EMPTY chain. We
- * can do this either by pushing arcs forward (linking directly from
- * "from"'s predecessors to "to") or by pulling them back (linking
- * directly from "from" to "to"'s successors). In general, we choose
- * whichever way creates greater fan-out or fan-in, so as to improve the
- * odds of reducing the other state to zero in-arcs or out-arcs and
- * thereby being able to delete it. However, if "from" is doomed (has no
- * non-EMPTY out-arcs), we must keep it so, so always push forward in that
- * case.
+ * Starting from each remaining NFA state, search outwards for a
+ * constraint loop. If we find a loop, break the loop, then start the
+ * search over. (We could possibly retain some state from the first scan,
+ * but it would complicate things greatly, and multi-state constraint
+ * loops are rare enough that it's not worth optimizing the case.)
+ */
+ restart:
+ for (s = nfa->states; s != NULL && !NISERR(); s = s->next) {
+ if (findconstraintloop(nfa, s)) {
+ goto restart;
+ }
+ }
+
+ if (NISERR()) {
+ return;
+ }
+
+ /*
+ * Now remove any states that have become useless. (This cleanup is not
+ * very thorough, and would be even less so if we tried to combine it with
+ * the previous step; but cleanup() will take care of anything we miss.)
*
- * The fan-out/fan-in comparison should count only non-EMPTY arcs. If
- * "from" is doomed, we can skip counting "to"'s arcs, since we want to
- * force taking the copynonemptyins path in that case.
+ * Because findconstraintloop intentionally doesn't reset all tmp fields,
+ * we have to clear them after it's done. This is a convenient place to
+ * do that, too.
*/
- fromouts = nonemptyouts(from);
- toins = (fromouts == 0) ? 1 : nonemptyins(to);
+ for (s = nfa->states; s != NULL; s = nexts) {
+ nexts = s->next;
+ s->tmp = NULL;
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
+ }
+ }
+
+ if (f != NULL) {
+ dumpnfa(nfa, f);
+ }
+}
- if (fromouts > toins) {
- copyouts(nfa, to, from, 0);
+/*
+ * findconstraintloop - recursively find a loop of constraint arcs
+ *
+ * If we find a loop, break it by calling breakconstraintloop(), then
+ * return 1; otherwise return 0.
+ *
+ * State tmp fields are guaranteed all NULL on a success return, because
+ * breakconstraintloop does that. After a failure return, any state that
+ * is known not to be part of a loop is marked with s->tmp == s; this allows
+ * us not to have to re-prove that fact on later calls. (This convention is
+ * workable because we already eliminated single-state loops.)
+ *
+ * Note that the found loop doesn't necessarily include the first state we
+ * are called on. Any loop reachable from that state will do.
+ *
+ * The maximum recursion depth here is one more than the length of the longest
+ * loop-free chain of constraint arcs, which is surely no more than the size
+ * of the NFA, and in practice will be a lot less than that.
+ */
+static int
+findconstraintloop(struct nfa * nfa, struct state * s)
+{
+ struct arc *a;
+
+ /* Since this is recursive, it could be driven to stack overflow */
+ if (STACK_TOO_DEEP(nfa->v->re)) {
+ NERR(REG_ETOOBIG);
+ return 1; /* to exit as quickly as possible */
+ }
+
+ if (s->tmp != NULL) {
+ /* Already proven uninteresting? */
+ if (s->tmp == s) {
+ return 0;
+ }
+ /* Found a loop involving s */
+ breakconstraintloop(nfa, s);
+ /* The tmp fields have been cleaned up by breakconstraintloop */
+ return 1;
+ }
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (isconstraintarc(a)) {
+ struct state *sto = a->to;
+
+ assert(sto != s);
+ s->tmp = sto;
+ if (findconstraintloop(nfa, sto)) {
+ return 1;
+ }
+ }
+ }
+
+ /*
+ * If we get here, no constraint loop exists leading out from s. Mark it
+ * with s->tmp == s so we need not rediscover that fact again later.
+ */
+ s->tmp = s;
+ return 0;
+}
+
+/*
+ * breakconstraintloop - break a loop of constraint arcs
+ *
+ * sinitial is any one member state of the loop. Each loop member's tmp
+ * field links to its successor within the loop. (Note that this function
+ * will reset all the tmp fields to NULL.)
+ *
+ * We can break the loop by, for any one state S1 in the loop, cloning its
+ * loop successor state S2 (and possibly following states), and then moving
+ * all S1->S2 constraint arcs to point to the cloned S2. The cloned S2 should
+ * copy any non-constraint outarcs of S2. Constraint outarcs should be
+ * dropped if they point back to S1, else they need to be copied as arcs to
+ * similarly cloned states S3, S4, etc. In general, each cloned state copies
+ * non-constraint outarcs, drops constraint outarcs that would lead to itself
+ * or any earlier cloned state, and sends other constraint outarcs to newly
+ * cloned states. No cloned state will have any inarcs that aren't constraint
+ * arcs or do not lead from S1 or earlier-cloned states. It's okay to drop
+ * constraint back-arcs since they would not take us to any state we've not
+ * already been in; therefore, no new constraint loop is created. In this way
+ * we generate a modified NFA that can still represent every useful state
+ * sequence, but not sequences that represent state loops with no consumption
+ * of input data. Note that the set of cloned states will certainly include
+ * all of the loop member states other than S1, and it may also include
+ * non-loop states that are reachable from S2 via constraint arcs. This is
+ * important because there is no guarantee that findconstraintloop found a
+ * maximal loop (and searching for one would be NP-hard, so don't try).
+ * Frequently the "non-loop states" are actually part of a larger loop that
+ * we didn't notice, and indeed there may be several overlapping loops.
+ * This technique ensures convergence in such cases, while considering only
+ * the originally-found loop does not.
+ *
+ * If there is only one S1->S2 constraint arc, then that constraint is
+ * certainly satisfied when we enter any of the clone states. This means that
+ * in the common case where many of the constraint arcs are identically
+ * labeled, we can merge together clone states linked by a similarly-labeled
+ * constraint: if we can get to the first one we can certainly get to the
+ * second, so there's no need to distinguish. This greatly reduces the number
+ * of new states needed, so we preferentially break the given loop at a state
+ * pair where this is true.
+ *
+ * Furthermore, it's fairly common to find that a cloned successor state has
+ * no outarcs, especially if we're a bit aggressive about removing unnecessary
+ * outarcs. If that happens, then there is simply not any interesting state
+ * that can be reached through the predecessor's loop arcs, which means we can
+ * break the loop just by removing those loop arcs, with no new states added.
+ */
+static void
+breakconstraintloop(struct nfa * nfa, struct state * sinitial)
+{
+ struct state *s;
+ struct state *shead;
+ struct state *stail;
+ struct state *sclone;
+ struct state *nexts;
+ struct arc *refarc;
+ struct arc *a;
+ struct arc *nexta;
+
+ /*
+ * Start by identifying which loop step we want to break at.
+ * Preferentially this is one with only one constraint arc. (XXX are
+ * there any other secondary heuristics we want to use here?) Set refarc
+ * to point to the selected lone constraint arc, if there is one.
+ */
+ refarc = NULL;
+ s = sinitial;
+ do {
+ nexts = s->tmp;
+ assert(nexts != s); /* should not see any one-element loops */
+ if (refarc == NULL) {
+ int narcs = 0;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (a->to == nexts && isconstraintarc(a)) {
+ refarc = a;
+ narcs++;
+ }
+ }
+ assert(narcs > 0);
+ if (narcs > 1) {
+ refarc = NULL; /* multiple constraint arcs here, no good */
+ }
+ }
+ s = nexts;
+ } while (s != sinitial);
+
+ if (refarc) {
+ /* break at the refarc */
+ shead = refarc->from;
+ stail = refarc->to;
+ assert(stail == shead->tmp);
+ } else {
+ /* for lack of a better idea, break after sinitial */
+ shead = sinitial;
+ stail = sinitial->tmp;
+ }
+
+ /*
+ * Reset the tmp fields so that we can use them for local storage in
+ * clonesuccessorstates. (findconstraintloop won't mind, since it's just
+ * going to abandon its search anyway.)
+ */
+ for (s = nfa->states; s != NULL; s = s->next) {
+ s->tmp = NULL;
+ }
+
+ /*
+ * Recursively build clone state(s) as needed.
+ */
+ sclone = newstate(nfa);
+ if (sclone == NULL) {
+ assert(NISERR());
return;
}
- if (fromouts < toins) {
- copyins(nfa, from, to, 0);
+
+ clonesuccessorstates(nfa, stail, sclone, shead, refarc,
+ NULL, NULL, nfa->nstates);
+
+ if (NISERR()) {
return;
}
/*
- * fromouts == toins. Decide on secondary issue: copy fewest arcs.
- *
- * Doesn't seem to be worth the trouble to exclude empties from these
- * comparisons; that takes extra time and doesn't seem to improve the
- * resulting graph much.
+ * It's possible that sclone has no outarcs at all, in which case it's
+ * useless. (We don't try extremely hard to get rid of useless states
+ * here, but this is an easy and fairly common case.)
+ */
+ if (sclone->nouts == 0) {
+ freestate(nfa, sclone);
+ sclone = NULL;
+ }
+
+ /*
+ * Move shead's constraint-loop arcs to point to sclone, or just drop them
+ * if we discovered we don't need sclone.
*/
- if (from->nins > to->nouts) {
- copyouts(nfa, to, from, 0);
+ for (a = shead->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ if (a->to == stail && isconstraintarc(a)) {
+ if (sclone) {
+ cparc(nfa, a, shead, sclone);
+ }
+ freearc(nfa, a);
+ if (NISERR()) {
+ break;
+ }
+ }
+ }
+}
+
+/*
+ * clonesuccessorstates - create a tree of constraint-arc successor states
+ *
+ * ssource is the state to be cloned, and sclone is the state to copy its
+ * outarcs into. sclone's inarcs, if any, should already be set up.
+ *
+ * spredecessor is the original predecessor state that we are trying to build
+ * successors for (it may not be the immediate predecessor of ssource).
+ * refarc, if not NULL, is the original constraint arc that is known to have
+ * been traversed out of spredecessor to reach the successor(s).
+ *
+ * For each cloned successor state, we transiently create a "donemap" that is
+ * a boolean array showing which source states we've already visited for this
+ * clone state. This prevents infinite recursion as well as useless repeat
+ * visits to the same state subtree (which can add up fast, since typical NFAs
+ * have multiple redundant arc pathways). Each donemap is a char array
+ * indexed by state number. The donemaps are all of the same size "nstates",
+ * which is nfa->nstates as of the start of the recursion. This is enough to
+ * have entries for all pre-existing states, but *not* entries for clone
+ * states created during the recursion. That's okay since we have no need to
+ * mark those.
+ *
+ * curdonemap is NULL when recursing to a new sclone state, or sclone's
+ * donemap when we are recursing without having created a new state (which we
+ * do when we decide we can merge a successor state into the current clone
+ * state). outerdonemap is NULL at the top level and otherwise the parent
+ * clone state's donemap.
+ *
+ * The successor states we create and fill here form a strict tree structure,
+ * with each state having exactly one predecessor, except that the toplevel
+ * state has no inarcs as yet (breakconstraintloop will add its inarcs from
+ * spredecessor after we're done). Thus, we can examine sclone's inarcs back
+ * to the root, plus refarc if any, to identify the set of constraints already
+ * known valid at the current point. This allows us to avoid generating extra
+ * successor states.
+ */
+static void
+clonesuccessorstates(
+ struct nfa * nfa,
+ struct state * ssource,
+ struct state * sclone,
+ struct state * spredecessor,
+ struct arc * refarc,
+ char *curdonemap,
+ char *outerdonemap,
+ int nstates)
+{
+ char *donemap;
+ struct arc *a;
+
+ /* Since this is recursive, it could be driven to stack overflow */
+ if (STACK_TOO_DEEP(nfa->v->re)) {
+ NERR(REG_ETOOBIG);
return;
}
- copyins(nfa, from, to, 0);
+ /* If this state hasn't already got a donemap, create one */
+ donemap = curdonemap;
+ if (donemap == NULL) {
+ donemap = (char *) MALLOC(nstates * sizeof(char));
+ if (donemap == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+
+ if (outerdonemap != NULL) {
+ /*
+ * Not at outermost recursion level, so copy the outer level's
+ * donemap; this ensures that we see states in process of being
+ * visited at outer levels, or already merged into predecessor
+ * states, as ones we shouldn't traverse back to.
+ */
+ memcpy(donemap, outerdonemap, nstates * sizeof(char));
+ } else {
+ /* At outermost level, only spredecessor is off-limits */
+ memset(donemap, 0, nstates * sizeof(char));
+ assert(spredecessor->no < nstates);
+ donemap[spredecessor->no] = 1;
+ }
+ }
+
+ /* Mark ssource as visited in the donemap */
+ assert(ssource->no < nstates);
+ assert(donemap[ssource->no] == 0);
+ donemap[ssource->no] = 1;
+
+ /*
+ * We proceed by first cloning all of ssource's outarcs, creating new
+ * clone states as needed but not doing more with them than that. Then in
+ * a second pass, recurse to process the child clone states. This allows
+ * us to have only one child clone state per reachable source state, even
+ * when there are multiple outarcs leading to the same state. Also, when
+ * we do visit a child state, its set of inarcs is known exactly, which
+ * makes it safe to apply the constraint-is-already-checked optimization.
+ * Also, this ensures that we've merged all the states we can into the
+ * current clone before we recurse to any children, thus possibly saving
+ * them from making extra images of those states.
+ *
+ * While this function runs, child clone states of the current state are
+ * marked by setting their tmp fields to point to the original state they
+ * were cloned from. This makes it possible to detect multiple outarcs
+ * leading to the same state, and also makes it easy to distinguish clone
+ * states from original states (which will have tmp == NULL).
+ */
+ for (a = ssource->outs; a != NULL && !NISERR(); a = a->outchain) {
+ struct state *sto = a->to;
+
+ /*
+ * We do not consider cloning successor states that have no constraint
+ * outarcs; just link to them as-is. They cannot be part of a
+ * constraint loop so there is no need to make copies. In particular,
+ * this rule keeps us from trying to clone the post state, which would
+ * be a bad idea.
+ */
+ if (isconstraintarc(a) && hasconstraintout(sto)) {
+ struct state *prevclone;
+ int canmerge;
+ struct arc *a2;
+
+ /*
+ * Back-link constraint arcs must not be followed. Nor is there a
+ * need to revisit states previously merged into this clone.
+ */
+ assert(sto->no < nstates);
+ if (donemap[sto->no] != 0) {
+ continue;
+ }
+
+ /*
+ * Check whether we already have a child clone state for this
+ * source state.
+ */
+ prevclone = NULL;
+ for (a2 = sclone->outs; a2 != NULL; a2 = a2->outchain) {
+ if (a2->to->tmp == sto) {
+ prevclone = a2->to;
+ break;
+ }
+ }
+
+ /*
+ * If this arc is labeled the same as refarc, or the same as any
+ * arc we must have traversed to get to sclone, then no additional
+ * constraints need to be met to get to sto, so we should just
+ * merge its outarcs into sclone.
+ */
+ if (refarc && a->type == refarc->type && a->co == refarc->co) {
+ canmerge = 1;
+ } else {
+ struct state *s;
+
+ canmerge = 0;
+ for (s = sclone; s->ins; s = s->ins->from) {
+ if (s->nins == 1 &&
+ a->type == s->ins->type && a->co == s->ins->co) {
+ canmerge = 1;
+ break;
+ }
+ }
+ }
+
+ if (canmerge) {
+ /*
+ * We can merge into sclone. If we previously made a child
+ * clone state, drop it; there's no need to visit it. (This
+ * can happen if ssource has multiple pathways to sto, and we
+ * only just now found one that is provably a no-op.)
+ */
+ if (prevclone) {
+ dropstate(nfa, prevclone); /* kills our outarc, too */
+ }
+
+ /* Recurse to merge sto's outarcs into sclone */
+ clonesuccessorstates(nfa, sto, sclone, spredecessor, refarc,
+ donemap, outerdonemap, nstates);
+ /* sto should now be marked as previously visited */
+ assert(NISERR() || donemap[sto->no] == 1);
+ } else if (prevclone) {
+ /*
+ * We already have a clone state for this successor, so just
+ * make another arc to it.
+ */
+ cparc(nfa, a, sclone, prevclone);
+ } else {
+ /*
+ * We need to create a new successor clone state.
+ */
+ struct state *stoclone;
+
+ stoclone = newstate(nfa);
+ if (stoclone == NULL) {
+ assert(NISERR());
+ break;
+ }
+ /* Mark it as to what it's a clone of */
+ stoclone->tmp = sto;
+ /* ... and add the outarc leading to it */
+ cparc(nfa, a, sclone, stoclone);
+ }
+ } else {
+ /*
+ * Non-constraint outarcs just get copied to sclone, as do outarcs
+ * leading to states with no constraint outarc.
+ */
+ cparc(nfa, a, sclone, sto);
+ }
+ }
+
+ /*
+ * If we are at outer level for this clone state, recurse to all its child
+ * clone states, clearing their tmp fields as we go. (If we're not
+ * outermost for sclone, leave this to be done by the outer call level.)
+ * Note that if we have multiple outarcs leading to the same clone state,
+ * it will only be recursed-to once.
+ */
+ if (curdonemap == NULL) {
+ for (a = sclone->outs; a != NULL && !NISERR(); a = a->outchain) {
+ struct state *stoclone = a->to;
+ struct state *sto = stoclone->tmp;
+
+ if (sto != NULL) {
+ stoclone->tmp = NULL;
+ clonesuccessorstates(nfa, sto, stoclone, spredecessor, refarc,
+ NULL, donemap, nstates);
+ }
+ }
+
+ /* Don't forget to free sclone's donemap when done with it */
+ FREE(donemap);
+ }
}
/*
@@ -1630,7 +2795,7 @@ analyze(
}
/*
- - compact - compact an NFA
+ - compact - construct the compact representation of an NFA
^ static void compact(struct nfa *, struct cnfa *);
*/
static void
@@ -1651,13 +2816,16 @@ compact(
narcs = 0;
for (s = nfa->states; s != NULL; s = s->next) {
nstates++;
- narcs += 1 + s->nouts + 1;
- /* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+ narcs += s->nouts + 1; /* need one extra for endmarker */
}
+ cnfa->stflags = (char *) MALLOC(nstates * sizeof(char));
cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *));
cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc));
- if (cnfa->states == NULL || cnfa->arcs == NULL) {
+ if (cnfa->stflags == NULL || cnfa->states == NULL || cnfa->arcs == NULL) {
+ if (cnfa->stflags != NULL) {
+ FREE(cnfa->stflags);
+ }
if (cnfa->states != NULL) {
FREE(cnfa->states);
}
@@ -1680,9 +2848,8 @@ compact(
ca = cnfa->arcs;
for (s = nfa->states; s != NULL; s = s->next) {
assert((size_t) s->no < nstates);
+ cnfa->stflags[s->no] = 0;
cnfa->states[s->no] = ca;
- ca->co = 0; /* clear and skip flags "arc" */
- ca++;
first = ca;
for (a = s->outs; a != NULL; a = a->outchain) {
switch (a->type) {
@@ -1699,11 +2866,11 @@ compact(
cnfa->flags |= HASLACONS;
break;
default:
- assert(NOTREACHED);
+ NERR(REG_ASSERT);
break;
}
}
- carcsort(first, ca-1);
+ carcsort(first, ca - first);
ca->co = COLORLESS;
ca->to = 0;
ca++;
@@ -1716,40 +2883,46 @@ compact(
*/
for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
- cnfa->states[a->to->no]->co = 1;
+ cnfa->stflags[a->to->no] = CNFA_NOPROGRESS;
}
- cnfa->states[nfa->pre->no]->co = 1;
+ cnfa->stflags[nfa->pre->no] = CNFA_NOPROGRESS;
}
/*
- carcsort - sort compacted-NFA arcs by color
- * Really dumb algorithm, but if the list is long enough for that to matter,
- * you're in real trouble anyway.
^ static void carcsort(struct carc *, struct carc *);
*/
static void
carcsort(
struct carc *first,
- struct carc *last)
+ size_t n)
{
- struct carc *p;
- struct carc *q;
- struct carc tmp;
-
- if (last - first <= 1) {
- return;
+ if (n > 1) {
+ qsort(first, n, sizeof(struct carc), carc_cmp);
}
+}
- for (p = first; p <= last; p++) {
- for (q = p; q <= last; q++) {
- if (p->co > q->co || (p->co == q->co && p->to > q->to)) {
- assert(p != q);
- tmp = *p;
- *p = *q;
- *q = tmp;
- }
- }
+static int
+carc_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct carc *aa = (const struct carc *) a;
+ const struct carc *bb = (const struct carc *) b;
+
+ if (aa->co < bb->co) {
+ return -1;
}
+ if (aa->co > bb->co) {
+ return +1;
+ }
+ if (aa->to < bb->to) {
+ return -1;
+ }
+ if (aa->to > bb->to) {
+ return +1;
+ }
+ return 0;
}
/*
@@ -1762,6 +2935,7 @@ freecnfa(
{
assert(cnfa->nstates != 0); /* not empty already */
cnfa->nstates = 0;
+ FREE(cnfa->stflags);
FREE(cnfa->states);
FREE(cnfa->arcs);
}
@@ -1777,6 +2951,8 @@ dumpnfa(
{
#ifdef REG_DEBUG
struct state *s;
+ int nstates = 0;
+ int narcs = 0;
fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
if (nfa->bos[0] != COLORLESS) {
@@ -1794,7 +2970,10 @@ dumpnfa(
fprintf(f, "\n");
for (s = nfa->states; s != NULL; s = s->next) {
dumpstate(s, f);
+ nstates++;
+ narcs += s->nouts;
}
+ fprintf(f, "total of %d states, %d arcs\n", nstates, narcs);
if (nfa->parent == NULL) {
dumpcolors(nfa->cm, f);
}
@@ -1847,37 +3026,28 @@ dumparcs(
FILE *f)
{
int pos;
+ struct arc *a;
- assert(s->nouts > 0);
- /* printing arcs in reverse order is usually clearer */
- pos = dumprarcs(s->outs, s, f, 1);
- if (pos != 1) {
- fprintf(f, "\n");
- }
-}
-
-/*
- - dumprarcs - dump remaining outarcs, recursively, in reverse order
- ^ static int dumprarcs(struct arc *, struct state *, FILE *, int);
- */
-static int /* resulting print position */
-dumprarcs(
- struct arc *a,
- struct state *s,
- FILE *f,
- int pos) /* initial print position */
-{
- if (a->outchain != NULL) {
- pos = dumprarcs(a->outchain, s, f, pos);
+ /* printing oldest arcs first is usually clearer */
+ a = s->outs;
+ assert(a != NULL);
+ while (a->outchain != NULL) {
+ a = a->outchain;
}
- dumparc(a, s, f);
- if (pos == 5) {
+ pos = 1;
+ do {
+ dumparc(a, s, f);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else {
+ pos++;
+ }
+ a = a->outchainRev;
+ } while (a != NULL);
+ if (pos != 1) {
fprintf(f, "\n");
- pos = 1;
- } else {
- pos++;
}
- return pos;
}
/*
@@ -1984,7 +3154,7 @@ dumpcnfa(
}
fprintf(f, "\n");
for (st = 0; st < cnfa->nstates; st++) {
- dumpcstate(st, cnfa->states[st], cnfa, f);
+ dumpcstate(st, cnfa, f);
}
fflush(f);
#endif
@@ -1997,25 +3167,24 @@ dumpcnfa(
/*
- dumpcstate - dump a compacted-NFA state in human-readable form
- ^ static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+ ^ static void dumpcstate(int, struct cnfa *, FILE *);
*/
static void
dumpcstate(
int st,
- struct carc *ca,
struct cnfa *cnfa,
FILE *f)
{
- int i;
+ struct carc *ca;
int pos;
- fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+ fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : ".");
pos = 1;
- for (i = 1; ca[i].co != COLORLESS; i++) {
- if (ca[i].co < cnfa->ncolors) {
- fprintf(f, "\t[%ld]->%d", (long) ca[i].co, ca[i].to);
+ for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) {
+ if (ca->co < cnfa->ncolors) {
+ fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to);
} else {
- fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
+ fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to);
}
if (pos == 5) {
fprintf(f, "\n");
@@ -2024,7 +3193,7 @@ dumpcstate(
pos++;
}
}
- if (i == 1 || pos != 1) {
+ if (ca == cnfa->states[st] || pos != 1) {
fprintf(f, "\n");
}
fflush(f);
diff --git a/generic/regcomp.c b/generic/regcomp.c
index c93eb24..211cd70 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -83,9 +83,6 @@ static int lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
static chr newline(NOPARMS);
-#ifdef REG_DEBUG
-static const chr *ch(NOPARMS);
-#endif
static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
static void initcm(struct vars *, struct colormap *);
@@ -119,17 +116,22 @@ static void dropstate(struct nfa *, struct state *);
static void freestate(struct nfa *, struct state *);
static void destroystate(struct nfa *, struct state *);
static void newarc(struct nfa *, int, pcolor, struct state *, struct state *);
+static void createarc(struct nfa *, int, pcolor, struct state *, struct state *);
static struct arc *allocarc(struct nfa *, struct state *);
static void freearc(struct nfa *, struct arc *);
+static void changearctarget(struct arc *, struct state *);
static int hasnonemptyout(struct state *);
-static int nonemptyouts(struct state *);
-static int nonemptyins(struct state *);
static struct arc *findarc(struct state *, int, pcolor);
static void cparc(struct nfa *, struct arc *, struct state *, struct state *);
+static void sortins(struct nfa *, struct state *);
+static int sortins_cmp(const void *, const void *);
+static void sortouts(struct nfa *, struct state *);
+static int sortouts_cmp(const void *, const void *);
static void moveins(struct nfa *, struct state *, struct state *);
-static void copyins(struct nfa *, struct state *, struct state *, int);
+static void copyins(struct nfa *, struct state *, struct state *);
+static void mergeins(struct nfa *, struct state *, struct arc **, int);
static void moveouts(struct nfa *, struct state *, struct state *);
-static void copyouts(struct nfa *, struct state *, struct state *, int);
+static void copyouts(struct nfa *, struct state *, struct state *);
static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int);
static void delsub(struct nfa *, struct state *, struct state *);
static void deltraverse(struct nfa *, struct state *, struct state *);
@@ -139,33 +141,40 @@ static void cleartraverse(struct nfa *, struct state *);
static void specialcolors(struct nfa *);
static long optimize(struct nfa *, FILE *);
static void pullback(struct nfa *, FILE *);
-static int pull(struct nfa *, struct arc *);
+static int pull(struct nfa *, struct arc *, struct state **);
static void pushfwd(struct nfa *, FILE *);
-static int push(struct nfa *, struct arc *);
+static int push(struct nfa *, struct arc *, struct state **);
#define INCOMPATIBLE 1 /* destroys arc */
#define SATISFIED 2 /* constraint satisfied */
#define COMPATIBLE 3 /* compatible but not satisfied yet */
static int combine(struct arc *, struct arc *);
static void fixempties(struct nfa *, FILE *);
-static struct state *emptyreachable(struct state *, struct state *);
-static void replaceempty(struct nfa *, struct state *, struct state *);
+static struct state *emptyreachable(struct nfa *, struct state *,
+ struct state *, struct arc **);
+static int isconstraintarc(struct arc *);
+static int hasconstraintout(struct state *);
+static void fixconstraintloops(struct nfa *, FILE *);
+static int findconstraintloop(struct nfa *, struct state *);
+static void breakconstraintloop(struct nfa *, struct state *);
+static void clonesuccessorstates(struct nfa *, struct state *, struct state *,
+ struct state *, struct arc *, char *, char *, int);
static void cleanup(struct nfa *);
static void markreachable(struct nfa *, struct state *, struct state *, struct state *);
static void markcanreach(struct nfa *, struct state *, struct state *, struct state *);
static long analyze(struct nfa *);
static void compact(struct nfa *, struct cnfa *);
-static void carcsort(struct carc *, struct carc *);
+static void carcsort(struct carc *, size_t);
+static int carc_cmp(const void *, const void *);
static void freecnfa(struct cnfa *);
static void dumpnfa(struct nfa *, FILE *);
#ifdef REG_DEBUG
static void dumpstate(struct state *, FILE *);
static void dumparcs(struct state *, FILE *);
-static int dumprarcs(struct arc *, struct state *, FILE *, int);
static void dumparc(struct arc *, struct state *, FILE *);
#endif
static void dumpcnfa(struct cnfa *, FILE *);
#ifdef REG_DEBUG
-static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+static void dumpcstate(int, struct cnfa *, FILE *);
#endif
/* === regc_cvec.c === */
static struct cvec *clearcvec(struct cvec *);
@@ -210,11 +219,12 @@ struct vars {
struct subre *tree; /* subexpression tree */
struct subre *treechain; /* all tree nodes allocated */
struct subre *treefree; /* any free tree nodes */
- int ntree; /* number of tree nodes */
+ int ntree; /* number of tree nodes, plus one */
struct cvec *cv; /* interface cvec */
struct cvec *cv2; /* utility cvec */
struct subre *lacons; /* lookahead-constraint vector */
int nlacons; /* size of lacons */
+ size_t spaceused; /* approx. space used for compilation */
};
/* parsing macros; most know that `v' is the struct vars pointer */
@@ -223,13 +233,13 @@ struct vars {
#define EAT(t) (SEE(t) && next(v)) /* if next is this, swallow it */
#define VISERR(vv) ((vv)->err != 0)/* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) \
- ((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define VERR(vv,e) ((vv)->nexttype = EOS, \
+ (vv)->err = ((vv)->err ? (vv)->err : (e)))
#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return;} /* if error seen, return */
#define NOERRN() {if (ISERR()) return NULL;} /* NOERR with retval */
#define NOERRZ() {if (ISERR()) return 0;} /* NOERR with retval */
-#define INSIST(c, e) ((c) ? 0 : ERR(e)) /* if condition false, error */
+#define INSIST(c, e) do { if (!(c)) ERR(e); } while (0) /* error if c false */
#define NOTE(b) (v->re->re_info |= (b)) /* note visible condition */
#define EMPTYARC(x, y) newarc(v->nfa, EMPTY, 0, x, y)
@@ -258,12 +268,14 @@ struct vars {
((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)
/* static function list */
-static struct fns functions = {
+static const struct fns functions = {
rfree, /* regfree insides */
};
/*
- compile - compile regular expression
+ * Note: on failure, no resources remain allocated, so regfree()
+ * need not be applied to re.
^ int compile(regex_t *, const chr *, size_t, int);
*/
int
@@ -324,6 +336,7 @@ compile(
v->cv2 = NULL;
v->lacons = NULL;
v->nlacons = 0;
+ v->spaceused = 0;
re->re_magic = REMAGIC;
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
@@ -593,13 +606,15 @@ makesearch(
break;
}
}
- if (b != NULL && s->tmp == NULL) {
- /*
- * Must be split if not already in the list (fixes bugs 505048,
- * 230589, 840258, 504785).
- */
- s->tmp = slist;
+ /*
+ * We want to mark states as being in the list already by having non
+ * NULL tmp fields, but we can't just store the old slist value in tmp
+ * because that doesn't work for the first such state. Instead, the
+ * first list entry gets its own address in tmp.
+ */
+ if (b != NULL && s->tmp == NULL) {
+ s->tmp = (slist != NULL) ? slist : s;
slist = s;
}
}
@@ -610,8 +625,9 @@ makesearch(
for (s=slist ; s!=NULL ; s=s2) {
s2 = newstate(nfa);
-
- copyouts(nfa, s, s2, 1);
+ NOERR();
+ copyouts(nfa, s, s2);
+ NOERR();
for (a=s->ins ; a!=NULL ; a=b) {
b = a->inchain;
@@ -620,7 +636,7 @@ makesearch(
freearc(nfa, a);
}
}
- s2 = s->tmp;
+ s2 = (s->tmp != s) ? s->tmp : NULL;
s->tmp = NULL; /* clean up while we're at it */
}
}
@@ -982,6 +998,7 @@ parseqatom(
NOERR();
assert(v->nextvalue > 0);
atom = subre(v, 'b', BACKR, lp, rp);
+ NOERR();
subno = v->nextvalue;
atom->subno = subno;
EMPTYARC(lp, rp); /* temporarily, so there's something */
@@ -996,13 +1013,13 @@ parseqatom(
switch (v->nexttype) {
case '*':
m = 0;
- n = INFINITY;
+ n = DUPINF;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
case '+':
m = 1;
- n = INFINITY;
+ n = DUPINF;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
@@ -1019,7 +1036,7 @@ parseqatom(
if (SEE(DIGIT)) {
n = scannum(v);
} else {
- n = INFINITY;
+ n = DUPINF;
}
if (m > n) {
ERR(REG_BADBR);
@@ -1102,11 +1119,17 @@ parseqatom(
/*
* Prepare a general-purpose state skeleton.
*
- * ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
- * / /
- * [lp] ----> [s2] ----bypass---------------------
+ * In the no-backrefs case, we want this:
+ *
+ * [lp] ---> [s] ---prefix---> [begin] ---atom---> [end] ---rest---> [rp]
*
- * where bypass is an empty, and prefix is some repetitions of atom
+ * where prefix is some repetitions of atom. In the general case we need
+ *
+ * [lp] ---> [s] ---iterator---> [s2] ---rest---> [rp]
+ *
+ * where the iterator wraps around [begin] ---atom---> [end]
+ *
+ * We make the s state here for both cases; s2 is made below if needed
*/
s = newstate(v->nfa); /* first, new endpoints for the atom */
@@ -1117,11 +1140,9 @@ parseqatom(
NOERR();
atom->begin = s;
atom->end = s2;
- s = newstate(v->nfa); /* and spots for prefix and bypass */
- s2 = newstate(v->nfa);
+ s = newstate(v->nfa); /* set up starting state */
NOERR();
EMPTYARC(lp, s);
- EMPTYARC(lp, s2);
NOERR();
/*
@@ -1129,6 +1150,7 @@ parseqatom(
*/
t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+ NOERR();
t->left = atom;
atomp = &t->left;
@@ -1142,6 +1164,7 @@ parseqatom(
assert(top->op == '=' && top->left == NULL && top->right == NULL);
top->left = subre(v, '=', top->flags, top->begin, lp);
+ NOERR();
top->op = '.';
top->right = t;
@@ -1166,27 +1189,8 @@ parseqatom(
}
/*
- * It's quantifier time; first, turn x{0,...} into x{1,...}|empty
- */
-
- if (m == 0) {
- EMPTYARC(s2, atom->end);/* the bypass */
- assert(PREF(qprefer) != 0);
- f = COMBINE(qprefer, atom->flags);
- t = subre(v, '|', f, lp, atom->end);
- NOERR();
- t->left = atom;
- t->right = subre(v, '|', PREF(f), s2, atom->end);
- NOERR();
- t->right->left = subre(v, '=', 0, s2, atom->end);
- NOERR();
- *atomp = t;
- atomp = &t->left;
- m = 1;
- }
-
- /*
- * Deal with the rest of the quantifier.
+ * It's quantifier time. If the atom is just a backref, we'll let it deal
+ * with quantifiers internally.
*/
if (atomtype == BACKREF) {
@@ -1204,21 +1208,29 @@ parseqatom(
atom->min = (short) m;
atom->max = (short) n;
atom->flags |= COMBINE(qprefer, atom->flags);
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
} else if (m == 1 && n == 1) {
/*
* No/vacuous quantifier: done.
*/
EMPTYARC(s, atom->begin); /* empty prefix */
- } else {
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
+ } else if (m > 0 && !(atom->flags & BACKR)) {
/*
- * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
- * x
+ * If there's no backrefs involved, we can turn x{m,n} into
+ * x{m-1,n-1}x, with capturing parens in only the second x. This
+ * is valid because we only care about capturing matches from the
+ * final iteration of the quantifier. It's a win because we can
+ * implement the backref-free left side as a plain DFA node, since
+ * we don't really care where its submatches are.
*/
dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
- assert(m >= 1 && m != INFINITY && n >= 1);
- repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
+ assert(m >= 1 && m != DUPINF && n >= 1);
+ repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1);
f = COMBINE(qprefer, atom->flags);
t = subre(v, '.', f, s, atom->end); /* prefix and atom */
NOERR();
@@ -1226,6 +1238,24 @@ parseqatom(
NOERR();
t->right = atom;
*atomp = t;
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
+ } else {
+ /* general case: need an iteration node */
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, atom->end, s2);
+ NOERR();
+ dupnfa(v->nfa, atom->begin, atom->end, s, s2);
+ repeat(v, s, s2, m, n);
+ f = COMBINE(qprefer, atom->flags);
+ t = subre(v, '*', f, s, s2);
+ NOERR();
+ t->min = (short) m;
+ t->max = (short) n;
+ t->left = atom;
+ *atomp = t;
+ /* rest of branch is to be strung from iteration's end state */
}
/*
@@ -1234,10 +1264,10 @@ parseqatom(
t = top->right;
if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
- t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+ t->right = parsebranch(v, stopper, type, s2, rp, 1);
} else {
- EMPTYARC(atom->end, rp);
- t->right = subre(v, '=', 0, atom->end, rp);
+ EMPTYARC(s2, rp);
+ t->right = subre(v, '=', 0, s2, rp);
}
NOERR();
assert(SEE('|') || SEE(stopper) || SEE(EOS));
@@ -1304,6 +1334,8 @@ scannum(
/*
- repeat - replicate subNFA for quantifiers
+ * The sub-NFA strung from lp to rp is modified to represent m to n
+ * repetitions of its initial contents.
* The duplication sequences used here are chosen carefully so that any
* pointers starting out pointing into the subexpression end up pointing into
* the last occurrence. (Note that it may not be strung between the same left
@@ -1323,7 +1355,7 @@ repeat(
#define SOME 2
#define INF 3
#define PAIR(x, y) ((x)*4 + (y))
-#define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
+#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) )
const int rm = REDUCE(m);
const int rn = REDUCE(n);
struct state *s, *s2;
@@ -1713,11 +1745,11 @@ subre(
v->treechain = ret;
}
- assert(strchr("|.b(=", op) != NULL);
+ assert(strchr("=b|.*(", op) != NULL);
ret->op = op;
ret->flags = flags;
- ret->retry = 0;
+ ret->id = 0; /* will be assigned later */
ret->subno = 0;
ret->min = ret->max = 1;
ret->left = NULL;
@@ -1770,7 +1802,8 @@ freesrnode(
}
sr->flags = 0;
- if (v != NULL) {
+ if (v != NULL && v->treechain != NULL) {
+ /* we're still parsing, maybe we can reuse the subre */
sr->left = v->treefree;
v->treefree = sr;
} else {
@@ -1798,7 +1831,7 @@ optst(
}
/*
- - numst - number tree nodes (assigning retry indexes)
+ - numst - number tree nodes (assigning "id" indexes)
^ static int numst(struct subre *, int);
*/
static int /* next number */
@@ -1811,7 +1844,7 @@ numst(
assert(t != NULL);
i = start;
- t->retry = (short) i++;
+ t->id = (short) i++;
if (t->left != NULL) {
i = numst(t->left, i);
}
@@ -1823,6 +1856,19 @@ numst(
/*
- markst - mark tree nodes as INUSE
+ * Note: this is a great deal more subtle than it looks. During initial
+ * parsing of a regex, all subres are linked into the treechain list;
+ * discarded ones are also linked into the treefree list for possible reuse.
+ * After we are done creating all subres required for a regex, we run markst()
+ * then cleanst(), which results in discarding all subres not reachable from
+ * v->tree. We then clear v->treechain, indicating that subres must be found
+ * by descending from v->tree. This changes the behavior of freesubre(): it
+ * will henceforth FREE() unwanted subres rather than sticking them into the
+ * treefree list. (Doing that any earlier would result in dangling links in
+ * the treechain list.) This all means that freev() will clean up correctly
+ * if invoked before or after markst()+cleanst(); but it would not work if
+ * called partway through this state conversion, so we mustn't error out
+ * in or between these two functions.
^ static void markst(struct subre *);
*/
static void
@@ -1929,24 +1975,26 @@ newlacon(
struct state *end,
int pos)
{
- struct subre *sub;
int n;
+ struct subre *newlacons;
+ struct subre *sub;
if (v->nlacons == 0) {
- v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
n = 1; /* skip 0th */
- v->nlacons = 2;
+ newlacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
} else {
- v->lacons = (struct subre *) REALLOC(v->lacons,
- (v->nlacons+1)*sizeof(struct subre));
- n = v->nlacons++;
+ n = v->nlacons;
+ newlacons = (struct subre *) REALLOC(v->lacons,
+ (n + 1) * sizeof(struct subre));
}
- if (v->lacons == NULL) {
+ if (newlacons == NULL) {
ERR(REG_ESPACE);
return 0;
}
+ v->lacons = newlacons;
+ v->nlacons = n + 1;
sub = &v->lacons[n];
sub->begin = begin;
sub->end = end;
@@ -1994,18 +2042,20 @@ rfree(
g = (struct guts *) re->re_guts;
re->re_guts = NULL;
re->re_fns = NULL;
- g->magic = 0;
- freecm(&g->cmap);
- if (g->tree != NULL) {
- freesubre(NULL, g->tree);
- }
- if (g->lacons != NULL) {
- freelacons(g->lacons, g->nlacons);
- }
- if (!NULLCNFA(g->search)) {
- freecnfa(&g->search);
+ if (g != NULL) {
+ g->magic = 0;
+ freecm(&g->cmap);
+ if (g->tree != NULL) {
+ freesubre(NULL, g->tree);
+ }
+ if (g->lacons != NULL) {
+ freelacons(g->lacons, g->nlacons);
+ }
+ if (!NULLCNFA(g->search)) {
+ freecnfa(&g->search);
+ }
+ FREE(g);
}
- FREE(g);
}
/*
@@ -2037,11 +2087,11 @@ dump(
fprintf(f, "\n\n\n========= DUMP ==========\n");
fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
- re->re_nsub, re->re_info, re->re_csize, g->ntree);
+ (int) re->re_nsub, re->re_info, re->re_csize, g->ntree);
dumpcolors(&g->cmap, f);
if (!NULLCNFA(g->search)) {
- printf("\nsearch:\n");
+ fprintf(f, "\nsearch:\n");
dumpcnfa(&g->search, f);
}
for (i = 1; i < g->nlacons; i++) {
@@ -2108,7 +2158,7 @@ stdump(
}
if (t->min != 1 || t->max != 1) {
fprintf(f, " {%d,", t->min);
- if (t->max != INFINITY) {
+ if (t->max != DUPINF) {
fprintf(f, "%d", t->max);
}
fprintf(f, "}");
@@ -2146,14 +2196,14 @@ stid(
size_t bufsize)
{
/*
- * Big enough for hex int or decimal t->retry?
+ * Big enough for hex int or decimal t->id?
*/
- if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
+ if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
return "unable";
}
- if (t->retry != 0) {
- sprintf(buf, "%d", t->retry);
+ if (t->id != 0) {
+ sprintf(buf, "%d", t->id);
} else {
sprintf(buf, "%p", t);
}
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 1c970ea..681b97d 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -60,12 +60,6 @@
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
@@ -75,8 +69,6 @@
/* Interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* Not really right, but good enough... */
-#define __REG_VOID_T void
-#define __REG_CONST const
/* Names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index 920ea6c..e5f22c4 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -84,7 +84,7 @@ longest(
if (v->eflags&REG_FTRACE) {
while (cp < realstop) {
- FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+ FDEBUG(("+++ at c%d +++\n", (int) (css - d->ssets)));
co = GETCOLOR(cm, *cp);
FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
ss = css->outs[co];
@@ -118,7 +118,7 @@ longest(
* Shutdown.
*/
- FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+ FDEBUG(("+++ shutdown at c%d +++\n", (int) (css - d->ssets)));
if (cp == v->stop && stop == v->stop) {
if (hitstopp != NULL) {
*hitstopp = 1;
@@ -213,7 +213,7 @@ shortest(
if (v->eflags&REG_FTRACE) {
while (cp < realmax) {
- FDEBUG(("--- at c%d ---\n", css - d->ssets));
+ FDEBUG(("--- at c%d ---\n", (int) (css - d->ssets)));
co = GETCOLOR(cm, *cp);
FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
ss = css->outs[co];
@@ -516,14 +516,14 @@ miss(
gotState = 0;
for (i = 0; i < d->nstates; i++) {
if (ISBSET(css->states, i)) {
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+ for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
if (ca->co == co) {
BSET(d->work, ca->to);
gotState = 1;
if (ca->to == cnfa->post) {
isPost = 1;
}
- if (!cnfa->states[ca->to]->co) {
+ if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
noProgress = 0;
}
FDEBUG(("%d -> %d\n", i, ca->to));
@@ -537,8 +537,8 @@ miss(
doLAConstraints = 0;
for (i = 0; i < d->nstates; i++) {
if (ISBSET(d->work, i)) {
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
- if (ca->co <= cnfa->ncolors) {
+ for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
+ if (ca->co < cnfa->ncolors) {
continue; /* NOTE CONTINUE */
}
sawLAConstraints = 1;
@@ -553,7 +553,7 @@ miss(
if (ca->to == cnfa->post) {
isPost = 1;
}
- if (!cnfa->states[ca->to]->co) {
+ if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
noProgress = 0;
}
FDEBUG(("%d :> %d\n", i, ca->to));
@@ -572,7 +572,7 @@ miss(
for (p = d->ssets, i = d->nssused; i > 0; p++, i--) {
if (HIT(h, d->work, p, d->wordsper)) {
- FDEBUG(("cached c%d\n", p - d->ssets));
+ FDEBUG(("cached c%d\n", (int) (p - d->ssets)));
break; /* NOTE BREAK OUT */
}
}
@@ -594,7 +594,8 @@ miss(
}
if (!sawLAConstraints) { /* lookahead conds. always cache miss */
- FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+ FDEBUG(("c%d[%d]->c%d\n",
+ (int) (css - d->ssets), co, (int) (p - d->ssets)));
css->outs[co] = p;
css->inchain[co] = p->ins;
p->ins.ss = css;
@@ -663,7 +664,7 @@ getVacantSS(
ap = ss->ins;
while ((p = ap.ss) != NULL) {
co = ap.co;
- FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+ FDEBUG(("zapping c%d's %ld outarc\n", (int) (p - d->ssets), (long)co));
p->outs[co] = NULL;
ap = p->inchain[co];
p->inchain[co].ss = NULL; /* paranoia */
@@ -680,7 +681,7 @@ getVacantSS(
if (p == NULL) {
continue; /* NOTE CONTINUE */
}
- FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+ FDEBUG(("del outarc %d from c%d's in chn\n", i, (int) (p - d->ssets)));
if (p->ins.ss == ss && p->ins.co == i) {
p->ins = ss->inchain[i];
} else {
@@ -772,7 +773,7 @@ pickNextSS(
if ((ss->lastseen == NULL || ss->lastseen < ancient)
&& !(ss->flags&LOCKED)) {
d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
+ FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
return ss;
}
}
@@ -780,7 +781,7 @@ pickNextSS(
if ((ss->lastseen == NULL || ss->lastseen < ancient)
&& !(ss->flags&LOCKED)) {
d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
+ FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
return ss;
}
}
diff --git a/generic/regerror.c b/generic/regerror.c
index a1a0163..49d93ed 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -41,7 +41,7 @@ static const char unk[] = "*** unknown regex error code 0x%x ***";
* Struct to map among codes, code names, and explanations.
*/
-static struct rerr {
+static const struct rerr {
int code;
const char *name;
const char *explain;
@@ -62,7 +62,7 @@ regerror(
char *errbuf, /* Result buffer (unless errbuf_size==0) */
size_t errbuf_size) /* Available space in errbuf, can be 0 */
{
- struct rerr *r;
+ const struct rerr *r;
const char *msg;
char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
size_t len;
diff --git a/generic/regerrs.h b/generic/regerrs.h
index 72548ff..ee203d5 100644
--- a/generic/regerrs.h
+++ b/generic/regerrs.h
@@ -16,5 +16,5 @@
{ REG_INVARG, "REG_INVARG", "invalid argument to regex function" },
{ REG_MIXED, "REG_MIXED", "character widths of regex and string differ" },
{ REG_BADOPT, "REG_BADOPT", "invalid embedded option" },
-{ REG_ETOOBIG, "REG_ETOOBIG", "nfa has too many states" },
+{ REG_ETOOBIG, "REG_ETOOBIG", "regular expression is too complex" },
{ REG_ECOLORS, "REG_ECOLORS", "too many colors" },
diff --git a/generic/regex.h b/generic/regex.h
index 9466fbb..8845f72 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -92,12 +92,6 @@ extern "C" {
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
@@ -107,8 +101,6 @@ extern "C" {
/* interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* not really right, but good enough... */
-#define __REG_VOID_T void
-#define __REG_CONST const
/* names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
@@ -134,26 +126,6 @@ typedef long regoff_t;
#endif
/*
- * For benefit of old compilers, we offer <sys/types.h> the option of
- * overriding the `void' type used to declare nonexistent return types.
- */
-#ifdef __REG_VOID_T
-typedef __REG_VOID_T re_void;
-#else
-typedef void re_void;
-#endif
-
-/*
- * Also for benefit of old compilers, <sys/types.h> can supply a macro which
- * expands to a substitute for `const'.
- */
-#ifndef __REG_CONST
-#define __REG_CONST const
-#endif
-
-
-
-/*
* other interface types
*/
@@ -197,13 +169,13 @@ typedef struct {
/*
* compilation
^ #ifndef __REG_NOCHAR
- ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+ ^ int re_comp(regex_t *, const char *, size_t, int);
^ #endif
^ #ifndef __REG_NOFRONT
- ^ int regcomp(regex_t *, __REG_CONST char *, int);
+ ^ int regcomp(regex_t *, const char *, int);
^ #endif
^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+ ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
^ #endif
*/
#define REG_BASIC 000000 /* BREs (convenience) */
@@ -228,14 +200,14 @@ typedef struct {
/*
* execution
^ #ifndef __REG_NOCHAR
- ^ int re_exec(regex_t *, __REG_CONST char *, size_t,
+ ^ int re_exec(regex_t *, const char *, size_t,
^ rm_detail_t *, size_t, regmatch_t [], int);
^ #endif
^ #ifndef __REG_NOFRONT
- ^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
+ ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
^ #endif
^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
+ ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t,
^ rm_detail_t *, size_t, regmatch_t [], int);
^ #endif
*/
@@ -248,7 +220,7 @@ typedef struct {
/*
* misc generics (may be more functions here eventually)
- ^ re_void regfree(regex_t *);
+ ^ void regfree(regex_t *);
*/
/*
@@ -260,7 +232,7 @@ typedef struct {
* of character is used for error reports is independent of what kind is used
* in matching.
*
- ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
+ ^ extern size_t regerror(int, const regex_t *, char *, size_t);
*/
#define REG_OKAY 0 /* no errors detected */
#define REG_NOMATCH 1 /* failed to match */
@@ -280,7 +252,7 @@ typedef struct {
#define REG_INVARG 16 /* invalid argument to regex function */
#define REG_MIXED 17 /* character widths of regex and string differ */
#define REG_BADOPT 18 /* invalid embedded option */
-#define REG_ETOOBIG 19 /* nfa has too many states */
+#define REG_ETOOBIG 19 /* regular expression is too complex */
#define REG_ECOLORS 20 /* too many colors */
/* two specials for debugging and testing */
#define REG_ATOI 101 /* convert error-code name to number */
@@ -293,25 +265,25 @@ typedef struct {
/* automatically gathered by fwd; do not hand-edit */
/* === regproto.h === */
#ifndef __REG_NOCHAR
-int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+int re_comp(regex_t *, const char *, size_t, int);
#endif
#ifndef __REG_NOFRONT
-int regcomp(regex_t *, __REG_CONST char *, int);
+int regcomp(regex_t *, const char *, int);
#endif
#ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
#endif
#ifndef __REG_NOCHAR
-int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
#ifndef __REG_NOFRONT
-int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
+int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
#endif
#ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
-MODULE_SCOPE re_void regfree(regex_t *);
-MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
+MODULE_SCOPE void regfree(regex_t *);
+MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */
diff --git a/generic/regexec.c b/generic/regexec.c
index ad4b6e6..6d12827 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -107,13 +107,13 @@ struct vars {
chr *start; /* start of string */
chr *stop; /* just past end of string */
int err; /* error code if any (0 none) */
- regoff_t *mem; /* memory vector for backtracking */
+ struct dfa **subdfas; /* per-subre DFAs */
struct smalldfa dfa1;
struct smalldfa dfa2;
};
#define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define VERR(vv,e) ((vv)->err = ((vv)->err ? (vv)->err : (e)))
#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return v->err;} /* if error seen, return it */
#define OFF(p) ((p) - v->start)
@@ -126,21 +126,20 @@ struct vars {
/* automatically gathered by fwd; do not hand-edit */
/* === regexec.c === */
int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+static struct dfa *getsubdfa(struct vars *, struct subre *);
static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const);
static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const);
static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const);
-static void zapSubexpressions(regmatch_t *const, const size_t);
-static void zapSubtree(struct vars *const, struct subre *const);
+static void zapallsubs(regmatch_t *const, const size_t);
+static void zaptreesubs(struct vars *const, struct subre *const);
static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
-static int dissect(struct vars *const, struct subre *, chr *const, chr *const);
-static int concatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int alternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
-static inline int complicatedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedCapturingDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedConcatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedReversedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedBackrefDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedAlternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
+static int cdissect(struct vars *, struct subre *, chr *, chr *);
+static int ccondissect(struct vars *, struct subre *, chr *, chr *);
+static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
+static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
+static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
/* === rege_dfa.c === */
static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const);
static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const);
@@ -174,10 +173,11 @@ exec(
AllocVars(v);
int st, backref;
size_t n;
+ size_t i;
#define LOCALMAT 20
regmatch_t mat[LOCALMAT];
-#define LOCALMEM 40
- regoff_t mem[LOCALMEM];
+#define LOCALDFAS 40
+ struct dfa *subdfas[LOCALDFAS];
/*
* Sanity checks.
@@ -235,28 +235,20 @@ exec(
v->start = (chr *)string;
v->stop = (chr *)string + len;
v->err = 0;
- if (backref) {
- /*
- * Need retry memory.
- */
-
- assert(v->g->ntree >= 0);
- n = (size_t)v->g->ntree;
- if (n <= LOCALMEM) {
- v->mem = mem;
- } else {
- v->mem = (regoff_t *) MALLOC(n*sizeof(regoff_t));
- }
- if (v->mem == NULL) {
- if (v->pmatch != pmatch && v->pmatch != mat) {
- FREE(v->pmatch);
- }
- FreeVars(v);
- return REG_ESPACE;
- }
- } else {
- v->mem = NULL;
+ assert(v->g->ntree >= 0);
+ n = (size_t) v->g->ntree;
+ if (n <= LOCALDFAS)
+ v->subdfas = subdfas;
+ else
+ v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
+ if (v->subdfas == NULL) {
+ if (v->pmatch != pmatch && v->pmatch != mat)
+ FREE(v->pmatch);
+ FreeVars(v);
+ return REG_ESPACE;
}
+ for (i = 0; i < n; i++)
+ v->subdfas[i] = NULL;
/*
* Do it.
@@ -274,7 +266,7 @@ exec(
*/
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
- zapSubexpressions(pmatch, nmatch);
+ zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
}
@@ -286,14 +278,35 @@ exec(
if (v->pmatch != pmatch && v->pmatch != mat) {
FREE(v->pmatch);
}
- if (v->mem != NULL && v->mem != mem) {
- FREE(v->mem);
+ n = (size_t) v->g->ntree;
+ for (i = 0; i < n; i++) {
+ if (v->subdfas[i] != NULL)
+ freeDFA(v->subdfas[i]);
}
+ if (v->subdfas != subdfas)
+ FREE(v->subdfas);
FreeVars(v);
return st;
}
/*
+ - getsubdfa - create or re-fetch the DFA for a subre node
+ * We only need to create the DFA once per overall regex execution.
+ * The DFA will be freed by the cleanup step in exec().
+ */
+static struct dfa *
+getsubdfa(struct vars * v,
+ struct subre * t)
+{
+ if (v->subdfas[t->id] == NULL) {
+ v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR())
+ return NULL;
+ }
+ return v->subdfas[t->id];
+}
+
+/*
- simpleFind - find a match for the main NFA (no-complications case)
^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
*/
@@ -357,7 +370,10 @@ simpleFind(
} else {
end = longest(v, d, begin, v->stop, &hitend);
}
- NOERR();
+ if (ISERR()) {
+ freeDFA(d);
+ return v->err;
+ }
if (hitend && cold == NULL) {
cold = begin;
}
@@ -388,11 +404,11 @@ simpleFind(
}
/*
- * Submatches.
+ * Find submatches.
*/
- zapSubexpressions(v->pmatch, v->nmatch);
- return dissect(v, v->g->tree, begin, end);
+ zapallsubs(v->pmatch, v->nmatch);
+ return cdissect(v, v->g->tree, begin, end);
}
/*
@@ -488,9 +504,8 @@ complicatedFindLoop(
}
MDEBUG(("tentative end %ld\n", LOFF(end)));
- zapSubexpressions(v->pmatch, v->nmatch);
- zapSubtree(v, v->g->tree);
- er = complicatedDissect(v, v->g->tree, begin, end);
+ zapallsubs(v->pmatch, v->nmatch);
+ er = cdissect(v, v->g->tree, begin, end);
if (er == REG_OKAY) {
if (v->nmatch > 0) {
v->pmatch[0].rm_so = OFF(begin);
@@ -501,6 +516,7 @@ complicatedFindLoop(
}
if (er != REG_NOMATCH) {
ERR(er);
+ *coldp = cold;
return er;
}
if ((shorter) ? end == estop : end == begin) {
@@ -525,11 +541,11 @@ complicatedFindLoop(
}
/*
- - zapSubexpressions - initialize the subexpression matches to "no match"
- ^ static void zapSubexpressions(regmatch_t *, size_t);
+ - zapallsubs - initialize all subexpression matches to "no match"
+ ^ static void zapallsubs(regmatch_t *, size_t);
*/
static void
-zapSubexpressions(
+zapallsubs(
regmatch_t *const p,
const size_t n)
{
@@ -542,36 +558,33 @@ zapSubexpressions(
}
/*
- - zapSubtree - initialize the retry memory of a subtree to zeros
- ^ static void zapSubtree(struct vars *, struct subre *);
+ - zaptreesubs - initialize subexpressions within subtree to "no match"
+ ^ static void zaptreesubs(struct vars *, struct subre *);
*/
static void
-zapSubtree(
+zaptreesubs(
struct vars *const v,
struct subre *const t)
{
- if (t == NULL) {
- return;
- }
-
- assert(v->mem != NULL);
- v->mem[t->retry] = 0;
if (t->op == '(') {
- assert(t->subno > 0);
- v->pmatch[t->subno].rm_so = -1;
- v->pmatch[t->subno].rm_eo = -1;
+ int n = t->subno;
+ assert(n > 0);
+ if ((size_t) n < v->nmatch) {
+ v->pmatch[n].rm_so = -1;
+ v->pmatch[n].rm_eo = -1;
+ }
}
if (t->left != NULL) {
- zapSubtree(v, t->left);
+ zaptreesubs(v, t->left);
}
if (t->right != NULL) {
- zapSubtree(v, t->right);
+ zaptreesubs(v, t->right);
}
}
/*
- - subset - set any subexpression relevant to a successful subre
+ - subset - set subexpression match data for a successful subre
^ static void subset(struct vars *, struct subre *, chr *, chr *);
*/
static void
@@ -594,247 +607,91 @@ subset(
}
/*
- - dissect - determine subexpression matches (uncomplicated case)
- ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
+ - cdissect - check backrefs and determine subexpression matches
+ * cdissect recursively processes a subre tree to check matching of backrefs
+ * and/or identify submatch boundaries for capture nodes. The proposed match
+ * runs from "begin" to "end" (not including "end"), and we are basically
+ * "dissecting" it to see where the submatches are.
+ * Before calling any level of cdissect, the caller must have run the node's
+ * DFA and found that the proposed substring satisfies the DFA. (We make
+ * the caller do that because in concatenation and iteration nodes, it's
+ * much faster to check all the substrings against the child DFAs before we
+ * recurse.) Also, caller must have cleared subexpression match data via
+ * zaptreesubs (or zapallsubs at the top level).
+ ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-dissect(
- struct vars *const v,
+cdissect(
+ struct vars *v,
struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- restart:
-#endif
- assert(t != NULL);
- MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
-
- switch (t->op) {
- case '=': /* terminal node */
- assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- case '|': /* alternation */
- assert(t->left != NULL);
- return alternationDissect(v, t, begin, end);
- case 'b': /* back ref -- shouldn't be calling us! */
- return REG_ASSERT;
- case '.': /* concatenation */
- assert(t->left != NULL && t->right != NULL);
- return concatenationDissect(v, t, begin, end);
- case '(': /* capturing */
- assert(t->left != NULL && t->right == NULL);
- assert(t->subno > 0);
- subset(v, t, begin, end);
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- t = t->left;
- goto restart;
-#else
- return dissect(v, t->left, begin, end);
-#endif
- default:
- return REG_ASSERT;
- }
-}
-
-/*
- - concatenationDissect - determine concatenation subexpression matches
- - (uncomplicated)
- ^ static int concatenationDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int /* regexec return code */
-concatenationDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- struct dfa *d, *d2;
- chr *mid;
- int i;
- int shorter = (t->left->flags&SHORTER) ? 1 : 0;
- chr *stop = (shorter) ? end : begin;
-
- assert(t->op == '.');
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- NOERR();
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
- if (ISERR()) {
- assert(d2 == NULL);
- freeDFA(d);
- return v->err;
- }
-
- /*
- * Pick a tentative midpoint.
- */
-
- if (shorter) {
- mid = shortest(v, d, begin, begin, end, NULL, NULL);
- } else {
- mid = longest(v, d, begin, end, NULL);
- }
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-
- /*
- * Iterate until satisfaction or failure.
- */
-
- while (longest(v, d2, mid, end, NULL) != end) {
- /*
- * That midpoint didn't work, find a new one.
- */
-
- if (mid == stop) {
- /*
- * All possibilities exhausted!
- */
-
- MDEBUG(("no midpoint!\n"));
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- if (shorter) {
- mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
- } else {
- mid = longest(v, d, begin, mid-1, NULL);
- }
- if (mid == NULL) {
- /*
- * Failed to find a new one!
- */
-
- MDEBUG(("failed midpoint!\n"));
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- MDEBUG(("new midpoint %ld\n", LOFF(mid)));
- }
-
- /*
- * Satisfaction.
- */
-
- MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
- i = dissect(v, t->left, begin, mid);
- if (i != REG_OKAY) {
- return i;
- }
- return dissect(v, t->right, mid, end);
-}
-
-/*
- - alternationDissect - determine alternative subexpression matches (uncomplicated)
- ^ static int alternationDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int /* regexec return code */
-alternationDissect(
- struct vars *const v,
- struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- int i;
-
- assert(t != NULL);
- assert(t->op == '|');
-
- for (i = 0; t != NULL; t = t->right, i++) {
- struct dfa *d;
+ int er;
- MDEBUG(("trying %dth\n", i));
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- if (ISERR()) {
- return v->err;
- }
- if (longest(v, d, begin, end, NULL) == end) {
- MDEBUG(("success\n"));
- freeDFA(d);
- return dissect(v, t->left, begin, end);
- }
- freeDFA(d);
- }
- return REG_ASSERT; /* none of them matched?!? */
-}
-
-/*
- - complicatedDissect - determine subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static inline int /* regexec return code */
-complicatedDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
assert(t != NULL);
- MDEBUG(("complicatedDissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
+ MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
switch (t->op) {
case '=': /* terminal node */
assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- case '|': /* alternation */
- assert(t->left != NULL);
- return complicatedAlternationDissect(v, t, begin, end);
- case 'b': /* back ref -- shouldn't be calling us! */
+ er = REG_OKAY; /* no action, parent did the work */
+ break;
+ case 'b': /* back reference */
assert(t->left == NULL && t->right == NULL);
- return complicatedBackrefDissect(v, t, begin, end);
+ er = cbrdissect(v, t, begin, end);
+ break;
case '.': /* concatenation */
assert(t->left != NULL && t->right != NULL);
- return complicatedConcatenationDissect(v, t, begin, end);
+ if (t->left->flags & SHORTER) /* reverse scan */
+ er = crevcondissect(v, t, begin, end);
+ else
+ er = ccondissect(v, t, begin, end);
+ break;
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ er = caltdissect(v, t, begin, end);
+ break;
+ case '*': /* iteration */
+ assert(t->left != NULL);
+ if (t->left->flags & SHORTER) /* reverse scan */
+ er = creviterdissect(v, t, begin, end);
+ else
+ er = citerdissect(v, t, begin, end);
+ break;
case '(': /* capturing */
assert(t->left != NULL && t->right == NULL);
assert(t->subno > 0);
- return complicatedCapturingDissect(v, t, begin, end);
+ er = cdissect(v, t->left, begin, end);
+ if (er == REG_OKAY) {
+ subset(v, t, begin, end);
+ }
+ break;
default:
- return REG_ASSERT;
+ er = REG_ASSERT;
+ break;
}
-}
-static int /* regexec return code */
-complicatedCapturingDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- int er = complicatedDissect(v, t->left, begin, end);
+ /*
+ * We should never have a match failure unless backrefs lurk below;
+ * otherwise, either caller failed to check the DFA, or there's some
+ * inconsistency between the DFA and the node's innards.
+ */
+ assert(er != REG_NOMATCH || (t->flags & BACKR));
- if (er == REG_OKAY) {
- subset(v, t, begin, end);
- }
return er;
}
/*
- - complicatedConcatenationDissect - concatenation subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedConcatenationDissect(struct vars *, struct subre *, chr *, chr *);
+ - ccondissect - dissect match for concatenation node
+ ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedConcatenationDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+ccondissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
struct dfa *d, *d2;
chr *mid;
@@ -842,39 +699,23 @@ complicatedConcatenationDissect(
assert(t->op == '.');
assert(t->left != NULL && t->left->cnfa.nstates > 0);
assert(t->right != NULL && t->right->cnfa.nstates > 0);
+ assert(!(t->left->flags & SHORTER));
- if (t->left->flags&SHORTER) { /* reverse scan */
- return complicatedReversedDissect(v, t, begin, end);
- }
+ d = getsubdfa(v, t->left);
+ NOERR();
+ d2 = getsubdfa(v, t->right);
+ NOERR();
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- return v->err;
- }
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freeDFA(d);
- return v->err;
- }
- MDEBUG(("cConcat %d\n", t->retry));
+ MDEBUG(("cConcat %d\n", t->id));
/*
* Pick a tentative midpoint.
*/
-
- if (v->mem[t->retry] == 0) {
- mid = longest(v, d, begin, end, NULL);
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ mid = longest(v, d, begin, end, (int *) NULL);
+ if (mid == NULL) {
+ return REG_NOMATCH;
}
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
/*
* Iterate until satisfaction or failure.
@@ -886,24 +727,20 @@ complicatedConcatenationDissect(
*/
if (longest(v, d2, mid, end, NULL) == end) {
- int er = complicatedDissect(v, t->left, begin, mid);
+ int er = cdissect(v, t->left, begin, mid);
if (er == REG_OKAY) {
- er = complicatedDissect(v, t->right, mid, end);
+ er = cdissect(v, t->right, mid, end);
if (er == REG_OKAY) {
/*
* Satisfaction.
*/
MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
return REG_OKAY;
}
}
- if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
- freeDFA(d);
- freeDFA(d2);
+ if (er != REG_NOMATCH) {
return er;
}
}
@@ -917,9 +754,7 @@ complicatedConcatenationDissect(
* All possibilities exhausted.
*/
- MDEBUG(("%d no midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d no midpoint\n", t->id));
return REG_NOMATCH;
}
mid = longest(v, d, begin, mid-1, NULL);
@@ -928,31 +763,25 @@ complicatedConcatenationDissect(
* Failed to find a new one.
*/
- MDEBUG(("%d failed midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d failed midpoint\n", t->id));
return REG_NOMATCH;
}
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapSubtree(v, t->left);
- zapSubtree(v, t->right);
+ MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
+ zaptreesubs(v, t->left);
+ zaptreesubs(v, t->right);
}
}
/*
- - complicatedReversedDissect - determine backref shortest-first subexpression
- - matches
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedReversedDissect(struct vars *, struct subre *, chr *, chr *);
+ - crevcondissect - dissect match for concatenation node, shortest-first
+ ^ static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedReversedDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+crevcondissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
struct dfa *d, *d2;
chr *mid;
@@ -962,38 +791,22 @@ complicatedReversedDissect(
assert(t->right != NULL && t->right->cnfa.nstates > 0);
assert(t->left->flags&SHORTER);
- /*
- * Concatenation -- need to split the substring between parts.
- */
+ d = getsubdfa(v, t->left);
+ NOERR();
+ d2 = getsubdfa(v, t->right);
+ NOERR();
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- return v->err;
- }
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freeDFA(d);
- return v->err;
- }
- MDEBUG(("cRev %d\n", t->retry));
+ MDEBUG(("crevcon %d\n", t->id));
/*
* Pick a tentative midpoint.
*/
- if (v->mem[t->retry] == 0) {
- mid = shortest(v, d, begin, begin, end, NULL, NULL);
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ mid = shortest(v, d, begin, begin, end, (chr **) NULL, (int *) NULL);
+ if (mid == NULL) {
+ return REG_NOMATCH;
}
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
/*
* Iterate until satisfaction or failure.
@@ -1005,24 +818,20 @@ complicatedReversedDissect(
*/
if (longest(v, d2, mid, end, NULL) == end) {
- int er = complicatedDissect(v, t->left, begin, mid);
+ int er = cdissect(v, t->left, begin, mid);
if (er == REG_OKAY) {
- er = complicatedDissect(v, t->right, mid, end);
+ er = cdissect(v, t->right, mid, end);
if (er == REG_OKAY) {
/*
* Satisfaction.
*/
MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
return REG_OKAY;
}
}
- if (er != REG_OKAY && er != REG_NOMATCH) {
- freeDFA(d);
- freeDFA(d2);
+ if (er != REG_NOMATCH) {
return er;
}
}
@@ -1036,9 +845,7 @@ complicatedReversedDissect(
* All possibilities exhausted.
*/
- MDEBUG(("%d no midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d no midpoint\n", t->id));
return REG_NOMATCH;
}
mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
@@ -1047,164 +854,474 @@ complicatedReversedDissect(
* Failed to find a new one.
*/
- MDEBUG(("%d failed midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d failed midpoint\n", t->id));
return REG_NOMATCH;
}
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapSubtree(v, t->left);
- zapSubtree(v, t->right);
+ MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
+ zaptreesubs(v, t->left);
+ zaptreesubs(v, t->right);
}
}
/*
- - complicatedBackrefDissect - determine backref subexpression matches
- ^ static int complicatedBackrefDissect(struct vars *, struct subre *, chr *, chr *);
+ - cbrdissect - dissect match for backref node
+ ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedBackrefDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+cbrdissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
- int i, n = t->subno, min = t->min, max = t->max;
- chr *paren, *p, *stop;
- size_t len;
+ int n = t->subno, min = t->min, max = t->max;
+ size_t numreps;
+ size_t tlen;
+ size_t brlen;
+ chr *brstring;
+ chr *p;
assert(t != NULL);
assert(t->op == 'b');
assert(n >= 0);
assert((size_t)n < v->nmatch);
- MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
+ MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));
+ /* get the backreferenced string */
if (v->pmatch[n].rm_so == -1) {
return REG_NOMATCH;
}
- paren = v->start + v->pmatch[n].rm_so;
- len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
+ brstring = v->start + v->pmatch[n].rm_so;
+ brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
- /*
- * No room to maneuver -- retries are pointless.
- */
-
- if (v->mem[t->retry]) {
+ /* special cases for zero-length strings */
+ if (brlen == 0) {
+ /*
+ * matches only if target is zero length, but any number of
+ * repetitions can be considered to be present
+ */
+ if (begin == end && min <= max) {
+ MDEBUG(("cbackref matched trivially\n"));
+ return REG_OKAY;
+ }
return REG_NOMATCH;
}
- v->mem[t->retry] = 1;
-
- /*
- * Special-case zero-length string.
- */
-
- if (len == 0) {
- if (begin == end) {
+ if (begin == end) {
+ /* matches only if zero repetitions are okay */
+ if (min == 0) {
+ MDEBUG(("cbackref matched trivially\n"));
return REG_OKAY;
}
return REG_NOMATCH;
}
/*
- * And too-short string.
+ * check target length to see if it could possibly be an allowed number of
+ * repetitions of brstring
*/
- assert(end >= begin);
- if ((size_t)(end - begin) < len) {
+ assert(end > begin);
+ tlen = end - begin;
+ if (tlen % brlen != 0)
+ return REG_NOMATCH;
+ numreps = tlen / brlen;
+ if (numreps < (size_t)min || (numreps > (size_t)max && max != DUPINF))
return REG_NOMATCH;
+
+ /* okay, compare the actual string contents */
+ p = begin;
+ while (numreps-- > 0) {
+ if ((*v->g->compare) (brstring, p, brlen) != 0)
+ return REG_NOMATCH;
+ p += brlen;
}
- stop = end - len;
- /*
- * Count occurrences.
- */
+ MDEBUG(("cbackref matched\n"));
+ return REG_OKAY;
+}
+
+/*
+ - caltdissect - dissect match for alternation node
+ ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+caltdissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
+{
+ struct dfa *d;
+ int er;
+
+ /* We loop, rather than tail-recurse, to handle a chain of alternatives */
+ while (t != NULL) {
+ assert(t->op == '|');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
- i = 0;
- for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
- if (v->g->compare(paren, p, len) != 0) {
- break;
+ MDEBUG(("calt n%d\n", t->id));
+
+ d = getsubdfa(v, t->left);
+ NOERR();
+ if (longest(v, d, begin, end, (int *) NULL) == end) {
+ MDEBUG(("calt matched\n"));
+ er = cdissect(v, t->left, begin, end);
+ if (er != REG_NOMATCH) {
+ return er;
+ }
}
- i++;
+
+ t = t->right;
}
- MDEBUG(("cbackref found %d\n", i));
+
+ return REG_NOMATCH;
+}
+
+/*
+ - citerdissect - dissect match for iteration node
+ ^ static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+citerdissect(struct vars * v,
+ struct subre * t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
+{
+ struct dfa *d;
+ chr **endpts;
+ chr *limit;
+ int min_matches;
+ size_t max_matches;
+ int nverified;
+ int k;
+ int i;
+ int er;
+
+ assert(t->op == '*');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(!(t->left->flags & SHORTER));
+ assert(begin <= end);
/*
- * And sort it out.
+ * If zero matches are allowed, and target string is empty, just declare
+ * victory. OTOH, if target string isn't empty, zero matches can't work
+ * so we pretend the min is 1.
*/
+ min_matches = t->min;
+ if (min_matches <= 0) {
+ if (begin == end)
+ return REG_OKAY;
+ min_matches = 1;
+ }
- if (p != end) { /* didn't consume all of it */
- return REG_NOMATCH;
+ /*
+ * We need workspace to track the endpoints of each sub-match. Normally
+ * we consider only nonzero-length sub-matches, so there can be at most
+ * end-begin of them. However, if min is larger than that, we will also
+ * consider zero-length sub-matches in order to find enough matches.
+ *
+ * For convenience, endpts[0] contains the "begin" pointer and we store
+ * sub-match endpoints in endpts[1..max_matches].
+ */
+ max_matches = end - begin;
+ if (max_matches > (size_t)t->max && t->max != DUPINF)
+ max_matches = t->max;
+ if (max_matches < (size_t)min_matches)
+ max_matches = min_matches;
+ endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+ if (endpts == NULL)
+ return REG_ESPACE;
+ endpts[0] = begin;
+
+ d = getsubdfa(v, t->left);
+ if (ISERR()) {
+ FREE(endpts);
+ return v->err;
}
- if (min <= i && (i <= max || max == INFINITY)) {
- return REG_OKAY;
+ MDEBUG(("citer %d\n", t->id));
+
+ /*
+ * Our strategy is to first find a set of sub-match endpoints that are
+ * valid according to the child node's DFA, and then recursively dissect
+ * each sub-match to confirm validity. If any validity check fails,
+ * backtrack the last sub-match and try again. And, when we next try for
+ * a validity check, we need not recheck any successfully verified
+ * sub-matches that we didn't move the endpoints of. nverified remembers
+ * how many sub-matches are currently known okay.
+ */
+
+ /* initialize to consider first sub-match */
+ nverified = 0;
+ k = 1;
+ limit = end;
+
+ /* iterate until satisfaction or failure */
+ while (k > 0) {
+ /* try to find an endpoint for the k'th sub-match */
+ endpts[k] = longest(v, d, endpts[k - 1], limit, (int *) NULL);
+ if (endpts[k] == NULL) {
+ /* no match possible, so see if we can shorten previous one */
+ k--;
+ goto backtrack;
+ }
+ MDEBUG(("%d: working endpoint %d: %ld\n",
+ t->id, k, LOFF(endpts[k])));
+
+ /* k'th sub-match can no longer be considered verified */
+ if (nverified >= k)
+ nverified = k - 1;
+
+ if (endpts[k] != end) {
+ /* haven't reached end yet, try another iteration if allowed */
+ if ((size_t)k >= max_matches) {
+ /* must try to shorten some previous match */
+ k--;
+ goto backtrack;
+ }
+
+ /* reject zero-length match unless necessary to achieve min */
+ if (endpts[k] == endpts[k - 1] &&
+ (k >= min_matches || min_matches - k < end - endpts[k]))
+ goto backtrack;
+
+ k++;
+ limit = end;
+ continue;
+ }
+
+ /*
+ * We've identified a way to divide the string into k sub-matches
+ * that works so far as the child DFA can tell. If k is an allowed
+ * number of matches, start the slow part: recurse to verify each
+ * sub-match. We always have k <= max_matches, needn't check that.
+ */
+ if (k < min_matches)
+ goto backtrack;
+
+ MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+ for (i = nverified + 1; i <= k; i++) {
+ zaptreesubs(v, t->left);
+ er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+ if (er == REG_OKAY) {
+ nverified = i;
+ continue;
+ }
+ if (er == REG_NOMATCH)
+ break;
+ /* oops, something failed */
+ FREE(endpts);
+ return er;
+ }
+
+ if (i > k) {
+ /* satisfaction */
+ MDEBUG(("%d successful\n", t->id));
+ FREE(endpts);
+ return REG_OKAY;
+ }
+
+ /* match failed to verify, so backtrack */
+
+ backtrack:
+ /*
+ * Must consider shorter versions of the current sub-match. However,
+ * we'll only ask for a zero-length match if necessary.
+ */
+ while (k > 0) {
+ chr *prev_end = endpts[k - 1];
+
+ if (endpts[k] > prev_end) {
+ limit = endpts[k] - 1;
+ if (limit > prev_end ||
+ (k < min_matches && min_matches - k >= end - prev_end)) {
+ /* break out of backtrack loop, continue the outer one */
+ break;
+ }
+ }
+ /* can't shorten k'th sub-match any more, consider previous one */
+ k--;
+ }
}
- return REG_NOMATCH; /* out of range */
+
+ /* all possibilities exhausted */
+ MDEBUG(("%d failed\n", t->id));
+ FREE(endpts);
+ return REG_NOMATCH;
}
/*
- - complicatedAlternationDissect - determine alternative subexpression matches (w.
- - complications)
- ^ static int complicatedAlternationDissect(struct vars *, struct subre *, chr *, chr *);
+ - creviterdissect - dissect match for iteration node, shortest-first
+ ^ static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedAlternationDissect(
- struct vars *const v,
- struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+creviterdissect(struct vars * v,
+ struct subre * t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
- int er;
-#define UNTRIED 0 /* not yet tried at all */
-#define TRYING 1 /* top matched, trying submatches */
-#define TRIED 2 /* top didn't match or submatches exhausted */
+ struct dfa *d;
+ chr **endpts;
+ chr *limit;
+ int min_matches;
+ size_t max_matches;
+ int nverified;
+ int k;
+ int i;
+ int er;
+
+ assert(t->op == '*');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->left->flags & SHORTER);
+ assert(begin <= end);
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- if (0) {
- doRight:
- t = t->right;
- }
-#endif
- if (t == NULL) {
- return REG_NOMATCH;
+ /*
+ * If zero matches are allowed, and target string is empty, just declare
+ * victory. OTOH, if target string isn't empty, zero matches can't work
+ * so we pretend the min is 1.
+ */
+ min_matches = t->min;
+ if (min_matches <= 0) {
+ if (begin == end)
+ return REG_OKAY;
+ min_matches = 1;
}
- assert(t->op == '|');
- if (v->mem[t->retry] == TRIED) {
- goto doRight;
+
+ /*
+ * We need workspace to track the endpoints of each sub-match. Normally
+ * we consider only nonzero-length sub-matches, so there can be at most
+ * end-begin of them. However, if min is larger than that, we will also
+ * consider zero-length sub-matches in order to find enough matches.
+ *
+ * For convenience, endpts[0] contains the "begin" pointer and we store
+ * sub-match endpoints in endpts[1..max_matches].
+ */
+ max_matches = end - begin;
+ if (max_matches > (size_t)t->max && t->max != DUPINF)
+ max_matches = t->max;
+ if (max_matches < (size_t)min_matches)
+ max_matches = min_matches;
+ endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+ if (endpts == NULL)
+ return REG_ESPACE;
+ endpts[0] = begin;
+
+ d = getsubdfa(v, t->left);
+ if (ISERR()) {
+ FREE(endpts);
+ return v->err;
}
+ MDEBUG(("creviter %d\n", t->id));
- MDEBUG(("cAlt n%d\n", t->retry));
- assert(t->left != NULL);
+ /*
+ * Our strategy is to first find a set of sub-match endpoints that are
+ * valid according to the child node's DFA, and then recursively dissect
+ * each sub-match to confirm validity. If any validity check fails,
+ * backtrack the last sub-match and try again. And, when we next try for
+ * a validity check, we need not recheck any successfully verified
+ * sub-matches that we didn't move the endpoints of. nverified remembers
+ * how many sub-matches are currently known okay.
+ */
- if (v->mem[t->retry] == UNTRIED) {
- struct dfa *d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+ /* initialize to consider first sub-match */
+ nverified = 0;
+ k = 1;
+ limit = begin;
+
+ /* iterate until satisfaction or failure */
+ while (k > 0) {
+ /* disallow zero-length match unless necessary to achieve min */
+ if (limit == endpts[k - 1] &&
+ limit != end &&
+ (k >= min_matches || min_matches - k < end - limit))
+ limit++;
+
+ /* if this is the last allowed sub-match, it must reach to the end */
+ if ((size_t)k >= max_matches)
+ limit = end;
+
+ /* try to find an endpoint for the k'th sub-match */
+ endpts[k] = shortest(v, d, endpts[k - 1], limit, end,
+ (chr **) NULL, (int *) NULL);
+ if (endpts[k] == NULL) {
+ /* no match possible, so see if we can lengthen previous one */
+ k--;
+ goto backtrack;
+ }
+ MDEBUG(("%d: working endpoint %d: %ld\n",
+ t->id, k, LOFF(endpts[k])));
+
+ /* k'th sub-match can no longer be considered verified */
+ if (nverified >= k)
+ nverified = k - 1;
+
+ if (endpts[k] != end) {
+ /* haven't reached end yet, try another iteration if allowed */
+ if ((size_t)k >= max_matches) {
+ /* must try to lengthen some previous match */
+ k--;
+ goto backtrack;
+ }
- if (ISERR()) {
- return v->err;
+ k++;
+ limit = endpts[k - 1];
+ continue;
}
- if (longest(v, d, begin, end, NULL) != end) {
- freeDFA(d);
- v->mem[t->retry] = TRIED;
- goto doRight;
+
+ /*
+ * We've identified a way to divide the string into k sub-matches
+ * that works so far as the child DFA can tell. If k is an allowed
+ * number of matches, start the slow part: recurse to verify each
+ * sub-match. We always have k <= max_matches, needn't check that.
+ */
+ if (k < min_matches)
+ goto backtrack;
+
+ MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+ for (i = nverified + 1; i <= k; i++) {
+ zaptreesubs(v, t->left);
+ er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+ if (er == REG_OKAY) {
+ nverified = i;
+ continue;
+ }
+ if (er == REG_NOMATCH)
+ break;
+ /* oops, something failed */
+ FREE(endpts);
+ return er;
}
- freeDFA(d);
- MDEBUG(("cAlt matched\n"));
- v->mem[t->retry] = TRYING;
- }
- er = complicatedDissect(v, t->left, begin, end);
- if (er != REG_NOMATCH) {
- return er;
+ if (i > k) {
+ /* satisfaction */
+ MDEBUG(("%d successful\n", t->id));
+ FREE(endpts);
+ return REG_OKAY;
+ }
+
+ /* match failed to verify, so backtrack */
+
+ backtrack:
+ /*
+ * Must consider longer versions of the current sub-match.
+ */
+ while (k > 0) {
+ if (endpts[k] < end) {
+ limit = endpts[k] + 1;
+ /* break out of backtrack loop, continue the outer one */
+ break;
+ }
+ /* can't lengthen k'th sub-match any more, consider previous one */
+ k--;
+ }
}
- v->mem[t->retry] = TRIED;
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- goto doRight;
-#else
- doRight:
- return complicatedAlternationDissect(v, t->right, begin, end);
-#endif
+ /* all possibilities exhausted */
+ MDEBUG(("%d failed\n", t->id));
+ FREE(endpts);
+ return REG_NOMATCH;
}
#include "rege_dfa.c"
diff --git a/generic/regguts.h b/generic/regguts.h
index b478e4c..1ac2465 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -99,7 +99,7 @@
#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
-#define INFINITY (DUPMAX+1)
+#define DUPINF (DUPMAX+1)
#define REMAGIC 0xfed7 /* magic number for main struct */
@@ -186,7 +186,14 @@ struct colordesc {
union tree *block; /* block of solid color, if any */
};
-/* the color map itself */
+/*
+ * The color map itself
+ *
+ * Much of the data in the colormap struct is only used at compile time.
+ * However, the bulk of the space usage is in the "tree" structure, so it's
+ * not clear that there's much point in converting the rest to a more compact
+ * form when compilation is finished.
+ */
struct colormap {
int magic;
#define CMMAGIC 0x876
@@ -242,14 +249,15 @@ struct cvec {
struct state;
struct arc {
- int type;
-#define ARCFREE '\0'
+ int type; /* 0 if free, else an NFA arc type code */
color co;
struct state *from; /* where it's from (and contained within) */
struct state *to; /* where it's to */
- struct arc *outchain; /* *from's outs chain or free chain */
-#define freechain outchain
+ struct arc *outchain; /* link in *from's outs chain or free chain */
+ struct arc *outchainRev; /* back-link in *from's outs chain */
+#define freechain outchain /* we do not maintain "freechainRev" */
struct arc *inchain; /* *to's ins chain */
+ struct arc *inchainRev; /* back-link in *to's ins chain */
struct arc *colorchain; /* color's arc chain */
struct arc *colorchainRev; /* back-link in color's arc chain */
};
@@ -288,20 +296,28 @@ struct nfa {
struct colormap *cm; /* the color map */
color bos[2]; /* colors, if any, assigned to BOS and BOL */
color eos[2]; /* colors, if any, assigned to EOS and EOL */
- size_t size; /* Current NFA size; differs from nstates as
- * it also counts the number of states created
- * by children of this state. */
struct vars *v; /* simplifies compile error reporting */
struct nfa *parent; /* parent NFA, if any */
};
/*
* definitions for compacted NFA
+ *
+ * The main space savings in a compacted NFA is from making the arcs as small
+ * as possible. We store only the transition color and next-state number for
+ * each arc. The list of out arcs for each state is an array beginning at
+ * cnfa.states[statenumber], and terminated by a dummy carc struct with
+ * co == COLORLESS.
+ *
+ * The non-dummy carc structs are of two types: plain arcs and LACON arcs.
+ * Plain arcs just store the transition color number as "co". LACON arcs
+ * store the lookahead constraint number plus cnfa.ncolors as "co". LACON
+ * arcs can be distinguished from plain by testing for co >= cnfa.ncolors.
*/
struct carc {
color co; /* COLORLESS is list terminator */
- int to; /* state number */
+ int to; /* next-state number */
};
struct cnfa {
@@ -313,27 +329,52 @@ struct cnfa {
int post; /* teardown state number */
color bos[2]; /* colors, if any, assigned to BOS and BOL */
color eos[2]; /* colors, if any, assigned to EOS and EOL */
+ char *stflags; /* vector of per-state flags bytes */
+#define CNFA_NOPROGRESS 01 /* flag bit for a no-progress state */
struct carc **states; /* vector of pointers to outarc lists */
+ /* states[n] are pointers into a single malloc'd array of arcs */
struct carc *arcs; /* the area for the lists */
};
#define ZAPCNFA(cnfa) ((cnfa).nstates = 0)
#define NULLCNFA(cnfa) ((cnfa).nstates == 0)
/*
- * Used to limit the maximum NFA size to something sane. [Bug 1810264]
+ * This symbol limits the transient heap space used by the regex compiler,
+ * and thereby also the maximum complexity of NFAs that we'll deal with.
+ * Currently we only count NFA states and arcs against this; the other
+ * transient data is generally not large enough to notice compared to those.
+ * Note that we do not charge anything for the final output data structures
+ * (the compacted NFA and the colormap).
*/
-
-#ifndef REG_MAX_STATES
-# define REG_MAX_STATES 100000
+#ifndef REG_MAX_COMPILE_SPACE
+#define REG_MAX_COMPILE_SPACE \
+ (100000 * sizeof(struct state) + 100000 * sizeof(struct arcbatch))
#endif
/*
* subexpression tree
+ *
+ * "op" is one of:
+ * '=' plain regex without interesting substructure (implemented as DFA)
+ * 'b' back-reference (has no substructure either)
+ * '(' capture node: captures the match of its single child
+ * '.' concatenation: matches a match for left, then a match for right
+ * '|' alternation: matches a match for left or a match for right
+ * '*' iteration: matches some number of matches of its single child
+ *
+ * Note: the right child of an alternation must be another alternation or
+ * NULL; hence, an N-way branch requires N alternation nodes, not N-1 as you
+ * might expect. This could stand to be changed. Actually I'd rather see
+ * a single alternation node with N children, but that will take revising
+ * the representation of struct subre.
+ *
+ * Note: when a backref is directly quantified, we stick the min/max counts
+ * into the backref rather than plastering an iteration node on top. This is
+ * for efficiency: there is no need to search for possible division points.
*/
struct subre {
- char op; /* '|', '.' (concat), 'b' (backref), '(',
- * '=' */
+ char op; /* see type codes above */
char flags;
#define LONGER 01 /* prefers longer match */
#define SHORTER 02 /* prefers shorter match */
@@ -349,10 +390,10 @@ struct subre {
#define PREF(f) ((f)&NOPROP)
#define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
#define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2))
- short retry; /* index into retry memory */
+ short id; /* ID of subre (1..ntree-1) */
int subno; /* subexpression number (for 'b' and '(') */
- short min; /* min repetitions, for backref only */
- short max; /* max repetitions, for backref only */
+ short min; /* min repetitions for iteration or backref */
+ short max; /* max repetitions for iteration or backref */
struct subre *left; /* left child, if any (also freelist chain) */
struct subre *right; /* right child, if any */
struct state *begin; /* outarcs from here... */
@@ -382,7 +423,7 @@ struct guts {
size_t nsub; /* copy of re_nsub */
struct subre *tree;
struct cnfa search; /* for fast preliminary search */
- int ntree;
+ int ntree; /* number of subre's, plus one */
struct colormap cmap;
int FUNCPTR(compare, (const chr *, const chr *, size_t));
struct subre *lacons; /* lookahead-constraint vector */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 1829249..574b49b 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2,8 +2,8 @@
#
# This file contains the declarations for all supported public
# functions that are exported by the Tcl library via the stubs table.
-# This file is used to generate the tclDecls.h, tclPlatDecls.h,
-# tclStub.c, and tclPlatStub.c files.
+# This file is used to generate the tclDecls.h, tclPlatDecls.h
+# and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
@@ -37,7 +37,7 @@ declare 1 {
void *clientDataPtr)
}
declare 2 {
- void Tcl_Panic(const char *format, ...)
+ TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
char *Tcl_Alloc(unsigned int size)
@@ -480,7 +480,7 @@ declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
- void Tcl_Exit(int status)
+ TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
@@ -815,7 +815,7 @@ declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {
- void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
+ void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
@@ -986,7 +986,7 @@ declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {
- void Tcl_PanicVA(const char *format, va_list argList)
+ TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
@@ -1872,7 +1872,7 @@ declare 518 {
# TIP#121 (exit handler) dkf for Joe Mistachkin
declare 519 {
- Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+ Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
# TIP#143 (resource limits) dkf
diff --git a/generic/tcl.h b/generic/tcl.h
index a833218..3490049 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -56,10 +56,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 0
+#define TCL_RELEASE_SERIAL 5
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6.0"
+#define TCL_PATCH_LEVEL "8.6.5"
/*
*----------------------------------------------------------------------------
@@ -67,27 +67,14 @@ extern "C" {
* We use this method because there is no autoconf equivalent.
*/
-#ifndef __WIN32__
-# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+# ifndef __WIN32__
# define __WIN32__
-# ifndef WIN32
-# define WIN32
-# endif
-# ifndef _WIN32
-# define _WIN32
-# endif
# endif
-#endif
-
-/*
- * STRICT: See MSDN Article Q83456
- */
-
-#ifdef __WIN32__
-# ifndef STRICT
-# define STRICT
+# ifndef WIN32
+# define WIN32
# endif
-#endif /* __WIN32__ */
+#endif
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -156,8 +143,20 @@ extern "C" {
#endif
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
+# define TCL_NORETURN __attribute__ ((noreturn))
+# if defined(BUILD_tcl) || defined(BUILD_tk)
+# define TCL_NORETURN1 __attribute__ ((noreturn))
+# else
+# define TCL_NORETURN1 /* nothing */
+# endif
#else
# define TCL_FORMAT_PRINTF(a,b)
+# if defined(_MSC_VER) && (_MSC_VER >= 1310)
+# define TCL_NORETURN _declspec(noreturn)
+# else
+# define TCL_NORETURN /* nothing */
+# endif
+# define TCL_NORETURN1 /* nothing */
#endif
/*
@@ -168,7 +167,7 @@ extern "C" {
*/
#if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1)))
-# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5))
+# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5))
# define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg)))
# else
# define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__))
@@ -191,7 +190,7 @@ extern "C" {
* MSVCRT.
*/
-#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
# define HAVE_DECLSPEC 1
# ifdef STATIC_BUILD
# define DLLIMPORT
@@ -315,14 +314,14 @@ extern "C" {
* VOID. This block is skipped under Cygwin and Mingw.
*/
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
@@ -390,7 +389,7 @@ typedef long LONG;
*/
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-# if defined(__WIN32__)
+# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
# ifdef __BORLANDC__
# define TCL_LL_MODIFIER "L"
@@ -400,22 +399,18 @@ typedef long LONG;
# elif defined(__GNUC__)
# define TCL_WIDE_INT_TYPE long long
# define TCL_LL_MODIFIER "ll"
-# else /* ! __WIN32__ && ! __GNUC__ */
+# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
*/
-# ifdef NO_LIMITS_H
-# error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
-# else /* !NO_LIMITS_H */
-# include <limits.h>
-# if (INT_MAX < LONG_MAX)
-# define TCL_WIDE_INT_IS_LONG 1
-# else
-# define TCL_WIDE_INT_TYPE long long
-# endif
-# endif /* NO_LIMITS_H */
-# endif /* __WIN32__ */
+# include <limits.h>
+# if (INT_MAX < LONG_MAX)
+# define TCL_WIDE_INT_IS_LONG 1
+# else
+# define TCL_WIDE_INT_TYPE long long
+# endif
+# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
@@ -447,7 +442,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */
-#if defined(__WIN32__)
+#if defined(_WIN32)
# ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
# elif defined(_WIN64)
@@ -458,7 +453,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
typedef struct _stat32i64 Tcl_StatBuf;
# endif /* _MSC_VER < 1400 */
#elif defined(__CYGWIN__)
- typedef struct _stat32i64 {
+ typedef struct {
dev_t st_dev;
unsigned short st_ino;
unsigned short st_mode;
@@ -562,7 +557,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
* will be called as the main fuction of the new thread created by that call.
*/
-#if defined __WIN32__
+#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
#else
typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
@@ -574,7 +569,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
* in generic/tclThreadTest.c for it's usage.
*/
-#if defined __WIN32__
+#if defined _WIN32
# define Tcl_ThreadCreateType unsigned __stdcall
# define TCL_THREAD_CREATE_RETURN return 0
#else
@@ -833,18 +828,19 @@ typedef struct Tcl_Obj {
union { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
- void *otherValuePtr; /* - another, type-specific value. */
+ void *otherValuePtr; /* - another, type-specific value,
+ not used internally any more. */
Tcl_WideInt wideValue; /* - a long long value. */
- struct { /* - internal rep as two pointers. */
+ struct { /* - internal rep as two pointers.
+ * the main use of which is a bignum's
+ * tightly packed fields, where the alloc,
+ * used and signum flags are packed into
+ * ptr2 with everything else hung off ptr1. */
void *ptr1;
void *ptr2;
} twoPtrValue;
struct { /* - internal rep as a pointer and a long,
- * the main use of which is a bignum's
- * tightly packed fields, where the alloc,
- * used and signum flags are packed into a
- * single word with everything else hung
- * off the pointer. */
+ not used internally any more. */
void *ptr;
unsigned long value;
} ptrAndLongRep;
@@ -2147,11 +2143,28 @@ typedef struct Tcl_EncodingType {
* substituting one or more "close" characters in
* the destination buffer and then continue to
* convert the source.
+ * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf will not append a
+ * terminating NUL byte. Knowing that it will
+ * not need space to do so, it will fill all
+ * dstLen bytes with encoded UTF-8 content, as
+ * other circumstances permit. If clear, the
+ * default behavior is to reserve a byte in
+ * the dst space for NUL termination, and to
+ * append the NUL byte.
+ * TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then
+ * Tcl_ExternalToUtf takes the initial value
+ * of *dstCharsPtr is taken as a limit of the
+ * maximum number of chars to produce in the
+ * encoded UTF-8 content. Otherwise, the
+ * number of chars produced is controlled only
+ * by other limiting factors.
*/
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#define TCL_ENCODING_STOPONERROR 0x04
+#define TCL_ENCODING_NO_TERMINATE 0x08
+#define TCL_ENCODING_CHAR_LIMIT 0x10
/*
* The following definitions are the error codes returned by the conversion
@@ -2422,9 +2435,7 @@ EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
-#endif
/*
*----------------------------------------------------------------------------
@@ -2436,9 +2447,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
/*
* Include platform specific public function declarations that are accessible
- * via the stubs table.
+ * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
+ * has effect on building it as a shared library). See ticket [3010352].
*/
+#if defined(BUILD_tcl)
+# undef TCLAPI
+# define TCLAPI MODULE_SCOPE
+#endif
+
#include "tclPlatDecls.h"
/*
@@ -2505,7 +2522,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define Tcl_DecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
- if (--(_objPtr)->refCount <= 0) { \
+ if ((_objPtr)->refCount-- <= 1) { \
TclFreeObj(_objPtr); \
} \
} while(0)
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index ae61e85..cda1f38 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -31,7 +31,7 @@
* until Tcl uses config.h properly.
*/
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
+#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 100e9ef..f56da8f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -26,6 +26,7 @@
*- jumpTable testing
*- syntax (?)
*- returnCodeBranch
+ *- tclooNext, tclooNextClass
*/
#include "tclInt.h"
@@ -49,7 +50,7 @@ typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
BBCS_NONE, /* Block is outside of any catch */
BBCS_INCATCH, /* Block is within a catch context */
- BBCS_CAUGHT, /* Block is within a catch context and
+ BBCS_CAUGHT /* Block is within a catch context and
* may be executed after an exception fires */
} BasicBlockCatchState;
@@ -120,7 +121,7 @@ enum BasicBlockFlags {
* marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
- BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
+ BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction,
* unwinding the catch from the exception
* stack. */
};
@@ -183,7 +184,7 @@ typedef enum TalInstType {
* produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand
* (INCR_STK_IMM) */
- ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
+ ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by
* LVT entry. Fixed arity */
} TalInstType;
@@ -349,7 +350,8 @@ static const TalInstDesc TalInstructionTable[] = {
{"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
{"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
- {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
+ {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
+ {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1},
{"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
{"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
@@ -408,6 +410,10 @@ static const TalInstDesc TalInstructionTable[] = {
{"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8
| INST_LAPPEND_ARRAY4),2, 1},
{"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1},
+ {"lappendList", ASSEM_LVT4, INST_LAPPEND_LIST, 1, 1},
+ {"lappendListArray",ASSEM_LVT4, INST_LAPPEND_LIST_ARRAY,2, 1},
+ {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3, 1},
+ {"lappendListStk", ASSEM_1BYTE, INST_LAPPEND_LIST_STK, 2, 1},
{"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1},
{"le", ASSEM_1BYTE, INST_LE, 2, 1},
{"lindexMulti", ASSEM_LINDEX_MULTI,
@@ -436,6 +442,8 @@ static const TalInstDesc TalInstructionTable[] = {
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
+ {"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1},
+ {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1},
{"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
{"pop", ASSEM_1BYTE, INST_POP, 1, 0},
{"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
@@ -452,7 +460,11 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_STORE_ARRAY4), 2, 1},
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
{"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1},
+ {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
+ {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
+ {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
{"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
{"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
{"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1},
{"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
@@ -461,12 +473,17 @@ static const TalInstDesc TalInstructionTable[] = {
{"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
{"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
+ {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
{"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
+ {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
+ {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
+ {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1},
{"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
{"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1},
{"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
{"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
{"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
+ {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
@@ -493,6 +510,7 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
INST_JUMP1, INST_JUMP4, /* 34-35 */
INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_LIST, /* 79 */
INST_OVER, /* 95 */
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
@@ -502,7 +520,11 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_COROUTINE_NAME, /* 149 */
INST_NS_CURRENT, /* 151 */
INST_INFO_LEVEL_NUM, /* 152 */
- INST_RESOLVE_COMMAND /* 154 */
+ INST_RESOLVE_COMMAND, /* 154 */
+ INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
+ INST_CONCAT_STK, /* 169 */
+ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
+ INST_NUM_TYPE /* 180 */
};
/*
@@ -682,7 +704,7 @@ BBEmitInstInt4(
* BBEmitInst1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand
+ * operand.
*
*-----------------------------------------------------------------------------
*/
@@ -2617,6 +2639,7 @@ AllocBB(
bb->minStackDepth = 0;
bb->maxStackDepth = 0;
bb->finalStackDepth = 0;
+ bb->catchDepth = 0;
bb->enclosingCatch = NULL;
bb->foreignExceptionBase = -1;
bb->foreignExceptionCount = 0;
@@ -3961,10 +3984,12 @@ UnstackExpiredCatches(
while (catchDepth > bbPtr->catchDepth) {
--catchDepth;
- range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
- range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
- catches[catchDepth] = NULL;
- catchIndices[catchDepth] = -1;
+ if (catches[catchDepth] != NULL) {
+ range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+ range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+ catches[catchDepth] = NULL;
+ catchIndices[catchDepth] = -1;
+ }
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c1032f9..e5d7406 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -22,10 +22,7 @@
#include "tclCompile.h"
#include "tommath.h"
#include <math.h>
-
-#if NRE_ENABLE_ASSERTS
#include <assert.h>
-#endif
#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE 200
@@ -147,7 +144,7 @@ static int TEOV_NotFound(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Namespace *lookupNsPtr);
static int TEOV_RunEnterTraces(Tcl_Interp *interp,
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
- Tcl_Obj *const objv[], Namespace *lookupNsPtr);
+ Tcl_Obj *const objv[]);
static Tcl_NRPostProc RewindCoroutineCallback;
static Tcl_NRPostProc TailcallCleanup;
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
@@ -157,9 +154,11 @@ static Tcl_NRPostProc TEOV_Exception;
static Tcl_NRPostProc TEOV_NotFoundCallback;
static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
+static Tcl_NRPostProc EvalObjvCore;
static Tcl_NRPostProc Dispatch;
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
MODULE_SCOPE const TclStubs tclStubs;
@@ -209,7 +208,7 @@ static const CmdInfo builtInCmds[] = {
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
- {"concat", Tcl_ConcatObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
{"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE},
{"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE},
@@ -225,7 +224,7 @@ static const CmdInfo builtInCmds[] = {
{"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE},
{"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE},
{"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE},
- {"linsert", Tcl_LinsertObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE},
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
@@ -257,7 +256,7 @@ static const CmdInfo builtInCmds[] = {
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
- {"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE},
+ {"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
@@ -470,7 +469,6 @@ Tcl_CreateInterp(void)
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
- int result;
TclInitSubsystems();
@@ -524,6 +522,9 @@ Tcl_CreateInterp(void)
iPtr->hiddenCmdTablePtr = NULL;
iPtr->interpInfo = NULL;
+ TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+ iPtr->extra.optimizer = TclOptimizeBytecode;
+
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
iPtr->framePtr = NULL; /* Initialise as soon as :: is available */
@@ -637,11 +638,8 @@ Tcl_CreateInterp(void)
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
framePtr = ckalloc(sizeof(CallFrame));
- result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+ (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
(Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
- }
framePtr->objc = 0;
iPtr->framePtr = framePtr;
@@ -835,7 +833,9 @@ Tcl_CreateInterp(void)
*/
Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
- Tcl_DisassembleObjCmd, NULL, NULL);
+ Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
+ Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
Tcl_RepresentationCmd, NULL, NULL);
@@ -916,6 +916,13 @@ Tcl_CreateInterp(void)
TclInitEmbeddedConfigurationInformation(interp);
/*
+ * TIP #440: Declare the name of the script engine to be "Tcl".
+ */
+
+ Tcl_SetVar2(interp, "tcl_platform", "engine", "Tcl",
+ TCL_GLOBAL_ONLY);
+
+ /*
* Compute the byte order of this machine.
*/
@@ -2080,10 +2087,19 @@ Tcl_CreateCommand(
*/
cmdPtr = Tcl_GetHashValue(hPtr);
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2173,7 +2189,8 @@ Tcl_CreateCommand(
*
* Side effects:
* If a command named "cmdName" already exists for interp, it is
- * first deleted. Then the new command is created from the arguments.
+ * first deleted. Then the new command is created from the arguments.
+ * [***] (See below for exception).
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
@@ -2240,17 +2257,45 @@ Tcl_CreateObjCommand(
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
+ /* Command already exists. */
+
+ /*
+ * [***] This is wrong. See Tcl Bug a16752c252.
+ * However, this buggy behavior is kept under particular
+ * circumstances to accommodate deployed binaries of the
+ * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
+ * that crash if the bug is fixed.
+ */
+
+ if (cmdPtr->objProc == TclInvokeStringCommand
+ && cmdPtr->clientData == clientData
+ && cmdPtr->deleteData == clientData
+ && cmdPtr->deleteProc == deleteProc) {
+ cmdPtr->objProc = proc;
+ cmdPtr->objClientData = clientData;
+ return (Tcl_Command) cmdPtr;
+ }
+
/*
- * Command already exists; delete it. Be careful to preserve any
+ * Otherwise, we delete the old command. Be careful to preserve any
* existing import links so we can restore them down below. That way,
* you can redefine a command and its import status will remain
* intact.
*/
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -3039,7 +3084,7 @@ Tcl_DeleteCommandFromToken(
while (tracePtr != NULL) {
CommandTrace *nextPtr = tracePtr->nextPtr;
- if ((--tracePtr->refCount) <= 0) {
+ if (tracePtr->refCount-- <= 1) {
ckfree(tracePtr);
}
tracePtr = nextPtr;
@@ -3092,12 +3137,13 @@ Tcl_DeleteCommandFromToken(
* commands were created that refer back to this command. Delete these
* imported commands now.
*/
-
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
+ if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
+ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = nextRefPtr) {
+ nextRefPtr = refPtr->nextPtr;
+ importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+ Tcl_DeleteCommandFromToken(interp, importCmd);
+ }
}
/*
@@ -3224,7 +3270,7 @@ CallCommandTraces(
tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
oldName, newName, flags);
cmdPtr->flags &= ~tracePtr->flags;
- if ((--tracePtr->refCount) <= 0) {
+ if (tracePtr->refCount-- <= 1) {
ckfree(tracePtr);
}
}
@@ -4093,42 +4139,39 @@ TclNREvalObjv(
* requested Command struct to be invoked. */
{
Interp *iPtr = (Interp *) interp;
- int result;
- Namespace *lookupNsPtr = iPtr->lookupNsPtr;
- Command **cmdPtrPtr;
- NRE_callback *callbackPtr;
-
- iPtr->lookupNsPtr = NULL;
/*
- * Push a callback with cleanup tasks for commands; the cmdPtr at data[0]
- * will be filled later when the command is found: save its address at
- * objProcPtr.
- *
* data[1] stores a marker for use by tailcalls; it will be set to 1 by
- * command redirectors (imports, alias, ensembles) so that tailcalls
- * finishes the source command and not just the target.
+ * command redirectors (imports, alias, ensembles) so that tailcall skips
+ * this callback (that marks the end of the target command) and goes back
+ * to the end of the source command.
*/
if (iPtr->deferredCallbacks) {
- callbackPtr = iPtr->deferredCallbacks;
iPtr->deferredCallbacks = NULL;
} else {
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
- callbackPtr = TOP_CB(interp);
}
- cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
iPtr->numLevels++;
- result = TclInterpReady(interp);
-
- if ((result != TCL_OK) || (objc == 0)) {
- return result;
- }
+ TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
+ INT2PTR(objc), objv);
+ return TCL_OK;
+}
- if (cmdPtr) {
- goto commandFound;
- }
+static int
+EvalObjvCore(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Command *cmdPtr = NULL, *preCmdPtr = data[0];
+ int flags = PTR2INT(data[1]);
+ int objc = PTR2INT(data[2]);
+ Tcl_Obj **objv = data[3];
+ Interp *iPtr = (Interp *) interp;
+ Namespace *lookupNsPtr = NULL;
+ int enterTracesDone = 0;
/*
* Push records for task to be done on return, in INVERSE order. First, if
@@ -4139,63 +4182,150 @@ TclNREvalObjv(
TEOV_PushExceptionHandlers(interp, objc, objv, flags);
}
+ if (TCL_OK != TclInterpReady(interp)) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ if (TclLimitExceeded(iPtr->limit)) {
+ return TCL_ERROR;
+ }
+
/*
* Configure evaluation context to match the requested flags.
*/
- if ((flags & TCL_EVAL_INVOKE) || lookupNsPtr) {
- if (!lookupNsPtr) {
- lookupNsPtr = iPtr->globalNsPtr;
- }
+ if (iPtr->lookupNsPtr) {
+
+ /*
+ * Capture the namespace we should do command name resolution in, as
+ * instructed by our caller sneaking it in to us in a private interp
+ * field. Clear that field right away so we cannot possibly have its
+ * use leak where it should not. The sneaky message pass is done.
+ *
+ * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
+ * TODO: Is that a bug?
+ */
+
+ lookupNsPtr = iPtr->lookupNsPtr;
+ iPtr->lookupNsPtr = NULL;
+ } else if (flags & TCL_EVAL_INVOKE) {
+ lookupNsPtr = iPtr->globalNsPtr;
} else {
- if (flags & TCL_EVAL_GLOBAL) {
- TEOV_SwitchVarFrame(interp);
- lookupNsPtr = iPtr->globalNsPtr;
- }
/*
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
iPtr->ensembleRewrite.sourceObjs = NULL;
+
+ if (flags & TCL_EVAL_GLOBAL) {
+ TEOV_SwitchVarFrame(interp);
+ lookupNsPtr = iPtr->globalNsPtr;
+ }
}
/*
- * Lookup the command
+ * Lookup the Command to dispatch.
*/
- cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
- if (!cmdPtr) {
- return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+ reresolve:
+ assert(cmdPtr == NULL);
+ if (preCmdPtr) {
+ /* Caller gave it to us */
+ if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+ /* So long as it exists, use it. */
+ cmdPtr = preCmdPtr;
+ } else if (flags & TCL_EVAL_NORESOLVE) {
+ /*
+ * When it's been deleted, and we're told not to attempt
+ * resolving it ourselves, all we can do is raise an error.
+ */
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to invoke a deleted command"));
+ Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
+ return TCL_ERROR;
+ }
}
-
- iPtr->cmdCount++;
- if (TclLimitExceeded(iPtr->limit)) {
- return TCL_ERROR;
+ if (cmdPtr == NULL) {
+ cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+ if (!cmdPtr) {
+ return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+ }
}
- /*
- * Found a command! The real work begins now ...
- */
+ if (enterTracesDone || iPtr->tracePtr
+ || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+
+ Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+ flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
+ objc, objv);
+ Tcl_IncrRefCount(commandPtr);
+
+ if (!enterTracesDone) {
+
+ int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
+ objc, objv);
+
+ /*
+ * Send any exception from enter traces back as an exception
+ * raised by the traced command.
+ * TODO: Is this a bug? Letting an execution trace BREAK or
+ * CONTINUE or RETURN in the place of the traced command?
+ * Would either converting all exceptions to TCL_ERROR, or
+ * just swallowing them be better? (Swallowing them has the
+ * problem of permanently hiding program errors.)
+ */
+
+ if (code != TCL_OK) {
+ Tcl_DecrRefCount(commandPtr);
+ return code;
+ }
+
+ /*
+ * If the enter traces made the resolved cmdPtr unusable, go
+ * back and resolve again, but next time don't run enter
+ * traces again.
+ */
+
+ if (cmdPtr == NULL) {
+ enterTracesDone = 1;
+ Tcl_DecrRefCount(commandPtr);
+ goto reresolve;
+ }
+ }
- commandFound:
- if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
/*
- * Call enter traces. They will schedule a call to the leave traces if
- * necessary.
+ * Schedule leave traces. Raise the refCount on the resolved
+ * cmdPtr, so that when it passes to the leave traces we know
+ * it's still valid.
*/
- result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame(
- flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
- objc, objv), objc, objv, lookupNsPtr);
- if (result != TCL_OK) {
- return result;
- }
- if (!cmdPtr) {
- return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
- }
+ cmdPtr->refCount++;
+ TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+ commandPtr, cmdPtr, objv);
}
+ TclNRAddCallback(interp, Dispatch,
+ cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
+ cmdPtr->objClientData, INT2PTR(objc), objv);
+ return TCL_OK;
+}
+
+static int
+Dispatch(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_ObjCmdProc *objProc = data[0];
+ ClientData clientData = data[1];
+ int objc = PTR2INT(data[2]);
+ Tcl_Obj **objv = data[3];
+ Interp *iPtr = (Interp *) interp;
#ifdef USE_DTRACE
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
@@ -4216,41 +4346,18 @@ TclNREvalObjv(
TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
TclDecrRefCount(info);
}
- if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) {
+ if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
+ && objc) {
TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
}
- if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
+ if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
#endif /* USE_DTRACE */
- /*
- * Fix the original callback to point to the now known cmdPtr. Insure that
- * the Command struct lives until the command returns.
- */
-
- *cmdPtrPtr = cmdPtr;
- cmdPtr->refCount++;
-
- TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL);
- return TCL_OK;
-}
-
-static int
-Dispatch(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Command *cmdPtr = data[0];
- int objc = PTR2INT(data[1]);
- Tcl_Obj **objv = data[2];
- if (cmdPtr->nreProc) {
- return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
- } else {
- return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
- }
+ iPtr->cmdCount++;
+ return objProc(clientData, interp, objc, objv);
}
int
@@ -4296,18 +4403,13 @@ NRCommand(
int result)
{
Interp *iPtr = (Interp *) interp;
- Command *cmdPtr = data[0];
- /* int cmdStart = PTR2INT(data[1]); NOT USED HERE */
- if (cmdPtr) {
- TclCleanupCommandMacro(cmdPtr);
- }
- ((Interp *)interp)->numLevels--;
+ iPtr->numLevels--;
/*
- * If there is a tailcall, schedule it
+ * If there is a tailcall, schedule it next
*/
-
+
if (data[1] && (data[1] != INT2PTR(1))) {
TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
}
@@ -4594,25 +4696,19 @@ TEOV_RunEnterTraces(
Command **cmdPtrPtr,
Tcl_Obj *commandPtr,
int objc,
- Tcl_Obj *const objv[],
- Namespace *lookupNsPtr)
+ Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- int traceCode = TCL_OK;
- int cmdEpoch = cmdPtr->cmdEpoch;
- int newEpoch;
- const char *command;
- int length;
-
- Tcl_IncrRefCount(commandPtr);
- command = Tcl_GetStringFromObj(commandPtr, &length);
+ int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ int length, traceCode = TCL_OK;
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
/*
* Call trace functions.
* Execute any command or execution traces. Note that we bump up the
- * command's reference count for the duration of the calling of the traces
- * so that the structure doesn't go away underneath our feet.
+ * command's reference count for the duration of the calling of the
+ * traces so that the structure doesn't go away underneath our feet.
*/
cmdPtr->refCount++;
@@ -4627,29 +4723,22 @@ TEOV_RunEnterTraces(
newEpoch = cmdPtr->cmdEpoch;
TclCleanupCommandMacro(cmdPtr);
- /*
- * If the traces modified/deleted the command or any existing traces, they
- * will update the command's epoch. We need to lookup again, but do not
- * run enter traces on the newly found cmdPtr.
- */
-
- if (cmdEpoch != newEpoch) {
- cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
- *cmdPtrPtr = cmdPtr;
+ if (traceCode != TCL_OK) {
+ if (traceCode == TCL_ERROR) {
+ Tcl_Obj *info;
+
+ TclNewLiteralStringObj(info, "\n (enter trace on \"");
+ Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+ Tcl_AppendToObj(info, "\")", 2);
+ Tcl_AppendObjToErrorInfo(interp, info);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ return traceCode;
}
-
- if (cmdPtr && (traceCode == TCL_OK)) {
- /*
- * Command was found: push a record to schedule the leave traces.
- */
-
- TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
- commandPtr, cmdPtr, objv);
- cmdPtr->refCount++;
- } else {
- Tcl_DecrRefCount(commandPtr);
+ if (cmdEpoch != newEpoch) {
+ *cmdPtrPtr = NULL;
}
- return traceCode;
+ return TCL_OK;
}
static int
@@ -4664,12 +4753,10 @@ TEOV_RunLeaveTraces(
Tcl_Obj *commandPtr = data[1];
Command *cmdPtr = data[2];
Tcl_Obj **objv = data[3];
-
+ int length;
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
- int length;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
-
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -4679,7 +4766,6 @@ TEOV_RunLeaveTraces(
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
}
- Tcl_DecrRefCount(commandPtr);
/*
* As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
@@ -4690,8 +4776,18 @@ TEOV_RunLeaveTraces(
TclCleanupCommandMacro(cmdPtr);
if (traceCode != TCL_OK) {
- return traceCode;
+ if (traceCode == TCL_ERROR) {
+ Tcl_Obj *info;
+
+ TclNewLiteralStringObj(info, "\n (leave trace on \"");
+ Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+ Tcl_AppendToObj(info, "\")", 2);
+ Tcl_AppendObjToErrorInfo(interp, info);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ result = traceCode;
}
+ Tcl_DecrRefCount(commandPtr);
return result;
}
@@ -4707,7 +4803,6 @@ TEOV_LookupCmdFromObj(
if (lookupNsPtr) {
iPtr->varFramePtr->nsPtr = lookupNsPtr;
- iPtr->lookupNsPtr = NULL;
}
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
@@ -5548,10 +5643,10 @@ TclArgumentBCEnter(
* ensemble dispatch. Ensemble subcommands that lead to script
* evaluation are not supposed to get compiled, because a command
* such as [info level] in the script can expose some of the dispatch
- * shenanigans. This means that we don't have to tend to the
+ * shenanigans. This means that we don't have to tend to the
* housekeeping, and can escape now.
*/
-
+
if (ePtr->nline != objc) {
return;
}
@@ -5815,7 +5910,7 @@ Tcl_GlobalEvalObj(
*
* If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
* must be NULL. Support for non-NULL invokers in that mode has
- * been removed since it was unused and untested. Failure to
+ * been removed since it was unused and untested. Failure to
* follow this limitation will lead to an assertion panic.
*
* Results:
@@ -6423,11 +6518,7 @@ TclObjInvokeNamespace(
* command.
*/
- result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
-
+ (void) TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
result = TclObjInvoke(interp, objc, objv, flags);
TclPopStackFrame(interp);
@@ -6462,30 +6553,32 @@ TclObjInvoke(
* TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
* or TCL_INVOKE_NO_TRACEBACK. */
{
- register Interp *iPtr = (Interp *) interp;
- Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
- const char *cmdName; /* Name of the command from objv[0]. */
- Tcl_HashEntry *hPtr = NULL;
- Command *cmdPtr;
- int result;
-
if (interp == NULL) {
return TCL_ERROR;
}
-
if ((objc < 1) || (objv == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal argument vector", -1));
return TCL_ERROR;
}
-
if ((flags & TCL_INVOKE_HIDDEN) == 0) {
Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
}
+ return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
+}
- if (TclInterpReady(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
+int
+TclNRInvoke(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ register Interp *iPtr = (Interp *) interp;
+ Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
+ const char *cmdName; /* Name of the command from objv[0]. */
+ Tcl_HashEntry *hPtr = NULL;
+ Command *cmdPtr;
cmdName = TclGetString(objv[0]);
hTblPtr = iPtr->hiddenCmdTablePtr;
@@ -6501,36 +6594,27 @@ TclObjInvoke(
}
cmdPtr = Tcl_GetHashValue(hPtr);
- /*
- * Invoke the command function.
- */
-
- iPtr->cmdCount++;
- if (cmdPtr->objProc != NULL) {
- result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
- } else {
- result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
- cmdPtr->objClientData, objc, objv);
- }
+ /* Avoid the exception-handling brain damage when numLevels == 0 . */
+ iPtr->numLevels++;
+ Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
/*
- * If an error occurred, record information about what was being executed
- * when the error occurred.
+ * Normal command resolution of objv[0] isn't going to find cmdPtr.
+ * That's the whole point of **hidden** commands. So tell the
+ * Eval core machinery not to even try (and risk finding something wrong).
*/
- if ((result == TCL_ERROR)
- && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
- && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
- int length;
- Tcl_Obj *command = Tcl_NewListObj(objc, objv);
- const char *cmdString;
+ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
+}
- Tcl_IncrRefCount(command);
- cmdString = Tcl_GetStringFromObj(command, &length);
- Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
- Tcl_DecrRefCount(command);
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
- }
+static int
+NRPostInvoke(
+ ClientData clientData[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *)interp;
+ iPtr->numLevels--;
return result;
}
@@ -7981,39 +8065,11 @@ Tcl_NRCallObjProc(
int objc,
Tcl_Obj *const objv[])
{
- int result = TCL_OK;
NRE_callback *rootPtr = TOP_CB(interp);
-#ifdef USE_DTRACE
- if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
- const char *a[10];
- int i = 0;
-
- while (i < 10) {
- a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
- }
- TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
- a[8], a[9]);
- }
- if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) {
- Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr);
- const char *a[6]; int i[2];
-
- TclDTraceInfo(info, a, i);
- TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
- TclDecrRefCount(info);
- }
- if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
- && objc) {
- TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
- }
- if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
- TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
- (Tcl_Obj **)(objv + 1));
- }
-#endif /* USE_DTRACE */
- result = objProc(clientData, interp, objc, objv);
- return TclNRRunCallbacks(interp, result, rootPtr);
+ TclNRAddCallback(interp, Dispatch, objProc, clientData,
+ INT2PTR(objc), objv);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
/*
@@ -8106,31 +8162,36 @@ Tcl_NRCmdSwap(
Tcl_Obj *const objv[],
int flags)
{
- return TclNREvalObjv(interp, objc, objv, flags, (Command *) cmd);
+ return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
+ (Command *) cmd);
}
/*****************************************************************************
- * Stuff for tailcalls
+ * Tailcall related code
*****************************************************************************
*
- * Just to show that IT CAN BE DONE! The precise semantics are not simple,
- * require more thought. Possibly need a new Tcl return code to do it right?
- * Questions include:
- * (1) How is the objc/objv tailcall to be run? My current thinking is that
- * it should essentially be
- * [tailcall a b c] <=> [uplevel 1 [list a b c]]
- * with two caveats
- * (a) the current frame is dropped first, after running all pending
- * cleanup tasks and saving its namespace
- * (b) 'a' is looked up in the returning frame's namespace, but the
- * command is run in the context to which we are returning
- * Current implementation does this if [tailcall] is called from within
- * a proc, errors otherwise.
- * (2) Should a tailcall bypass [catch] in the returning frame? Current
- * implementation does not (or does it? Changed, test!) - it causes an
- * error.
- *
- * FIXME NRE!
+ * The steps of the tailcall dance are as follows:
+ *
+ * 1. when [tailcall] is invoked, it stores the corresponding callback in
+ * the current CallFrame and returns TCL_RETURN
+ * 2. when the CallFrame is popped, it calls TclSetTailcall to store the
+ * callback in the proper NRCommand callback - the spot where the command
+ * that pushed the CallFrame is completely cleaned up
+ * 3. when the NRCommand callback runs, it schedules the tailcall callback
+ * to run immediately after it returns
+ *
+ * One delicate point is to properly define the NRCommand where the tailcall
+ * will execute. There are functions whose purpose is to help define the
+ * precise spot:
+ * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
+ * should continue right here
+ * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution
+ * should continue after the CURRENT command is fully returned ("skip
+ * the next command: we are redirecting to it, tailcalls should run
+ * after WE return")
+ * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
+ * this point. This is special for OO, as some of the oo constructs
+ * that behave like commands may not push an NRCommand callback.
*/
void
@@ -8164,6 +8225,18 @@ TclPushTailcallPoint(
((Interp *) interp)->numLevels++;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetTailcall --
+ *
+ * Splice a tailcall command in the proper spot of the NRE callback
+ * stack, so that it runs at the right time.
+ *
+ *----------------------------------------------------------------------
+ */
+
void
TclSetTailcall(
Tcl_Interp *interp,
@@ -8188,6 +8261,23 @@ TclSetTailcall(
runPtr->data[1] = listPtr;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallObjCmd --
+ *
+ * Prepare the tailcall as a list and store it in the current
+ * varFrame. When the frame is later popped the tailcall will be spliced
+ * at the proper place.
+ *
+ * Results:
+ * The first NRCommand callback that is not marked to be skipped is
+ * updated so that its data[1] field contains the tailcall list.
+ *
+ *----------------------------------------------------------------------
+ */
+
int
TclNRTailcallObjCmd(
ClientData clientData,
@@ -8202,9 +8292,9 @@ TclNRTailcallObjCmd(
return TCL_ERROR;
}
- if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */
+ if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "tailcall can only be called from a proc or lambda", -1));
+ "tailcall can only be called from a proc, lambda or method", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8222,8 +8312,7 @@ TclNRTailcallObjCmd(
/*
* Create the callback to actually evaluate the tailcalled
* command, then set it in the varFrame so that PopCallFrame can use it
- * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
- * build the callback.
+ * at the proper time.
*/
if (objc > 1) {
@@ -8233,7 +8322,7 @@ TclNRTailcallObjCmd(
/* The tailcall data is in a Tcl list: the first element is the
* namespace, the rest the command to be tailcalled. */
-
+
listPtr = Tcl_NewListObj(objc, objv);
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
@@ -8242,12 +8331,23 @@ TclNRTailcallObjCmd(
Tcl_Panic("Tailcall failed to find the proper namespace");
}
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-
+
iPtr->varFramePtr->tailcallPtr = listPtr;
}
return TCL_RETURN;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallEval --
+ *
+ * This NREcallback actually causes the tailcall to be evaluated.
+ *
+ *----------------------------------------------------------------------
+ */
+
int
TclNRTailcallEval(
ClientData data[],
@@ -8260,9 +8360,9 @@ TclNRTailcallEval(
int objc;
Tcl_Obj **objv;
- Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
+ Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
-
+
if (result == TCL_OK) {
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
}
@@ -8377,8 +8477,7 @@ TclNRYieldToObjCmd(
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
Tcl_Obj *listPtr, *nsObjPtr;
- Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- Tcl_Namespace *ns1Ptr;
+ Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8392,11 +8491,13 @@ TclNRYieldToObjCmd(
return TCL_ERROR;
}
- /*
- * Add the tailcall in the caller env, then just yield.
- *
- * This is essentially code from TclNRTailcallObjCmd
- */
+ if (((Namespace *) nsPtr)->flags & NS_DYING) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ return TCL_ERROR;
+ }
/*
* Add the tailcall in the caller env, then just yield.
@@ -8405,15 +8506,9 @@ TclNRYieldToObjCmd(
*/
listPtr = Tcl_NewListObj(objc, objv);
-
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
- if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
- || (nsPtr != ns1Ptr)) {
- Tcl_Panic("yieldto failed to find the proper namespace");
- }
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 901237b..981f174 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -87,10 +87,13 @@ static int BinaryDecodeHex(ClientData clientData,
static int BinaryEncode64(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int BinaryDecodeUu(ClientData clientData,
+static int BinaryDecode64(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int BinaryDecode64(ClientData clientData,
+static int BinaryEncodeUu(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int BinaryDecodeUu(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
@@ -139,9 +142,9 @@ static const EnsembleImplMap binaryMap[] = {
{ NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
- { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 },
- { "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 },
- { "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 },
+ { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ { "uuencode", BinaryEncodeUu, NULL, NULL, NULL, 0 },
+ { "base64", BinaryEncode64, NULL, NULL, NULL, 0 },
{ NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap decodeMap[] = {
@@ -607,9 +610,7 @@ UpdateStringOfByteArray(
*
* This function appends an array of bytes to a byte array object. Note
* that the object *must* be unshared, and the array of bytes *must not*
- * refer to the object being appended to. Also the caller must have
- * already checked that the final length of the bytearray after the
- * append operations is complete will not overflow the int range.
+ * refer to the object being appended to.
*
* Results:
* None.
@@ -628,6 +629,7 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
+ int needed;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -636,64 +638,57 @@ TclAppendBytesToByteArray(
Tcl_Panic("%s must be called with definite number of bytes to append",
"TclAppendBytesToByteArray");
}
+ if (len == 0) {
+ /* Append zero bytes is a no-op. */
+ return;
+ }
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
+ if (len > INT_MAX - byteArrayPtr->used) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ needed = byteArrayPtr->used + len;
/*
* If we need to, resize the allocated space in the byte array.
*/
- if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
- unsigned int attempt, used = byteArrayPtr->used;
- ByteArray *tmpByteArrayPtr = NULL;
-
- attempt = byteArrayPtr->allocated;
- if (attempt < 1) {
- /*
- * No allocated bytes, so must be none used too. We use this
- * method to calculate how many bytes to allocate because we can
- * end up with a zero-length buffer otherwise, when doubling can
- * cause trouble. [Bug 3067036]
- */
+ if (needed > byteArrayPtr->allocated) {
+ ByteArray *ptr = NULL;
+ int attempt;
- attempt = len + 1;
- } else {
- do {
- attempt *= 2;
- } while (attempt < used+len);
+ if (needed <= INT_MAX/2) {
+ /* Try to allocate double the total space that is needed. */
+ attempt = 2 * needed;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
- tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
- BYTEARRAY_SIZE(attempt));
+ if (ptr == NULL) {
+ /* Try to allocate double the increment that is needed (plus). */
+ unsigned int limit = INT_MAX - needed;
+ unsigned int extra = len + TCL_MIN_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ attempt = needed + growth;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- if (tmpByteArrayPtr == NULL) {
- attempt = used + len;
- if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
- Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
- }
- tmpByteArrayPtr = ckrealloc(byteArrayPtr,
- BYTEARRAY_SIZE(attempt));
+ if (ptr == NULL) {
+ /* Last chance: Try to allocate exactly what is needed. */
+ attempt = needed;
+ ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- byteArrayPtr = tmpByteArrayPtr;
+ byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
- byteArrayPtr->used = used;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
- /*
- * Do the append if there's any point.
- */
-
- if (len > 0) {
+ if (bytes) {
memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
- byteArrayPtr->used += len;
- TclInvalidateStringRep(objPtr);
}
+ byteArrayPtr->used += len;
+ TclInvalidateStringRep(objPtr);
}
/*
@@ -2312,7 +2307,6 @@ BinaryEncodeHex(
Tcl_Obj *resultObj = NULL;
unsigned char *data = NULL;
unsigned char *cursor = NULL;
- const char *digits = clientData;
int offset = 0, count = 0;
if (objc != 2) {
@@ -2324,8 +2318,8 @@ BinaryEncodeHex(
data = Tcl_GetByteArrayFromObj(objv[1], &count);
cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
for (offset = 0; offset < count; ++offset) {
- *cursor++ = digits[((data[offset] >> 4) & 0x0f)];
- *cursor++ = digits[(data[offset] & 0x0f)];
+ *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
+ *cursor++ = HexDigits[(data[offset] & 0x0f)];
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -2386,29 +2380,32 @@ BinaryDecodeHex(
while (data < dataend) {
value = 0;
for (i=0 ; i<2 ; i++) {
- if (data < dataend) {
- c = *data++;
-
- if (!isxdigit((int) c)) {
- if (strict || !isspace(c)) {
- goto badChar;
- }
- i--;
- continue;
- }
+ if (data >= dataend) {
value <<= 4;
- c -= '0';
- if (c > 9) {
- c += ('0' - 'A') + 10;
- }
- if (c > 16) {
- c += ('A' - 'a');
+ break;
+ }
+
+ c = *data++;
+ if (!isxdigit((int) c)) {
+ if (strict || !isspace(c)) {
+ goto badChar;
}
- value |= (c & 0xf);
- } else {
- value <<= 4;
- cut++;
+ i--;
+ continue;
+ }
+
+ value <<= 4;
+ c -= '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
}
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= (c & 0xf);
+ }
+ if (i < 2) {
+ cut++;
}
*cursor++ = UCHAR(value);
value = 0;
@@ -2436,7 +2433,7 @@ BinaryDecodeHex(
* This implements a generic 6 bit binary encoding. Input is broken into
* 6 bit chunks and a lookup table passed in via clientData is used to
* turn these values into output characters. This is used to implement
- * base64 and uuencode binary encodings.
+ * base64 binary encodings.
*
* Results:
* Interp result set to an encoded byte array object
@@ -2472,7 +2469,6 @@ BinaryEncode64(
{
Tcl_Obj *resultObj;
unsigned char *data, *cursor, *limit;
- const char *digits = clientData;
int maxlen = 0;
const char *wrapchar = "\n";
int wrapcharlen = 1;
@@ -2495,6 +2491,13 @@ BinaryEncode64(
if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
return TCL_ERROR;
}
+ if (maxlen < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "line length out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+ "LINE_LENGTH", NULL);
+ return TCL_ERROR;
+ }
break;
case OPT_WRAPCHAR:
wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
@@ -2525,17 +2528,17 @@ BinaryEncode64(
for (i = 0; i < 3 && offset+i < count; ++i) {
d[i] = data[offset + i];
}
- OUTPUT(digits[d[0] >> 2]);
- OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
+ OUTPUT(B64Digits[d[0] >> 2]);
+ OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
if (offset+1 < count) {
- OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
+ OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
} else {
- OUTPUT(digits[64]);
+ OUTPUT(B64Digits[64]);
}
if (offset+2 < count) {
- OUTPUT(digits[d[2] & 0x3f]);
+ OUTPUT(B64Digits[d[2] & 0x3f]);
} else {
- OUTPUT(digits[64]);
+ OUTPUT(B64Digits[64]);
}
}
}
@@ -2547,6 +2550,125 @@ BinaryEncode64(
/*
*----------------------------------------------------------------------
*
+ * BinaryEncodeUu --
+ *
+ * This implements the uuencode binary encoding. Input is broken into 6
+ * bit chunks and a lookup table is used to turn these values into output
+ * characters. This differs from the generic code above in that line
+ * lengths are also encoded.
+ *
+ * Results:
+ * Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryEncodeUu(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj;
+ unsigned char *data, *start, *cursor;
+ int offset, count, rawLength, n, i, j, bits, index;
+ int lineLength = 61;
+ const unsigned char SingleNewline[] = { (unsigned char) '\n' };
+ const unsigned char *wrapchar = SingleNewline;
+ int wrapcharlen = sizeof(SingleNewline);
+ enum { OPT_MAXLEN, OPT_WRAPCHAR };
+ static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
+
+ if (objc < 2 || objc%2 != 0) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-maxlen len? ?-wrapchar char? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_MAXLEN:
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (lineLength < 3 || lineLength > 85) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "line length out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+ "LINE_LENGTH", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ case OPT_WRAPCHAR:
+ wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
+ break;
+ }
+ }
+
+ /*
+ * Allocate the buffer. This is a little bit too long, but is "good
+ * enough".
+ */
+
+ resultObj = Tcl_NewObj();
+ offset = 0;
+ data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+ rawLength = (lineLength - 1) * 3 / 4;
+ start = cursor = Tcl_SetByteArrayLength(resultObj,
+ (lineLength + wrapcharlen) *
+ ((count + (rawLength - 1)) / rawLength));
+ n = bits = 0;
+
+ /*
+ * Encode the data. Each output line first has the length of raw data
+ * encoded by the output line described in it by one encoded byte, then
+ * the encoded data follows (encoding each 6 bits as one character).
+ * Encoded lines are always terminated by a newline.
+ */
+
+ while (offset < count) {
+ int lineLen = count - offset;
+
+ if (lineLen > rawLength) {
+ lineLen = rawLength;
+ }
+ *cursor++ = UueDigits[lineLen];
+ for (i=0 ; i<lineLen ; i++) {
+ n <<= 8;
+ n |= data[offset++];
+ for (bits += 8; bits > 6 ; bits -= 6) {
+ *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
+ }
+ }
+ if (bits > 0) {
+ n <<= 8;
+ *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
+ bits = 0;
+ }
+ for (j=0 ; j<wrapcharlen ; ++j) {
+ *cursor++ = wrapchar[j];
+ }
+ }
+
+ /*
+ * Fix the length of the output bytearray.
+ */
+
+ Tcl_SetByteArrayLength(resultObj, cursor-start);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* BinaryDecodeUu --
*
* Decode a uuencoded string.
@@ -2570,8 +2692,8 @@ BinaryDecodeUu(
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend;
unsigned char *begin, *cursor;
- int i, index, size, count = 0, cut = 0, strict = 0;
- char c;
+ int i, index, size, count = 0, strict = 0, lineLen;
+ unsigned char c;
enum {OPT_STRICT };
static const char *const optStrings[] = { "-strict", NULL };
@@ -2597,44 +2719,112 @@ BinaryDecodeUu(
dataend = data + count;
size = ((count + 3) & ~3) * 3 / 4;
begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
+ lineLen = -1;
+
+ /*
+ * The decoding loop. First, we get the length of line (strictly, the
+ * number of data bytes we expect to generate from the line) we're
+ * processing this time round if it is not already known (i.e., when the
+ * lineLen variable is set to the magic value, -1).
+ */
+
while (data < dataend) {
char d[4] = {0, 0, 0, 0};
+ if (lineLen < 0) {
+ c = *data++;
+ if (c < 32 || c > 96) {
+ if (strict || !isspace(c)) {
+ goto badUu;
+ }
+ i--;
+ continue;
+ }
+ lineLen = (c - 32) & 0x3f;
+ }
+
+ /*
+ * Now we read a four-character grouping.
+ */
+
for (i=0 ; i<4 ; i++) {
if (data < dataend) {
d[i] = c = *data++;
- if (c < 33 || c > 96) {
- if (strict || !isspace(UCHAR(c))) {
- goto badUu;
+ if (c < 32 || c > 96) {
+ if (strict) {
+ if (!isspace(c)) {
+ goto badUu;
+ } else if (c == '\n') {
+ goto shortUu;
+ }
}
i--;
continue;
}
- } else {
- cut++;
}
}
- if (cut > 3) {
- cut = 3;
+
+ /*
+ * Translate that grouping into (up to) three binary bytes output.
+ */
+
+ if (lineLen > 0) {
+ *cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
+ | (((d[1] - 0x20) & 0x3f) >> 4);
+ if (--lineLen > 0) {
+ *cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
+ | (((d[2] - 0x20) & 0x3f) >> 2);
+ if (--lineLen > 0) {
+ *cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
+ | (((d[3] - 0x20) & 0x3f));
+ lineLen--;
+ }
+ }
+ }
+
+ /*
+ * If we've reached the end of the line, skip until we process a
+ * newline.
+ */
+
+ if (lineLen == 0 && data < dataend) {
+ lineLen = -1;
+ do {
+ c = *data++;
+ if (c == '\n') {
+ break;
+ } else if (c >= 32 && c <= 96) {
+ data--;
+ break;
+ } else if (strict || !isspace(c)) {
+ goto badUu;
+ }
+ } while (data < dataend);
}
- *cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
- | (((d[1] - 0x20) & 0x3f) >> 4);
- *cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
- | (((d[2] - 0x20) & 0x3f) >> 2);
- *cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
- | (((d[3] - 0x20) & 0x3f));
}
- if (cut > size) {
- cut = size;
+
+ /*
+ * Sanity check, clean up and finish.
+ */
+
+ if (lineLen > 0 && strict) {
+ goto shortUu;
}
- Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
+ Tcl_SetByteArrayLength(resultObj, cursor - begin);
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
+ shortUu:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
+ TclDecrRefCount(resultObj);
+ return TCL_ERROR;
+
badUu:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid uuencode character \"%c\" at position %d",
c, (int) (data - datastart - 1)));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
TclDecrRefCount(resultObj);
return TCL_ERROR;
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 6d2976d..949cb1c 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -19,7 +19,7 @@
* Windows has mktime. The configurators do not check.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
@@ -522,6 +522,46 @@ ClockGetdatefieldsObjCmd(
*/
static int
+FetchEraField(
+ Tcl_Interp *interp,
+ Tcl_Obj *dict,
+ Tcl_Obj *key,
+ int *storePtr)
+{
+ Tcl_Obj *value = NULL;
+
+ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
+}
+
+static int
+FetchIntField(
+ Tcl_Interp *interp,
+ Tcl_Obj *dict,
+ Tcl_Obj *key,
+ int *storePtr)
+{
+ Tcl_Obj *value = NULL;
+
+ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ return TclGetIntFromObj(interp, value, storePtr);
+}
+
+static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
@@ -532,7 +572,6 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
- Tcl_Obj *fieldPtr;
int changeover;
int copied = 0;
int status;
@@ -547,18 +586,13 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
return TCL_ERROR;
}
dict = objv[1];
- if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
- || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
- &era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
+ if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
+ != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
+ != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
+ &fields.dayOfMonth) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
return TCL_ERROR;
}
@@ -622,7 +656,6 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
- Tcl_Obj *fieldPtr;
int changeover;
int copied = 0;
int status;
@@ -637,18 +670,13 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
return TCL_ERROR;
}
dict = objv[1];
- if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
- || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
- &era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Week)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfWeek) != TCL_OK
+ if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
+ &fields.iso8601Year) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
+ &fields.iso8601Week) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
+ &fields.dayOfWeek) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
return TCL_ERROR;
}
@@ -1697,7 +1725,7 @@ ClockClicksObjCmd(
case 1:
break;
case 2:
- if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1867,9 +1895,9 @@ ClockParseformatargsObjCmd(
localeObj = litPtr[LIT_C];
timezoneObj = litPtr[LIT__NIL];
for (i = 2; i < objc; i+=2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&optionIndex) != TCL_OK) {
- Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
Tcl_GetString(objv[i]), NULL);
return TCL_ERROR;
}
@@ -1977,22 +2005,23 @@ ClockSecondsObjCmd(
static void
TzsetIfNecessary(void)
{
- static char *tzWas = NULL; /* Previous value of TZ, protected by
+ static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
const char *tzIsNow; /* Current value of TZ */
Tcl_MutexLock(&clockMutex);
tzIsNow = getenv("TZ");
- if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
+ if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
+ || strcmp(tzIsNow, tzWas) != 0)) {
tzset();
- if (tzWas != NULL) {
+ if (tzWas != NULL && tzWas != INT2PTR(-1)) {
ckfree(tzWas);
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
- ckfree(tzWas);
+ if (tzWas != INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
}
Tcl_MutexUnlock(&clockMutex);
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f90819a..54e0227 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -748,7 +748,7 @@ Tcl_EvalObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);
+ return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);
}
int
@@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd(
* test for equivalence to the current user.
*/
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
value = 1;
#else
value = (geteuid() == buf.st_uid);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fa4ead4..0d35397 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -29,7 +29,7 @@
typedef struct SortElement {
union { /* The value that we sorting by. */
const char *strValuePtr;
- long intValue;
+ Tcl_WideInt wideValue;
double doubleValue;
Tcl_Obj *objValuePtr;
} collationKey;
@@ -1147,41 +1147,38 @@ InfoFrameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level, topLevel, code = TCL_OK;
- CmdFrame *runPtr, *framePtr;
+ int level, code = TCL_OK;
+ CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ int topLevel = 0;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?number?");
return TCL_ERROR;
}
- topLevel = ((iPtr->cmdFramePtr == NULL)
- ? 0
- : iPtr->cmdFramePtr->level);
-
- if (corPtr) {
- /*
- * A coroutine: must fix the level computations AND the cmdFrame chain,
- * which is interrupted at the base.
- */
-
- CmdFrame *lastPtr = NULL;
-
- runPtr = iPtr->cmdFramePtr;
+ while (corPtr) {
+ while (*cmdFramePtrPtr) {
+ topLevel++;
+ cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+ }
+ if (corPtr->caller.cmdFramePtr) {
+ *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+ }
+ corPtr = corPtr->callerEEPtr->corPtr;
+ }
+ topLevel += (*cmdFramePtrPtr)->level;
- /* TODO - deal with overflow */
- topLevel += corPtr->caller.cmdFramePtr->level;
- while (runPtr) {
- runPtr->level += corPtr->caller.cmdFramePtr->level;
- lastPtr = runPtr;
- runPtr = runPtr->nextPtr;
+ if (topLevel != iPtr->cmdFramePtr->level) {
+ framePtr = iPtr->cmdFramePtr;
+ while (framePtr) {
+ framePtr->level = topLevel--;
+ framePtr = framePtr->nextPtr;
}
- if (lastPtr) {
- lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
- } else {
- iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+ if (topLevel) {
+ Tcl_Panic("Broken frame level calculation");
}
+ topLevel = iPtr->cmdFramePtr->level;
}
if (objc == 1) {
@@ -1231,20 +1228,27 @@ InfoFrameCmd(
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
done:
- if (corPtr) {
+ cmdFramePtrPtr = &iPtr->cmdFramePtr;
+ corPtr = iPtr->execEnvPtr->corPtr;
+ while (corPtr) {
+ CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+ if (endPtr) {
+ if (*cmdFramePtrPtr == endPtr) {
+ *cmdFramePtrPtr = NULL;
+ } else {
+ CmdFrame *runPtr = *cmdFramePtrPtr;
- if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
- iPtr->cmdFramePtr = NULL;
- } else {
- runPtr = iPtr->cmdFramePtr;
- while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
- runPtr->level -= corPtr->caller.cmdFramePtr->level;
- runPtr = runPtr->nextPtr;
+ while (runPtr->nextPtr != endPtr) {
+ runPtr->level -= endPtr->level;
+ runPtr = runPtr->nextPtr;
+ }
+ runPtr->level = 1;
+ runPtr->nextPtr = NULL;
}
- runPtr->level = 1;
- runPtr->nextPtr = NULL;
+ cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
}
-
+ corPtr = corPtr->callerEEPtr->corPtr;
}
return code;
}
@@ -1283,6 +1287,7 @@ TclInfoFrame(
"eval", "eval", "eval", "precompiled", "source", "proc"
};
Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+ int needsFree = -1;
/*
* Pull the information and construct the dictionary to return, as list.
@@ -1356,6 +1361,9 @@ TclInfoFrame(
}
ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
+ if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
+ needsFree = lc - 1;
+ }
TclStackFree(interp, fPtr);
break;
}
@@ -1443,7 +1451,11 @@ TclInfoFrame(
}
}
- return Tcl_NewListObj(lc, lv);
+ tmpObj = Tcl_NewListObj(lc, lv);
+ if (needsFree >= 0) {
+ Tcl_DecrRefCount(lv[needsFree]);
+ }
+ return tmpObj;
}
/*
@@ -2378,7 +2390,10 @@ Tcl_LinsertObjCmd(
Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
} else {
- Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
+ if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
+ (objc-3), &(objv[3]))) {
+ return TCL_ERROR;
+ }
}
/*
@@ -2651,7 +2666,7 @@ Tcl_LrepeatObjCmd(
* number of times.
*/
- CLANG_ASSERT(dataArray);
+ CLANG_ASSERT(dataArray || totalElems == 0 );
if (objc == 1) {
register Tcl_Obj *tmpPtr = objv[0];
@@ -2740,7 +2755,7 @@ Tcl_LreplaceObjCmd(
* (to allow for replacing the last elem).
*/
- if ((first >= listLen) && (listLen > 0)) {
+ if ((first > listLen) && (listLen > 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list doesn't contain element %s", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
@@ -2774,7 +2789,10 @@ Tcl_LreplaceObjCmd(
* optimize this case away.
*/
- Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, objv+4);
+ if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+ objc-4, objv+4)) {
+ return TCL_ERROR;
+ }
/*
* Set the interpreter's object result.
@@ -2889,7 +2907,8 @@ Tcl_LsearchObjCmd(
{
const char *bytes, *patternBytes;
int i, match, index, result, listc, length, elemLen, bisect;
- int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+ int dataType, isIncreasing, lower, upper, offset;
+ Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
@@ -3208,7 +3227,7 @@ Tcl_LsearchObjCmd(
patternBytes = TclGetStringFromObj(patObj, &length);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, patObj, &patInt);
+ result = TclGetWideIntFromObj(interp, patObj, &patWide);
if (result != TCL_OK) {
goto done;
}
@@ -3277,13 +3296,13 @@ Tcl_LsearchObjCmd(
match = DictionaryCompare(patternBytes, bytes);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
goto done;
}
- if (patInt == objInt) {
+ if (patWide == objWide) {
match = 0;
- } else if (patInt < objInt) {
+ } else if (patWide < objWide) {
match = -1;
} else {
match = 1;
@@ -3396,14 +3415,14 @@ Tcl_LsearchObjCmd(
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
goto done;
}
- match = (objInt == patInt);
+ match = (objWide == patWide);
break;
case REAL:
@@ -3967,13 +3986,13 @@ Tcl_LsortObjCmd(
if (sortMode == SORTMODE_ASCII) {
elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
} else if (sortMode == SORTMODE_INTEGER) {
- long a;
+ Tcl_WideInt a;
- if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+ if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done1;
}
- elementArray[i].collationKey.intValue = a;
+ elementArray[i].collationKey.wideValue = a;
} else if (sortMode == SORTMODE_REAL) {
double a;
@@ -4222,10 +4241,10 @@ SortCompare(
order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
- long a, b;
+ Tcl_WideInt a, b;
- a = elemPtr1->collationKey.intValue;
- b = elemPtr2->collationKey.intValue;
+ a = elemPtr1->collationKey.wideValue;
+ b = elemPtr2->collationKey.wideValue;
order = ((a >= b) - (a <= b));
} else if (infoPtr->sortMode == SORTMODE_REAL) {
double a, b;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 5087fbb..13f9e7d 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -18,6 +18,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclStringTrim.h"
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -37,32 +38,33 @@ static int UniCharIsHexDigit(int character);
* UTF-8 literal string containing all Unicode space characters [TIP #413]
*/
-#define DEFAULT_TRIM_SET \
- "\x09\x0a\x0b\x0c\x0d " /* ASCII */\
- "\xc0\x80" /* nul (U+0000) */\
- "\xc2\x85" /* next line (U+0085) */\
- "\xc2\xa0" /* non-breaking space (U+00a0) */\
- "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
- "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
- "\xe2\x80\x80" /* en quad (U+2000) */\
- "\xe2\x80\x81" /* em quad (U+2001) */\
- "\xe2\x80\x82" /* en space (U+2002) */\
- "\xe2\x80\x83" /* em space (U+2003) */\
- "\xe2\x80\x84" /* three-per-em space (U+2004) */\
- "\xe2\x80\x85" /* four-per-em space (U+2005) */\
- "\xe2\x80\x86" /* six-per-em space (U+2006) */\
- "\xe2\x80\x87" /* figure space (U+2007) */\
- "\xe2\x80\x88" /* punctuation space (U+2008) */\
- "\xe2\x80\x89" /* thin space (U+2009) */\
- "\xe2\x80\x8a" /* hair space (U+200a) */\
- "\xe2\x80\x8b" /* zero width space (U+200b) */\
- "\xe2\x80\xa8" /* line separator (U+2028) */\
- "\xe2\x80\xa9" /* paragraph separator (U+2029) */\
- "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
- "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
- "\xe2\x81\xa0" /* word joiner (U+2060) */\
- "\xe3\x80\x80" /* ideographic space (U+3000) */\
+const char tclDefaultTrimSet[] =
+ "\x09\x0a\x0b\x0c\x0d " /* ASCII */
+ "\xc0\x80" /* nul (U+0000) */
+ "\xc2\x85" /* next line (U+0085) */
+ "\xc2\xa0" /* non-breaking space (U+00a0) */
+ "\xe1\x9a\x80" /* ogham space mark (U+1680) */
+ "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
+ "\xe2\x80\x80" /* en quad (U+2000) */
+ "\xe2\x80\x81" /* em quad (U+2001) */
+ "\xe2\x80\x82" /* en space (U+2002) */
+ "\xe2\x80\x83" /* em space (U+2003) */
+ "\xe2\x80\x84" /* three-per-em space (U+2004) */
+ "\xe2\x80\x85" /* four-per-em space (U+2005) */
+ "\xe2\x80\x86" /* six-per-em space (U+2006) */
+ "\xe2\x80\x87" /* figure space (U+2007) */
+ "\xe2\x80\x88" /* punctuation space (U+2008) */
+ "\xe2\x80\x89" /* thin space (U+2009) */
+ "\xe2\x80\x8a" /* hair space (U+200a) */
+ "\xe2\x80\x8b" /* zero width space (U+200b) */
+ "\xe2\x80\xa8" /* line separator (U+2028) */
+ "\xe2\x80\xa9" /* paragraph separator (U+2029) */
+ "\xe2\x80\xaf" /* narrow no-break space (U+202f) */
+ "\xe2\x81\x9f" /* medium mathematical space (U+205f) */
+ "\xe2\x81\xa0" /* word joiner (U+2060) */
+ "\xe3\x80\x80" /* ideographic space (U+3000) */
"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+;
/*
*----------------------------------------------------------------------
@@ -159,7 +161,7 @@ Tcl_RegexpObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
goto optionError;
}
@@ -215,7 +217,7 @@ Tcl_RegexpObjCmd(
endOfForLoop:
if ((objc - i) < (2 - about)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
+ "?-option ...? exp string ?matchVar? ?subMatchVar ...?");
goto optionError;
}
objc -= i;
@@ -229,6 +231,8 @@ Tcl_RegexpObjCmd(
if (doinline && ((objc - 2) != 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"regexp match variables not allowed when using -inline", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
+ "MIX_VAR_INLINE", NULL);
goto optionError;
}
@@ -517,7 +521,7 @@ Tcl_RegsubObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+ if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
TCL_EXACT, &index) != TCL_OK) {
goto optionError;
}
@@ -564,7 +568,7 @@ Tcl_RegsubObjCmd(
endOfForLoop:
if (objc-idx < 3 || objc-idx > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? exp string subSpec ?varName?");
+ "?-option ...? exp string subSpec ?varName?");
optionError:
if (startIndex) {
Tcl_DecrRefCount(startIndex);
@@ -2834,6 +2838,59 @@ StringCmpCmd(
/*
*----------------------------------------------------------------------
*
+ * StringCatCmd --
+ *
+ * This procedure is invoked to process the "string cat" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringCatCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i;
+ Tcl_Obj *objResultPtr;
+
+ if (objc < 2) {
+ /*
+ * If there are no args, the result is an empty object.
+ * Just leave the preset empty interp result.
+ */
+ return TCL_OK;
+ }
+ if (objc == 2) {
+ /*
+ * Other trivial case, single arg, just return it.
+ */
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+ objResultPtr = objv[1];
+ if (Tcl_IsShared(objResultPtr)) {
+ objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ }
+ for(i = 2;i < objc;i++) {
+ Tcl_AppendObjToObj(objResultPtr, objv[i]);
+ }
+ Tcl_SetObjResult(interp, objResultPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* StringBytesCmd --
*
* This procedure is invoked to process the "string bytelength" Tcl
@@ -3189,8 +3246,8 @@ StringTrimCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3237,8 +3294,8 @@ StringTrimLCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3283,8 +3340,8 @@ StringTrimRCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3326,25 +3383,26 @@ TclInitStringCmd(
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
- {"is", StringIsCmd, NULL, NULL, NULL, 0},
+ {"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
{"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
- {"replace", StringRplcCmd, NULL, NULL, NULL, 0},
+ {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0},
{"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0},
+ {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0},
+ {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0},
+ {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0},
+ {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0},
+ {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0},
{"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
@@ -3389,7 +3447,7 @@ TclSubstOptions(
for (i = 0; i < numOpts; i++) {
int optionIndex;
- if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
&optionIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -3589,7 +3647,7 @@ TclNRSwitchObjCmd(
finishedOptions:
if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? string ?pattern body ...? ?default body?");
+ "?-option ...? string ?pattern body ...? ?default body?");
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
@@ -3636,7 +3694,7 @@ TclNRSwitchObjCmd(
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, savedObjv,
- "?-switch ...? string {?pattern body ...? ?default body?}");
+ "?-option ...? string {?pattern body ...? ?default body?}");
return TCL_ERROR;
}
objv = listv;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8edb2d9..3ab03cc 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -26,11 +26,23 @@ static void FreeDictUpdateInfo(ClientData clientData);
static void PrintDictUpdateInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleDictUpdateInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static ClientData DupForeachInfo(ClientData clientData);
static void FreeForeachInfo(ClientData clientData);
static void PrintForeachInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleForeachInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void PrintNewForeachInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void DisassembleNewForeachInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static int CompileEachloopCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr, int collect);
@@ -42,23 +54,66 @@ static int CompileDictEachCmd(Tcl_Interp *interp,
* The structures below define the AuxData types defined in this file.
*/
-const AuxDataType tclForeachInfoType = {
+static const AuxDataType foreachInfoType = {
"ForeachInfo", /* name */
DupForeachInfo, /* dupProc */
FreeForeachInfo, /* freeProc */
- PrintForeachInfo /* printProc */
+ PrintForeachInfo, /* printProc */
+ DisassembleForeachInfo /* disassembleProc */
};
-const AuxDataType tclDictUpdateInfoType = {
+static const AuxDataType newForeachInfoType = {
+ "NewForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo, /* freeProc */
+ PrintNewForeachInfo, /* printProc */
+ DisassembleNewForeachInfo /* disassembleProc */
+};
+
+static const AuxDataType dictUpdateInfoType = {
"DictUpdateInfo", /* name */
DupDictUpdateInfo, /* dupProc */
FreeDictUpdateInfo, /* freeProc */
- PrintDictUpdateInfo /* printProc */
+ PrintDictUpdateInfo, /* printProc */
+ DisassembleDictUpdateInfo /* disassembleProc */
};
/*
*----------------------------------------------------------------------
*
+ * TclGetAuxDataType --
+ *
+ * This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ * If an AuxData type with name matching "typeName" is found, a pointer
+ * to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const AuxDataType *
+TclGetAuxDataType(
+ const char *typeName) /* Name of AuxData type to look up. */
+{
+ if (!strcmp(typeName, foreachInfoType.name)) {
+ return &foreachInfoType;
+ } else if (!strcmp(typeName, newForeachInfoType.name)) {
+ return &newForeachInfoType;
+ } else if (!strcmp(typeName, dictUpdateInfoType.name)) {
+ return &dictUpdateInfoType;
+ } else if (!strcmp(typeName, tclJumptableInfoType.name)) {
+ return &tclJumptableInfoType;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileAppendCmd --
*
* Procedure called to compile the "append" command.
@@ -155,9 +210,9 @@ TclCompileAppendCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
- &localIndex, &isScalar, 1);
- if (!isScalar || localIndex < 0) {
+
+ localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
@@ -245,8 +300,8 @@ TclCompileArraySetCmd(
Tcl_Token *varTokenPtr, *dataTokenPtr;
int isScalar, localIndex, code = TCL_OK;
int isDataLiteral, isDataValid, isDataEven, len;
- int dataVar, iterVar, keyVar, valVar, infoIndex;
- int back, fwd, offsetBack, offsetFwd;
+ int keyVar, valVar, infoIndex;
+ int fwd, offsetBack, offsetFwd;
Tcl_Obj *literalObj;
ForeachInfo *infoPtr;
@@ -268,8 +323,8 @@ TclCompileArraySetCmd(
if (isDataValid && !isDataEven) {
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
}
@@ -279,7 +334,8 @@ TclCompileArraySetCmd(
* a proc, we cannot do a better compile than generic.
*/
- if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
+ if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
+ (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
goto done;
}
@@ -290,6 +346,7 @@ TclCompileArraySetCmd(
code = TCL_ERROR;
goto done;
}
+
/*
* Special case: literal empty value argument is just an "ensure array"
* operation.
@@ -314,24 +371,34 @@ TclCompileArraySetCmd(
goto done;
}
+ if (localIndex < 0) {
+ /*
+ * a non-local variable: upvar from a local one! This consumes the
+ * variable name that was left at stacktop.
+ */
+
+ localIndex = TclFindCompiledLocal(varTokenPtr->start,
+ varTokenPtr->size, 1, envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+
/*
* Prepare for the internal foreach.
*/
- dataVar = AnonymousLocal(envPtr);
- iterVar = AnonymousLocal(envPtr);
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
- infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
+ infoPtr = ckalloc(sizeof(ForeachInfo));
infoPtr->numLists = 1;
- infoPtr->firstValueTemp = dataVar;
- infoPtr->loopCtTemp = iterVar;
- infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
+ infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
infoPtr->varLists[0]->numVars = 2;
infoPtr->varLists[0]->varIndexes[0] = keyVar;
infoPtr->varLists[0]->varIndexes[1] = valVar;
- infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+ infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
/*
* Start issuing instructions to write to the array.
@@ -353,61 +420,30 @@ TclCompileArraySetCmd(
offsetFwd = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
fwd = CurrentOffset(envPtr) - offsetFwd;
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
}
- Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- if (localIndex >= 0) {
- TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
- TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
- TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
- offsetBack = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
- Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- back = offsetBack - CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP1, back, envPtr);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- } else {
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
- TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr);
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr);
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
- offsetBack = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
- TclEmitOpcode( INST_DUP, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
- TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- back = offsetBack - CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP1, back, envPtr);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- TclEmitOpcode( INST_POP, envPtr);
- }
- if (!isDataLiteral) {
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( dataVar, envPtr);
- }
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+ offsetBack = CurrentOffset(envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
+ TclEmitOpcode( INST_FOREACH_STEP, envPtr);
+ TclEmitOpcode( INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-3, envPtr);
PushStringLiteral(envPtr, "");
- done:
+
+ done:
Tcl_DecrRefCount(literalObj);
return code;
}
@@ -500,17 +536,14 @@ TclCompileBreakCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopBreakFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real break.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_BREAK, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -544,8 +577,9 @@ TclCompileCatchCmd(
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
- int resultIndex, optsIndex, range;
+ int resultIndex, optsIndex, range, dropScript = 0;
DefineLineInformation; /* TIP #280 */
+ int depth = TclGetStackDepth(envPtr);
/*
* If syntax does not match what we expect for [catch], do not compile.
@@ -593,11 +627,7 @@ TclCompileCatchCmd(
/*
* We will compile the catch command. Declare the exception range that it
* uses.
- */
-
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-
- /*
+ *
* If the body is a simple word, compile a BEGIN_CATCH instruction,
* followed by the instructions to eval the body.
* Otherwise, compile instructions to substitute the body text before
@@ -610,6 +640,7 @@ TclCompileCatchCmd(
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -620,71 +651,51 @@ TclCompileCatchCmd(
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_EVAL_STK, envPtr);
- }
- /* Stack at this point:
- * nonsimple: script <mark> result
- * simple: <mark> result
- */
-
- if (resultIndex == -1) {
- /*
- * Special case when neither result nor options are being saved. In
- * that case, we can skip quite a bit of the command epilogue; all we
- * have to do is drop the result and push the return code (and, of
- * course, finish the catch context).
- */
-
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
+ /* drop the script */
+ dropScript = 1;
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "0");
- TclEmitInstInt1( INST_JUMP1, 3, envPtr);
- TclAdjustStackDepth(-1, envPtr);
- ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- ExceptionRangeEnds(envPtr, range);
- TclEmitOpcode( INST_END_CATCH, envPtr);
-
- /*
- * Stack at this point:
- * nonsimple: script <mark> returnCode
- * simple: <mark> returnCode
- */
-
- goto dropScriptAtEnd;
}
+ ExceptionRangeEnds(envPtr, range);
+
/*
* Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
* and jump around the "error case" code.
*/
+ TclCheckStackDepth(depth+1, envPtr);
PushStringLiteral(envPtr, "0");
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- /* Stack at this point: ?script? <mark> result TCL_OK */
- /*
+ /*
* Emit the "error case" epilogue. Push the interpreter result and the
* return code.
*/
- TclAdjustStackDepth(-2, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
- /* Stack at this point: ?script? */
+ TclSetStackDepth(depth + dropScript, envPtr);
+
+ if (dropScript) {
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+
+ /* Stack at this point is empty */
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- /*
- * Update the target of the jump after the "no errors" code.
- */
+ /* Stack at this point on both branches: result returnCode */
- /* Stack at this point: ?script? result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
/*
- * Push the return options if the caller wants them.
+ * Push the return options if the caller wants them. This needs to happen
+ * before INST_END_CATCH
*/
if (optsIndex != -1) {
@@ -695,53 +706,118 @@ TclCompileCatchCmd(
* End the catch
*/
- ExceptionRangeEnds(envPtr, range);
TclEmitOpcode( INST_END_CATCH, envPtr);
/*
- * At this point, the top of the stack is inconveniently ordered:
- * ?script? result returnCode ?returnOptions?
- * Reverse the stack to bring the result to the top.
+ * Save the result and return options if the caller wants them. This needs
+ * to happen after INST_END_CATCH (compile-3.6/7).
*/
if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 3, envPtr);
- } else {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
- * Store the result and remove it from the stack.
+ * At this point, the top of the stack is inconveniently ordered:
+ * result returnCode
+ * Reverse the stack to store the result.
*/
- Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ if (resultIndex != -1) {
+ Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
+ }
+ TclEmitOpcode( INST_POP, envPtr);
+
+ TclCheckStackDepth(depth+1, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileConcatCmd --
+ *
+ * Procedure called to compile the "concat" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "concat" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *objPtr, *listObj;
+ Tcl_Token *tokenPtr;
+ int i;
+
+ /* TODO: Consider compiling expansion case. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * [concat] without arguments just pushes an empty object.
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
/*
- * Stack is now ?script? ?returnOptions? returnCode.
- * If the options dict has been requested, it is buried on the stack under
- * the return code. Reverse the stack to bring it to the top, store it and
- * remove it from the stack.
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
*/
- if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ listObj = Tcl_NewObj();
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objPtr = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ break;
+ }
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
+ if (listObj != NULL) {
+ Tcl_Obj **objs;
+ const char *bytes;
+ int len;
- dropScriptAtEnd:
+ Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+ objPtr = Tcl_ConcatObj(len, objs);
+ Tcl_DecrRefCount(listObj);
+ bytes = Tcl_GetStringFromObj(objPtr, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+ }
/*
- * Stack is now ?script? result. Get rid of the subst'ed script if it's
- * hanging arond.
+ * General case: runtime concat.
*/
- if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
}
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
return TCL_OK;
}
@@ -796,17 +872,14 @@ TclCompileContinueCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopContinueFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real continue.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_CONTINUE, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -839,7 +912,7 @@ TclCompileDictSetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i, dictVarIndex;
+ int i, dictVarIndex;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
@@ -868,8 +941,7 @@ TclCompileDictSetCmd(
*/
tokenPtr = TokenAfter(varTokenPtr);
- numWords = parsePtr->numWords-1;
- for (i=1 ; i<numWords ; i++) {
+ for (i=2 ; i< parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
@@ -878,7 +950,7 @@ TclCompileDictSetCmd(
* Now emit the instruction to do the dict manipulation.
*/
- TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr);
+ TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr);
TclEmitInt4( dictVarIndex, envPtr);
TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
@@ -950,7 +1022,7 @@ TclCompileDictIncrCmd(
* Emit the key and the code to actually do the increment.
*/
- CompileWord(envPtr, keyTokenPtr, interp, 3);
+ CompileWord(envPtr, keyTokenPtr, interp, 2);
TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr);
TclEmitInt4( dictVarIndex, envPtr);
return TCL_OK;
@@ -966,7 +1038,7 @@ TclCompileDictGetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -979,17 +1051,16 @@ TclCompileDictGetCmd(
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- numWords = parsePtr->numWords-1;
/*
* Only compile this because we need INST_DICT_GET anyway.
*/
- for (i=0 ; i<numWords ; i++) {
+ for (i=1 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
- TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
+ TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
}
@@ -1004,7 +1075,7 @@ TclCompileDictExistsCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -1017,17 +1088,16 @@ TclCompileDictExistsCmd(
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- numWords = parsePtr->numWords-1;
/*
* Now we do the code generation.
*/
- for (i=0 ; i<numWords ; i++) {
+ for (i=1 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
- TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
+ TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
}
@@ -1426,7 +1496,7 @@ CompileDictEachCmd(
* this point.
*/
- CompileWord(envPtr, dictTokenPtr, interp, 3);
+ CompileWord(envPtr, dictTokenPtr, interp, 2);
/*
* Now we catch errors from here on so that we can finalize the search
@@ -1632,10 +1702,10 @@ TclCompileDictUpdateCmd(
* can't be snagged by literal sharing and forced to shimmer dangerously.
*/
- infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+ infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, envPtr);
for (i=0 ; i<numVars ; i++) {
- CompileWord(envPtr, keyTokenPtrs[i], interp, i);
+ CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
}
TclEmitInstInt4( INST_LIST, numVars, envPtr);
TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
@@ -1678,7 +1748,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -1742,7 +1812,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -1792,8 +1862,8 @@ TclCompileDictLappendCmd(
* Issue the implementation.
*/
- CompileWord(envPtr, keyTokenPtr, interp, 3);
- CompileWord(envPtr, valueTokenPtr, interp, 4);
+ CompileWord(envPtr, keyTokenPtr, interp, 2);
+ CompileWord(envPtr, valueTokenPtr, interp, 3);
TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
return TCL_OK;
}
@@ -1878,7 +1948,7 @@ TclCompileDictWithCmd(
tokenPtr = TokenAfter(varTokenPtr);
for (i=2 ; i<parsePtr->numWords-1 ; i++) {
- CompileWord(envPtr, tokenPtr, interp, i-1);
+ CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
@@ -1905,7 +1975,7 @@ TclCompileDictWithCmd(
tokenPtr = varTokenPtr;
for (i=1 ; i<parsePtr->numWords-1 ; i++) {
- CompileWord(envPtr, tokenPtr, interp, i-1);
+ CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
@@ -1919,7 +1989,7 @@ TclCompileDictWithCmd(
* Case: Direct dict in non-simple var with empty body.
*/
- CompileWord(envPtr, varTokenPtr, interp, 0);
+ CompileWord(envPtr, varTokenPtr, interp, 1);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LOAD_STK, envPtr);
PushStringLiteral(envPtr, "");
@@ -1954,13 +2024,13 @@ TclCompileDictWithCmd(
*/
if (dictVar == -1) {
- CompileWord(envPtr, varTokenPtr, interp, 0);
+ CompileWord(envPtr, varTokenPtr, interp, 1);
Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr);
}
tokenPtr = TokenAfter(varTokenPtr);
if (gotPath) {
for (i=2 ; i<parsePtr->numWords-1 ; i++) {
- CompileWord(envPtr, tokenPtr, interp, i-1);
+ CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr);
@@ -2036,7 +2106,7 @@ TclCompileDictWithCmd(
} else {
TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
}
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
/*
* Prepare for the start of the next command.
@@ -2061,11 +2131,13 @@ TclCompileDictWithCmd(
* DupDictUpdateInfo: a copy of the auxiliary data
* FreeDictUpdateInfo: none
* PrintDictUpdateInfo: none
+ * DisassembleDictUpdateInfo: none
*
* Side effects:
* DupDictUpdateInfo: allocates memory
* FreeDictUpdateInfo: releases memory
* PrintDictUpdateInfo: none
+ * DisassembleDictUpdateInfo: none
*
*----------------------------------------------------------------------
*/
@@ -2108,6 +2180,25 @@ PrintDictUpdateInfo(
Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
}
}
+
+static void
+DisassembleDictUpdateInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ DictUpdateInfo *duiPtr = clientData;
+ int i;
+ Tcl_Obj *variables = Tcl_NewObj();
+
+ for (i=0 ; i<duiPtr->length ; i++) {
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewIntObj(duiPtr->varIndices[i]));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
+ variables);
+}
/*
*----------------------------------------------------------------------
@@ -2138,19 +2229,48 @@ TclCompileErrorCmd(
{
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
- * However, we only deal with the case where there is just a message.
*/
- Tcl_Token *messageTokenPtr;
+
+ Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
- if (parsePtr->numWords != 2) {
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
- messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushStringLiteral(envPtr, "-code error -level 0");
- CompileWord(envPtr, messageTokenPtr, interp, 1);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ /*
+ * Handle the message.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+
+ /*
+ * Construct the options. Note that -code and -level are not here.
+ */
+
+ if (parsePtr->numWords == 2) {
+ PushStringLiteral(envPtr, "");
+ } else {
+ PushStringLiteral(envPtr, "-errorinfo");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST, 2, envPtr);
+ } else {
+ PushStringLiteral(envPtr, "-errorcode");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
+ }
+ }
+
+ /*
+ * Issue the error via 'returnImm error 0'.
+ */
+
+ TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
return TCL_OK;
}
@@ -2228,7 +2348,7 @@ TclCompileForCmd(
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+ int bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
DefineLineInformation; /* TIP #280 */
@@ -2309,13 +2429,9 @@ TclCompileForCmd(
* terminates the for.
*/
- testCodeOffset = CurrentOffset(envPtr);
-
- jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
bodyCodeOffset += 3;
nextCodeOffset += 3;
- testCodeOffset += 3;
}
SetLineInformation(2);
@@ -2444,33 +2560,17 @@ CompileEachloopCmd(
* (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
- ForeachInfo *infoPtr; /* Points to the structure describing this
+ ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
- int firstValueTemp; /* Index of the first temp var in the frame
- * used to point to a value list. */
- int loopCtTemp; /* Index of temp var holding the loop's
- * iteration count. */
- int collectVar = -1; /* Index of temp var holding the result var
- * index. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
- unsigned char *jumpPc;
- JumpFixup jumpFalseFixup;
- int jumpBackDist, jumpBackOffset, infoIndex, range;
- int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+ int jumpBackOffset, infoIndex, range;
+ int numWords, numLists, i, j, code = TCL_OK;
+ Tcl_Obj *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
/*
- * We parse the variable list argument words and create two arrays:
- * varcList[i] is number of variables in i-th var list.
- * varvList[i] points to array of var names in i-th var list.
- */
-
- int *varcList;
- const char ***varvList;
-
- /*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
@@ -2498,260 +2598,148 @@ CompileEachloopCmd(
}
/*
- * Allocate storage for the varcList and varvList arrays if necessary.
+ * Create and initialize the ForeachInfo and ForeachVarList data
+ * structures describing this command. Then create a AuxData record
+ * pointing to the ForeachInfo structure.
*/
numLists = (numWords - 2)/2;
- varcList = TclStackAlloc(interp, numLists * sizeof(int));
- memset(varcList, 0, numLists * sizeof(int));
- varvList = (const char ***) TclStackAlloc(interp,
- numLists * sizeof(const char **));
- memset((char*) varvList, 0, numLists * sizeof(const char **));
+ infoPtr = ckalloc(sizeof(ForeachInfo)
+ + (numLists - 1) * sizeof(ForeachVarList *));
+ infoPtr->numLists = 0; /* Count this up as we go */
/*
- * Break up each var list and set the varcList and varvList arrays. Don't
+ * Parse each var list into sequence of var names. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
- loopIndex = 0;
+ varListObj = Tcl_NewObj();
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
- Tcl_DString varList;
+ ForeachVarList *varListPtr;
+ int numVars;
if (i%2 != 1) {
continue;
}
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- code = TCL_ERROR;
- goto done;
- }
-
- /*
- * Lots of copying going on here. Need a ListObj wizard to show a
- * better way.
- */
-
- Tcl_DStringInit(&varList);
- TclDStringAppendToken(&varList, &tokenPtr[1]);
- code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
- &varcList[loopIndex], &varvList[loopIndex]);
- Tcl_DStringFree(&varList);
- if (code != TCL_OK) {
- code = TCL_ERROR;
- goto done;
- }
- numVars = varcList[loopIndex];
/*
* If the variable list is empty, we can enter an infinite loop when
- * the interpreted version would not. Take care to ensure this does
- * not happen. [Bug 1671138]
+ * the interpreted version would not. Take care to ensure this does
+ * not happen. [Bug 1671138]
*/
- if (numVars == 0) {
+ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
+ TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
+ numVars == 0) {
code = TCL_ERROR;
goto done;
}
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
+ varListPtr = ckalloc(sizeof(ForeachVarList)
+ + (numVars - 1) * sizeof(int));
+ varListPtr->numVars = numVars;
+ infoPtr->varLists[i/2] = varListPtr;
+ infoPtr->numLists++;
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ for (j = 0; j < numVars; j++) {
+ Tcl_Obj *varNameObj;
+ const char *bytes;
+ int numBytes, varIndex;
+
+ Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
+ bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+ varIndex = LocalScalar(bytes, numBytes, envPtr);
+ if (varIndex < 0) {
code = TCL_ERROR;
goto done;
}
+ varListPtr->varIndexes[j] = varIndex;
}
- loopIndex++;
+ Tcl_SetObjLength(varListObj, 0);
}
- if (collect == TCL_EACH_COLLECT) {
- collectVar = AnonymousLocal(envPtr);
- if (collectVar < 0) {
- return TCL_ERROR;
- }
- }
-
/*
- * We will compile the foreach command. Reserve (numLists + 1) temporary
- * variables:
- * - numLists temps to hold each value list
- * - 1 temp for the loop counter (index of next element in each list)
- *
- * At this time we don't try to reuse temporaries; if there are two
- * nonoverlapping foreach loops, they don't share any temps.
+ * We will compile the foreach command.
*/
- code = TCL_OK;
- firstValueTemp = -1;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- tempVar = AnonymousLocal(envPtr);
- if (loopIndex == 0) {
- firstValueTemp = tempVar;
- }
- }
- loopCtTemp = AnonymousLocal(envPtr);
+ infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
/*
- * Create and initialize the ForeachInfo and ForeachVarList data
- * structures describing this command. Then create a AuxData record
- * pointing to the ForeachInfo structure.
+ * Create the collecting object, unshared.
*/
- infoPtr = ckalloc(sizeof(ForeachInfo)
- + numLists * sizeof(ForeachVarList *));
- infoPtr->numLists = numLists;
- infoPtr->firstValueTemp = firstValueTemp;
- infoPtr->loopCtTemp = loopCtTemp;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- ForeachVarList *varListPtr;
-
- numVars = varcList[loopIndex];
- varListPtr = ckalloc(sizeof(ForeachVarList)
- + numVars * sizeof(int));
- varListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
- int nameChars = strlen(varName);
-
- varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, envPtr);
- }
- infoPtr->varLists[loopIndex] = varListPtr;
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt4(INST_LIST, 0, envPtr);
}
- infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
-
- /*
- * Create an exception record to handle [break] and [continue].
- */
-
- range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
/*
- * Evaluate then store each value list in the associated temporary.
+ * Evaluate each value list and leave it on stack.
*/
- loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
if ((i%2 == 0) && (i > 0)) {
CompileWord(envPtr, tokenPtr, interp, i);
- tempVar = (firstValueTemp + loopIndex);
- Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- loopIndex++;
}
}
- /*
- * Create temporary variable to capture return values from loop body.
- */
-
- if (collect == TCL_EACH_COLLECT) {
- PushStringLiteral(envPtr, "");
- Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- }
-
- /*
- * Initialize the temporary var that holds the count of loop iterations.
- */
-
- TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr);
-
- /*
- * Top of loop code: assign each loop variable and check whether
- * to terminate the loop.
- */
-
- ExceptionRangeTarget(envPtr, range, continueOffset);
- TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
/*
* Inline compile the loop body.
*/
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
ExceptionRangeStarts(envPtr, range);
BODY(bodyTokenPtr, numWords - 1);
ExceptionRangeEnds(envPtr, range);
if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
- }
- TclEmitOpcode( INST_POP, envPtr);
-
- /*
- * Jump back to the test at the top of the loop. Generate a 4 byte jump if
- * the distance to the test is > 120 bytes. This is conservative and
- * ensures that we won't have to replace this jump if we later need to
- * replace the ifFalse jump with a 4 byte jump.
- */
-
- jumpBackOffset = CurrentOffset(envPtr);
- jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+ TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
} else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
- * Fix the target of the jump after the foreach_step test.
+ * Bottom of loop code: assign each loop variable and check whether
+ * to terminate the loop. Set the loop's break target.
*/
- if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->exceptArrayPtr[range].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
- }
- }
+ ExceptionRangeTarget(envPtr, range, continueOffset);
+ TclEmitOpcode(INST_FOREACH_STEP, envPtr);
+ ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
+ TclEmitOpcode(INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-(numLists+2), envPtr);
/*
- * Set the loop's break target.
+ * Set the jumpback distance from INST_FOREACH_STEP to the start of the
+ * body's code. Misuse loopCtTemp for storing the jump size.
*/
- ExceptionRangeTarget(envPtr, range, breakOffset);
- TclFinalizeLoopExceptionRange(envPtr, range);
+ jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
+ envPtr->exceptArrayPtr[range].codeOffset;
+ infoPtr->loopCtTemp = -jumpBackOffset;
/*
- * The command's result is an empty string if not collecting, or the
- * list of results from evaluating the loop body.
+ * The command's result is an empty string if not collecting. If
+ * collecting, it is automatically left on stack after FOREACH_END.
*/
- if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( collectVar, envPtr);
- } else {
+ if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
- done:
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != NULL) {
- ckfree(varvList[loopIndex]);
- }
+ done:
+ if (code == TCL_ERROR) {
+ FreeForeachInfo(infoPtr);
}
- TclStackFree(interp, (void *)varvList);
- TclStackFree(interp, varcList);
+ Tcl_DecrRefCount(varListObj);
return code;
}
@@ -2845,10 +2833,10 @@ FreeForeachInfo(
/*
*----------------------------------------------------------------------
*
- * PrintForeachInfo --
+ * PrintForeachInfo, DisassembleForeachInfo --
*
- * Function to write a human-readable representation of a ForeachInfo
- * structure to stdout for debugging.
+ * Functions to write a human-readable or script-readablerepresentation
+ * of a ForeachInfo structure to a Tcl_Obj for debugging.
*
* Results:
* None.
@@ -2898,6 +2886,119 @@ PrintForeachInfo(
Tcl_AppendToObj(appendObj, "]", -1);
}
}
+
+static void
+PrintNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+
+ Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
+ infoPtr->loopCtTemp);
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendToObj(appendObj, "[", -1);
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ if (j) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+ (unsigned) varsPtr->varIndexes[j]);
+ }
+ Tcl_AppendToObj(appendObj, "]", -1);
+ }
+}
+
+static void
+DisassembleForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+ Tcl_Obj *objPtr, *innerPtr;
+
+ /*
+ * Data stores.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(infoPtr->firstValueTemp + i));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
+
+ /*
+ * Loop counter.
+ */
+
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
+ Tcl_NewIntObj(infoPtr->loopCtTemp));
+
+ /*
+ * Assignment targets.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ innerPtr = Tcl_NewObj();
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ Tcl_ListObjAppendElement(NULL, innerPtr,
+ Tcl_NewIntObj(varsPtr->varIndexes[j]));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+}
+
+static void
+DisassembleNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+ Tcl_Obj *objPtr, *innerPtr;
+
+ /*
+ * Jump offset.
+ */
+
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
+ Tcl_NewIntObj(infoPtr->loopCtTemp));
+
+ /*
+ * Assignment targets.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ innerPtr = Tcl_NewObj();
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ Tcl_ListObjAppendElement(NULL, innerPtr,
+ Tcl_NewIntObj(varsPtr->varIndexes[j]));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+}
/*
*----------------------------------------------------------------------
@@ -3104,7 +3205,7 @@ TclCompileFormatCmd(
* Do the concatenation, which produces the result.
*/
- TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
} else {
/*
* EVIL HACK! Force there to be a string representation in the case
@@ -3123,6 +3224,54 @@ TclCompileFormatCmd(
/*
*----------------------------------------------------------------------
*
+ * TclLocalScalarFromToken --
+ *
+ * Get the index into the table of compiled locals that corresponds
+ * to a local scalar variable name.
+ *
+ * Results:
+ * Returns the non-negative integer index value into the table of
+ * compiled locals corresponding to a local scalar variable name.
+ * If the arguments passed in do not identify a local scalar variable
+ * then return -1.
+ *
+ * Side effects:
+ * May add an entery into the table of compiled locals.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLocalScalarFromToken(
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr)
+{
+ int isScalar, index;
+
+ TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
+ if (!isScalar) {
+ index = -1;
+ }
+ return index;
+}
+
+int
+TclLocalScalar(
+ const char *bytes,
+ int numBytes,
+ CompileEnv *envPtr)
+{
+ Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
+ {TCL_TOKEN_TEXT, NULL, 0, 0}};
+
+ token[1].start = bytes;
+ token[1].size = numBytes;
+ return TclLocalScalarFromToken(token, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
@@ -3178,16 +3327,7 @@ TclPushVarName(
nameChars = elNameChars = 0;
localIndex = -1;
- /*
- * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
- * curly braces surround the variable name. This really matters for array
- * elements to handle things like
- * set {x($foo)} 5
- * which raises an undefined var error if we are not careful here.
- */
-
- if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
- (varTokenPtr->start[0] != '{')) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
@@ -3211,7 +3351,7 @@ TclPushVarName(
}
}
- if ((elName != NULL) && elNameChars) {
+ if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
@@ -3226,7 +3366,7 @@ TclPushVarName(
elemTokenCount = 1;
}
}
- } else if (((n = varTokenPtr->numComponents) > 1)
+ } else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -3262,9 +3402,10 @@ TclPushVarName(
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
- elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;
+ elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
- if (remainingChars) {
+ if (!(flags & TCL_NO_ELEMENT)) {
+ if (remainingChars) {
/*
* Make a first token with the extra characters in the first
* token.
@@ -3284,13 +3425,14 @@ TclPushVarName(
memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
- } else {
+ } else {
/*
* Use the already available tokens.
*/
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
+ }
}
}
}
@@ -3325,7 +3467,7 @@ TclPushVarName(
localIndex = -1;
}
}
- if (localIndex < 0) {
+ if (interp && localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -3342,7 +3484,7 @@ TclPushVarName(
PushStringLiteral(envPtr, "");
}
}
- } else {
+ } else if (interp) {
/*
* The var name isn't simple: compile and push it.
*/
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 150c378..ffe39ba 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -28,6 +28,58 @@ static void CompileReturnInternal(CompileEnv *envPtr,
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -85,14 +137,17 @@ TclCompileGlobalCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+ for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
if (localIndex < 0) {
return TCL_ERROR;
}
- CompileWord(envPtr, varTokenPtr, interp, 1);
+ /* TODO: Consider what value can pass throug the
+ * IndexTailVarIfKnown() screen. Full CompileWord()
+ * likely does not apply here. Push known value instead. */
+ CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
@@ -584,6 +639,7 @@ TclCompileInfoCommandsCmd(
* that the result needs to be list-ified.
*/
+ /* TODO: Just push the known value */
CompileWord(envPtr, tokenPtr, interp, 1);
TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
TclEmitOpcode( INST_DUP, envPtr);
@@ -810,28 +866,16 @@ TclCompileLappendCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
- int isScalar, localIndex, numWords, i, fwd, offsetFwd;
+ int isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
- /*
- * If we're not in a procedure, don't compile.
- */
-
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
- }
-
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
- if (numWords == 1) {
+ if (numWords < 3) {
return TCL_ERROR;
}
- if (numWords != 3) {
- /*
- * LAPPEND instructions currently only handle one value, but we can
- * handle some multi-value cases by stringing them together.
- */
+ if (numWords != 3 || envPtr->procPtr == NULL) {
goto lappendMultiple;
}
@@ -885,42 +929,28 @@ TclCompileLappendCmd(
return TCL_OK;
lappendMultiple:
- /*
- * Can only handle the case where we are appending to a local scalar when
- * there are multiple values to append. Fortunately, this is common.
- */
-
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
- }
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
&localIndex, &isScalar, 1);
- if (!isScalar || localIndex < 0) {
- return TCL_ERROR;
- }
-
- /*
- * Definitely appending to a local scalar; generate the words and append
- * them.
- */
-
valueTokenPtr = TokenAfter(varTokenPtr);
for (i = 2 ; i < numWords ; i++) {
CompileWord(envPtr, valueTokenPtr, interp, i);
valueTokenPtr = TokenAfter(valueTokenPtr);
}
- TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
- TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- TclEmitOpcode( INST_LIST_CONCAT, envPtr);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
-
+ TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_LIST, localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_LIST_ARRAY_STK, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
+ }
+ }
return TCL_OK;
}
@@ -1023,7 +1053,7 @@ TclCompileLassignCmd(
*/
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
- TclEmitInt4( -2 /* == "end" */, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
return TCL_OK;
}
@@ -1056,7 +1086,7 @@ TclCompileLindexCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *idxTokenPtr, *valTokenPtr;
- int i, numWords = parsePtr->numWords;
+ int i, idx, numWords = parsePtr->numWords;
DefineLineInformation; /* TIP #280 */
/*
@@ -1074,46 +1104,28 @@ TclCompileLindexCmd(
}
idxTokenPtr = TokenAfter(valTokenPtr);
- if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- Tcl_Obj *tmpObj;
- int idx, result;
-
- tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx);
- if (result == TCL_OK) {
- if (idx < 0) {
- result = TCL_ERROR;
- }
- } else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
- if (result == TCL_OK && idx > -2) {
- result = TCL_ERROR;
- }
- }
- TclDecrRefCount(tmpObj);
-
- if (result == TCL_OK) {
- /*
- * All checks have been completed, and we have exactly one of
- * these constructs:
- * lindex <arbitraryValue> <posInt>
- * lindex <arbitraryValue> end-<posInt>
- * This is best compiled as a push of the arbitrary value followed
- * by an "immediate lindex" which is the most efficient variety.
- */
-
- CompileWord(envPtr, valTokenPtr, interp, 1);
- TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
- return TCL_OK;
- }
-
+ if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
/*
- * If the conversion failed or the value was negative, we just keep on
- * going with the more complex compilation.
+ * All checks have been completed, and we have exactly one of these
+ * constructs:
+ * lindex <arbitraryValue> <posInt>
+ * lindex <arbitraryValue> end-<posInt>
+ * This is best compiled as a push of the arbitrary value followed by
+ * an "immediate lindex" which is the most efficient variety.
*/
+
+ CompileWord(envPtr, valTokenPtr, interp, 1);
+ TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
+ return TCL_OK;
}
/*
+ * If the value was not known at compile time, the conversion failed or
+ * the value was negative, we just keep on going with the more complex
+ * compilation.
+ */
+
+ /*
* Push the operands onto the stack.
*/
@@ -1198,20 +1210,7 @@ TclCompileListCmd(
valueTokenPtr = TokenAfter(valueTokenPtr);
}
if (listObj != NULL) {
- int len;
- const char *bytes = Tcl_GetStringFromObj(listObj, &len);
-
- PushLiteral(envPtr, bytes, len);
- Tcl_DecrRefCount(listObj);
- if (len > 0) {
- /*
- * Force list interpretation!
- */
-
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_LIST_LENGTH, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- }
+ TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr);
return TCL_OK;
}
@@ -1259,7 +1258,7 @@ TclCompileListCmd(
if (concat && numWords == 2) {
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
- TclEmitInt4( -2, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
}
return TCL_OK;
}
@@ -1326,8 +1325,7 @@ TclCompileLrangeCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result;
+ int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
@@ -1335,56 +1333,18 @@ TclCompileLrangeCmd(
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx1);
- if (result == TCL_OK) {
- if (idx1 < 0) {
- result = TCL_ERROR;
- }
- } else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
- if (result == TCL_OK && idx1 > -2) {
- result = TCL_ERROR;
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
return TCL_ERROR;
}
- /*
- * Parse the second index. Will only compile if it is constant and not an
- * _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
- */
-
tokenPtr = TokenAfter(tokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx2);
- if (result == TCL_OK) {
- if (idx2 < 0) {
- result = TCL_ERROR;
- }
- } else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
- if (result == TCL_OK && idx2 > -2) {
- result = TCL_ERROR;
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
return TCL_ERROR;
}
@@ -1403,19 +1363,16 @@ TclCompileLrangeCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileLreplaceCmd --
+ * TclCompileLinsertCmd --
*
- * How to compile the "lreplace" command. We only bother with the case
- * where there are no elements to insert and where both the 'first' and
- * 'last' arguments are constant and one can be deterined to be at the
- * end of the list. (This is the case that could also be written with
- * "lrange".)
+ * How to compile the "linsert" command. We only bother with the case
+ * where the index is constant.
*
*----------------------------------------------------------------------
*/
int
-TclCompileLreplaceCmd(
+TclCompileLinsertCmd(
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
@@ -1425,101 +1382,331 @@ TclCompileLreplaceCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result, guaranteedDropAll = 0;
+ int idx, i;
- if (parsePtr->numWords != 4) {
+ if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * Parse the index. Will only compile if it is constant and not an
* _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
return TCL_ERROR;
}
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx1);
- if (result == TCL_OK) {
- if (idx1 < 0) {
- result = TCL_ERROR;
- }
+
+ /*
+ * There are four main cases. If there are no values to insert, this is
+ * just a confirm-listiness check. If the index is '0', this is a prepend.
+ * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
+ * this is a splice (== split, insert values as list, concat-3).
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ return TCL_OK;
+ }
+
+ for (i=3 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ TclEmitInstInt4( INST_LIST, i-3, envPtr);
+
+ if (idx == 0 /*start*/) {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ } else if (idx == INDEX_END /*end*/) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
} else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
- if (result == TCL_OK && idx1 > -2) {
- result = TCL_ERROR;
+ if (idx < 0) {
+ idx++;
}
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx-1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
}
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ * How to compile the "lreplace" command. We only bother with the case
+ * where the indices are constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLreplaceCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *listTokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *tmpObj;
+ int idx1, idx2, i, offset, offset2;
+
+ if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the second index. Will only compile if it is constant and not an
+ * Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
- tokenPtr = TokenAfter(tokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
return TCL_ERROR;
}
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx2);
- if (result == TCL_OK) {
- if (idx2 < 0) {
- result = TCL_ERROR;
- }
- } else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
- if (result == TCL_OK && idx2 > -2) {
- result = TCL_ERROR;
- }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ return TCL_ERROR;
}
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+
+ /*
+ * idx1, idx2 are now in canonical form:
+ *
+ * - integer: [0,len+1]
+ * - end index: INDEX_END
+ * - -ive offset: INDEX_END-[len-1,0]
+ * - +ive offset: INDEX_END+1
+ */
+
+ /*
+ * Compilation fails when one index is end-based but the other isn't.
+ * Fixing this will require more bytecodes, but this is a workaround for
+ * now. [Bug 47ac84309b]
+ */
+
+ if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
return TCL_ERROR;
}
+ if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+
/*
- * Sanity check: can only issue when we're removing a range at one or
- * other end of the list. If we're at one end or the other, convert the
- * indices into the equivalent for an [lrange].
+ * Work out what this [lreplace] is actually doing.
*/
+ tmpObj = NULL;
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 4) {
+ if (idx1 == 0) {
+ if (idx2 == INDEX_END) {
+ goto dropAll;
+ }
+ idx1 = idx2 + 1;
+ idx2 = INDEX_END;
+ goto dropEnd;
+ } else if (idx2 == INDEX_END) {
+ idx2 = idx1 - 1;
+ idx1 = 0;
+ goto dropEnd;
+ } else {
+ if (idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto dropRange;
+ }
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ for (i=4 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, i - 4, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
if (idx1 == 0) {
- if (idx2 == -2) {
- guaranteedDropAll = 1;
+ if (idx2 == INDEX_END) {
+ goto replaceAll;
}
idx1 = idx2 + 1;
- idx2 = -2;
- } else if (idx2 == -2) {
+ idx2 = INDEX_END;
+ goto replaceHead;
+ } else if (idx2 == INDEX_END) {
idx2 = idx1 - 1;
idx1 = 0;
+ goto replaceTail;
} else {
- return TCL_ERROR;
+ if (idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto replaceRange;
}
/*
- * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
- * we've not proved that the 'list' argument is really a list. Not that it
- * is worth trying to do that given current knowledge.
+ * Issue instructions to perform the operations relating to configurations
+ * that just drop. The only argument pushed on the stack is the list to
+ * operate on.
*/
- CompileWord(envPtr, listTokenPtr, interp, 1);
- if (guaranteedDropAll) {
+ dropAll: /* This just ensures the arg is a list. */
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ goto done;
+
+ dropEnd:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ goto done;
+
+ dropRange:
+ if (tmpObj != NULL) {
+ /*
+ * Emit bytecode to check the list length.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "");
- } else {
- TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
- TclEmitInt4( idx2, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GE, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+
+ /*
+ * Emit an error if we've been given an empty list.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ offset2 = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+ envPtr->codeStart + offset2 + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Issue instructions to perform the operations relating to configurations
+ * that do real replacement. All arguments are pushed and assembled into a
+ * pair: the list of values to replace with, and the list to do the
+ * surgery on.
+ */
+
+ replaceAll:
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ goto done;
+
+ replaceHead:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceTail:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceRange:
+ if (tmpObj != NULL) {
+ /*
+ * Emit bytecode to check the list length.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+
+ /*
+ * Check the list length vs idx1.
+ */
+
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GE, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+
+ /*
+ * Emit an error if we've been given an empty list.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ offset2 = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+ envPtr->codeStart + offset2 + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Clean up the allocated memory.
+ */
+
+ done:
+ if (tmpObj != NULL) {
+ Tcl_DecrRefCount(tmpObj);
}
return TCL_OK;
}
@@ -1787,6 +1974,28 @@ TclCompileNamespaceCodeCmd(
}
int
+TclCompileNamespaceOriginCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr);
+ return TCL_OK;
+}
+
+int
TclCompileNamespaceQualifiersCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -1869,7 +2078,7 @@ TclCompileNamespaceUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
@@ -1899,15 +2108,13 @@ TclCompileNamespaceUpvarCmd(
*/
localTokenPtr = tokenPtr;
- for (i=3; i<=numWords; i+=2) {
+ for (i=2; i<numWords; i+=2) {
otherTokenPtr = TokenAfter(localTokenPtr);
localTokenPtr = TokenAfter(otherTokenPtr);
- CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
-
- if ((localIndex < 0) || !isScalar) {
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
@@ -2093,7 +2300,7 @@ TclCompileRegexpCmd(
* converted pattern as a literal.
*/
- if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
+ if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
== TCL_OK) {
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
@@ -2185,7 +2392,7 @@ TclCompileRegsubCmd(
Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
Tcl_DString pattern;
const char *bytes;
- int len, exact, result = TCL_ERROR;
+ int len, exact, quantified, result = TCL_ERROR;
if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
return TCL_ERROR;
@@ -2245,7 +2452,8 @@ TclCompileRegsubCmd(
*/
bytes = Tcl_GetStringFromObj(patternObj, &len);
- if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) {
+ if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
+ != TCL_OK || exact || quantified) {
goto done;
}
bytes = Tcl_DStringValue(&pattern);
@@ -2363,7 +2571,7 @@ TclCompileReturnCmd(
CompileWord(envPtr, optsTokenPtr, interp, 2);
CompileWord(envPtr, msgTokenPtr, interp, 3);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
return TCL_OK;
}
@@ -2377,6 +2585,10 @@ TclCompileReturnCmd(
* Scan through the return options. If any are unknown at compile time,
* there is no value in bytecompiling. Save the option values known in an
* objv array for merging into a return options dictionary.
+ *
+ * TODO: There is potential for improvement if all option keys are known
+ * at compile time and all option values relating to '-code' and '-level'
+ * are known at compile time.
*/
for (objc = 0; objc < numOptionWords; objc++) {
@@ -2384,7 +2596,7 @@ TclCompileReturnCmd(
Tcl_IncrRefCount(objv[objc]);
if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
/*
- * Non-literal, so punt to run-time.
+ * Non-literal, so punt to run-time assembly of the dictionary.
*/
for (; objc>=0 ; objc--) {
@@ -2505,7 +2717,7 @@ TclCompileReturnCmd(
* Issue the RETURN itself.
*/
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
return TCL_OK;
}
@@ -2517,6 +2729,23 @@ CompileReturnInternal(
int level,
Tcl_Obj *returnOpts)
{
+ if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
+ ExceptionRange *rangePtr;
+ ExceptionAux *exceptAux;
+
+ rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
+ if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+ TclCleanupStackForBreakContinue(envPtr, exceptAux);
+ if (code == TCL_BREAK) {
+ TclAddLoopBreakFixup(envPtr, exceptAux);
+ } else {
+ TclAddLoopContinueFixup(envPtr, exceptAux);
+ }
+ Tcl_DecrRefCount(returnOpts);
+ return;
+ }
+ }
+
TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
TclEmitInstInt4(op, code, envPtr);
TclEmitInt4(level, envPtr);
@@ -2566,18 +2795,16 @@ TclCompileUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *objPtr = Tcl_NewObj();
+ Tcl_Obj *objPtr;
if (envPtr->procPtr == NULL) {
- Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
numWords = parsePtr->numWords;
if (numWords < 3) {
- Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -2585,6 +2812,7 @@ TclCompileUpvarCmd(
* Push the frame index if it is known at compile time
*/
+ objPtr = Tcl_NewObj();
tokenPtr = TokenAfter(parsePtr->tokenPtr);
if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
CallFrame *framePtr;
@@ -2603,16 +2831,17 @@ TclCompileUpvarCmd(
if (numWords%2) {
return TCL_ERROR;
}
+ /* TODO: Push the known value instead? */
CompileWord(envPtr, tokenPtr, interp, 1);
otherTokenPtr = TokenAfter(tokenPtr);
- i = 4;
+ i = 2;
} else {
if (!(numWords%2)) {
return TCL_ERROR;
}
PushStringLiteral(envPtr, "1");
otherTokenPtr = tokenPtr;
- i = 3;
+ i = 1;
}
} else {
Tcl_DecrRefCount(objPtr);
@@ -2625,14 +2854,12 @@ TclCompileUpvarCmd(
* be called at runtime.
*/
- for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
+ for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
localTokenPtr = TokenAfter(otherTokenPtr);
- CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
-
- if ((localIndex < 0) || !isScalar) {
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
@@ -2706,6 +2933,9 @@ TclCompileVariableCmd(
return TCL_ERROR;
}
+ /* TODO: Consider what value can pass throug the
+ * IndexTailVarIfKnown() screen. Full CompileWord()
+ * likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
@@ -2779,10 +3009,12 @@ IndexTailVarIfKnown(
} else {
full = 0;
lastTokenPtr = varTokenPtr + n;
- if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+
+ if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
Tcl_DecrRefCount(tailPtr);
return -1;
}
+ Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
}
tailName = TclGetStringFromObj(tailPtr, &len);
@@ -2824,6 +3056,66 @@ IndexTailVarIfKnown(
return localIndex;
}
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
+ *
+ * Compilations of the TclOO utility commands [next] and [self].
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclCompileObjectNextCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ int i;
+
+ if (parsePtr->numWords > 255) {
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileObjectNextToCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ int i;
+
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr);
+ return TCL_OK;
+}
+
int
TclCompileObjectSelfCmd(
Tcl_Interp *interp, /* Used for error reporting. */
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d1eb9db..101edbd 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tclCompile.h"
+#include "tclStringTrim.h"
/*
* Prototypes for procedures defined later in this file:
@@ -27,6 +28,9 @@ static void FreeJumptableInfo(ClientData clientData);
static void PrintJumptableInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleJumptableInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, const char *identity,
int instruction, CompileEnv *envPtr);
@@ -71,7 +75,8 @@ const AuxDataType tclJumptableInfoType = {
"JumptableInfo", /* name */
DupJumptableInfo, /* dupProc */
FreeJumptableInfo, /* freeProc */
- PrintJumptableInfo /* printProc */
+ PrintJumptableInfo, /* printProc */
+ DisassembleJumptableInfo /* disassembleProc */
};
/*
@@ -99,6 +104,61 @@ const AuxDataType tclJumptableInfoType = {
if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
+#define INVOKE(name) \
+ TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -213,6 +273,78 @@ TclCompileSetCmd(
*/
int
+TclCompileStringCatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ int i, numWords = parsePtr->numWords, numArgs;
+ Tcl_Token *wordTokenPtr;
+ Tcl_Obj *obj, *folded;
+ DefineLineInformation; /* TIP #280 */
+
+ /* Trivial case, no arg */
+
+ if (numWords<2) {
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
+ contiguous constants along the way */
+
+ numArgs = 0;
+ folded = NULL;
+ wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i = 1; i < numWords; i++) {
+ obj = Tcl_NewObj();
+ if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
+ if (folded) {
+ Tcl_AppendObjToObj(folded, obj);
+ Tcl_DecrRefCount(obj);
+ } else {
+ folded = obj;
+ }
+ } else {
+ Tcl_DecrRefCount(obj);
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ CompileWord(envPtr, wordTokenPtr, interp, i);
+ numArgs ++;
+ if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
+ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+ numArgs = 1; /* concat pushes 1 obj, the result */
+ }
+ }
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ if (numArgs > 1) {
+ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+int
TclCompileStringCmpCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -369,6 +501,284 @@ TclCompileStringIndexCmd(
}
int
+TclCompileStringIsCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ static const char *const isClasses[] = {
+ "alnum", "alpha", "ascii", "control",
+ "boolean", "digit", "double", "entier",
+ "false", "graph", "integer", "list",
+ "lower", "print", "punct", "space",
+ "true", "upper", "wideinteger", "wordchar",
+ "xdigit", NULL
+ };
+ enum isClasses {
+ STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
+ STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
+ STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
+ STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
+ STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
+ STR_IS_XDIGIT
+ };
+ int t, range, allowEmpty = 0, end;
+ InstStringClassType strClassType;
+ Tcl_Obj *isClass;
+
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
+ return TCL_ERROR;
+ }
+ isClass = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
+ Tcl_DecrRefCount(isClass);
+ return TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
+ &t) != TCL_OK) {
+ Tcl_DecrRefCount(isClass);
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
+ }
+ Tcl_DecrRefCount(isClass);
+
+#define GotLiteral(tokenPtr, word) \
+ ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
+ (tokenPtr)[1].size > 1 && \
+ (tokenPtr)[1].start[0] == word[0] && \
+ strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+ /*
+ * Cannot handle the -failindex option at all, and that's the only legal
+ * way to have more than 4 arguments.
+ */
+
+ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords == 3) {
+ allowEmpty = 1;
+ } else {
+ if (!GotLiteral(tokenPtr, "-strict")) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+#undef GotLiteral
+
+ /*
+ * Compile the code. There are several main classes of check here.
+ * 1. Character classes
+ * 2. Booleans
+ * 3. Integers
+ * 4. Floats
+ * 5. Lists
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+
+ switch ((enum isClasses) t) {
+ case STR_IS_ALNUM:
+ strClassType = STR_CLASS_ALNUM;
+ goto compileStrClass;
+ case STR_IS_ALPHA:
+ strClassType = STR_CLASS_ALPHA;
+ goto compileStrClass;
+ case STR_IS_ASCII:
+ strClassType = STR_CLASS_ASCII;
+ goto compileStrClass;
+ case STR_IS_CONTROL:
+ strClassType = STR_CLASS_CONTROL;
+ goto compileStrClass;
+ case STR_IS_DIGIT:
+ strClassType = STR_CLASS_DIGIT;
+ goto compileStrClass;
+ case STR_IS_GRAPH:
+ strClassType = STR_CLASS_GRAPH;
+ goto compileStrClass;
+ case STR_IS_LOWER:
+ strClassType = STR_CLASS_LOWER;
+ goto compileStrClass;
+ case STR_IS_PRINT:
+ strClassType = STR_CLASS_PRINT;
+ goto compileStrClass;
+ case STR_IS_PUNCT:
+ strClassType = STR_CLASS_PUNCT;
+ goto compileStrClass;
+ case STR_IS_SPACE:
+ strClassType = STR_CLASS_SPACE;
+ goto compileStrClass;
+ case STR_IS_UPPER:
+ strClassType = STR_CLASS_UPPER;
+ goto compileStrClass;
+ case STR_IS_WORD:
+ strClassType = STR_CLASS_WORD;
+ goto compileStrClass;
+ case STR_IS_XDIGIT:
+ strClassType = STR_CLASS_XDIGIT;
+ compileStrClass:
+ if (allowEmpty) {
+ OP1( STR_CLASS, strClassType);
+ } else {
+ int over, over2;
+
+ OP( DUP);
+ OP1( STR_CLASS, strClassType);
+ JUMP1( JUMP_TRUE, over);
+ OP( POP);
+ PUSH( "0");
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ PUSH( "");
+ OP( STR_NEQ);
+ FIXJUMP1(over2);
+ }
+ return TCL_OK;
+
+ case STR_IS_BOOL:
+ case STR_IS_FALSE:
+ case STR_IS_TRUE:
+ OP( TRY_CVT_TO_BOOLEAN);
+ switch (t) {
+ int over, over2;
+
+ case STR_IS_BOOL:
+ if (allowEmpty) {
+ JUMP1( JUMP_TRUE, over);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ OP( POP);
+ PUSH( "1");
+ FIXJUMP1(over2);
+ } else {
+ OP4( REVERSE, 2);
+ OP( POP);
+ }
+ return TCL_OK;
+ case STR_IS_TRUE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_EQ);
+ } else {
+ OP( POP);
+ PUSH( "0");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ OP( LNOT);
+ return TCL_OK;
+ case STR_IS_FALSE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_NEQ);
+ } else {
+ OP( POP);
+ PUSH( "1");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ case STR_IS_DOUBLE: {
+ int satisfied, isEmpty;
+
+ if (allowEmpty) {
+ OP( DUP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_TRUE, isEmpty);
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ FIXJUMP1( isEmpty);
+ OP( POP);
+ FIXJUMP1( satisfied);
+ } else {
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(-1, envPtr);
+ FIXJUMP1( satisfied);
+ }
+ PUSH( "1");
+ FIXJUMP1( end);
+ return TCL_OK;
+ }
+
+ case STR_IS_INT:
+ case STR_IS_WIDE:
+ case STR_IS_ENTIER:
+ if (allowEmpty) {
+ int testNumType;
+
+ OP( DUP);
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_TRUE, testNumType);
+ OP( POP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(1, envPtr);
+ FIXJUMP1( testNumType);
+ OP4( REVERSE, 2);
+ OP( POP);
+ } else {
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_FALSE, end);
+ }
+
+ switch (t) {
+ case STR_IS_INT:
+ PUSH( "1");
+ OP( EQ);
+ break;
+ case STR_IS_WIDE:
+ PUSH( "2");
+ OP( LE);
+ break;
+ case STR_IS_ENTIER:
+ PUSH( "3");
+ OP( LE);
+ break;
+ }
+ FIXJUMP1( end);
+ return TCL_OK;
+
+ case STR_IS_LIST:
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ OP( DUP);
+ OP( LIST_LENGTH);
+ OP( POP);
+ ExceptionRangeEnds(envPtr, range);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( POP);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
TclCompileStringMatchCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -563,8 +973,7 @@ TclCompileStringRangeCmd(
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
- Tcl_Obj *tmpObj;
- int idx1, idx2, result;
+ int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
@@ -574,50 +983,13 @@ TclCompileStringRangeCmd(
toTokenPtr = TokenAfter(fromTokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
- * _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * Parse the two indices.
*/
- tmpObj = Tcl_NewObj();
- result = TCL_ERROR;
- if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) {
- if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) {
- if (idx1 >= 0) {
- result = TCL_OK;
- }
- } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) {
- if (idx1 <= -2) {
- result = TCL_OK;
- }
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
goto nonConstantIndices;
}
-
- /*
- * Parse the second index. Will only compile if it is constant and not an
- * _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
- */
-
- tmpObj = Tcl_NewObj();
- result = TCL_ERROR;
- if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) {
- if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) {
- if (idx2 >= 0) {
- result = TCL_OK;
- }
- } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) {
- if (idx2 <= -2) {
- result = TCL_OK;
- }
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
goto nonConstantIndices;
}
@@ -631,7 +1003,7 @@ TclCompileStringRangeCmd(
/*
* Push the operands onto the stack and then the substring operation.
- */
+ */
nonConstantIndices:
CompileWord(envPtr, stringTokenPtr, interp, 1);
@@ -640,6 +1012,320 @@ TclCompileStringRangeCmd(
OP( STR_RANGE);
return TCL_OK;
}
+
+int
+TclCompileStringReplaceCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
+ DefineLineInformation; /* TIP #280 */
+ int idx1, idx2;
+
+ if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+ return TCL_ERROR;
+ }
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (parsePtr->numWords == 5) {
+ tokenPtr = TokenAfter(valueTokenPtr);
+ tokenPtr = TokenAfter(tokenPtr);
+ replacementTokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Parse the indices. Will only compile special cases if both are
+ * constants and not an _integer_ less than zero (since we reserve
+ * negative indices here for end-relative indexing) or an end-based index
+ * greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(valueTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ /*
+ * We handle these replacements specially: first character (where
+ * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
+ * else and the semantics get rather screwy.
+ */
+
+ if (idx1 == 0 && idx2 == 0) {
+ int notEq, end;
+
+ /*
+ * Just working with the first character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop first */
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ return TCL_OK;
+ }
+ /* Replace first */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
+ int notEq, end;
+
+ /*
+ * Just working with the last character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop last */
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ return TCL_OK;
+ }
+ /* Replace last */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ OP4( REVERSE, 2);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else {
+ /*
+ * Need to process indices at runtime. This could be because the
+ * indices are not constants, or because we need to resolve them to
+ * absolute indices to work out if a replacement is going to happen.
+ * In any case, to runtime it is.
+ */
+
+ genericReplace:
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ tokenPtr = TokenAfter(valueTokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ if (replacementTokenPtr != NULL) {
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ } else {
+ PUSH( "");
+ }
+ OP( STR_REPLACE);
+ return TCL_OK;
+ }
+}
+
+int
+TclCompileStringTrimLCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM_LEFT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimRCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM_RIGHT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_UPPER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_LOWER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_TITLE);
+ return TCL_OK;
+}
+
+/*
+ * Support definitions for the [string is] compilation.
+ */
+
+static int
+UniCharIsAscii(
+ int character)
+{
+ return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+ int character)
+{
+ return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+StringClassDesc const tclStringClassTable[] = {
+ {"alnum", Tcl_UniCharIsAlnum},
+ {"alpha", Tcl_UniCharIsAlpha},
+ {"ascii", UniCharIsAscii},
+ {"control", Tcl_UniCharIsControl},
+ {"digit", Tcl_UniCharIsDigit},
+ {"graph", Tcl_UniCharIsGraph},
+ {"lower", Tcl_UniCharIsLower},
+ {"print", Tcl_UniCharIsPrint},
+ {"punct", Tcl_UniCharIsPunct},
+ {"space", Tcl_UniCharIsSpace},
+ {"upper", Tcl_UniCharIsUpper},
+ {"word", Tcl_UniCharIsWordChar},
+ {"xdigit", UniCharIsHexDigit},
+ {NULL, NULL}
+};
/*
*----------------------------------------------------------------------
@@ -750,7 +1436,7 @@ TclSubstCompile(
/*
* Tricky point! If the first token does not result in a *guaranteed* push
* of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
- * is possible to get to an INST_CONCAT1 or INST_DONE without enough
+ * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
* values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
* identifying a script that could trigger this case.
*/
@@ -815,11 +1501,11 @@ TclSubstCompile(
}
while (count > 255) {
- OP1( CONCAT1, 255);
+ OP1( STR_CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- OP1( CONCAT1, count);
+ OP1( STR_CONCAT1, count);
count = 1;
}
@@ -873,7 +1559,7 @@ TclSubstCompile(
OP( END_CATCH);
OP( RETURN_CODE_BRANCH);
- /* ERROR -> reraise it */
+ /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
OP( RETURN_STK);
OP( NOP);
@@ -939,7 +1625,7 @@ TclSubstCompile(
(int) (CurrentOffset(envPtr) - okFixup.codeOffset));
}
if (count > 1) {
- OP1(CONCAT1, count);
+ OP1(STR_CONCAT1, count);
count = 1;
}
@@ -952,11 +1638,11 @@ TclSubstCompile(
}
while (count > 255) {
- OP1( CONCAT1, 255);
+ OP1( STR_CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- OP1( CONCAT1, count);
+ OP1( STR_CONCAT1, count);
}
Tcl_FreeParse(&parse);
@@ -1342,7 +2028,7 @@ IssueSwitchChainedTests(
int foundDefault; /* Flag to indicate whether a "default" clause
* is present. */
JumpFixup *fixupArray; /* Array of forward-jump fixup records. */
- int *fixupTargetArray; /* Array of places for fixups to point at. */
+ unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
int fixupCount; /* Number of places to fix up. */
int contFixIndex; /* Where the first of the jumps due to a group
* of continuation bodies starts, or -1 if
@@ -1409,7 +2095,7 @@ IssueSwitchChainedTests(
*/
if (TclReToGlob(NULL, bodyToken[i]->start,
- bodyToken[i]->size, &ds, &exact) == TCL_OK) {
+ bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
@@ -1496,7 +2182,7 @@ IssueSwitchChainedTests(
}
/*
- * Now do the actual compilation. Note that we do not use BODY()
+ * Now do the actual compilation. Note that we do not use BODY()
* because we may have synthesized the tokens in a non-standard
* pattern.
*/
@@ -1759,11 +2445,13 @@ IssueSwitchJumpTable(
* DupJumptableInfo: a copy of the jump-table
* FreeJumptableInfo: none
* PrintJumptableInfo: none
+ * DisassembleJumptableInfo: none
*
* Side effects:
* DupJumptableInfo: allocates memory
* FreeJumptableInfo: releases memory
* PrintJumptableInfo: none
+ * DisassembleJumptableInfo: none
*
*----------------------------------------------------------------------
*/
@@ -1826,6 +2514,30 @@ PrintJumptableInfo(
keyPtr, pcOffset + offset);
}
}
+
+static void
+DisassembleJumptableInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register JumptableInfo *jtPtr = clientData;
+ Tcl_Obj *mapping = Tcl_NewObj();
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ const char *keyPtr;
+ int offset;
+
+ hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+ for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+ keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+ offset = PTR2INT(Tcl_GetHashValue(hPtr));
+ Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
+ Tcl_NewIntObj(offset));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
+}
/*
*----------------------------------------------------------------------
@@ -1864,6 +2576,7 @@ TclCompileTailcallCmd(
}
/* make room for the nsObjPtr */
+ /* TODO: Doesn't this have to be a known value? */
CompileWord(envPtr, tokenPtr, interp, 0);
for (i=1 ; i<parsePtr->numWords ; i++) {
tokenPtr = TokenAfter(tokenPtr);
@@ -1927,7 +2640,7 @@ TclCompileThrowCmd(
}
CompileWord(envPtr, msgToken, interp, 2);
- codeIsList = codeKnown && (TCL_OK ==
+ codeIsList = codeKnown && (TCL_OK ==
Tcl_ListObjLength(interp, objPtr, &len));
codeIsValid = codeIsList && (len != 0);
@@ -1964,7 +2677,7 @@ TclCompileThrowCmd(
OP( LIST_LENGTH);
OP1( JUMP_FALSE1, 16);
OP4( LIST, 2);
- OP44( RETURN_IMM, 1, 0);
+ OP44( RETURN_IMM, TCL_ERROR, 0);
TclAdjustStackDepth(2, envPtr);
OP( POP);
OP( POP);
@@ -1973,7 +2686,7 @@ TclCompileThrowCmd(
PUSH( "type must be non-empty list");
PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}");
}
- OP44( RETURN_IMM, 1, 0);
+ OP44( RETURN_IMM, TCL_ERROR, 0);
return TCL_OK;
}
@@ -2355,6 +3068,7 @@ IssueTryClausesInstructions(
if (!handlerTokens[i]) {
forwardsNeedFixing = 1;
JUMP4( JUMP, forwardsToFix[i]);
+ TclAdjustStackDepth(1, envPtr);
} else {
int dontChangeOptions;
@@ -2395,7 +3109,7 @@ IssueTryClausesInstructions(
TclAdjustStackDepth(-1, envPtr);
FIXJUMP1( dontChangeOptions);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
}
JUMP4( JUMP, addrsToFix[i]);
@@ -2414,7 +3128,7 @@ IssueTryClausesInstructions(
OP( POP);
LOAD( optionsVar);
LOAD( resultVar);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
/*
* Fix all the jumps from taken clauses to here (which is the end of the
@@ -2723,7 +3437,7 @@ IssueTryClausesFinallyInstructions(
FIXJUMP1( finalOK);
LOAD( optionsVar);
LOAD( resultVar);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}
@@ -2782,7 +3496,7 @@ IssueTryFinallyInstructions(
OP1( JUMP1, 7);
FIXJUMP1( jumpOK);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}
@@ -2814,39 +3528,81 @@ TclCompileUnsetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int isScalar, localIndex, numWords, flags, i;
- Tcl_Obj *leadingWord;
+ int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
- numWords = parsePtr->numWords-1;
- flags = 1;
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- leadingWord = Tcl_NewObj();
- if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
- int len;
- const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
- if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
- flags = 0;
- varTokenPtr = TokenAfter(varTokenPtr);
- numWords--;
- } else if (len == 2 && !strncmp("--", bytes, 2)) {
- varTokenPtr = TokenAfter(varTokenPtr);
- numWords--;
- }
- } else {
- /*
- * Cannot guarantee that the first word is not '-nocomplain' at
- * evaluation with reasonable effort, so spill to interpreted version.
- */
+ /*
+ * Verify that all words - except the first non-option one - are known at
+ * compile time so that we can handle them without needing to do a nasty
+ * push/rotate. [Bug 3970f54c4e]
+ */
+
+ for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+ Tcl_Obj *leadingWord = Tcl_NewObj();
+
+ varTokenPtr = TokenAfter(varTokenPtr);
+ if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ TclDecrRefCount(leadingWord);
+
+ /*
+ * We can tolerate non-trivial substitutions in the first variable
+ * to be unset. If a '--' or '-nocomplain' was present, anything
+ * goes in that one place! (All subsequent variable names must be
+ * constants since we don't want to have to push them all first.)
+ */
+
+ if (varCount == 0) {
+ if (haveFlags) {
+ continue;
+ }
+
+ /*
+ * In fact, we're OK as long as we're the first argument *and*
+ * we provably don't start with a '-'. If that is true, then
+ * even if everything else is varying, we still can't be a
+ * flag. Otherwise we'll spill to runtime to place a limit on
+ * the trickiness.
+ */
+ if (varTokenPtr->type == TCL_TOKEN_WORD
+ && varTokenPtr[1].type == TCL_TOKEN_TEXT
+ && varTokenPtr[1].size > 0
+ && varTokenPtr[1].start[0] != '-') {
+ continue;
+ }
+ }
+ return TCL_ERROR;
+ }
+ if (varCount == 0) {
+ const char *bytes;
+ int len;
+
+ bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+ flags = 0;
+ haveFlags++;
+ } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
+ haveFlags++;
+ } else {
+ varCount++;
+ }
+ } else {
+ varCount++;
+ }
TclDecrRefCount(leadingWord);
- return TCL_ERROR;
}
- TclDecrRefCount(leadingWord);
- for (i=0 ; i<numWords ; i++) {
+ /*
+ * Issue instructions to unset each of the named variables.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i=0; i<haveFlags;i++) {
+ varTokenPtr = TokenAfter(varTokenPtr);
+ }
+ for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
/*
* Decide if we can use a frame slot for the var/array name or if we
* need to emit code to compute and push the name at runtime. We use a
@@ -2856,7 +3612,7 @@ TclCompileUnsetCmd(
*/
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
+ &localIndex, &isScalar, i);
/*
* Emit instructions to unset the variable.
@@ -3106,6 +3862,51 @@ TclCompileYieldCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileYieldToCmd --
+ *
+ * Procedure called to compile the "yieldto" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "yieldto" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldToCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ int i;
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ OP( NS_CURRENT);
+ for (i = 1 ; i < parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ OP4( LIST, i);
+ OP( YIELD_TO_INVOKE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* CompileUnaryOpCmd --
*
* Utility routine to compile the unary operator commands.
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 2a48117..4390282 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -365,7 +365,7 @@ static const unsigned char prec[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
@@ -420,7 +420,7 @@ static const unsigned char instruction[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
@@ -488,15 +488,8 @@ static const unsigned char Lexeme[] = {
typedef struct JumpList {
JumpFixup jump; /* Pass this argument to matching calls of
- * TclEmitForwardJump() and
+ * TclEmitForwardJump() and
* TclFixupForwardJump(). */
- int depth; /* Remember the currStackDepth of the
- * CompileEnv here. */
- int offset; /* Data used to compute jump lengths to pass
- * to TclFixupForwardJump() */
- int convert; /* Temporary storage used to compute whether
- * numeric conversion will be needed following
- * the operator we're compiling. */
struct JumpList *next; /* Point to next item on the stack */
} JumpList;
@@ -571,13 +564,13 @@ ParseExpr(
{
OpNode *nodes = NULL; /* Pointer to the OpNode storage array where
* we build the parse tree. */
- int nodesAvailable = 64; /* Initial size of the storage array. This
+ unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
* value establishes a minimum tree memory
* cost of only about 1 kibyte, and is large
* enough for most expressions to parse with
* no need for array growth and
* reallocation. */
- int nodesUsed = 0; /* Number of OpNodes filled. */
+ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */
int scanned = 0; /* Capture number of byte scanned by parsing
* routines. */
int lastParsed; /* Stores info about what the lexeme parsed
@@ -669,11 +662,13 @@ ParseExpr(
*/
if (nodesUsed >= nodesAvailable) {
- int size = nodesUsed * 2;
- OpNode *newPtr;
+ unsigned int size = nodesUsed * 2;
+ OpNode *newPtr = NULL;
do {
+ if (size <= UINT_MAX/sizeof(OpNode)) {
newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
+ }
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
@@ -845,7 +840,7 @@ ParseExpr(
switch (lexeme) {
case NUMBER:
- case BOOLEAN:
+ case BOOLEAN:
/*
* TODO: Consider using a dict or hash to collapse all
* duplicate literals into a single representative value.
@@ -868,7 +863,7 @@ ParseExpr(
start += scanned;
numBytes -= scanned;
continue;
-
+
default:
break;
}
@@ -1331,7 +1326,7 @@ ParseExpr(
nodePtr->mark = MARK_LEFT;
nodePtr->left = complete;
- /*
+ /*
* The COMMA operator cannot be optimized, since the function
* needs all of its arguments, and optimization would reduce the
* number. Other binary operators root constant expressions when
@@ -1553,7 +1548,7 @@ ConvertTreeToTokens(
* Tcl_ParseExpr() we do not change them now. Internally, we can
* do better.
*/
-
+
int toCopy = tokenPtr->numComponents + 1;
if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
@@ -1569,7 +1564,7 @@ ConvertTreeToTokens(
subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
parsePtr->numTokens += toCopy;
} else {
- /*
+ /*
* Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
* lead, with fields initialized from the leading token, then
* copy entire set of word tokens.
@@ -1618,7 +1613,7 @@ ConvertTreeToTokens(
case COMMA:
case COLON:
- /*
+ /*
* Historical practice has been to have no Tcl_Tokens for
* these operators.
*/
@@ -1754,7 +1749,7 @@ ConvertTreeToTokens(
/*
* Before we leave this node/operator/subexpression for the
* last time, finish up its tokens....
- *
+ *
* Our current position scanning the string is where the
* substring for the subexpression ends.
*/
@@ -1974,7 +1969,7 @@ ParseLexeme(
case 'i':
if ((numBytes > 1) && (start[1] == 'n')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
/*
* Must make this check so we can tell the difference between the
* "in" operator and the "int" function name and the "infinity"
@@ -1988,14 +1983,15 @@ ParseLexeme(
case 'e':
if ((numBytes > 1) && (start[1] == 'q')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
*lexemePtr = STREQ;
return 2;
}
break;
case 'n':
- if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ if ((numBytes > 1)
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
switch (start[1]) {
case 'e':
*lexemePtr = STRNEQ;
@@ -2010,9 +2006,8 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
- if (end < start + numBytes && !isalnum(UCHAR(*end))
- && UCHAR(*end) != '_') {
-
+ if (end < start + numBytes && !TclIsBareword(*end)) {
+
number:
TclInitStringRep(literal, start, end-start);
*lexemePtr = NUMBER;
@@ -2036,9 +2031,9 @@ ParseLexeme(
const char *p = start;
while (p < end) {
- if (!isalnum(UCHAR(*p++))) {
+ if (!TclIsBareword(*p++)) {
/*
- * The number has non-bareword characters, so we
+ * The number has non-bareword characters, so we
* must treat it as a number.
*/
goto number;
@@ -2061,33 +2056,30 @@ ParseLexeme(
}
}
- if (Tcl_UtfCharComplete(start, numBytes)) {
- scanned = Tcl_UtfToUniChar(start, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
+ /*
+ * We reject leading underscores in bareword. No sensible reason why.
+ * Might be inspired by reserved identifier rules in C, which of course
+ * have no direct relevance here.
+ */
- memcpy(utfBytes, start, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- scanned = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- if (!isalnum(UCHAR(ch))) {
- *lexemePtr = INVALID;
- Tcl_DecrRefCount(literal);
- return scanned;
- }
- end = start;
- while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
- end += scanned;
- numBytes -= scanned;
- if (Tcl_UtfCharComplete(end, numBytes)) {
- scanned = Tcl_UtfToUniChar(end, &ch);
+ if (!TclIsBareword(*start) || *start == '_') {
+ if (Tcl_UtfCharComplete(start, numBytes)) {
+ scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
- memcpy(utfBytes, end, (size_t) numBytes);
+ memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
+ *lexemePtr = INVALID;
+ Tcl_DecrRefCount(literal);
+ return scanned;
+ }
+ end = start;
+ while (numBytes && TclIsBareword(*end)) {
+ end += 1;
+ numBytes -= 1;
}
*lexemePtr = BAREWORD;
if (literalPtr) {
@@ -2105,7 +2097,7 @@ ParseLexeme(
* TclCompileExpr --
*
* This procedure compiles a string containing a Tcl expression into Tcl
- * bytecodes.
+ * bytecodes.
*
* Results:
* None.
@@ -2261,30 +2253,8 @@ CompileExprTree(
if (nodePtr->mark == MARK_LEFT) {
next = nodePtr->left;
- switch (nodePtr->lexeme) {
- case QUESTION:
- newJump = TclStackAlloc(interp, sizeof(JumpList));
- newJump->next = jumpPtr;
- jumpPtr = newJump;
- newJump = TclStackAlloc(interp, sizeof(JumpList));
- newJump->next = jumpPtr;
- jumpPtr = newJump;
- jumpPtr->depth = envPtr->currStackDepth;
+ if (nodePtr->lexeme == QUESTION) {
convert = 1;
- break;
- case AND:
- case OR:
- newJump = TclStackAlloc(interp, sizeof(JumpList));
- newJump->next = jumpPtr;
- jumpPtr = newJump;
- newJump = TclStackAlloc(interp, sizeof(JumpList));
- newJump->next = jumpPtr;
- jumpPtr = newJump;
- newJump = TclStackAlloc(interp, sizeof(JumpList));
- newJump->next = jumpPtr;
- jumpPtr = newJump;
- jumpPtr->depth = envPtr->currStackDepth;
- break;
}
} else if (nodePtr->mark == MARK_RIGHT) {
next = nodePtr->right;
@@ -2317,25 +2287,35 @@ CompileExprTree(
break;
}
case QUESTION:
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
break;
case COLON:
- CLANG_ASSERT(jumpPtr);
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &jumpPtr->next->jump);
- envPtr->currStackDepth = jumpPtr->depth;
- jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
- jumpPtr->convert = convert;
+ &jumpPtr->jump);
+ TclAdjustStackDepth(-1, envPtr);
+ if (convert) {
+ jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
+ }
convert = 1;
break;
case AND:
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
- break;
case OR:
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
+ TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
+ ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
break;
}
} else {
+ int pc1, pc2, target;
+
switch (nodePtr->lexeme) {
case START:
case QUESTION:
@@ -2352,11 +2332,11 @@ CompileExprTree(
* Use the numWords count we've kept to invoke the function
* command with the correct number of arguments.
*/
-
+
if (numWords < 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
} else {
- TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
}
/*
@@ -2375,18 +2355,20 @@ CompileExprTree(
break;
case COLON:
CLANG_ASSERT(jumpPtr);
- if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
- (envPtr->codeNext - envPtr->codeStart)
- - jumpPtr->next->jump.codeOffset, 127)) {
- jumpPtr->offset += 3;
+ if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
+ jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
+ convert = 1;
+ }
+ target = jumpPtr->jump.codeOffset + 2;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
+ target += 3;
}
- TclFixupForwardJump(envPtr, &jumpPtr->jump,
- jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
- convert |= jumpPtr->convert;
- envPtr->currStackDepth = jumpPtr->depth + 1;
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
TclStackFree(interp, freePtr);
+ TclFixupForwardJump(envPtr, &jumpPtr->jump,
+ target - jumpPtr->jump.codeOffset, 127);
+
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
TclStackFree(interp, freePtr);
@@ -2394,30 +2376,24 @@ CompileExprTree(
case AND:
case OR:
CLANG_ASSERT(jumpPtr);
- TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
- ? TCL_FALSE_JUMP : TCL_TRUE_JUMP,
- &jumpPtr->next->jump);
+ pc1 = CurrentOffset(envPtr);
+ TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
+ : INST_JUMP_TRUE1, 0, envPtr);
TclEmitPush(TclRegisterNewLiteral(envPtr,
(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &jumpPtr->next->next->jump);
+ pc2 = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP1, 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
- TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
+ envPtr->codeStart + pc1 + 1);
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
- jumpPtr->next->next->jump.codeOffset += 3;
+ pc2 += 3;
}
TclEmitPush(TclRegisterNewLiteral(envPtr,
(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
- TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
- 127);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
+ envPtr->codeStart + pc2 + 1);
convert = 0;
- envPtr->currStackDepth = jumpPtr->depth + 1;
- freePtr = jumpPtr;
- jumpPtr = jumpPtr->next;
- TclStackFree(interp, freePtr);
- freePtr = jumpPtr;
- jumpPtr = jumpPtr->next;
- TclStackFree(interp, freePtr);
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
TclStackFree(interp, freePtr);
@@ -2450,7 +2426,7 @@ CompileExprTree(
const char *bytes = TclGetStringFromObj(literal, &length);
int index = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
-
+
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2593,7 +2569,7 @@ TclSingleOpCmd(
*
* TclSortingOpCmd --
* Implements the commands:
- * <, <=, >, >=, ==, eq
+ * <, <=, >, >=, ==, eq
* in the ::tcl::mathop namespace. These commands are defined for
* arbitrary number of arguments by computing the AND of the base
* operator applied to all neighbor argument pairs.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f5c8d41..c0b5dcc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -17,15 +17,6 @@
#include <assert.h>
/*
- * Table of all AuxData types.
- */
-
-static Tcl_HashTable auxDataTypeTable;
-static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */
-
-TCL_DECLARE_MUTEX(tableMutex)
-
-/*
* Variable that controls whether compilation tracing is enabled and, if so,
* what level of tracing is desired:
* 0: no compilation tracing
@@ -55,15 +46,15 @@ InstructionDesc const tclInstructionTable[] = {
/* Name Bytes stackEffect #Opnds Operand types */
{"done", 1, -1, 0, {OPERAND_NONE}},
/* Finish ByteCode execution and return stktop (top stack item) */
- {"push1", 2, +1, 1, {OPERAND_UINT1}},
+ {"push1", 2, +1, 1, {OPERAND_LIT1}},
/* Push object at ByteCode objArray[op1] */
- {"push4", 5, +1, 1, {OPERAND_UINT4}},
+ {"push4", 5, +1, 1, {OPERAND_LIT4}},
/* Push object at ByteCode objArray[op4] */
{"pop", 1, -1, 0, {OPERAND_NONE}},
/* Pop the topmost stack object */
{"dup", 1, +1, 0, {OPERAND_NONE}},
/* Duplicate the topmost stack object and push the result */
- {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Concatenate the top op1 items and push result */
{"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
@@ -125,17 +116,17 @@ InstructionDesc const tclInstructionTable[] = {
{"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
/* Incr general variable; unparsed name is top, amount is op1 */
- {"jump1", 2, 0, 1, {OPERAND_INT1}},
+ {"jump1", 2, 0, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) */
- {"jump4", 5, 0, 1, {OPERAND_INT4}},
+ {"jump4", 5, 0, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) */
- {"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
+ {"jumpTrue1", 2, -1, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) if stktop expr object is true */
- {"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
+ {"jumpTrue4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is true */
- {"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
+ {"jumpFalse1", 2, -1, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) if stktop expr object is false */
- {"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
+ {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
{"lor", 1, -1, 0, {OPERAND_NONE}},
@@ -298,7 +289,7 @@ InstructionDesc const tclInstructionTable[] = {
/* List Index: push (lindex stktop op4) */
{"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
/* List Range: push (lrange stktop op4 op4) */
- {"startCommand", 9, 0, 2, {OPERAND_INT4,OPERAND_UINT4}},
+ {"startCommand", 9, 0, 2, {OPERAND_OFFSET4, OPERAND_UINT4}},
/* Start of bytecoded command: op is the length of the cmd's code, op2
* is number of commands here */
@@ -356,7 +347,7 @@ InstructionDesc const tclInstructionTable[] = {
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
* the variable referred to by the first immediate argument. The list
- * of keys (top of the stack, not poppsed) must be the same length as
+ * of keys (top of the stack, not popped) must be the same length as
* the list of variables.
* Stack: ... keyList => ... keyList */
{"dictUpdateEnd", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}},
@@ -493,6 +484,7 @@ InstructionDesc const tclInstructionTable[] = {
* qualified version, or produces the empty string if no such command
* exists. Never generates errors.
* Stack: ... cmdName => ... fullCmdName */
+
{"tclooSelf", 1, +1, 0, {OPERAND_NONE}},
/* Push the identity of the current TclOO object (i.e., the name of
* its current public access command) on the stack. */
@@ -517,7 +509,7 @@ InstructionDesc const tclInstructionTable[] = {
* case. Also runs the whole-array trace on the named variable, so can
* throw anything.
* Stack: ... varName => ... boolean */
- {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}},
+ {"arrayExistsImm", 5, +1, 1, {OPERAND_LVT4}},
/* Looks up the variable indexed by opnd and tests whether it is an
* array. Pushes a boolean describing whether this is the case. Also
* runs the whole-array trace on the named variable, so can throw
@@ -527,7 +519,7 @@ InstructionDesc const tclInstructionTable[] = {
/* Forces the element on the top of the stack to be the name of an
* array.
* Stack: ... varName => ... */
- {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}},
+ {"arrayMakeImm", 5, 0, 1, {OPERAND_LVT4}},
/* Forces the variable indexed by opnd to be an array. Does not touch
* the stack. */
@@ -545,6 +537,123 @@ InstructionDesc const tclInstructionTable[] = {
/* Drops an element from the auxiliary stack, popping stack elements
* until the matching stack depth is reached. */
+ /* New foreach implementation */
+ {"foreach_start", 5, +2, 1, {OPERAND_AUX4}},
+ /* Initialize execution of a foreach loop. Operand is aux data index
+ * of the ForeachInfo structure for the foreach command. It pushes 2
+ * elements which hold runtime params for foreach_step, they are later
+ * dropped by foreach_end together with the value lists. NOTE that the
+ * iterator-tracker and info reference must not be passed to bytecodes
+ * that handle normal Tcl values. NOTE that this instruction jumps to
+ * the foreach_step instruction paired with it; the stack info below
+ * is only nominal.
+ * Stack: ... listObjs... => ... listObjs... iterTracker info */
+ {"foreach_step", 1, 0, 0, {OPERAND_NONE}},
+ /* "Step" or begin next iteration of foreach loop. Assigns to foreach
+ * iteration variables. May jump to straight after the foreach_start
+ * that pushed the iterTracker and info values. MUST be followed
+ * immediately by a foreach_end.
+ * Stack: ... listObjs... iterTracker info =>
+ * ... listObjs... iterTracker info */
+ {"foreach_end", 1, 0, 0, {OPERAND_NONE}},
+ /* Clean up a foreach loop by dropping the info value, the tracker
+ * value and the lists that were being iterated over.
+ * Stack: ... listObjs... iterTracker info => ... */
+ {"lmap_collect", 1, -1, 0, {OPERAND_NONE}},
+ /* Appends the value at the top of the stack to the list located on
+ * the stack the "other side" of the foreach-related values.
+ * Stack: ... collector listObjs... iterTracker info value =>
+ * ... collector listObjs... iterTracker info */
+
+ {"strtrim", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trim] core: removes the characters (designated by the value
+ * at the top of the stack) from both ends of the string and pushes
+ * the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimleft] core: removes the characters (designated by the
+ * value at the top of the stack) from the left of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimRight", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimright] core: removes the characters (designated by the
+ * value at the top of the stack) from the right of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+
+ {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+ * is number of values to concatenate.
+ * Operation: push concat(stk1 stk2 ... stktop) */
+
+ {"strcaseUpper", 1, 0, 0, {OPERAND_NONE}},
+ /* [string toupper] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strcaseLower", 1, 0, 0, {OPERAND_NONE}},
+ /* [string tolower] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strcaseTitle", 1, 0, 0, {OPERAND_NONE}},
+ /* [string totitle] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strreplace", 1, -3, 0, {OPERAND_NONE}},
+ /* [string replace] core: replaces a non-empty range of one string
+ * with the contents of another.
+ * Stack: ... string fromIdx toIdx replacement => ... newString */
+
+ {"originCmd", 1, 0, 0, {OPERAND_NONE}},
+ /* Reports which command was the origin (via namespace import chain)
+ * of the command named on the top of the stack.
+ * Stack: ... cmdName => ... fullOriginalCmdName */
+
+ {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Call the next item on the TclOO call chain, passing opnd arguments
+ * (min 1, max 255, *includes* "next"). The result of the invoked
+ * method implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "next" arg2 arg3 -- argN => ... result */
+ {"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Call the following item on the TclOO call chain defined by class
+ * className, passing opnd arguments (min 2, max 255, *includes*
+ * "nextto" and the class name). The result of the invoked method
+ * implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "nextto" className arg3 arg4 -- argN => ... result */
+
+ {"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}},
+ /* Makes the current coroutine yield the value at the top of the
+ * stack, invoking the given command/args with resolution in the given
+ * namespace (all packed into a list), and places the list of values
+ * that are the response back on top of the stack when it resumes.
+ * Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */
+
+ {"numericType", 1, 0, 0, {OPERAND_NONE}},
+ /* Pushes the numeric type code of the word at the top of the stack.
+ * Stack: ... value => ... typeCode */
+ {"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
+ /* Try converting stktop to boolean if possible. No errors.
+ * Stack: ... value => ... value isStrictBool */
+ {"strclass", 2, 0, 1, {OPERAND_SCLS1}},
+ /* See if all the characters of the given string are a member of the
+ * specified (by opnd) character class. Note that an empty string will
+ * satisfy the class check (standard definition of "all").
+ * Stack: ... stringValue => ... boolean */
+
+ {"lappendList", 5, 0, 1, {OPERAND_LVT4}},
+ /* Lappend list to scalar variable at op4 in frame.
+ * Stack: ... list => ... listVarContents */
+ {"lappendListArray", 5, -1, 1, {OPERAND_LVT4}},
+ /* Lappend list to array element; array at op4.
+ * Stack: ... elem list => ... listVarContents */
+ {"lappendListArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Lappend list to array element.
+ * Stack: ... arrayName elem list => ... listVarContents */
+ {"lappendListStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Lappend list to general variable.
+ * Stack: ... varName list => ... listVarContents */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -570,15 +679,9 @@ static int IsCompactibleCompileEnv(Tcl_Interp *interp,
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
-static void RegisterAuxDataType(const AuxDataType *typePtr);
static int SetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void StartExpanding(CompileEnv *envPtr);
-static int FormatInstruction(ByteCode *codePtr,
- const unsigned char *pc, Tcl_Obj *bufferObj);
-static void PrintSourceToObj(Tcl_Obj *appendObj,
- const char *stringPtr, int maxChars);
-static void UpdateStringOfInstName(Tcl_Obj *objPtr);
/*
* TIP #280: Helper for building the per-word line information of all compiled
@@ -617,19 +720,6 @@ static const Tcl_ObjType substCodeType = {
};
/*
- * The structure below defines an instruction name Tcl object to allow
- * reporting of inner contexts in errorstack without string allocation.
- */
-
-static const Tcl_ObjType tclInstNameType = {
- "instname", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfInstName, /* updateStringProc */
- NULL, /* setFromAnyProc */
-};
-
-/*
* Helper macros.
*/
@@ -754,7 +844,9 @@ TclSetByteCodeFromAny(
* instruction generator boundaries.
*/
- TclOptimizeBytecode(&compEnv);
+ if (iPtr->extra.optimizer) {
+ (iPtr->extra.optimizer)(&compEnv);
+ }
/*
* Invoke the compilation hook procedure if one exists.
@@ -876,8 +968,7 @@ FreeByteCodeInternalRep(
register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1193,8 +1284,8 @@ CompileSubstObj(
if (objPtr->typePtr == &substCodeType) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
- if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
@@ -1220,8 +1311,8 @@ CompileSubstObj(
TclFreeCompileEnv(&compEnv);
codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
- objPtr->internalRep.ptrAndLongRep.value = flags;
+ objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1260,11 +1351,10 @@ static void
FreeSubstCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+ register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1524,7 +1614,7 @@ TclFreeCompileEnv(
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
if (envPtr->iPtr) {
- /*
+ /*
* We never converted to Bytecode, so free the things we would
* have transferred to it.
*/
@@ -1709,7 +1799,7 @@ TclCompileInvocation(
int numWords,
CompileEnv *envPtr)
{
- int wordIdx = 0;
+ int wordIdx = 0, depth = TclGetStackDepth(envPtr);
DefineLineInformation;
if (cmdObj) {
@@ -1738,10 +1828,11 @@ TclCompileInvocation(
}
if (wordIdx <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
} else {
- TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
static void
@@ -1754,7 +1845,7 @@ CompileExpanded(
{
int wordIdx = 0;
DefineLineInformation;
-
+ int depth = TclGetStackDepth(envPtr);
StartExpanding(envPtr);
if (cmdObj) {
@@ -1787,27 +1878,24 @@ CompileExpanded(
}
/*
- * The stack depth during argument expansion can only be
- * managed at runtime, as the number of elements in the
- * expanded lists is not known at compile time. We adjust here
- * the stack depth estimate so that it is correct after the
- * command with expanded arguments returns.
+ * The stack depth during argument expansion can only be managed at
+ * runtime, as the number of elements in the expanded lists is not known
+ * at compile time. We adjust here the stack depth estimate so that it is
+ * correct after the command with expanded arguments returns.
*
- * The end effect of this command's invocation is that all the
- * words of the command are popped from the stack, and the
- * result is pushed: the stack top changes by (1-wordIdx).
+ * The end effect of this command's invocation is that all the words of
+ * the command are popped from the stack, and the result is pushed: the
+ * stack top changes by (1-wordIdx).
*
- * Note that the estimates are not correct while the command
- * is being prepared and run, INST_EXPAND_STKTOP is not
- * stack-neutral in general.
+ * Note that the estimates are not correct while the command is being
+ * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
*/
- TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
- envPtr->expandCount--;
- TclAdjustStackDepth(1 - wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+ TclCheckStackDepth(depth+1, envPtr);
}
-static int
+static int
CompileCmdCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
@@ -1816,10 +1904,11 @@ CompileCmdCompileProc(
{
int unwind = 0, incrOffset = -1;
DefineLineInformation;
+ int depth = TclGetStackDepth(envPtr);
/*
- * Emit of the INST_START_CMD instruction is controlled by
- * the value of envPtr->atCmdStart:
+ * Emit of the INST_START_CMD instruction is controlled by the value of
+ * envPtr->atCmdStart:
*
* atCmdStart == 2 : We are not using the INST_START_CMD instruction.
* atCmdStart == 1 : INST_START_CMD was the last instruction emitted.
@@ -1850,9 +1939,10 @@ CompileCmdCompileProc(
if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
if (incrOffset >= 0) {
/*
- * We successfully compiled a command. Increment the number
- * of commands that start at the currently active INST_START_CMD.
+ * We successfully compiled a command. Increment the number of
+ * commands that start at the currently active INST_START_CMD.
*/
+
unsigned char *incrPtr = envPtr->codeStart + incrOffset;
unsigned char *startPtr = incrPtr - 5;
@@ -1862,15 +1952,16 @@ CompileCmdCompileProc(
TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
}
}
+ TclCheckStackDepth(depth+1, envPtr);
return TCL_OK;
}
envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
/*
- * Throw out any line information generated by the failed
- * compile attempt.
+ * Throw out any line information generated by the failed compile attempt.
*/
+
while (mapPtr->nuloc - 1 > eclIndex) {
mapPtr->nuloc--;
ckfree(mapPtr->loc[mapPtr->nuloc].line);
@@ -1878,11 +1969,11 @@ CompileCmdCompileProc(
}
/*
- * Reset the index of next command.
- * Toss out any from failed nested partial compiles.
+ * Reset the index of next command. Toss out any from failed nested
+ * partial compiles.
*/
- envPtr->numCommands = mapPtr->nuloc;
+ envPtr->numCommands = mapPtr->nuloc;
return TCL_ERROR;
}
@@ -1904,6 +1995,7 @@ CompileCommandTokens(
int *clNext = envPtr->clNext;
int cmdIdx = envPtr->numCommands;
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+ int depth = TclGetStackDepth(envPtr);
assert (parsePtr->numWords > 0);
@@ -1914,11 +2006,10 @@ CompileCommandTokens(
parsePtr->commandStart - envPtr->source, startCodeOffset);
/*
- * TIP #280. Scan the words and compute the extended location
- * information. The map first contain full per-word line
- * information for use by the compiler. This is later replaced by
- * a reduced form which signals non-literal words, stored in
- * 'wlines'.
+ * TIP #280. Scan the words and compute the extended location information.
+ * The map first contain full per-word line information for use by the
+ * compiler. This is later replaced by a reduced form which signals
+ * non-literal words, stored in 'wlines'.
*/
EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
@@ -1940,8 +2031,8 @@ CompileCommandTokens(
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
if (cmdPtr) {
/*
- * Found a command. Test the ways we can be told
- * not to attempt to compile it.
+ * Found a command. Test the ways we can be told not to attempt
+ * to compile it.
*/
if ((cmdPtr->compileProc == NULL)
|| (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
@@ -1985,8 +2076,8 @@ CompileCommandTokens(
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
/*
- * TIP #280: Free full form of per-word line data and insert the
- * reduced form now
+ * TIP #280: Free full form of per-word line data and insert the reduced
+ * form now
*/
envPtr->line = cmdLine;
@@ -1996,6 +2087,7 @@ CompileCommandTokens(
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
+ TclCheckStackDepth(depth, envPtr);
return cmdIdx;
}
@@ -2015,6 +2107,7 @@ TclCompileScript(
* Initial value of -1 indicates this routine
* has not yet generated any bytecode. */
const char *p = script; /* Where we are in our compile. */
+ int depth = TclGetStackDepth(envPtr);
if (envPtr->iPtr == NULL) {
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2071,20 +2164,20 @@ TclCompileScript(
if (parse.numWords == 0) {
/*
- * The "command" parsed has no words. In this case
- * we can skip the rest of the loop body. With no words,
- * clearly CompileCommandTokens() has nothing to do. Since
- * the parser aggressively sucks up leading comment and white
- * space, including newlines, parse.commandStart must be
- * pointing at either the end of script, or a command-terminating
- * semi-colon. In either case, the TclAdvance*() calls have
- * nothing to do. Finally, when no words are parsed, no
- * tokens have been allocated at parse.tokenPtr so there's
- * also nothing for Tcl_FreeParse() to do.
+ * The "command" parsed has no words. In this case we can skip
+ * the rest of the loop body. With no words, clearly
+ * CompileCommandTokens() has nothing to do. Since the parser
+ * aggressively sucks up leading comment and white space,
+ * including newlines, parse.commandStart must be pointing at
+ * either the end of script, or a command-terminating semi-colon.
+ * In either case, the TclAdvance*() calls have nothing to do.
+ * Finally, when no words are parsed, no tokens have been
+ * allocated at parse.tokenPtr so there's also nothing for
+ * Tcl_FreeParse() to do.
*
* The advantage of this shortcut is that CompileCommandTokens()
- * can be written with an assumption that parse.numWords > 0,
- * with the implication the CCT() always generates bytecode.
+ * can be written with an assumption that parse.numWords > 0, with
+ * the implication the CCT() always generates bytecode.
*/
continue;
}
@@ -2103,27 +2196,30 @@ TclCompileScript(
if (lastCmdIdx == -1) {
/*
- * Compiling the script yielded no bytecode. The script must be
- * all whitespace, comments, and empty commands. Such scripts
- * are defined to successfully produce the empty string result,
- * so we emit the simple bytecode that makes that happen.
+ * Compiling the script yielded no bytecode. The script must be all
+ * whitespace, comments, and empty commands. Such scripts are defined
+ * to successfully produce the empty string result, so we emit the
+ * simple bytecode that makes that happen.
*/
+
PushStringLiteral(envPtr, "");
} else {
/*
* We compiled at least one command to bytecode. The routine
* CompileCommandTokens() follows the bytecode of each compiled
- * command with an INST_POP, so that stack balance is maintained
- * when several commands are in sequence. (The result of each
- * command is thrown away before moving on to the next command).
- * For the last command compiled, we need to undo that INST_POP
- * so that the result of the last command becomes the result of
- * the script. The code here removes that trailing INST_POP.
+ * command with an INST_POP, so that stack balance is maintained when
+ * several commands are in sequence. (The result of each command is
+ * thrown away before moving on to the next command). For the last
+ * command compiled, we need to undo that INST_POP so that the result
+ * of the last command becomes the result of the script. The code
+ * here removes that trailing INST_POP.
*/
+
envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
envPtr->codeNext--;
envPtr->currStackDepth++;
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2229,11 +2325,12 @@ TclCompileTokens(
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
- int i, numObjsToConcat, length;
+ int i, numObjsToConcat, length, adjust;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
+ int depth = TclGetStackDepth(envPtr);
/*
* For the handling of continuation lines in literals we first check if
@@ -2266,6 +2363,7 @@ TclCompileTokens(
clPosition = ckalloc(maxNumCL * sizeof(int));
}
+ adjust = 0;
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
@@ -2309,6 +2407,7 @@ TclCompileTokens(
clPosition[numCL] = clPos;
numCL ++;
}
+ adjust++;
}
break;
@@ -2331,8 +2430,10 @@ TclCompileTokens(
numCL = 0;
}
+ envPtr->line += adjust;
TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, envPtr);
+ envPtr->line -= adjust;
numObjsToConcat++;
break;
@@ -2383,11 +2484,11 @@ TclCompileTokens(
*/
while (numObjsToConcat > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
}
if (numObjsToConcat > 1) {
- TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
}
/*
@@ -2407,6 +2508,7 @@ TclCompileTokens(
if (maxNumCL) {
ckfree(clPosition);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2454,7 +2556,7 @@ TclCompileCmdWord(
*/
TclCompileTokens(interp, tokenPtr, count, envPtr);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
}
}
@@ -2518,11 +2620,11 @@ TclCompileExprWords(
}
concatItems = 2*numWords - 1;
while (concatItems > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
concatItems -= 254;
}
if (concatItems > 1) {
- TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
}
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
@@ -3258,26 +3360,25 @@ TclGetInnermostExceptionRange(
int returnCode,
ExceptionAux **auxPtrPtr)
{
- int exnIdx = -1, i;
+ int i = envPtr->exceptArrayNext;
+ ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;
- for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
- ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+ while (i > 0) {
+ rangePtr--; i--;
if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
rangePtr->codeOffset+rangePtr->numCodeBytes) &&
(returnCode != TCL_CONTINUE ||
envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
- exnIdx = i;
+
+ if (auxPtrPtr) {
+ *auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
+ }
+ return rangePtr;
}
}
- if (exnIdx == -1) {
- return NULL;
- }
- if (auxPtrPtr) {
- *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
- }
- return &envPtr->exceptArrayPtr[exnIdx];
+ return NULL;
}
/*
@@ -3351,9 +3452,9 @@ TclAddLoopContinueFixup(
*
* TclCleanupStackForBreakContinue --
*
- * Ditch the extra elements from the auxiliary stack and the main
- * stack. How to do this exactly depends on whether there are any
- * elements on the auxiliary stack to pop.
+ * Ditch the extra elements from the auxiliary stack and the main stack.
+ * How to do this exactly depends on whether there are any elements on
+ * the auxiliary stack to pop.
*
* ---------------------------------------------------------------------
*/
@@ -3367,23 +3468,16 @@ TclCleanupStackForBreakContinue(
int toPop = envPtr->expandCount - auxPtr->expandTarget;
if (toPop > 0) {
- while (toPop > 0) {
+ while (toPop --> 0) {
TclEmitOpcode(INST_EXPAND_DROP, envPtr);
- toPop--;
}
TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
envPtr);
- toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth;
- while (toPop > 0) {
- TclEmitOpcode(INST_POP, envPtr);
- toPop--;
- }
- } else {
- toPop = envPtr->currStackDepth - auxPtr->stackDepth;
- while (toPop > 0) {
- TclEmitOpcode(INST_POP, envPtr);
- toPop--;
- }
+ envPtr->currStackDepth = auxPtr->expandTargetDepth;
+ }
+ toPop = envPtr->currStackDepth - auxPtr->stackDepth;
+ while (toPop --> 0) {
+ TclEmitOpcode(INST_POP, envPtr);
}
envPtr->currStackDepth = savedStackDepth;
}
@@ -3900,185 +3994,219 @@ TclFixupForwardJump(
/*
*----------------------------------------------------------------------
*
- * TclGetInstructionTable --
+ * TclEmitInvoke --
*
- * Returns a pointer to the table describing Tcl bytecode instructions.
- * This procedure is defined so that clients can access the pointer from
- * outside the TCL DLLs.
+ * Emit one of the invoke-related instructions, wrapping it if necessary
+ * in code that ensures that any break or continue operation passing
+ * through it gets the stack unwinding correct, converting it into an
+ * internal jump if in an appropriate context.
*
* Results:
- * Returns a pointer to the global instruction table, same as the
- * expression (&tclInstructionTable[0]).
+ * None
*
* Side effects:
- * None.
+ * Issues the jump with all correct stack management. May create another
+ * loop exception range; pointers to ExceptionRange and ExceptionAux
+ * structures should not be held across this call.
*
*----------------------------------------------------------------------
*/
-const void * /* == InstructionDesc* == */
-TclGetInstructionTable(void)
-{
- return &tclInstructionTable[0];
-}
-
-/*
- *--------------------------------------------------------------
- *
- * RegisterAuxDataType --
- *
- * This procedure is called to register a new AuxData type in the table
- * of all AuxData types supported by Tcl.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The type is registered in the AuxData type table. If there was already
- * a type with the same name as in typePtr, it is replaced with the new
- * type.
- *
- *--------------------------------------------------------------
- */
-
-static void
-RegisterAuxDataType(
- const AuxDataType *typePtr) /* Information about object type; storage must
- * be statically allocated (must live forever;
- * will not be deallocated). */
+void
+TclEmitInvoke(
+ CompileEnv *envPtr,
+ int opcode,
+ ...)
{
- register Tcl_HashEntry *hPtr;
- int isNew;
-
- Tcl_MutexLock(&tableMutex);
- if (!auxDataTypeTableInitialized) {
- TclInitAuxDataTypeTable();
- }
+ va_list argList;
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxBreakPtr, *auxContinuePtr;
+ int arg1, arg2, wordCount = 0, expandCount = 0;
+ int loopRange = 0, breakRange = 0, continueRange = 0;
+ int cleanup, depth = TclGetStackDepth(envPtr);
/*
- * If there's already a type with the given name, remove it.
+ * Parse the arguments.
*/
- hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
- if (hPtr != NULL) {
- Tcl_DeleteHashEntry(hPtr);
+ va_start(argList, opcode);
+ switch (opcode) {
+ case INST_INVOKE_STK1:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ break;
+ case INST_INVOKE_STK4:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ break;
+ case INST_INVOKE_REPLACE:
+ arg1 = va_arg(argList, int);
+ arg2 = va_arg(argList, int);
+ wordCount = arg1 + arg2 - 1;
+ cleanup = arg1 + 1;
+ break;
+ default:
+ Tcl_Panic("unexpected opcode");
+ case INST_EVAL_STK:
+ wordCount = cleanup = 1;
+ arg1 = arg2 = 0;
+ break;
+ case INST_RETURN_STK:
+ wordCount = cleanup = 2;
+ arg1 = arg2 = 0;
+ break;
+ case INST_INVOKE_EXPANDED:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ expandCount = 1;
+ break;
}
+ va_end(argList);
/*
- * Now insert the new object type.
+ * Determine if we need to handle break and continue exceptions with a
+ * special handling exception range (so that we can correctly unwind the
+ * stack).
+ *
+ * These must be done separately; they can be different (especially for
+ * calls from inside a [for] increment clause).
*/
- hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
- if (isNew) {
- Tcl_SetHashValue(hPtr, typePtr);
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
+ &auxContinuePtr);
+ if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ auxContinuePtr = NULL;
+ } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
+ && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
+ auxContinuePtr = NULL;
+ } else {
+ continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr;
}
- Tcl_MutexUnlock(&tableMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetAuxDataType --
- *
- * This procedure looks up an Auxdata type by name.
- *
- * Results:
- * If an AuxData type with name matching "typeName" is found, a pointer
- * to its AuxDataType structure is returned; otherwise, NULL is returned.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-const AuxDataType *
-TclGetAuxDataType(
- const char *typeName) /* Name of AuxData type to look up. */
-{
- register Tcl_HashEntry *hPtr;
- const AuxDataType *typePtr = NULL;
- Tcl_MutexLock(&tableMutex);
- if (!auxDataTypeTableInitialized) {
- TclInitAuxDataTypeTable();
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
+ if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ auxBreakPtr = NULL;
+ } else if (auxContinuePtr == NULL
+ && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
+ && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
+ auxBreakPtr = NULL;
+ } else {
+ breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
}
- hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
- if (hPtr != NULL) {
- typePtr = Tcl_GetHashValue(hPtr);
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ ExceptionRangeStarts(envPtr, loopRange);
}
- Tcl_MutexUnlock(&tableMutex);
- return typePtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclInitAuxDataTypeTable --
- *
- * This procedure is invoked to perform once-only initialization of the
- * AuxData type table. It also registers the AuxData types defined in
- * this file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Initializes the table of defined AuxData types "auxDataTypeTable" with
- * builtin AuxData types defined in this file.
- *
- *--------------------------------------------------------------
- */
-
-void
-TclInitAuxDataTypeTable(void)
-{
/*
- * The table mutex must already be held before this routine is invoked.
+ * Issue the invoke itself.
*/
- auxDataTypeTableInitialized = 1;
- Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+ switch (opcode) {
+ case INST_INVOKE_STK1:
+ TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
+ break;
+ case INST_INVOKE_STK4:
+ TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
+ break;
+ case INST_INVOKE_EXPANDED:
+ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+ envPtr->expandCount--;
+ TclAdjustStackDepth(1 - arg1, envPtr);
+ break;
+ case INST_EVAL_STK:
+ TclEmitOpcode(INST_EVAL_STK, envPtr);
+ break;
+ case INST_RETURN_STK:
+ TclEmitOpcode(INST_RETURN_STK, envPtr);
+ break;
+ case INST_INVOKE_REPLACE:
+ TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
+ TclEmitInt1(arg2, envPtr);
+ TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+ break;
+ }
/*
- * There are only three AuxData types at this time, so register them here.
+ * If we're generating a special wrapper exception range, we need to
+ * finish that up now.
*/
- RegisterAuxDataType(&tclForeachInfoType);
- RegisterAuxDataType(&tclJumptableInfoType);
- RegisterAuxDataType(&tclDictUpdateInfoType);
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ int savedStackDepth = envPtr->currStackDepth;
+ int savedExpandCount = envPtr->expandCount;
+ JumpFixup nonTrapFixup;
+
+ if (auxBreakPtr != NULL) {
+ auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+ }
+ if (auxContinuePtr != NULL) {
+ auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+ }
+
+ ExceptionRangeEnds(envPtr, loopRange);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
+
+ /*
+ * Careful! When generating these stack unwinding sequences, the depth
+ * of stack in the cases where they are taken is not the same as if
+ * the exception is not taken.
+ */
+
+ if (auxBreakPtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
+ TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ if (auxContinuePtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
+ TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ TclFinalizeLoopExceptionRange(envPtr, loopRange);
+ TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
+ }
+ TclCheckStackDepth(depth+1-cleanup, envPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclFinalizeAuxDataTypeTable --
+ * TclGetInstructionTable --
*
- * This procedure is called by Tcl_Finalize after all exit handlers have
- * been run to free up storage associated with the table of AuxData
- * types. This procedure is called by TclFinalizeExecution() which is
- * called by Tcl_Finalize().
+ * Returns a pointer to the table describing Tcl bytecode instructions.
+ * This procedure is defined so that clients can access the pointer from
+ * outside the TCL DLLs.
*
* Results:
- * None.
+ * Returns a pointer to the global instruction table, same as the
+ * expression (&tclInstructionTable[0]).
*
* Side effects:
- * Deletes all entries in the hash table of AuxData types.
+ * None.
*
*----------------------------------------------------------------------
*/
-void
-TclFinalizeAuxDataTypeTable(void)
+const void * /* == InstructionDesc* == */
+TclGetInstructionTable(void)
{
- Tcl_MutexLock(&tableMutex);
- if (auxDataTypeTableInitialized) {
- Tcl_DeleteHashTable(&auxDataTypeTable);
- auxDataTypeTableInitialized = 0;
- }
- Tcl_MutexUnlock(&tableMutex);
+ return &tclInstructionTable[0];
}
/*
@@ -4279,773 +4407,6 @@ EncodeCmdLocMap(
return p;
}
-#ifdef TCL_COMPILE_DEBUG
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintByteCodeObj --
- *
- * This procedure prints ("disassembles") the instructions of a bytecode
- * object to stdout.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintByteCodeObj(
- Tcl_Interp *interp, /* Used only for Tcl_GetStringFromObj. */
- Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
-{
- Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
-
- fprintf(stdout, "\n%s", TclGetString(bufPtr));
- Tcl_DecrRefCount(bufPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintInstruction --
- *
- * This procedure prints ("disassembles") one instruction from a bytecode
- * object to stdout.
- *
- * Results:
- * Returns the length in bytes of the current instruiction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPrintInstruction(
- ByteCode *codePtr, /* Bytecode containing the instruction. */
- const unsigned char *pc) /* Points to first byte of instruction. */
-{
- Tcl_Obj *bufferObj;
- int numBytes;
-
- TclNewObj(bufferObj);
- numBytes = FormatInstruction(codePtr, pc, bufferObj);
- fprintf(stdout, "%s", TclGetString(bufferObj));
- Tcl_DecrRefCount(bufferObj);
- return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintObject --
- *
- * This procedure prints up to a specified number of characters from the
- * argument Tcl object's string representation to a specified file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintObject(
- FILE *outFile, /* The file to print the source to. */
- Tcl_Obj *objPtr, /* Points to the Tcl object whose string
- * representation should be printed. */
- int maxChars) /* Maximum number of chars to print. */
-{
- char *bytes;
- int length;
-
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- TclPrintSource(outFile, bytes, TclMin(length, maxChars));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintSource --
- *
- * This procedure prints up to a specified number of characters from the
- * argument string to a specified file. It tries to produce legible
- * output by adding backslashes as necessary.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintSource(
- FILE *outFile, /* The file to print the source to. */
- const char *stringPtr, /* The string to print. */
- int maxChars) /* Maximum number of chars to print. */
-{
- Tcl_Obj *bufferObj;
-
- TclNewObj(bufferObj);
- PrintSourceToObj(bufferObj, stringPtr, maxChars);
- fprintf(outFile, "%s", TclGetString(bufferObj));
- Tcl_DecrRefCount(bufferObj);
-}
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDisassembleByteCodeObj --
- *
- * Given an object which is of bytecode type, return a disassembled
- * version of the bytecode (in a new refcount 0 object). No guarantees
- * are made about the details of the contents of the result.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDisassembleByteCodeObj(
- Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
-{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- unsigned char *codeStart, *codeLimit, *pc;
- unsigned char *codeDeltaNext, *codeLengthNext;
- unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
- Interp *iPtr = (Interp *) *codePtr->interpHandle;
- Tcl_Obj *bufferObj;
- char ptrBuf1[20], ptrBuf2[20];
-
- TclNewObj(bufferObj);
- if (codePtr->refCount <= 0) {
- return bufferObj; /* Already freed. */
- }
-
- codeStart = codePtr->codeStart;
- codeLimit = codeStart + codePtr->numCodeBytes;
- numCmds = codePtr->numCommands;
-
- /*
- * Print header lines describing the ByteCode.
- */
-
- sprintf(ptrBuf1, "%p", codePtr);
- sprintf(ptrBuf2, "%p", iPtr);
- Tcl_AppendPrintfToObj(bufferObj,
- "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
- ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
- iPtr->compileEpoch);
- Tcl_AppendToObj(bufferObj, " Source ", -1);
- PrintSourceToObj(bufferObj, codePtr->source,
- TclMin(codePtr->numSrcBytes, 55));
- Tcl_AppendPrintfToObj(bufferObj,
- "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
- numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
- codePtr->numLitObjects, codePtr->numAuxDataItems,
- codePtr->maxStackDepth,
-#ifdef TCL_COMPILE_STATS
- codePtr->numSrcBytes?
- codePtr->structureSize/(float)codePtr->numSrcBytes :
-#endif
- 0.0);
-
-#ifdef TCL_COMPILE_STATS
- Tcl_AppendPrintfToObj(bufferObj,
- " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
- (unsigned long) codePtr->structureSize,
- (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
- codePtr->numCodeBytes,
- (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
- (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
- (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
- codePtr->numCmdLocBytes);
-#endif /* TCL_COMPILE_STATS */
-
- /*
- * If the ByteCode is the compiled body of a Tcl procedure, print
- * information about that procedure. Note that we don't know the
- * procedure's name since ByteCode's can be shared among procedures.
- */
-
- if (codePtr->procPtr != NULL) {
- Proc *procPtr = codePtr->procPtr;
- int numCompiledLocals = procPtr->numCompiledLocals;
-
- sprintf(ptrBuf1, "%p", procPtr);
- Tcl_AppendPrintfToObj(bufferObj,
- " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
- ptrBuf1, procPtr->refCount, procPtr->numArgs,
- numCompiledLocals);
- if (numCompiledLocals > 0) {
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
-
- for (i = 0; i < numCompiledLocals; i++) {
- Tcl_AppendPrintfToObj(bufferObj,
- " slot %d%s%s%s%s%s%s", i,
- (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
- (localPtr->flags & VAR_ARRAY) ? ", array" : "",
- (localPtr->flags & VAR_LINK) ? ", link" : "",
- (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
- (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
- (localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
- if (TclIsVarTemporary(localPtr)) {
- Tcl_AppendToObj(bufferObj, "\n", -1);
- } else {
- Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
- localPtr->name);
- }
- localPtr = localPtr->nextPtr;
- }
- }
- }
-
- /*
- * Print the ExceptionRange array.
- */
-
- if (codePtr->numExceptRanges > 0) {
- Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
- codePtr->numExceptRanges, codePtr->maxExceptDepth);
- for (i = 0; i < codePtr->numExceptRanges; i++) {
- ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
-
- Tcl_AppendPrintfToObj(bufferObj,
- " %d: level %d, %s, pc %d-%d, ",
- i, rangePtr->nestingLevel,
- (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
- rangePtr->codeOffset,
- (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
- rangePtr->continueOffset, rangePtr->breakOffset);
- break;
- case CATCH_EXCEPTION_RANGE:
- Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
- rangePtr->catchOffset);
- break;
- default:
- Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
- rangePtr->type);
- }
- }
- }
-
- /*
- * If there were no commands (e.g., an expression or an empty string was
- * compiled), just print all instructions and return.
- */
-
- if (numCmds == 0) {
- pc = codeStart;
- while (pc < codeLimit) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
- return bufferObj;
- }
-
- /*
- * Print table showing the code offset, source offset, and source length
- * for each command. These are encoded as a sequence of bytes.
- */
-
- Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
- codeDeltaNext = codePtr->codeDeltaStart;
- codeLengthNext = codePtr->codeLengthStart;
- srcDeltaNext = codePtr->srcDeltaStart;
- srcLengthNext = codePtr->srcLengthStart;
- codeOffset = srcOffset = 0;
- for (i = 0; i < numCmds; i++) {
- if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
- codeLengthNext++;
- codeLen = TclGetInt4AtPtr(codeLengthNext);
- codeLengthNext += 4;
- } else {
- codeLen = TclGetInt1AtPtr(codeLengthNext);
- codeLengthNext++;
- }
-
- if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
-
- if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
- }
-
- Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
- ((i % 2)? " " : "\n "),
- (i+1), codeOffset, (codeOffset + codeLen - 1),
- srcOffset, (srcOffset + srcLen - 1));
- }
- if (numCmds > 0) {
- Tcl_AppendToObj(bufferObj, "\n", -1);
- }
-
- /*
- * Print each instruction. If the instruction corresponds to the start of
- * a command, print the command's source. Note that we don't need the code
- * length here.
- */
-
- codeDeltaNext = codePtr->codeDeltaStart;
- srcDeltaNext = codePtr->srcDeltaStart;
- srcLengthNext = codePtr->srcLengthStart;
- codeOffset = srcOffset = 0;
- pc = codeStart;
- for (i = 0; i < numCmds; i++) {
- if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
-
- if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
- }
-
- /*
- * Print instructions before command i.
- */
-
- while ((pc-codeStart) < codeOffset) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
-
- Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
- PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
- TclMin(srcLen, 55));
- Tcl_AppendToObj(bufferObj, "\n", -1);
- }
- if (pc < codeLimit) {
- /*
- * Print instructions after the last command.
- */
-
- while (pc < codeLimit) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
- }
- return bufferObj;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FormatInstruction --
- *
- * Appends a representation of a bytecode instruction to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FormatInstruction(
- ByteCode *codePtr, /* Bytecode containing the instruction. */
- const unsigned char *pc, /* Points to first byte of instruction. */
- Tcl_Obj *bufferObj) /* Object to append instruction info to. */
-{
- Proc *procPtr = codePtr->procPtr;
- unsigned char opCode = *pc;
- register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
- unsigned char *codeStart = codePtr->codeStart;
- unsigned pcOffset = pc - codeStart;
- int opnd = 0, i, j, numBytes = 1;
- int localCt = procPtr ? procPtr->numCompiledLocals : 0;
- CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
- char suffixBuffer[128]; /* Additional info to print after main opcode
- * and immediates. */
- char *suffixSrc = NULL;
- Tcl_Obj *suffixObj = NULL;
- AuxData *auxPtr = NULL;
-
- suffixBuffer[0] = '\0';
- Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
- for (i = 0; i < instDesc->numOperands; i++) {
- switch (instDesc->opTypes[i]) {
- case OPERAND_INT1:
- opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
- if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
- || opCode == INST_JUMP_FALSE1) {
- sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
- break;
- case OPERAND_INT4:
- opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
- || opCode == INST_JUMP_FALSE4) {
- sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
- } else if (opCode == INST_START_CMD) {
- sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
- break;
- case OPERAND_UINT1:
- opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
- if (opCode == INST_PUSH1) {
- suffixObj = codePtr->objArrayPtr[opnd];
- }
- Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
- break;
- case OPERAND_AUX4:
- case OPERAND_UINT4:
- opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opCode == INST_PUSH4) {
- suffixObj = codePtr->objArrayPtr[opnd];
- } else if (opCode == INST_START_CMD && opnd != 1) {
- sprintf(suffixBuffer+strlen(suffixBuffer),
- ", %u cmds start here", opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
- if (instDesc->opTypes[i] == OPERAND_AUX4) {
- auxPtr = &codePtr->auxDataArrayPtr[opnd];
- }
- break;
- case OPERAND_IDX4:
- opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opnd >= -1) {
- Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
- } else if (opnd == -2) {
- Tcl_AppendPrintfToObj(bufferObj, "end ");
- } else {
- Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
- }
- break;
- case OPERAND_LVT1:
- opnd = TclGetUInt1AtPtr(pc+numBytes);
- numBytes++;
- goto printLVTindex;
- case OPERAND_LVT4:
- opnd = TclGetUInt4AtPtr(pc+numBytes);
- numBytes += 4;
- printLVTindex:
- if (localPtr != NULL) {
- if (opnd >= localCt) {
- Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
- (unsigned) opnd, localCt);
- }
- for (j = 0; j < opnd; j++) {
- localPtr = localPtr->nextPtr;
- }
- if (TclIsVarTemporary(localPtr)) {
- sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
- } else {
- sprintf(suffixBuffer, "var ");
- suffixSrc = localPtr->name;
- }
- }
- Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
- break;
- case OPERAND_NONE:
- default:
- break;
- }
- }
- if (suffixObj) {
- const char *bytes;
- int length;
-
- Tcl_AppendToObj(bufferObj, "\t# ", -1);
- bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
- PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
- } else if (suffixBuffer[0]) {
- Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
- if (suffixSrc) {
- PrintSourceToObj(bufferObj, suffixSrc, 40);
- }
- }
- Tcl_AppendToObj(bufferObj, "\n", -1);
- if (auxPtr && auxPtr->type->printProc) {
- Tcl_AppendToObj(bufferObj, "\t\t[", -1);
- auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
- pcOffset);
- Tcl_AppendToObj(bufferObj, "]\n", -1);
- }
- return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetInnerContext --
- *
- * If possible, returns a list capturing the inner context. Otherwise
- * return NULL.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetInnerContext(
- Tcl_Interp *interp,
- const unsigned char *pc,
- Tcl_Obj **tosPtr)
-{
- int objc = 0, off = 0;
- Tcl_Obj *result;
- Interp *iPtr = (Interp *) interp;
-
- switch (*pc) {
- case INST_STR_LEN:
- case INST_LNOT:
- case INST_BITNOT:
- case INST_UMINUS:
- case INST_UPLUS:
- case INST_TRY_CVT_TO_NUMERIC:
- case INST_EXPAND_STKTOP:
- case INST_EXPR_STK:
- objc = 1;
- break;
-
- case INST_LIST_IN:
- case INST_LIST_NOT_IN: /* Basic list containment operators. */
- case INST_STR_EQ:
- case INST_STR_NEQ: /* String (in)equality check */
- case INST_STR_CMP: /* String compare. */
- case INST_STR_INDEX:
- case INST_STR_MATCH:
- case INST_REGEXP:
- case INST_EQ:
- case INST_NEQ:
- case INST_LT:
- case INST_GT:
- case INST_LE:
- case INST_GE:
- case INST_MOD:
- case INST_LSHIFT:
- case INST_RSHIFT:
- case INST_BITOR:
- case INST_BITXOR:
- case INST_BITAND:
- case INST_EXPON:
- case INST_ADD:
- case INST_SUB:
- case INST_DIV:
- case INST_MULT:
- objc = 2;
- break;
-
- case INST_RETURN_STK:
- /* early pop. TODO: dig out opt dict too :/ */
- objc = 1;
- break;
-
- case INST_SYNTAX:
- case INST_RETURN_IMM:
- objc = 2;
- break;
-
- case INST_INVOKE_STK4:
- objc = TclGetUInt4AtPtr(pc+1);
- break;
-
- case INST_INVOKE_STK1:
- objc = TclGetUInt1AtPtr(pc+1);
- break;
- }
-
- result = iPtr->innerContext;
- if (Tcl_IsShared(result)) {
- Tcl_DecrRefCount(result);
- iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
- Tcl_IncrRefCount(result);
- } else {
- int len;
-
- /*
- * Reset while keeping the list intrep as much as possible.
- */
-
- Tcl_ListObjLength(interp, result, &len);
- Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
- }
- Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
-
- for (; objc>0 ; objc--) {
- Tcl_Obj *objPtr;
-
- objPtr = tosPtr[1 - objc + off];
- if (!objPtr) {
- Tcl_Panic("InnerContext: bad tos -- appending null object");
- }
- if ((objPtr->refCount<=0)
-#ifdef TCL_MEM_DEBUG
- || (objPtr->refCount==0x61616161)
-#endif
- ) {
- Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
- objPtr);
- }
- Tcl_ListObjAppendElement(NULL, result, objPtr);
- }
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclNewInstNameObj --
- *
- * Creates a new InstName Tcl_Obj based on the given instruction
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclNewInstNameObj(
- unsigned char inst)
-{
- Tcl_Obj *objPtr = Tcl_NewObj();
-
- objPtr->typePtr = &tclInstNameType;
- objPtr->internalRep.longValue = (long) inst;
- objPtr->bytes = NULL;
-
- return objPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfInstName --
- *
- * Update the string representation for an instruction name object.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfInstName(
- Tcl_Obj *objPtr)
-{
- int inst = objPtr->internalRep.longValue;
- char *s, buf[20];
- int len;
-
- if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
- sprintf(buf, "inst_%d", inst);
- s = buf;
- } else {
- s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
- }
- len = strlen(s);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, s, len + 1);
- objPtr->length = len;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrintSourceToObj --
- *
- * Appends a quoted representation of a string to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrintSourceToObj(
- Tcl_Obj *appendObj, /* The object to print the source to. */
- const char *stringPtr, /* The string to print. */
- int maxChars) /* Maximum number of chars to print. */
-{
- register const char *p;
- register int i = 0;
-
- if (stringPtr == NULL) {
- Tcl_AppendToObj(appendObj, "\"\"", -1);
- return;
- }
-
- Tcl_AppendToObj(appendObj, "\"", -1);
- p = stringPtr;
- for (; (*p != '\0') && (i < maxChars); p++, i++) {
- switch (*p) {
- case '"':
- Tcl_AppendToObj(appendObj, "\\\"", -1);
- continue;
- case '\f':
- Tcl_AppendToObj(appendObj, "\\f", -1);
- continue;
- case '\n':
- Tcl_AppendToObj(appendObj, "\\n", -1);
- continue;
- case '\r':
- Tcl_AppendToObj(appendObj, "\\r", -1);
- continue;
- case '\t':
- Tcl_AppendToObj(appendObj, "\\t", -1);
- continue;
- case '\v':
- Tcl_AppendToObj(appendObj, "\\v", -1);
- continue;
- default:
- Tcl_AppendPrintfToObj(appendObj, "%c", *p);
- continue;
- }
- }
- Tcl_AppendToObj(appendObj, "\"", -1);
-}
-
#ifdef TCL_COMPILE_STATS
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5660055..d5bc86b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -48,6 +48,13 @@ MODULE_SCOPE int tclTraceCompile;
MODULE_SCOPE int tclTraceExec;
#endif
+
+/*
+ * The type of lambda expressions. Note that every lambda will *always* have a
+ * string representation.
+ */
+
+MODULE_SCOPE const Tcl_ObjType tclLambdaType;
/*
*------------------------------------------------------------------------
@@ -128,7 +135,7 @@ typedef struct ExceptionAux {
int numBreakTargets; /* The number of [break]s that want to be
* targeted to the place where this loop
* exception will be bound to. */
- int *breakTargets; /* The offsets of the INST_JUMP4 instructions
+ unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions
* issued by the [break]s that we must
* update. Note that resizing a jump (via
* TclFixupForwardJump) can cause the contents
@@ -138,7 +145,7 @@ typedef struct ExceptionAux {
int numContinueTargets; /* The number of [continue]s that want to be
* targeted to the place where this loop
* exception will be bound to. */
- int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+ unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
* issued by the [continue]s that we must
* update. Note that resizing a jump (via
* TclFixupForwardJump) can cause the contents
@@ -238,6 +245,16 @@ typedef struct AuxDataType {
AuxDataPrintProc *printProc;/* Callback function to invoke when printing
* the aux data as part of debugging. NULL
* means that the data can't be printed. */
+ AuxDataPrintProc *disassembleProc;
+ /* Callback function to invoke when doing a
+ * disassembly of the aux data (like the
+ * printProc, except that the output is
+ * intended to be script-readable). The
+ * appendObj argument should be filled in with
+ * a descriptive dictionary; it will start out
+ * with "name" mapped to the content of the
+ * name field. NULL means that the printProc
+ * should be used instead. */
} AuxDataType;
/*
@@ -512,7 +529,7 @@ typedef struct ByteCode {
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
-#define INST_CONCAT1 5
+#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
@@ -586,8 +603,8 @@ typedef struct ByteCode {
#define INST_CONTINUE 66
/* Opcodes 67 to 68 */
-#define INST_FOREACH_START4 67
-#define INST_FOREACH_STEP4 68
+#define INST_FOREACH_START4 67 /* DEPRECATED */
+#define INST_FOREACH_STEP4 68 /* DEPRECATED */
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4 69
@@ -751,6 +768,8 @@ typedef struct ByteCode {
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
+
+/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
@@ -768,8 +787,42 @@ typedef struct ByteCode {
#define INST_EXPAND_DROP 165
+/* New foreach implementation */
+#define INST_FOREACH_START 166
+#define INST_FOREACH_STEP 167
+#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+#define INST_STR_REPLACE 177
+
+#define INST_ORIGIN_COMMAND 178
+
+#define INST_TCLOO_NEXT 179
+#define INST_TCLOO_NEXT_CLASS 180
+
+#define INST_YIELD_TO_INVOKE 181
+
+#define INST_NUM_TYPE 182
+#define INST_TRY_CVT_TO_BOOLEAN 183
+#define INST_STR_CLASS 184
+
+#define INST_LAPPEND_LIST 185
+#define INST_LAPPEND_LIST_ARRAY 186
+#define INST_LAPPEND_LIST_ARRAY_STK 187
+#define INST_LAPPEND_LIST_STK 188
+
/* The last opcode */
-#define LAST_INST_OPCODE 165
+#define LAST_INST_OPCODE 188
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -794,8 +847,15 @@ typedef enum InstOperandType {
* variable table. */
OPERAND_LVT4, /* Four byte unsigned index into the local
* variable table. */
- OPERAND_AUX4 /* Four byte unsigned index into the aux data
+ OPERAND_AUX4, /* Four byte unsigned index into the aux data
* table. */
+ OPERAND_OFFSET1, /* One byte signed jump offset. */
+ OPERAND_OFFSET4, /* Four byte signed jump offset. */
+ OPERAND_LIT1, /* One byte unsigned index into table of
+ * literals. */
+ OPERAND_LIT4, /* Four byte unsigned index into table of
+ * literals. */
+ OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -814,6 +874,40 @@ typedef struct InstructionDesc {
MODULE_SCOPE InstructionDesc const tclInstructionTable[];
/*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+ STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
+ STR_CLASS_ALPHA, /* Unicode alphabet characters. */
+ STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
+ STR_CLASS_CONTROL, /* Unicode control characters. */
+ STR_CLASS_DIGIT, /* Unicode digit characters. */
+ STR_CLASS_GRAPH, /* Unicode printing characters, excluding
+ * space. */
+ STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
+ STR_CLASS_PRINT, /* Unicode printing characters, including
+ * spaces. */
+ STR_CLASS_PUNCT, /* Unicode punctuation characters. */
+ STR_CLASS_SPACE, /* Unicode space characters. */
+ STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
+ STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
+ * punctuation) characters. */
+ STR_CLASS_XDIGIT /* Characters that can be used as digits in
+ * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+ const char *name; /* Name of the class. */
+ int (*comparator)(int); /* Function to test if a single unicode
+ * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
+
+/*
* Compilation of some Tcl constructs such as if commands and the logical or
* (||) and logical and (&&) operators in expressions requires the generation
* of forward jumps. Since the PC target of these jumps isn't known when the
@@ -834,7 +928,7 @@ typedef enum {
typedef struct JumpFixup {
TclJumpType jumpType; /* Indicates the kind of jump. */
- int codeOffset; /* Offset of the first byte of the one-byte
+ unsigned int codeOffset; /* Offset of the first byte of the one-byte
* forward jump's code. */
int cmdIndex; /* Index of the first command after the one
* for which the jump was emitted. Used to
@@ -901,11 +995,6 @@ typedef struct ForeachInfo {
* LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;
-MODULE_SCOPE const AuxDataType tclForeachInfoType;
-
-#define FOREACHINFO(envPtr, index) \
- ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
-
/*
* Structure used to hold information about a switch command that is needed
* during program execution. These structures are stored in CompileEnv and
@@ -938,11 +1027,6 @@ typedef struct {
* STRUCTURE. */
} DictUpdateInfo;
-MODULE_SCOPE const AuxDataType tclDictUpdateInfoType;
-
-#define DICTUPDATEINFO(envPtr, index) \
- ((DictUpdateInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
-
/*
* ClientData type used by the math operator commands.
*/
@@ -1021,13 +1105,13 @@ MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp,
LiteralTable *tablePtr);
MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
TclJumpType jumpType, JumpFixup *jumpFixupPtr);
+MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
-MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
int create, CompileEnv *envPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
@@ -1035,7 +1119,6 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
int distThreshold);
MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE void TclInitAuxDataTypeTable(void);
MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
@@ -1055,7 +1138,11 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
#endif
-MODULE_SCOPE void TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -1070,10 +1157,8 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *isScalarPtr);
-MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
- char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
-MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
+MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -1094,12 +1179,15 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
- const char *script,
- const char *command, int length,
- const unsigned char *pc, Tcl_Obj **tosPtr);
+ const char *script, const char *command,
+ int length, const unsigned char *pc,
+ Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
- const unsigned char *pc, Tcl_Obj **tosPtr);
+ const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
+MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
+ register Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int isLambda);
/*
@@ -1162,6 +1250,21 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
(envPtr)->currStackDepth += (delta); \
} while (0)
+#define TclGetStackDepth(envPtr) \
+ ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr) \
+ (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr) \
+ do { \
+ int dd = (depth); \
+ if (dd != (envPtr)->currStackDepth) { \
+ Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+ (envPtr)->currStackDepth, dd); \
+ } \
+ } while (0)
+
/*
* Macro used to update the stack requirements. It is called by the macros
* TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
@@ -1544,7 +1647,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#define PushVarNameWord(i,v,e,f,l,sc,word) \
SetLineInformation(word); \
- TclPushVarName(i,v,e,f,l,sc)
+ TclPushVarName(i,v,e,f,l,sc)
/*
* Often want to issue one of two versions of an instruction based on whether
@@ -1566,11 +1669,9 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#define AnonymousLocal(envPtr) \
(TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
- (!TclIsLocalScalar((chars), (len)) ? -1 : \
- TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr)))
+ TclLocalScalar(chars, len, envPtr)
#define LocalScalarFromToken(tokenPtr,envPtr) \
- ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
- LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
+ TclLocalScalarFromToken(tokenPtr, envPtr)
/*
* Flags bits used by TclPushVarName.
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 6222a8a..e4dd000 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -359,14 +359,8 @@ typedef short int yytype_int16;
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
-# elif defined size_t
-# define YYSIZE_T size_t
-# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
-# define YYSIZE_T size_t
# else
-# define YYSIZE_T unsigned int
+# define YYSIZE_T size_t
# endif
#endif
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4d40be1..b022d3c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -31,6 +31,10 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
@@ -44,7 +48,7 @@ EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
-EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
+EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN char * Tcl_Alloc(unsigned int size);
/* 4 */
@@ -59,7 +63,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
const char *file, int line);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
@@ -69,7 +73,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask,
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
@@ -413,7 +417,7 @@ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
EXTERN void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
/* 133 */
-EXTERN void Tcl_Exit(int status);
+EXTERN TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp,
const char *hiddenCmdToken,
@@ -507,7 +511,7 @@ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
EXTERN const char * Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
const char *chanID, int forWriting,
@@ -682,7 +686,8 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
-EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
+EXTERN void Tcl_SetPanicProc(
+ TCL_NORETURN1 Tcl_PanicProc *panicProc);
/* 231 */
EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* 232 */
@@ -831,7 +836,7 @@ EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
-EXTERN void Tcl_PanicVA(const char *format, va_list argList);
+EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -1495,7 +1500,7 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp,
Tcl_Obj *fileName, const char *encodingName);
/* 519 */
-EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc);
+EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc,
@@ -1824,26 +1829,26 @@ typedef struct TclStubs {
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
- void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
+ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -1971,7 +1976,7 @@ typedef struct TclStubs {
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
- void (*tcl_Exit) (int status); /* 133 */
+ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
@@ -2005,10 +2010,10 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2076,7 +2081,7 @@ typedef struct TclStubs {
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
- void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
+ void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
@@ -2124,7 +2129,7 @@ typedef struct TclStubs {
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
- void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+ TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
@@ -2365,7 +2370,7 @@ typedef struct TclStubs {
Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
- Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc); /* 519 */
+ Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
@@ -2479,10 +2484,8 @@ typedef struct TclStubs {
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
} TclStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclStubs *tclStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -2511,7 +2514,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbCkfree) /* 7 */
#define Tcl_DbCkrealloc \
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* UNIX */
@@ -2519,7 +2522,7 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* UNIX */
@@ -2839,7 +2842,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* UNIX */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index e31d708..c8474e6 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -155,6 +155,13 @@ typedef struct Dict {
} Dict;
/*
+ * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
+ * must be assignable as well as readable.
+ */
+
+#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
+
+/*
* The structure below defines the dictionary object type by means of
* functions that can be invoked by generic object code.
*/
@@ -312,6 +319,7 @@ DeleteChainEntry(
return 0;
} else {
Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
TclDecrRefCount(valuePtr);
}
@@ -361,7 +369,7 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+ Dict *oldDict = DICT(srcPtr);
Dict *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
@@ -396,7 +404,8 @@ DupDictInternalRep(
* Store in the object.
*/
- copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+ DICT(copyPtr) = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclDictType;
}
@@ -422,7 +431,7 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictPtr);
dict->refcount--;
if (dict->refcount <= 0) {
@@ -487,7 +496,7 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
@@ -600,7 +609,7 @@ SetDictFromAny(
Tcl_Obj *objPtr)
{
Tcl_HashEntry *hPtr;
- int isNew, result;
+ int isNew;
Dict *dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
@@ -622,7 +631,7 @@ SetDictFromAny(
}
for (i=0 ; i<objc ; i+=2) {
-
+
/* Store key and value in the hash table we're building. */
hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
@@ -651,10 +660,9 @@ SetDictFromAny(
const char *elemStart;
int elemSize, literal;
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
- goto errorExit;
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
+ goto errorInFindDictElement;
}
if (elemStart == limit) {
break;
@@ -673,11 +681,10 @@ SetDictFromAny(
keyPtr->bytes);
}
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
TclDecrRefCount(keyPtr);
- goto errorExit;
+ goto errorInFindDictElement;
}
if (literal) {
@@ -713,7 +720,8 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(objPtr) = dict;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclDictType;
return TCL_OK;
@@ -723,15 +731,10 @@ SetDictFromAny(
"missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
- result = TCL_ERROR;
-
- errorExit:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
+ errorInFindDictElement:
DeleteChainTable(dict);
ckfree(dict);
- return result;
+ return TCL_ERROR;
}
/*
@@ -777,12 +780,11 @@ TclTraceDictPath(
Dict *dict, *newDict;
int i;
- if (dictPtr->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
- return NULL;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -818,14 +820,13 @@ TclTraceDictPath(
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = Tcl_GetHashValue(hPtr);
- if (tmpObj->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
- return NULL;
- }
+ if (tmpObj->typePtr != &tclDictType
+ && SetDictFromAny(interp, tmpObj) != TCL_OK) {
+ return NULL;
}
}
- newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+ newDict = DICT(tmpObj);
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -833,7 +834,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+ newDict = DICT(tmpObj);
}
newDict->chain = dictPtr;
@@ -868,7 +869,7 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictObj);
do {
TclInvalidateStringRep(dictObj);
@@ -878,7 +879,7 @@ InvalidateDictChain(
break;
}
dict->chain = NULL;
- dict = dictObj->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictObj);
} while (dict != NULL);
}
@@ -916,18 +917,15 @@ Tcl_DictObjPut(
Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
}
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
if (dictPtr->bytes != NULL) {
TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -970,15 +968,13 @@ Tcl_DictObjGet(
Dict *dict;
Tcl_HashEntry *hPtr;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- *valuePtrPtr = NULL;
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ *valuePtrPtr = NULL;
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
@@ -1019,18 +1015,16 @@ Tcl_DictObjRemove(
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
}
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
if (DeleteChainEntry(dict, keyPtr)) {
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
+ }
dict->epoch++;
}
return TCL_OK;
@@ -1062,14 +1056,12 @@ Tcl_DictObjSize(
{
Dict *dict;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1116,15 +1108,12 @@ Tcl_DictObjFirst(
Dict *dict;
ChainEntry *cPtr;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
@@ -1299,11 +1288,12 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -1355,7 +1345,7 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1401,7 +1391,8 @@ Tcl_NewDictObj(void)
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(dictPtr) = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1450,7 +1441,8 @@ Tcl_DbNewDictObj(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(dictPtr) = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1504,7 +1496,7 @@ DictCreateCmd(
/*
* The next command is assumed to never fail...
*/
- Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
+ Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
}
Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
@@ -1629,8 +1621,7 @@ DictReplaceCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if ((objc < 2) || (objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
@@ -1638,18 +1629,18 @@ DictReplaceCmd(
}
dictPtr = objv[1];
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ }
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
}
for (i=2 ; i<objc ; i+=2) {
- result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
- }
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -1681,8 +1672,7 @@ DictRemoveCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
@@ -1690,18 +1680,18 @@ DictRemoveCmd(
}
dictPtr = objv[1];
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ }
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
}
for (i=2 ; i<objc ; i++) {
- result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
- }
+ Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -1750,10 +1740,9 @@ DictMergeCmd(
*/
targetObj = objv[1];
- if (targetObj->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, targetObj) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (targetObj->typePtr != &tclDictType
+ && SetDictFromAny(interp, targetObj) != TCL_OK) {
+ return TCL_ERROR;
}
if (objc == 2) {
@@ -1835,12 +1824,9 @@ DictKeysCmd(
* need. [Bug 1705778, leak K04]
*/
- if (objv[1]->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, objv[1]);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (objv[1]->typePtr != &tclDictType
+ && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+ return TCL_ERROR;
}
if (objc == 3) {
@@ -2056,13 +2042,11 @@ DictInfoCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
statsStr = Tcl_HashStats(&dict->table);
Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2099,7 +2083,7 @@ DictIncrCmd(
Tcl_Obj *dictPtr, *valuePtr = NULL;
if (objc < 3 || objc > 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
return TCL_ERROR;
}
@@ -2152,10 +2136,10 @@ DictIncrCmd(
*/
mp_clear(&increment);
- Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
}
} else {
- Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1));
}
} else {
/*
@@ -2164,7 +2148,7 @@ DictIncrCmd(
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
@@ -2173,7 +2157,7 @@ DictIncrCmd(
Tcl_IncrRefCount(incrPtr);
code = TclIncrObj(interp, valuePtr, incrPtr);
- Tcl_DecrRefCount(incrPtr);
+ TclDecrRefCount(incrPtr);
}
}
if (code == TCL_OK) {
@@ -2186,7 +2170,7 @@ DictIncrCmd(
Tcl_SetObjResult(interp, valuePtr);
}
} else if (dictPtr->refCount == 0) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
return code;
}
@@ -2220,7 +2204,7 @@ DictLappendCmd(
int i, allocatedDict = 0, allocatedValue = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
return TCL_ERROR;
}
@@ -2264,7 +2248,7 @@ DictLappendCmd(
}
if (allocatedValue) {
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
} else if (dictPtr->bytes != NULL) {
TclInvalidateStringRep(dictPtr);
}
@@ -2307,7 +2291,7 @@ DictAppendCmd(
int i, allocatedDict = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
return TCL_ERROR;
}
@@ -2329,17 +2313,15 @@ DictAppendCmd(
if (valuePtr == NULL) {
TclNewObj(valuePtr);
- } else {
- if (Tcl_IsShared(valuePtr)) {
- valuePtr = Tcl_DuplicateObj(valuePtr);
- }
+ } else if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
}
for (i=3 ; i<objc ; i++) {
Tcl_AppendObjToObj(valuePtr, objv[i]);
}
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
@@ -2383,7 +2365,7 @@ DictForNRCmd(
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "{keyVar valueVar} dictionary script");
+ "{keyVarName valueVarName} dictionary script");
return TCL_ERROR;
}
@@ -2397,6 +2379,7 @@ DictForNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
return TCL_ERROR;
}
searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2430,12 +2413,14 @@ DictForNRCmd(
*/
Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(valueObj);
goto error;
}
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
goto error;
}
@@ -2574,7 +2559,7 @@ DictMapNRCmd(
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "{keyVar valueVar} dictionary script");
+ "{keyVarName valueVarName} dictionary script");
return TCL_ERROR;
}
@@ -2588,6 +2573,7 @@ DictMapNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
return TCL_ERROR;
}
storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
@@ -2782,7 +2768,7 @@ DictSetCmd(
int result, allocatedDict = 0;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
return TCL_ERROR;
}
@@ -2842,7 +2828,7 @@ DictUnsetCmd(
int result, allocatedDict = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
return TCL_ERROR;
}
@@ -2949,12 +2935,12 @@ DictFilterCmd(
Tcl_DictObjDone(&search);
Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
if (valueObj != NULL) {
- Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+ Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj);
}
} else {
while (!done) {
if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2972,7 +2958,7 @@ DictFilterCmd(
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
}
@@ -2998,7 +2984,7 @@ DictFilterCmd(
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
}
@@ -3010,7 +2996,7 @@ DictFilterCmd(
case FILTER_SCRIPT:
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
- "dictionary script {keyVar valueVar} filterScript");
+ "dictionary script {keyVarName valueVarName} filterScript");
return TCL_ERROR;
}
@@ -3026,6 +3012,7 @@ DictFilterCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -3064,19 +3051,15 @@ DictFilterCmd(
Tcl_IncrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set key variable: \"%s\"",
- TclGetString(keyVarObj)));
+ Tcl_AddErrorInfo(interp,
+ "\n (\"dict filter\" filter script key variable)");
result = TCL_ERROR;
goto abnormalResult;
}
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set value variable: \"%s\"",
- TclGetString(valueVarObj)));
+ Tcl_AddErrorInfo(interp,
+ "\n (\"dict filter\" filter script value variable)");
result = TCL_ERROR;
goto abnormalResult;
}
@@ -3099,7 +3082,7 @@ DictFilterCmd(
}
TclDecrRefCount(boolObj);
if (satisfied) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
}
break;
case TCL_BREAK:
@@ -3190,7 +3173,7 @@ DictUpdateCmd(
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "varName key varName ?key varName ...? script");
+ "dictVarName key varName ?key varName ...? script");
return TCL_ERROR;
}
@@ -3287,18 +3270,17 @@ FinalizeDictUpdate(
for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
- Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+ Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
} else if (objPtr == dictPtr) {
/*
* Someone is messing us around, trying to build a recursive
* structure. [Bug 1786481]
*/
- Tcl_DictObjPut(interp, dictPtr, objv[i],
- Tcl_DuplicateObj(objPtr));
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
} else {
/* Shouldn't fail */
- Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
}
}
TclDecrRefCount(argsObj);
@@ -3347,7 +3329,7 @@ DictWithCmd(
Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
return TCL_ERROR;
}
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
new file mode 100644
index 0000000..c85fe13
--- /dev/null
+++ b/generic/tclDisassemble.c
@@ -0,0 +1,1503 @@
+/*
+ * tclDisassemble.c --
+ *
+ * This file contains procedures that disassemble bytecode into either
+ * human-readable or Tcl-processable forms.
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2013 Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclOOInt.h"
+#include <assert.h>
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static int FormatInstruction(ByteCode *codePtr,
+ const unsigned char *pc, Tcl_Obj *bufferObj);
+static void GetLocationInformation(Tcl_Interp *interp,
+ Proc *procPtr, Tcl_Obj **fileObjPtr,
+ int *linePtr);
+static void PrintSourceToObj(Tcl_Obj *appendObj,
+ const char *stringPtr, int maxChars);
+static void UpdateStringOfInstName(Tcl_Obj *objPtr);
+
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+ "instname", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInstName, /* updateStringProc */
+ NULL, /* setFromAnyProc */
+};
+
+/*
+ * How to get the bytecode out of a Tcl_Obj.
+ */
+
+#define BYTECODE(objPtr) \
+ ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLocationInformation --
+ *
+ * This procedure looks up the information about where a procedure was
+ * originally declared.
+ *
+ * Results:
+ * Writes to the variables pointed at by fileObjPtr and linePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetLocationInformation(
+ Tcl_Interp *interp, /* Where to look up the location
+ * information. */
+ Proc *procPtr, /* What to look up the information for. */
+ Tcl_Obj **fileObjPtr, /* Where to write the information about what
+ * file the code came from. Will be written
+ * to, either with the object (assume shared!)
+ * that describes what the file was, or with
+ * NULL if the information is not
+ * available. */
+ int *linePtr) /* Where to write the information about what
+ * line number represented the start of the
+ * code in question. Will be written to,
+ * either with the line number or with -1 if
+ * the information is not available. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hePtr;
+ CmdFrame *cfPtr;
+
+ *fileObjPtr = NULL;
+ *linePtr = -1;
+ if (iPtr != NULL && procPtr != NULL) {
+ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
+ if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
+ *linePtr = cfPtr->line[0];
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ *fileObjPtr = cfPtr->data.eval.path;
+ }
+ }
+ }
+}
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintByteCodeObj --
+ *
+ * This procedure prints ("disassembles") the instructions of a bytecode
+ * object to stdout.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintByteCodeObj(
+ Tcl_Interp *interp, /* Used only for getting location info. */
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
+{
+ Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
+
+ fprintf(stdout, "\n%s", TclGetString(bufPtr));
+ Tcl_DecrRefCount(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ * This procedure prints ("disassembles") one instruction from a bytecode
+ * object to stdout.
+ *
+ * Results:
+ * Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc) /* Points to first byte of instruction. */
+{
+ Tcl_Obj *bufferObj;
+ int numBytes;
+
+ TclNewObj(bufferObj);
+ numBytes = FormatInstruction(codePtr, pc, bufferObj);
+ fprintf(stdout, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintObject --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument Tcl object's string representation to a specified file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintObject(
+ FILE *outFile, /* The file to print the source to. */
+ Tcl_Obj *objPtr, /* Points to the Tcl object whose string
+ * representation should be printed. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ char *bytes;
+ int length;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument string to a specified file. It tries to produce legible
+ * output by adding backslashes as necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(
+ FILE *outFile, /* The file to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ Tcl_Obj *bufferObj;
+
+ TclNewObj(bufferObj);
+ PrintSourceToObj(bufferObj, stringPtr, maxChars);
+ fprintf(outFile, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeObj --
+ *
+ * Given an object which is of bytecode type, return a disassembled
+ * version of the bytecode (in a new refcount 0 object). No guarantees
+ * are made about the details of the contents of the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
+{
+ ByteCode *codePtr = BYTECODE(objPtr);
+ unsigned char *codeStart, *codeLimit, *pc;
+ unsigned char *codeDeltaNext, *codeLengthNext;
+ unsigned char *srcDeltaNext, *srcLengthNext;
+ int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Tcl_Obj *bufferObj, *fileObj;
+ char ptrBuf1[20], ptrBuf2[20];
+
+ TclNewObj(bufferObj);
+ if (codePtr->refCount <= 0) {
+ return bufferObj; /* Already freed. */
+ }
+
+ codeStart = codePtr->codeStart;
+ codeLimit = codeStart + codePtr->numCodeBytes;
+ numCmds = codePtr->numCommands;
+
+ /*
+ * Print header lines describing the ByteCode.
+ */
+
+ sprintf(ptrBuf1, "%p", codePtr);
+ sprintf(ptrBuf2, "%p", iPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+ ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
+ iPtr->compileEpoch);
+ Tcl_AppendToObj(bufferObj, " Source ", -1);
+ PrintSourceToObj(bufferObj, codePtr->source,
+ TclMin(codePtr->numSrcBytes, 55));
+ GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
+ if (line > -1 && fileObj != NULL) {
+ Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
+ Tcl_GetString(fileObj), line);
+ }
+ Tcl_AppendPrintfToObj(bufferObj,
+ "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+ numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
+ codePtr->numLitObjects, codePtr->numAuxDataItems,
+ codePtr->maxStackDepth,
+#ifdef TCL_COMPILE_STATS
+ codePtr->numSrcBytes?
+ codePtr->structureSize/(float)codePtr->numSrcBytes :
+#endif
+ 0.0);
+
+#ifdef TCL_COMPILE_STATS
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+ (unsigned long) codePtr->structureSize,
+ (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
+ codePtr->numCodeBytes,
+ (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+ (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
+ codePtr->numCmdLocBytes);
+#endif /* TCL_COMPILE_STATS */
+
+ /*
+ * If the ByteCode is the compiled body of a Tcl procedure, print
+ * information about that procedure. Note that we don't know the
+ * procedure's name since ByteCode's can be shared among procedures.
+ */
+
+ if (codePtr->procPtr != NULL) {
+ Proc *procPtr = codePtr->procPtr;
+ int numCompiledLocals = procPtr->numCompiledLocals;
+
+ sprintf(ptrBuf1, "%p", procPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
+ ptrBuf1, procPtr->refCount, procPtr->numArgs,
+ numCompiledLocals);
+ if (numCompiledLocals > 0) {
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+
+ for (i = 0; i < numCompiledLocals; i++) {
+ Tcl_AppendPrintfToObj(bufferObj,
+ " slot %d%s%s%s%s%s%s", i,
+ (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
+ (localPtr->flags & VAR_ARRAY) ? ", array" : "",
+ (localPtr->flags & VAR_LINK) ? ", link" : "",
+ (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
+ (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
+ (localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
+ if (TclIsVarTemporary(localPtr)) {
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ } else {
+ Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+ localPtr->name);
+ }
+ localPtr = localPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Print the ExceptionRange array.
+ */
+
+ if (codePtr->numExceptRanges > 0) {
+ Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
+ codePtr->numExceptRanges, codePtr->maxExceptDepth);
+ for (i = 0; i < codePtr->numExceptRanges; i++) {
+ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+ Tcl_AppendPrintfToObj(bufferObj,
+ " %d: level %d, %s, pc %d-%d, ",
+ i, rangePtr->nestingLevel,
+ (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
+ rangePtr->codeOffset,
+ (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+ switch (rangePtr->type) {
+ case LOOP_EXCEPTION_RANGE:
+ Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
+ rangePtr->continueOffset, rangePtr->breakOffset);
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+ rangePtr->catchOffset);
+ break;
+ default:
+ Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
+ rangePtr->type);
+ }
+ }
+ }
+
+ /*
+ * If there were no commands (e.g., an expression or an empty string was
+ * compiled), just print all instructions and return.
+ */
+
+ if (numCmds == 0) {
+ pc = codeStart;
+ while (pc < codeLimit) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+ return bufferObj;
+ }
+
+ /*
+ * Print table showing the code offset, source offset, and source length
+ * for each command. These are encoded as a sequence of bytes.
+ */
+
+ Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
+ codeDeltaNext = codePtr->codeDeltaStart;
+ codeLengthNext = codePtr->codeLengthStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+ codeLengthNext++;
+ codeLen = TclGetInt4AtPtr(codeLengthNext);
+ codeLengthNext += 4;
+ } else {
+ codeLen = TclGetInt1AtPtr(codeLengthNext);
+ codeLengthNext++;
+ }
+
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+ ((i % 2)? " " : "\n "),
+ (i+1), codeOffset, (codeOffset + codeLen - 1),
+ srcOffset, (srcOffset + srcLen - 1));
+ }
+ if (numCmds > 0) {
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ }
+
+ /*
+ * Print each instruction. If the instruction corresponds to the start of
+ * a command, print the command's source. Note that we don't need the code
+ * length here.
+ */
+
+ codeDeltaNext = codePtr->codeDeltaStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
+ pc = codeStart;
+ for (i = 0; i < numCmds; i++) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ /*
+ * Print instructions before command i.
+ */
+
+ while ((pc-codeStart) < codeOffset) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+
+ Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
+ PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
+ TclMin(srcLen, 55));
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ }
+ if (pc < codeLimit) {
+ /*
+ * Print instructions after the last command.
+ */
+
+ while (pc < codeLimit) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+ }
+ return bufferObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatInstruction --
+ *
+ * Appends a representation of a bytecode instruction to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FormatInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc, /* Points to first byte of instruction. */
+ Tcl_Obj *bufferObj) /* Object to append instruction info to. */
+{
+ Proc *procPtr = codePtr->procPtr;
+ unsigned char opCode = *pc;
+ register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
+ unsigned char *codeStart = codePtr->codeStart;
+ unsigned pcOffset = pc - codeStart;
+ int opnd = 0, i, j, numBytes = 1;
+ int localCt = procPtr ? procPtr->numCompiledLocals : 0;
+ CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
+ char suffixBuffer[128]; /* Additional info to print after main opcode
+ * and immediates. */
+ char *suffixSrc = NULL;
+ Tcl_Obj *suffixObj = NULL;
+ AuxData *auxPtr = NULL;
+
+ suffixBuffer[0] = '\0';
+ Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
+ for (i = 0; i < instDesc->numOperands; i++) {
+ switch (instDesc->opTypes[i]) {
+ case OPERAND_INT1:
+ opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_INT4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_UINT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_UINT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer+strlen(suffixBuffer),
+ ", %u cmds start here", opnd);
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_OFFSET1:
+ opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+ sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_OFFSET4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+ } else {
+ sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_LIT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ suffixObj = codePtr->objArrayPtr[opnd];
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_LIT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ suffixObj = codePtr->objArrayPtr[opnd];
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_AUX4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ auxPtr = &codePtr->auxDataArrayPtr[opnd];
+ break;
+ case OPERAND_IDX4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opnd >= -1) {
+ Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
+ } else if (opnd == -2) {
+ Tcl_AppendPrintfToObj(bufferObj, "end ");
+ } else {
+ Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
+ }
+ break;
+ case OPERAND_LVT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes);
+ numBytes++;
+ goto printLVTindex;
+ case OPERAND_LVT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes);
+ numBytes += 4;
+ printLVTindex:
+ if (localPtr != NULL) {
+ if (opnd >= localCt) {
+ Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+ (unsigned) opnd, localCt);
+ }
+ for (j = 0; j < opnd; j++) {
+ localPtr = localPtr->nextPtr;
+ }
+ if (TclIsVarTemporary(localPtr)) {
+ sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
+ } else {
+ sprintf(suffixBuffer, "var ");
+ suffixSrc = localPtr->name;
+ }
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
+ break;
+ case OPERAND_SCLS1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%s ",
+ tclStringClassTable[opnd].name);
+ break;
+ case OPERAND_NONE:
+ default:
+ break;
+ }
+ }
+ if (suffixObj) {
+ const char *bytes;
+ int length;
+
+ Tcl_AppendToObj(bufferObj, "\t# ", -1);
+ bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
+ } else if (suffixBuffer[0]) {
+ Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
+ if (suffixSrc) {
+ PrintSourceToObj(bufferObj, suffixSrc, 40);
+ }
+ }
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ if (auxPtr && auxPtr->type->printProc) {
+ Tcl_AppendToObj(bufferObj, "\t\t[", -1);
+ auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
+ pcOffset);
+ Tcl_AppendToObj(bufferObj, "]\n", -1);
+ }
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInnerContext --
+ *
+ * If possible, returns a list capturing the inner context. Otherwise
+ * return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetInnerContext(
+ Tcl_Interp *interp,
+ const unsigned char *pc,
+ Tcl_Obj **tosPtr)
+{
+ int objc = 0, off = 0;
+ Tcl_Obj *result;
+ Interp *iPtr = (Interp *) interp;
+
+ switch (*pc) {
+ case INST_STR_LEN:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ case INST_EXPAND_STKTOP:
+ case INST_EXPR_STK:
+ objc = 1;
+ break;
+
+ case INST_LIST_IN:
+ case INST_LIST_NOT_IN: /* Basic list containment operators. */
+ case INST_STR_EQ:
+ case INST_STR_NEQ: /* String (in)equality check */
+ case INST_STR_CMP: /* String compare. */
+ case INST_STR_INDEX:
+ case INST_STR_MATCH:
+ case INST_REGEXP:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ case INST_LE:
+ case INST_GE:
+ case INST_MOD:
+ case INST_LSHIFT:
+ case INST_RSHIFT:
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ case INST_EXPON:
+ case INST_ADD:
+ case INST_SUB:
+ case INST_DIV:
+ case INST_MULT:
+ objc = 2;
+ break;
+
+ case INST_RETURN_STK:
+ /* early pop. TODO: dig out opt dict too :/ */
+ objc = 1;
+ break;
+
+ case INST_SYNTAX:
+ case INST_RETURN_IMM:
+ objc = 2;
+ break;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ break;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ break;
+ }
+
+ result = iPtr->innerContext;
+ if (Tcl_IsShared(result)) {
+ Tcl_DecrRefCount(result);
+ iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
+ Tcl_IncrRefCount(result);
+ } else {
+ int len;
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjLength(interp, result, &len);
+ Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
+ }
+ Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+
+ for (; objc>0 ; objc--) {
+ Tcl_Obj *objPtr;
+
+ objPtr = tosPtr[1 - objc + off];
+ if (!objPtr) {
+ Tcl_Panic("InnerContext: bad tos -- appending null object");
+ }
+ if ((objPtr->refCount<=0)
+#ifdef TCL_MEM_DEBUG
+ || (objPtr->refCount==0x61616161)
+#endif
+ ) {
+ Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+ objPtr);
+ }
+ Tcl_ListObjAppendElement(NULL, result, objPtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ * Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewInstNameObj(
+ unsigned char inst)
+{
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ objPtr->typePtr = &tclInstNameType;
+ objPtr->internalRep.longValue = (long) inst;
+ objPtr->bytes = NULL;
+
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ * Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInstName(
+ Tcl_Obj *objPtr)
+{
+ int inst = objPtr->internalRep.longValue;
+ char *s, buf[20];
+ int len;
+
+ if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
+ sprintf(buf, "inst_%d", inst);
+ s = buf;
+ } else {
+ s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
+ }
+ len = strlen(s);
+ objPtr->bytes = ckalloc(len + 1);
+ memcpy(objPtr->bytes, s, len + 1);
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintSourceToObj --
+ *
+ * Appends a quoted representation of a string to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintSourceToObj(
+ Tcl_Obj *appendObj, /* The object to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ register const char *p;
+ register int i = 0, len;
+ Tcl_UniChar ch = 0;
+
+ if (stringPtr == NULL) {
+ Tcl_AppendToObj(appendObj, "\"\"", -1);
+ return;
+ }
+
+ Tcl_AppendToObj(appendObj, "\"", -1);
+ p = stringPtr;
+ for (; (*p != '\0') && (i < maxChars); p+=len) {
+
+ len = TclUtfToUniChar(p, &ch);
+ switch (ch) {
+ case '"':
+ Tcl_AppendToObj(appendObj, "\\\"", -1);
+ i += 2;
+ continue;
+ case '\f':
+ Tcl_AppendToObj(appendObj, "\\f", -1);
+ i += 2;
+ continue;
+ case '\n':
+ Tcl_AppendToObj(appendObj, "\\n", -1);
+ i += 2;
+ continue;
+ case '\r':
+ Tcl_AppendToObj(appendObj, "\\r", -1);
+ i += 2;
+ continue;
+ case '\t':
+ Tcl_AppendToObj(appendObj, "\\t", -1);
+ i += 2;
+ continue;
+ case '\v':
+ Tcl_AppendToObj(appendObj, "\\v", -1);
+ i += 2;
+ continue;
+ default:
+#if TCL_UTF_MAX > 4
+ if (ch > 0xffff) {
+ Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
+ i += 10;
+ } else
+#elif TCL_UTF_MAX > 3
+ /* If len == 0, this means we have a char > 0xffff, resulting in
+ * TclUtfToUniChar producing a surrogate pair. We want to output
+ * this pair as a single Unicode character.
+ */
+ if (len == 0) {
+ int upper = ((ch & 0x3ff) + 1) << 10;
+ len = TclUtfToUniChar(p, &ch);
+ Tcl_AppendPrintfToObj(appendObj, "\\U%08x", upper + (ch & 0x3ff));
+ i += 10;
+ } else
+#endif
+ if (ch < 0x20 || ch >= 0x7f) {
+ Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+ i += 6;
+ } else {
+ Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+ i++;
+ }
+ continue;
+ }
+ }
+ if (*p != '\0') {
+ Tcl_AppendToObj(appendObj, "...", -1);
+ }
+ Tcl_AppendToObj(appendObj, "\"", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeAsDicts --
+ *
+ * Given an object which is of bytecode type, return a disassembled
+ * version of the bytecode (in a new refcount 0 object) in a dictionary.
+ * No guarantees are made about the details of the contents of the
+ * result, but it is intended to be more readable than the old output
+ * format.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeAsDicts(
+ Tcl_Interp *interp, /* Used for looking up the CmdFrame for the
+ * procedure, if one exists. */
+ Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
+{
+ ByteCode *codePtr = BYTECODE(objPtr);
+ Tcl_Obj *description, *literals, *variables, *instructions, *inst;
+ Tcl_Obj *aux, *exn, *commands, *file;
+ unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
+ int codeOffset, codeLength, sourceOffset, sourceLength;
+ int i, val, line;
+
+ /*
+ * Get the literals from the bytecode.
+ */
+
+ literals = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numLitObjects ; i++) {
+ Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
+ }
+
+ /*
+ * Get the variables from the bytecode.
+ */
+
+ variables = Tcl_NewObj();
+ if (codePtr->procPtr) {
+ int localCount = codePtr->procPtr->numCompiledLocals;
+ CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
+
+ for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
+ Tcl_Obj *descriptor[2];
+
+ descriptor[0] = Tcl_NewObj();
+ if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("scalar", -1));
+ }
+ if (localPtr->flags & VAR_ARRAY) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("array", -1));
+ }
+ if (localPtr->flags & VAR_LINK) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("link", -1));
+ }
+ if (localPtr->flags & VAR_ARGUMENT) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("arg", -1));
+ }
+ if (localPtr->flags & VAR_TEMPORARY) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("temp", -1));
+ }
+ if (localPtr->flags & VAR_RESOLVED) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("resolved", -1));
+ }
+ if (localPtr->flags & VAR_TEMPORARY) {
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewListObj(1, descriptor));
+ } else {
+ descriptor[1] = Tcl_NewStringObj(localPtr->name, -1);
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewListObj(2, descriptor));
+ }
+ }
+ }
+
+ /*
+ * Get the instructions from the bytecode.
+ */
+
+ instructions = Tcl_NewObj();
+ for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){
+ const InstructionDesc *instDesc = &tclInstructionTable[*pc];
+ int address = pc - codePtr->codeStart;
+
+ inst = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+ instDesc->name, -1));
+ opnd = pc + 1;
+ for (i=0 ; i<instDesc->numOperands ; i++) {
+ switch (instDesc->opTypes[i]) {
+ case OPERAND_INT1:
+ val = TclGetInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatNumber;
+ case OPERAND_UINT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatNumber;
+ case OPERAND_INT4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ goto formatNumber;
+ case OPERAND_UINT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatNumber:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewIntObj(val));
+ break;
+
+ case OPERAND_OFFSET1:
+ val = TclGetInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatAddress;
+ case OPERAND_OFFSET4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ formatAddress:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "pc %d", address + val));
+ break;
+
+ case OPERAND_LIT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatLiteral;
+ case OPERAND_LIT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatLiteral:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "@%d", val));
+ break;
+
+ case OPERAND_LVT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatVariable;
+ case OPERAND_LVT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatVariable:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "%%%d", val));
+ break;
+ case OPERAND_IDX4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ if (val >= -1) {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ ".%d", val));
+ } else if (val == -2) {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+ ".end", -1));
+ } else {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ ".end-%d", -2-val));
+ }
+ break;
+ case OPERAND_AUX4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "?%d", val));
+ break;
+ case OPERAND_SCLS1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd++;
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "=%s", tclStringClassTable[val].name));
+ break;
+ case OPERAND_NONE:
+ Tcl_Panic("opcode %d with more than zero 'no' operands", *pc);
+ }
+ }
+ Tcl_DictObjPut(NULL, instructions, Tcl_NewIntObj(address), inst);
+ pc += instDesc->numBytes;
+ }
+
+ /*
+ * Get the auxiliary data from the bytecode.
+ */
+
+ aux = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numAuxDataItems ; i++) {
+ AuxData *auxData = &codePtr->auxDataArrayPtr[i];
+ Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1);
+
+ if (auxData->type->disassembleProc) {
+ Tcl_Obj *desc = Tcl_NewObj();
+
+ Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
+ auxDesc = desc;
+ auxData->type->disassembleProc(auxData->clientData, auxDesc,
+ codePtr, 0);
+ } else if (auxData->type->printProc) {
+ Tcl_Obj *desc = Tcl_NewObj();
+
+ auxData->type->printProc(auxData->clientData, desc, codePtr, 0);
+ Tcl_ListObjAppendElement(NULL, auxDesc, desc);
+ }
+ Tcl_ListObjAppendElement(NULL, aux, auxDesc);
+ }
+
+ /*
+ * Get the exception ranges from the bytecode.
+ */
+
+ exn = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numExceptRanges ; i++) {
+ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+ switch (rangePtr->type) {
+ case LOOP_EXCEPTION_RANGE:
+ Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+ "type %s level %d from %d to %d break %d continue %d",
+ "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
+ rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+ rangePtr->breakOffset, rangePtr->continueOffset));
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+ "type %s level %d from %d to %d catch %d",
+ "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
+ rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+ rangePtr->catchOffset));
+ break;
+ }
+ }
+
+ /*
+ * Get the command information from the bytecode.
+ *
+ * The way these are encoded in the bytecode is non-trivial; the Decode
+ * macro (which updates its argument and returns the next decoded value)
+ * handles this so that the rest of the code does not.
+ */
+
+#define Decode(ptr) \
+ ((TclGetUInt1AtPtr(ptr) == 0xFF) \
+ ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \
+ : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1)))
+
+ commands = Tcl_NewObj();
+ codeOffPtr = codePtr->codeDeltaStart;
+ codeLenPtr = codePtr->codeLengthStart;
+ srcOffPtr = codePtr->srcDeltaStart;
+ srcLenPtr = codePtr->srcLengthStart;
+ codeOffset = sourceOffset = 0;
+ for (i=0 ; i<codePtr->numCommands ; i++) {
+ Tcl_Obj *cmd;
+
+ codeOffset += Decode(codeOffPtr);
+ codeLength = Decode(codeLenPtr);
+ sourceOffset += Decode(srcOffPtr);
+ sourceLength = Decode(srcLenPtr);
+ cmd = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
+ Tcl_NewIntObj(codeOffset));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
+ Tcl_NewIntObj(codeOffset + codeLength - 1));
+
+ /*
+ * Convert byte offsets to character offsets; important if multibyte
+ * characters are present in the source!
+ */
+
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
+ Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ sourceOffset)));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
+ Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ sourceOffset + sourceLength - 1)));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
+ Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
+ Tcl_ListObjAppendElement(NULL, commands, cmd);
+ }
+
+#undef Decode
+
+ /*
+ * Get the source file and line number information from the CmdFrame
+ * system if it is available.
+ */
+
+ GetLocationInformation(interp, codePtr->procPtr, &file, &line);
+
+ /*
+ * Build the overall result.
+ */
+
+ description = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
+ literals);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
+ variables);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
+ instructions);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
+ commands);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
+ Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
+ Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
+ Tcl_NewIntObj(codePtr->maxStackDepth));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
+ Tcl_NewIntObj(codePtr->maxExceptDepth));
+ if (line > -1) {
+ Tcl_DictObjPut(NULL, description,
+ Tcl_NewStringObj("initiallinenumber", -1),
+ Tcl_NewIntObj(line));
+ }
+ if (file) {
+ Tcl_DictObjPut(NULL, description,
+ Tcl_NewStringObj("sourcefile", -1), file);
+ }
+ return description;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DisassembleObjCmd --
+ *
+ * Implementation of the "::tcl::unsupported::disassemble" command. This
+ * command is not documented, but will disassemble procedures, lambda
+ * terms and general scripts. Note that will compile terms if necessary
+ * in order to disassemble them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DisassembleObjCmd(
+ ClientData clientData, /* What type of operation. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const types[] = {
+ "lambda", "method", "objmethod", "proc", "script", NULL
+ };
+ enum Types {
+ DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
+ DISAS_SCRIPT
+ };
+ int idx, result;
+ Tcl_Obj *codeObjPtr = NULL;
+ Proc *procPtr = NULL;
+ Tcl_HashEntry *hPtr;
+ Object *oPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type ...");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+ return TCL_ERROR;
+ }
+
+ switch ((enum Types) idx) {
+ case DISAS_LAMBDA: {
+ Command cmd;
+ Tcl_Obj *nsObjPtr;
+ Tcl_Namespace *nsPtr;
+
+ /*
+ * Compile (if uncompiled) and disassemble a lambda term.
+ *
+ * WARNING! Pokes inside the lambda objtype.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
+ return TCL_ERROR;
+ }
+ if (objv[2]->typePtr == &tclLambdaType) {
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+ if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+ result = tclLambdaType.setFromAnyProc(interp, objv[2]);
+ if (result != TCL_OK) {
+ return result;
+ }
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+
+ memset(&cmd, 0, sizeof(Command));
+ nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ cmd.nsPtr = (Namespace *) nsPtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ }
+ case DISAS_PROC:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "procName");
+ return TCL_ERROR;
+ }
+
+ procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile (if uncompiled) and disassemble a procedure.
+ */
+
+ result = TclPushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ case DISAS_SCRIPT:
+ /*
+ * Compile and disassemble a script.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "script");
+ return TCL_ERROR;
+ }
+ if ((objv[2]->typePtr != &tclByteCodeType)
+ && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ codeObjPtr = objv[2];
+ break;
+
+ case DISAS_CLASS_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a class method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
+ (char *) objv[3]);
+ goto methodBody;
+ case DISAS_OBJECT_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of an instance method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->methodsPtr == NULL) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+
+ /*
+ * Compile (if necessary) and disassemble a method body.
+ */
+
+ methodBody:
+ if (hPtr == NULL) {
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[3]), NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of method",
+ TclGetString(objv[3]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ default:
+ CLANG_ASSERT(0);
+ }
+
+ /*
+ * Do the actual disassembly.
+ */
+
+ if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not disassemble prebuilt bytecode", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "BYTECODE", NULL);
+ return TCL_ERROR;
+ }
+ if (PTR2INT(clientData)) {
+ Tcl_SetObjResult(interp,
+ DisassembleByteCodeAsDicts(interp, codeObjPtr));
+ } else {
+ Tcl_SetObjResult(interp,
+ DisassembleByteCodeObj(interp, codeObjPtr));
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2cc55d6..4edebcf 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -180,8 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
* the system encoding will be used to perform the conversion.
*/
-static Tcl_Encoding defaultEncoding;
-static Tcl_Encoding systemEncoding;
+static Tcl_Encoding defaultEncoding = NULL;
+static Tcl_Encoding systemEncoding = NULL;
+Tcl_Encoding tclIdentityEncoding = NULL;
/*
* The following variable is used in the sparse matrix code for a
@@ -567,7 +568,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
- Tcl_CreateEncoding(&type);
+ tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfExtToUtfIntProc;
@@ -651,6 +652,10 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
+ systemEncoding = NULL;
+ defaultEncoding = NULL;
+ FreeEncoding(tclIdentityEncoding);
+ tclIdentityEncoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -1201,7 +1206,10 @@ Tcl_ExternalToUtf(
* output buffer. */
{
const Encoding *encodingPtr;
- int result, srcRead, dstWrote, dstChars;
+ int result, srcRead, dstWrote, dstChars = 0;
+ int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
+ int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
+ int maxChars = INT_MAX;
Tcl_EncodingState state;
if (encoding == NULL) {
@@ -1226,19 +1234,40 @@ Tcl_ExternalToUtf(
}
if (dstCharsPtr == NULL) {
dstCharsPtr = &dstChars;
+ flags &= ~TCL_ENCODING_CHAR_LIMIT;
+ } else if (charLimited) {
+ maxChars = *dstCharsPtr;
}
- /*
- * If there are any null characters in the middle of the buffer, they will
- * converted to the UTF-8 null character (\xC080). To get the actual \0 at
- * the end of the destination buffer, we need to append it manually.
- */
+ if (!noTerminate) {
+ /*
+ * If there are any null characters in the middle of the buffer,
+ * they will converted to the UTF-8 null character (\xC080). To get
+ * the actual \0 at the end of the destination buffer, we need to
+ * append it manually. First make room for it...
+ */
- dstLen--;
- result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
- flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
- dstCharsPtr);
- dst[*dstWrotePtr] = '\0';
+ dstLen--;
+ }
+ do {
+ int savedFlags = flags;
+ Tcl_EncodingState savedState = *statePtr;
+
+ result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
+ flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr);
+ if (*dstCharsPtr <= maxChars) {
+ break;
+ }
+ dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX;
+ flags = savedFlags;
+ *statePtr = savedState;
+ } while (1);
+ if (!noTerminate) {
+ /* ...and then append it */
+
+ dst[*dstWrotePtr] = '\0';
+ }
return result;
}
@@ -1421,7 +1450,7 @@ Tcl_UtfToExternal(
*
* Side effects:
* The absolute pathname for the application is computed and stored to be
- * returned later be [info nameofexecutable].
+ * returned later by [info nameofexecutable].
*
*---------------------------------------------------------------------------
*/
@@ -2102,6 +2131,9 @@ BinaryProc(
if (dstLen < 0) {
dstLen = 0;
}
+ if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
+ srcLen = *dstCharsPtr;
+ }
if (srcLen > dstLen) {
srcLen = dstLen;
result = TCL_CONVERT_NOSPACE;
@@ -2262,7 +2294,7 @@ UtfToUtfProc(
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
result = TCL_OK;
@@ -2273,11 +2305,14 @@ UtfToUtfProc(
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
@@ -2299,7 +2334,7 @@ UtfToUtfProc(
*dst++ = *src++;
} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
- UCHAR(*(src+1)) == 0x80) {
+ (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
/*
* Convert 0xc080 to real nulls when we are in output mode.
*/
@@ -2373,9 +2408,12 @@ UnicodeToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
result = TCL_OK;
if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
result = TCL_CONVERT_MULTIBYTE;
@@ -2389,7 +2427,7 @@ UnicodeToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2487,22 +2525,35 @@ UtfToUnicodeProc(
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
- }
+ }
src += TclUtfToUniChar(src, &ch);
/*
* Need to handle this in a way that won't cause misalignment by
* casting dst to a Tcl_UniChar. [Bug 1122671]
- * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
*/
#ifdef WORDS_BIGENDIAN
+#if TCL_UTF_MAX > 4
+ *dst++ = (ch >> 24);
+ *dst++ = ((ch >> 16) & 0xFF);
+ *dst++ = ((ch >> 8) & 0xFF);
+ *dst++ = (ch & 0xFF);
+#else
*dst++ = (ch >> 8);
*dst++ = (ch & 0xFF);
+#endif
+#else
+#if TCL_UTF_MAX > 4
+ *dst++ = (ch & 0xFF);
+ *dst++ = ((ch >> 8) & 0xFF);
+ *dst++ = ((ch >> 16) & 0xFF);
+ *dst++ = (ch >> 24);
#else
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
#endif
+#endif
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
@@ -2557,12 +2608,15 @@ TableToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart, *prefixBytes;
- int result, byte, numChars;
+ int result, byte, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
const unsigned short *const *toUnicode;
const unsigned short *pageZero;
TableEncodingData *dataPtr = clientData;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
srcStart = src;
srcEnd = src + srcLen;
@@ -2574,7 +2628,7 @@ TableToUtfProc(
pageZero = toUnicode[0];
result = TCL_OK;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2788,8 +2842,11 @@ Iso88591ToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
srcStart = src;
srcEnd = src + srcLen;
@@ -2797,7 +2854,7 @@ Iso88591ToUtfProc(
dstEnd = dst + dstLen - TCL_UTF_MAX;
result = TCL_OK;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
Tcl_UniChar ch;
if (dst > dstEnd) {
@@ -2958,7 +3015,9 @@ TableFreeProc(
*/
ckfree(dataPtr->toUnicode);
+ dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
+ dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
@@ -3011,9 +3070,12 @@ EscapeToUtfProc(
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
- int state, result, numChars;
+ int state, result, numChars, charLimit = INT_MAX;
const char *dstStart, *dstEnd;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
result = TCL_OK;
tablePrefixBytes = NULL; /* lint. */
tableToUnicode = NULL; /* lint. */
@@ -3031,7 +3093,7 @@ EscapeToUtfProc(
state = 0;
}
- for (numChars = 0; src < srcEnd; ) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
int byte, hi, lo, ch;
if (dst > dstEnd) {
@@ -3431,6 +3493,7 @@ EscapeFreeProc(
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+ subTablePtr->encodingPtr = NULL;
subTablePtr++;
}
}
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index ad11785..986a553 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2749,15 +2749,9 @@ TclCompileEnsemble(
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
+ DefineLineInformation;
Tcl_IncrRefCount(replaced);
-
- /*
- * This is where we return to if we are parsing multiple nested compiled
- * ensembles. [info object] is such a beast.
- */
-
- checkNextWord:
if (parsePtr->numWords < depth + 1) {
goto failed;
}
@@ -2769,6 +2763,12 @@ TclCompileEnsemble(
goto failed;
}
+ /*
+ * This is where we return to if we are parsing multiple nested compiled
+ * ensembles. [info object] is such a beast.
+ */
+
+ checkNextWord:
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
@@ -2979,6 +2979,17 @@ TclCompileEnsemble(
if (cmdPtr->compileProc == TclCompileEnsemble) {
tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords < depth + 1
+ || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Too hard because the user has done something unpleasant like
+ * omitting the sub-ensemble's command name or used a non-constant
+ * name for a sub-ensemble's command name; we respond by bailing
+ * out completely (this is a rare case). [Bug 6d2f249a01]
+ */
+
+ goto cleanup;
+ }
ensemble = (Tcl_Command) cmdPtr;
goto checkNextWord;
}
@@ -2998,6 +3009,23 @@ TclCompileEnsemble(
}
/*
+ * Throw out any line information generated by the failed compile attempt.
+ */
+
+ while (mapPtr->nuloc - 1 > eclIndex) {
+ mapPtr->nuloc--;
+ ckfree(mapPtr->loc[mapPtr->nuloc].line);
+ mapPtr->loc[mapPtr->nuloc].line = NULL;
+ }
+
+ /*
+ * Reset the index of next command. Toss out any from failed nested
+ * partial compiles.
+ */
+
+ envPtr->numCommands = mapPtr->nuloc;
+
+ /*
* Failed to do a full compile for some reason. Try to do a direct invoke
* instead of going through the ensemble lookup process again.
*/
@@ -3009,8 +3037,24 @@ TclCompileEnsemble(
cmdPtr = oldCmdPtr;
depth--;
}
- (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
}
+ /*
+ * The length of the "replaced" list must be depth-1. Trim back
+ * any extra elements that might have been appended by failing
+ * pathways above.
+ */
+ (void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);
+
+ /*
+ * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
+ * when depth==1. In that case we are choosing to emit the
+ * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
+ * to be done. It would be equally functional and presumably more
+ * performant to fall through to cleanup below, return TCL_ERROR,
+ * and let the compiler harness emit the INST_INVOKE_STK
+ * implementation for us.
+ */
+
CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
ourResult = TCL_OK;
}
@@ -3038,6 +3082,11 @@ TclAttemptCompileProc(
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+ int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
+ int savedExceptArrayNext = envPtr->exceptArrayNext;
+#ifdef TCL_COMPILE_DEBUG
+ int savedExceptDepth = envPtr->exceptDepth;
+#endif
DefineLineInformation;
if (cmdPtr->compileProc == NULL) {
@@ -3071,7 +3120,7 @@ TclAttemptCompileProc(
result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
/*
- * Undo the shift.
+ * Undo the shift.
*/
mapPtr->loc[eclIndex].line -= (depth - 1);
@@ -3086,7 +3135,45 @@ TclAttemptCompileProc(
* we avoid compiling subcommands that recursively call TclCompileScript().
*/
+#ifdef TCL_COMPILE_DEBUG
+ if (envPtr->exceptDepth != savedExceptDepth) {
+ Tcl_Panic("ExceptionRange Starts and Ends do not balance");
+ }
+#endif
+
if (result != TCL_OK) {
+ ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
+
+ for (i = 0; i < savedExceptArrayNext; i++) {
+ while (auxPtr->numBreakTargets > 0
+ && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
+ >= savedCodeNext) {
+ auxPtr->numBreakTargets--;
+ }
+ while (auxPtr->numContinueTargets > 0
+ && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
+ >= savedCodeNext) {
+ auxPtr->numContinueTargets--;
+ }
+ auxPtr++;
+ }
+ envPtr->exceptArrayNext = savedExceptArrayNext;
+
+ if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+ AuxData *auxDataEnd = auxDataPtr;
+
+ auxDataPtr += savedAuxDataArrayNext;
+ auxDataEnd += envPtr->auxDataArrayNext;
+
+ while (auxDataPtr < auxDataEnd) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ envPtr->auxDataArrayNext = savedAuxDataArrayNext;
+ }
envPtr->currStackDepth = savedStackDepth;
envPtr->codeNext = envPtr->codeStart + savedCodeNext;
#ifdef TCL_COMPILE_DEBUG
@@ -3179,9 +3266,7 @@ CompileToInvokedCommand(
* Do the replacing dispatch.
*/
- TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr);
- TclEmitInt1(numWords+1, envPtr);
- TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */
+ TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1);
}
/*
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index b5ae6ea..66ddb57 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -43,11 +43,6 @@ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
-
-#if defined(__CYGWIN__)
- static void TclCygwinPutenv(char *string);
-# define putenv TclCygwinPutenv
-#endif
/*
*----------------------------------------------------------------------
@@ -76,36 +71,56 @@ TclSetupEnv(
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNamePtr;
Tcl_DString envString;
- char *p1, *p2;
- int i;
+ Tcl_HashTable namesHash;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
/*
* Synchronize the values in the environ array with the contents of the
* Tcl "env" variable. To do this:
- * 1) Remove the trace that fires when the "env" var is unset.
- * 2) Unset the "env" variable.
- * 3) If there are no environ variables, create an empty "env" array.
- * Otherwise populate the array with current values.
- * 4) Add a trace that synchronizes the "env" array.
+ * 1) Remove the trace that fires when the "env" var is updated.
+ * 2) Find the existing contents of the "env", storing in a hash table.
+ * 3) Create/update elements for each environ variable, removing
+ * elements from the hash table as we go.
+ * 4) Remove the elements for each remaining entry in the hash table,
+ * which must have existed before yet have no analog in the environ
+ * variable.
+ * 5) Add a trace that synchronizes the "env" array.
*/
Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
- Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
+ /*
+ * Find out what elements are currently in the global env array.
+ */
- if (environ[0] == NULL) {
- Tcl_Obj *varNamePtr;
+ TclNewLiteralStringObj(varNamePtr, "env");
+ Tcl_IncrRefCount(varNamePtr);
+ Tcl_InitObjHashTable(&namesHash);
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ TclFindArrayPtrElements(varPtr, &namesHash);
+
+ /*
+ * Go through the environment array and transfer its values into Tcl. At
+ * the same time, remove those elements we add/update from the hash table
+ * of existing elements, so that after this part processes, that table
+ * will hold just the parts to remove.
+ */
+
+ if (environ[0] != NULL) {
+ int i;
- TclNewLiteralStringObj(varNamePtr, "env");
- Tcl_IncrRefCount(varNamePtr);
- TclArraySet(interp, varNamePtr, NULL);
- Tcl_DecrRefCount(varNamePtr);
- } else {
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
+ Tcl_Obj *obj1, *obj2;
+ char *p1, *p2;
+
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
if (p2 == NULL) {
@@ -119,12 +134,41 @@ TclSetupEnv(
}
p2++;
p2[-1] = '\0';
- Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+ obj1 = Tcl_NewStringObj(p1, -1);
+ obj2 = Tcl_NewStringObj(p2, -1);
Tcl_DStringFree(&envString);
+
+ Tcl_IncrRefCount(obj1);
+ Tcl_IncrRefCount(obj2);
+ Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
+ hPtr = Tcl_FindHashEntry(&namesHash, obj1);
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DecrRefCount(obj1);
+ Tcl_DecrRefCount(obj2);
}
Tcl_MutexUnlock(&envMutex);
}
+ /*
+ * Delete those elements that existed in the array but which had no
+ * counterparts in the environment array.
+ */
+
+ for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
+ hPtr=Tcl_NextHashEntry(&search)) {
+ Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
+
+ TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
+ }
+ Tcl_DeleteHashTable(&namesHash);
+ Tcl_DecrRefCount(varNamePtr);
+
+ /*
+ * Re-establish the trace.
+ */
+
Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
@@ -395,7 +439,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -404,7 +448,7 @@ TclUnsetEnv(
string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
@@ -507,7 +551,8 @@ TclGetEnv(
* array.
*
* Results:
- * Always returns NULL to indicate success.
+ * Returns NULL to indicate success, or an error-message if the array
+ * element being handled doesn't exist.
*
* Side effects:
* Environment variable changes get propagated. If the whole "env" array
@@ -690,98 +735,6 @@ TclFinalizeEnvironment(void)
}
}
-#if defined(__CYGWIN__)
-
-/*
- * When using cygwin, when an environment variable changes, we need to synch
- * with both the cygwin environment (in case the application C code calls
- * fork) and the Windows environment (in case the application TCL code calls
- * exec, which calls the Windows CreateProcess function).
- */
-DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
-
-static void
-TclCygwinPutenv(
- char *str)
-{
- char *name, *value;
-
- /*
- * Get the name and value, so that we can change the environment variable
- * for Windows.
- */
-
- name = alloca(strlen(str) + 1);
- strcpy(name, str);
- for (value=name ; *value!='=' && *value!='\0' ; ++value) {
- /* Empty body */
- }
- if (*value == '\0') {
- /* Can't happen. */
- return;
- }
- *(value++) = '\0';
- if (*value == '\0') {
- value = NULL;
- }
-
- /*
- * Set the cygwin environment variable.
- */
-
-#undef putenv
- if (value == NULL) {
- unsetenv(name);
- } else {
- putenv(str);
- }
-
- /*
- * Before changing the environment variable in Windows, if this is PATH,
- * we need to convert the value back to a Windows style path.
- *
- * FIXME: The calling program may know it is running under windows, and
- * may have set the path to a Windows path, or, worse, appended or
- * prepended a Windows path to PATH.
- */
-
- if (strcmp(name, "PATH") != 0) {
- /*
- * If this is Path, eliminate any PATH variable, to prevent any
- * confusion.
- */
-
- if (strcmp(name, "Path") == 0) {
- SetEnvironmentVariableA("PATH", NULL);
- unsetenv("PATH");
- }
-
- SetEnvironmentVariableA(name, value);
- } else {
- char *buf;
-
- /*
- * Eliminate any Path variable, to prevent any confusion.
- */
-
- SetEnvironmentVariableA("Path", NULL);
- unsetenv("Path");
-
- if (value == NULL) {
- buf = NULL;
- } else {
- int size;
-
- size = cygwin_conv_path_list(0, value, NULL, 0);
- buf = alloca(size + 1);
- cygwin_conv_path_list(0, value, buf, size);
- }
-
- SetEnvironmentVariableA(name, buf);
- }
-}
-#endif /* __CYGWIN__ */
-
/*
* Local Variables:
* mode: c
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 906ecbb..b0b8188 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -89,7 +89,7 @@ static int subsystemsInitialized = 0;
* non-NULL value.
*/
-static Tcl_ExitProc *appExitPtr = NULL;
+static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL;
typedef struct ThreadSpecificData {
ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
@@ -119,6 +119,7 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
+static void FinalizeThread(int quick);
/*
*----------------------------------------------------------------------
@@ -262,7 +263,7 @@ HandleBgErrors(
if (errChannel != NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr = NULL;
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
@@ -314,7 +315,7 @@ TclDefaultBgErrorHandlerObjCmd(
{
Tcl_Obj *keyPtr, *valuePtr;
Tcl_Obj *tempObjv[2];
- int code, level;
+ int result, code, level;
Tcl_InterpState saved;
if (objc != 3) {
@@ -328,9 +329,9 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-level");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr == NULL) {
+ if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
@@ -341,9 +342,9 @@ TclDefaultBgErrorHandlerObjCmd(
}
TclNewLiteralStringObj(keyPtr, "-code");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr == NULL) {
+ if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
@@ -406,17 +407,17 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-errorcode");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr) {
+ if (result == TCL_OK && valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
}
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr) {
+ if (result == TCL_OK && valuePtr != NULL) {
Tcl_AppendObjToErrorInfo(interp, valuePtr);
}
@@ -856,7 +857,7 @@ Tcl_DeleteThreadExitHandler(
Tcl_ExitProc *
Tcl_SetExitProc(
- Tcl_ExitProc *proc) /* New exit handler for app or NULL */
+ TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */
{
Tcl_ExitProc *prevExitProc;
@@ -891,7 +892,7 @@ Tcl_SetExitProc(
*----------------------------------------------------------------------
*/
static void
-InvokeExitHandlers(void)
+InvokeExitHandlers(void)
{
ExitHandler *exitPtr;
@@ -932,12 +933,12 @@ InvokeExitHandlers(void)
*----------------------------------------------------------------------
*/
-void
+TCL_NORETURN void
Tcl_Exit(
int status) /* Exit status for application; typically 0
* for normal return, 1 for error return. */
{
- Tcl_ExitProc *currentAppExitPtr;
+ TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr;
Tcl_MutexLock(&exitMutex);
currentAppExitPtr = appExitPtr;
@@ -967,23 +968,23 @@ Tcl_Exit(
/*
* Fast and deterministic exit (default behavior)
*/
-
+
InvokeExitHandlers();
-
+
/*
* Ensure the thread-specific data is initialised as it is used in
* Tcl_FinalizeThread()
*/
-
+
(void) TCL_TSD_INIT(&dataKey);
-
+
/*
* Now finalize the calling thread only (others are not safely
* reachable). Among other things, this triggers a flush of the
* Tcl_Channels that may have data enqueued.
*/
-
- Tcl_FinalizeThread();
+
+ FinalizeThread(/* quick */ 1);
}
TclpExit(status);
Tcl_Panic("OS exit failed!");
@@ -1089,7 +1090,7 @@ Tcl_Finalize(void)
* Invoke exit handlers first.
*/
- InvokeExitHandlers();
+ InvokeExitHandlers();
TclpInitLock();
if (subsystemsInitialized == 0) {
@@ -1171,8 +1172,6 @@ Tcl_Finalize(void)
TclFinalizeEncodingSubsystem();
- Tcl_SetPanicProc(NULL);
-
/*
* Repeat finalization of the thread local storage once more. Although
* this step is already done by the Tcl_FinalizeThread call above, series
@@ -1185,7 +1184,7 @@ Tcl_Finalize(void)
* This fixes the Tcl Bug #990552.
*/
- TclFinalizeThreadData();
+ TclFinalizeThreadData(/* quick */ 0);
/*
* Now we can free constants for conversions to/from double.
@@ -1271,6 +1270,13 @@ Tcl_Finalize(void)
void
Tcl_FinalizeThread(void)
{
+ FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+ int quick)
+{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
@@ -1311,8 +1317,7 @@ Tcl_FinalizeThread(void)
*
* Fix [Bug #571002]
*/
-
- TclFinalizeThreadData();
+ TclFinalizeThreadData(quick);
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d066476..d4077f5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,11 +19,9 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"
+#include "tclStringRep.h"
#include <math.h>
-
-#if NRE_ENABLE_ASSERTS
#include <assert.h>
-#endif
/*
* Hack to determine whether we may expect IEEE floating point. The hack is
@@ -81,9 +79,7 @@ int tclTraceExec = 0;
static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
- "+", "-", "*", "/", "%", "+", "-", "~", "!",
- "BUILTIN FUNCTION", "FUNCTION",
- "", "", "", "", "", "", "", "", "eq", "ne"
+ "+", "-", "*", "/", "%", "+", "-", "~", "!"
};
/*
@@ -174,29 +170,24 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
typedef struct TEBCdata {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
- const unsigned char *pc; /* These fields are used on return TO this */
- ptrdiff_t *catchTop; /* this level: they record the state when a */
- int cleanup; /* new codePtr was received for NR */
- Tcl_Obj *auxObjList; /* execution. */
- int checkInterp;
- CmdFrame cmdFrame;
+ ptrdiff_t *catchTop; /* These fields are used on return TO this */
+ Tcl_Obj *auxObjList; /* this level: they record the state when a */
+ CmdFrame cmdFrame; /* new codePtr was received for NR */
+ /* execution. */
void *stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
} TEBCdata;
#define TEBC_YIELD() \
- do { \
- esPtr->tosPtr = tosPtr; \
- TD->pc = pc; \
- TD->cleanup = cleanup; \
- TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+ do { \
+ esPtr->tosPtr = tosPtr; \
+ TclNRAddCallback(interp, TEBCresume, \
+ TD, pc, INT2PTR(cleanup), NULL); \
} while (0)
#define TEBC_DATA_DIG() \
do { \
- pc = TD->pc; \
- cleanup = TD->cleanup; \
tosPtr = esPtr->tosPtr; \
} while (0)
@@ -205,14 +196,14 @@ typedef struct TEBCdata {
if (auxObjList) { \
objPtr->length += auxObjList->length; \
} \
- objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \
+ objPtr->internalRep.twoPtrValue.ptr1 = auxObjList; \
auxObjList = objPtr; \
} while (0)
#define POP_TAUX_OBJ() \
do { \
tmpPtr = auxObjList; \
- auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr; \
+ auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1; \
Tcl_DecrRefCount(tmpPtr); \
} while (0)
@@ -293,12 +284,14 @@ VarHashCreateVar(
switch (nCleanup) { \
case 1: goto cleanup1_pushObjResultPtr; \
case 2: goto cleanup2_pushObjResultPtr; \
+ case 0: break; \
} \
} else { \
pc += (pcAdjustment); \
switch (nCleanup) { \
case 1: goto cleanup1; \
case 2: goto cleanup2; \
+ case 0: break; \
} \
} \
} while (0)
@@ -318,6 +311,70 @@ VarHashCreateVar(
} \
} while (0)
+#ifndef TCL_COMPILE_DEBUG
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F(0, (cleanup), 1); \
+ } \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V(0, (cleanup), 1); \
+ } \
+ } while (0)
+#else /* TCL_COMPILE_DEBUG */
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#endif
+
/*
* Macros used to cache often-referenced Tcl evaluation stack information
* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
@@ -360,6 +417,8 @@ VarHashCreateVar(
#define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr))
+#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
+
/*
* Macros used to trace instruction execution. The macros TRACE,
* TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
@@ -381,6 +440,8 @@ VarHashCreateVar(
printf a; \
break; \
}
+# define TRACE_ERROR(interp) \
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
# define TRACE_WITH_OBJ(a, objPtr) \
while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
@@ -397,6 +458,7 @@ VarHashCreateVar(
#else /* !TCL_COMPILE_DEBUG */
# define TRACE(a)
# define TRACE_APPEND(a)
+# define TRACE_ERROR(interp)
# define TRACE_WITH_OBJ(a, objPtr)
# define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */
@@ -451,7 +513,7 @@ VarHashCreateVar(
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
- ? TCL_ERROR : \
+ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -471,7 +533,7 @@ VarHashCreateVar(
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
- ? TCL_ERROR : \
+ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */
@@ -490,30 +552,6 @@ VarHashCreateVar(
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- * Tcl_WideInt *wideIntPtr);
- */
-
-#ifdef TCL_WIDE_INT_IS_LONG
-#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? (*(wideIntPtr) = (Tcl_WideInt) \
- ((objPtr)->internalRep.longValue), TCL_OK) : \
- Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#else /* !TCL_WIDE_INT_IS_LONG */
-#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
- (((objPtr)->typePtr == &tclWideIntType) \
- ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
- ((objPtr)->typePtr == &tclIntType) \
- ? (*(wideIntPtr) = (Tcl_WideInt) \
- ((objPtr)->internalRep.longValue), TCL_OK) : \
- Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#endif /* TCL_WIDE_INT_IS_LONG */
-
-/*
* Macro used to make the check for type overflow more mnemonic. This works by
* comparing sign bits; the rest of the word is irrelevant. The ANSI C
* "prototype" (where inttype_t is any integer type) is:
@@ -718,7 +756,7 @@ static Tcl_Obj * ExecuteExtendedUnaryMathOp(int opcode,
Tcl_Obj *valuePtr);
static void FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
- int catchOnly, ByteCode *codePtr);
+ int searchMode, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
ByteCode *codePtr, int *lengthPtr,
const unsigned char **pcBeg, int *cmdIdxPtr);
@@ -734,7 +772,8 @@ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
-
+static Tcl_NRPostProc FinalizeOONext;
+static Tcl_NRPostProc FinalizeOONextFilter;
static Tcl_NRPostProc TEBCresume;
/*
@@ -885,11 +924,10 @@ TclCreateExecEnv(
esPtr->nextPtr = NULL;
esPtr->markerPtr = NULL;
esPtr->endPtr = &esPtr->stackWords[size-1];
- esPtr->tosPtr = &esPtr->stackWords[-1];
+ esPtr->tosPtr = STACK_BASE(esPtr);
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
- TclInitAuxDataTypeTable();
InitByteCodeExecution(interp);
execInitialized = 1;
}
@@ -988,7 +1026,6 @@ TclFinalizeExecution(void)
Tcl_MutexLock(&execMutex);
execInitialized = 0;
Tcl_MutexUnlock(&execMutex);
- TclFinalizeAuxDataTypeTable();
}
/*
@@ -1097,7 +1134,7 @@ GrowEvaluationStack(
}
needed = growth + moveWords + WALLOCALIGN;
-
+
/*
* Check if there is enough room in the next stack (if there is one, it
* should be both empty and the last one!)
@@ -1106,8 +1143,8 @@ GrowEvaluationStack(
if (esPtr->nextPtr) {
oldPtr = esPtr;
esPtr = oldPtr->nextPtr;
- currElems = esPtr->endPtr - &esPtr->stackWords[-1];
- if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
+ if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) {
Tcl_Panic("STACK: Stack after current is in use");
}
if (esPtr->nextPtr) {
@@ -1119,7 +1156,7 @@ GrowEvaluationStack(
DeleteExecStack(esPtr);
esPtr = oldPtr;
} else {
- currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
}
/*
@@ -1135,7 +1172,7 @@ GrowEvaluationStack(
#else
newElems = needed;
#endif
-
+
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
oldPtr = esPtr;
@@ -1273,10 +1310,10 @@ TclStackFree(
while (esPtr->nextPtr) {
esPtr = esPtr->nextPtr;
}
- esPtr->tosPtr = &esPtr->stackWords[-1];
+ esPtr->tosPtr = STACK_BASE(esPtr);
while (esPtr->prevPtr) {
ExecStack *tmpPtr = esPtr->prevPtr;
- if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
+ if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) {
DeleteExecStack(tmpPtr);
} else {
break;
@@ -1608,8 +1645,7 @@ FreeExprCodeInternalRep(
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1930,6 +1966,41 @@ TclIncrObj(
/*
*----------------------------------------------------------------------
*
+ * ArgumentBCEnter --
+ *
+ * This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
+ * a code sequence that is fairly common in the code but *not* commonly
+ * called.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May register information about the bytecode in the command frame.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArgumentBCEnter(
+ Tcl_Interp *interp,
+ ByteCode *codePtr,
+ TEBCdata *tdPtr,
+ const unsigned char *pc,
+ int objc,
+ Tcl_Obj **objv)
+{
+ int cmd;
+
+ if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+ TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
+ pc - codePtr->codeStart);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclNRExecuteByteCode --
*
* This procedure executes the instructions of a ByteCode structure. It
@@ -1962,10 +2033,6 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- if (iPtr->execEnvPtr->rewind) {
- return TCL_ERROR;
- }
-
codePtr->refCount++;
/*
@@ -1984,11 +2051,8 @@ TclNRExecuteByteCode(
esPtr->tosPtr = initTosPtr;
TD->codePtr = codePtr;
- TD->pc = codePtr->codeStart;
TD->catchTop = initCatchTop;
- TD->cleanup = 0;
TD->auxObjList = NULL;
- TD->checkInterp = 0;
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
@@ -2017,8 +2081,8 @@ TclNRExecuteByteCode(
* Push the callback for bytecode execution
*/
- TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
- NULL, NULL);
+ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
+ /* cleanup */ INT2PTR(0), NULL);
return TCL_OK;
}
@@ -2074,9 +2138,6 @@ TEBCresume(
#define auxObjList (TD->auxObjList)
#define catchTop (TD->catchTop)
#define codePtr (TD->codePtr)
-#define checkInterp (TD->checkInterp)
- /* Indicates when a check of interp readyness is
- * necessary. Set by CACHE_STACK_INFO() */
/*
* Globals: variables that store state, must remain valid at all times.
@@ -2084,16 +2145,19 @@ TEBCresume(
Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
* stack. */
- const unsigned char *pc; /* The current program counter. */
+ const unsigned char *pc = data[1];
+ /* The current program counter. */
unsigned char inst; /* The currently running instruction */
-
+
/*
* Transfer variables - needed only between opcodes, but not while
* executing an instruction.
*/
- int cleanup = 0;
+ int cleanup = PTR2INT(data[2]);
Tcl_Obj *objResultPtr;
+ int checkInterp; /* Indicates when a check of interp readyness
+ * is necessary. Set by CACHE_STACK_INFO() */
/*
* Locals - variables that are used within opcodes or bounded sections of
@@ -2118,17 +2182,22 @@ TEBCresume(
TEBC_DATA_DIG();
#ifdef TCL_COMPILE_DEBUG
- if (!data[1] && (tclTraceExec >= 2)) {
+ if (!pc && (tclTraceExec >= 2)) {
PrintByteCodeInfo(codePtr);
fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
fflush(stdout);
}
#endif
- if (data[1] /* resume from invocation */) {
- if (iPtr->execEnvPtr->rewind) {
- result = TCL_ERROR;
- }
+ if (!pc) {
+ /* bytecode is starting from scratch */
+ checkInterp = 0;
+ pc = codePtr->codeStart;
+ goto cleanup0;
+ } else {
+ /* resume from invocation */
+ CACHE_STACK_INFO();
+
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
if (bcFramePtr->cmdObj) {
Tcl_DecrRefCount(bcFramePtr->cmdObj);
@@ -2137,68 +2206,53 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+ TclArgumentBCRelease(interp, bcFramePtr);
+ }
+ if (iPtr->execEnvPtr->rewind) {
+ result = TCL_ERROR;
+ goto abnormalReturn;
}
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
}
- CACHE_STACK_INFO();
- if (result == TCL_OK) {
- /*
- * Push the call's object result and continue execution with the
- * next instruction.
- */
-
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
- /*
- * Reset the interp's result to avoid possible duplications of
- * large objects [Bug 781585]. We do not call Tcl_ResetResult to
- * avoid any side effects caused by the resetting of errorInfo and
- * errorCode [Bug 804681], which are not needed here. We chose
- * instead to manipulate the interp's object result directly.
- *
- * Note that the result object is now in objResultPtr, it keeps
- * the refCount it had in its role of iPtr->objResultPtr.
- */
-
- objResultPtr = Tcl_GetObjResult(interp);
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
-#ifndef TCL_COMPILE_DEBUG
- if (*pc == INST_POP) {
- TclDecrRefCount(objResultPtr);
- NEXT_INST_V(1, cleanup, 0);
- }
-#endif
- NEXT_INST_V(0, cleanup, -1);
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
}
/*
- * Result not TCL_OK: fall through
+ * Push the call's object result and continue execution with the next
+ * instruction.
*/
- }
- if (iPtr->execEnvPtr->rewind) {
- result = TCL_ERROR;
- goto abnormalReturn;
- }
-
- if (result != TCL_OK) {
- pc--;
- goto processExceptionReturn;
- }
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
- /*
- * Loop executing instructions until a "done" instruction, a TCL_RETURN,
- * or some error.
- */
+ /*
+ * Reset the interp's result to avoid possible duplications of large
+ * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
+ * side effects caused by the resetting of errorInfo and errorCode
+ * [Bug 804681], which are not needed here. We chose instead to
+ * manipulate the interp's object result directly.
+ *
+ * Note that the result object is now in objResultPtr, it keeps the
+ * refCount it had in its role of iPtr->objResultPtr.
+ */
- goto cleanup0;
+ objResultPtr = Tcl_GetObjResult(interp);
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+#ifndef TCL_COMPILE_DEBUG
+ if (*pc == INST_POP) {
+ TclDecrRefCount(objResultPtr);
+ NEXT_INST_V(1, cleanup, 0);
+ }
+#endif
+ NEXT_INST_V(0, cleanup, -1);
+ }
/*
* Targets for standard instruction endings; unrolled for speed in the
@@ -2299,7 +2353,7 @@ TEBCresume(
*/
inst = *pc;
-
+
peepholeStart:
#ifdef TCL_COMPILE_STATS
iPtr->stats.instructionCount[*pc]++;
@@ -2319,7 +2373,7 @@ TEBCresume(
#endif /* TCL_COMPILE_DEBUG */
TCL_DTRACE_INST_NEXT();
-
+
if (inst == INST_LOAD_SCALAR1) {
goto instLoadScalar1;
} else if (inst == INST_PUSH1) {
@@ -2331,7 +2385,7 @@ TEBCresume(
/*
* Peephole: do not run INST_START_CMD, just skip it
*/
-
+
iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
if (checkInterp) {
checkInterp = 0;
@@ -2352,7 +2406,7 @@ TEBCresume(
}
goto peepholeStart;
}
-
+
switch (inst) {
case INST_SYNTAX:
case INST_RETURN_IMM: {
@@ -2409,48 +2463,109 @@ TEBCresume(
TRACE_APPEND(("\n"));
goto processExceptionReturn;
- case INST_YIELD: {
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ {
+ CoroutineData *corPtr;
+ int yieldParameter;
+ case INST_YIELD:
+ corPtr = iPtr->execEnvPtr->corPtr;
TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
if (!corPtr) {
TRACE_APPEND(("ERROR: yield outside coroutine\n"));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"yield can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
- TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
- if (traceInstructions) {
- fprintf(stdout, "\n");
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE_APPEND(("YIELD...\n"));
+ } else {
+ fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(OBJ_AT_TOS));
+ }
+ fflush(stdout);
+ }
+#endif
+ yieldParameter = 0;
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+ goto doYield;
+
+ case INST_YIELD_TO_INVOKE:
+ corPtr = iPtr->execEnvPtr->corPtr;
+ valuePtr = OBJ_AT_TOS;
+ if (!corPtr) {
+ TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+ TRACE(("[%.30s] => ERROR: yield in deleted\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
+ } else {
+ /* FIXME: What is the right thing to trace? */
+ fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(valuePtr));
+ }
+ fflush(stdout);
}
#endif
+
+ /*
+ * Install a tailcall record in the caller and continue with the
+ * yield. The yield is switched into multi-return mode (via the
+ * 'yieldParameter').
+ */
+
+ Tcl_IncrRefCount(valuePtr);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ TclSetTailcall(interp, valuePtr);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
+
+ doYield:
/* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
-
+
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
- }
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
pc++;
cleanup = 1;
TEBC_YIELD();
-
- Tcl_SetObjResult(interp, OBJ_AT_TOS);
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- INT2PTR(0), NULL, NULL);
-
+ INT2PTR(yieldParameter), NULL, NULL);
return TCL_OK;
}
@@ -2463,11 +2578,14 @@ TEBCresume(
TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc or lambda", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
+ /* FIXME: What is the right thing to trace? */
{
register int i;
@@ -2541,7 +2659,7 @@ TEBCresume(
case INST_OVER:
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = OBJ_AT_DEPTH(opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_F(5, 0, 1);
case INST_REVERSE: {
@@ -2556,10 +2674,11 @@ TEBCresume(
*b = tmpPtr;
a++; b--;
}
+ TRACE(("%u => OK\n", opnd));
NEXT_INST_F(5, 0, 0);
}
- case INST_CONCAT1: {
+ case INST_STR_CONCAT1: {
int appendLen = 0;
char *bytes, *p;
Tcl_Obj **currPtr;
@@ -2708,6 +2827,17 @@ TEBCresume(
NEXT_INST_V(2, opnd, 1);
}
+ case INST_CONCAT_STK:
+ /*
+ * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+ * and then decrement their ref counts.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+
case INST_EXPAND_START:
/*
* Push an element to the auxObjList. This records the current
@@ -2723,9 +2853,10 @@ TEBCresume(
*/
TclNewObj(objPtr);
- objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
+ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
objPtr->length = 0;
PUSH_TAUX_OBJ(objPtr);
+ TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
case INST_EXPAND_DROP:
@@ -2736,12 +2867,13 @@ TEBCresume(
*/
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
/* Ugly abuse! */
starting = 1;
#endif
+ TRACE(("=> drop %d items\n", objc));
NEXT_INST_V(1, objc, 0);
case INST_EXPAND_STKTOP: {
@@ -2755,9 +2887,9 @@ TEBCresume(
*/
objPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
(void) POP_OBJECT();
@@ -2784,7 +2916,6 @@ TEBCresume(
* stack-allocated parameter, update the stack pointers.
*/
- esPtr = iPtr->execEnvPtr->execStackPtr;
TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
catchTop += moved;
@@ -2801,6 +2932,7 @@ TEBCresume(
PUSH_OBJECT(objv[i]);
}
+ TRACE_APPEND(("OK\n"));
Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
@@ -2835,7 +2967,7 @@ TEBCresume(
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
POP_TAUX_OBJ();
if (objc) {
pcAdjustment = 1;
@@ -2893,11 +3025,7 @@ TEBCresume(
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
- }
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
DECACHE_STACK_INFO();
@@ -3042,11 +3170,7 @@ TEBCresume(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
- }
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = opnd;
@@ -3055,8 +3179,8 @@ TEBCresume(
pc += 6;
TEBC_YIELD();
+ TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
- TclSkipTailcall(interp);
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
/*
@@ -3145,7 +3269,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
cleanup = 1;
@@ -3171,7 +3295,7 @@ TEBCresume(
TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
&arrayPtr);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -3198,7 +3322,7 @@ TEBCresume(
part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (!objResultPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -3215,7 +3339,7 @@ TEBCresume(
*/
{
- int storeFlags;
+ int storeFlags, len;
case INST_STORE_ARRAY4:
opnd = TclGetUInt4AtPtr(pc+1);
@@ -3347,7 +3471,7 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
cleanup = ((part2Ptr == NULL)? 2 : 3);
@@ -3397,7 +3521,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
goto doCallPtrSetVar;
@@ -3445,7 +3569,7 @@ TEBCresume(
part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
CACHE_STACK_INFO();
if (!objResultPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
#ifndef TCL_COMPILE_DEBUG
@@ -3455,6 +3579,171 @@ TEBCresume(
#endif
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+ case INST_LAPPEND_LIST:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
+ cleanup = 1;
+ pcAdjustment = 5;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclIsVarDirectReadable(varPtr)
+ && TclIsVarDirectWritable(varPtr)) {
+ goto lappendListDirect;
+ }
+ arrayPtr = NULL;
+ part1Ptr = part2Ptr = NULL;
+ goto lappendListPtr;
+
+ case INST_LAPPEND_LIST_ARRAY:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ part1Ptr = NULL;
+ part2Ptr = OBJ_UNDER_TOS;
+ arrayPtr = LOCAL(opnd);
+ cleanup = 2;
+ pcAdjustment = 5;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" \"%.30s\" => ",
+ opnd, O2S(part2Ptr), O2S(valuePtr)));
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)
+ && !WriteTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (varPtr && TclIsVarDirectReadable(varPtr)
+ && TclIsVarDirectWritable(varPtr)) {
+ goto lappendListDirect;
+ }
+ }
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+ if (varPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ goto lappendListPtr;
+
+ case INST_LAPPEND_LIST_ARRAY_STK:
+ pcAdjustment = 1;
+ cleanup = 3;
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = OBJ_UNDER_TOS; /* element name */
+ part1Ptr = OBJ_AT_DEPTH(2); /* array name */
+ TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ",
+ O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
+ goto lappendList;
+
+ case INST_LAPPEND_LIST_STK:
+ pcAdjustment = 1;
+ cleanup = 2;
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = NULL;
+ part1Ptr = OBJ_UNDER_TOS; /* variable name */
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr)));
+ goto lappendList;
+
+ lappendListDirect:
+ objResultPtr = varPtr->value.objPtr;
+ if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (Tcl_IsShared(objResultPtr)) {
+ Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
+
+ TclDecrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr = newValue;
+ Tcl_IncrRefCount(newValue);
+ }
+ if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+ lappendList:
+ opnd = -1;
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ DECACHE_STACK_INFO();
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+ CACHE_STACK_INFO();
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ lappendListPtr:
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)++;
+ }
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+ part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
+ CACHE_STACK_INFO();
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)--;
+ }
+
+ {
+ int createdNewObj = 0;
+
+ if (!objResultPtr) {
+ objResultPtr = valuePtr;
+ } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ } else {
+ if (Tcl_IsShared(objResultPtr)) {
+ objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ createdNewObj = 1;
+ }
+ if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
+ != TCL_OK) {
+ goto errorInLappendListPtr;
+ }
+ }
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+ part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);
+ CACHE_STACK_INFO();
+ if (!objResultPtr) {
+ errorInLappendListPtr:
+ if (createdNewObj) {
+ TclDecrRefCount(objResultPtr);
+ }
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
}
/*
@@ -3520,9 +3809,11 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
if (!varPtr) {
+ DECACHE_STACK_INFO();
Tcl_AddErrorInfo(interp,
"\n (reading value of variable to increment)");
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
}
@@ -3548,7 +3839,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
}
@@ -3660,8 +3951,7 @@ TEBCresume(
TclNewLongObj(incrPtr, increment);
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DecrRefCount(incrPtr);
@@ -3698,8 +3988,7 @@ TEBCresume(
}
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DecrRefCount(incrPtr);
@@ -3710,8 +3999,7 @@ TEBCresume(
CACHE_STACK_INFO();
Tcl_DecrRefCount(incrPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -3732,6 +4020,8 @@ TEBCresume(
*/
case INST_EXIST_SCALAR:
+ cleanup = 0;
+ pcAdjustment = 5;
opnd = TclGetUInt4AtPtr(pc+1);
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
@@ -3748,16 +4038,11 @@ TEBCresume(
varPtr = NULL;
}
}
-
- /*
- * Tricky! Arrays always exist.
- */
-
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 0, 1);
+ goto afterExistsPeephole;
case INST_EXIST_ARRAY:
+ cleanup = 1;
+ pcAdjustment = 5;
opnd = TclGetUInt4AtPtr(pc+1);
part2Ptr = OBJ_AT_TOS;
arrayPtr = LOCAL(opnd);
@@ -3768,7 +4053,7 @@ TEBCresume(
if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
if (!varPtr || !ReadTraced(varPtr)) {
- goto doneExistArray;
+ goto afterExistsPeephole;
}
}
varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
@@ -3785,13 +4070,11 @@ TEBCresume(
varPtr = NULL;
}
}
- doneExistArray:
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 1, 1);
+ goto afterExistsPeephole;
case INST_EXIST_ARRAY_STK:
cleanup = 2;
+ pcAdjustment = 1;
part2Ptr = OBJ_AT_TOS; /* element name */
part1Ptr = OBJ_UNDER_TOS; /* array name */
TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
@@ -3799,6 +4082,7 @@ TEBCresume(
case INST_EXIST_STK:
cleanup = 1;
+ pcAdjustment = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
@@ -3818,9 +4102,17 @@ TEBCresume(
varPtr = NULL;
}
}
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(1, cleanup, 1);
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
+ */
+
+ afterExistsPeephole: {
+ int found = (varPtr && !TclIsVarUndefined(varPtr));
+
+ TRACE_APPEND(("%d\n", found ? 1 : 0));
+ JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
+ }
/*
* End of INST_EXIST instructions.
@@ -3838,7 +4130,7 @@ TEBCresume(
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
+ TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
/*
* No errors, no traces, no searches: just make the variable cease
@@ -3851,6 +4143,7 @@ TEBCresume(
goto slowUnsetScalar;
}
varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 0, 0);
}
@@ -3871,7 +4164,7 @@ TEBCresume(
while (TclIsVarLink(arrayPtr)) {
arrayPtr = arrayPtr->value.linkPtr;
}
- TRACE(("%s %u \"%.30s\"\n",
+ TRACE(("%s %u \"%.30s\" => ",
(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
@@ -3883,16 +4176,20 @@ TEBCresume(
if (!TclIsVarUndefined(varPtr)) {
TclDecrRefCount(varPtr->value.objPtr);
+ TclSetVarUndefined(varPtr);
+ TclClearVarNamespaceVar(varPtr);
+ TclCleanupVar(varPtr, arrayPtr);
} else if (flags & TCL_LEAVE_ERR_MSG) {
goto slowUnsetArray;
}
- varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 1, 0);
} else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
/*
* Don't need to do anything here.
*/
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 1, 0);
}
}
@@ -3916,7 +4213,7 @@ TEBCresume(
cleanup = 2;
part2Ptr = OBJ_AT_TOS; /* element name */
part1Ptr = OBJ_UNDER_TOS; /* array name */
- TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
+ TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
O2S(part1Ptr), O2S(part2Ptr)));
goto doUnsetStk;
@@ -3925,7 +4222,8 @@ TEBCresume(
cleanup = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
- TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
+ TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
+ O2S(part1Ptr)));
doUnsetStk:
DECACHE_STACK_INFO();
@@ -3934,11 +4232,12 @@ TEBCresume(
goto errorInUnset;
}
CACHE_STACK_INFO();
+ TRACE_APPEND(("OK\n"));
NEXT_INST_V(2, cleanup, 0);
errorInUnset:
CACHE_STACK_INFO();
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
/*
@@ -3947,7 +4246,7 @@ TEBCresume(
case INST_DICT_DONE:
opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u\n", opnd));
+ TRACE(("%u => OK\n", opnd));
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
@@ -4000,8 +4299,7 @@ TEBCresume(
TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
CACHE_STACK_INFO();
if (result == TCL_ERROR) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -4034,7 +4332,7 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
doArrayMake:
@@ -4046,9 +4344,10 @@ TEBCresume(
TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
"variable isn't array", opnd);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
- TRACE_APPEND(("ERROR: bad array ref: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
goto gotError;
}
TclSetVarArray(varPtr);
@@ -4076,9 +4375,11 @@ TEBCresume(
Namespace *savedNsPtr;
case INST_UPVAR:
- TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4093,13 +4394,16 @@ TEBCresume(
/*createPart2*/ 1, &varPtr);
iPtr->varFramePtr = savedFramePtr;
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
goto doLinkVars;
case INST_NSUPVAR:
- TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4114,16 +4418,18 @@ TEBCresume(
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
goto doLinkVars;
case INST_VARIABLE:
- TRACE(("variable "));
+ TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4141,7 +4447,7 @@ TEBCresume(
* if there are no errors; otherwise, let it handle the case.
*/
- opnd = TclGetInt4AtPtr(pc+1);;
+ opnd = TclGetInt4AtPtr(pc+1);
varPtr = LOCAL(opnd);
if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
@@ -4153,6 +4459,7 @@ TEBCresume(
Var *linkPtr = varPtr->value.linkPtr;
if (linkPtr == otherPtr) {
+ TRACE_APPEND(("already linked\n"));
NEXT_INST_F(5, 1, 0);
}
if (TclIsVarInHash(linkPtr)) {
@@ -4169,6 +4476,7 @@ TEBCresume(
}
} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
opnd) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4177,6 +4485,7 @@ TEBCresume(
* variables - and [variable] did not push it at all.
*/
+ TRACE_APPEND(("link made\n"));
NEXT_INST_F(5, 1, 0);
}
@@ -4223,31 +4532,29 @@ TEBCresume(
doCondJump:
valuePtr = OBJ_AT_TOS;
+ TRACE(("%d => ", jmpOffset[
+ (*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
/* TODO - check claim that taking address of b harms performance */
/* TODO - consider optimization search for constants */
if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
- TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
- ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
- ? 0 : 1]), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
if (b) {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1],
- O2S(valuePtr),
+ TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
} else {
- TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
}
} else {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
} else {
- TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
- O2S(valuePtr),
+ TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
}
}
@@ -4266,7 +4573,7 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
- TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS)));
+ TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
if (hPtr != NULL) {
int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
@@ -4361,13 +4668,11 @@ TEBCresume(
register CallFrame *framePtr = iPtr->varFramePtr;
register CallFrame *rootFramePtr = iPtr->rootFramePtr;
- valuePtr = OBJ_AT_TOS;
- if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
- TRACE(("%d => ", level));
if (level <= 0) {
level += framePtr->level;
}
@@ -4376,38 +4681,76 @@ TEBCresume(
/* Empty loop body */
}
if (framePtr == rootFramePtr) {
- Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr),
- "\"", NULL);
- TRACE_APPEND(("ERROR: bad level\n"));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
+ TRACE_ERROR(interp);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
- TclGetString(valuePtr), NULL);
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
- case INST_RESOLVE_COMMAND: {
- Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+ {
+ Tcl_Command cmd, origCmd;
+ case INST_RESOLVE_COMMAND:
+ cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
TclNewObj(objResultPtr);
if (cmd != NULL) {
Tcl_GetCommandFullName(interp, cmd, objResultPtr);
}
TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
NEXT_INST_F(1, 1, 1);
+
+ case INST_ORIGIN_COMMAND:
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+ if (cmd == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("ERROR: not command\n"));
+ goto gotError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+ TclNewObj(objResultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+ TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
+ NEXT_INST_F(1, 1, 1);
}
- case INST_TCLOO_SELF: {
- CallFrame *framePtr = iPtr->varFramePtr;
+
+ /*
+ * -----------------------------------------------------------------
+ * Start of TclOO support instructions.
+ */
+
+ {
+ Object *oPtr;
+ CallFrame *framePtr;
CallContext *contextPtr;
+ int skip, newDepth;
+ case INST_TCLOO_SELF:
+ framePtr = iPtr->varFramePtr;
if (framePtr == NULL ||
!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
TRACE(("=> ERROR: no TclOO call context\n"));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"self may only be called from inside a method",
-1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
contextPtr = framePtr->clientData;
@@ -4419,9 +4762,213 @@ TEBCresume(
objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
- }
- {
- Object *oPtr;
+
+ case INST_TCLOO_NEXT_CLASS:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ framePtr = iPtr->varFramePtr;
+ valuePtr = OBJ_AT_DEPTH(opnd - 2);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ skip = 2;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "nextto may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
+ if (oPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
+ goto gotError;
+ } else {
+ Class *classPtr = oPtr->classPtr;
+ struct MInvoke *miPtr;
+ int i;
+ const char *methodType;
+
+ if (classPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (!miPtr->isFilter &&
+ miPtr->mPtr->declaringClassPtr == classPtr) {
+ newDepth = i;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels,
+ (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ goto doInvokeNext;
+ }
+ }
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
+ O2S(valuePtr)));
+ for (i=contextPtr->index ; i>=0 ; i--) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (miPtr->isFilter
+ || miPtr->mPtr->declaringClassPtr != classPtr) {
+ continue;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ case INST_TCLOO_NEXT:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ framePtr = iPtr->varFramePtr;
+ skip = 1;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "next may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ newDepth = contextPtr->index + 1;
+ if (newDepth >= contextPtr->callPtr->numChain) {
+ /*
+ * We're at the end of the chain; generate an error message unless
+ * the interpreter is being torn down, in which case we might be
+ * getting here because of methods/destructors doing a [next] (or
+ * equivalent) unexpectedly.
+ */
+
+ const char *methodType;
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ TRACE_APPEND(("ERROR: no TclOO next impl\n"));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+#ifdef TCL_COMPILE_DEBUG
+ } else if (tclTraceExec >= 2) {
+ int i;
+
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+#endif /*TCL_COMPILE_DEBUG*/
+ }
+
+ doInvokeNext:
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
+ }
+
+ pcAdjustment = 2;
+ cleanup = opnd;
+ DECACHE_STACK_INFO();
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ pc += pcAdjustment;
+ TEBC_YIELD();
+
+ TclPushTailcallPoint(interp);
+ oPtr = contextPtr->oPtr;
+ if (oPtr->flags & FILTER_HANDLING) {
+ TclNRAddCallback(interp, FinalizeOONextFilter,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
+ } else {
+ TclNRAddCallback(interp, FinalizeOONext,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
+ }
+ contextPtr->skip = skip;
+ contextPtr->index = newDepth;
+ if (contextPtr->callPtr->chain[newDepth].isFilter
+ || contextPtr->callPtr->flags & FILTER_HANDLING) {
+ oPtr->flags |= FILTER_HANDLING;
+ } else {
+ oPtr->flags &= ~FILTER_HANDLING;
+ }
+
+ {
+ register Method *const mPtr =
+ contextPtr->callPtr->chain[newDepth].mPtr;
+
+ return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, opnd, objv);
+ }
case INST_TCLOO_IS_OBJECT:
oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
@@ -4455,6 +5002,7 @@ TEBCresume(
}
/*
+ * End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
@@ -4476,19 +5024,19 @@ TEBCresume(
NEXT_INST_V(5, opnd, 1);
case INST_LIST_LENGTH:
- valuePtr = OBJ_AT_TOS;
- if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE_APPEND(("%d\n", length));
NEXT_INST_F(1, 1, 1);
case INST_LIST_INDEX: /* lindex with objc == 3 */
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Extract the desired list element.
@@ -4506,8 +5054,7 @@ TEBCresume(
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
- O2S(value2Ptr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4515,8 +5062,7 @@ TEBCresume(
* Stash the list element on the stack.
*/
- TRACE(("%.20s %.20s => %s\n",
- O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1); /* Already has the correct refCount */
case INST_LIST_INDEX_IMM: /* lindex with objc==3 and index in bytecode
@@ -4528,6 +5074,7 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
opnd = TclGetInt4AtPtr(pc+1);
+ TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
/*
* Get the contents of the list, making sure that it really is a list
@@ -4535,8 +5082,7 @@ TEBCresume(
*/
if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4559,8 +5105,7 @@ TEBCresume(
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
- objResultPtr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(pcAdjustment, 1, 1);
case INST_LIST_INDEX_MULTI: /* 'lindex' with multiple index args */
@@ -4575,10 +5120,11 @@ TEBCresume(
* Do the 'lindex' operation.
*/
+ TRACE(("%d => ", opnd));
objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
numIndices, &OBJ_AT_DEPTH(numIndices - 1));
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4586,7 +5132,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, opnd, -1);
case INST_LSET_FLAT:
@@ -4596,6 +5142,7 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc + 1);
numIndices = opnd - 2;
+ TRACE(("%d => ", opnd));
/*
* Get the old value of variable, and remove the stack ref. This is
@@ -4614,7 +5161,7 @@ TEBCresume(
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4622,7 +5169,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, numIndices+1, -1);
case INST_LSET_LIST: /* 'lset' with 4 args */
@@ -4642,6 +5189,8 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
value2Ptr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+ O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
/*
* Compute the new variable value.
@@ -4649,8 +5198,7 @@ TEBCresume(
objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4658,7 +5206,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("=> %s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
case INST_LIST_RANGE_IMM: /* lrange with objc==4 and both indices in
@@ -4671,6 +5219,8 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
+ TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
+ TclGetInt4AtPtr(pc+5)));
/*
* Get the contents of the list, making sure that it really is a list
@@ -4678,8 +5228,7 @@ TEBCresume(
*/
if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
- fromIdx, toIdx), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4736,9 +5285,7 @@ TEBCresume(
List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
if (listPtr->refCount == 1) {
- TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
- TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
- for (index=toIdx+1 ; index<objc-1 ; index++) {
+ for (index=toIdx+1; index<objc ; index++) {
TclDecrRefCount(objv[index]);
}
listPtr->elemCount = toIdx+1;
@@ -4753,8 +5300,7 @@ TEBCresume(
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
- TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
+ TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
case INST_LIST_IN:
@@ -4763,9 +5309,9 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
s1 = TclGetStringFromObj(valuePtr, &s1len);
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
- O2S(value2Ptr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
match = 0;
@@ -4796,7 +5342,7 @@ TEBCresume(
match = !match;
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -4804,21 +5350,7 @@ TEBCresume(
* for branching.
*/
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ JUMP_PEEPHOLE_F(match, 1, 2);
case INST_LIST_CONCAT:
value2Ptr = OBJ_AT_TOS;
@@ -4828,7 +5360,7 @@ TEBCresume(
objResultPtr = Tcl_DuplicateObj(valuePtr);
if (Tcl_ListObjAppendList(interp, objResultPtr,
value2Ptr) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(objResultPtr);
goto gotError;
}
@@ -4836,7 +5368,7 @@ TEBCresume(
NEXT_INST_F(1, 2, 1);
} else {
if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
@@ -4875,8 +5407,8 @@ TEBCresume(
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
- } else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ } else if ((valuePtr->typePtr == &tclStringType)
+ && (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -4887,7 +5419,9 @@ TEBCresume(
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
- && (s2len == value2Ptr->length)) {
+ && (valuePtr->bytes != NULL)
+ && (s2len == value2Ptr->length)
+ && (value2Ptr->bytes != NULL)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
@@ -4971,25 +5505,74 @@ TEBCresume(
break;
}
}
- if (match < 0) {
- TclNewIntObj(objResultPtr, -1);
- } else {
- objResultPtr = TCONST(match > 0);
- }
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
- NEXT_INST_F(1, 2, 1);
+
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ (match < 0 ? -1 : match > 0 ? 1 : 0)));
+ JUMP_PEEPHOLE_F(match, 1, 2);
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
length = Tcl_GetCharLength(valuePtr);
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
+ case INST_STR_UPPER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToUpper(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_LOWER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToLower(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToLower(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_TITLE:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToTitle(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
case INST_STR_INDEX:
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Get char length to calulate what 'end' means.
@@ -4997,6 +5580,7 @@ TEBCresume(
length = Tcl_GetCharLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -5004,7 +5588,7 @@ TEBCresume(
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
- Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
+ Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
@@ -5022,18 +5606,18 @@ TEBCresume(
objResultPtr = Tcl_NewStringObj(buf, length);
}
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
+ TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_STR_RANGE:
- TRACE(("\"%.20s\" %s %s =>",
+ TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
&fromIdx) != TCL_OK
|| TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
&toIdx) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -5093,33 +5677,208 @@ TEBCresume(
int length3;
Tcl_Obj *value3Ptr;
+ case INST_STR_REPLACE:
+ value3Ptr = POP_OBJECT();
+ valuePtr = OBJ_AT_DEPTH(2);
+ length = Tcl_GetCharLength(valuePtr) - 1;
+ TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+ &fromIdx) != TCL_OK
+ || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ &toIdx) != TCL_OK) {
+ TclDecrRefCount(value3Ptr);
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TclDecrRefCount(OBJ_AT_TOS);
+ (void) POP_OBJECT();
+ TclDecrRefCount(OBJ_AT_TOS);
+ (void) POP_OBJECT();
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+
+ if (fromIdx > toIdx || fromIdx > length) {
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ TclDecrRefCount(value3Ptr);
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ if (toIdx > length) {
+ toIdx = length;
+ }
+
+ if (fromIdx == 0 && toIdx == length) {
+ TclDecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = value3Ptr;
+ TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ length3 = Tcl_GetCharLength(value3Ptr);
+
+ /*
+ * Remove substring. In-place.
+ */
+
+ if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
+ TclDecrRefCount(value3Ptr);
+ Tcl_SetObjLength(valuePtr, fromIdx);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ /*
+ * See if we can splice in place. This happens when the number of
+ * characters being replaced is the same as the number of characters
+ * in the string to be inserted.
+ */
+
+ if (length3 - 1 == toIdx - fromIdx) {
+ unsigned char *bytes1, *bytes2;
+
+ /*
+ * Flush the info in the string internal rep that refers to the
+ * about-to-be-invalidated UTF-8 rep. This indicates that a new
+ * buffer needs to be allocated, and assumes that the value is
+ * already of tclStringTypePtr type, which should be true provided
+ * we call it after Tcl_GetUnicodeFromObj.
+ */
+#define MarkStringInternalRepForFlush(objPtr) \
+ (GET_STRING(objPtr)->allocated = 0)
+
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_DuplicateObj(valuePtr);
+ if (TclIsPureByteArray(objResultPtr)
+ && TclIsPureByteArray(value3Ptr)) {
+ bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
+ bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+ memcpy(bytes1 + fromIdx, bytes2, length3);
+ } else {
+ ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
+ ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
+ memcpy(ustring1 + fromIdx, ustring2,
+ length3 * sizeof(Tcl_UniChar));
+ MarkStringInternalRepForFlush(objResultPtr);
+ }
+ Tcl_InvalidateStringRep(objResultPtr);
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ if (TclIsPureByteArray(valuePtr)
+ && TclIsPureByteArray(value3Ptr)) {
+ bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL);
+ bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+ memcpy(bytes1 + fromIdx, bytes2, length3);
+ } else {
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
+ ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
+ memcpy(ustring1 + fromIdx, ustring2,
+ length3 * sizeof(Tcl_UniChar));
+ MarkStringInternalRepForFlush(valuePtr);
+ }
+ Tcl_InvalidateStringRep(valuePtr);
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ }
+
+ /*
+ * Get the unicode representation; this is where we guarantee to lose
+ * bytearrays.
+ */
+
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ length--;
+
+ /*
+ * Remove substring using copying.
+ */
+
+ if (length3 == 0) {
+ if (fromIdx > 0) {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ } else {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ /*
+ * Splice string pieces by full copying.
+ */
+
+ if (fromIdx > 0) {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+ Tcl_AppendObjToObj(objResultPtr, value3Ptr);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ } else if (Tcl_IsShared(value3Ptr)) {
+ objResultPtr = Tcl_DuplicateObj(value3Ptr);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ } else {
+ /*
+ * Be careful with splicing the stack in this case; we have a
+ * refCount:1 object in value3Ptr and we want to append to it and
+ * make it be the refCount:1 object at the top of the stack
+ * afterwards. [Bug 82e7f67325]
+ */
+
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+ TclDecrRefCount(valuePtr);
+ OBJ_AT_TOS = value3Ptr; /* Tricky! */
+ NEXT_INST_F(1, 0, 0);
+ }
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+
case INST_STR_MAP:
valuePtr = OBJ_AT_TOS; /* "Main" string. */
value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */
value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */
if (value3Ptr == value2Ptr) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (valuePtr == value2Ptr) {
objResultPtr = value3Ptr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
if (length == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
if (length2 > length || length2 == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (length2 == length) {
if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
objResultPtr = valuePtr;
} else {
objResultPtr = value3Ptr;
}
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
@@ -5148,6 +5907,7 @@ TEBCresume(
Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
+ doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
NEXT_INST_V(1, 3, 1);
@@ -5170,7 +5930,6 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -5194,6 +5953,25 @@ TEBCresume(
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
+
+ case INST_STR_CLASS:
+ opnd = TclGetInt1AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
+ O2S(valuePtr)));
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ match = 1;
+ if (length > 0) {
+ end = ustring1 + length;
+ for (p=ustring1 ; p<end ; p++) {
+ if (!tclStringClassTable[opnd].comparator(*p)) {
+ match = 0;
+ break;
+ }
+ }
+ }
+ TRACE_APPEND(("%d\n", match));
+ JUMP_PEEPHOLE_F(match, 2, 1);
}
case INST_STR_MATCH:
@@ -5236,26 +6014,77 @@ TEBCresume(
* Peep-hole optimisation: if you're about to jump, do jump from here.
*/
- pc += 2;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ JUMP_PEEPHOLE_F(match, 2, 2);
+
+ {
+ const char *string1, *string2;
+ int trim1, trim2;
+
+ case INST_STR_TRIM_LEFT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ trim2 = 0;
+ goto createTrimmedString;
+ case INST_STR_TRIM_RIGHT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ trim1 = 0;
+ goto createTrimmedString;
+ case INST_STR_TRIM:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ if (trim1 < length) {
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ } else {
+ trim2 = 0;
+ }
+ createTrimmedString:
+ /*
+ * Careful here; trim set often contains non-ASCII characters so we
+ * take care when printing. [Bug 971cb4f1db]
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TRACE(("\"%.30s\" ", O2S(valuePtr)));
+ TclPrintObject(stdout, value2Ptr, 30);
+ printf(" => ");
}
#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ if (trim1 == 0 && trim2 == 0) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, valuePtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, objResultPtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 2, 1);
+ }
+ }
case INST_REGEXP:
cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
valuePtr = OBJ_AT_TOS; /* String */
value2Ptr = OBJ_UNDER_TOS; /* Pattern */
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Compile and match the regular expression.
@@ -5266,44 +6095,24 @@ TEBCresume(
Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
if (regExpr == NULL) {
- goto regexpFailure;
+ TRACE_ERROR(interp);
+ goto gotError;
}
-
match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
if (match < 0) {
- regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
- objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
- O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
+ TRACE_ERROR(interp);
goto gotError;
}
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
* Adjustment is 2 due to the nocase byte.
*/
- pc += 2;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ JUMP_PEEPHOLE_F(match, 2, 2);
}
/*
@@ -5317,6 +6126,39 @@ TEBCresume(
int type1, type2;
long l1, l2, lResult;
+ case INST_NUM_TYPE:
+ if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
+ type1 = 0;
+ } else if (type1 == TCL_NUMBER_LONG) {
+ /* value is between LONG_MIN and LONG_MAX */
+ /* [string is integer] is -UINT_MAX to UINT_MAX range */
+ int i;
+
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (type1 == TCL_NUMBER_WIDE) {
+ /* value is between WIDE_MIN and WIDE_MAX */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ int i;
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
+ type1 = TCL_NUMBER_LONG;
+ }
+#endif
+ } else if (type1 == TCL_NUMBER_BIG) {
+ /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ Tcl_WideInt w;
+
+ if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
+ }
+ TclNewIntObj(objResultPtr, type1);
+ TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
+ NEXT_INST_F(1, 1, 1);
+
case INST_EQ:
case INST_NEQ:
case INST_LT:
@@ -5401,21 +6243,9 @@ TEBCresume(
*/
foundResult:
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = TCONST(iResult);
- NEXT_INST_F(0, 2, 1);
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ iResult));
+ JUMP_PEEPHOLE_F(iResult, 1, 2);
}
case INST_MOD:
@@ -5502,13 +6332,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5550,13 +6380,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5573,12 +6403,12 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"integer value too large to represent", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
"integer value too large to represent", NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
int shift = (int) l2;
@@ -5636,8 +6466,7 @@ TEBCresume(
TRACE_APPEND(("DIVIDE BY ZERO\n"));
goto divideByZero;
} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
- TRACE_APPEND(("ERROR: %s\n",
- TclGetString(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
} else if (objResultPtr == NULL) {
TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -5809,8 +6638,7 @@ TEBCresume(
TRACE_APPEND(("EXPONENT OF ZERO\n"));
goto exponOfZero;
} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
- TRACE_APPEND(("ERROR: %s\n",
- TclGetString(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
} else if (objResultPtr == NULL) {
TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -5828,7 +6656,7 @@ TEBCresume(
/* TODO - check claim that taking address of b harms performance */
/* TODO - consider optimization search for constants */
if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+ TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5837,18 +6665,20 @@ TEBCresume(
}
/* TODO: Consider peephole opt. */
objResultPtr = TCONST(!b);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 1, 1);
}
case INST_BITNOT:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
/*
* ... ~$NonInteger => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5859,23 +6689,28 @@ TEBCresume(
l1 = *((const long *) ptr1);
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_UMINUS:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| IsErroringNaNType(type1)) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s \n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5885,23 +6720,28 @@ TEBCresume(
switch (type1) {
case TCL_NUMBER_NAN:
/* -NaN => NaN */
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_LONG:
l1 = *((const long *) ptr1);
if (l1 != LONG_MIN) {
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
/* FALLTHROUGH */
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -5914,6 +6754,7 @@ TEBCresume(
*/
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
if (*pc == INST_UPLUS) {
@@ -5921,7 +6762,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5930,7 +6771,7 @@ TEBCresume(
}
/* ... TryConvertToNumeric($NonNumeric) is acceptable */
- TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+ TRACE_APPEND(("not numeric\n"));
NEXT_INST_F(1, 0, 0);
}
if (IsErroringNaNType(type1)) {
@@ -5939,7 +6780,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5949,8 +6790,7 @@ TEBCresume(
* Numeric conversion of NaN -> error.
*/
- TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(objResultPtr)));
+ TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
DECACHE_STACK_INFO();
TclExprFloatError(interp, *((const double *) ptr1));
CACHE_STACK_INFO();
@@ -5968,7 +6808,7 @@ TEBCresume(
*/
if (valuePtr->bytes == NULL) {
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
if (Tcl_IsShared(valuePtr)) {
@@ -5983,11 +6823,11 @@ TEBCresume(
valuePtr->bytes = NULL;
objResultPtr = Tcl_DuplicateObj(valuePtr);
valuePtr->bytes = savedString;
- TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, new Tcl_Obj\n"));
NEXT_INST_F(1, 1, 1);
}
TclInvalidateStringRep(valuePtr);
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
@@ -5996,6 +6836,17 @@ TEBCresume(
* -----------------------------------------------------------------
*/
+ case INST_TRY_CVT_TO_BOOLEAN:
+ valuePtr = OBJ_AT_TOS;
+ if (valuePtr->typePtr == &tclBooleanType) {
+ objResultPtr = TCONST(1);
+ } else {
+ int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+ objResultPtr = TCONST(result);
+ }
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
case INST_BREAK:
/*
DECACHE_STACK_INFO();
@@ -6004,6 +6855,7 @@ TEBCresume(
*/
result = TCL_BREAK;
cleanup = 0;
+ TRACE(("=> BREAK!\n"));
goto processExceptionReturn;
case INST_CONTINUE:
@@ -6014,6 +6866,7 @@ TEBCresume(
*/
result = TCL_CONTINUE;
cleanup = 0;
+ TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
{
@@ -6025,7 +6878,7 @@ TEBCresume(
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
long i;
- case INST_FOREACH_START4:
+ case INST_FOREACH_START4: /* DEPRECATED */
/*
* Initialize the temporary local var that holds the count of the
* number of iterations of the loop body to -1.
@@ -6058,13 +6911,14 @@ TEBCresume(
NEXT_INST_F(5, 0, 0);
#endif
- case INST_FOREACH_STEP4:
+ case INST_FOREACH_STEP4: /* DEPRECATED */
/*
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
* the next value list element to each loop var.
*/
opnd = TclGetUInt4AtPtr(pc+1);
+ TRACE(("%u => ", opnd));
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
numLists = infoPtr->numLists;
@@ -6091,8 +6945,8 @@ TEBCresume(
listVarPtr = LOCAL(listTmpIndex);
listPtr = listVarPtr->value.objPtr;
if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
- TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
- opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if (listLen > iterNum * numVars) {
@@ -6147,9 +7001,9 @@ TEBCresume(
if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
CACHE_STACK_INFO();
- TRACE_WITH_OBJ((
- "%u => ERROR init. index temp %d: ",
- opnd,varIndex), Tcl_GetObjResult(interp));
+ TRACE_APPEND((
+ "ERROR init. index temp %d: %s\n",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
TclDecrRefCount(listPtr);
goto gotError;
}
@@ -6161,8 +7015,8 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
- iterNum, (continueLoop? "continue" : "exit")));
+ TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
* Run-time peep-hole optimisation: the compiler ALWAYS follows
@@ -6176,6 +7030,200 @@ TEBCresume(
} else {
NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
}
+
+ }
+ {
+ ForeachInfo *infoPtr;
+ Tcl_Obj *listPtr, **elements, *tmpPtr;
+ ForeachVarList *varListPtr;
+ int numLists, iterMax, listLen, numVars;
+ int iterTmp, iterNum, listTmpDepth;
+ int varIndex, valIndex, j;
+ long i;
+
+ case INST_FOREACH_START:
+ /*
+ * Initialize the data for the looping construct, pushing the
+ * corresponding Tcl_Objs to the stack.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
+ numLists = infoPtr->numLists;
+ TRACE(("%u => ", opnd));
+
+ /*
+ * Compute the number of iterations that will be run: iterMax
+ */
+
+ iterMax = 0;
+ listTmpDepth = numLists-1;
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+ listPtr = OBJ_AT_DEPTH(listTmpDepth);
+ if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+ TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ if (Tcl_IsShared(listPtr)) {
+ objPtr = TclListObjCopy(NULL, listPtr);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_DecrRefCount(listPtr);
+ OBJ_AT_DEPTH(listTmpDepth) = objPtr;
+ }
+ iterTmp = (listLen + (numVars - 1))/numVars;
+ if (iterTmp > iterMax) {
+ iterMax = iterTmp;
+ }
+ listTmpDepth--;
+ }
+
+ /*
+ * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
+ * nul-string obj with the pointer stored in the ptrValue so that the
+ * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
+ * it will never leave this scope and is read-only.
+ */
+
+ TclNewObj(tmpPtr);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
+ tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+ PUSH_OBJECT(tmpPtr); /* iterCounts object */
+
+ /*
+ * Store a pointer to the ForeachInfo struct; same dirty trick
+ * as above
+ */
+
+ TclNewObj(tmpPtr);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = infoPtr;
+ PUSH_OBJECT(tmpPtr); /* infoPtr object */
+ TRACE_APPEND(("jump to loop step\n"));
+
+ /*
+ * Jump directly to the INST_FOREACH_STEP instruction; the C code just
+ * falls through.
+ */
+
+ pc += 5 - infoPtr->loopCtTemp;
+
+ case INST_FOREACH_STEP:
+ /*
+ * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+ * the next value list element to each loop var.
+ */
+
+ tmpPtr = OBJ_AT_TOS;
+ infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+ numLists = infoPtr->numLists;
+ TRACE(("=> "));
+
+ tmpPtr = OBJ_AT_DEPTH(1);
+ iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+ iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+
+ /*
+ * If some list still has a remaining list element iterate one more
+ * time. Assign to var the next element from its value list.
+ */
+
+ if (iterNum < iterMax) {
+ /*
+ * Set the variables and jump back to run the body
+ */
+
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+
+ listTmpDepth = numLists + 1;
+
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+
+ listPtr = OBJ_AT_DEPTH(listTmpDepth);
+ TclListObjGetElements(interp, listPtr, &listLen, &elements);
+
+ valIndex = (iterNum * numVars);
+ for (j = 0; j < numVars; j++) {
+ if (valIndex >= listLen) {
+ TclNewObj(valuePtr);
+ } else {
+ valuePtr = elements[valIndex];
+ }
+
+ varIndex = varListPtr->varIndexes[j];
+ varPtr = LOCAL(varIndex);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (TclIsVarDirectWritable(varPtr)) {
+ value2Ptr = varPtr->value.objPtr;
+ if (valuePtr != value2Ptr) {
+ if (value2Ptr != NULL) {
+ TclDecrRefCount(value2Ptr);
+ }
+ varPtr->value.objPtr = valuePtr;
+ Tcl_IncrRefCount(valuePtr);
+ }
+ } else {
+ DECACHE_STACK_INFO();
+ if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("ERROR init. index temp %d: %.30s",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ CACHE_STACK_INFO();
+ }
+ valIndex++;
+ }
+ listTmpDepth--;
+ }
+ TRACE_APPEND(("jump to loop start\n"));
+ /* loopCtTemp being 'misused' for storing the jump size */
+ NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+ }
+
+ TRACE_APPEND(("loop has no more iterations\n"));
+#ifdef TCL_COMPILE_DEBUG
+ NEXT_INST_F(1, 0, 0);
+#else
+ /*
+ * FALL THROUGH
+ */
+ pc++;
+#endif
+
+ case INST_FOREACH_END:
+ /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
+ tmpPtr = OBJ_AT_TOS;
+ infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+ numLists = infoPtr->numLists;
+ TRACE(("=> loop terminated\n"));
+ NEXT_INST_V(1, numLists+2, 0);
+
+ case INST_LMAP_COLLECT:
+ /*
+ * This instruction is only issued by lmap. The stack is:
+ * - result
+ * - infoPtr
+ * - loop counters
+ * - valLists
+ * - collecting obj (unshared)
+ * The instruction lappends the result to the collecting obj.
+ */
+
+ tmpPtr = OBJ_AT_DEPTH(1);
+ infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+ numLists = infoPtr->numLists;
+ TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
+
+ objPtr = OBJ_AT_DEPTH(3 + numLists);
+ Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+ NEXT_INST_F(1, 1, 0);
}
case INST_BEGIN_CATCH4:
@@ -6237,7 +7285,8 @@ TEBCresume(
if (code < TCL_ERROR || code > TCL_CONTINUE) {
code = TCL_CONTINUE + 1;
}
- NEXT_INST_F(2*code -1, 1, 0);
+ TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+ NEXT_INST_F(2*code-1, 1, 0);
}
/*
@@ -6254,10 +7303,10 @@ TEBCresume(
case INST_DICT_VERIFY:
dictPtr = OBJ_AT_TOS;
- TRACE(("=> "));
+ TRACE(("\"%.30s\" => ", O2S(dictPtr)));
if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
- TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
- O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
+ TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6266,6 +7315,7 @@ TEBCresume(
case INST_DICT_GET:
case INST_DICT_EXISTS: {
register Tcl_Interp *interp2 = interp;
+ register int found;
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
@@ -6278,10 +7328,11 @@ TEBCresume(
&OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
if (dictPtr == NULL) {
if (*pc == INST_DICT_EXISTS) {
- goto dictNotExists;
+ found = 0;
+ goto afterDictExists;
}
TRACE_WITH_OBJ((
- "ERROR tracing dictionary path into \"%s\": ",
+ "ERROR tracing dictionary path into \"%.30s\": ",
O2S(OBJ_AT_DEPTH(opnd))),
Tcl_GetObjResult(interp));
goto gotError;
@@ -6290,34 +7341,40 @@ TEBCresume(
if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
&objResultPtr) == TCL_OK) {
if (*pc == INST_DICT_EXISTS) {
- objResultPtr = TCONST(objResultPtr ? 1 : 0);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
+ found = (objResultPtr ? 1 : 0);
+ goto afterDictExists;
}
- if (objResultPtr) {
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
+ if (!objResultPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
}
- DECACHE_STACK_INFO();
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "key \"%s\" not known in dictionary",
- TclGetString(OBJ_AT_TOS)));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(OBJ_AT_TOS), NULL);
- CACHE_STACK_INFO();
- TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd+1, 1);
+ } else if (*pc != INST_DICT_EXISTS) {
+ TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
} else {
- if (*pc == INST_DICT_EXISTS) {
- dictNotExists:
- objResultPtr = TCONST(0);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
- }
- TRACE_WITH_OBJ((
- "%u => ERROR reading leaf dictionary key \"%s\": ",
- opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+ found = 0;
}
- goto gotError;
+ afterDictExists:
+ TRACE_APPEND(("%d\n", found));
+
+ /*
+ * The INST_DICT_EXISTS instruction is usually followed by a
+ * conditional jump, so we can take advantage of this to do some
+ * peephole optimization (note that we're careful to not close out
+ * someone doing something else).
+ */
+
+ JUMP_PEEPHOLE_V(found, 5, opnd+1);
}
case INST_DICT_SET:
@@ -6391,8 +7448,8 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
- TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
- opnd, opnd2), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR updating dictionary: %s\n",
+ O2S(Tcl_GetObjResult(interp))));
goto checkForCatch;
}
@@ -6414,8 +7471,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6424,7 +7480,7 @@ TEBCresume(
NEXT_INST_V(10, cleanup, 0);
}
#endif
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(9, cleanup, 1);
case INST_DICT_APPEND:
@@ -6457,6 +7513,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6505,6 +7562,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
@@ -6514,6 +7572,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6550,8 +7609,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6570,7 +7628,16 @@ TEBCresume(
searchPtr = ckalloc(sizeof(Tcl_DictSearch));
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
+
+ /*
+ * dictPtr is no longer on the stack, and we're not
+ * moving it into the intrep of an iterator. We need
+ * to drop the refcount [Tcl Bug 9b352768e6].
+ */
+
+ Tcl_DecrRefCount(dictPtr);
ckfree(searchPtr);
+ TRACE_ERROR(interp);
goto gotError;
}
TclNewObj(statePtr);
@@ -6606,8 +7673,9 @@ TEBCresume(
PUSH_OBJECT(valuePtr);
PUSH_OBJECT(keyPtr);
}
+ TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
-#ifndef TCL_COMPILE_DEBUG
/*
* The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
* followed by a conditional jump, so we can take advantage of this to
@@ -6615,37 +7683,17 @@ TEBCresume(
* out someone doing something else).
*/
- pc += 5;
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
- default:
- pc -= 5;
- /* fall through to non-debug handling */
- }
-#endif
-
- TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
- O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
- objResultPtr = TCONST(done);
- /* TODO: consider opt like INST_FOREACH_STEP4 */
- NEXT_INST_F(5, 0, 1);
+ JUMP_PEEPHOLE_F(done, 5, 0);
case INST_DICT_UPDATE_START:
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
varPtr = LOCAL(opnd);
duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => \n", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6654,11 +7702,13 @@ TEBCresume(
TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (dictPtr == NULL) {
+ TRACE_ERROR(interp);
goto gotError;
}
}
if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
if (length != duiPtr->length) {
@@ -6667,6 +7717,7 @@ TEBCresume(
for (i=0 ; i<length ; i++) {
if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
&valuePtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
varPtr = LOCAL(duiPtr->varIndices[i]);
@@ -6682,21 +7733,23 @@ TEBCresume(
valuePtr, TCL_LEAVE_ERR_MSG,
duiPtr->varIndices[i]) == NULL) {
CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
}
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(9, 0, 0);
case INST_DICT_UPDATE_END:
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
varPtr = LOCAL(opnd);
duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6705,11 +7758,13 @@ TEBCresume(
CACHE_STACK_INFO();
}
if (dictPtr == NULL) {
+ TRACE_APPEND(("storage was unset\n"));
NEXT_INST_F(9, 1, 0);
}
if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
allocdict = Tcl_IsShared(dictPtr);
@@ -6755,27 +7810,27 @@ TEBCresume(
if (allocdict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
}
+ TRACE_APPEND(("written back\n"));
NEXT_INST_F(9, 1, 0);
case INST_DICT_EXPAND:
dictPtr = OBJ_UNDER_TOS;
listPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
- O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
- O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
- TRACE((" => "));
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_DICT_RECOMBINE_STK:
@@ -6785,14 +7840,14 @@ TEBCresume(
TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(keysPtr);
goto gotError;
}
varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(keysPtr);
goto gotError;
}
@@ -6802,7 +7857,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(keysPtr);
if (result != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6816,7 +7871,7 @@ TEBCresume(
TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
O2S(keysPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
while (TclIsVarLink(varPtr)) {
@@ -6827,7 +7882,7 @@ TEBCresume(
objc, objv, keysPtr);
CACHE_STACK_INFO();
if (result != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6885,7 +7940,7 @@ TEBCresume(
}
#endif
if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, result, codePtr);
if (rangePtr == NULL) {
TRACE_APPEND(("no encl. loop or catch, returning %s\n",
StringForResultCode(result)));
@@ -6923,10 +7978,10 @@ TEBCresume(
if (traceInstructions) {
objPtr = Tcl_GetObjResult(interp);
if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
result, O2S(objPtr)));
} else {
- TRACE_APPEND(("%s, result= \"%s\"\n",
+ TRACE_APPEND(("%s, result=\"%.30s\"\n",
StringForResultCode(result), O2S(objPtr)));
}
}
@@ -6939,8 +7994,8 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -6951,9 +8006,9 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponentiation of zero by negative power", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
@@ -6997,7 +8052,7 @@ TEBCresume(
while (auxObjList) {
if ((catchTop != initCatchTop)
&& (*catchTop > (ptrdiff_t)
- auxObjList->internalRep.ptrAndLongRep.value)) {
+ auxObjList->internalRep.twoPtrValue.ptr2)) {
break;
}
POP_TAUX_OBJ();
@@ -7046,7 +8101,7 @@ TEBCresume(
#endif
goto abnormalReturn;
}
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, TCL_ERROR, codePtr);
if (rangePtr == NULL) {
/*
* This is only possible when compiling a [catch] that sends its
@@ -7127,7 +8182,7 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- if (--codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
TclStackFree(interp, TD); /* free my stack */
@@ -7166,6 +8221,7 @@ TEBCresume(
bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
+ assert(bytes);
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
goto instEvalStk;
}
@@ -7179,6 +8235,59 @@ TEBCresume(
#undef auxObjList
#undef catchTop
#undef TCONST
+#undef esPtr
+
+static int
+FinalizeOONext(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+ return result;
+}
+
+static int
+FinalizeOONextFilter(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags |= FILTER_HANDLING;
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -8653,7 +9762,7 @@ ValidatePcAndStackTop(
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
+ if (checkStack &&
((stackTop < 0) || (stackTop > stackUpperBound))) {
int numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
@@ -8706,10 +9815,12 @@ IllegalExprOperandType(
ClientData ptr;
int type;
const unsigned char opcode = *pc;
- const char *description, *operator = operatorStrings[opcode - INST_LOR];
+ const char *description, *operator = "unknown";
if (opcode == INST_EXPON) {
operator = "**";
+ } else if (opcode <= INST_LNOT) {
+ operator = operatorStrings[opcode - INST_LOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
@@ -8777,7 +9888,11 @@ TclGetSourceFromFrame(
cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
}
- cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+ if (cfPtr->cmd) {
+ cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+ } else {
+ cfPtr->cmdObj = Tcl_NewListObj(objc, objv);
+ }
Tcl_IncrRefCount(cfPtr->cmdObj);
}
return cfPtr->cmdObj;
@@ -8798,8 +9913,7 @@ TclGetSrcInfoForPc(
&cfPtr->len, NULL, NULL);
}
- assert(cfPtr->cmd != NULL);
- {
+ if (cfPtr->cmd != NULL) {
/*
* We now have the command. We can get the srcOffset back and from
* there find the list of word locations for this command.
@@ -8860,7 +9974,7 @@ GetSrcInfoForPc(
* where the current instruction starts.
* If NULL; no pointer is stored. */
int *cmdIdxPtr) /* If non-NULL, the location where the index
- * of the command containing the pc should
+ * of the command containing the pc should
* be stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
@@ -8873,10 +9987,8 @@ GetSrcInfoForPc(
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
int bestCmdIdx = -1;
- if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
- if (pcBeg != NULL) *pcBeg = NULL;
- return NULL;
- }
+ /* The pc must point within the bytecode */
+ assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
/*
* Decode the code and source offset and length for each command. The
@@ -8985,13 +10097,14 @@ GetSrcInfoForPc(
* ExceptionRange.
*
* Results:
- * In the normal case, catchOnly is 0 (false) and this procedure returns
- * a pointer to the most closely enclosing ExceptionRange structure
- * regardless of whether it is a loop or catch exception range. This is
- * appropriate when processing a TCL_BREAK or TCL_CONTINUE, which will be
- * "handled" either by a loop exception range or a closer catch range. If
- * catchOnly is nonzero, this procedure ignores loop exception ranges and
- * returns a pointer to the closest catch range. If no matching
+ * If the searchMode is TCL_ERROR, this procedure ignores loop exception
+ * ranges and returns a pointer to the closest catch range. If the
+ * searchMode is TCL_BREAK, this procedure returns a pointer to the most
+ * closely enclosing ExceptionRange regardless of whether it is a loop or
+ * catch exception range. If the searchMode is TCL_CONTINUE, this
+ * procedure returns a pointer to the most closely enclosing
+ * ExceptionRange (of any type) skipping only loop exception ranges if
+ * they don't have a sensible continueOffset defined. If no matching
* ExceptionRange is found that encloses pc, a NULL is returned.
*
* Side effects:
@@ -9002,14 +10115,16 @@ GetSrcInfoForPc(
static ExceptionRange *
GetExceptRangeForPc(
- const unsigned char *pc, /* The program counter value for which to
+ const unsigned char *pc, /* The program counter value for which to
* search for a closest enclosing exception
* range. This points to a bytecode
* instruction in codePtr's code. */
- int catchOnly, /* If 0, consider either loop or catch
- * ExceptionRanges in search. If nonzero
+ int searchMode, /* If TCL_BREAK, consider either loop or catch
+ * ExceptionRanges in search. If TCL_ERROR
* consider only catch ranges (and ignore any
- * closer loop ranges). */
+ * closer loop ranges). If TCL_CONTINUE, look
+ * for loop ranges that define a continue
+ * point or a catch range. */
ByteCode *codePtr) /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
@@ -9035,8 +10150,13 @@ GetExceptRangeForPc(
start = rangePtr->codeOffset;
if ((start <= pcOffset) &&
(pcOffset < (start + rangePtr->numCodeBytes))) {
- if ((!catchOnly)
- || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+ if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+ return rangePtr;
+ }
+ if (searchMode == TCL_BREAK) {
+ return rangePtr;
+ }
+ if (searchMode == TCL_CONTINUE && rangePtr->continueOffset != -1){
return rangePtr;
}
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 13377d3..bb814ea 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -120,7 +120,7 @@ FileCopyRename(
}
i++;
if ((objc - i) < 2) {
- Tcl_WrongNumArgs(interp, 1, objv,
+ Tcl_WrongNumArgs(interp, 1, objv,
"?-option value ...? source ?source ...? target");
return TCL_ERROR;
}
@@ -517,7 +517,7 @@ CopyRenameOneFile(
* 16 bits and we get collisions. See bug #2015723.
*/
-#if !defined(WIN32) && !defined(__CYGWIN__)
+#if !defined(_WIN32) && !defined(__CYGWIN__)
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -735,7 +735,7 @@ CopyRenameOneFile(
errfile = target;
}
- /*
+ /*
* We now need to reset the result, because the above call,
* may have left set it. (Ideally we would prefer not to pass
* an interpreter in above, but the channel IO code used by
@@ -1196,7 +1196,7 @@ TclFileLinkCmd(
static const char *const linkTypes[] = {
"-symbolic", "-hard", NULL
};
- if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0,
&linkAction) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5d4702b..39bac99 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -235,9 +235,9 @@ ExtractWinRoot(
if ((path[0] == 'c' || path[0] == 'C')
&& (path[1] == 'o' || path[1] == 'O')) {
if ((path[2] == 'm' || path[2] == 'M')
- && path[3] >= '1' && path[3] <= '4') {
+ && path[3] >= '1' && path[3] <= '9') {
/*
- * May have match for 'com[1-4]:?', which is a serial port.
+ * May have match for 'com[1-9]:?', which is a serial port.
*/
if (path[4] == '\0') {
@@ -257,9 +257,9 @@ ExtractWinRoot(
} else if ((path[0] == 'l' || path[0] == 'L')
&& (path[1] == 'p' || path[1] == 'P')
&& (path[2] == 't' || path[2] == 'T')) {
- if (path[3] >= '1' && path[3] <= '3') {
+ if (path[3] >= '1' && path[3] <= '9') {
/*
- * May have match for 'lpt[1-3]:?'
+ * May have match for 'lpt[1-9]:?'
*/
if (path[4] == '\0') {
@@ -821,10 +821,10 @@ Tcl_FSJoinToPath(
return TclJoinPath(2, pair);
} else {
int elemc = objc + 1;
- Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj **));
+ Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
elemv[0] = pathPtr;
- memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj **));
+ memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
ret = TclJoinPath(elemc, elemv);
ckfree(elemv);
return ret;
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 6be3e03..1eec7ff 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -33,7 +33,7 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
-MODULE_SCOPE int TclFSEpoch(void);
+MODULE_SCOPE size_t TclFSEpoch(void);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
@@ -55,7 +55,7 @@ MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
const Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE int TclFSEpochOk(int filesystemEpoch);
+MODULE_SCOPE int TclFSEpochOk(size_t filesystemEpoch);
MODULE_SCOPE int TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
const char *path, Tcl_Obj **useThisCwdPtr);
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 90be511..1991aea 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -326,7 +326,7 @@ CreateHashEntry(
continue;
}
#endif
- if (compareKeysProc((void *) key, hPtr)) {
+ if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
if (newPtr) {
*newPtr = 0;
}
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index b10d423..b08e352 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -161,7 +161,7 @@ Tcl_RecordAndEvalObj(
Tcl_Obj *list[3];
/*
- * Do recording by eval'ing a tcl history command: history add $cmd.
+ * Do recording by eval'ing a tcl history command: history add $cmd.
*/
list[0] = histObjsPtr->historyObj;
@@ -175,7 +175,7 @@ Tcl_RecordAndEvalObj(
/*
* One possible failure mode above: exceeding a resource limit.
*/
-
+
if (Tcl_LimitExceeded(interp)) {
return TCL_ERROR;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f1d85bf..f93d00d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -34,15 +35,15 @@ typedef struct ChannelHandler {
/*
* This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
+ * the current invocation of Tcl_NotifyChannel. There is a potential
* problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
* problem, structures of the type below indicate the next handler to be
* processed for any (recursively nested) dispatches in progress. The
* nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
+ * The nestedHandlerPtr field is used to chain together all recursive
+ * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
+ * nested invocations of Tcl_NotifyChannel and compare the handler being
* deleted against the NEXT handler to be invoked in that invocation; when it
* finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
* field of the structure to the next handler.
@@ -53,21 +54,10 @@ typedef struct NextChannelHandler {
* this invocation. */
struct NextChannelHandler *nestedHandlerPtr;
/* Next nested invocation of
- * ChannelHandlerEventProc. */
+ * Tcl_NotifyChannel. */
} NextChannelHandler;
/*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
- */
-
-typedef struct ChannelHandlerEvent {
- Tcl_Event header; /* Standard header for all events. */
- Channel *chanPtr; /* The channel that is ready. */
- int readyMask; /* Events that have occurred. */
-} ChannelHandlerEvent;
-
-/*
* The following structure is used by Tcl_GetsObj() to encapsulates the
* state for a "gets" operation.
*/
@@ -129,7 +119,7 @@ typedef struct CopyState {
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
- * ChannelHandlerEventProc invocations. */
+ * Tcl_NotifyChannel invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
@@ -162,11 +152,14 @@ typedef struct CloseCallback {
*/
static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
+static void ChannelFree(Channel *chanPtr);
static void ChannelTimerProc(ClientData clientData);
+static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
int direction);
-static int CheckFlush(Channel *chanPtr, ChannelBuffer *bufPtr,
- int newlineFlag);
static int CheckForDeadChannel(Tcl_Interp *interp,
ChannelState *statePtr);
static void CheckForStdChannelsBeingClosed(Tcl_Channel chan);
@@ -178,10 +171,15 @@ static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
int errorCode, int flags);
static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void CommonGetsCleanup(Channel *chanPtr);
-static int CopyAndTranslateBuffer(ChannelState *statePtr,
- char *result, int space);
-static int CopyBuffer(Channel *chanPtr, char *result, int space);
static int CopyData(CopyState *csPtr, int mask);
+static int MoveBytes(CopyState *csPtr);
+
+static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
+static void MBError(CopyState *csPtr, int mask, int errorCode);
+static int MBRead(CopyState *csPtr);
+static int MBWrite(CopyState *csPtr);
+static void MBEvent(ClientData clientData, int mask);
+
static void CopyEventProc(ClientData clientData, int mask);
static void CreateScriptRecord(Tcl_Interp *interp,
Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -193,16 +191,16 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
-static int DoRead(Channel *chanPtr, char *srcPtr, int slen, int allowShortReads);
-static int DoWrite(Channel *chanPtr, const char *src, int srcLen);
+static int DoRead(Channel *chanPtr, char *dst, int bytesToRead,
+ int allowShortReads);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
-static int DoWriteChars(Channel *chan, const char *src, int len);
static int FilterInputBytes(Channel *chanPtr,
GetsState *statePtr);
static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
int calledFromAsyncFlush);
static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
+static Tcl_Encoding GetBinaryEncoding();
static void FreeBinaryEncoding(ClientData clientData);
static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp);
static int GetInput(Channel *chanPtr);
@@ -211,29 +209,30 @@ static int HaveVersion(const Tcl_ChannelType *typePtr,
static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
GetsState *gsPtr);
static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr);
+ int charsLeft);
static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr, int *factorPtr);
+ int charsLeft, int *factorPtr);
static void RecycleBuffer(ChannelState *statePtr,
ChannelBuffer *bufPtr, int mustDiscard);
static int StackSetBlockMode(Channel *chanPtr, int mode);
static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
int mode);
static void StopCopy(CopyState *csPtr);
-static int TranslateInputEOL(ChannelState *statePtr, char *dst,
- const char *src, int *dstLenPtr, int *srcLenPtr);
-static int TranslateOutputEOL(ChannelState *statePtr, char *dst,
+static void TranslateInputEOL(ChannelState *statePtr, char *dst,
const char *src, int *dstLenPtr, int *srcLenPtr);
static void UpdateInterest(Channel *chanPtr);
-static int WriteBytes(Channel *chanPtr, const char *src,
- int srcLen);
-static int WriteChars(Channel *chanPtr, const char *src,
- int srcLen);
+static int Write(Channel *chanPtr, const char *src,
+ int srcLen, Tcl_Encoding encoding);
static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
static void SpliceChannel(Tcl_Channel chan);
static void CutChannel(Tcl_Channel chan);
static int WillRead(Channel *chanPtr);
+#define WriteChars(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, chanPtr->state->encoding)
+#define WriteBytes(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, tclIdentityEncoding)
+
/*
* Simplifying helper macros. All may use their argument(s) multiple times.
* The ANSI C "prototypes" for the macros are listed below, together with a
@@ -286,7 +285,7 @@ static int WillRead(Channel *chanPtr);
#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
-#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
@@ -323,14 +322,13 @@ static int WillRead(Channel *chanPtr);
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static int SetChannelFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
-static void UpdateStringOfChannel(Tcl_Obj *objPtr);
static void FreeChannelIntRep(Tcl_Obj *objPtr);
-static const Tcl_ObjType tclChannelType = {
+static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelIntRep, /* freeIntRepProc */
DupChannelIntRep, /* dupIntRepProc */
- NULL, /* updateStringProc UpdateStringOfChannel */
+ NULL, /* updateStringProc */
NULL /* setFromAnyProc SetChannelFromAny */
};
@@ -339,7 +337,7 @@ static const Tcl_ObjType tclChannelType = {
#define SET_CHANNELSTATE(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
#define GET_CHANNELINTERP(objPtr) \
- ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
+ ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
@@ -382,19 +380,87 @@ ChanCloseHalf(
return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
}
-static inline int
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanRead --
+ *
+ * Read up to dstSize bytes using the inputProc of chanPtr, store
+ * them at dst, and return the number of bytes stored.
+ *
+ * Results:
+ * The return value of the driver inputProc,
+ * - number of bytes stored at dst, ot
+ * - -1 on error, with a Posix error code available to the
+ * caller by calling Tcl_GetErrno().
+ *
+ * Side effects:
+ * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
+ * set as appropriate.
+ * On EOF, the inputEncodingFlags are set to perform ending operations
+ * on decoding.
+ * TODO - Is this really the right place for that?
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
ChanRead(
Channel *chanPtr,
char *dst,
- int dstSize,
- int *errnoPtr)
+ int dstSize)
{
+ int bytesRead, result;
+
+ /*
+ * If the caller asked for zero bytes, we'd force the inputProc
+ * to return zero bytes, and then misinterpret that as EOF.
+ */
+ assert(dstSize > 0);
+
+ /*
+ * Each read op must set the blocked and eof states anew, not let
+ * the effect of prior reads leak through.
+ */
+ if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
if (WillRead(chanPtr) < 0) {
return -1;
}
- return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
- errnoPtr);
+ bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
+ dst, dstSize, &result);
+
+ /* Stop any flag leakage through stacked channel levels */
+ if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
+ if (bytesRead > 0) {
+ /*
+ * If we get a short read, signal up that we may be BLOCKED.
+ * We should avoid calling the driver because on some
+ * platforms we will block in the low level reading code even
+ * though the channel is set into nonblocking mode.
+ */
+
+ if (bytesRead < dstSize) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ }
+ } else if (bytesRead == 0) {
+ SetFlag(chanPtr->state, CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (bytesRead < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ result = EAGAIN;
+ }
+ Tcl_SetErrno(result);
+ }
+ return bytesRead;
}
static inline Tcl_WideInt
@@ -512,11 +578,11 @@ TclFinalizeIOSubsystem(void)
int active = 1; /* Flag == 1 while there's still work to do */
int doflushnb;
- /* Fetch the pre-TIP#398 compatibility flag */
+ /* Fetch the pre-TIP#398 compatibility flag */
{
const char *s;
Tcl_DString ds;
-
+
s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
doflushnb = ((s != NULL) && strcmp(s, "0"));
if (s != NULL) {
@@ -558,6 +624,7 @@ TclFinalizeIOSubsystem(void)
if (active) {
+ TclChannelPreserve((Tcl_Channel)chanPtr);
/*
* TIP #398: by default, we no longer set the channel back into
* blocking mode. To restore the old blocking behavior, the
@@ -568,9 +635,9 @@ TclFinalizeIOSubsystem(void)
/* Set the channel back into blocking mode to ensure that we wait
* for all data to flush out.
*/
-
+
(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
+ "-blocking", "on");
}
if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
@@ -616,6 +683,7 @@ TclFinalizeIOSubsystem(void)
chanPtr->instanceData = NULL;
SetFlag(statePtr, CHANNEL_DEAD);
}
+ TclChannelRelease((Tcl_Channel)chanPtr);
}
}
@@ -954,8 +1022,7 @@ DeleteChannelTable(
Tcl_DeleteHashEntry(hPtr);
SetFlag(statePtr, CHANNEL_TAINTED);
- statePtr->refCount--;
- if (statePtr->refCount <= 0) {
+ if (statePtr->refCount-- <= 1) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
@@ -1177,15 +1244,6 @@ Tcl_UnregisterChannel(
*/
if (statePtr->refCount <= 0) {
- /*
- * Ensure that if there is another buffer, it gets flushed whether or
- * not we are doing a background flush.
- */
-
- if ((statePtr->curOutPtr != NULL) &&
- IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
@@ -1497,6 +1555,22 @@ Tcl_CreateChannel(
*/
assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
+ assert(typePtr->typeName != NULL);
+ if (NULL == typePtr->closeProc) {
+ Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
+ }
+ if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
+ Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
+ }
+ if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) {
+ Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
+ }
+ if (NULL == typePtr->watchProc) {
+ Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
+ }
+ if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
+ Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
+ }
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
@@ -1581,11 +1655,7 @@ Tcl_CreateChannel(
statePtr->timer = NULL;
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
-
statePtr->outputStage = NULL;
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
- }
/*
* As we are creating the channel, it is obviously the top for now.
@@ -1597,6 +1667,7 @@ Tcl_CreateChannel(
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
+ chanPtr->refCount = 0;
/*
* TIP #219, Tcl Channel Reflection API
@@ -1750,6 +1821,10 @@ Tcl_StackChannel(
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
+ /*
+ * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+ * the stacking state of this channel during its operations.
+ */
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
@@ -1781,17 +1856,17 @@ Tcl_StackChannel(
*/
if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+
/*
- * Remark: It is possible that the channel buffers contain data from
- * some earlier push-backs.
+ * When statePtr->inQueueHead is not NULL, we know
+ * prevChanPtr->inQueueHead must be NULL.
*/
- statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
- prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ assert(prevChanPtr->inQueueHead == NULL);
+ assert(prevChanPtr->inQueueTail == NULL);
- if (prevChanPtr->inQueueTail == NULL) {
- prevChanPtr->inQueueTail = statePtr->inQueueTail;
- }
+ prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ prevChanPtr->inQueueTail = statePtr->inQueueTail;
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
@@ -1813,6 +1888,7 @@ Tcl_StackChannel(
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
+ chanPtr->refCount = 0;
/*
* Place new block at the head of a possibly existing list of previously
@@ -1837,6 +1913,41 @@ Tcl_StackChannel(
return (Tcl_Channel) chanPtr;
}
+
+void
+TclChannelPreserve(
+ Tcl_Channel chan)
+{
+ ((Channel *)chan)->refCount++;
+}
+
+void
+TclChannelRelease(
+ Tcl_Channel chan)
+{
+ Channel *chanPtr = (Channel *) chan;
+
+ if (chanPtr->refCount == 0) {
+ Tcl_Panic("Channel released more than preserved");
+ }
+ if (--chanPtr->refCount) {
+ return;
+ }
+ if (chanPtr->typePtr == NULL) {
+ ckfree(chanPtr);
+ }
+}
+
+static void
+ChannelFree(
+ Channel *chanPtr)
+{
+ if (chanPtr->refCount == 0) {
+ ckfree(chanPtr);
+ return;
+ }
+ chanPtr->typePtr = NULL;
+}
/*
*----------------------------------------------------------------------
@@ -1879,6 +1990,13 @@ Tcl_UnstackChannel(
* into the old structure.
*/
+ /*
+ * TODO: Figure out how to handle the situation where the chan
+ * operations called below by this unstacking operation cause
+ * another unstacking recursively. In that case the downChanPtr
+ * value we're holding on to will not be the right thing.
+ */
+
Channel *downChanPtr = chanPtr->downChanPtr;
/*
@@ -1976,14 +2094,9 @@ Tcl_UnstackChannel(
*/
result = ChanClose(chanPtr, interp);
- chanPtr->typePtr = NULL;
-
- /*
- * AK: Tcl_NotifyChannel may hold a reference to this block of memory
- */
+ ChannelFree(chanPtr);
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
@@ -2295,8 +2408,36 @@ AllocChannelBuffer(
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (bufPtr->refCount == 0) {
+ Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
+ }
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree(bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -2327,20 +2468,23 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
/*
- * Only save buffers which are at least as big as the requested buffersize
- * for the channel. This is to honor dynamic changes of the buffersize
+ * Only save buffers which have the requested buffersize for the
+ * channel. This is to honor dynamic changes of the buffersize
* made by the user.
*/
- if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree(bufPtr);
+ if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2375,7 +2519,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
@@ -2413,6 +2557,11 @@ DiscardOutputQueued(
}
statePtr->outQueueHead = NULL;
statePtr->outQueueTail = NULL;
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr && BytesLeft(bufPtr)) {
+ statePtr->curOutPtr = NULL;
+ RecycleBuffer(statePtr, bufPtr, 0);
+ }
}
/*
@@ -2480,8 +2629,6 @@ FlushChannel(
ChannelState *statePtr = chanPtr->state;
/* State of the channel stack. */
ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */
- int toWrite; /* Amount of output data in current buffer
- * available to be written. */
int written; /* Amount of output data actually written in
* current round. */
int errorCode = 0; /* Stores POSIX error codes from channel
@@ -2501,63 +2648,61 @@ FlushChannel(
}
/*
- * Loop over the queued buffers and attempt to flush as much as possible
- * of the queued output to the channel.
- */
-
- Tcl_Preserve(chanPtr);
- while (1) {
- /*
- * If the queue is empty and there is a ready current buffer, OR if
- * the current buffer is full, then move the current buffer to the
- * queue.
- */
-
- if (((statePtr->curOutPtr != NULL) &&
- IsBufferFull(statePtr->curOutPtr))
- || (GotFlag(statePtr, BUFFER_READY) &&
- (statePtr->outQueueHead == NULL))) {
- ResetFlag(statePtr, BUFFER_READY);
- statePtr->curOutPtr->nextPtr = NULL;
- if (statePtr->outQueueHead == NULL) {
- statePtr->outQueueHead = statePtr->curOutPtr;
- } else {
- statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
- }
- statePtr->outQueueTail = statePtr->curOutPtr;
- statePtr->curOutPtr = NULL;
+ * Should we shift the current output buffer over to the output queue?
+ * First check that there are bytes in it. If so then...
+ * If the output queue is empty, then yes, trusting the caller called
+ * us only when written bytes ought to be flushed.
+ * If the current output buffer is full, then yes, so we can meet
+ * the post-condition that on a successful return to caller we've
+ * left space in the current output buffer for more writing (the flush
+ * call was to make new room).
+ * If the channel is blocking, then yes, so we guarantee that
+ * blocking flushes actually flush all pending data.
+ * Otherwise, no. Keep the current output buffer where it is so more
+ * can be written to it, possibly filling it, to promote more efficient
+ * buffer usage.
+ */
+
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
+ (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
+ || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
+ if (statePtr->outQueueHead == NULL) {
+ statePtr->outQueueHead = bufPtr;
+ } else {
+ statePtr->outQueueTail->nextPtr = bufPtr;
}
- bufPtr = statePtr->outQueueHead;
+ statePtr->outQueueTail = bufPtr;
+ statePtr->curOutPtr = NULL;
+ }
- /*
- * If we are not being called from an async flush and an async flush
- * is active, we just return without producing any output.
- */
+ assert(!IsBufferFull(statePtr->curOutPtr));
- if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
- errorCode = 0;
- goto done;
- }
+ /*
+ * If we are not being called from an async flush and an async flush
+ * is active, we just return without producing any output.
+ */
- /*
- * If the output queue is still empty, break out of the while loop.
- */
+ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ return 0;
+ }
- if (bufPtr == NULL) {
- break; /* Out of the "while (1)". */
- }
+ /*
+ * Loop over the queued buffers and attempt to flush as much as possible
+ * of the queued output to the channel.
+ */
+
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ while (statePtr->outQueueHead) {
+ bufPtr = statePtr->outQueueHead;
/*
* Produce the output on the channel.
*/
- toWrite = BytesLeft(bufPtr);
- if (toWrite == 0) {
- written = 0;
- } else {
- written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
- &errorCode);
- }
+ PreserveChannelBuffer(bufPtr);
+ written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr),
+ &errorCode);
/*
* If the write failed completely attempt to start the asynchronous
@@ -2572,6 +2717,7 @@ FlushChannel(
if (errorCode == EINTR) {
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
continue;
}
@@ -2593,6 +2739,7 @@ FlushChannel(
UpdateInterest(chanPtr);
}
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
break;
}
@@ -2654,14 +2801,15 @@ FlushChannel(
*/
DiscardOutputQueued(statePtr);
- continue;
+ ReleaseChannelBuffer(bufPtr);
+ break;
} else {
+ /* TODO: Consider detecting and reacting to short writes
+ * on blocking channels. Ought not happen. See iocmd-24.2. */
wroteSome = 1;
}
- if (!IsBufferEmpty(bufPtr)) {
- bufPtr->nextRemoved += written;
- }
+ bufPtr->nextRemoved += written;
/*
* If this buffer is now empty, recycle it.
@@ -2674,7 +2822,8 @@ FlushChannel(
}
RecycleBuffer(statePtr, bufPtr, 0);
}
- } /* Closes "while (1)". */
+ ReleaseChannelBuffer(bufPtr);
+ } /* Closes "while". */
/*
* If we wrote some data while flushing in the background, we are done.
@@ -2689,6 +2838,25 @@ FlushChannel(
} else if (statePtr->outQueueHead == NULL) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
ChanWatch(chanPtr, statePtr->interestMask);
+ } else {
+
+ /*
+ * When we are calledFromAsyncFlush, that means a writable
+ * state on the channel triggered the call, so we should be
+ * able to write something. Either we did write something
+ * and wroteSome should be set, or there was nothing left to
+ * write in this call, and we've completed the BG flush.
+ * These are the two cases above. If we get here, that means
+ * there is some kind failure in the writable event machinery.
+ *
+ * The tls extension indeed suffers from flaws in its channel
+ * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca.
+ * Until that patch is broadly distributed, disable the
+ * assertion checking here, so that programs using Tcl and
+ * tls can be debugged.
+
+ assert(!calledFromAsyncFlush);
+ */
}
}
@@ -2721,7 +2889,7 @@ FlushChannel(
}
done:
- Tcl_Release(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return errorCode;
}
@@ -2775,7 +2943,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree(statePtr->curOutPtr);
+ ReleaseChannelBuffer(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2838,10 +3006,6 @@ CloseChannel(
}
Tcl_FreeEncoding(statePtr->encoding);
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
}
/*
@@ -2891,9 +3055,9 @@ CloseChannel(
statePtr->topChanPtr = downChanPtr;
downChanPtr->upChanPtr = NULL;
- chanPtr->typePtr = NULL;
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+ ChannelFree(chanPtr);
+
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
}
@@ -2901,13 +3065,11 @@ CloseChannel(
* There is only the TOP Channel, so we free the remaining pointers we
* have and then ourselves. Since this is the last of the channels in the
* stack, make sure to free the ChannelState structure associated with it.
- * We use Tcl_EventuallyFree to allow for any last references.
*/
- chanPtr->typePtr = NULL;
+ ChannelFree(chanPtr);
Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
return errorCode;
}
@@ -3191,10 +3353,18 @@ Tcl_Close(
stickyError = 0;
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
- && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
- statePtr->outputEncodingFlags |= TCL_ENCODING_END;
- if (WriteChars(chanPtr, "", 0) < 0) {
+ if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {
+
+ int code = CheckChannelErrors(statePtr, TCL_WRITABLE);
+
+ if (code == 0) {
+ statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+ code = WriteChars(chanPtr, "", 0);
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_END;
+ statePtr->outputEncodingFlags |= TCL_ENCODING_START;
+ }
+ if (code < 0) {
stickyError = Tcl_GetErrno();
}
@@ -3229,14 +3399,6 @@ Tcl_Close(
ResetFlag(statePtr, CHANNEL_INCLOSE);
/*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If this channel supports it, close the read side, since we don't need
* it anymore and this will help avoid deadlocks on some channel types.
*/
@@ -3281,7 +3443,17 @@ Tcl_Close(
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- flushcode = -1;
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
@@ -3394,10 +3566,6 @@ Tcl_CloseEx(
return CloseChannelPart(interp, chanPtr, 0, flags);
} else if (flags & TCL_CLOSE_WRITE) {
- if ((statePtr->curOutPtr != NULL) &&
- IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
@@ -3459,14 +3627,6 @@ CloseWrite(
int result = 0;
/*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* The call to FlushChannel will flush any queued output and invoke the
* close function of the channel driver, or it will set up the channel to
* be flushed and closed asynchronously.
@@ -3778,7 +3938,10 @@ Tcl_Write(
if (srcLen < 0) {
srcLen = strlen(src);
}
- return DoWrite(chanPtr, src, srcLen);
+ if (WriteBytes(chanPtr, src, srcLen) < 0) {
+ return -1;
+ }
+ return srcLen;
}
/*
@@ -3869,82 +4032,40 @@ Tcl_WriteChars(
int len) /* Length of string in bytes, or < 0 for
* strlen(). */
{
- ChannelState *statePtr; /* State info for channel */
-
- statePtr = ((Channel *) chan)->state;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* State info for channel */
+ int result;
+ Tcl_Obj *objPtr;
if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
- return DoWriteChars((Channel *) chan, src, len);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * DoWriteChars --
- *
- * Takes a sequence of UTF-8 characters and converts them for output
- * using the channel's current encoding, may queue the buffer for output
- * if it gets full, and also remembers whether the current buffer is
- * ready e.g. if it contains a newline and we are in line buffering mode.
- * Compensates stacking, i.e. will redirect the data from the specified
- * channel to the topmost channel in a stack.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DoWriteChars(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* UTF-8 characters to queue in output
- * buffer. */
- int len) /* Length of string in bytes, or < 0 for
- * strlen(). */
-{
- /*
- * Always use the topmost channel of the stack
- */
-
- ChannelState *statePtr; /* State info for channel */
-
- statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
if (len < 0) {
len = strlen(src);
}
- if (statePtr->encoding == NULL) {
- /*
- * Inefficient way to convert UTF-8 to byte-array, but the code
- * parallels the way it is done for objects.
- * Special case for 1-byte (used by eg [puts] for the \n) could
- * be extended to more efficient translation of the src string.
- */
-
- int result;
+ if (statePtr->encoding) {
+ return WriteChars(chanPtr, src, len);
+ }
- if ((len == 1) && (UCHAR(*src) < 0xC0)) {
- result = WriteBytes(chanPtr, src, len);
- } else {
- Tcl_Obj *objPtr = Tcl_NewStringObj(src, len);
+ /*
+ * Inefficient way to convert UTF-8 to byte-array, but the code
+ * parallels the way it is done for objects. Special case for 1-byte
+ * (used by eg [puts] for the \n) could be extended to more efficient
+ * translation of the src string.
+ */
- src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
- result = WriteBytes(chanPtr, src, len);
- TclDecrRefCount(objPtr);
- }
- return result;
+ if ((len == 1) && (UCHAR(*src) < 0xC0)) {
+ return WriteBytes(chanPtr, src, len);
}
- return WriteChars(chanPtr, src, len);
+
+ objPtr = Tcl_NewStringObj(src, len);
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+ result = WriteBytes(chanPtr, src, len);
+ TclDecrRefCount(objPtr);
+ return result;
}
/*
@@ -4020,12 +4141,25 @@ static int
WillRead(
Channel *chanPtr)
{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ DiscardInputQueued(chanPtr->state, 0);
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
- if ((chanPtr->state->curOutPtr != NULL)
- && IsBufferReady(chanPtr->state->curOutPtr)) {
- SetFlag(chanPtr->state, BUFFER_READY);
- }
+
+ /*
+ * CAVEAT - The assumption here is that FlushChannel() will
+ * push out the bytes of any writes that are in progress.
+ * Since this is a seekable channel, we assume it is not one
+ * that can block and force bg flushing. Channels we know that
+ * can do that -- sockets, pipes -- are not seekable. If the
+ * assumption is wrong, more drastic measures may be required here
+ * like temporarily setting the channel into blocking mode.
+ */
+
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -4036,110 +4170,9 @@ WillRead(
/*
*----------------------------------------------------------------------
*
- * WriteBytes --
- *
- * Write a sequence of bytes into an output buffer, may queue the buffer
- * for output if it gets full, and also remembers whether the current
- * buffer is ready e.g. if it contains a newline and we are in line
- * buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WriteBytes(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* Bytes to write. */
- int srcLen) /* Number of bytes to write. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- ChannelBuffer *bufPtr;
- char *dst;
- int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;
-
- if (srcLen) {
- WillWrite(chanPtr);
- }
-
- total = 0;
- sawLF = 0;
- savedLF = 0;
- translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
- || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
-
- /*
- * Loop over all bytes in src, storing them in output buffer with proper
- * EOL translation.
- */
-
- while (srcLen + savedLF > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = InsertPoint(bufPtr);
- dstMax = SpaceLeft(bufPtr);
- dstLen = dstMax;
-
- toWrite = dstLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
- }
-
- if (translate) {
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL()
- * and we need to store it in this buffer. If the channel is
- * line-based, we will need to flush it.
- */
-
- *dst++ = '\n';
- dstLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
- sawLF++;
- }
- dstLen += savedLF;
- savedLF = 0;
- if (dstLen > dstMax) {
- savedLF = 1;
- dstLen = dstMax;
- }
- } else {
- memcpy(dst, src, toWrite);
- dstLen = toWrite;
- }
-
- bufPtr->nextAdded += dstLen;
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
- total += dstLen;
- src += toWrite;
- srcLen -= toWrite;
- sawLF = 0;
- }
- return total;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WriteChars --
+ * Write --
*
- * Convert UTF-8 bytes to the channel's external encoding and write the
+ * Convert srcLen bytes starting at src according to encoding and write
* produced bytes into an output buffer, may queue the buffer for output
* if it gets full, and also remembers whether the current buffer is
* ready e.g. if it contains a newline and we are in line buffering mode.
@@ -4156,381 +4189,175 @@ WriteBytes(
*/
static int
-WriteChars(
+Write(
Channel *chanPtr, /* The channel to buffer output for. */
const char *src, /* UTF-8 string to write. */
- int srcLen) /* Length of UTF-8 string in bytes. */
+ int srcLen, /* Length of UTF-8 string in bytes. */
+ Tcl_Encoding encoding)
{
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- ChannelBuffer *bufPtr;
- char *dst, *stage;
- int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
- int stageLen, toWrite, stageRead, endEncoding, result;
- int consumedSomething, translate;
- Tcl_Encoding encoding;
- char safe[BUFFER_PADDING];
+ char *nextNewLine = NULL;
+ int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
if (srcLen) {
WillWrite(chanPtr);
}
- total = 0;
- sawLF = 0;
- savedLF = 0;
- saved = 0;
- encoding = statePtr->encoding;
-
/*
* Write the terminated escape sequence even if srcLen is 0.
*/
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
- translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
- || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
+ nextNewLine = memchr(src, '\n', srcLen);
+ }
- /*
- * Loop over all UTF-8 characters in src, storing them in staging buffer
- * with proper EOL translation.
- */
+ while (srcLen + saved + endEncoding > 0) {
+ ChannelBuffer *bufPtr;
+ char *dst, safe[BUFFER_PADDING];
+ int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
- consumedSomething = 1;
- while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
- consumedSomething = 0;
- stage = statePtr->outputStage;
- stageMax = statePtr->bufSize;
- stageLen = stageMax;
+ if (nextNewLine) {
+ srcLimit = nextNewLine - src;
+ }
- toWrite = stageLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
+ /* Get space to write into */
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
+ if (saved) {
+ /*
+ * Here's some translated bytes left over from the last buffer
+ * that we need to stick at the beginning of this buffer.
+ */
- if (translate) {
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL()
- * and we need to store it in the staging buffer. If the
- * channel is line-based, we will need to flush the output
- * buffer (after translating the staging buffer).
- */
+ memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
+ bufPtr->nextAdded += saved;
+ saved = 0;
+ }
+ PreserveChannelBuffer(bufPtr);
+ dst = InsertPoint(bufPtr);
+ dstLen = SpaceLeft(bufPtr);
- *stage++ = '\n';
- stageLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, stage, src, &stageLen,
- &toWrite)) {
- sawLF++;
- }
+ result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- stage -= savedLF;
- stageLen += savedLF;
- savedLF = 0;
+ /* See chan-io-1.[89]. Tcl Bug 506297. */
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
- if (stageLen > stageMax) {
- savedLF = 1;
- stageLen = stageMax;
+ if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
+ /* We're reading from invalid/incomplete UTF-8 */
+ ReleaseChannelBuffer(bufPtr);
+ if (total == 0) {
+ Tcl_SetErrno(EINVAL);
+ return -1;
}
- } else {
- memcpy(stage, src, toWrite);
- stageLen = toWrite;
+ break;
}
- src += toWrite;
- srcLen -= toWrite;
- /*
- * Loop over all UTF-8 characters in staging buffer, converting them
- * to external encoding, storing them in output buffer.
- */
+ bufPtr->nextAdded += dstWrote;
+ src += srcRead;
+ srcLen -= srcRead;
+ total += dstWrote;
+ dst += dstWrote;
+ dstLen -= dstWrote;
- while (stageLen + saved + endEncoding > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = InsertPoint(bufPtr);
- dstLen = SpaceLeft(bufPtr);
+ if (src == nextNewLine && dstLen > 0) {
+ static char crln[3] = "\r\n";
+ char *nl = NULL;
+ int nlLen = 0;
- if (saved != 0) {
- /*
- * Here's some translated bytes left over from the last buffer
- * that we need to stick at the beginning of this buffer.
- */
-
- memcpy(dst, safe, (size_t) saved);
- bufPtr->nextAdded += saved;
- dst += saved;
- dstLen -= saved;
- saved = 0;
+ switch (statePtr->outputTranslation) {
+ case TCL_TRANSLATE_LF:
+ nl = crln + 1;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CR:
+ nl = crln;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CRLF:
+ nl = crln;
+ nlLen = 2;
+ break;
+ default:
+ Tcl_Panic("unknown output translation requested");
+ break;
}
- result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
- statePtr->outputEncodingFlags,
- &statePtr->outputEncodingState, dst,
- dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
-
- /*
- * Fix for SF #506297, reported by Martin Forssen
- * <ruric@users.sourceforge.net>.
- *
- * The encoding chosen in the script exposing the bug writes out
- * three intro characters when TCL_ENCODING_START is set, but does
- * not consume any input as TCL_ENCODING_END is cleared. As some
- * output was generated the enclosing loop calls UtfToExternal
- * again, again with START set. Three more characters in the out
- * and still no use of input ... To break this infinite loop we
- * remove TCL_ENCODING_START from the set of flags after the first
- * call (no condition is required, the later calls remove an unset
- * flag, which is a no-op). This causes the subsequent calls to
- * UtfToExternal to consume and convert the actual input.
- */
-
- statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
-
- /*
- * The following code must be executed only when result is not 0.
- */
+ result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- if ((result != 0) && (stageRead + dstWrote == 0)) {
- /*
- * We have an incomplete UTF-8 character at the end of the
- * staging buffer. It will get moved to the beginning of the
- * staging buffer followed by more bytes from src.
- */
+ assert (srcRead == nlLen);
- src -= stageLen;
- srcLen += stageLen;
- stageLen = 0;
- savedLF = 0;
- break;
- }
bufPtr->nextAdded += dstWrote;
- if (IsBufferOverflowing(bufPtr)) {
- /*
- * When translating from UTF-8 to external encoding, we
- * allowed the translation to produce a character that crossed
- * the end of the output buffer, so that we would get a
- * completely full buffer before flushing it. The extra bytes
- * will be moved to the beginning of the next buffer.
- */
-
- saved = -SpaceLeft(bufPtr);
- memcpy(safe, dst + dstLen, (size_t) saved);
- bufPtr->nextAdded = bufPtr->bufLength;
- }
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
-
+ src++;
+ srcLen--;
total += dstWrote;
- stage += stageRead;
- stageLen -= stageRead;
- sawLF = 0;
-
- consumedSomething = 1;
+ dst += dstWrote;
+ dstLen -= dstWrote;
+ nextNewLine = memchr(src, '\n', srcLen);
+ needNlFlush = 1;
+ }
+ if (IsBufferOverflowing(bufPtr)) {
/*
- * If all translated characters are written to the buffer,
- * endEncoding is set to 0 because the escape sequence may be
- * output.
+ * When translating from UTF-8 to external encoding, we
+ * allowed the translation to produce a character that crossed
+ * the end of the output buffer, so that we would get a
+ * completely full buffer before flushing it. The extra bytes
+ * will be moved to the beginning of the next buffer.
*/
- if ((stageLen + saved == 0) && (result == 0)) {
- endEncoding = 0;
- }
+ saved = -SpaceLeft(bufPtr);
+ memcpy(safe, dst + dstLen, (size_t) saved);
+ bufPtr->nextAdded = bufPtr->bufLength;
}
- }
-
- /*
- * If nothing was written and it happened because there was no progress in
- * the UTF conversion, we throw an error.
- */
-
- if (!consumedSomething && (total == 0)) {
- Tcl_SetErrno(EINVAL);
- return -1;
- }
- return total;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TranslateOutputEOL --
- *
- * Helper function for WriteBytes() and WriteChars(). Converts the '\n'
- * characters in the source buffer into the appropriate EOL form
- * specified by the output translation mode.
- *
- * EOL translation stops either when the source buffer is empty or the
- * output buffer is full.
- *
- * When converting to CRLF mode and there is only 1 byte left in the
- * output buffer, this routine stores the '\r' in the last byte and then
- * stores the '\n' in the byte just past the end of the buffer. The
- * caller is responsible for passing in a buffer that is large enough to
- * hold the extra byte.
- *
- * Results:
- * The return value is 1 if a '\n' was translated from the source buffer,
- * or 0 otherwise -- this can be used by the caller to decide to flush a
- * line-based channel even though the channel buffer is not full.
- *
- * *dstLenPtr is filled with how many bytes of the output buffer were
- * used. As mentioned above, this can be one more that the output
- * buffer's specified length if a CRLF was stored.
- *
- * *srcLenPtr is filled with how many bytes of the source buffer were
- * consumed.
- *
- * Side effects:
- * It may be obvious, but bears mentioning that when converting in CRLF
- * mode (which requires two bytes of storage in the output buffer), the
- * number of bytes consumed from the source buffer will be less than the
- * number of bytes stored in the output buffer.
- *
- *---------------------------------------------------------------------------
- */
-static int
-TranslateOutputEOL(
- ChannelState *statePtr, /* Channel being read, for translation and
- * buffering modes. */
- char *dst, /* Output buffer filled with UTF-8 chars by
- * applying appropriate EOL translation to
- * source characters. */
- const char *src, /* Source UTF-8 characters. */
- int *dstLenPtr, /* On entry, the maximum length of output
- * buffer in bytes. On exit, the number of
- * bytes actually used in output buffer. */
- int *srcLenPtr) /* On entry, the length of source buffer. On
- * exit, the number of bytes read from the
- * source buffer. */
-{
- char *dstEnd;
- int srcLen, newlineFound;
-
- newlineFound = 0;
- srcLen = *srcLenPtr;
-
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- for (dstEnd = dst + srcLen; dst < dstEnd; ) {
- if (*src == '\n') {
- newlineFound = 1;
- }
- *dst++ = *src++;
- }
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CR:
- for (dstEnd = dst + srcLen; dst < dstEnd;) {
- if (*src == '\n') {
- *dst++ = '\r';
- newlineFound = 1;
- src++;
- } else {
- *dst++ = *src++;
- }
+ if ((srcLen + saved == 0) && (result == TCL_OK)) {
+ endEncoding = 0;
}
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CRLF: {
- /*
- * Since this causes the number of bytes to grow, we start off trying
- * to put 'srcLen' bytes into the output buffer, but allow it to store
- * more bytes, as long as there's still source bytes and room in the
- * output buffer.
- */
-
- char *dstStart, *dstMax;
- const char *srcStart;
-
- dstStart = dst;
- dstMax = dst + *dstLenPtr;
- srcStart = src;
-
- if (srcLen < *dstLenPtr) {
- dstEnd = dst + srcLen;
- } else {
- dstEnd = dst + *dstLenPtr;
- }
- while (dst < dstEnd) {
- if (*src == '\n') {
- if (dstEnd < dstMax) {
- dstEnd++;
- }
- *dst++ = '\r';
- newlineFound = 1;
- }
- *dst++ = *src++;
- }
- *srcLenPtr = src - srcStart;
- *dstLenPtr = dst - dstStart;
- break;
- }
- default:
- break;
- }
- return newlineFound;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * CheckFlush --
- *
- * Helper function for WriteBytes() and WriteChars(). If the channel
- * buffer is ready to be flushed, flush it.
- *
- * Results:
- * The return value is -1 if there was a problem flushing the channel
- * buffer, or 0 otherwise.
- *
- * Side effects:
- * The buffer will be recycled if it is flushed.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-CheckFlush(
- Channel *chanPtr, /* Channel being read, for buffering mode. */
- ChannelBuffer *bufPtr, /* Channel buffer to possibly flush. */
- int newlineFlag) /* Non-zero if a the channel buffer contains a
- * newline. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
-
- /*
- * The current buffer is ready for output:
- * 1. if it is full.
- * 2. if it contains a newline and this channel is line-buffered.
- * 3. if it contains any output and this channel is unbuffered.
- */
-
- if (!GotFlag(statePtr, BUFFER_READY)) {
if (IsBufferFull(bufPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- } else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
- if (newlineFlag != 0) {
- SetFlag(statePtr, BUFFER_READY);
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ ReleaseChannelBuffer(bufPtr);
+ return -1;
}
- } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
- SetFlag(statePtr, BUFFER_READY);
- }
- }
- if (GotFlag(statePtr, BUFFER_READY)) {
+ flushed += statePtr->bufSize;
+
+ /*
+ * We just flushed. So if we have needNlFlush set to record
+ * that we need to flush because theres a (translated) newline
+ * in the buffer, that's likely not true any more. But there
+ * is a tricky exception. If we have saved bytes that did not
+ * really get flushed and those bytes came from a translation
+ * of a newline as the last thing taken from the src array,
+ * then needNlFlush needs to remain set to flag that the
+ * next buffer still needs a newline flush.
+ */
+ if (needNlFlush && (saved == 0 || src[-1] != '\n')) {
+ needNlFlush = 0;
+ }
+ }
+ ReleaseChannelBuffer(bufPtr);
+ }
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
}
- return 0;
+
+ return total;
}
/*
@@ -4612,8 +4439,22 @@ Tcl_GetsObj(
Tcl_EncodingState oldState;
if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
- copiedTotal = -1;
- goto done;
+ return -1;
+ }
+
+ /*
+ * If we're sitting ready to read the eofchar, there's no need to
+ * do it.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+
+ /* TODO: Do we need this? */
+ UpdateInterest(chanPtr);
+ return -1;
}
/*
@@ -4633,6 +4474,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -4656,16 +4498,7 @@ Tcl_GetsObj(
*/
if (encoding == NULL) {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (tsdPtr->binaryEncoding == NULL) {
- tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
- Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
- }
- encoding = tsdPtr->binaryEncoding;
- if (encoding == NULL) {
- Tcl_Panic("attempted gets on binary channel where no iso8859-1 encoding available");
- }
+ encoding = GetBinaryEncoding();
}
/*
@@ -4690,6 +4523,7 @@ Tcl_GetsObj(
eof = NULL;
inEofChar = statePtr->inEofChar;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
if (dst >= dstEnd) {
if (FilterInputBytes(chanPtr, &gs) != 0) {
@@ -4781,14 +4615,14 @@ Tcl_GetsObj(
* Skip the raw bytes that make up the '\n'.
*/
- char tmp[1 + TCL_UTF_MAX];
+ char tmp[TCL_UTF_MAX];
int rawRead;
bufPtr = gs.bufPtr;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
- gs.rawRead, statePtr->inputEncodingFlags,
- &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
- NULL);
+ gs.rawRead, statePtr->inputEncodingFlags
+ | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
+ TCL_UTF_MAX, &rawRead, NULL, NULL);
bufPtr->nextRemoved += rawRead;
gs.rawRead -= rawRead;
gs.bytesWrote--;
@@ -4841,6 +4675,7 @@ Tcl_GetsObj(
dstEnd = eof;
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -4854,6 +4689,7 @@ Tcl_GetsObj(
Tcl_SetObjLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
@@ -4875,7 +4711,11 @@ Tcl_GetsObj(
* self-modifying reflected transforms.
*/
- chanPtr = statePtr->topChanPtr;
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
@@ -4883,8 +4723,9 @@ Tcl_GetsObj(
}
statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst,
+ eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
&gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -4909,16 +4750,18 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4947,14 +4790,24 @@ Tcl_GetsObj(
*/
done:
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
}
@@ -4967,6 +4820,11 @@ Tcl_GetsObj(
* end-of-line or end-of-file has been seen. Bytes read from the input
* channel return as a ByteArray obj.
*
+ * WARNING! The notion of "binary" used here is different from
+ * notions of "binary" used in other places. In particular, this
+ * "binary" routine may be called when an -eofchar is set on the
+ * channel.
+ *
* Results:
* Number of characters accumulated in the object or -1 if error,
* blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
@@ -5000,6 +4858,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -5027,6 +4886,7 @@ TclGetsObjBinary(
eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
/*
* Subtract the number of bytes that were removed from channel
@@ -5046,17 +4906,24 @@ TclGetsObjBinary(
* hasn't seen EOL. Need to read more bytes from the channel
* device. Side effect is to allocate another channel buffer.
*/
-
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto restore;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
if (GetInput(chanPtr) != 0) {
goto restore;
}
bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
+ } else {
+ /*
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
+ * A new CHANNEL_STICKY_EOF set in this routine leads to
+ * return before coming back here. When we are not dealing
+ * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
+ * empty buffer. Here the buffer is non-empty so we know
+ * we're a non-EOF */
+
+ assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+ assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -5098,6 +4965,7 @@ TclGetsObjBinary(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -5111,10 +4979,15 @@ TclGetsObjBinary(
byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
}
+ if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
+ == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
+ goto restore;
+ }
/*
* Copy bytes from the channel buffer to the ByteArray.
@@ -5169,12 +5042,12 @@ TclGetsObjBinary(
restore:
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+ if (bufPtr) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -5202,7 +5075,13 @@ TclGetsObjBinary(
*/
done:
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
}
@@ -5231,6 +5110,21 @@ FreeBinaryEncoding(
tsdPtr->binaryEncoding = NULL;
}
}
+
+static Tcl_Encoding
+GetBinaryEncoding()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->binaryEncoding == NULL) {
+ tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
+ }
+ if (tsdPtr->binaryEncoding == NULL) {
+ Tcl_Panic("binary encoding is not available");
+ }
+ return tsdPtr->binaryEncoding;
+}
/*
*---------------------------------------------------------------------------
@@ -5264,7 +5158,7 @@ FilterInputBytes(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- char *raw, *rawStart, *dst;
+ char *raw, *dst;
int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
Tcl_Obj *objPtr;
#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at
@@ -5298,13 +5192,11 @@ FilterInputBytes(
*/
read:
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- gsPtr->charsWrote = 0;
- gsPtr->rawRead = 0;
- return -1;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
}
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
@@ -5313,6 +5205,22 @@ FilterInputBytes(
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ } else {
+ /*
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
+ * A new CHANNEL_STICKY_EOF set in this routine leads to
+ * return before coming back here. When we are not dealing
+ * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
+ * empty buffer. Here the buffer is non-empty so we know
+ * we're a non-EOF */
+
+ assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+ assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
/*
@@ -5321,8 +5229,7 @@ FilterInputBytes(
* string rep if we need more space.
*/
- rawStart = RemovePoint(bufPtr);
- raw = rawStart;
+ raw = RemovePoint(bufPtr);
rawLen = BytesLeft(bufPtr);
dst = *gsPtr->dstPtr;
@@ -5350,9 +5257,9 @@ FilterInputBytes(
}
gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
- &gsPtr->charsWrote);
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
+ &gsPtr->bytesWrote, &gsPtr->charsWrote);
/*
* Make sure that if we go through 'gets', that we reset the
@@ -5389,7 +5296,7 @@ FilterInputBytes(
} else {
/*
* There are no more cached raw bytes left. See if we can get
- * some more.
+ * some more, but avoid blocking on a non-blocking channel.
*/
goto read;
@@ -5630,134 +5537,87 @@ Tcl_Read(
int
Tcl_ReadRaw(
Tcl_Channel chan, /* The channel from which to read. */
- char *bufPtr, /* Where to store input read. */
+ char *readBuf, /* Where to store input read. */
int bytesToRead) /* Maximum number of bytes to read. */
{
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- int nread, result, copied, copiedNow;
-
- /*
- * The check below does too much because it will reject a call to this
- * function with a channel which is part of an 'fcopy'. But we have to
- * allow this here or else the chaining in the transformation drivers will
- * fail with 'file busy' error instead of retrieving and transforming the
- * data to copy.
- *
- * We let the check procedure now believe that there is no fcopy in
- * progress. A better solution than this might be an additional flag
- * argument to switch off specific checks.
- */
+ int copied = 0;
+ assert(bytesToRead > 0);
if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
return -1;
}
- /*
- * Check for information in the push-back buffers. If there is some, use
- * it. Go to the driver only if there is none (anymore) and the caller
- * requests more bytes.
- */
+ /* First read bytes from the push-back buffers. */
- for (copied = 0; copied < bytesToRead; copied += copiedNow) {
- copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
- bytesToRead - copied);
- if (copiedNow == 0) {
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- goto done;
- }
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
+ while (chanPtr->inQueueHead && bytesToRead > 0) {
+ ChannelBuffer *bufPtr = chanPtr->inQueueHead;
+ int bytesInBuffer = BytesLeft(bufPtr);
+ int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
+ : bytesToRead;
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [Bug 943274]. Better emulation of non-blocking channels for
- * channels without BlockModeProc, by keeping track of true
- * fileevents generated by the OS == Data waiting and reading if
- * and only if we are sure to have data.
- */
+ /* Copy the current chunk into the read buffer. */
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
- /*
- * We bypass the driver; it would block as no data is
- * available.
- */
+ memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
+ bufPtr->nextRemoved += toCopy;
+ copied += toCopy;
+ readBuf += toCopy;
+ bytesToRead -= toCopy;
- nread = -1;
- result = EWOULDBLOCK;
- } else
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- {
- /*
- * Now go to the driver to get as much as is possible to fill
- * the remaining request. Do all the error handling by
- * ourselves. The code was stolen from 'GetInput' and slightly
- * adapted (different return value here).
- *
- * The case of 'bytesToRead == 0' at this point cannot happen.
- */
+ /* If the current buffer is empty recycle it. */
- nread = ChanRead(chanPtr, bufPtr + copied,
- bytesToRead - copied, &result);
+ if (IsBufferEmpty(bufPtr)) {
+ chanPtr->inQueueHead = bufPtr->nextPtr;
+ if (chanPtr->inQueueHead == NULL) {
+ chanPtr->inQueueTail = NULL;
}
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
+ }
+ }
- if (nread > 0) {
- /*
- * If we get a short read, signal up that we may be BLOCKED.
- * We should avoid calling the driver because on some
- * platforms we will block in the low level reading code even
- * though the channel is set into nonblocking mode.
- */
-
- if (nread < (bytesToRead - copied)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= (bytesToRead - copied)) {
- /*
- * [Bug 943274] We have read the available data, clear
- * flag.
- */
+ /*
+ * Go to the driver only if we got nothing from pushback.
+ * Have to do it this way to avoid EOF mis-timings when we
+ * consider the ability that EOF may not be a permanent
+ * condition in the driver, and in that case we have to
+ * synchronize.
+ */
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- if (copied > 0) {
- /*
- * Information that was copied earlier has precedence
- * over EAGAIN/WOULDBLOCK handling.
- */
+ if (copied) {
+ return copied;
+ }
- return copied;
- }
+ /* This test not needed. */
+ if (bytesToRead > 0) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
+ int nread = ChanRead(chanPtr, readBuf, bytesToRead);
- Tcl_SetErrno(result);
- return -1;
+ if (nread > 0) {
+ /* Successful read (short is OK) - add to bytes copied */
+ copied += nread;
+ } else if (nread < 0) {
+ /*
+ * An error signaled. If CHANNEL_BLOCKED, then the error
+ * is not real, but an indication of blocked state. In
+ * that case, retain the flag and let caller receive the
+ * short read of copied bytes from the pushback.
+ * HOWEVER, if copied==0 bytes from pushback then repeat
+ * signalling the blocked state as an error to caller so
+ * there is no false report of an EOF.
+ * When !CHANNEL_BLOCKED, the error is real and passes on
+ * to caller.
+ */
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
+ copied = -1;
}
-
- return copied + nread;
+ } else {
+ /*
+ * nread == 0. Driver is at EOF. Let that state filter up.
+ */
}
}
-
- done:
return copied;
}
@@ -5854,20 +5714,18 @@ DoReadChars(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- int offset, factor, copied, copiedNow, result;
- Tcl_Encoding encoding;
+ int copied, copiedNow, result;
+ Tcl_Encoding encoding = statePtr->encoding;
+ int binaryMode;
#define UTF_EXPANSION_FACTOR 1024
+ int factor = UTF_EXPANSION_FACTOR;
- /*
- * This operation should occur at the top of a channel stack.
- */
-
- chanPtr = statePtr->topChanPtr;
- encoding = statePtr->encoding;
- factor = UTF_EXPANSION_FACTOR;
+ binaryMode = (encoding == NULL)
+ && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
+ && (statePtr->inEofChar == '\0');
if (appendFlag == 0) {
- if (encoding == NULL) {
+ if (binaryMode) {
Tcl_SetByteArrayLength(objPtr, 0);
} else {
Tcl_SetObjLength(objPtr, 0);
@@ -5876,27 +5734,63 @@ DoReadChars(
* We're going to access objPtr->bytes directly, so we must ensure
* that this is actually a string object (otherwise it might have
* been pure Unicode).
+ *
+ * Probably not needed anymore.
*/
TclGetString(objPtr);
}
- offset = 0;
- } else {
- if (encoding == NULL) {
- Tcl_GetByteArrayFromObj(objPtr, &offset);
- } else {
- TclGetStringFromObj(objPtr, &offset);
+ }
+
+ /*
+ * Early out when next read will see eofchar.
+ *
+ * NOTE: See DoRead for argument that it's a bug (one we're keeping)
+ * to have this escape before the one for zero-char read request.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+
+ /* TODO: We don't need this call? */
+ UpdateInterest(chanPtr);
+ return 0;
+ }
+
+ /* Special handling for zero-char read request. */
+ if (toRead == 0) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+ /* TODO: We don't need this call? */
+ UpdateInterest(chanPtr);
+ return 0;
}
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+
+ /* Must clear the BLOCKED|EOF flags here since we check before reading */
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
for (copied = 0; (unsigned) toRead > 0; ) {
copiedNow = -1;
if (statePtr->inQueueHead != NULL) {
- if (encoding == NULL) {
- copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
+ if (binaryMode) {
+ copiedNow = ReadBytes(statePtr, objPtr, toRead);
} else {
- copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
- &factor);
+ copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
}
/*
@@ -5919,19 +5813,21 @@ DoReadChars(
if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- break;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ break;
}
result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
if (result != 0) {
- if (result == EAGAIN) {
- break;
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ copied = -1;
}
- copied = -1;
- goto done;
+ break;
}
} else {
copied += copiedNow;
@@ -5939,27 +5835,36 @@ DoReadChars(
}
}
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- if (encoding == NULL) {
- Tcl_SetByteArrayLength(objPtr, offset);
- } else {
- Tcl_SetObjLength(objPtr, offset);
- }
-
/*
- * Update the notifier state so we don't block while there is still data
- * in the buffers.
+ * Failure to fill a channel buffer may have left channel reporting
+ * a "blocked" state, but so long as we fulfilled the request here,
+ * the caller does not consider us blocked.
*/
+ if (toRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
- done:
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
- chanPtr = statePtr->topChanPtr;
-
+ /*
+ * Update the notifier state so we don't block while there is still data
+ * in the buffers.
+ */
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copied;
}
@@ -5977,13 +5882,11 @@ DoReadChars(
* allocated to hold data read from the channel as needed.
*
* Results:
- * The return value is the number of bytes appended to the object and
- * *offsetPtr is filled with the total number of bytes in the object
- * (greater than the return value if there were already bytes in the
- * object).
+ * The return value is the number of bytes appended to the object, or
+ * -1 to indicate that zero bytes were read due to an EOF.
*
* Side effects:
- * None.
+ * The storage of bytes in objPtr can cause (re-)allocation of memory.
*
*---------------------------------------------------------------------------
*/
@@ -5996,72 +5899,22 @@ ReadBytes(
* been allocated to hold data, not how many
* bytes of data have been stored in the
* object. */
- int bytesToRead, /* Maximum number of bytes to store, or < 0 to
+ int bytesToRead) /* Maximum number of bytes to store, or < 0 to
* get all available bytes. Bytes are obtained
* from the first buffer in the queue - even
* if this number is larger than the number of
* bytes available in the first buffer, only
* the bytes from the first buffer are
* returned. */
- int *offsetPtr) /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
{
- int toRead, srcLen, offset, length, srcRead, dstWrote;
- ChannelBuffer *bufPtr;
- char *src, *dst;
-
- offset = *offsetPtr;
-
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
-
- toRead = bytesToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
- toRead = srcLen;
- }
-
- dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
- if (toRead > length - offset - 1) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we may get from the source buffer, whichever is
- * larger.
- */
-
- length = offset * 2;
- if (offset < toRead) {
- length = offset + toRead + 1;
- }
- dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
- }
- dst += offset;
-
- if (GotFlag(statePtr, INPUT_NEED_NL)) {
- ResetFlag(statePtr, INPUT_NEED_NL);
- if ((srcLen == 0) || (*src != '\n')) {
- *dst = '\r';
- *offsetPtr += 1;
- return 1;
- }
- *dst++ = '\n';
- src++;
- srcLen--;
- toRead--;
- }
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int srcLen = BytesLeft(bufPtr);
+ int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead;
- srcRead = srcLen;
- dstWrote = toRead;
- if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
- if (dstWrote == 0) {
- return -1;
- }
- }
- bufPtr->nextRemoved += srcRead;
- *offsetPtr += dstWrote;
- return dstWrote;
+ TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr),
+ toRead);
+ bufPtr->nextRemoved += toRead;
+ return toRead;
}
/*
@@ -6105,35 +5958,35 @@ ReadChars(
* is larger than the number of characters
* available in the first buffer, only the
* characters from the first buffer are
- * returned. */
- int *offsetPtr, /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
+ * returned. The execption is when there is
+ * not any complete character in the first
+ * buffer. In that case, a recursive call
+ * effectively obtains chars from the
+ * second buffer. */
int *factorPtr) /* On input, contains a guess of how many
* bytes need to be allocated to hold the
* result of converting N source bytes to
* UTF-8. On output, contains another guess
* based on the data seen so far. */
{
- int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
- int srcRead, dstWrote, numChars, dstRead;
- ChannelBuffer *bufPtr;
- char *src, *dst;
- Tcl_EncodingState oldState;
- int encEndFlagSuppressed = 0;
-
- factor = *factorPtr;
- offset = *offsetPtr;
+ Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
+ : GetBinaryEncoding();
+ Tcl_EncodingState savedState = statePtr->inputEncodingState;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int savedIEFlags = statePtr->inputEncodingFlags;
+ int savedFlags = statePtr->flags;
+ char *dst, *src = RemovePoint(bufPtr);
+ int numBytes, srcLen = BytesLeft(bufPtr);
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
+ /*
+ * One src byte can yield at most one character. So when the
+ * number of src bytes we plan to read is less than the limit on
+ * character count to be read, clearly we will remain within that
+ * limit, and we can use the value of "srcLen" as a tighter limit
+ * for sizing receiving buffers.
+ */
- toRead = charsToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
- toRead = srcLen;
- }
+ int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
/*
* 'factor' is how much we guess that the bytes in the source buffer will
@@ -6141,226 +5994,335 @@ ReadChars(
* how many characters were produced by the previous pass.
*/
- dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- spaceLeft = objPtr->length - offset;
-
- if (dstNeeded > spaceLeft) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we want from the source buffer, whichever is
- * larger.
- */
-
- int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+ int factor = *factorPtr;
+ int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- length = offset + dstNeeded;
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- dstNeeded = TCL_UTF_MAX - 1 + toRead;
- length = offset + dstNeeded;
- Tcl_SetObjLength(objPtr, length);
- }
- }
- spaceLeft = length - offset;
- }
+ (void) TclGetStringFromObj(objPtr, &numBytes);
+ Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
- /*
- * Want to convert the whole buffer in one pass. If we have enough
- * space, convert it using all available space in object rather than
- * using the factor.
- */
-
- dstNeeded = spaceLeft;
+ unsigned int size;
+ dst = TclGetStringStorage(objPtr, &size) + numBytes;
+ dstLimit = size - numBytes;
+ } else {
+ dst = TclGetString(objPtr) + numBytes;
}
- dst = objPtr->bytes + offset;
/*
- * [Bug 1462248]: The cause of the crash reported in this bug is this:
- *
- * - ReadChars, called with a single buffer, with a incomplete
- * multi-byte character at the end (only the first byte of it).
- * - Encoding translation fails, asks for more data
- * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
- * - ReadChar is called again, converts the first buffer, but due to TEE
- * it does not check for incomplete multi-byte data, and the character
- * just after the end of the first buffer is a valid completion of the
- * multi-byte header in the actual buffer. The conversion reads more
- * characters from the buffer then present. This causes nextRemoved to
- * overshoot nextAdded and the next reads compute a negative srcLen,
- * cause further translations to fail, causing copying of data into the
- * next buffer using bad arguments, causing the mecpy for to eventually
- * fail.
- *
- * In the end it is a memory access bug spiraling out of control if the
- * conditions are _just so_. And ultimate cause is that TEE is given to a
- * conversion where it should not. TEE signals that this is the last
- * buffer. Except in our case it is not.
+ * This routine is burdened with satisfying several constraints.
+ * It cannot append more than 'charsToRead` chars onto objPtr.
+ * This is measured after encoding and translation transformations
+ * are completed. There is no precise number of src bytes that can
+ * be associated with the limit. Yet, when we are done, we must know
+ * precisely the number of src bytes that were consumed to produce
+ * the appended chars, so that all subsequent bytes are left in
+ * the buffers for future read operations.
*
- * My solution is to suppress TEE if the first buffer is not the last. We
- * will eventually need it given that EOF has been reached, but not right
- * now. This is what the new flag "endEncSuppressFlag" is for.
- *
- * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
- * actual buffer has been fixed as well, and fixes the problem with the
- * crash too, but this would still allow the generic layer to
- * accidentially break a multi-byte sequence if the conditions are just
- * right, because again the ExternalToUtf would be successful where it
- * should not.
+ * The consequence is that we have no choice but to implement a
+ * "trial and error" approach, where in general we may need to
+ * perform transformations and copies multiple times to achieve
+ * a consistent set of results. This takes the shape of a loop.
*/
- if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
- (bufPtr->nextPtr != NULL)) {
+ while (1) {
+ int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
+ int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;
+
+ if (charsToRead > 0) {
+ flags |= TCL_ENCODING_CHAR_LIMIT;
+ numChars = charsToRead;
+ }
+
/*
- * TEE is set for a buffer which is not the last. Squash it for now,
- * and restore it later, before yielding control to our caller.
+ * Perform the encoding transformation. Read no more than
+ * srcLen bytes, write no more than dstLimit bytes.
+ *
+ * Some trickiness with encoding flags here. We do not want
+ * the end of a buffer to be treated as the end of all input
+ * when the presence of bytes in a next buffer are already
+ * known to exist. This is checked with an assert() because
+ * so far no test case causing the assertion to be false has
+ * been created. The normal operations of channel reading
+ * appear to cause EOF and TCL_ENCODING_END setting to appear
+ * only in situations where there are no further bytes in
+ * any buffers.
*/
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
- encEndFlagSuppressed = 1;
- }
+ assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
+ || (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
+
+ code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ flags, &statePtr->inputEncodingState,
+ dst, dstLimit, &srcRead, &dstDecoded, &numChars);
- oldState = statePtr->inputEncodingState;
- if (GotFlag(statePtr, INPUT_NEED_NL)) {
/*
- * We want a '\n' because the last character we saw was '\r'.
+ * Perform the translation transformation in place. Read no more
+ * than the dstDecoded bytes the encoding transformation actually
+ * produced. Capture the number of bytes written in dstWrote.
+ * Capture the number of bytes actually consumed in dstRead.
*/
- ResetFlag(statePtr, INPUT_NEED_NL);
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
- if ((dstWrote > 0) && (*dst == '\n')) {
+ dstWrote = dstLimit;
+ dstRead = dstDecoded;
+ TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
+
+ if (dstRead < dstDecoded) {
+
/*
- * The next char was a '\n'. Consume it and produce a '\n'.
+ * The encoding transformation produced bytes that the
+ * translation transformation did not consume. Why did
+ * this happen?
*/
- bufPtr->nextRemoved += srcRead;
- } else {
+ if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
+ /*
+ * 1) There's an eof char set on the channel, and
+ * we saw it and stopped translating at that point.
+ *
+ * NOTE the bizarre spec of TranslateInputEOL in this case.
+ * Clearly the eof char had to be read in order to account
+ * for the stopping, but the value of dstRead does not
+ * include it.
+ *
+ * Also rather bizarre, our caller can only notice an
+ * EOF condition if we return the value -1 as the number
+ * of chars read. This forces us to perform a 2-call
+ * dance where the first call can read all the chars
+ * up to the eof char, and the second call is solely
+ * for consuming the encoded eof char then pointed at
+ * by src so that we can return that magic -1 value.
+ * This seems really wasteful, especially since
+ * the first decoding pass of each call is likely to
+ * decode many bytes beyond that eof char that's all we
+ * care about.
+ */
+
+ if (dstRead == 0) {
+ /*
+ * Curious choice in the eof char handling. We leave
+ * the eof char in the buffer. So, no need to compute
+ * a proper srcRead value. At this point, there
+ * are no chars before the eof char in the buffer.
+ */
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ {
+ /*
+ * There are chars leading the buffer before the eof
+ * char. Adjust the dstLimit so we go back and read
+ * only those and do not encounter the eof char this
+ * time.
+ */
+
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
+ }
+
/*
- * The next char was not a '\n'. Produce a '\r'.
+ * 2) The other way to read fewer bytes than are decoded
+ * is when the final byte is \r and we're in a CRLF
+ * translation mode so we cannot decide whether to
+ * record \r or \n yet.
*/
- *dst = '\r';
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
- *offsetPtr += 1;
+ assert(dst[dstRead] == '\r');
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
- return 1;
- }
+ if (dstWrote > 0) {
+ /*
+ * There are chars we can read before we hit the bare cr.
+ * Go back with a smaller dstLimit so we get them in the
+ * next pass, compute a matching srcRead, and don't end
+ * up back here in this call.
+ */
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- dstNeeded + 1, &srcRead, &dstWrote, &numChars);
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
+ assert(dstWrote == 0);
+ assert(dstRead == 0);
- if (srcRead == 0) {
- /*
- * Not enough bytes in src buffer to make a complete char. Copy the
- * bytes to the next buffer to make a new contiguous string, then tell
- * the caller to fill the buffer with more bytes.
- */
+ /*
+ * We decoded only the bare cr, and we cannot read a
+ * translated char from that alone. We have to know what's
+ * next. So why do we only have the one decoded char?
+ */
- ChannelBuffer *nextPtr;
+ if (code != TCL_OK) {
+ char buffer[TCL_UTF_MAX + 1];
+ int read, decoded, count;
- nextPtr = bufPtr->nextPtr;
- if (nextPtr == NULL) {
- if (srcLen > 0) {
/*
- * There isn't enough data in the buffers to complete the next
- * character, so we need to wait for more data before the next
- * file event can be delivered. [Bug 478856]
- *
- * The exception to this is if the input buffer was completely
- * empty before we tried to convert its contents. Nothing in,
- * nothing out, and no incomplete character data. The
- * conversion before the current one was complete.
+ * Didn't get everything the buffer could offer
*/
- SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+
+ assert(bufPtr->nextPtr == NULL
+ || BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
+ (statePtr->inputEncodingFlags & TCL_ENCODING_END));
+
+ Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
+ &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
+ &read, &decoded, &count);
+
+ if (count == 2) {
+ if (buffer[1] == '\n') {
+ /* \r\n translate to \n */
+ dst[0] = '\n';
+ bufPtr->nextRemoved += read;
+ } else {
+ dst[0] = '\r';
+ bufPtr->nextRemoved += srcRead;
+ }
+
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
+ }
+
+ } else if (statePtr->flags & CHANNEL_EOF) {
+
+ /*
+ * The bare \r is the only char and we will never read
+ * a subsequent char to make the determination.
+ */
+
+ dst[0] = '\r';
+ bufPtr->nextRemoved = bufPtr->nextAdded;
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
}
- return -1;
+
+ /*
+ * Revise the dstRead value so that the numChars calc
+ * below correctly computes zero characters read.
+ */
+
+ dstRead = numChars;
+
+ /* FALL THROUGH - get more data (dstWrote == 0) */
}
/*
- * Space is made at the beginning of the buffer to copy the previous
- * unused bytes there. Check first if the buffer we are using actually
- * has enough space at its beginning for the data we are copying.
- * Because if not we will write over the buffer management
- * information, especially the 'nextPtr'.
- *
- * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
- * prevent exactly this situation. I.e. it should never happen.
- * Therefore it is ok to panic should it happen despite the
- * precautions.
+ * The translation transformation can only reduce the number
+ * of chars when it converts \r\n into \n. The reduction in
+ * the number of chars is the difference in bytes read and written.
*/
- if (nextPtr->nextRemoved - srcLen < 0) {
- Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
- }
+ numChars -= (dstRead - dstWrote);
- nextPtr->nextRemoved -= srcLen;
- memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
- RecycleBuffer(statePtr, bufPtr, 0);
- statePtr->inQueueHead = nextPtr;
- return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
- }
+ if (charsToRead > 0 && numChars > charsToRead) {
- dstRead = dstWrote;
- if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
- /*
- * Hit EOF char. How many bytes of src correspond to where the EOF was
- * located in dst? Run the conversion again with an output buffer just
- * big enough to hold the data so we can get the correct value for
- * srcRead.
- */
+ /*
+ * TODO: This cannot happen anymore.
+ *
+ * We read more chars than allowed. Reset limits to
+ * prevent that and try again. Don't forget the extra
+ * padding of TCL_UTF_MAX bytes demanded by the
+ * Tcl_ExternalToUtf() call!
+ */
- if (dstWrote == 0) {
- return -1;
+ dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
}
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- }
- /*
- * The number of characters that we got may be less than the number that
- * we started with because "\r\n" sequences may have been turned into just
- * '\n' in dst.
- */
+ if (dstWrote == 0) {
+ ChannelBuffer *nextPtr;
- numChars -= dstRead - dstWrote;
+ /* We were not able to read any chars. */
- if ((unsigned) numChars > (unsigned) toRead) {
- /*
- * Got too many chars.
- */
+ assert (numChars == 0);
- const char *eof = Tcl_UtfAtIndex(dst, toRead);
+ /*
+ * There is one situation where this is the correct final
+ * result. If the src buffer contains only a single \n
+ * byte, and we are in TCL_TRANSLATE_AUTO mode, and
+ * when the translation pass was made the INPUT_SAW_CR
+ * flag was set on the channel. In that case, the
+ * correct behavior is to consume that \n and produce the
+ * empty string.
+ */
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- dstRead = dstWrote;
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- numChars -= (dstRead - dstWrote);
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ if (dstRead == 1 && dst[0] == '\n') {
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
+
+ goto consume;
+ }
+
+ /* Otherwise, reading zero characters indicates there's
+ * something incomplete at the end of the src buffer.
+ * Maybe there were not enough src bytes to decode into
+ * a char. Maybe a lone \r could not be translated (crlf
+ * mode). Need to combine any unused src bytes we have
+ * in the first buffer with subsequent bytes to try again.
+ */
+
+ nextPtr = bufPtr->nextPtr;
+
+ if (nextPtr == NULL) {
+ if (srcLen > 0) {
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ }
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ /*
+ * Space is made at the beginning of the buffer to copy the
+ * previous unused bytes there. Check first if the buffer we
+ * are using actually has enough space at its beginning for
+ * the data we are copying. Because if not we will write over
+ * the buffer management information, especially the 'nextPtr'.
+ *
+ * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
+ * used to prevent exactly this situation. I.e. it should never
+ * happen. Therefore it is ok to panic should it happen despite
+ * the precautions.
+ */
+
+ if (nextPtr->nextRemoved - srcLen < 0) {
+ Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+ }
+
+ nextPtr->nextRemoved -= srcLen;
+ memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ Tcl_SetObjLength(objPtr, numBytes);
+ return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
+ }
- bufPtr->nextRemoved += srcRead;
- if (dstWrote > srcRead + 1) {
- *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ consume:
+ bufPtr->nextRemoved += srcRead;
+ /*
+ * If this read contained multibyte characters, revise factorPtr
+ * so the next read will allocate bigger buffers.
+ */
+ if (numChars && numChars < srcRead) {
+ *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars;
+ }
+ Tcl_SetObjLength(objPtr, numBytes + dstWrote);
+ return numChars;
}
- *offsetPtr += dstWrote;
- return numChars;
}
/*
@@ -6381,7 +6343,7 @@ ReadChars(
*---------------------------------------------------------------------------
*/
-static int
+static void
TranslateInputEOL(
ChannelState *statePtr, /* Channel being read, for EOL translation and
* EOF character. */
@@ -6390,132 +6352,138 @@ TranslateInputEOL(
* characters. */
const char *srcStart, /* Source characters. */
int *dstLenPtr, /* On entry, the maximum length of output
- * buffer in bytes; must be <= *srcLenPtr. On
- * exit, the number of bytes actually used in
- * output buffer. */
+ * buffer in bytes. On exit, the number of
+ * bytes actually used in output buffer. */
int *srcLenPtr) /* On entry, the length of source buffer. On
* exit, the number of bytes read from the
* source buffer. */
{
- int dstLen, srcLen, inEofChar;
- const char *eof;
+ const char *eof = NULL;
+ int dstLen = *dstLenPtr;
+ int srcLen = *srcLenPtr;
+ int inEofChar = statePtr->inEofChar;
- dstLen = *dstLenPtr;
+ /*
+ * Depending on the translation mode in use, there's no need
+ * to scan more srcLen bytes at srcStart than can possibly transform
+ * to dstLen bytes. This keeps the scan for eof char below from
+ * being pointlessly long.
+ */
+
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
+ if (srcLen > dstLen) {
+ /* In these modes, each src byte become a dst byte. */
+ srcLen = dstLen;
+ }
+ break;
+ default:
+ /* In other modes, at most 2 src bytes become a dst byte. */
+ if (srcLen/2 > dstLen) {
+ srcLen = 2 * dstLen;
+ }
+ break;
+ }
- eof = NULL;
- inEofChar = statePtr->inEofChar;
if (inEofChar != '\0') {
/*
- * Find EOF in translated buffer then compress out the EOL. The source
- * buffer may be much longer than the destination buffer - we only
- * want to return EOF if the EOF has been copied to the destination
- * buffer.
+ * Make sure we do not read past any logical end of channel input
+ * created by the presence of the input eof char.
*/
- const char *src, *srcMax = srcStart + *srcLenPtr;
-
- for (src = srcStart; src < srcMax; src++) {
- if (*src == inEofChar) {
- eof = src;
- srcLen = src - srcStart;
- if (srcLen < dstLen) {
- dstLen = srcLen;
- }
- *srcLenPtr = srcLen;
- break;
- }
+ if ((eof = memchr(srcStart, inEofChar, srcLen))) {
+ srcLen = eof - srcStart;
}
}
+
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
+ memcpy(dstStart, srcStart, (size_t) srcLen);
}
- srcLen = dstLen;
- break;
- case TCL_TRANSLATE_CR: {
- char *dst, *dstEnd;
+ if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ char *dst = dstStart;
+ char *dstEnd = dstStart + srcLen;
- if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
- }
- dstEnd = dstStart + dstLen;
- for (dst = dstStart; dst < dstEnd; dst++) {
- if (*dst == '\r') {
- *dst = '\n';
+ while ((dst = memchr(dst, '\r', dstEnd - dst))) {
+ *dst++ = '\n';
}
}
- srcLen = dstLen;
+ dstLen = srcLen;
break;
- }
case TCL_TRANSLATE_CRLF: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
-
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_NEED_NL);
- } else if (*src == '\n') {
- *dst++ = *src++;
- } else {
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser = (dstLen < srcLen) ? dstLen : srcLen;
+
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst += numBytes; dstLen -= numBytes;
+ src += numBytes; srcLen -= numBytes;
+ if (srcLen == 1) {
+ /* valid src bytes end in \r */
+ if (eof) {
*dst++ = '\r';
+ src++; srcLen--;
+ } else {
+ lesser = 0;
+ break;
}
+ } else if (src[1] == '\n') {
+ *dst++ = '\n';
+ src += 2; srcLen -= 2;
} else {
- *dst++ = *src++;
+ *dst++ = '\r';
+ src++; srcLen--;
}
+ dstLen--;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
case TCL_TRANSLATE_AUTO: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser;
- if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
- if (*src == '\n') {
- src++;
- }
+ if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
+ if (*src == '\n') { src++; srcLen--; }
ResetFlag(statePtr, INPUT_SAW_CR);
}
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else if (*src == '\n') {
- if (srcEnd < srcMax) {
- srcEnd++;
- }
- src++;
- }
- *dst++ = '\n';
- } else {
- *dst++ = *src++;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst[numBytes] = '\n';
+ dst += numBytes + 1; dstLen -= numBytes + 1;
+ src += numBytes + 1; srcLen -= numBytes + 1;
+ if (srcLen == 0) {
+ SetFlag(statePtr, INPUT_SAW_CR);
+ } else if (*src == '\n') {
+ src++; srcLen--;
}
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
default:
- return 0;
+ Tcl_Panic("unknown input translation %d", statePtr->inputTranslation);
}
*dstLenPtr = dstLen;
+ *srcLenPtr = srcLen;
- if ((eof != NULL) && (srcStart + srcLen >= eof)) {
+ if (srcStart + srcLen == eof) {
/*
* EOF character was seen in EOL translated range. Leave current file
* position pointing at the EOF character, but don't store the EOF
@@ -6524,12 +6492,8 @@ TranslateInputEOL(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
- return 1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
-
- *srcLenPtr = srcLen;
- return 0;
}
/*
@@ -6583,16 +6547,15 @@ Tcl_Ungets(
statePtr->flags = flags;
/*
- * If we have encountered a sticky EOF, just punt without storing (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading beyond
- * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
- * bit. We want to discover these conditions anew in each operation.
+ * Clear the EOF flags, and clear the BLOCKED bit.
*/
- if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- goto done;
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+ ResetFlag(statePtr,
+ CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
bufPtr = AllocChannelBuffer(len);
memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6657,14 +6620,6 @@ Tcl_Flush(
return -1;
}
- /*
- * Force current output buffer to be output also.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
result = FlushChannel(NULL, chanPtr, 0);
if (result != 0) {
return TCL_ERROR;
@@ -6715,7 +6670,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree(statePtr->saveInBufPtr);
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -6727,6 +6682,9 @@ DiscardInputQueued(
*
* Reads input data from a device into a channel buffer.
*
+ * IMPORTANT! This routine is only called on a chanPtr argument
+ * that is the top channel of a stack!
+ *
* Results:
* The return value is the Posix error code if an error occurred while
* reading from the file, or 0 otherwise.
@@ -6749,6 +6707,14 @@ GetInput(
/* State info for channel */
/*
+ * Verify that all callers know better than to call us when
+ * it's recorded that the next char waiting to be read is the
+ * eofchar.
+ */
+
+ assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+
+ /*
* Prevent reading from a dead channel -- a channel that has been closed
* but not yet deallocated, which can happen if the exit handler for
* channel cleanup has run but the channel is still registered in some
@@ -6760,20 +6726,34 @@ GetInput(
}
/*
+ * WARNING: There was once a comment here claiming that it was
+ * a bad idea to make another call to the inputproc of a channel
+ * driver when EOF has already been detected on the channel. Through
+ * much of Tcl's history, this warning was then completely negated
+ * by having all (most?) read paths clear the EOF setting before
+ * reaching here. So we had a guard that was never triggered.
+ *
+ * Don't be tempted to restore the guard. Even if EOF is set on
+ * the channel, continue through and call the inputproc again. This
+ * is the way to enable the ability to [read] again beyond the EOF,
+ * which seems a strange thing to do, but for which use cases exist
+ * [Tcl Bug 5adc350683] and which may even be essential for channels
+ * representing things like ttys or other devices where the stream
+ * might take the logical form of a series of 'files' separated by
+ * an EOF condition.
+ */
+
+ /*
* First check for more buffers in the pushback area of the topmost
* channel in the stack and use them. They can be the result of a
* transformation which went away without reading all the information
* placed in the area when it was stacked.
- *
- * Two possibilities for the state: No buffers in it, or a single empty
- * buffer. In the latter case we can recycle it now.
*/
if (chanPtr->inQueueHead != NULL) {
- if (statePtr->inQueueHead != NULL) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
- statePtr->inQueueHead = NULL;
- }
+
+ /* TODO: Tests to cover this. */
+ assert(statePtr->inQueueHead == NULL);
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -6794,21 +6774,21 @@ GetInput(
*/
bufPtr = statePtr->inQueueTail;
- if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
- toRead = SpaceLeft(bufPtr);
- } else {
+
+ if ((bufPtr == NULL) || IsBufferFull(bufPtr)) {
bufPtr = statePtr->saveInBufPtr;
statePtr->saveInBufPtr = NULL;
/*
* Check the actual buffersize against the requested buffersize.
- * Buffers which are smaller than requested are squashed. This is done
+ * Saved buffers of the wrong size are squashed. This is done
* to honor dynamic changes of the buffersize made by the user.
+ * TODO: Tests to cover this.
*/
if ((bufPtr != NULL)
- && (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree(bufPtr);
+ && (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
@@ -6817,21 +6797,8 @@ GetInput(
}
bufPtr->nextPtr = NULL;
- /*
- * SF #427196: Use the actual size of the buffer to determine the
- * number of bytes to read from the channel and not the size for new
- * buffers. They can be different if the buffersize was changed
- * between reads.
- *
- * Note: This affects performance negatively if the buffersize was
- * extended but this small buffer is reused for all subsequent reads.
- * The system never uses buffers with the requested bigger size in
- * that case. An adjunct patch could try and delete all unused buffers
- * it encounters and which are smaller than the formally requested
- * buffersize.
- */
-
toRead = SpaceLeft(bufPtr);
+ assert(toRead == statePtr->bufSize);
if (statePtr->inQueueTail == NULL) {
statePtr->inQueueHead = bufPtr;
@@ -6839,75 +6806,22 @@ GetInput(
statePtr->inQueueTail->nextPtr = bufPtr;
}
statePtr->inQueueTail = bufPtr;
+ } else {
+ toRead = SpaceLeft(bufPtr);
}
- /*
- * If EOF is set, we should avoid calling the driver because on some
- * platforms it is impossible to read from a device after EOF.
- */
-
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- return 0;
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [Bug 943274]: Better emulation of non-blocking channels for channels
- * without BlockModeProc, by keeping track of true fileevents generated by
- * the OS == Data waiting and reading if and only if we are sure to have
- * data.
- */
+ PreserveChannelBuffer(bufPtr);
+ nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead);
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
- /*
- * Bypass the driver, it would block, as no data is available
- */
-
- nread = -1;
- result = EWOULDBLOCK;
- } else
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- {
- nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
- }
-
- if (nread > 0) {
+ if (nread < 0) {
+ result = Tcl_GetErrno();
+ } else {
+ result = 0;
bufPtr->nextAdded += nread;
-
- /*
- * If we get a short read, signal up that we may be BLOCKED. We should
- * avoid calling the driver because on some platforms we will block in
- * the low level reading code even though the channel is set into
- * nonblocking mode.
- */
-
- if (nread < toRead) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= toRead) {
- /*
- * [Bug 943274]: We have read the available data, clear flag.
- */
-
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
- Tcl_SetErrno(result);
- return result;
}
- return 0;
+
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -7011,8 +6925,12 @@ Tcl_Seek(
* point. Also clear CR related flags.
*/
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
INPUT_SAW_CR);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
/*
* If the channel is in asynchronous output mode, switch it back to
@@ -7035,15 +6953,6 @@ Tcl_Seek(
}
/*
- * If there is data buffered in statePtr->curOutPtr then mark the channel
- * as ready to flush before invoking FlushChannel.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If the flush fails we cannot recover the original position. In that
* case the seek is not attempted because we do not know where the access
* position is - instead we return the error. FlushChannel has already
@@ -7367,17 +7276,7 @@ CheckChannelErrors(
}
if (direction == TCL_READABLE) {
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading
- * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
- * discover these conditions anew in each operation.
- */
-
- if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
}
return 0;
@@ -7406,9 +7305,7 @@ Tcl_Eof(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
- (GotFlag(statePtr, CHANNEL_EOF) &&
- (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
+ return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
}
/*
@@ -7593,14 +7490,26 @@ Tcl_SetChannelBufferSize(
}
statePtr = ((Channel *) chan)->state;
+
+ if (statePtr->bufSize == sz) {
+ return;
+ }
statePtr->bufSize = sz;
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
+ /*
+ * If bufsize changes, need to get rid of old utility buffer.
+ */
+
+ if (statePtr->saveInBufPtr != NULL) {
+ RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+ statePtr->saveInBufPtr = NULL;
}
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
+ if ((statePtr->inQueueHead != NULL)
+ && (statePtr->inQueueHead->nextPtr == NULL)
+ && IsBufferEmpty(statePtr->inQueueHead)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
}
}
@@ -8036,6 +7945,7 @@ Tcl_SetChannelOption(
return TCL_ERROR;
}
Tcl_SetChannelBufferSize(chan, newBufferSize);
+ return TCL_OK;
} else if (HaveOpt(2, "-encoding")) {
Tcl_Encoding encoding;
@@ -8053,7 +7963,8 @@ Tcl_SetChannelOption(
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
@@ -8066,6 +7977,7 @@ Tcl_SetChannelOption(
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
+ return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
@@ -8112,7 +8024,11 @@ Tcl_SetChannelOption(
* ahead'. Ditto for blocked.
*/
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
return TCL_OK;
} else if (HaveOpt(1, "-translation")) {
const char *readMode, *writeMode;
@@ -8226,33 +8142,6 @@ Tcl_SetChannelOption(
return Tcl_BadChannelOption(interp, optionName, NULL);
}
- /*
- * If bufsize changes, need to get rid of old utility buffer.
- */
-
- if (statePtr->saveInBufPtr != NULL) {
- RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
- statePtr->saveInBufPtr = NULL;
- }
- if ((statePtr->inQueueHead != NULL)
- && (statePtr->inQueueHead->nextPtr == NULL)
- && IsBufferEmpty(statePtr->inQueueHead)) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
- statePtr->inQueueHead = NULL;
- statePtr->inQueueTail = NULL;
- }
-
- /*
- * If encoding or bufsize changes, need to update output staging buffer.
- */
-
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
- }
return TCL_OK;
}
@@ -8344,21 +8233,6 @@ Tcl_NotifyChannel(
Channel *upChanPtr;
const Tcl_ChannelType *upTypePtr;
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
- * keep track of actual input coming from the OS so that we can do a
- * credible imitation of non-blocking behaviour.
- */
-
- if ((mask & TCL_READABLE) &&
- GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
- SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
/*
* In contrast to the other API functions this procedure walks towards the
* top of a stack and not down from it.
@@ -8408,7 +8282,7 @@ Tcl_NotifyChannel(
* Preserve the channel struct in case the script closes it.
*/
- Tcl_Preserve(channel);
+ TclChannelPreserve((Tcl_Channel)channel);
Tcl_Preserve(statePtr);
/*
@@ -8418,13 +8292,14 @@ Tcl_NotifyChannel(
*/
if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
- FlushChannel(NULL, chanPtr, 1);
- mask &= ~TCL_WRITABLE;
+ if (0 == FlushChannel(NULL, chanPtr, 1)) {
+ mask &= ~TCL_WRITABLE;
+ }
}
/*
* Add this invocation to the list of recursive invocations of
- * ChannelHandlerEventProc.
+ * Tcl_NotifyChannel.
*/
nh.nextHandlerPtr = NULL;
@@ -8439,7 +8314,7 @@ Tcl_NotifyChannel(
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
- chPtr->proc(chPtr->clientData, mask);
+ chPtr->proc(chPtr->clientData, chPtr->mask & mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -8453,11 +8328,16 @@ Tcl_NotifyChannel(
*/
if (chanPtr->typePtr != NULL) {
+ /*
+ * TODO: This call may not be needed. If a handler induced a
+ * change in interest, that handler should have made its own
+ * UpdateInterest() call, one would think.
+ */
UpdateInterest(chanPtr);
}
Tcl_Release(statePtr);
- Tcl_Release(channel);
+ TclChannelRelease(channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
@@ -8487,6 +8367,11 @@ UpdateInterest(
/* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
@@ -8594,29 +8479,8 @@ ChannelTimerProc(
statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
ChannelTimerProc,chanPtr);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * Set the TIMER flag to notify the higher levels that the driver
- * might have no data for us. We do this only if we are in
- * non-blocking mode and the driver has no BlockModeProc because only
- * then we really don't know if the driver will block or not. A
- * similar test is done in "PeekAhead".
- */
-
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
- SetFlag(statePtr, CHANNEL_TIMER_FEV);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
Tcl_Preserve(statePtr);
Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ResetFlag(statePtr, CHANNEL_TIMER_FEV);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
Tcl_Release(statePtr);
} else {
statePtr->timer = NULL;
@@ -8759,7 +8623,7 @@ Tcl_DeleteChannelHandler(
}
/*
- * If ChannelHandlerEventProc is about to process this handler, tell it to
+ * If Tcl_NotifyChannel is about to process this handler, tell it to
* process the next one instead - we are going to delete *this* one.
*/
@@ -8955,7 +8819,7 @@ TclChannelEventScriptInvoker(
*/
Tcl_Preserve(interp);
- Tcl_Preserve(chanPtr);
+ TclChannelPreserve((Tcl_Channel)chanPtr);
result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
@@ -8972,7 +8836,7 @@ TclChannelEventScriptInvoker(
}
Tcl_BackgroundException(interp, result);
}
- Tcl_Release(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
Tcl_Release(interp);
}
@@ -9147,6 +9011,7 @@ TclCopyChannel(
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+ int moveBytes;
inStatePtr = inPtr->state;
outStatePtr = outPtr->state;
@@ -9198,13 +9063,24 @@ TclCopyChannel(
| CHANNEL_UNBUFFERED;
/*
+ * Test for conditions where we know we can just move bytes from input
+ * channel to output channel with no transformation or even examination
+ * of the bytes themselves.
+ */
+
+ moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */
+ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+ && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+ && inStatePtr->encoding == outStatePtr->encoding;
+
+ /*
* Allocate a new CopyState to maintain info about the current copy in
* progress. This structure will be deallocated when the copy is
* completed.
*/
- csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
- csPtr->bufSize = inStatePtr->bufSize;
+ csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+ csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
csPtr->readFlags = readFlags;
@@ -9220,6 +9096,10 @@ TclCopyChannel(
inStatePtr->csPtrR = csPtr;
outStatePtr->csPtrW = csPtr;
+ if (moveBytes) {
+ return MoveBytes(csPtr);
+ }
+
/*
* Special handling of -size 0 async transfers, so that the -command is
* still called asynchronously.
@@ -9254,6 +9134,236 @@ TclCopyChannel(
*----------------------------------------------------------------------
*/
+static void
+MBCallback(
+ CopyState *csPtr,
+ Tcl_Obj *errObj)
+{
+ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
+ Tcl_WideInt total = csPtr->total;
+ Tcl_Interp *interp = csPtr->interp;
+ int code;
+
+ Tcl_IncrRefCount(cmdPtr);
+ StopCopy(csPtr);
+
+ /* TODO: What if cmdPtr is not a list?! */
+
+ Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
+ if (errObj) {
+ Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
+ }
+
+ Tcl_Preserve(interp);
+ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_Release(interp);
+ TclDecrRefCount(cmdPtr);
+}
+
+static void
+MBError(
+ CopyState *csPtr,
+ int mask,
+ int errorCode)
+{
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ Tcl_Obj *errObj;
+
+ Tcl_SetErrno(errorCode);
+
+ errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
+ (mask & TCL_READABLE) ? "read" : "writ",
+ Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
+ Tcl_PosixError(csPtr->interp));
+
+ if (csPtr->cmdPtr) {
+ MBCallback(csPtr, errObj);
+ } else {
+ Tcl_SetObjResult(csPtr->interp, errObj);
+ StopCopy(csPtr);
+ }
+}
+
+static void
+MBEvent(
+ ClientData clientData,
+ int mask)
+{
+ CopyState *csPtr = (CopyState *) clientData;
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+
+ if (mask & TCL_WRITABLE) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
+ switch (MBWrite(csPtr)) {
+ case TCL_OK:
+ MBCallback(csPtr, NULL);
+ break;
+ case TCL_CONTINUE:
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ break;
+ }
+ } else if (mask & TCL_READABLE) {
+ if (TCL_OK == MBRead(csPtr)) {
+ /* When at least one full buffer is present, stop reading. */
+ if (IsBufferFull(inStatePtr->inQueueHead)
+ || !Tcl_InputBlocked(inChan)) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ }
+
+ /* Successful read -- set up to write the bytes we read */
+ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
+ }
+ }
+}
+
+static int
+MBRead(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ int code;
+
+ if (bufPtr && BytesLeft(bufPtr) > 0) {
+ return TCL_OK;
+ }
+
+ code = GetInput(inStatePtr->topChanPtr);
+ if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
+ return TCL_OK;
+ } else {
+ MBError(csPtr, TCL_READABLE, code);
+ return TCL_ERROR;
+ }
+}
+
+static int
+MBWrite(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ ChannelBuffer *tail = NULL;
+ int code;
+ Tcl_WideInt inBytes = 0;
+
+ /* Count up number of bytes waiting in the input queue */
+ while (bufPtr) {
+ inBytes += BytesLeft(bufPtr);
+ tail = bufPtr;
+ if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+ /* Queue has enough bytes to complete the copy */
+ break;
+ }
+ bufPtr = bufPtr->nextPtr;
+ }
+
+ if (bufPtr) {
+ /* Split the overflowing buffer in two */
+ int extra = (int) (inBytes - csPtr->toRead);
+ /* Note that going with int for extra assumes that inBytes is not too
+ * much over toRead to require a wide itself. If that gets violated
+ * then the calculations involving extra must be made wide too.
+ *
+ * Noted with Win32/MSVC debug build treating the warning (possible of
+ * data in int64 to int conversion) as error.
+ */
+
+ bufPtr = AllocChannelBuffer(extra);
+
+ tail->nextAdded -= extra;
+ memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+ bufPtr->nextAdded += extra;
+ bufPtr->nextPtr = tail->nextPtr;
+ tail->nextPtr = NULL;
+ inBytes = csPtr->toRead;
+ }
+
+ /* Update the byte counts */
+ if (csPtr->toRead != -1) {
+ csPtr->toRead -= inBytes;
+ }
+ csPtr->total += inBytes;
+
+ /* Move buffers from input to output channels */
+ if (outStatePtr->outQueueTail) {
+ outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+ } else {
+ outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+ }
+ outStatePtr->outQueueTail = tail;
+ inStatePtr->inQueueHead = bufPtr;
+ if (inStatePtr->inQueueTail == tail) {
+ inStatePtr->inQueueTail = bufPtr;
+ }
+ if (bufPtr == NULL) {
+ inStatePtr->inQueueTail = NULL;
+ }
+
+ code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (code) {
+ MBError(csPtr, TCL_WRITABLE, code);
+ return TCL_ERROR;
+ }
+ if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
+ return TCL_OK;
+ }
+ return TCL_CONTINUE;
+}
+
+static int
+MoveBytes(
+ CopyState *csPtr) /* State of copy operation. */
+{
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
+ int errorCode;
+
+ if (bufPtr && BytesLeft(bufPtr)) {
+ /* If we start with unflushed bytes in the destination
+ * channel, flush them out of the way first. */
+
+ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (errorCode != 0) {
+ MBError(csPtr, TCL_WRITABLE, errorCode);
+ return TCL_ERROR;
+ }
+ }
+
+ if (csPtr->cmdPtr) {
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ return TCL_OK;
+ }
+
+ while (1) {
+ int code;
+
+ if (TCL_ERROR == MBRead(csPtr)) {
+ return TCL_ERROR;
+ }
+ code = MBWrite(csPtr);
+ if (code == TCL_OK) {
+ Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+ StopCopy(csPtr);
+ return TCL_OK;
+ }
+ if (code == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /* code == TCL_CONTINUE --> continue the loop */
+ }
+ return TCL_OK; /* Silence compiler warnings */
+}
+
static int
CopyData(
CopyState *csPtr, /* State of copy operation. */
@@ -9379,6 +9489,10 @@ CopyData(
csPtr);
}
if (size == 0) {
+ if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
+ /* We allowed a short read. Keep trying. */
+ continue;
+ }
if (bufObj != NULL) {
TclDecrRefCount(bufObj);
bufObj = NULL;
@@ -9399,9 +9513,9 @@ CopyData(
}
if (outBinary || sameEncoding) {
- sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
} else {
- sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
}
/*
@@ -9556,12 +9670,23 @@ CopyData(
*
* DoRead --
*
- * Reads a given number of bytes from a channel. No encoding conversions
+ * Stores up to "bytesToRead" bytes in memory pointed to by "dst".
+ * These bytes come from reading the channel "chanPtr" and
+ * performing the configured translations. No encoding conversions
* are applied to the bytes being read.
*
* Results:
- * The number of characters read, or -1 on error. Use Tcl_GetErrno() to
- * retrieve the error code for the error that occurred.
+ * The number of bytes actually stored (<= bytesToRead),
+ * or -1 if there is an error in reading the channel. Use
+ * Tcl_GetErrno() to retrieve the error code for the error
+ * that occurred.
+ *
+ * The number of bytes stored can be less than the number
+ * requested when
+ * - EOF is reached on the channel; or
+ * - the channel is non-blocking, and we've read all we can
+ * without blocking.
+ * - a channel reading error occurs (and we return -1)
*
* Side effects:
* May cause input to be buffered.
@@ -9572,538 +9697,197 @@ CopyData(
static int
DoRead(
Channel *chanPtr, /* The channel from which to read. */
- char *bufPtr, /* Where to store input read. */
- int toRead, /* Maximum number of bytes to read. */
+ char *dst, /* Where to store input read. */
+ int bytesToRead, /* Maximum number of bytes to read. */
int allowShortReads) /* Allow half-blocking (pipes,sockets) */
{
ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- int copied; /* How many characters were copied into the
- * result string? */
- int copiedNow; /* How many characters were copied from the
- * current input buffer? */
- int result; /* Of calling GetInput. */
+ char *p = dst;
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit. Either way
- * clear the BLOCKED bit. We want to discover these anew during each
- * operation.
- */
-
- if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
-
- for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
- toRead - copied);
- if (copiedNow == 0) {
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- goto done;
- }
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
- result = GetInput(chanPtr);
- if (result != 0) {
- if (result != EAGAIN) {
- copied = -1;
- }
- goto done;
- }
- } else if (allowShortReads) {
- copied += copiedNow;
- break;
- }
- }
-
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ assert (bytesToRead >= 0);
/*
- * Update the notifier state so we don't block while there is still data
- * in the buffers.
+ * Early out when we know a read will get the eofchar.
+ *
+ * NOTE: This seems to be a bug. The special handling for
+ * a zero-char read request ought to come first. As coded
+ * the EOF due to eofchar has distinguishing behavior from
+ * the EOF due to reported EOF on the underlying device, and
+ * that seems undesirable. However recent history indicates
+ * that new inconsistent behavior in a patchlevel has problems
+ * too. Keep on keeping on for now.
*/
- done:
- UpdateInterest(chanPtr);
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyAndTranslateBuffer --
- *
- * Copy at most one buffer of input to the result space, doing eol
- * translations according to mode in effect currently.
- *
- * Results:
- * Number of bytes stored in the result buffer (as opposed to the number
- * of bytes read from the channel). May return zero if no input is
- * available to be translated.
- *
- * Side effects:
- * Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CopyAndTranslateBuffer(
- ChannelState *statePtr, /* Channel state from which to read input. */
- char *result, /* Where to store the copied input. */
- int space) /* How many bytes are available in result to
- * store the copied input? */
-{
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- int bytesInBuffer; /* How many bytes are available to be copied
- * in the current input buffer? */
- int copied; /* How many characters were already copied
- * into the destination space? */
- int i; /* Iterates over the copied input looking for
- * the input eofChar. */
-
- /*
- * If there is no input at all, return zero. The invariant is that either
- * there is no buffer in the queue, or if the first buffer is empty, it is
- * also the last buffer (and thus there is no input in the queue). Note
- * also that if the buffer is empty, we leave it in the queue.
- */
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
- if (statePtr->inQueueHead == NULL) {
+ /* TODO: Don't need this call */
+ UpdateInterest(chanPtr);
return 0;
}
- bufPtr = statePtr->inQueueHead;
- bytesInBuffer = BytesLeft(bufPtr);
- copied = 0;
- switch (statePtr->inputTranslation) {
- case TCL_TRANSLATE_LF:
- if (bytesInBuffer == 0) {
- return 0;
+ /* Special handling for zero-char read request. */
+ if (bytesToRead == 0) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+ /* TODO: Don't need this call */
+ UpdateInterest(chanPtr);
+ return 0;
+ }
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ while (bytesToRead) {
/*
- * Copy the current chunk into the result buffer.
+ * Each pass through the loop is intended to process up to
+ * one channel buffer.
*/
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
- break;
- case TCL_TRANSLATE_CR: {
- char *end;
-
- if (bytesInBuffer == 0) {
- return 0;
- }
+ int bytesRead, bytesWritten;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
/*
- * Copy the current chunk into the result buffer, then replace all \r
- * with \n.
+ * Don't read more data if we have what we need.
*/
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ while (!bufPtr || /* We got no buffer! OR */
+ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */
+ (BytesLeft(bufPtr) < bytesToRead) ) ) {
+ /* Not enough bytes in it
+ * yet to fill the dst */
+ int code;
- for (end = result + copied; result < end; result++) {
- if (*result == '\r') {
- *result = '\n';
- }
- }
- break;
- }
- case TCL_TRANSLATE_CRLF: {
- char *src, *end, *dst;
- int curByte;
+ moreData:
+ code = GetInput(chanPtr);
+ bufPtr = statePtr->inQueueHead;
- /*
- * If there is a held-back "\r" at EOF, produce it now.
- */
+ assert (bufPtr != NULL);
- if (bytesInBuffer == 0) {
- if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
- (INPUT_SAW_CR | CHANNEL_EOF)) {
- result[0] = '\r';
- ResetFlag(statePtr, INPUT_SAW_CR);
- return 1;
+ if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
+ /* Further reads cannot do any more */
+ break;
}
- return 0;
- }
- /*
- * Copy the current chunk and replace "\r\n" with "\n" (but not
- * standalone "\r"!).
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
-
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\n') {
- ResetFlag(statePtr, INPUT_SAW_CR);
- } else if (GotFlag(statePtr, INPUT_SAW_CR)) {
- ResetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\r';
- dst++;
- }
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else {
- *dst = (char) curByte;
- dst++;
+ if (code) {
+ /* Read error */
+ UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ return -1;
}
- }
- copied = dst - result;
- break;
- }
- case TCL_TRANSLATE_AUTO: {
- char *src, *end, *dst;
- int curByte;
- if (bytesInBuffer == 0) {
- return 0;
+ assert (IsBufferFull(bufPtr));
}
- /*
- * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
- */
+ assert (bufPtr != NULL);
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ bytesRead = BytesLeft(bufPtr);
+ bytesWritten = bytesToRead;
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\n';
- dst++;
- } else {
- if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {
- *dst = (char) curByte;
- dst++;
- }
- ResetFlag(statePtr, INPUT_SAW_CR);
- }
- }
- copied = dst - result;
- break;
- }
- default:
- Tcl_Panic("unknown eol translation mode");
- }
-
- /*
- * If an in-stream EOF character is set for this channel, check that the
- * input we copied so far does not contain the EOF char. If it does, copy
- * only up to and excluding that character.
- */
+ TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
+ &bytesWritten, &bytesRead);
+ bufPtr->nextRemoved += bytesRead;
+ p += bytesWritten;
+ bytesToRead -= bytesWritten;
- if (statePtr->inEofChar != 0) {
- for (i = 0; i < copied; i++) {
- if (result[i] == (char) statePtr->inEofChar) {
- /*
- * Set sticky EOF so that no further input is presented to the
- * caller.
- */
+ if (!IsBufferEmpty(bufPtr)) {
+ /*
+ * Buffer is not empty. How can that be?
+ *
+ * 0) We stopped early because we got all the bytes
+ * we were seeking. That's fine.
+ */
- SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- copied = i;
+ if (bytesToRead == 0) {
break;
}
- }
- }
-
- /*
- * If the current buffer is empty recycle it.
- */
-
- if (IsBufferEmpty(bufPtr)) {
- statePtr->inQueueHead = bufPtr->nextPtr;
- if (statePtr->inQueueHead == NULL) {
- statePtr->inQueueTail = NULL;
- }
- RecycleBuffer(statePtr, bufPtr, 0);
- }
-
- /*
- * Return the number of characters copied into the result buffer. This may
- * be different from the number of bytes consumed, because of EOL
- * translations.
- */
-
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyBuffer --
- *
- * Copy at most one buffer of input to the result space.
- *
- * Results:
- * Number of bytes stored in the result buffer. May return zero if no
- * input is available.
- *
- * Side effects:
- * Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CopyBuffer(
- Channel *chanPtr, /* Channel from which to read input. */
- char *result, /* Where to store the copied input. */
- int space) /* How many bytes are available in result to
- * store the copied input? */
-{
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- int bytesInBuffer; /* How many bytes are available to be copied
- * in the current input buffer? */
- int copied; /* How many characters were already copied
- * into the destination space? */
-
- /*
- * If there is no input at all, return zero. The invariant is that either
- * there is no buffer in the queue, or if the first buffer is empty, it is
- * also the last buffer (and thus there is no input in the queue). Note
- * also that if the buffer is empty, we don't leave it in the queue, but
- * recycle it.
- */
-
- if (chanPtr->inQueueHead == NULL) {
- return 0;
- }
- bufPtr = chanPtr->inQueueHead;
- bytesInBuffer = BytesLeft(bufPtr);
- copied = 0;
-
- if (bytesInBuffer == 0) {
- RecycleBuffer(chanPtr->state, bufPtr, 0);
- chanPtr->inQueueHead = NULL;
- chanPtr->inQueueTail = NULL;
- return 0;
- }
-
- /*
- * Copy the current chunk into the result buffer.
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
-
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
-
- /*
- * We don't care about in-stream EOF characters here as the data read here
- * may still flow through one or more transformations, i.e. is not in its
- * final state yet.
- */
-
- /*
- * If the current buffer is empty recycle it.
- */
-
- if (IsBufferEmpty(bufPtr)) {
- chanPtr->inQueueHead = bufPtr->nextPtr;
- if (chanPtr->inQueueHead == NULL) {
- chanPtr->inQueueTail = NULL;
- }
- RecycleBuffer(chanPtr->state, bufPtr, 0);
- }
+ /*
+ * 1) We're @EOF because we saw eof char.
+ */
- /*
- * Return the number of characters copied into the result buffer.
- */
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ break;
+ }
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DoWrite --
- *
- * Puts a sequence of characters into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * 2) The buffer holds a \r while in CRLF translation,
+ * followed by the end of the buffer.
+ */
-static int
-DoWrite(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* Data to write. */
- int srcLen) /* Number of bytes to write. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- ChannelBuffer *outBufPtr; /* Current output buffer. */
- int foundNewline; /* Did we find a newline in output? */
- char *dPtr;
- const char *sPtr; /* Search variables for newline. */
- int crsent; /* In CRLF eol translation mode, remember the
- * fact that a CR was output to the channel
- * without its following NL. */
- int i; /* Loop index for newline search. */
- int destCopied; /* How many bytes were used in this
- * destination buffer to hold the output? */
- int totalDestCopied; /* How many bytes total were copied to the
- * channel buffer? */
- int srcCopied; /* How many bytes were copied from the source
- * string? */
- char *destPtr; /* Where in line to copy to? */
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+ assert(RemovePoint(bufPtr)[0] == '\r');
+ assert(BytesLeft(bufPtr) == 1);
- /*
- * If we are in network (or windows) translation mode, record the fact
- * that we have not yet sent a CR to the channel.
- */
+ if (bufPtr->nextPtr == NULL) {
+ /* There's no more buffered data.... */
- crsent = 0;
+ if (statePtr->flags & CHANNEL_EOF) {
+ /* ...and there never will be. */
- /*
- * Loop filling buffers and flushing them until all output has been
- * consumed.
- */
+ *p++ = '\r';
+ bytesToRead--;
+ bufPtr->nextRemoved++;
+ } else if (statePtr->flags & CHANNEL_BLOCKED) {
+ /* ...and we cannot get more now. */
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ break;
+ } else {
+ /* ... so we need to get some. */
+ goto moreData;
+ }
+ }
- srcCopied = 0;
- totalDestCopied = 0;
+ if (bufPtr->nextPtr) {
+ /* There's a next buffer. Shift orphan \r to it. */
- while (srcLen > 0) {
- /*
- * Make sure there is a current output buffer to accept output.
- */
+ ChannelBuffer *nextPtr = bufPtr->nextPtr;
- if (statePtr->curOutPtr == NULL) {
- statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
+ nextPtr->nextRemoved -= 1;
+ RemovePoint(nextPtr)[0] = '\r';
+ bufPtr->nextRemoved++;
+ }
}
- outBufPtr = statePtr->curOutPtr;
-
- destCopied = SpaceLeft(outBufPtr);
- if (destCopied > srcLen) {
- destCopied = srcLen;
+ if (IsBufferEmpty(bufPtr)) {
+ statePtr->inQueueHead = bufPtr->nextPtr;
+ if (statePtr->inQueueHead == NULL) {
+ statePtr->inQueueTail = NULL;
+ }
+ RecycleBuffer(statePtr, bufPtr, 0);
+ bufPtr = statePtr->inQueueHead;
}
- destPtr = InsertPoint(outBufPtr);
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- srcCopied = destCopied;
- memcpy(destPtr, src, (size_t) destCopied);
- break;
- case TCL_TRANSLATE_CR:
- srcCopied = destCopied;
- memcpy(destPtr, src, (size_t) destCopied);
- for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
- if (*dPtr == '\n') {
- *dPtr = '\r';
- }
- }
+ if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
+ && GotFlag(statePtr, CHANNEL_BLOCKED)) {
break;
- case TCL_TRANSLATE_CRLF:
- for (srcCopied = 0, dPtr = destPtr, sPtr = src;
- dPtr < destPtr + destCopied;
- dPtr++, sPtr++, srcCopied++) {
- if (*sPtr == '\n') {
- if (crsent) {
- *dPtr = '\n';
- crsent = 0;
- } else {
- *dPtr = '\r';
- crsent = 1;
- sPtr--, srcCopied--;
- }
- } else {
- *dPtr = *sPtr;
- }
- }
- break;
- case TCL_TRANSLATE_AUTO:
- Tcl_Panic("Tcl_Write: AUTO output translation mode not supported");
- default:
- Tcl_Panic("Tcl_Write: unknown output translation mode");
}
/*
- * The current buffer is ready for output if it is full, or if it
- * contains a newline and this channel is line-buffered, or if it
- * contains any output and this channel is unbuffered.
+ * When there's no buffered data to read, and we're at EOF,
+ * escape to the caller.
*/
- outBufPtr->nextAdded += destCopied;
- if (!GotFlag(statePtr, BUFFER_READY)) {
- if (IsBufferFull(outBufPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- } else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
- for (sPtr = src, i = 0, foundNewline = 0;
- (i < srcCopied) && (!foundNewline);
- i++, sPtr++) {
- if (*sPtr == '\n') {
- foundNewline = 1;
- break;
- }
- }
- if (foundNewline) {
- SetFlag(statePtr, BUFFER_READY);
- }
- } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
- SetFlag(statePtr, BUFFER_READY);
- }
- }
-
- totalDestCopied += srcCopied;
- src += srcCopied;
- srcLen -= srcCopied;
-
- if (GotFlag(statePtr, BUFFER_READY)) {
- if (FlushChannel(NULL, chanPtr, 0) != 0) {
- return -1;
- }
+ if (GotFlag(statePtr, CHANNEL_EOF)
+ && (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
+ break;
}
- } /* Closes "while" */
+ }
+ if (bytesToRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
- return totalDestCopied;
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+ UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ return (int)(p - dst);
}
/*
@@ -10154,12 +9938,16 @@ StopCopy(
CopyState *csPtr) /* State for bg copy to stop . */
{
ChannelState *inStatePtr, *outStatePtr;
+ Tcl_Channel inChan, outChan;
+
int nonBlocking;
if (!csPtr) {
return;
}
+ inChan = (Tcl_Channel) csPtr->readPtr;
+ outChan = (Tcl_Channel) csPtr->writePtr;
inStatePtr = csPtr->readPtr->state;
outStatePtr = csPtr->writePtr->state;
@@ -10184,12 +9972,12 @@ StopCopy(
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
if (csPtr->cmdPtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
- csPtr);
- if (csPtr->readPtr != csPtr->writePtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
- CopyEventProc, csPtr);
+ Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+ if (inChan != outChan) {
+ Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
TclDecrRefCount(csPtr->cmdPtr);
}
inStatePtr->csPtrR = NULL;
@@ -10223,12 +10011,15 @@ StackSetBlockMode(
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
+ ChannelState *statePtr = chanPtr->state;
/*
* Start at the top of the channel stack
+ * TODO: Examine what can go wrong when blockModeProc calls
+ * disturb the stacking state of the channel.
*/
- chanPtr = chanPtr->state->topChanPtr;
+ chanPtr = statePtr->topChanPtr;
while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
@@ -11331,12 +11122,11 @@ DupChannelIntRep(
* currently have an internal rep.*/
{
ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
- Interp *interpPtr = GET_CHANNELINTERP(srcPtr);
SET_CHANNELSTATE(copyPtr, statePtr);
- SET_CHANNELINTERP(copyPtr, interpPtr);
+ SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
Tcl_Preserve(statePtr);
- copyPtr->typePtr = &tclChannelType;
+ copyPtr->typePtr = srcPtr->typePtr;
}
/*
@@ -11362,43 +11152,30 @@ SetChannelFromAny(
register Tcl_Obj *objPtr) /* The object to convert. */
{
ChannelState *statePtr;
- Interp *interpPtr;
if (interp == NULL) {
return TCL_ERROR;
}
- if (objPtr->typePtr == &tclChannelType) {
+ if (objPtr->typePtr == &chanObjType) {
/*
+ * TODO: TAINT Flag and dup'd channel values?
* The channel is valid until any call to DetachChannel occurs.
* Ensure consistency checks are done.
*/
statePtr = GET_CHANNELSTATE(objPtr);
- interpPtr = GET_CHANNELINTERP(objPtr);
if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
Tcl_Release(statePtr);
- UpdateStringOfChannel(objPtr);
objPtr->typePtr = NULL;
- } else if (interpPtr != (Interp*) interp) {
+ } else if (interp != GET_CHANNELINTERP(objPtr)) {
Tcl_Release(statePtr);
- UpdateStringOfChannel(objPtr);
objPtr->typePtr = NULL;
}
}
- if (objPtr->typePtr != &tclChannelType) {
- Tcl_Channel chan;
+ if (objPtr->typePtr != &chanObjType) {
+ Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
- /*
- * We need a valid string with which to check for a valid channel, but
- * make sure not to free internal rep until validated. [Bug 1847044]
- */
-
- if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) {
- objPtr->typePtr->updateStringProc(objPtr);
- }
-
- chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
if (chan == NULL) {
return TCL_ERROR;
}
@@ -11408,7 +11185,7 @@ SetChannelFromAny(
Tcl_Preserve(statePtr);
SET_CHANNELSTATE(objPtr, statePtr);
SET_CHANNELINTERP(objPtr, interp);
- objPtr->typePtr = &tclChannelType;
+ objPtr->typePtr = &chanObjType;
}
return TCL_OK;
}
@@ -11416,45 +11193,6 @@ SetChannelFromAny(
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfChannel --
- *
- * Update the string representation for an object whose internal
- * representation is "Channel".
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's string may be set by converting its Unicode represention
- * to UTF format.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfChannel(
- Tcl_Obj *objPtr) /* Object with string rep to update. */
-{
- if (objPtr->bytes == NULL) {
- ChannelState *statePtr = GET_CHANNELSTATE(objPtr);
- const char *name = statePtr->channelName;
-
- if (name) {
- size_t len = strlen(name);
-
- objPtr->bytes = ckalloc(len + 1);
- objPtr->length = len;
- memcpy(objPtr->bytes, name, len);
- } else {
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FreeChannelIntRep --
*
* Release statePtr storage.
@@ -11497,20 +11235,14 @@ DumpFlags(
ChanFlag('n', CHANNEL_NONBLOCKING);
ChanFlag('l', CHANNEL_LINEBUFFERED);
ChanFlag('u', CHANNEL_UNBUFFERED);
- ChanFlag('R', BUFFER_READY);
ChanFlag('F', BG_FLUSH_SCHEDULED);
ChanFlag('c', CHANNEL_CLOSED);
ChanFlag('E', CHANNEL_EOF);
ChanFlag('S', CHANNEL_STICKY_EOF);
ChanFlag('B', CHANNEL_BLOCKED);
ChanFlag('/', INPUT_SAW_CR);
- ChanFlag('*', INPUT_NEED_NL);
ChanFlag('D', CHANNEL_DEAD);
ChanFlag('R', CHANNEL_RAW_MODE);
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ChanFlag('T', CHANNEL_TIMER_FEV);
- ChanFlag('H', CHANNEL_HAS_MORE_DATA);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
ChanFlag('x', CHANNEL_INCLOSE);
buf[i] ='\0';
diff --git a/generic/tclIO.h b/generic/tclIO.h
index e84f300..b799375 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
*/
typedef struct ChannelBuffer {
+ int refCount; /* Current uses count */
int nextAdded; /* The next position into which a character
* will be put in the buffer. */
int nextRemoved; /* Position of next byte to be removed from
@@ -111,6 +112,8 @@ typedef struct Channel {
ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+
+ int refCount;
} Channel;
/*
@@ -123,7 +126,7 @@ typedef struct Channel {
*/
typedef struct ChannelState {
- const char *channelName; /* The name of the channel instance in Tcl
+ char *channelName; /* The name of the channel instance in Tcl
* commands. Storage is owned by the generic
* IO code, is dynamically allocated. */
int flags; /* ORed combination of the flags defined
@@ -226,11 +229,6 @@ typedef struct ChannelState {
* flushed after every newline. */
#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
* be flushed immediately. */
-#define BUFFER_READY (1<<6) /* Current output buffer (the
- * curOutPtr field in the channel
- * structure) should be output as soon
- * as possible even though it may not
- * be full. */
#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued
* output buffers has been
* scheduled. */
@@ -252,9 +250,6 @@ typedef struct ChannelState {
#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
* translation mode and the last byte
* seen was a "\r". */
-#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
- * and there should be a '\n' at
- * beginning of next buffer. */
#define CHANNEL_DEAD (1<<13) /* The channel has been closed by the
* exit handler (on exit) but not
* deallocated. When any IO operation
@@ -274,29 +269,6 @@ typedef struct ChannelState {
* changes. */
#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
* being used. */
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are notified
- * by is a fileevent generated by a
- * timer. We don't know if the driver
- * has more data and should not try to
- * read from it. If the system needs
- * more than is in the buffers out
- * read routines will simulate a short
- * read (0 characters read) */
-#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a channel
- * if and only if the channel is
- * configured non-blocking, the driver
- * for said channel has no
- * blockmodeproc, and data has arrived
- * for reading at the OS level). A
- * GetInput will pass reading from the
- * driver if the channel is
- * non-blocking, without blockmode
- * proc and the flag has not been set.
- * A read will be performed if the
- * flag is set. This will reset the
- * flag as well. */
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed.
* Its structures are still live and
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 1673bce..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -181,6 +181,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -191,6 +192,7 @@ Tcl_PutsObjCmd(
goto error;
}
}
+ TclChannelRelease(chan);
return TCL_OK;
/*
@@ -205,6 +207,7 @@ Tcl_PutsObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
@@ -252,6 +255,7 @@ Tcl_FlushObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
/*
* TIP #219.
@@ -265,8 +269,10 @@ Tcl_FlushObjCmd(
"error flushing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
+ TclChannelRelease(chan);
return TCL_OK;
}
@@ -299,6 +305,7 @@ Tcl_GetsObjCmd(
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
+ int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -315,6 +322,7 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
@@ -333,20 +341,24 @@ Tcl_GetsObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ TclChannelRelease(chan);
+ return code;
}
/*
@@ -453,6 +465,7 @@ Tcl_ReadObjCmd(
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
/*
@@ -467,6 +480,7 @@ Tcl_ReadObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -485,6 +499,7 @@ Tcl_ReadObjCmd(
}
}
Tcl_SetObjResult(interp, resultPtr);
+ TclChannelRelease(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -544,6 +559,7 @@ Tcl_SeekObjCmd(
mode = modeArray[optionIndex];
}
+ TclChannelPreserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
/*
@@ -558,8 +574,10 @@ Tcl_SeekObjCmd(
"error during seek on \"%s\": %s",
TclGetString(objv[1]), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
+ TclChannelRelease(chan);
return TCL_OK;
}
@@ -590,6 +608,7 @@ Tcl_TellObjCmd(
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
+ int code;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -605,6 +624,7 @@ Tcl_TellObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
newLoc = Tcl_Tell(chan);
/*
@@ -613,7 +633,10 @@ Tcl_TellObjCmd(
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ TclChannelRelease(chan);
+ if (code) {
return TCL_ERROR;
}
@@ -896,7 +919,7 @@ Tcl_ExecObjCmd(
if (string[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+ if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -910,7 +933,7 @@ Tcl_ExecObjCmd(
}
}
if (objc <= skip) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?");
return TCL_ERROR;
}
@@ -1673,7 +1696,7 @@ Tcl_FcopyObjCmd(
toRead = -1;
cmdPtr = NULL;
for (i = 3; i < objc; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index bfe6a10..7f61def 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -187,6 +187,7 @@ struct TransformChannelData {
Tcl_Channel self; /* Our own Channel handle. */
int readIsFlushed; /* Flag to note whether in.flushProc was
* called or not. */
+ int eofPending; /* Flag: EOF seen down, not raised up */
int flags; /* Currently CHANNEL_ASYNC or zero. */
int watchMask; /* Current watch/event/interest mask. */
int mode; /* Mode of parent channel, OR'ed combination
@@ -210,7 +211,27 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
+ int refCount;
};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree(dataPtr);
+}
/*
*----------------------------------------------------------------------
@@ -240,6 +261,7 @@ TclChannelTransform(
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State info for channel. */
int mode; /* Read/write mode of the channel. */
+ int objc;
TransformChannelData *dataPtr;
Tcl_DString ds;
@@ -247,6 +269,12 @@ TclChannelTransform(
return TCL_ERROR;
}
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ return TCL_ERROR;
+ }
+
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -261,16 +289,17 @@ TclChannelTransform(
dataPtr = ckalloc(sizeof(TransformChannelData));
+ dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
}
Tcl_DStringFree(&ds);
- dataPtr->self = chan;
dataPtr->watchMask = 0;
dataPtr->mode = mode;
dataPtr->timer = NULL;
@@ -286,19 +315,20 @@ TclChannelTransform(
if (dataPtr->self == NULL) {
Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
- Tcl_DecrRefCount(dataPtr->command);
- ResultClear(&dataPtr->result);
- ckfree(dataPtr);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ Tcl_Preserve(dataPtr->self);
/*
* At last initialize the transformation at the script level.
*/
+ PreserveData(dataPtr);
if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -307,9 +337,11 @@ TclChannelTransform(
ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -350,7 +382,10 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
- Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
/*
* Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +396,18 @@ ExecuteCallback(
*/
if (preserve == P_PRESERVE) {
- state = Tcl_SaveInterpState(dataPtr->interp, res);
+ state = Tcl_SaveInterpState(eval, res);
}
Tcl_IncrRefCount(command);
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewStringObj((char *) op, -1));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
/*
* Use a byte-array to prevent the misinterpretation of binary data coming
* through as UTF while at the tcl level.
*/
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewByteArrayObj(buf, bufLen));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
/*
* Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +417,14 @@ ExecuteCallback(
* current interpreter. Don't copy if in preservation mode.
*/
- res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
command = NULL;
- if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
&& (preserve == P_NO_PRESERVE)) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
return res;
}
@@ -411,20 +439,26 @@ ExecuteCallback(
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
resLen);
break;
case TRANSMIT_SELF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
break;
case TRANSMIT_IBUF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
ResultAdd(&dataPtr->result, resBuf, resLen);
break;
@@ -434,24 +468,16 @@ ExecuteCallback(
* Interpret result as integer number.
*/
- resObj = Tcl_GetObjResult(dataPtr->interp);
- TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
break;
}
- Tcl_ResetResult(dataPtr->interp);
- if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- return res;
-
- cleanup:
+ Tcl_ResetResult(eval);
if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- if (command != NULL) {
- Tcl_DecrRefCount(command);
+ (void) Tcl_RestoreInterpState(eval, state);
}
+ Tcl_Release(eval);
return res;
}
@@ -535,6 +561,7 @@ TransformCloseProc(
* system rely on (f.e. signaling the close to interested parties).
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +581,15 @@ TransformCloseProc(
ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
TRANSMIT_DONT, P_PRESERVE);
}
+ ReleaseData(dataPtr);
/*
* General cleanup.
*/
- ResultClear(&dataPtr->result);
- Tcl_DecrRefCount(dataPtr->command);
- ckfree(dataPtr);
+ Tcl_Release(dataPtr->self);
+ dataPtr->self = NULL;
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -596,9 +624,9 @@ TransformInputProc(
* Should assert(dataPtr->mode & TCL_READABLE);
*/
- if (toRead == 0) {
+ if (toRead == 0 || dataPtr->self == NULL) {
/*
- * Catch a no-op.
+ * Catch a no-op. TODO: Is this a panic()?
*/
return 0;
}
@@ -606,6 +634,7 @@ TransformInputProc(
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
+ PreserveData(dataPtr);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
@@ -623,7 +652,7 @@ TransformInputProc(
* break out of the loop and return to the caller.
*/
- return gotBytes;
+ break;
}
/*
@@ -647,7 +676,18 @@ TransformInputProc(
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
+ }
+ if (dataPtr->eofPending) {
+ /*
+ * Already saw EOF from downChan; don't ask again.
+ * NOTE: Could move this up to avoid the last maxRead
+ * execution. Believe this would still be correct behavior,
+ * but the test suite tests the whole command callback
+ * sequence, so leave it unchanged for now.
+ */
+
+ break;
}
/*
@@ -656,45 +696,35 @@ TransformInputProc(
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
- /*
- * Report errors to caller. EAGAIN is a special situation. If we
- * had some data before we report that instead of the request to
- * re-try.
- */
+ if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
+ /*
+ * Zero bytes available from downChan because blocked.
+ * But nonzero bytes already copied, so total is a
+ * valid blocked short read. Return to caller.
+ */
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- return gotBytes;
+ break;
}
- *errorCodePtr = Tcl_GetErrno();
- return -1;
- } else if (read == 0) {
/*
- * Check wether we hit on EOF in the underlying channel or not. If
- * not differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
+ * Either downChan is not blocked (there's a real error).
+ * or it is and there are no bytes copied yet. In either
+ * case we want to pass the "error" along to the caller,
+ * either to report an error, or to signal to the caller
+ * that zero bytes are available because blocked.
*/
- if (!Tcl_Eof(downChan)) {
- if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
- return gotBytes;
- }
-
- if (dataPtr->readIsFlushed) {
- /*
- * Already flushed, nothing to do anymore.
- */
+ *errorCodePtr = Tcl_GetErrno();
+ gotBytes = -1;
+ break;
+ } else if (read == 0) {
- return gotBytes;
- }
+ /*
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
+ */
+ dataPtr->eofPending = 1;
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
@@ -704,7 +734,7 @@ TransformInputProc(
* We had nothing to flush.
*/
- return gotBytes;
+ break;
}
continue; /* at: while (toRead > 0) */
@@ -718,10 +748,15 @@ TransformInputProc(
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ gotBytes = -1;
+ break;
}
} /* while toRead > 0 */
+ if (gotBytes == 0) {
+ dataPtr->eofPending = 0;
+ }
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -762,11 +797,13 @@ TransformOutputProc(
return 0;
}
+ PreserveData(dataPtr);
if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ toWrite = -1;
}
+ ReleaseData(dataPtr);
return toWrite;
}
@@ -819,6 +856,7 @@ TransformSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -829,7 +867,9 @@ TransformSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
}
+ ReleaseData(dataPtr);
return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
errorCodePtr);
@@ -890,6 +930,7 @@ TransformWideSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -900,7 +941,9 @@ TransformWideSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
@@ -1055,6 +1098,9 @@ TransformWatchProc(
* unchanged.
*/
+ if (dataPtr->self == NULL) {
+ return;
+ }
downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_GetChannelType(downChan)->watchProc(
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index cb0282a..f476a1a 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -99,31 +99,9 @@ typedef struct {
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj **argv; /* Preallocated array for calling the handler.
- * args[0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words. */
- int methods; /* Bitmask of supported methods */
-
- /*
- * NOTE (9): Should we have predefined shared literals for the method
- * names?
- */
+ Tcl_Obj *cmd; /* Callback command prefix */
+ Tcl_Obj *methods; /* Methods to append to command prefix */
+ Tcl_Obj *name; /* Name of the channel as created */
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
@@ -450,15 +428,15 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
-static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
- const char *method, Tcl_Obj *argOneObj,
+ MethodName method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
static void DeleteReflectedChannelMap(ClientData clientData,
Tcl_Interp *interp);
static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
+static void MarkDead(ReflectedChannel *rcPtr);
/*
* Global constant strings (messages). ==================
@@ -467,16 +445,14 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
* list-quoting to keep the words of the message together. See also [x].
*/
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
+static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
/*
@@ -583,10 +559,6 @@ TclChanCreateObjCmd(
rcId = NextHandle();
rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
- mode);
- rcPtr->chan = chan;
- chanPtr = (Channel *) chan;
/*
* Invoke 'initialize' and validate that the handler is present and ok.
@@ -600,7 +572,7 @@ TclChanCreateObjCmd(
modeObj = DecodeEventMask(mode);
/* assert modeObj.refCount == 1 */
- result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
@@ -683,7 +655,11 @@ TclChanCreateObjCmd(
* Everything is fine now.
*/
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ TclChannelPreserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
/*
@@ -744,12 +720,10 @@ TclChanCreateObjCmd(
return TCL_OK;
error:
- /*
- * Signal to ReflectClose to not call 'finalize'.
- */
-
- rcPtr->methods = 0;
- Tcl_Close(interp, chan);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree((char*) rcPtr);
return TCL_ERROR;
#undef MODE
@@ -1138,6 +1112,7 @@ ReflectClose(
ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
* this interp */
Tcl_HashEntry *hPtr; /* Entry in the above map */
+ const Tcl_ChannelType *tctPtr;
if (TclInThreadExit()) {
/*
@@ -1175,18 +1150,11 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
- return EOK;
- }
-
- /*
- * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
- *
- * A cleaned method mask here implies that the channel creation was
- * aborted, and "finalize" must not be called.
- */
-
- if (rcPtr->methods == 0) {
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1208,14 +1176,12 @@ ReflectClose(
Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
}
} else {
#endif
- result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
if ((result != TCL_OK) && (interp != NULL)) {
Tcl_SetChannelErrorInterp(interp, resObj);
}
@@ -1251,12 +1217,14 @@ ReflectClose(
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
-#endif
-
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-#ifdef TCL_THREADS
}
#endif
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return (result == TCL_OK) ? EOK : EINVAL;
}
@@ -1290,18 +1258,6 @@ ReflectInput(
Tcl_Obj *resObj; /* Result data for 'read' */
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_READ))) {
- SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1339,7 +1295,7 @@ ReflectInput(
toReadObj = Tcl_NewIntObj(toRead);
Tcl_IncrRefCount(toReadObj);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1405,18 +1361,6 @@ ReflectOutput(
int written;
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_WRITE))) {
- SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1450,11 +1394,12 @@ ReflectOutput(
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
Tcl_Preserve(rcPtr);
+ Tcl_Preserve(rcPtr->interp);
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
Tcl_IncrRefCount(bufObj);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1466,6 +1411,14 @@ ReflectOutput(
goto invalid;
}
+ if (Tcl_InterpDeleted(rcPtr->interp)) {
+ /*
+ * The interp was destroyed during InvokeTclMethod().
+ */
+
+ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+ goto invalid;
+ }
if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
goto invalid;
@@ -1495,6 +1448,7 @@ ReflectOutput(
stop:
Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr->interp);
Tcl_Release(rcPtr);
return written;
invalid:
@@ -1568,7 +1522,7 @@ ReflectSeekWide(
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1639,8 +1593,6 @@ ReflectWatch(
ReflectedChannel *rcPtr = clientData;
Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
/*
* We restrict the interest to what the channel can support. IOW there
* will never be write events for a channel which is not writable.
@@ -1657,8 +1609,6 @@ ReflectWatch(
return;
}
- rcPtr->interest = mask;
-
/*
* Are we in the correct thread?
*/
@@ -1681,9 +1631,10 @@ ReflectWatch(
Tcl_Preserve(rcPtr);
+ rcPtr->interest = mask;
maskObj = DecodeEventMask(mask);
/* assert maskObj.refCount == 1 */
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
@@ -1742,7 +1693,7 @@ ReflectBlock(
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
@@ -1854,7 +1805,7 @@ ReflectSetOption(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
- result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
}
@@ -1899,7 +1850,7 @@ ReflectGetOption(
Tcl_Obj *resObj; /* Result data for 'configure' */
int listc, result = TCL_OK;
Tcl_Obj **listv;
- const char *method;
+ MethodName method;
/*
* Are we in the correct thread?
@@ -1938,14 +1889,14 @@ ReflectGetOption(
* Retrieve all options.
*/
- method = "cgetall";
+ method = METH_CGETALL;
optionObj = NULL;
} else {
/*
* Retrieve the value of one option.
*/
- method = "cget";
+ method = METH_CGET;
optionObj = Tcl_NewStringObj(optionName, -1);
Tcl_IncrRefCount(optionObj);
}
@@ -2159,16 +2110,13 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
+ MethodName mn = METH_BLOCKING;
rcPtr = ckalloc(sizeof(ReflectedChannel));
/* rcPtr->chan: Assigned by caller. Dummy data here. */
- /* rcPtr->methods: Assigned by caller. Dummy data here. */
rcPtr->chan = NULL;
- rcPtr->methods = 0;
rcPtr->interp = interp;
rcPtr->dead = 0;
#ifdef TCL_THREADS
@@ -2177,54 +2125,17 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /*
- * Method placeholder.
- */
-
/* ASSERT: cmdpfxObj is a Tcl List */
-
- Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
- /*
- * See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- */
-
- rcPtr->argc = listc + 2;
- rcPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
- /*
- * Duplicate object references.
- */
-
- for (i=0; i<listc ; i++) {
- Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
- Tcl_IncrRefCount(word);
- }
-
- i++; /* Skip placeholder for method */
-
- /*
- * [Bug 1667990]: See [x] in FreeReflectedChannel for release
- */
-
- rcPtr->argv[i] = handleObj;
- Tcl_IncrRefCount(handleObj);
-
- /*
- * The next two objects are kept empty, varying arguments.
- */
-
- /*
- * Initialization complete.
- */
-
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
+ rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+ while (mn <= METH_WRITE) {
+ Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+ Tcl_NewStringObj(methodNames[mn++], -1));
+ }
+ Tcl_IncrRefCount(rcPtr->methods);
+ rcPtr->name = handleObj;
+ Tcl_IncrRefCount(rcPtr->name);
return rcPtr;
}
@@ -2271,45 +2182,21 @@ NextHandle(void)
}
static void
-FreeReflectedChannelArgs(
- ReflectedChannel *rcPtr)
-{
- int i, n = rcPtr->argc - 2;
-
- if (n < 0) {
- return;
- }
- for (i=0; i<n; i++) {
- Tcl_DecrRefCount(rcPtr->argv[i]);
- }
-
- /*
- * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
- */
-
- Tcl_DecrRefCount(rcPtr->argv[n+1]);
-
- rcPtr->argc = 1;
-}
-
-static void
FreeReflectedChannel(
ReflectedChannel *rcPtr)
{
Channel *chanPtr = (Channel *) rcPtr->chan;
- if (chanPtr->typePtr != &tclRChannelType) {
- /*
- * Delete a cloned ChannelType structure.
- */
-
- ckfree(chanPtr->typePtr);
- chanPtr->typePtr = NULL;
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ if (rcPtr->name) {
+ Tcl_DecrRefCount(rcPtr->name);
+ }
+ if (rcPtr->methods) {
+ Tcl_DecrRefCount(rcPtr->methods);
+ }
+ if (rcPtr->cmd) {
+ Tcl_DecrRefCount(rcPtr->cmd);
}
-
- FreeReflectedChannelArgs(rcPtr);
-
- ckfree(rcPtr->argv);
ckfree(rcPtr);
}
@@ -2340,16 +2227,16 @@ FreeReflectedChannel(
static int
InvokeTclMethod(
ReflectedChannel *rcPtr,
- const char *method,
+ MethodName method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
- int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
if (rcPtr->dead) {
/*
@@ -2372,19 +2259,15 @@ InvokeTclMethod(
}
/*
- * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
- * TSD data as reflections can be created in many different threads.
- * NO: Caching of command resolutions means storage per channel.
- */
-
- /*
- * Insert method into the pre-allocated area, after the command prefix,
+ * Insert method into the callback command, after the command prefix,
* before the channel id.
*/
- methObj = Tcl_NewStringObj(method, -1);
- Tcl_IncrRefCount(methObj);
- rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+
+ Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
/*
* Append the additional argument containing method specific details
@@ -2394,13 +2277,10 @@ InvokeTclMethod(
* The objects will survive the Tcl_EvalObjv without change.
*/
- cmdc = rcPtr->argc;
if (argOneObj) {
- rcPtr->argv[cmdc] = argOneObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
if (argTwoObj) {
- rcPtr->argv[cmdc] = argTwoObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
}
}
@@ -2409,9 +2289,10 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
/*
* We do not try to extract the result information if the caller has no
@@ -2437,7 +2318,6 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2451,25 +2331,17 @@ InvokeTclMethod(
result = TCL_ERROR;
}
Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
- "\n (chan handler subcommand \"%s\")", method));
+ "\n (chan handler subcommand \"%s\")",
+ methodNames[method]));
resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
/*
- * Cleanup of the dynamic parts of the command.
- *
- * The detail objects survived the Tcl_EvalObjv without change because of
- * the contract. Therefore there is no need to decrement the refcounts. Only
- * the internal method object has to be disposed of.
- */
-
- Tcl_DecrRefCount(methObj);
-
- /*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
@@ -2590,6 +2462,28 @@ GetReflectedChannelMap(
*/
static void
+MarkDead(
+ ReflectedChannel *rcPtr)
+{
+ if (rcPtr->dead) {
+ return;
+ }
+ if (rcPtr->name) {
+ Tcl_DecrRefCount(rcPtr->name);
+ rcPtr->name = NULL;
+ }
+ if (rcPtr->methods) {
+ Tcl_DecrRefCount(rcPtr->methods);
+ rcPtr->methods = NULL;
+ }
+ if (rcPtr->cmd) {
+ Tcl_DecrRefCount(rcPtr->cmd);
+ rcPtr->cmd = NULL;
+ }
+ rcPtr->dead = 1;
+}
+
+static void
DeleteReflectedChannelMap(
ClientData clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
@@ -2624,7 +2518,7 @@ DeleteReflectedChannelMap(
chan = Tcl_GetHashValue(hPtr);
rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->dead = 1;
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(&rcmPtr->map);
@@ -2657,6 +2551,11 @@ DeleteReflectedChannelMap(
/*
* The receiver for the event exited, before processing the event. We
* detach the result now, wake the originator up and signal failure.
+ *
+ * Attention: Results may have been detached already, by either the
+ * receiver, or this thread, as part of other parts in the thread
+ * teardown. Such results are ignored. See ticket [b47b176adf] for the
+ * identical race condition in Tcl 8.6 IORTrans.
*/
evPtr = resultPtr->evPtr;
@@ -2666,6 +2565,9 @@ DeleteReflectedChannelMap(
continue;
}
paramPtr = evPtr->param;
+ if (!evPtr) {
+ continue;
+ }
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
@@ -2699,8 +2601,7 @@ DeleteReflectedChannelMap(
continue;
}
- rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
@@ -2797,6 +2698,11 @@ DeleteThreadReflectedChannelMap(
/*
* The receiver for the event exited, before processing the event. We
* detach the result now, wake the originator up and signal failure.
+ *
+ * Attention: Results may have been detached already, by either the
+ * receiver, or this thread, as part of other parts in the thread
+ * teardown. Such results are ignored. See ticket [b47b176adf] for the
+ * identical race condition in Tcl 8.6 IORTrans.
*/
evPtr = resultPtr->evPtr;
@@ -2806,6 +2712,9 @@ DeleteThreadReflectedChannelMap(
continue;
}
paramPtr = evPtr->param;
+ if (!evPtr) {
+ continue;
+ }
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
@@ -2839,8 +2748,7 @@ DeleteThreadReflectedChannelMap(
Tcl_Channel chan = Tcl_GetHashValue(hPtr);
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
ckfree(rcmPtr);
@@ -3018,17 +2926,17 @@ ForwardProc(
* call upon for the driver.
*/
- case ForwardedClose:
+ case ForwardedClose: {
/*
* No parameters/results.
*/
- if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
/*
- * Freeing is done here, in the origin thread, because the argv[]
+ * Freeing is done here, in the origin thread, callback command
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*
@@ -3046,16 +2954,16 @@ ForwardProc(
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
-
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
break;
+ }
case ForwardedInput: {
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -3095,7 +3003,7 @@ ForwardProc(
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -3138,7 +3046,7 @@ ForwardProc(
Tcl_IncrRefCount(baseObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
paramPtr->seek.offset = -1;
} else {
@@ -3174,7 +3082,8 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ rcPtr->interest = paramPtr->watch.mask;
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
break;
@@ -3185,7 +3094,7 @@ ForwardProc(
Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3201,7 +3110,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+ if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3220,7 +3129,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
TclDStringAppendObj(paramPtr->getOpt.value, resObj);
@@ -3236,7 +3145,7 @@ ForwardProc(
*/
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
/*
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 1de635f..af86ba5 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -161,6 +161,7 @@ typedef struct {
int mode; /* Mask of R/W mode */
int nonblocking; /* Flag: Channel is blocking or not. */
int readIsDrained; /* Flag: Read buffers are flushed. */
+ int eofPending; /* Flag: EOF seen down, but not raised up */
int dead; /* Boolean signal that some operations
* should no longer be attempted. */
ResultBuffer result;
@@ -457,8 +458,7 @@ static void TimerKill(ReflectedTransform *rtPtr);
static void TimerSetup(ReflectedTransform *rtPtr);
static void TimerRun(ClientData clientData);
static int TransformRead(ReflectedTransform *rtPtr,
- int *errorCodePtr, unsigned char *buf,
- int toRead);
+ int *errorCodePtr, Tcl_Obj *bufObj);
static int TransformWrite(ReflectedTransform *rtPtr,
int *errorCodePtr, unsigned char *buf,
int toWrite);
@@ -943,7 +943,7 @@ ReflectClose(
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
- }
+ }
#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
@@ -957,7 +957,7 @@ ReflectClose(
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
- }
+ }
#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
@@ -1063,6 +1063,7 @@ ReflectInput(
{
ReflectedTransform *rtPtr = clientData;
int gotBytes, copied, readBytes;
+ Tcl_Obj *bufObj;
/*
* The following check can be done before thread redirection, because we
@@ -1078,7 +1079,14 @@ ReflectInput(
Tcl_Preserve(rtPtr);
+ /* TODO: Consider a more appropriate buffer size. */
+ bufObj = Tcl_NewByteArrayObj(NULL, toRead);
+ Tcl_IncrRefCount(bufObj);
gotBytes = 0;
+ if (rtPtr->eofPending) {
+ goto stop;
+ }
+ rtPtr->readIsDrained = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
@@ -1094,6 +1102,11 @@ ReflectInput(
goto stop;
}
+ if (rtPtr->eofPending) {
+ goto stop;
+ }
+
+
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
@@ -1129,55 +1142,41 @@ ReflectInput(
goto stop;
}
- readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
+
+ readBytes = Tcl_ReadRaw(rtPtr->parent,
+ (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
if (readBytes < 0) {
- /*
- * Report errors to caller. The state of the seek system is
- * unchanged!
- */
+ if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
/*
- * EAGAIN is a special situation. If we had some data before
- * we report that instead of the request to re-try.
+ * Down channel is blocked and offers zero additional bytes.
+ * The nonzero gotBytes already returned makes the total
+ * operation a valid short read. Return to caller.
*/
goto stop;
}
+ /*
+ * Either the down channel is not blocked (a real error)
+ * or it is and there are gotBytes==0 byte copied so far.
+ * In either case, pass up the error, so we either report
+ * any real error, or do not mistakenly signal EOF by
+ * returning 0 to the caller.
+ */
+
*errorCodePtr = Tcl_GetErrno();
goto error;
}
if (readBytes == 0) {
+
/*
- * Check wether we hit on EOF in 'parent' or not. If not
- * differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
*/
- if (!Tcl_Eof(rtPtr->parent)) {
- /*
- * The state of the seek system is unchanged!
- */
-
- if ((gotBytes == 0) && rtPtr->nonblocking) {
- *errorCodePtr = EWOULDBLOCK;
- goto error;
- }
- goto stop;
- } else {
- /*
- * Eof in parent.
- */
-
- if (rtPtr->readIsDrained) {
- goto stop;
- }
+ rtPtr->eofPending = 1;
/*
* Now this is a bit different. The partial data waiting is
@@ -1198,13 +1197,7 @@ ReflectInput(
goto stop;
}
- /*
- * Reset eof, force caller to drain result buffer.
- */
-
- ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
continue; /* at: while (toRead > 0) */
- }
} /* readBytes == 0 */
/*
@@ -1213,12 +1206,23 @@ ReflectInput(
* iteration will put it into the result.
*/
- if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) {
+ Tcl_SetByteArrayLength(bufObj, readBytes);
+ if (!TransformRead(rtPtr, errorCodePtr, bufObj)) {
goto error;
}
+ if (Tcl_IsShared(bufObj)) {
+ Tcl_DecrRefCount(bufObj);
+ bufObj = Tcl_NewObj();
+ Tcl_IncrRefCount(bufObj);
+ }
+ Tcl_SetByteArrayLength(bufObj, 0);
} /* while toRead > 0 */
stop:
+ if (gotBytes == 0) {
+ rtPtr->eofPending = 0;
+ }
+ Tcl_DecrRefCount(bufObj);
Tcl_Release(rtPtr);
return gotBytes;
@@ -1773,6 +1777,7 @@ NewReflectedTransform(
rtPtr->timer = NULL;
rtPtr->mode = 0;
rtPtr->readIsDrained = 0;
+ rtPtr->eofPending = 0;
rtPtr->nonblocking =
(((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
rtPtr->dead = 0;
@@ -2010,6 +2015,7 @@ InvokeTclMethod(
sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rtPtr);
+ Tcl_Preserve(rtPtr->interp);
result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
/*
@@ -2054,6 +2060,7 @@ InvokeTclMethod(
Tcl_IncrRefCount(resObj);
}
Tcl_RestoreInterpState(rtPtr->interp, sr);
+ Tcl_Release(rtPtr->interp);
Tcl_Release(rtPtr);
/*
@@ -2230,6 +2237,9 @@ DeleteReflectedTransformMap(
*/
evPtr = resultPtr->evPtr;
+ if (evPtr == NULL) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -2355,6 +2365,9 @@ DeleteThreadReflectedTransformMap(
*/
evPtr = resultPtr->evPtr;
+ if (evPtr == NULL) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -3065,10 +3078,8 @@ static int
TransformRead(
ReflectedTransform *rtPtr,
int *errorCodePtr,
- unsigned char *buf,
- int toRead)
+ Tcl_Obj *bufObj)
{
- Tcl_Obj *bufObj;
Tcl_Obj *resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
@@ -3081,8 +3092,8 @@ TransformRead(
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- p.transform.buf = (char *) buf;
- p.transform.size = toRead;
+ p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
+ &(p.transform.size));
ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
@@ -3102,12 +3113,8 @@ TransformRead(
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
- bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
- Tcl_IncrRefCount(bufObj);
-
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
- Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
@@ -3116,7 +3123,6 @@ TransformRead(
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
ResultAdd(&rtPtr->result, bytev, bytec);
- Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 1;
}
@@ -3184,7 +3190,7 @@ TransformWrite(
}
if (res < 0) {
- *errorCodePtr = EINVAL;
+ *errorCodePtr = Tcl_GetErrno();
return 0;
}
@@ -3294,7 +3300,7 @@ TransformFlush(
}
if (res < 0) {
- *errorCodePtr = EINVAL;
+ *errorCodePtr = Tcl_GetErrno();
return 0;
}
@@ -3324,6 +3330,7 @@ TransformClear(
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
rtPtr->readIsDrained = 0;
+ rtPtr->eofPending = 0;
ResultClear(&rtPtr->result);
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7d6c462..c5b7d28 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -12,9 +12,26 @@
#include "tclInt.h"
#if defined(_WIN32) && defined(UNICODE)
-/* On Windows, we always need the ASCII version. */
-# undef gai_strerror
-# define gai_strerror gai_strerrorA
+/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_DString errorMsg; /* UTF-8 encoded error-message */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+#undef gai_strerror
+static const char *gai_strerror(int code) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->initialized) {
+ Tcl_DStringFree(&tsdPtr->errorMsg);
+ } else {
+ tsdPtr->initialized = 1;
+ }
+ Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
+ return Tcl_DStringValue(&tsdPtr->errorMsg);
+}
#endif
/*
@@ -139,7 +156,7 @@ int
TclCreateSocketAddress(
Tcl_Interp *interp, /* Interpreter for querying
* the desired socket family */
- void **addrlist, /* Socket address list */
+ struct addrinfo **addrlist, /* Socket address list */
const char *host, /* Host. NULL implies INADDR_ANY */
int port, /* Port number */
int willBind, /* Is this an address to bind() to or
@@ -154,7 +171,7 @@ TclCreateSocketAddress(
char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
const char *family = NULL;
Tcl_DString ds;
- int result, i;
+ int result;
if (host != NULL) {
native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
@@ -170,11 +187,11 @@ TclCreateSocketAddress(
TclFormatInt(portbuf, port);
portstring = portbuf;
}
-
+
(void) memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
- /*
+ /*
* Magic variable to enforce a certain address family - to be superseded
* by a TIP that adds explicit switches to [socket]
*/
@@ -211,9 +228,9 @@ TclCreateSocketAddress(
if (willBind) {
hints.ai_flags |= AI_PASSIVE;
- }
+ }
- result = getaddrinfo(native, portstring, &hints, (struct addrinfo **) addrlist);
+ result = getaddrinfo(native, portstring, &hints, addrlist);
if (host != NULL) {
Tcl_DStringFree(&ds);
@@ -262,11 +279,6 @@ TclCreateSocketAddress(
*addrlist = v4head;
}
}
- i = 0;
- for (p = *addrlist; p != NULL; p = p->ai_next) {
- i++;
- }
-
return 1;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6259216..1330c02 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -19,11 +19,17 @@
*/
#include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+#include <sys/statfs.h>
+#endif
+#endif
+
/*
* struct FilesystemRecord --
*
@@ -53,12 +59,12 @@ typedef struct FilesystemRecord {
typedef struct ThreadSpecificData {
int initialized;
- int cwdPathEpoch;
- int filesystemEpoch;
+ size_t cwdPathEpoch;
+ size_t filesystemEpoch;
Tcl_Obj *cwdPathPtr;
ClientData cwdClientData;
FilesystemRecord *filesystemList;
- int claims;
+ size_t claims;
} ThreadSpecificData;
/*
@@ -209,7 +215,7 @@ static FilesystemRecord nativeFilesystemRecord = {
* trigger cache cleanup in all threads.
*/
-static int theFilesystemEpoch = 1;
+static size_t theFilesystemEpoch = 1;
/*
* Stores the linked list of filesystems. A 1:1 copy of this list is also
@@ -225,7 +231,7 @@ TCL_DECLARE_MUTEX(filesystemMutex)
*/
static Tcl_Obj *cwdPathPtr = NULL;
-static int cwdPathEpoch = 0;
+static size_t cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
@@ -639,7 +645,7 @@ FsGetFirstFilesystem(void)
int
TclFSEpochOk(
- int filesystemEpoch)
+ size_t filesystemEpoch)
{
return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}
@@ -660,7 +666,7 @@ Disclaim(void)
tsdPtr->claims--;
}
-int
+size_t
TclFSEpoch(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
@@ -707,7 +713,9 @@ FsUpdateCwd(
cwdClientData = TclNativeDupInternalRep(clientData);
}
- cwdPathEpoch++;
+ if (++cwdPathEpoch == 0) {
+ ++cwdPathEpoch;
+ }
tsdPtr->cwdPathEpoch = cwdPathEpoch;
Tcl_MutexUnlock(&cwdMutex);
@@ -784,7 +792,9 @@ TclFinalizeFilesystem(void)
}
fsRecPtr = tmpFsRecPtr;
}
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
filesystemList = NULL;
/*
@@ -792,7 +802,7 @@ TclFinalizeFilesystem(void)
* filesystem is likely to fail.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
TclWinEncodingsCleanup();
#endif
}
@@ -817,9 +827,11 @@ void
TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
-#ifdef __WIN32__
+#ifdef _WIN32
/*
* Cleans up the win32 API filesystem proc lookup table. This must happen
* very late in finalization so that deleting of copied dlls can occur.
@@ -902,7 +914,9 @@ Tcl_FSRegister(
* conceivably now belong to different filesystems.
*/
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
Tcl_MutexUnlock(&filesystemMutex);
return TCL_OK;
@@ -967,7 +981,9 @@ Tcl_FSUnregister(
* (which would of course lead to memory exceptions).
*/
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
ckfree(fsRecPtr);
@@ -1298,7 +1314,9 @@ Tcl_FSMountsChanged(
*/
Tcl_MutexLock(&filesystemMutex);
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
Tcl_MutexUnlock(&filesystemMutex);
}
@@ -2884,9 +2902,13 @@ int
Tcl_FSChdir(
Tcl_Obj *pathPtr)
{
- const Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
int retVal = -1;
+ if (tsdPtr->cwdPathPtr != NULL) {
+ oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ }
if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
Tcl_SetErrno(ENOENT);
return retVal;
@@ -2986,7 +3008,6 @@ Tcl_FSChdir(
* instead. This should be examined by someone on Unix.
*/
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
ClientData cd;
ClientData oldcd = tsdPtr->cwdClientData;
@@ -3003,6 +3024,14 @@ Tcl_FSChdir(
} else {
FsUpdateCwd(normDirName, NULL);
}
+
+ /*
+ * If the filesystem changed between old and new cwd
+ * force filesystem refresh on path objects.
+ */
+ if (oldFsPtr != NULL && fsPtr != oldFsPtr) {
+ Tcl_FSMountsChanged(NULL);
+ }
}
return retVal;
@@ -3110,6 +3139,82 @@ Tcl_FSLoadFile(
*----------------------------------------------------------------------
*/
+/*
+ * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
+ * error) yet somehow trash some internal data structures which prevents the
+ * second and further shared libraries from getting properly loaded. Only the
+ * first is ok. We try to get around the issue by not unlinking,
+ * i.e. emulating the behaviour of the older HPUX which denied removal.
+ *
+ * Doing the unlink is also an issue within docker containers, whose AUFS
+ * bungles this as well, see
+ * https://github.com/dotcloud/docker/issues/1911
+ *
+ * For these situations the change below makes the execution of the unlink
+ * semi-controllable at runtime.
+ *
+ * An AUFS filesystem (if it can be detected) will force avoidance of
+ * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
+ * users general request (unlink and not.
+ *
+ * By default the unlink is done (if not in AUFS). However if the variable is
+ * present and set to true (any integer > 0) then the unlink is skipped.
+ */
+
+int
+TclSkipUnlink (Tcl_Obj* shlibFile)
+{
+ /* Order of testing:
+ * 1. On hpux we generally want to skip unlink in general
+ *
+ * Outside of hpux then:
+ * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
+ * 3. For general AUFS environment (statfs, if available).
+ *
+ * Ad 2: This variable can disable/override the AUFS detection, i.e. for
+ * testing if a newer AUFS does not have the bug any more.
+ *
+ * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
+ * This part needs proper tests in the configure(.in).
+ */
+
+#ifdef hpux
+ return 1;
+#else
+ char* skipstr;
+
+ skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
+ if (skipstr && (skipstr[0] != '\0')) {
+ return atoi(skipstr);
+ }
+
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+ {
+ struct statfs fs;
+ /* Have fstatfs. May not have the AUFS super magic ... Indeed our build
+ * box is too old to have it directly in the headers. Define taken from
+ * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
+ * http://aufs.sourceforge.net/
+ * Better reference will be gladly taken.
+ */
+#ifndef AUFS_SUPER_MAGIC
+#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
+#endif /* AUFS_SUPER_MAGIC */
+ if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
+ (fs.f_type == AUFS_SUPER_MAGIC)) {
+ return 1;
+ }
+ }
+#endif /* ... NO_FSTATFS */
+#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
+
+ /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
+ * Don't skip */
+ return 0;
+#endif /* hpux */
+}
+
int
Tcl_LoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -3149,7 +3254,9 @@ Tcl_LoadFile(
if (*handlePtr == NULL) {
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
goto resolveSymbols;
}
if (Tcl_GetErrno() != EXDEV) {
@@ -3165,9 +3272,11 @@ Tcl_LoadFile(
*/
if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't load library \"%s\": %s",
- Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load library \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ }
return TCL_ERROR;
}
@@ -3216,7 +3325,9 @@ Tcl_LoadFile(
}
mustCopyToTempAnyway:
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
#endif /* TCL_LOAD_FROM_MEMORY */
/*
@@ -3240,8 +3351,10 @@ Tcl_LoadFile(
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "couldn't load from current filesystem", -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load from current filesystem", -1));
+ }
return TCL_ERROR;
}
@@ -3255,7 +3368,7 @@ Tcl_LoadFile(
return TCL_ERROR;
}
-#ifndef __WIN32__
+#ifndef _WIN32
/*
* Do we need to set appropriate permissions on the file? This may be
* required on some systems. On Unix we could loop over the file
@@ -3281,7 +3394,9 @@ Tcl_LoadFile(
* have stored the number of bytes in the result.
*/
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
&newLoadHandle);
@@ -3300,7 +3415,9 @@ Tcl_LoadFile(
* avoids any worries about leaving the copy laying around on exit.
*/
- if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ if (
+ !TclSkipUnlink (copyToPtr) &&
+ (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
@@ -3311,7 +3428,9 @@ Tcl_LoadFile(
*/
*handlePtr = newLoadHandle;
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
return TCL_OK;
}
@@ -3372,11 +3491,13 @@ Tcl_LoadFile(
divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
*handlePtr = divertedLoadHandle;
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
return retVal;
resolveSymbols:
- /*
+ /*
* At this point, *handlePtr is already set up to the handle for the
* loaded library. We now try to resolve the symbols.
*/
@@ -3385,7 +3506,7 @@ Tcl_LoadFile(
for (i=0 ; symbols[i] != NULL; i++) {
procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
if (procPtrs[i] == NULL) {
- /*
+ /*
* At least one symbol in the list was not found. Unload the
* file, and report the problem back to the caller.
* (Tcl_FindSymbol should already have left an appropriate
@@ -3405,7 +3526,7 @@ Tcl_LoadFile(
*----------------------------------------------------------------------
*
* DivertFindSymbol --
- *
+ *
* Find a symbol in a shared library loaded by copy-from-VFS.
*
*----------------------------------------------------------------------
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f0e907f..4e7e422 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -2,9 +2,8 @@
#
# This file contains the declarations for all unsupported
# functions that are exported by the Tcl library. This file
-# is used to generate the tclIntDecls.h, tclIntPlatDecls.h,
-# tclIntStub.c, tclPlatStub.c, tclCompileDecls.h and tclCompileStub.c
-# files
+# is used to generate the tclIntDecls.h, tclIntPlatDecls.h
+# and tclStubInit.c files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
@@ -1006,6 +1005,12 @@ declare 249 {
declare 250 {
void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}
+
+# Allow extensions for optimization
+declare 251 {
+ int TclRegisterLiteral(void *envPtr,
+ char *bytes, int length, int flags)
+}
##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6056119..7ea37bb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -48,7 +48,8 @@
#else
#include <string.h>
#endif
-#ifdef STDC_HEADERS
+#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
+ || defined(__cplusplus) || defined(_MSC_VER)
#include <stddef.h>
#else
typedef int ptrdiff_t;
@@ -1177,25 +1178,25 @@ typedef struct CmdFrame {
*
* Field TEBC EvalEx
* ======= ==== ======
- * level yes yes
+ * level yes yes
* type BC/PREBC SRC/EVAL
- * line0 yes yes
- * framePtr yes yes
+ * line0 yes yes
+ * framePtr yes yes
* ======= ==== ======
*
* ======= ==== ========= union data
- * line1 - yes
- * line3 - yes
- * path - yes
+ * line1 - yes
+ * line3 - yes
+ * path - yes
* ------- ---- ------
- * codePtr yes -
- * pc yes -
+ * codePtr yes -
+ * pc yes -
* ======= ==== ======
*
* ======= ==== ========= union cmd
- * str.cmd yes yes
- * str.len yes yes
- * ------- ---- ------
+ * str.cmd yes yes
+ * str.len yes yes
+ * ------- ---- ------
*/
union {
@@ -1686,6 +1687,7 @@ typedef struct Command {
#define CMD_TRACE_ACTIVE 0x2
#define CMD_HAS_EXEC_TRACES 0x4
#define CMD_COMPILES_EXPANDED 0x8
+#define CMD_REDEF_IN_PROGRESS 0x10
/*
*----------------------------------------------------------------
@@ -1740,7 +1742,7 @@ enum PkgPreferOptions {
* definition there.
* Some macros require knowledge of some fields in the struct in order to
* avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the objCache field in struct Interp.
+ * to the relevant fields is kept in the allocCache field in struct Interp.
*----------------------------------------------------------------
*/
@@ -1809,7 +1811,14 @@ typedef struct Interp {
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
- Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */
+ union {
+ void (*optimizer)(void *envPtr);
+ Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
+ * unused space in interp was repurposed for
+ * pluggable bytecode optimizers. The core
+ * contains one optimizer, which can be
+ * selectively overriden by extensions. */
+ } extra;
/*
* Information related to procedures and variables. See tclProc.c and
@@ -2201,6 +2210,7 @@ typedef struct Interp {
#define TCL_ALLOW_EXCEPTIONS 0x04
#define TCL_EVAL_FILE 0x02
#define TCL_EVAL_SOURCE_IN_FRAME 0x10
+#define TCL_EVAL_NORESOLVE 0x20
/*
* Flag bits for Interp structures:
@@ -2444,6 +2454,30 @@ typedef struct List {
#endif
/*
+ * Macro used to save a function call for common uses of
+ * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ * Tcl_WideInt *wideIntPtr);
+ */
+
+#ifdef TCL_WIDE_INT_IS_LONG
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? (*(wideIntPtr) = (Tcl_WideInt) \
+ ((objPtr)->internalRep.longValue), TCL_OK) : \
+ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#else /* !TCL_WIDE_INT_IS_LONG */
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+ (((objPtr)->typePtr == &tclWideIntType) \
+ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
+ ((objPtr)->typePtr == &tclIntType) \
+ ? (*(wideIntPtr) = (Tcl_WideInt) \
+ ((objPtr)->internalRep.longValue), TCL_OK) : \
+ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+/*
* Flag values for TclTraceDictPath().
*
* DICT_PATH_READ indicates that all entries on the path must exist but no
@@ -2631,6 +2665,8 @@ MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
+MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
+
/*
* TIP #233 (Virtualized Time)
* Data for the time hooks, if any.
@@ -2725,6 +2761,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -2828,6 +2865,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
int strLen, const unsigned char *pattern,
int ptnLen, int flags);
MODULE_SCOPE double TclCeil(const mp_int *a);
+MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
+MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
@@ -2845,6 +2884,10 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
+ const char *dict, int dictLength,
+ const char **elementPtr, const char **nextPtr,
+ int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
@@ -2884,7 +2927,8 @@ MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
-MODULE_SCOPE void TclFinalizeThreadData(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
+MODULE_SCOPE void TclFinalizeThreadData(int quick);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
@@ -2909,6 +2953,8 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
+ unsigned int *sizePtr);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
@@ -2940,8 +2986,8 @@ MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
-MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int TclIsSpaceProc(char byte);
+MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
@@ -2999,8 +3045,9 @@ MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void TclpFinalizePipes(void);
MODULE_SCOPE void TclpFinalizeSockets(void);
MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
- void **addrlist, const char *host, int port,
- int willBind, const char **errorMsgPtr);
+ struct addrinfo **addrlist,
+ const char *host, int port, int willBind,
+ const char **errorMsgPtr);
MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc, ClientData clientData,
int stackSize, int flags);
@@ -3049,7 +3096,8 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
- int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
+ int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
+ int *quantifiersFoundPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
int *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
@@ -3105,7 +3153,6 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void);
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
-MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
@@ -3183,15 +3230,15 @@ MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-
-/* Assemble command function */
+
+/* Assemble command function */
MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-
+ Tcl_Obj *const objv[]);
+
MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3432,6 +3479,9 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3531,6 +3581,9 @@ MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3555,6 +3608,9 @@ MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3570,6 +3626,12 @@ MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectNextToCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3585,6 +3647,9 @@ MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringCatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3597,6 +3662,9 @@ MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3612,6 +3680,27 @@ MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringReplaceCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimRCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3642,6 +3731,9 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileYieldToCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3817,7 +3909,7 @@ MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-
+
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3855,6 +3947,8 @@ MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
Tcl_Obj *part2Ptr, const int flags,
int index);
MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
+MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr,
+ Tcl_HashTable *tablePtr);
/*
* The new extended interface to the variable traces.
@@ -3945,7 +4039,7 @@ typedef const char *TclDTraceStr;
*/
# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount > 0) ; else { \
+ if ((objPtr)->refCount-- > 1) ; else { \
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
@@ -4022,7 +4116,8 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
AllocCache *cachePtr; \
if (((interp) == NULL) || \
((cachePtr = ((Interp *)(interp))->allocCache), \
- (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \
+ ((cachePtr->numObjects == 0) || \
+ (cachePtr->numObjects >= ALLOC_NOBJHIGH)))) { \
TclThreadFreeObj(objPtr); \
} else { \
(objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
@@ -4340,17 +4435,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
/*
*----------------------------------------------------------------------
*
- * Core procedures added to libtommath for bignum manipulation.
+ * Core procedure added to libtommath for bignum manipulation.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
-MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
-MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int *bignum,
- Tcl_WideInt initVal);
-MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
- Tcl_WideUInt initVal);
/*
*----------------------------------------------------------------------
@@ -4584,7 +4674,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#define TclCleanupCommandMacro(cmdPtr) \
- if (--(cmdPtr)->refCount <= 0) { \
+ if ((cmdPtr)->refCount-- <= 1) { \
ckfree((char *) (cmdPtr));\
}
@@ -4701,7 +4791,9 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
*/
#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */
-#define NRE_ENABLE_ASSERTS 1
+#ifndef NRE_ENABLE_ASSERTS
+#define NRE_ENABLE_ASSERTS 0
+#endif
/*
* This is the main data struct for representing NR commands. It is designed
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 533d6f4..f95f999 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -52,6 +52,10 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
@@ -610,6 +614,9 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
/* 250 */
EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
int force);
+/* 251 */
+EXTERN int TclRegisterLiteral(void *envPtr, char *bytes,
+ int length, int flags);
typedef struct TclIntStubs {
int magic;
@@ -866,12 +873,11 @@ typedef struct TclIntStubs {
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
} TclIntStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclIntStubs *tclIntStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -1297,6 +1303,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclDoubleDigits) /* 249 */
#define TclSetSlaveCancelFlags \
(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclRegisterLiteral \
+ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 3181d4e..ac06787 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,7 +13,7 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
-#ifdef __WIN32__
+#ifdef _WIN32
# define Tcl_DirEntry void
# define DIR void
#endif
@@ -37,11 +37,15 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -100,7 +104,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
@@ -254,7 +258,7 @@ typedef struct TclIntPlatStubs {
int magic;
void *hooks;
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -287,7 +291,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -355,10 +359,8 @@ typedef struct TclIntPlatStubs {
#endif /* MACOSX */
} TclIntPlatStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -369,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
* Inline function declarations:
*/
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
@@ -418,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
@@ -548,9 +550,15 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32)
# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1a4297b..cd0dc18 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -279,6 +279,12 @@ static void DeleteScriptLimitCallback(ClientData clientData);
static void RunLimitHandlers(LimitHandler *handlerPtr,
Tcl_Interp *interp);
static void TimeLimitCallback(ClientData clientData);
+
+/* NRE enabling */
+static Tcl_NRPostProc NRPostInvokeHidden;
+static Tcl_ObjCmdProc NRInterpCmd;
+static Tcl_ObjCmdProc NRSlaveCmd;
+
/*
*----------------------------------------------------------------------
@@ -481,7 +487,8 @@ TclInterpInit(
slavePtr->interpCmd = NULL;
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
- Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
+ Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
+ NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
return TCL_OK;
@@ -590,6 +597,16 @@ Tcl_InterpObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
+}
+
+static int
+NRInterpCmd(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
Tcl_Interp *slaveInterp;
int index;
static const char *const options[] = {
@@ -706,7 +723,7 @@ Tcl_InterpObjCmd(
}
endOfForLoop:
- if ((i + 2) < objc) {
+ if (i < objc - 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-unwind? ?--? ?path? ?result?");
return TCL_ERROR;
@@ -1865,7 +1882,6 @@ AliasObjCmd(
cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
}
- prefv = &aliasPtr->objPtr;
memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
@@ -2372,8 +2388,8 @@ SlaveCreate(
slavePtr->masterInterp = masterInterp;
slavePtr->slaveEntryPtr = hPtr;
slavePtr->slaveInterp = slaveInterp;
- slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
- SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
+ slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
+ SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
Tcl_SetHashValue(hPtr, slavePtr);
Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
@@ -2462,6 +2478,16 @@ SlaveObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
+}
+
+static int
+NRSlaveCmd(
+ ClientData clientData, /* Slave interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
Tcl_Interp *slaveInterp = clientData;
int index;
static const char *const options[] = {
@@ -3052,7 +3078,11 @@ SlaveInvokeHidden(
Tcl_AllowExceptions(slaveInterp);
if (namespaceName == NULL) {
- result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+ NRE_callback *rootPtr = TOP_CB(slaveInterp);
+
+ Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+ rootPtr, NULL, NULL);
+ return TclNRInvoke(NULL, slaveInterp, objc, objv);
} else {
Namespace *nsPtr, *dummy1, *dummy2;
const char *tail;
@@ -3071,6 +3101,23 @@ SlaveInvokeHidden(
Tcl_Release(slaveInterp);
return result;
}
+
+static int
+NRPostInvokeHidden(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+ NRE_callback *rootPtr = (NRE_callback *)data[1];
+
+ if (interp != slaveInterp) {
+ result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
+ Tcl_TransferResult(slaveInterp, result, interp);
+ }
+ Tcl_Release(slaveInterp);
+ return result;
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index bd2dbc4..14b8a14 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -137,7 +137,7 @@ NewListIntRep(
* Creates a list internal rep with space for objc elements. objc
* must be > 0. If objv!=NULL, initializes with the first objc values
* in that array. If objv==NULL, initalize list internal rep to have
- * 0 elements, with space to add objc more.
+ * 0 elements, with space to add objc more.
*
* Results:
* A new List struct with refCount 0 is returned. If some failure
@@ -857,7 +857,7 @@ Tcl_ListObjReplace(
{
List *listRepPtr;
register Tcl_Obj **elemPtrs;
- int numElems, numRequired, numAfterLast, start, i, j, isShared;
+ int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
@@ -906,14 +906,46 @@ Tcl_ListObjReplace(
count = numElems - first;
}
+ if (objc > LIST_MAX - (numElems - count)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+ return TCL_ERROR;
+ }
isShared = (listRepPtr->refCount > 1);
- numRequired = numElems - count + objc;
+ numRequired = numElems - count + objc; /* Known <= LIST_MAX */
+ needGrow = numRequired > listRepPtr->maxElemCount;
for (i = 0; i < objc; i++) {
Tcl_IncrRefCount(objv[i]);
}
- if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+ if (needGrow && !isShared) {
+ /* Try to use realloc */
+ List *newPtr = NULL;
+ int attempt = 2 * numRequired;
+ if (attempt <= LIST_MAX) {
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr) {
+ listRepPtr = newPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ elemPtrs = &listRepPtr->elements;
+ listRepPtr->maxElemCount = attempt;
+ needGrow = numRequired > listRepPtr->maxElemCount;
+ }
+ }
+ if (!needGrow && !isShared) {
int shift;
/*
@@ -950,7 +982,7 @@ Tcl_ListObjReplace(
Tcl_Obj **oldPtrs = elemPtrs;
int newMax;
- if (numRequired > listRepPtr->maxElemCount){
+ if (needGrow){
newMax = 2 * numRequired;
} else {
newMax = listRepPtr->maxElemCount;
@@ -1726,7 +1758,7 @@ FreeListInternalRep(
{
List *listRepPtr = ListRepPtr(listPtr);
- if (--listRepPtr->refCount <= 0) {
+ if (listRepPtr->refCount-- <= 1) {
Tcl_Obj **elemPtrs = &listRepPtr->elements;
int i, numElems = listRepPtr->elemCount;
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 11da6f8..03200ca 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -358,7 +358,7 @@ TclFetchLiteral(
int
TclRegisterLiteral(
- CompileEnv *envPtr, /* Points to the CompileEnv in whose object
+ void *ePtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
register char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
@@ -372,6 +372,7 @@ TclRegisterLiteral(
* the literal should not be shared accross
* namespaces. */
{
+ CompileEnv *envPtr = ePtr;
Interp *iPtr = envPtr->iPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
LiteralEntry *globalPtr, *localPtr;
@@ -425,7 +426,7 @@ TclRegisterLiteral(
} else {
nsPtr = NULL;
}
-
+
/*
* Is it in the interpreter's global literal table? If not, create it.
*/
@@ -716,16 +717,22 @@ ExpandLocalLiteralArray(
LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
LiteralEntry *newArrayPtr;
int i;
+ unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;
+
+ if (currBytes == newSize) {
+ Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
+ currElems);
+ }
if (envPtr->mallocedLiteralArray) {
- newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
+ newArrayPtr = ckrealloc(currArrayPtr, newSize);
} else {
/*
* envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves.
*/
- newArrayPtr = ckalloc(2 * currBytes);
+ newArrayPtr = ckalloc(newSize);
memcpy(newArrayPtr, currArrayPtr, currBytes);
envPtr->mallocedLiteralArray = 1;
}
@@ -750,7 +757,7 @@ ExpandLocalLiteralArray(
}
envPtr->literalArrayPtr = newArrayPtr;
- envPtr->literalArrayEnd = (2 * currElems);
+ envPtr->literalArrayEnd = newSize / sizeof(LiteralEntry);
}
/*
@@ -931,7 +938,8 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
- int oldSize, count, index, length;
+ unsigned int oldSize;
+ int count, index, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -941,6 +949,16 @@ RebuildLiteralTable(
* constants for new array size.
*/
+ if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
+ /*
+ * Memory allocator limitations will not let us create the
+ * next larger table size. Best option is to limp along
+ * with what we have.
+ */
+
+ return;
+ }
+
tablePtr->numBuckets *= 4;
tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
@@ -990,7 +1008,7 @@ RebuildLiteralTable(
* Results:
* None.
*
- * Side effects:
+ * Side effects:
* Resets the internal representation of the CmdName Tcl_Obj
* using TclFreeIntRep().
*
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 5cacab1..7c70e03 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
* Unload the shared library from the application memory...
*/
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
pkgPtr = firstPackagePtr;
firstPackagePtr = pkgPtr->nextPtr;
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index c22c4c4..6af5c4f 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -45,9 +45,11 @@ TclpDlopen(
* file. */
int flags)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "dynamic loading is not currently available on this system",
- -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "dynamic loading is not currently available on this system",
+ -1));
+ }
return TCL_ERROR;
}
@@ -104,11 +106,15 @@ TclpLoadMemory(
int size, /* Dummy: unused by this implementation */
int codeSize, /* Dummy: unused by this implementation */
Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
+ /* Dummy: unused by this implementation */
+ int flags)
/* Dummy: unused by this implementation */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
- "is not available on this system", -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+ "is not available on this system", -1));
+ }
return TCL_ERROR;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index faea75a..927de7e 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -47,7 +47,7 @@
* we have to translate that to strcmp here.
*/
-#ifndef __WIN32__
+#ifndef _WIN32
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
@@ -80,7 +80,10 @@ NewNativeObj(
* source directory to make their own modified versions).
*/
+#if defined _MSC_VER && _MSC_VER < 1900
+/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int isatty(int fd);
+#endif
/*
* The thread-local variables for this file's functions.
@@ -616,7 +619,7 @@ Tcl_MainEx(
if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
-
+
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
@@ -729,7 +732,7 @@ TclFullFinalizationRequested(void)
const char *fin;
Tcl_DString ds;
int finalize = 0;
-
+
fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
finalize = ((fin != NULL) && strcmp(fin, "0"));
if (fin != NULL) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index aed623a..58a86d9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
{"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
- {"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0},
{"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
@@ -343,7 +343,7 @@ Tcl_PushCallFrame(
framePtr->clientData = NULL;
framePtr->localCachePtr = NULL;
framePtr->tailcallPtr = NULL;
-
+
/*
* Push the new call frame onto the interpreter's stack of procedure call
* frames making it the current frame.
@@ -673,6 +673,10 @@ Tcl_CreateNamespace(
Tcl_DString *namePtr, *buffPtr;
int newEntry, nameLen;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ const char *nameStr;
+ Tcl_DString tmpBuffer;
+
+ Tcl_DStringInit(&tmpBuffer);
/*
* If there is no active namespace, the interpreter is being initialized.
@@ -686,49 +690,78 @@ Tcl_CreateNamespace(
parentPtr = NULL;
simpleName = "";
- } else if (*name == '\0') {
+ goto doCreate;
+ }
+
+ /*
+ * Ensure that there are no trailing colons as that causes chaos when a
+ * deleteProc is specified. [Bug d614d63989]
+ */
+
+ if (deleteProc != NULL) {
+ nameStr = name + strlen(name) - 2;
+ if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') {
+ Tcl_DStringAppend(&tmpBuffer, name, -1);
+ while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0
+ && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') {
+ Tcl_DStringSetLength(&tmpBuffer, nameLen-1);
+ }
+ name = Tcl_DStringValue(&tmpBuffer);
+ }
+ }
+
+ /*
+ * If we've ended up with an empty string now, we're attempting to create
+ * the global namespace despite the global namespace existing. That's
+ * naughty!
+ */
+
+ if (*name == '\0') {
Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
" \"\": only global namespace can have empty name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
"CREATEGLOBAL", NULL);
+ Tcl_DStringFree(&tmpBuffer);
return NULL;
- } else {
- /*
- * Find the parent for the new namespace.
- */
+ }
- TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
- &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
+ /*
+ * Find the parent for the new namespace.
+ */
- /*
- * If the unqualified name at the end is empty, there were trailing
- * "::"s after the namespace's name which we ignore. The new namespace
- * was already (recursively) created and is pointed to by parentPtr.
- */
+ TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
+ &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
- if (*simpleName == '\0') {
- return (Tcl_Namespace *) parentPtr;
- }
+ /*
+ * If the unqualified name at the end is empty, there were trailing "::"s
+ * after the namespace's name which we ignore. The new namespace was
+ * already (recursively) created and is pointed to by parentPtr.
+ */
- /*
- * Check for a bad namespace name and make sure that the name does not
- * already exist in the parent namespace.
- */
+ if (*simpleName == '\0') {
+ Tcl_DStringFree(&tmpBuffer);
+ return (Tcl_Namespace *) parentPtr;
+ }
- if (
+ /*
+ * Check for a bad namespace name and make sure that the name does not
+ * already exist in the parent namespace.
+ */
+
+ if (
#ifndef BREAK_NAMESPACE_COMPAT
- Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
+ Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
#else
- parentPtr->childTablePtr != NULL &&
- Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
+ parentPtr->childTablePtr != NULL &&
+ Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
- ) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't create namespace \"%s\": already exists", name));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
- "CREATEEXISTING", NULL);
- return NULL;
- }
+ ) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create namespace \"%s\": already exists", name));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEEXISTING", NULL);
+ Tcl_DStringFree(&tmpBuffer);
+ return NULL;
}
/*
@@ -736,6 +769,7 @@ Tcl_CreateNamespace(
* of namespaces created.
*/
+ doCreate:
nsPtr = ckalloc(sizeof(Namespace));
nameLen = strlen(simpleName) + 1;
nsPtr->name = ckalloc(nameLen);
@@ -831,6 +865,7 @@ Tcl_CreateNamespace(
Tcl_DStringFree(&buffer1);
Tcl_DStringFree(&buffer2);
+ Tcl_DStringFree(&tmpBuffer);
/*
* If compilation of commands originating from the parent NS is
@@ -1070,8 +1105,6 @@ TclTeardownNamespace(
Interp *iPtr = (Interp *) nsPtr->interp;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
- Tcl_Namespace *childNsPtr;
- Tcl_Command cmd;
int i;
/*
@@ -1086,16 +1119,31 @@ TclTeardownNamespace(
/*
* Delete all commands in this namespace. Be careful when traversing the
* hash table: when each command is deleted, it removes itself from the
- * command table.
- *
- * Don't optimize to Tcl_NextHashEntry() because of traces.
+ * command table. Because of traces (and the desire to avoid the quadratic
+ * problems of just using Tcl_FirstHashEntry over and over, [Bug
+ * f97d4ee020]) we copy to a temporary array and then delete all those
+ * commands.
*/
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
- cmd = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+ while (nsPtr->cmdTable.numEntries > 0) {
+ int length = nsPtr->cmdTable.numEntries;
+ Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Command *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ cmds[i] = Tcl_GetHashValue(entryPtr);
+ cmds[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+ (Tcl_Command) cmds[i]);
+ TclCleanupCommandMacro(cmds[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, cmds);
}
Tcl_DeleteHashTable(&nsPtr->cmdTable);
Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -1140,25 +1188,54 @@ TclTeardownNamespace(
*
* BE CAREFUL: When each child is deleted, it will divorce itself from its
* parent. You can't traverse a hash table properly if its elements are
- * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
+ * being deleted. Because of traces (and the desire to avoid the
+ * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+ * f97d4ee020]) we copy to a temporary array and then delete all those
+ * namespaces.
*
- * Don't optimize to Tcl_NextHashEntry() because of traces.
+ * Important: leave the hash table itself still live.
*/
#ifndef BREAK_NAMESPACE_COMPAT
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
- childNsPtr = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ while (nsPtr->childTable.numEntries > 0) {
+ int length = nsPtr->childTable.numEntries;
+ Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
}
#else
if (nsPtr->childTablePtr != NULL) {
- for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
- childNsPtr = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ while (nsPtr->childTablePtr->numEntries > 0) {
+ int length = nsPtr->childTablePtr->numEntries;
+ Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
}
}
#endif
@@ -1942,7 +2019,7 @@ InvokeImportedNRCmd(
Command *realCmdPtr = dataPtr->realCmdPtr;
TclSkipTailcall(interp);
- return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
+ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}
static int
@@ -3021,7 +3098,7 @@ NamespaceCodeCmd(
*/
arg = TclGetStringFromObj(objv[1], &length);
- if (*arg==':' && length > 20
+ if (*arg==':' && length > 20
&& strncmp(arg, "::namespace inscope ", 20) == 0) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
@@ -3274,11 +3351,8 @@ NRNamespaceEvalCmd(
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
framePtrPtr = &framePtr;
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
framePtr->objc = objc;
@@ -3695,7 +3769,7 @@ NRNamespaceInscopeCmd(
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
register Interp *iPtr = (Interp *) interp;
- int i, result;
+ int i;
Tcl_Obj *cmdObjPtr;
if (objc < 3) {
@@ -3717,11 +3791,8 @@ NRNamespaceInscopeCmd(
framePtrPtr = &framePtr; /* This is needed to satisfy GCC's
* strict aliasing rules. */
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- return result;
- }
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
framePtr->objc = objc;
@@ -4894,7 +4965,7 @@ TclLogCommandInfo(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -4926,7 +4997,7 @@ TclLogCommandInfo(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(command, length));
}
- }
+ }
if (!iPtr->framePtr->objc) {
/*
@@ -4979,7 +5050,7 @@ TclErrorStackResetIf(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -4999,7 +5070,7 @@ TclErrorStackResetIf(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(msg, length));
- }
+ }
}
/*
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index a6523fc..e76bca8 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -813,11 +813,7 @@ Tcl_SetMaxBlockTime(
*/
if (!tsdPtr->inTraversal) {
- if (tsdPtr->blockTimeSet) {
- Tcl_SetTimer(&tsdPtr->blockTime);
- } else {
- Tcl_SetTimer(NULL);
- }
+ Tcl_SetTimer(&tsdPtr->blockTime);
}
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index cb22de6..9df5029 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -58,6 +58,8 @@ static const struct {
static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj);
static Object * AllocObject(Tcl_Interp *interp, const char *nameStr,
const char *nsNameStr);
+static void ClearMixins(Class *clsPtr);
+static void ClearSuperclasses(Class *clsPtr);
static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
Method *mPtr, Tcl_Obj *namePtr,
Method **newMPtrPtr);
@@ -271,7 +273,7 @@ TclOOInit(
return TCL_ERROR;
}
- return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION,
+ return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
(ClientData) &tclOOStubs);
}
@@ -394,6 +396,7 @@ InitFoundation(
fPtr->classCls->flags |= ROOT_CLASS;
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
AddRef(fPtr->objectCls->thisPtr);
AddRef(fPtr->objectCls);
@@ -437,10 +440,12 @@ InitFoundation(
* ensemble.
*/
- Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
- NULL);
- Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
- NULL, NULL);
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+ NULL, TclOONextObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextCmd;
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+ NULL, TclOONextToObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextToCmd;
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
TclOOSelfObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectSelfCmd;
@@ -790,7 +795,7 @@ ObjectRenamedTrace(
ClientData clientData, /* The object being deleted. */
Tcl_Interp *interp, /* The interpreter containing the object. */
const char *oldName, /* What the object was (last) called. */
- const char *newName, /* Always NULL. */
+ const char *newName, /* What it's getting renamed to. (unused) */
int flags) /* Why was the object deleted? */
{
Object *oPtr = clientData;
@@ -893,6 +898,55 @@ ObjectRenamedTrace(
/*
* ----------------------------------------------------------------------
*
+ * ClearMixins, ClearSuperclasses --
+ *
+ * Utility functions for correctly clearing the list of mixins or
+ * superclasses of a class. Will ckfree() the list storage.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ClearMixins(
+ Class *clsPtr)
+{
+ int i;
+ Class *mixinPtr;
+
+ if (clsPtr->mixins.num == 0) {
+ return;
+ }
+
+ FOREACH(mixinPtr, clsPtr->mixins) {
+ TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+ }
+ ckfree(clsPtr->mixins.list);
+ clsPtr->mixins.list = NULL;
+ clsPtr->mixins.num = 0;
+}
+
+static void
+ClearSuperclasses(
+ Class *clsPtr)
+{
+ int i;
+ Class *superPtr;
+
+ if (clsPtr->superclasses.num == 0) {
+ return;
+ }
+
+ FOREACH(superPtr, clsPtr->superclasses) {
+ TclOORemoveFromSubclasses(clsPtr, superPtr);
+ }
+ ckfree(clsPtr->superclasses.list);
+ clsPtr->superclasses.list = NULL;
+ clsPtr->superclasses.num = 0;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* ReleaseClassContents --
*
* Tear down the special class data structure, including deleting all
@@ -948,6 +1002,16 @@ ReleaseClassContents(
}
if (!IsRootClass(oPtr)) {
FOREACH(instancePtr, clsPtr->instances) {
+ int j;
+ if (instancePtr->selfCls == clsPtr) {
+ instancePtr->flags |= CLASS_GONE;
+ }
+ for(j=0 ; j<instancePtr->mixins.num ; j++) {
+ Class *mixin = instancePtr->mixins.list[j];
+ if (mixin == clsPtr) {
+ instancePtr->mixins.list[j] = NULL;
+ }
+ }
if (instancePtr != NULL && !IsRoot(instancePtr)) {
AddRef(instancePtr);
}
@@ -959,13 +1023,11 @@ ReleaseClassContents(
*/
FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
- if (mixinSubclassPtr == NULL) {
- continue;
- }
if (!Deleted(mixinSubclassPtr->thisPtr)) {
Tcl_DeleteCommandFromToken(interp,
mixinSubclassPtr->thisPtr->command);
}
+ ClearMixins(mixinSubclassPtr);
DelRef(mixinSubclassPtr->thisPtr);
DelRef(mixinSubclassPtr);
}
@@ -980,12 +1042,13 @@ ReleaseClassContents(
*/
FOREACH(subclassPtr, clsPtr->subclasses) {
- if (subclassPtr == NULL || IsRoot(subclassPtr)) {
+ if (IsRoot(subclassPtr)) {
continue;
}
if (!Deleted(subclassPtr->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
}
+ ClearSuperclasses(subclassPtr);
DelRef(subclassPtr->thisPtr);
DelRef(subclassPtr);
}
@@ -1006,6 +1069,12 @@ ReleaseClassContents(
}
if (!Deleted(instancePtr)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
+ /*
+ * Tcl_DeleteCommandFromToken() may have done to whole
+ * job for us. Roll back and check again.
+ */
+ i--;
+ continue;
}
DelRef(instancePtr);
}
@@ -1122,12 +1191,14 @@ ObjectNamespaceDeleted(
* methods on the object.
*/
- if (!IsRootObject(oPtr)) {
+ if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) {
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
}
FOREACH(mixinPtr, oPtr->mixins) {
- TclOORemoveFromInstances(oPtr, mixinPtr);
+ if (mixinPtr) {
+ TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
}
if (i) {
ckfree(oPtr->mixins.list);
@@ -1173,8 +1244,11 @@ ObjectNamespaceDeleted(
oPtr->metadataPtr = NULL;
}
+ /*
+ * If this was a class, there's additional deletion work to do.
+ */
+
if (clsPtr != NULL) {
- Class *superPtr;
Tcl_ObjectMetadataType *metadataTypePtr;
ClientData value;
@@ -1194,24 +1268,11 @@ ObjectNamespaceDeleted(
ckfree(clsPtr->filters.list);
clsPtr->filters.num = 0;
}
- FOREACH(mixinPtr, clsPtr->mixins) {
- if (!Deleted(mixinPtr->thisPtr)) {
- TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
- }
- }
- if (i) {
- ckfree(clsPtr->mixins.list);
- clsPtr->mixins.num = 0;
- }
- FOREACH(superPtr, clsPtr->superclasses) {
- if (!Deleted(superPtr->thisPtr)) {
- TclOORemoveFromSubclasses(clsPtr, superPtr);
- }
- }
- if (i) {
- ckfree(clsPtr->superclasses.list);
- clsPtr->superclasses.num = 0;
- }
+
+ ClearMixins(clsPtr);
+
+ ClearSuperclasses(clsPtr);
+
if (clsPtr->subclasses.list) {
ckfree(clsPtr->subclasses.list);
clsPtr->subclasses.num = 0;
@@ -1278,6 +1339,9 @@ TclOORemoveFromInstances(
removeInstance:
if (Deleted(clsPtr->thisPtr)) {
+ if (!IsRootClass(clsPtr)) {
+ DelRef(clsPtr->instances.list[i]);
+ }
clsPtr->instances.list[i] = NULL;
} else {
clsPtr->instances.num--;
@@ -1350,9 +1414,7 @@ TclOORemoveFromSubclasses(
return;
removeSubclass:
- if (Deleted(superPtr->thisPtr)) {
- superPtr->subclasses.list[i] = NULL;
- } else {
+ if (!Deleted(superPtr->thisPtr)) {
superPtr->subclasses.num--;
if (i < superPtr->subclasses.num) {
superPtr->subclasses.list[i] =
@@ -1423,9 +1485,7 @@ TclOORemoveFromMixinSubs(
return;
removeSubclass:
- if (Deleted(superPtr->thisPtr)) {
- superPtr->mixinSubs.list[i] = NULL;
- } else {
+ if (!Deleted(superPtr->thisPtr)) {
superPtr->mixinSubs.num--;
if (i < superPtr->mixinSubs.num) {
superPtr->mixinSubs.list[i] =
@@ -1663,10 +1723,13 @@ Tcl_NewObjectInstance(
/*
* Take care to not delete a deleted object; that would be
- * bad. [Bug 2903011]
+ * bad. [Bug 2903011] Also take care to make sure that we have
+ * the name of the command before we delete it. [Bug
+ * 9dd1bd7a74]
*/
if (!Deleted(oPtr)) {
+ (void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
return NULL;
@@ -1809,10 +1872,12 @@ FinalizeAlloc(
/*
* Take care to not delete a deleted object; that would be bad. [Bug
- * 2903011]
+ * 2903011] Also take care to make sure that we have the name of the
+ * command before we delete it. [Bug 9dd1bd7a74]
*/
if (!Deleted(oPtr)) {
+ (void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
DelRef(oPtr);
@@ -1891,13 +1956,13 @@ Tcl_CopyObjectInstance(
*/
FOREACH(mixinPtr, o2Ptr->mixins) {
- if (mixinPtr != o2Ptr->selfCls) {
+ if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
TclOORemoveFromInstances(o2Ptr, mixinPtr);
}
}
DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
FOREACH(mixinPtr, o2Ptr->mixins) {
- if (mixinPtr != o2Ptr->selfCls) {
+ if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
TclOOAddToInstances(o2Ptr, mixinPtr);
}
}
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 31d1113..265ba88 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,12 +1,24 @@
+# tclOO.decls --
+#
+# This file contains the declarations for all supported public functions
+# that are exported by the TclOO package that is embedded within the Tcl
+# library via the stubs table. This file is used to generate the
+# tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
+#
+# Copyright (c) 2008-2013 by Donal K. Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
library tclOO
######################################################################
-# public API
+# Public API, exposed for general users of TclOO.
#
interface tclOO
hooks tclOOInt
-scspec TCLOOAPI
+scspec TCLAPI
declare 0 {
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
@@ -116,7 +128,9 @@ declare 28 {
}
######################################################################
-# private API, exposed to support advanced OO systems that plug in on top
+# Private API, exposed to support advanced OO systems that plug in on top of
+# TclOO; not intended for general use and does not have any commitment to
+# long-term support.
#
interface tclOOInt
diff --git a/generic/tclOO.h b/generic/tclOO.h
index cf253b1..696908a 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -12,21 +12,6 @@
#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED
-#include "tcl.h"
-
-#ifndef TCLOOAPI
-# if defined(BUILD_tcl) || defined(BUILD_TclOO)
-# define TCLOOAPI MODULE_SCOPE
-# else
-# define TCLOOAPI extern
-# undef USE_TCLOO_STUBS
-# define USE_TCLOO_STUBS 1
-# endif
-#endif
-
-extern const char *TclOOInitializeStubs(
- Tcl_Interp *, const char *version);
-#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION)
/*
* Be careful when it comes to versioning; need to make sure that the
@@ -39,9 +24,27 @@ extern const char *TclOOInitializeStubs(
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.0"
+#define TCLOO_VERSION "1.0.4"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
+#include "tcl.h"
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern const char *TclOOInitializeStubs(
+ Tcl_Interp *, const char *version);
+#define Tcl_OOInitStubs(interp) \
+ TclOOInitializeStubs((interp), TCLOO_VERSION)
+#ifndef USE_TCL_STUBS
+# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
+#endif
+
/*
* These are opaque types.
*/
@@ -130,6 +133,9 @@ typedef struct {
#include "tclOODecls.h"
+#ifdef __cplusplus
+}
+#endif
#endif
/*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index aba06a5..8cb80e5 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -4,7 +4,7 @@
* This file contains implementations of the "simple" commands and
* methods from the object-system core.
*
- * Copyright (c) 2005-2012 by Donal K. Fellows
+ * Copyright (c) 2005-2013 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,16 +17,11 @@
#include "tclOOInt.h"
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
-static int AfterNRDestructor(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DecrRefsPostClassConstructor(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeConstruction(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeEval(ClientData data[],
- Tcl_Interp *interp, int result);
-static int RestoreFrame(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc AfterNRDestructor;
+static Tcl_NRPostProc DecrRefsPostClassConstructor;
+static Tcl_NRPostProc FinalizeConstruction;
+static Tcl_NRPostProc FinalizeEval;
+static Tcl_NRPostProc NextRestoreFrame;
/*
* ----------------------------------------------------------------------
@@ -407,7 +402,6 @@ TclOO_Object_Eval(
register const int skip = Tcl_ObjectContextSkippedArgs(context);
CallFrame *framePtr, **framePtrPtr = &framePtr;
Tcl_Obj *scriptPtr;
- int result;
CmdFrame *invoker;
if (objc-1 < skip) {
@@ -420,11 +414,8 @@ TclOO_Object_Eval(
* command(s).
*/
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
Tcl_GetObjectNamespace(object), 0);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
framePtr->objc = objc;
framePtr->objv = objv; /* Reference counts do not need to be
* incremented here. */
@@ -808,7 +799,7 @@ TclOONextObjCmd(
* that this is like [uplevel 1] and not [eval].
*/
- TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
@@ -826,6 +817,7 @@ TclOONextToObjCmd(
CallContext *contextPtr;
int i;
Tcl_Object object;
+ const char *methodType;
/*
* Start with sanity checks on the calling context to make sure that we
@@ -877,8 +869,8 @@ TclOONextToObjCmd(
* context. Note that this is like [uplevel 1] and not [eval].
*/
- TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
- INT2PTR(contextPtr->index), NULL);
+ TclNRAddCallback(interp, NextRestoreFrame, framePtr,
+ contextPtr, INT2PTR(contextPtr->index), NULL);
contextPtr->index = i-1;
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp,
@@ -891,24 +883,35 @@ TclOONextToObjCmd(
* is on the chain but unreachable, or not on the chain at all.
*/
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
for (i=contextPtr->index ; i>=0 ; i--) {
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "method implementation by \"%s\" not reachable from here",
- TclGetString(objv[1])));
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "method has no non-filter implementation by \"%s\"",
- TclGetString(objv[1])));
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
return TCL_ERROR;
}
static int
-RestoreFrame(
+NextRestoreFrame(
ClientData data[],
Tcl_Interp *interp,
int result)
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 26fd09f..facf90d 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -38,6 +38,12 @@ struct ChainBuilder {
#define DEFINITE_PUBLIC 0x200000
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
+#define BUILDING_MIXINS 0x400000
+#define TRAVERSED_MIXIN 0x800000
+#define OBJECT_MIXIN 0x1000000
+#define MIXIN_CONSISTENT(flags) \
+ (((flags) & OBJECT_MIXIN) || \
+ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
/*
* Function declarations for things defined in this file.
@@ -45,13 +51,13 @@ struct ChainBuilder {
static void AddClassFiltersToCallContext(Object *const oPtr,
Class *clsPtr, struct ChainBuilder *const cbPtr,
- Tcl_HashTable *const doneFilters);
+ Tcl_HashTable *const doneFilters, int flags);
static void AddClassMethodNames(Class *clsPtr, const int flags,
Tcl_HashTable *const namesPtr);
static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
- Class *const filterDecl);
+ Class *const filterDecl, int flags);
static inline void AddSimpleChainToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
@@ -150,7 +156,7 @@ void
TclOODeleteChain(
CallChain *callPtr)
{
- if (--callPtr->refCount >= 1) {
+ if (callPtr == NULL || callPtr->refCount-- > 1) {
return;
}
if (callPtr->chain != callPtr->staticChain) {
@@ -434,7 +440,7 @@ TclOOGetSortedMethodList(
AddClassMethodNames(oPtr->selfCls, flags, &names);
FOREACH(mixinPtr, oPtr->mixins) {
- AddClassMethodNames(mixinPtr, flags, &names);
+ AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names);
}
/*
@@ -598,7 +604,7 @@ AddClassMethodNames(
/* TODO: Beware of infinite loops! */
FOREACH(mixinPtr, clsPtr->mixins) {
- AddClassMethodNames(mixinPtr, flags, namesPtr);
+ AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
}
}
@@ -695,13 +701,13 @@ AddSimpleChainToCallContext(
FOREACH(mixinPtr, oPtr->mixins) {
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
if (hPtr != NULL) {
AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
- doneFilters, filterDecl);
+ doneFilters, filterDecl, flags);
}
}
}
@@ -732,9 +738,15 @@ AddMethodToCallChain(
* 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
+ 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;
@@ -743,9 +755,11 @@ AddMethodToCallChain(
* Return 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) {
+ if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
return;
}
@@ -1001,6 +1015,8 @@ TclOOGetCallContext(
if (flags & FORCE_UNKNOWN) {
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1024,21 +1040,32 @@ TclOOGetCallContext(
doFilters = 1;
Tcl_InitObjHashTable(&doneFilters);
FOREACH(mixinPtr, oPtr->mixins) {
- AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
+ TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
+ OBJECT_MIXIN);
}
FOREACH(filterObj, oPtr->filters) {
+ AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
+ BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
NULL);
}
- AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
+ AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+ BUILDING_MIXINS);
+ AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+ 0);
Tcl_DeleteHashTable(&doneFilters);
}
count = cb.filterLength = callPtr->numChain;
/*
- * Add the actual method implementations.
+ * Add the actual method implementations. We have to do this twice to
+ * handle class mixins right.
*/
+ AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
+ flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1058,6 +1085,8 @@ TclOOGetCallContext(
return NULL;
}
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1201,7 +1230,9 @@ TclOOGetStereotypeCallChain(
*/
Tcl_InitObjHashTable(&doneFilters);
- AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters);
+ AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
+ BUILDING_MIXINS);
+ AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
Tcl_DeleteHashTable(&doneFilters);
count = cb.filterLength = callPtr->numChain;
@@ -1209,6 +1240,8 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
+ AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
+ flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1219,6 +1252,8 @@ TclOOGetStereotypeCallChain(
if (count == callPtr->numChain) {
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
+ NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1259,12 +1294,15 @@ AddClassFiltersToCallContext(
Class *clsPtr, /* Class to get the filters from. */
struct ChainBuilder *const cbPtr,
/* Context to fill with call chain entries. */
- Tcl_HashTable *const doneFilters)
+ Tcl_HashTable *const doneFilters,
/* Where to record what filters have been
* processed. Keys are objects, values are
* ignored. */
+ int flags) /* Whether we've gone along a mixin link
+ * yet. */
{
- int i;
+ int i, clearedFlags =
+ flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
Class *superPtr, *mixinPtr;
Tcl_Obj *filterObj;
@@ -1279,7 +1317,8 @@ AddClassFiltersToCallContext(
*/
FOREACH(mixinPtr, clsPtr->mixins) {
- AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
+ flags|TRAVERSED_MIXIN);
}
/*
@@ -1288,13 +1327,18 @@ AddClassFiltersToCallContext(
* override how filters work to extend their behaviour.
*/
- FOREACH(filterObj, clsPtr->filters) {
- int isNew;
+ if (MIXIN_CONSISTENT(flags)) {
+ FOREACH(filterObj, clsPtr->filters) {
+ int isNew;
- (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
- if (isNew) {
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
- 0, clsPtr);
+ (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
+ &isNew);
+ if (isNew) {
+ AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
+ AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ doneFilters, clearedFlags, clsPtr);
+ }
}
}
@@ -1308,7 +1352,8 @@ AddClassFiltersToCallContext(
goto tailRecurse;
default:
FOREACH(superPtr, clsPtr->superclasses) {
- AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
+ AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
+ flags);
}
case 0:
return;
@@ -1355,16 +1400,16 @@ AddSimpleClassChainToCallContext(
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (flags & CONSTRUCTOR) {
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
- filterDecl);
+ filterDecl, flags);
} else if (flags & DESTRUCTOR) {
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
- filterDecl);
+ filterDecl, flags);
} else {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodNameObj);
@@ -1383,7 +1428,7 @@ AddSimpleClassChainToCallContext(
flags |= DEFINITE_PROTECTED;
}
}
- AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
}
}
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 58871c6..9fd62ec 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -5,99 +5,116 @@
#ifndef _TCLOODECLS
#define _TCLOODECLS
+#ifndef TCLAPI
+# ifdef BUILD_tcl
+# define TCLAPI extern DLLEXPORT
+# else
+# define TCLAPI extern DLLIMPORT
+# endif
+#endif
+
+#ifdef USE_TCL_STUBS
+# undef USE_TCLOO_STUBS
+# define USE_TCLOO_STUBS
+#endif
+
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
/* 0 */
-TCLOOAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
Tcl_Object sourceObject,
const char *targetName,
const char *targetNamespaceName);
/* 1 */
-TCLOOAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
+TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
/* 2 */
-TCLOOAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
+TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
/* 3 */
-TCLOOAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
+TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
/* 4 */
-TCLOOAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 5 */
-TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
/* 6 */
-TCLOOAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
/* 7 */
-TCLOOAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
-TCLOOAPI int Tcl_MethodIsPublic(Tcl_Method method);
+TCLAPI int Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
-TCLOOAPI int Tcl_MethodIsType(Tcl_Method method,
+TCLAPI int Tcl_MethodIsType(Tcl_Method method,
const Tcl_MethodType *typePtr,
ClientData *clientDataPtr);
/* 10 */
-TCLOOAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
+TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
-TCLOOAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData);
/* 12 */
-TCLOOAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
/* 13 */
-TCLOOAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip);
/* 14 */
-TCLOOAPI int Tcl_ObjectDeleted(Tcl_Object object);
+TCLAPI int Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
-TCLOOAPI int Tcl_ObjectContextIsFiltering(
+TCLAPI int Tcl_ObjectContextIsFiltering(
Tcl_ObjectContext context);
/* 16 */
-TCLOOAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
-TCLOOAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
-TCLOOAPI int Tcl_ObjectContextSkippedArgs(
+TCLAPI int Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context);
/* 19 */
-TCLOOAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr);
/* 20 */
-TCLOOAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 21 */
-TCLOOAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr);
/* 22 */
-TCLOOAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 23 */
-TCLOOAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, int objc,
Tcl_Obj *const *objv, int skip);
/* 24 */
-TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
/* 25 */
-TCLOOAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
-TCLOOAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 27 */
-TCLOOAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
-TCLOOAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
+TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
typedef struct {
@@ -139,10 +156,8 @@ typedef struct TclOOStubs {
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
} TclOOStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclOOStubs *tclOOStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -215,4 +230,5 @@ extern const TclOOStubs *tclOOStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
+
#endif /* _TCLOODECLS */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index f0983cc..c880754 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,7 +4,7 @@
* This file contains the implementation of the ::oo::define command,
* part of the object-system core (NB: not Tcl_Obj, but ::oo).
*
- * Copyright (c) 2006-2012 by Donal K. Fellows
+ * Copyright (c) 2006-2013 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -323,7 +323,9 @@ TclOOObjectSetMixins(
if (numMixins == 0) {
if (oPtr->mixins.num != 0) {
FOREACH(mixinPtr, oPtr->mixins) {
- TclOORemoveFromInstances(oPtr, mixinPtr);
+ if (mixinPtr) {
+ TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
}
ckfree(oPtr->mixins.list);
oPtr->mixins.num = 0;
@@ -332,7 +334,7 @@ TclOOObjectSetMixins(
} else {
if (oPtr->mixins.num != 0) {
FOREACH(mixinPtr, oPtr->mixins) {
- if (mixinPtr != oPtr->selfCls) {
+ if (mixinPtr && mixinPtr != oPtr->selfCls) {
TclOORemoveFromInstances(oPtr, mixinPtr);
}
}
@@ -646,7 +648,6 @@ InitDefineContext(
Tcl_Obj *const objv[])
{
CallFrame *framePtr, **framePtrPtr = &framePtr;
- int result;
if (namespacePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -658,11 +659,8 @@ InitDefineContext(
/* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, FRAME_IS_OO_DEFINE);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
framePtr->clientData = oPtr;
framePtr->objc = objc;
framePtr->objv = objv; /* Reference counts do not need to be
@@ -891,6 +889,7 @@ TclOODefineObjCmd(
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ /* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
@@ -1005,6 +1004,7 @@ TclOOObjDefObjCmd(
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ /* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
@@ -1119,6 +1119,7 @@ TclOODefineSelfObjCmd(
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ /* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
@@ -1214,6 +1215,9 @@ TclOODefineClassObjCmd(
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
oPtr->selfCls = clsPtr;
TclOOAddToInstances(oPtr, oPtr->selfCls);
+ if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
+ oPtr->flags &= ~CLASS_GONE;
+ }
if (oPtr->classPtr != NULL) {
BumpGlobalEpoch(interp, oPtr->classPtr);
} else {
@@ -2510,8 +2514,10 @@ ObjMixinGet(
resultObj = Tcl_NewObj();
FOREACH(mixinPtr, oPtr->mixins) {
- Tcl_ListObjAppendElement(NULL, resultObj,
- TclOOObjectName(interp, mixinPtr->thisPtr));
+ if (mixinPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
+ }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 3217f98..76eaef5 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -196,6 +196,9 @@ InfoObjectClassCmd(
}
FOREACH(mixinPtr, oPtr->mixins) {
+ if (!mixinPtr) {
+ continue;
+ }
if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
return TCL_OK;
@@ -401,7 +404,7 @@ InfoObjectIsACmd(
IsClass, IsMetaclass, IsMixin, IsObject, IsType
};
Object *oPtr, *o2Ptr;
- int idx, i;
+ int idx, i, result = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
@@ -412,93 +415,88 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
- if (idx == IsObject) {
- int ok = (Tcl_GetObjectFromObj(interp, objv[2]) != NULL);
-
- if (!ok) {
- Tcl_ResetResult(interp);
- }
- Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
- return TCL_OK;
- }
- oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
- if (oPtr == NULL) {
- return TCL_ERROR;
- }
+ /*
+ * Now we know what test we are doing, we can check we've got the right
+ * number of arguments.
+ */
switch ((enum IsACats) idx) {
+ case IsObject:
case IsClass:
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "objName");
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
- return TCL_OK;
case IsMetaclass:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
- if (oPtr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- } else {
- Class *classCls = TclOOGetFoundation(interp)->classCls;
-
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
- }
- return TCL_OK;
+ break;
case IsMixin:
+ case IsType:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objName className");
return TCL_ERROR;
}
+ break;
+ }
+
+ /*
+ * Perform the check. Note that we can guarantee that we will not fail
+ * from here on; "failures" result in a false-TCL_OK result.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ goto failPrecondition;
+ }
+
+ switch ((enum IsACats) idx) {
+ case IsObject:
+ result = 1;
+ break;
+ case IsClass:
+ result = (oPtr->classPtr != NULL);
+ break;
+ case IsMetaclass:
+ if (oPtr->classPtr != NULL) {
+ result = TclOOIsReachable(TclOOGetFoundation(interp)->classCls,
+ oPtr->classPtr);
+ }
+ break;
+ case IsMixin:
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
- return TCL_ERROR;
+ goto failPrecondition;
}
- if (o2Ptr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "non-classes cannot be mixins", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
- return TCL_ERROR;
- } else {
+ if (o2Ptr->classPtr != NULL) {
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
- if (mixinPtr == o2Ptr->classPtr) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
- return TCL_OK;
+ if (!mixinPtr) {
+ continue;
+ }
+ if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
+ result = 1;
+ break;
}
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- return TCL_OK;
+ break;
case IsType:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "objName className");
- return TCL_ERROR;
- }
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
- return TCL_ERROR;
+ goto failPrecondition;
}
- if (o2Ptr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "non-classes cannot be types", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
- return TCL_ERROR;
+ if (o2Ptr->classPtr != NULL) {
+ result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls);
}
- if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- }
- return TCL_OK;
- case IsObject:
- Tcl_Panic("unexpected fallthrough");
+ break;
}
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ return TCL_OK;
+
+ failPrecondition:
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
}
/*
@@ -673,6 +671,9 @@ InfoObjectMixinsCmd(
resultObj = Tcl_NewObj();
FOREACH(mixinPtr, oPtr->mixins) {
+ if (!mixinPtr) {
+ continue;
+ }
Tcl_ListObjAppendElement(NULL, resultObj,
TclOOObjectName(interp, mixinPtr->thisPtr));
}
@@ -1289,6 +1290,9 @@ InfoClassMixinsCmd(
resultObj = Tcl_NewObj();
FOREACH(mixinPtr, clsPtr->mixins) {
+ if (!mixinPtr) {
+ continue;
+ }
Tcl_ListObjAppendElement(NULL, resultObj,
TclOOObjectName(interp, mixinPtr->thisPtr));
}
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index c0e4022..b75ffdb 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -193,6 +193,9 @@ typedef struct Object {
* destroyed. */
#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
* called. */
+#define CLASS_GONE 4 /* Indicates that the class of this object has
+ * been deleted, and so the object should not
+ * attempt to remove itself from its class. */
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
@@ -588,7 +591,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do { \
- if (--(ptr)->refCount < 1) { \
+ if ((ptr)->refCount-- <= 1) { \
ckfree((char *) (ptr)); \
} \
} while(0)
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index acafb18..74a8d81 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -7,51 +7,55 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
/* 0 */
-TCLOOAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
-TCLOOAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 2 */
-TCLOOAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
Class *clsPtr, int flags, Tcl_Obj *nameObj,
const char *namePtr, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 3 */
-TCLOOAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 4 */
-TCLOOAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 5 */
-TCLOOAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv,
int publicOnly, Class *startCls);
/* 6 */
-TCLOOAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
+TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
-TCLOOAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
+TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic,
Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
/* 8 */
-TCLOOAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
/* 9 */
-TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -60,7 +64,7 @@ TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 10 */
-TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -69,22 +73,22 @@ TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 11 */
-TCLOOAPI int TclOOInvokeObject(Tcl_Interp *interp,
+TCLAPI int TclOOInvokeObject(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class startCls,
int publicPrivate, int objc,
Tcl_Obj *const *objv);
/* 12 */
-TCLOOAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
+TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
Tcl_Obj *const *filters);
/* 13 */
-TCLOOAPI void TclOOClassSetFilters(Tcl_Interp *interp,
+TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
Class *classPtr, int numFilters,
Tcl_Obj *const *filters);
/* 14 */
-TCLOOAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
Class *const *mixins);
/* 15 */
-TCLOOAPI void TclOOClassSetMixins(Tcl_Interp *interp,
+TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
Class *classPtr, int numMixins,
Class *const *mixins);
@@ -110,10 +114,8 @@ typedef struct TclOOIntStubs {
void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclOOIntStubs *tclOOIntStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -160,4 +162,5 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
+
#endif /* _TCLOOINTDECLS */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index f9f980a..34fa108 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -272,7 +272,7 @@ void
TclOODelMethodRef(
Method *mPtr)
{
- if ((mPtr != NULL) && (--mPtr->refCount <= 0)) {
+ if ((mPtr != NULL) && (mPtr->refCount-- <= 1)) {
if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
mPtr->typePtr->deleteProc(mPtr->clientData);
}
@@ -720,7 +720,7 @@ InvokeProcedureMethod(
Tcl_PopCallFrame(interp);
TclStackFree(interp, fdPtr->framePtr);
- if (--pmPtr->refCount < 1) {
+ if (pmPtr->refCount-- <= 1) {
DeleteProcedureMethodRecord(pmPtr);
}
TclStackFree(interp, fdPtr);
@@ -771,7 +771,7 @@ FinalizePMCall(
* sensitive when it comes to performance!
*/
- if (--pmPtr->refCount < 1) {
+ if (pmPtr->refCount-- <= 1) {
DeleteProcedureMethodRecord(pmPtr);
}
TclStackFree(interp, fdPtr);
@@ -875,11 +875,8 @@ PushMethodCallFrame(
* This operation may fail.
*/
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
(Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
- if (result != TCL_OK) {
- goto failureReturn;
- }
fdPtr->framePtr->clientData = contextPtr;
fdPtr->framePtr->objc = objc;
@@ -961,7 +958,7 @@ ProcedureMethodVarResolver(
{
int result;
Tcl_ResolvedVarInfo *rPtr = NULL;
-
+
result = ProcedureMethodCompiledVarResolver(interp, varName,
strlen(varName), contextNs, &rPtr);
@@ -1278,7 +1275,7 @@ DeleteProcedureMethod(
{
register ProcedureMethod *pmPtr = clientData;
- if (--pmPtr->refCount < 1) {
+ if (pmPtr->refCount-- <= 1) {
DeleteProcedureMethodRecord(pmPtr);
}
}
@@ -1290,11 +1287,57 @@ CloneProcedureMethod(
ClientData *newClientData)
{
ProcedureMethod *pmPtr = clientData;
- ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
+ ProcedureMethod *pm2Ptr;
+ Tcl_Obj *bodyObj, *argsObj;
+ CompiledLocal *localPtr;
+
+ /*
+ * Copy the argument list.
+ */
+
+ argsObj = Tcl_NewObj();
+ for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_Obj *argObj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(NULL, argObj,
+ Tcl_NewStringObj(localPtr->name, -1));
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+ }
+ Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+ }
+ }
+ /*
+ * Must strip the internal representation in order to ensure that any
+ * bound references to instance variables are removed. [Bug 3609693]
+ */
+
+ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+ TclFreeIntRep(bodyObj);
+
+ /*
+ * Create the actual copy of the method record, manufacturing a new proc
+ * record.
+ */
+
+ pm2Ptr = ckalloc(sizeof(ProcedureMethod));
memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
pm2Ptr->refCount = 1;
- pm2Ptr->procPtr->refCount++;
+ Tcl_IncrRefCount(argsObj);
+ Tcl_IncrRefCount(bodyObj);
+ if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
+ &pm2Ptr->procPtr) != TCL_OK) {
+ Tcl_DecrRefCount(argsObj);
+ Tcl_DecrRefCount(bodyObj);
+ ckfree(pm2Ptr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(argsObj);
+ Tcl_DecrRefCount(bodyObj);
+
if (pmPtr->cloneClientdataProc) {
pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
}
@@ -1305,7 +1348,7 @@ CloneProcedureMethod(
/*
* ----------------------------------------------------------------------
*
- * TclOONewForwardMethod --
+ * TclOONewForwardInstanceMethod --
*
* Create a forwarded method for an object.
*
@@ -1323,7 +1366,6 @@ TclOONewForwardInstanceMethod(
{
int prefixLen;
register ForwardMethod *fmPtr;
- Tcl_Obj *cmdObj;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
@@ -1337,7 +1379,6 @@ TclOONewForwardInstanceMethod(
fmPtr = ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
- Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
Tcl_IncrRefCount(prefixObj);
return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
nameObj, flags, &fwdMethodType, fmPtr);
@@ -1364,7 +1405,6 @@ TclOONewForwardMethod(
{
int prefixLen;
register ForwardMethod *fmPtr;
- Tcl_Obj *cmdObj;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
@@ -1378,7 +1418,6 @@ TclOONewForwardMethod(
fmPtr = ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
- Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
Tcl_IncrRefCount(prefixObj);
return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
flags, &fwdMethodType, fmPtr);
@@ -1421,7 +1460,7 @@ InvokeForwardMethod(
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
((Interp *)interp)->lookupNsPtr
= (Namespace *) contextPtr->oPtr->namespacePtr;
- return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, NULL);
+ return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}
static int
@@ -1431,7 +1470,7 @@ FinalizeForwardCall(
int result)
{
Tcl_Obj **argObjs = data[0];
-
+
TclStackFree(interp, argObjs);
return result;
}
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 921aced..a9fa212 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -27,6 +27,8 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
*----------------------------------------------------------------------
*/
+#undef TclOOInitializeStubs
+
MODULE_SCOPE const char *
TclOOInitializeStubs(
Tcl_Interp *interp,
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 930e1fd..628c3a7 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -180,26 +180,26 @@ static Tcl_ThreadDataKey pendingObjDataKey;
if ((bignum).used > 0x7fff) { \
mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
*temp = bignum; \
- (objPtr)->internalRep.ptrAndLongRep.ptr = temp; \
- (objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
} else { \
if ((bignum).alloc > 0x7fff) { \
mp_shrink(&(bignum)); \
} \
- (objPtr)->internalRep.ptrAndLongRep.ptr = (void *) (bignum).dp; \
- (objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
| ((bignum).alloc << 15) | ((bignum).used)); \
}
#define UNPACK_BIGNUM(objPtr, bignum) \
- if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
- (bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
+ if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
+ (bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
} else { \
- (bignum).dp = (objPtr)->internalRep.ptrAndLongRep.ptr; \
- (bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
+ (bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
+ (bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
(bignum).alloc = \
- ((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
- (bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
+ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
+ (bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
}
/*
@@ -320,7 +320,7 @@ const Tcl_HashKeyType tclObjHashKeyType = {
* does allow them to delete a command when references to it are gone, which
* is fragile but useful given their somewhat-OO style. Because of this, this
* structure MUST NOT be const so that the C compiler puts the data in
- * writable memory. [Bug 2558422]
+ * writable memory. [Bug 2558422] [Bug 07d13d99b0a9]
* TODO: Provide a better API for those extensions so that they can coexist...
*/
@@ -1301,6 +1301,39 @@ TclFreeObj(
ObjInitDeletionContext(context);
+# ifdef TCL_THREADS
+ /*
+ * Check to make sure that the Tcl_Obj was allocated by the current
+ * thread. Don't do this check when shutting down since thread local
+ * storage can be finalized before the last Tcl_Obj is freed.
+ */
+
+ if (!TclInExit()) {
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry *hPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tablePtr = tsdPtr->objThreadMap;
+ if (!tablePtr) {
+ Tcl_Panic("TclFreeObj: object table not initialized");
+ }
+ hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+ if (hPtr) {
+ /*
+ * As the Tcl_Obj is going to be deleted we remove the entry.
+ */
+
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ ckfree(objData);
+ }
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
+# endif
+
/*
* Check for a double free of the same value. This is slightly tricky
* because it is customary to free a Tcl_Obj when its refcount falls
@@ -3148,8 +3181,8 @@ FreeBignum(
UNPACK_BIGNUM(objPtr, toFree);
mp_clear(&toFree);
- if ((long) objPtr->internalRep.ptrAndLongRep.value < 0) {
- ckfree(objPtr->internalRep.ptrAndLongRep.ptr);
+ if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr1);
}
objPtr->typePtr = NULL;
}
@@ -3360,8 +3393,8 @@ GetBignumFromObj(
mp_init_copy(bignumValue, &temp);
} else {
UNPACK_BIGNUM(objPtr, *bignumValue);
- objPtr->internalRep.ptrAndLongRep.ptr = NULL;
- objPtr->internalRep.ptrAndLongRep.value = 0;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
if (objPtr->bytes == NULL) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
@@ -3766,25 +3799,11 @@ Tcl_DbDecrRefCount(
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
"decr ref count");
}
-
- /*
- * If the Tcl_Obj is going to be deleted, remove the entry.
- */
-
- if ((objPtr->refCount - 1) <= 0) {
- ObjData *objData = Tcl_GetHashValue(hPtr);
-
- if (objData != NULL) {
- ckfree(objData);
- }
-
- Tcl_DeleteHashEntry(hPtr);
- }
}
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */
- if (--(objPtr)->refCount <= 0) {
+ if (objPtr->refCount-- <= 1) {
TclFreeObj(objPtr);
}
}
@@ -3952,11 +3971,10 @@ TclCompareObjKeys(
/*
* If the object pointers are the same then they match.
- */
+ * OPT: this comparison was moved to the caller
- if (objPtr1 == objPtr2) {
- return 1;
- }
+ if (objPtr1 == objPtr2) return 1;
+ */
/*
* Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
@@ -4158,7 +4176,8 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
+ /* See [] why we cannot call SetCmdNameFromAny() directly here. */
+ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
return NULL;
}
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -4269,8 +4288,7 @@ FreeCmdNameInternalRep(
* there are no more uses, free the ResolvedCmdName structure.
*/
- resPtr->refCount--;
- if (resPtr->refCount == 0) {
+ if (resPtr->refCount-- == 1) {
/*
* Now free the cached command, unless it is still in its hash
* table or if there are other references to it from other cmdName
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index b7f4173..827d89d 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -191,7 +191,7 @@ TrimUnreachable(
* ConvertZeroEffectToNOP --
*
* Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
- * replace PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an
+ * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
* operation that guarantees the check for arithmeticity) and eliminate
* LNOT when we can invert the following JUMP condition.
*
@@ -227,7 +227,7 @@ ConvertZeroEffectToNOP(
case INST_PUSH1:
if (nextInst == INST_POP) {
blank = size + InstLength(nextInst);
- } else if (nextInst == INST_CONCAT1
+ } else if (nextInst == INST_STR_CONCAT1
&& TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt1AtPtr(currentInstPtr + 1));
@@ -242,7 +242,7 @@ ConvertZeroEffectToNOP(
case INST_PUSH4:
if (nextInst == INST_POP) {
blank = size + 1;
- } else if (nextInst == INST_CONCAT1
+ } else if (nextInst == INST_STR_CONCAT1
&& TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt4AtPtr(currentInstPtr + 1));
@@ -344,21 +344,28 @@ AdvanceJumps(
CompileEnv *envPtr)
{
unsigned char *currentInstPtr;
+ Tcl_HashTable jumps;
for (currentInstPtr = envPtr->codeStart ;
currentInstPtr < envPtr->codeNext-1 ;
currentInstPtr += AddrLength(currentInstPtr)) {
- int offset, delta;
+ int offset, delta, isNew;
switch (*currentInstPtr) {
case INST_JUMP1:
case INST_JUMP_TRUE1:
case INST_JUMP_FALSE1:
offset = TclGetInt1AtPtr(currentInstPtr + 1);
+ Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
for (delta=0 ; offset+delta != 0 ;) {
if (offset + delta < -128 || offset + delta > 127) {
break;
}
+ Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+ if (!isNew) {
+ offset = TclGetInt1AtPtr(currentInstPtr + 1);
+ break;
+ }
offset += delta;
switch (*(currentInstPtr + offset)) {
case INST_NOP:
@@ -373,13 +380,21 @@ AdvanceJumps(
}
break;
}
+ Tcl_DeleteHashTable(&jumps);
TclStoreInt1AtPtr(offset, currentInstPtr + 1);
continue;
case INST_JUMP4:
case INST_JUMP_TRUE4:
case INST_JUMP_FALSE4:
+ Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+ Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew);
for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
+ Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+ if (!isNew) {
+ offset = TclGetInt4AtPtr(currentInstPtr + 1);
+ break;
+ }
switch (*(currentInstPtr + offset)) {
case INST_NOP:
offset += InstLength(INST_NOP);
@@ -393,6 +408,7 @@ AdvanceJumps(
}
break;
}
+ Tcl_DeleteHashTable(&jumps);
TclStoreInt4AtPtr(offset, currentInstPtr + 1);
continue;
}
@@ -411,7 +427,7 @@ AdvanceJumps(
void
TclOptimizeBytecode(
- CompileEnv *envPtr)
+ void *envPtr)
{
ConvertZeroEffectToNOP(envPtr);
AdvanceJumps(envPtr);
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 2a453b9..b032449 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -15,7 +15,7 @@
#include "tclInt.h"
#if defined(_WIN32) || defined(__CYGWIN__)
- MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
+ MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
#endif
/*
@@ -24,9 +24,9 @@
*/
#if defined(__CYGWIN__)
-static Tcl_PanicProc *panicProc = tclWinDebugPanic;
+static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
-static Tcl_PanicProc *panicProc = NULL;
+static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
/*
@@ -47,7 +47,7 @@ static Tcl_PanicProc *panicProc = NULL;
void
Tcl_SetPanicProc(
- Tcl_PanicProc *proc)
+ TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
/* tclWinDebugPanic only installs if there is no panicProc yet. */
@@ -141,7 +141,14 @@ Tcl_PanicVA(
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
+/* ARGSUSED */
+
+/*
+ * The following comment is here so that Coverity's static analizer knows that
+ * a Tcl_Panic() call can never return and avoids lots of false positives.
+ */
+
+/* coverity[+kill] */
void
Tcl_Panic(
const char *format,
diff --git a/generic/tclParse.c b/generic/tclParse.c
index c5cb1d1..95abc45 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -12,10 +12,10 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-
-#include <assert.h>
+
#include "tclInt.h"
#include "tclParse.h"
+#include <assert.h>
/*
* The following table provides parsing information about each possible 8-bit
@@ -511,7 +511,7 @@ Tcl_ParseCommand(
listStart = nextElem = tokenPtr[1].start;
while (nextElem < listEnd) {
int quoted;
-
+
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
tokenPtr->numComponents = 1;
@@ -621,6 +621,47 @@ TclIsSpaceProc(
/*
*----------------------------------------------------------------------
*
+ * TclIsBareword--
+ *
+ * Report whether byte is one that can be part of a "bareword".
+ * This concept is named in expression parsing, where it determines
+ * what can be a legal function name, but is the same definition used
+ * in determining what variable names can be parsed as variable
+ * substitutions without the benefit of enclosing braces. The set of
+ * ASCII chars that are accepted are the numeric chars ('0'-'9'),
+ * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_').
+ *
+ * Results:
+ * Returns 1, if byte is in the accepted set of chars, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsBareword(
+ char byte)
+{
+ if (byte < '0' || byte > 'z') {
+ return 0;
+ }
+ if (byte <= '9' || byte >= 'a') {
+ return 1;
+ }
+ if (byte == '_') {
+ return 1;
+ }
+ if (byte < 'A' || byte > 'Z') {
+ return 0;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseWhiteSpace --
*
* Scans up to numBytes bytes starting at src, consuming white space
@@ -1346,9 +1387,7 @@ Tcl_ParseVarName(
{
Tcl_Token *tokenPtr;
register const char *src;
- unsigned char c;
- int varIndex, offset;
- Tcl_UniChar ch;
+ int varIndex;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
@@ -1431,22 +1470,12 @@ Tcl_ParseVarName(
tokenPtr->numComponents = 0;
while (numBytes) {
- if (Tcl_UtfCharComplete(src, numBytes)) {
- offset = Tcl_UtfToUniChar(src, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
-
- memcpy(utfBytes, src, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- offset = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- c = UCHAR(ch);
- if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
- numBytes -= offset;
+ if (TclIsBareword(*src)) {
+ src += 1;
+ numBytes -= 1;
continue;
}
- if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) {
src += 2;
numBytes -= 2;
while (numBytes && (*src == ':')) {
@@ -1886,7 +1915,7 @@ Tcl_ParseQuotedString(
* flags argument to provide support for the -nobackslashes, -nocommands,
* and -novariables options, as represented by the flag values
* TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
- *
+ *
* Results:
* None.
*
@@ -2497,56 +2526,6 @@ TclObjCommandComplete(
}
/*
- *----------------------------------------------------------------------
- *
- * TclIsLocalScalar --
- *
- * Check to see if a given string is a legal scalar variable name with no
- * namespace qualifiers or substitutions.
- *
- * Results:
- * Returns 1 if the variable is a local scalar.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclIsLocalScalar(
- const char *src,
- int len)
-{
- const char *p;
- const char *lastChar = src + (len - 1);
-
- for (p=src ; p<=lastChar ; p++) {
- if ((CHAR_TYPE(*p) != TYPE_NORMAL)
- && (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
- /*
- * TCL_COMMAND_END is returned for the last character of the
- * string. By this point we know it isn't an array or namespace
- * reference.
- */
-
- return 0;
- }
- if (*p == '(') {
- if (*lastChar == ')') { /* We have an array element */
- return 0;
- }
- } else if (*p == ':') {
- if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
- return 0;
- }
- }
- }
-
- return 1;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index b7f3dcf..99d576d 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -512,7 +512,7 @@ TclFSGetPathType(
if (PATHFLAGS(pathPtr) == 0) {
/* The path is not absolute... */
-#ifdef __WIN32__
+#ifdef _WIN32
/* ... on Windows we must make another call to determine whether
* it's relative or volumerelative [Bug 2571597]. */
return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
/*
* We have a refCount on the cwd.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
/*
* Only Windows has volume-relative paths.
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
pureNormalized = 0;
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
}
}
@@ -2437,19 +2437,13 @@ SetFsPathFromAny(
}
TclDecrRefCount(parts);
} else {
- /*
- * Simple case. "rest" is relative path. Just join it. The
- * "rest" object will be freed when Tcl_FSJoinToPath returns
- * (unless something else claims a refCount on it).
- */
-
- Tcl_Obj *joined;
- Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1);
+ Tcl_Obj *pair[2];
- Tcl_IncrRefCount(transPtr);
- joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
- TclDecrRefCount(transPtr);
- transPtr = joined;
+ pair[0] = transPtr;
+ pair[1] = Tcl_NewStringObj(name+split+1, -1);
+ transPtr = TclJoinPath(2, pair);
+ Tcl_DecrRefCount(pair[0]);
+ Tcl_DecrRefCount(pair[1]);
}
}
} else {
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index df90cea..f6e8b20 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -383,7 +383,7 @@ PkgRequireCore(
if (pkgPtr->clientData != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"circular package dependency:"
- " attempt to provide %s %s requires %s",
+ " attempt to provide %s %s requires %s",
name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index e9b92fe..abc8ee8 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -42,11 +42,15 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
@@ -71,7 +75,7 @@ typedef struct TclPlatStubs {
int magic;
void *hooks;
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
@@ -81,10 +85,8 @@ typedef struct TclPlatStubs {
#endif /* MACOSX */
} TclPlatStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclPlatStubs *tclPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -95,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
* Inline function declarations:
*/
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 0bd8f93..cca13e8 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -459,8 +459,7 @@ TclHandleRelease(
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
- handlePtr->refCount--;
- if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
+ if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
ckfree(handlePtr);
}
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1314719..172b860 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -15,7 +15,6 @@
#include "tclInt.h"
#include "tclCompile.h"
-#include "tclOOInt.h"
/*
* Variables that are part of the [apply] command implementation and which
@@ -41,9 +40,6 @@ static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
-static int PushProcCallFrame(ClientData clientData,
- register Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[], int isLambda);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static int ProcWrongNumArgs(Tcl_Interp *interp, int skip);
@@ -73,9 +69,8 @@ const Tcl_ObjType tclProcBodyType = {
};
/*
- * The [upvar]/[uplevel] level reference type. Uses the ptrAndLongRep field,
- * encoding the type of level reference in ptr and the actual parsed out
- * offset in value.
+ * The [upvar]/[uplevel] level reference type. Uses the longValue field
+ * to remember the integer value of a parsed #<integer> format.
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
@@ -92,10 +87,10 @@ static const Tcl_ObjType levelReferenceType = {
*
* Internally, ptr1 is a pointer to a Proc instance that is not bound to a
* command name, and ptr2 is a pointer to the namespace that the Proc instance
- * will execute within.
+ * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
*/
-static const Tcl_ObjType lambdaType = {
+const Tcl_ObjType tclLambdaType = {
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
@@ -221,7 +216,7 @@ Tcl_ProcObjCmd(
*
* This code is nearly identical to the #280 code in SetLambdaFromAny, see
* this file. The differences are the different index of the body in the
- * line array of the context, and the lamdba code requires some special
+ * line array of the context, and the lambda code requires some special
* processing. Find a way to factor the common elements into a single
* function.
*/
@@ -789,7 +784,7 @@ TclGetFrame(
* Results:
* The return value is -1 if an error occurred in finding the frame (in
* this case an error message is left in the interp's result). 1 is
- * returned if objPtr was either a number or a number preceded by "#" and
+ * returned if objPtr was either an int or an int preceded by "#" and
* it specified a valid frame. 0 is returned if objPtr isn't one of the
* two things above (in this case, the lookup acts as if objPtr were
* "1"). The variable pointed to by framePtrPtr is filled in with the
@@ -811,99 +806,69 @@ TclObjGetFrame(
{
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
- CallFrame *framePtr;
- const char *name;
+ const char *name = NULL;
/*
* Parse object to figure out which level number to go to.
*/
- result = 1;
+ result = 0;
curLevel = iPtr->varFramePtr->level;
- if (objPtr == NULL) {
- name = "1";
- goto haveLevel1;
- }
-
- name = TclGetString(objPtr);
- if (objPtr->typePtr == &levelReferenceType) {
- if (objPtr->internalRep.ptrAndLongRep.ptr != NULL) {
- level = curLevel - objPtr->internalRep.ptrAndLongRep.value;
- } else {
- level = objPtr->internalRep.ptrAndLongRep.value;
- }
- if (level < 0) {
- goto levelError;
- }
- /* TODO: Consider skipping the typePtr checks */
- } else if (objPtr->typePtr == &tclIntType
-#ifndef TCL_WIDE_INT_IS_LONG
- || objPtr->typePtr == &tclWideIntType
-#endif
- ) {
- if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
- goto levelError;
- }
- level = curLevel - level;
- } else if (*name == '#') {
- if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
- goto levelError;
- }
-
- /*
- * Cache for future reference.
- *
- * TODO: Use the new ptrAndLongRep intrep
- */
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.ptrAndLongRep.ptr = NULL;
- objPtr->internalRep.ptrAndLongRep.value = level;
- } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
- if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
- return -1;
- }
-
- /*
- * Cache for future reference.
- *
- * TODO: Use the new ptrAndLongRep intrep
- */
+ /*
+ * Check for integer first, since that has potential to spare us
+ * a generation of a stringrep.
+ */
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.ptrAndLongRep.ptr = (void *) 1; /* non-NULL */
- objPtr->internalRep.ptrAndLongRep.value = level;
+ if (objPtr == NULL) {
+ /* Do nothing */
+ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
+ && (level >= 0)) {
level = curLevel - level;
+ result = 1;
+ } else if (objPtr->typePtr == &levelReferenceType) {
+ level = (int) objPtr->internalRep.longValue;
+ result = 1;
} else {
- /*
- * Don't cache as the object *isn't* a level reference (might even be
- * NULL...)
- */
+ name = TclGetString(objPtr);
+ if (name[0] == '#') {
+ if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = &levelReferenceType;
+ objPtr->internalRep.longValue = level;
+ result = 1;
+ } else {
+ result = -1;
+ }
+ } else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+ /*
+ * If this were an integer, we'd have succeeded already.
+ * Docs say we have to treat this as a 'bad level' error.
+ */
+ result = -1;
+ }
+ }
- haveLevel1:
+ if (result == 0) {
level = curLevel - 1;
- result = 0;
+ name = "1";
}
-
- /*
- * Figure out which frame to use, and return it to the caller.
- */
-
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
+ if (result != -1) {
+ if (level >= 0) {
+ CallFrame *framePtr;
+ for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ framePtr = framePtr->callerVarPtr) {
+ if (framePtr->level == level) {
+ *framePtrPtr = framePtr;
+ return result;
+ }
+ }
+ }
+ if (name == NULL) {
+ name = TclGetString(objPtr);
}
}
- if (framePtr == NULL) {
- goto levelError;
- }
- *framePtrPtr = framePtr;
- return result;
- levelError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
@@ -1571,7 +1536,7 @@ InitArgsAndLocals(
/*
*----------------------------------------------------------------------
*
- * PushProcCallFrame --
+ * TclPushProcCallFrame --
*
* Compiles a proc body if necessary, then pushes a CallFrame suitable
* for executing it.
@@ -1586,8 +1551,8 @@ InitArgsAndLocals(
*----------------------------------------------------------------------
*/
-static int
-PushProcCallFrame(
+int
+TclPushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
register Tcl_Interp *interp,/* Interpreter in which procedure was
@@ -1650,12 +1615,9 @@ PushProcCallFrame(
*/
framePtrPtr = &framePtr;
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
(Tcl_Namespace *) nsPtr,
(isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC));
- if (result != TCL_OK) {
- return result;
- }
framePtr->objc = objc;
framePtr->objv = objv;
@@ -1708,7 +1670,7 @@ TclNRInterpProc(
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
- int result = PushProcCallFrame(clientData, interp, objc, objv,
+ int result = TclPushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
if (result != TCL_OK) {
@@ -1850,14 +1812,44 @@ InterpProcNR2(
TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
}
- if (--procPtr->refCount <= 0) {
+ if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
/*
- * Process the result code.
+ * Free the stack-allocated compiled locals and CallFrame. It is important
+ * to pop the call frame without freeing it first: the compiledLocals
+ * cannot be freed before the frame is popped, as the local variables must
+ * be deleted. But the compiledLocals must be freed first, as they were
+ * allocated later on the stack.
*/
+ if (result != TCL_OK) {
+ goto process;
+ }
+
+ done:
+ if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+ TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+ TclGetString(r), r);
+ }
+
+ freePtr = iPtr->framePtr;
+ Tcl_PopCallFrame(interp); /* Pop but do not free. */
+ TclStackFree(interp, freePtr->compiledLocals);
+ /* Free compiledLocals. */
+ TclStackFree(interp, freePtr); /* Free CallFrame. */
+ return result;
+
+ /*
+ * Process any non-TCL_OK result code.
+ */
+
+ process:
switch (result) {
case TCL_RETURN:
/*
@@ -1892,46 +1884,8 @@ InterpProcNR2(
*/
errorProc(interp, procNameObj);
-
- default:
- /*
- * Process other results (OK and non-standard) by doing nothing
- * special, skipping directly to the code afterwards that cleans up
- * associated memory.
- *
- * Non-standard results are processed by passing them through quickly.
- * This means they all work as exceptions, unwinding the stack quickly
- * and neatly. Who knows how well they are handled by third-party code
- * though...
- */
-
- (void) 0; /* do nothing */
}
-
- if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
- Tcl_Obj *r = Tcl_GetObjResult(interp);
-
- TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
- TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
- TclGetString(r), r);
- }
-
- /*
- * Free the stack-allocated compiled locals and CallFrame. It is important
- * to pop the call frame without freeing it first: the compiledLocals
- * cannot be freed before the frame is popped, as the local variables must
- * be deleted. But the compiledLocals must be freed first, as they were
- * allocated later on the stack.
- */
-
- freePtr = iPtr->framePtr;
- Tcl_PopCallFrame(interp); /* Pop but do not free. */
- TclStackFree(interp, freePtr->compiledLocals);
- /* Free compiledLocals. */
- TclStackFree(interp, freePtr); /* Free CallFrame. */
-
- return result;
+ goto done;
}
/*
@@ -2071,7 +2025,7 @@ TclProcCompileProc(
procPtr->numCompiledLocals = procPtr->numArgs;
}
- TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
+ (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
/* isProcCallFrame */ 0);
/*
@@ -2163,8 +2117,7 @@ TclProcDeleteProc(
{
Proc *procPtr = clientData;
- procPtr->refCount--;
- if (procPtr->refCount <= 0) {
+ if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
}
@@ -2419,7 +2372,7 @@ ProcBodyFree(
{
Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (procPtr->refCount-- < 2) {
+ if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
}
@@ -2451,7 +2404,7 @@ DupLambdaInternalRep(
procPtr->refCount++;
Tcl_IncrRefCount(nsObjPtr);
- copyPtr->typePtr = &lambdaType;
+ copyPtr->typePtr = &tclLambdaType;
}
static void
@@ -2462,8 +2415,7 @@ FreeLambdaInternalRep(
Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
- procPtr->refCount--;
- if (procPtr->refCount == 0) {
+ if (procPtr->refCount-- == 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
@@ -2488,7 +2440,7 @@ SetLambdaFromAny(
/*
* Convert objPtr to list type first; if it cannot be converted, or if its
- * length is not 2, then it cannot be converted to lambdaType.
+ * length is not 2, then it cannot be converted to tclLambdaType.
*/
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2634,14 +2586,14 @@ SetLambdaFromAny(
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
- * conversion to lambdaType.
+ * conversion to tclLambdaType.
*/
TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
- objPtr->typePtr = &lambdaType;
+ objPtr->typePtr = &tclLambdaType;
return TCL_OK;
}
@@ -2692,12 +2644,12 @@ TclNRApplyObjCmd(
}
/*
- * Set lambdaPtr, convert it to lambdaType in the current interp if
+ * Set lambdaPtr, convert it to tclLambdaType in the current interp if
* necessary.
*/
lambdaPtr = objv[1];
- if (lambdaPtr->typePtr == &lambdaType) {
+ if (lambdaPtr->typePtr == &tclLambdaType) {
procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
}
@@ -2775,7 +2727,7 @@ TclNRApplyObjCmd(
}
extraPtr->isRootEnsemble = isRootEnsemble;
- result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
+ result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
if (result == TCL_OK) {
TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
@@ -2835,234 +2787,6 @@ MakeLambdaError(
}
/*
- *----------------------------------------------------------------------
- *
- * Tcl_DisassembleObjCmd --
- *
- * Implementation of the "::tcl::unsupported::disassemble" command. This
- * command is not documented, but will disassemble procedures, lambda
- * terms and general scripts. Note that will compile terms if necessary
- * in order to disassemble them.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_DisassembleObjCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- static const char *const types[] = {
- "lambda", "method", "objmethod", "proc", "script", NULL
- };
- enum Types {
- DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
- DISAS_SCRIPT
- };
- int idx, result;
- Tcl_Obj *codeObjPtr = NULL;
- Proc *procPtr = NULL;
- Tcl_HashEntry *hPtr;
- Object *oPtr;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "type ...");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
- return TCL_ERROR;
- }
-
- switch ((enum Types) idx) {
- case DISAS_LAMBDA: {
- Command cmd;
- Tcl_Obj *nsObjPtr;
- Tcl_Namespace *nsPtr;
-
- /*
- * Compile (if uncompiled) and disassemble a lambda term.
- */
-
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
- return TCL_ERROR;
- }
- if (objv[2]->typePtr == &lambdaType) {
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
- }
- if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
- result = SetLambdaFromAny(interp, objv[2]);
- if (result != TCL_OK) {
- return result;
- }
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
- }
-
- memset(&cmd, 0, sizeof(Command));
- nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
- result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
- if (result != TCL_OK) {
- return result;
- }
- cmd.nsPtr = (Namespace *) nsPtr;
- procPtr->cmdPtr = &cmd;
- result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
- if (result != TCL_OK) {
- return result;
- }
- TclPopStackFrame(interp);
- codeObjPtr = procPtr->bodyPtr;
- break;
- }
- case DISAS_PROC:
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "procName");
- return TCL_ERROR;
- }
-
- procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
- if (procPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "\"%s\" isn't a procedure", TclGetString(objv[2])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
- TclGetString(objv[2]), NULL);
- return TCL_ERROR;
- }
-
- /*
- * Compile (if uncompiled) and disassemble a procedure.
- */
-
- result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
- if (result != TCL_OK) {
- return result;
- }
- TclPopStackFrame(interp);
- codeObjPtr = procPtr->bodyPtr;
- break;
- case DISAS_SCRIPT:
- /*
- * Compile and disassemble a script.
- */
-
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "script");
- return TCL_ERROR;
- }
- if ((objv[2]->typePtr != &tclByteCodeType)
- && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
- return TCL_ERROR;
- }
- codeObjPtr = objv[2];
- break;
-
- case DISAS_CLASS_METHOD:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
- return TCL_ERROR;
- }
-
- /*
- * Look up the body of a class method.
- */
-
- oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
- if (oPtr == NULL) {
- return TCL_ERROR;
- }
- if (oPtr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "\"%s\" is not a class", TclGetString(objv[2])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
- (char *) objv[3]);
- goto methodBody;
- case DISAS_OBJECT_METHOD:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
- return TCL_ERROR;
- }
-
- /*
- * Look up the body of an instance method.
- */
-
- oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
- if (oPtr == NULL) {
- return TCL_ERROR;
- }
- if (oPtr->methodsPtr == NULL) {
- goto unknownMethod;
- }
- hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
-
- /*
- * Compile (if necessary) and disassemble a method body.
- */
-
- methodBody:
- if (hPtr == NULL) {
- unknownMethod:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown method \"%s\"", TclGetString(objv[3])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[3]), NULL);
- return TCL_ERROR;
- }
- procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
- if (procPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "body not available for this kind of method", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
- return TCL_ERROR;
- }
- if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
- Command cmd;
-
- /*
- * Yes, this is ugly, but we need to pass the namespace in to the
- * compiler in two places.
- */
-
- cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
- procPtr->cmdPtr = &cmd;
- result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
- (Namespace *) oPtr->namespacePtr, "body of method",
- TclGetString(objv[3]));
- procPtr->cmdPtr = NULL;
- if (result != TCL_OK) {
- return result;
- }
- }
- codeObjPtr = procPtr->bodyPtr;
- break;
- default:
- CLANG_ASSERT(0);
- }
-
- /*
- * Do the actual disassembly.
- */
-
- if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags
- & TCL_BYTECODE_PRECOMPILED) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "may not disassemble prebuilt bytecode", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "BYTECODE", NULL);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
- return TCL_OK;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 6348e4a..ea25d4b 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -755,7 +755,7 @@ FreeRegexpInternalRep(
* If this is the last reference to the regexp, free it.
*/
- if (--(regexpRepPtr->refCount) <= 0) {
+ if (regexpRepPtr->refCount-- <= 1) {
FreeRegexp(regexpRepPtr);
}
objPtr->typePtr = NULL;
@@ -946,7 +946,8 @@ CompileRegexp(
* Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
*/
- if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
+ if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
+ NULL) == TCL_OK) {
regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
Tcl_IncrRefCount(regexpPtr->globObjPtr);
} else {
@@ -975,7 +976,7 @@ CompileRegexp(
if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
- if (--(oldRegexpPtr->refCount) <= 0) {
+ if (oldRegexpPtr->refCount-- <= 1) {
FreeRegexp(oldRegexpPtr);
}
ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
@@ -1049,7 +1050,7 @@ FinalizeRegexp(
for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
regexpPtr = tsdPtr->regexps[i];
- if (--(regexpPtr->refCount) <= 0) {
+ if (regexpPtr->refCount-- <= 1) {
FreeRegexp(regexpPtr);
}
ckfree(tsdPtr->patterns[i]);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 2f2563a..9d0714c 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1293,7 +1293,7 @@ TclProcessReturn(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -1626,7 +1626,7 @@ TclNoErrorStack(
Tcl_Obj *options)
{
Tcl_Obj **keys = GetKeys();
-
+
Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
return options;
}
diff --git a/generic/tclScan.c b/generic/tclScan.c
index ef7eedf..3edb8be 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -406,11 +406,14 @@ ValidateFormat(
*/
case 'd':
case 'e':
+ case 'E':
case 'f':
case 'g':
+ case 'G':
case 'i':
case 'o':
case 'x':
+ case 'X':
case 'b':
break;
case 'u':
@@ -592,7 +595,7 @@ Tcl_ScanObjCmd(
return TCL_ERROR;
}
- format = Tcl_GetStringFromObj(objv[2], NULL);
+ format = Tcl_GetString(objv[2]);
numVars = objc-3;
/*
@@ -614,7 +617,7 @@ Tcl_ScanObjCmd(
}
}
- string = Tcl_GetStringFromObj(objv[1], NULL);
+ string = Tcl_GetString(objv[1]);
baseString = string;
/*
@@ -743,6 +746,7 @@ Tcl_ScanObjCmd(
parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
break;
case 'x':
+ case 'X':
op = 'i';
parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
break;
@@ -758,7 +762,9 @@ Tcl_ScanObjCmd(
case 'f':
case 'e':
+ case 'E':
case 'g':
+ case 'G':
op = 'f';
break;
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 883e2ea..f69f6b9 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1548,7 +1548,7 @@ MakeLowPrecisionDouble(
* Test for the easy cases.
*/
- if (numSigDigs <= DBL_DIG) {
+ if (numSigDigs <= QUICK_MAX) {
if (exponent >= 0) {
if (exponent <= mmaxpow) {
/*
@@ -1561,7 +1561,7 @@ MakeLowPrecisionDouble(
((Tcl_WideInt)significand * pow10vals[exponent]);
goto returnValue;
} else {
- int diff = DBL_DIG - numSigDigs;
+ int diff = QUICK_MAX - numSigDigs;
if (exponent-diff <= mmaxpow) {
/*
@@ -1798,6 +1798,12 @@ RefineApproximation(
double quot; /* Correction term. */
double minincr; /* Lower bound on the absolute value of the
* correction term. */
+ int roundToEven = 0; /* Flag == TRUE if we need to invoke
+ * "round to even" functionality */
+ double rteSignificand; /* Significand of the round-to-even result */
+ int rteExponent; /* Exponent of the round-to-even result */
+ Tcl_WideInt rteSigWide; /* Wide integer version of the significand
+ * for testing evenness */
int i;
/*
@@ -1893,15 +1899,33 @@ RefineApproximation(
mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
}
- /*
- * If the result is less than unity, the error is less than 1/2 unit in
- * the last place, so there's no correction to make.
- */
-
- if (mp_cmp_mag(&twoMd, &twoMv) == MP_LT) {
+ switch (mp_cmp_mag(&twoMd, &twoMv)) {
+ case MP_LT:
+ /*
+ * If the result is less than unity, the error is less than 1/2 unit in
+ * the last place, so there's no correction to make.
+ */
mp_clear(&twoMd);
mp_clear(&twoMv);
return approxResult;
+ case MP_EQ:
+ /*
+ * If the result is exactly unity, we need to round to even.
+ */
+ roundToEven = 1;
+ break;
+ case MP_GT:
+ break;
+ }
+
+ if (roundToEven) {
+ rteSignificand = frexp(approxResult, &rteExponent);
+ rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
+ if ((rteSigWide & 1) == 0) {
+ mp_clear(&twoMd);
+ mp_clear(&twoMv);
+ return approxResult;
+ }
}
/*
@@ -4025,7 +4049,7 @@ StrictBignumConversion(
* choosing the one that is closest to the given number (and
* resolving ties with 'round to even'). It is allowed to return
* fewer than 'ndigits' if the number converts exactly; if the
- * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it
+ * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it
* also returns fewer digits if the shorter string will still
* reconvert without loss to the given input number. In any case,
* strings of trailing zeroes are suppressed.
@@ -4559,7 +4583,7 @@ TclBignumToDouble(
/*
- * We need a 'mantBits'-bit significand. Determine what shift will
+ * We need a 'mantBits'-bit significand. Determine what shift will
* give us that.
*/
@@ -4574,7 +4598,7 @@ TclBignumToDouble(
}
shift = mantBits - bits;
- /*
+ /*
* If shift > 0, shift the significand left by the requisite number of
* bits. If shift == 0, the significand is already exactly 'mantBits'
* in length. If shift < 0, we will need to shift the significand right
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index e495c2e..11a57e9 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -36,6 +36,7 @@
#include "tclInt.h"
#include "tommath.h"
+#include "tclStringRep.h"
/*
* Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
@@ -89,60 +90,6 @@ const Tcl_ObjType tclStringType = {
UpdateStringOfString, /* updateStringProc */
SetStringFromAny /* setFromAnyProc */
};
-
-/*
- * The following structure is the internal rep for a String object. It keeps
- * track of how much memory has been used and how much has been allocated for
- * the Unicode and UTF string to enable growing and shrinking of the UTF and
- * Unicode reps of the String object with fewer mallocs. To optimize string
- * length and indexing operations, this structure also stores the number of
- * characters (same of UTF and Unicode!) once that value has been computed.
- *
- * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
- * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
- * can be officially modified by altering the definition of Tcl_UniChar in
- * tcl.h, but do not do that unless you are sure what you're doing!
- */
-
-typedef struct String {
- int numChars; /* The number of chars in the string. -1 means
- * this value has not been calculated. >= 0
- * means that there is a valid Unicode rep, or
- * that the number of UTF bytes == the number
- * of chars. */
- int allocated; /* The amount of space actually allocated for
- * the UTF string (minus 1 byte for the
- * termination char). */
- int maxChars; /* Max number of chars that can fit in the
- * space allocated for the unicode array. */
- int hasUnicode; /* Boolean determining whether the string has
- * a Unicode representation. */
- Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
- * of this field depends on the 'maxChars'
- * field above. */
-} String;
-
-#define STRING_MAXCHARS \
- (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
-#define STRING_SIZE(numChars) \
- (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
-#define stringCheckLimits(numChars) \
- if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
- Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
- STRING_MAXCHARS); \
- }
-#define stringAttemptAlloc(numChars) \
- (String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
-#define stringAlloc(numChars) \
- (String *) ckalloc((unsigned) STRING_SIZE(numChars) )
-#define stringRealloc(ptr, numChars) \
- (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
-#define stringAttemptRealloc(ptr, numChars) \
- (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
-#define GET_STRING(objPtr) \
- ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_STRING(objPtr, stringPtr) \
- ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
/*
* TCL STRING GROWTH ALGORITHM
@@ -188,7 +135,7 @@ GrowStringBuffer(
int flag)
{
/*
- * Pre-conditions:
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
@@ -238,7 +185,7 @@ GrowUnicodeBuffer(
int needed)
{
/*
- * Pre-conditions:
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
@@ -1123,7 +1070,8 @@ Tcl_AppendLimitedToObj(
if (ellipsis == NULL) {
ellipsis = "...";
}
- toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
+ toCopy = (bytes == NULL) ? limit
+ : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
}
/*
@@ -1281,23 +1229,43 @@ Tcl_AppendObjToObj(
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
&& TclIsPureByteArray(appendObjPtr)) {
- unsigned char *bytesSrc;
- int lengthSrc, lengthTotal;
/*
- * We do not assume that objPtr and appendObjPtr must be distinct!
- * This makes this code a bit more complex than it otherwise would be,
- * but in turn makes it much safer.
+ * You might expect the code here to be
+ *
+ * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
+ * TclAppendBytesToByteArray(objPtr, bytes, length);
+ *
+ * and essentially all of the time that would be fine. However,
+ * it would run into trouble in the case where objPtr and
+ * appendObjPtr point to the same thing. That may never be a
+ * good idea. It seems to violate Copy On Write, and we don't
+ * have any tests for the situation, since making any Tcl commands
+ * that call Tcl_AppendObjToObj() do that appears impossible
+ * (They honor Copy On Write!). For the sake of extensions that
+ * go off into that realm, though, here's a more complex approach
+ * that can handle all the cases.
*/
+ /* Get lengths */
+ int lengthSrc;
+
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
- lengthTotal = length + lengthSrc;
- if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
- }
- bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
- TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
+
+ /* Grow buffer enough for the append */
+ TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
+
+ /* Reset objPtr back to the original value */
+ Tcl_SetByteArrayLength(objPtr, length);
+
+ /*
+ * Now do the append knowing that buffer growth cannot cause
+ * any trouble.
+ */
+
+ TclAppendBytesToByteArray(objPtr,
+ Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
return;
}
@@ -1313,7 +1281,7 @@ Tcl_AppendObjToObj(
* appendObjPtr and append it.
*/
- if (stringPtr->hasUnicode
+ if (stringPtr->hasUnicode
#if COMPAT
&& stringPtr->numChars > 0
#endif
@@ -1415,7 +1383,7 @@ AppendUnicodeToUnicodeRep(
* the reallocs below.
*/
- if (unicode >= stringPtr->unicode
+ if (unicode && unicode >= stringPtr->unicode
&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
offset = unicode - stringPtr->unicode;
}
@@ -1437,8 +1405,10 @@ AppendUnicodeToUnicodeRep(
* trailing null.
*/
- memmove(stringPtr->unicode + stringPtr->numChars, unicode,
- appendNumChars * sizeof(Tcl_UniChar));
+ if (unicode) {
+ memmove(stringPtr->unicode + stringPtr->numChars, unicode,
+ appendNumChars * sizeof(Tcl_UniChar));
+ }
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
stringPtr->allocated = 0;
@@ -1577,7 +1547,7 @@ AppendUtfToUtfRep(
* the reallocs below.
*/
- if (bytes >= objPtr->bytes
+ if (bytes && bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
@@ -1605,7 +1575,9 @@ AppendUtfToUtfRep(
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
- memmove(objPtr->bytes + oldLength, bytes, numBytes);
+ if (bytes) {
+ memmove(objPtr->bytes + oldLength, bytes, numBytes);
+ }
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
@@ -2289,7 +2261,7 @@ Tcl_AppendFormatToObj(
p += sprintf(p, "%d", width);
if (width > length) {
length = width;
- }
+ }
}
if (gotPrecision) {
*p++ = '.';
@@ -2638,6 +2610,38 @@ Tcl_ObjPrintf(
/*
*---------------------------------------------------------------------------
*
+ * TclGetStringStorage --
+ *
+ * Returns the string storage space of a Tcl_Obj.
+ *
+ * Results:
+ * The pointer value objPtr->bytes is returned and the number of bytes
+ * allocated there is written to *sizePtr (if known).
+ *
+ * Side effects:
+ * May set objPtr->bytes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclGetStringStorage(
+ Tcl_Obj *objPtr,
+ unsigned int *sizePtr)
+{
+ String *stringPtr;
+
+ if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) {
+ return TclGetStringFromObj(objPtr, (int *)sizePtr);
+ }
+
+ stringPtr = GET_STRING(objPtr);
+ *sizePtr = stringPtr->allocated;
+ return objPtr->bytes;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
* TclStringObjReverse --
*
* Implements the [string reverse] operation.
@@ -2821,14 +2825,18 @@ ExtendUnicodeRepWithString(
}
needed = numOrigChars + numAppendChars;
stringCheckLimits(needed);
-
+
if (needed > stringPtr->maxChars) {
GrowUnicodeBuffer(objPtr, needed);
stringPtr = GET_STRING(objPtr);
}
stringPtr->hasUnicode = 1;
- stringPtr->numChars = needed;
+ if (bytes) {
+ stringPtr->numChars = needed;
+ } else {
+ numAppendChars = 0;
+ }
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
bytes += TclUtfToUniChar(bytes, dst);
}
@@ -3035,7 +3043,7 @@ ExtendStringRepWithUnicode(
* Pre-condition: this is the "string" Tcl_ObjType.
*/
- int i, origLength, size = 0;
+ int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
String *stringPtr = GET_STRING(objPtr);
@@ -3051,12 +3059,12 @@ ExtendStringRepWithUnicode(
objPtr->length = 0;
}
size = origLength = objPtr->length;
-
+
/*
* Quick cheap check in case we have more than enough room.
*/
- if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
+ if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
}
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
new file mode 100644
index 0000000..227e6bc
--- /dev/null
+++ b/generic/tclStringRep.h
@@ -0,0 +1,97 @@
+/*
+ * tclStringRep.h --
+ *
+ * This file contains the definition of the Unicode string internal
+ * representation and macros to access it.
+ *
+ * A Unicode string is an internationalized string. Conceptually, a
+ * Unicode string is an array of 16-bit quantities organized as a
+ * sequence of properly formed UTF-8 characters. There is a one-to-one
+ * map between Unicode and UTF characters. Because Unicode characters
+ * have a fixed width, operations such as indexing operate on Unicode
+ * data. The String object is optimized for the case where each UTF char
+ * in a string is only one byte. In this case, we store the value of
+ * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
+ * is explicitly called).
+ *
+ * The String object type stores one or both formats. The default
+ * behavior is to store UTF. Once Unicode is calculated by a function, it
+ * is stored in the internal rep for future access (without an additional
+ * O(n) cost).
+ *
+ * To allow many appends to be done to an object without constantly
+ * reallocating the space for the string or Unicode representation, we
+ * allocate double the space for the string or Unicode and use the
+ * internal representation to keep track of how much space is used vs.
+ * allocated.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * The following structure is the internal rep for a String object. It keeps
+ * track of how much memory has been used and how much has been allocated for
+ * the Unicode and UTF string to enable growing and shrinking of the UTF and
+ * Unicode reps of the String object with fewer mallocs. To optimize string
+ * length and indexing operations, this structure also stores the number of
+ * characters (same of UTF and Unicode!) once that value has been computed.
+ *
+ * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
+ * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
+ * can be officially modified by altering the definition of Tcl_UniChar in
+ * tcl.h, but do not do that unless you are sure what you're doing!
+ */
+
+typedef struct String {
+ int numChars; /* The number of chars in the string. -1 means
+ * this value has not been calculated. >= 0
+ * means that there is a valid Unicode rep, or
+ * that the number of UTF bytes == the number
+ * of chars. */
+ int allocated; /* The amount of space actually allocated for
+ * the UTF string (minus 1 byte for the
+ * termination char). */
+ int maxChars; /* Max number of chars that can fit in the
+ * space allocated for the unicode array. */
+ int hasUnicode; /* Boolean determining whether the string has
+ * a Unicode representation. */
+ Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
+ * of this field depends on the 'maxChars'
+ * field above. */
+} String;
+
+#define STRING_MAXCHARS \
+ (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
+#define STRING_SIZE(numChars) \
+ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+#define stringCheckLimits(numChars) \
+ do { \
+ if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
+ Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
+ STRING_MAXCHARS); \
+ } \
+ } while (0)
+#define stringAttemptAlloc(numChars) \
+ (String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
+#define stringAlloc(numChars) \
+ (String *) ckalloc((unsigned) STRING_SIZE(numChars))
+#define stringRealloc(ptr, numChars) \
+ (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+#define stringAttemptRealloc(ptr, numChars) \
+ (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+#define GET_STRING(objPtr) \
+ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_STRING(objPtr, stringPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
new file mode 100644
index 0000000..030e4ec
--- /dev/null
+++ b/generic/tclStringTrim.h
@@ -0,0 +1,43 @@
+/*
+ * tclStringTrim.h --
+ *
+ * This file contains the definition of what characters are to be trimmed
+ * from a string by [string trim] by default. It's only needed by Tcl's
+ * implementation; it does not form a public or private API at all.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2003-2013 Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TCL_STRING_TRIM_H
+#define TCL_STRING_TRIM_H
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters. [TIP #413]
+ */
+
+MODULE_SCOPE const char tclDefaultTrimSet[];
+
+/*
+ * The whitespace trimming set used when [concat]enating. This is a subset of
+ * the above, and deliberately so.
+ */
+
+#define CONCAT_TRIM_SET " \f\v\r\t\n"
+
+#endif /* TCL_STRING_TRIM_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 782bbdf..5b7a1cd 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -44,6 +44,9 @@
#define TclBackgroundException Tcl_BackgroundException
#undef Tcl_SetIntObj
#undef TclpInetNtoa
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
@@ -79,7 +82,7 @@ static const char *TclGetStartupScriptFileName(void)
if (path == NULL) {
return NULL;
}
- return Tcl_GetStringFromObj(path, NULL);
+ return Tcl_GetString(path);
}
#if defined(_WIN32) || defined(__CYGWIN__)
@@ -90,7 +93,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
}
#endif
-#ifdef __WIN32__
+#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
@@ -111,7 +114,8 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
@@ -127,27 +131,31 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
TclWinNoBackslash(char *path)
{
char *p;
@@ -234,9 +242,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
- Tcl_SetResult(interp,
- "integer value too large to represent as non-long integer",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent as non-long integer", -1));
result = TCL_ERROR;
}
}
@@ -251,9 +258,8 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
- Tcl_SetResult(interp,
- "integer value too large to represent as non-long integer",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent as non-long integer", -1));
result = TCL_ERROR;
}
}
@@ -553,12 +559,13 @@ static const TclIntStubs tclIntStubs = {
TclCopyChannel, /* 248 */
TclDoubleDigits, /* 249 */
TclSetSlaveCancelFlags, /* 250 */
+ TclRegisterLiteral, /* 251 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
@@ -591,7 +598,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
@@ -662,7 +669,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
@@ -739,6 +746,9 @@ const TclTomMathStubs tclTomMathStubs = {
TclBN_mp_init_set_int, /* 61 */
TclBN_mp_set_int, /* 62 */
TclBN_mp_cnt_lsb, /* 63 */
+ TclBNInitBignumFromLong, /* 64 */
+ TclBNInitBignumFromWideInt, /* 65 */
+ TclBNInitBignumFromWideUInt, /* 66 */
};
static const TclStubHooks tclStubHooks = {
@@ -759,19 +769,19 @@ const TclStubs tclStubs = {
Tcl_DbCkalloc, /* 6 */
Tcl_DbCkfree, /* 7 */
Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -933,10 +943,10 @@ const TclStubs tclStubs = {
Tcl_GetMaster, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 96973d7..4695ab5 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -201,8 +201,9 @@ static int EncodingFromUtfProc(ClientData clientData,
int *dstCharsPtr);
static void ExitProcEven(ClientData clientData);
static void ExitProcOdd(ClientData clientData);
-static int GetTimesCmd(ClientData clientData,
- Tcl_Interp *interp, int argc, const char **argv);
+static int GetTimesObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static void MainLoop(void);
static int NoopCmd(ClientData clientData,
Tcl_Interp *interp, int argc, const char **argv);
@@ -219,6 +220,9 @@ static void SpecialFree(char *blockPtr);
static int StaticInitProc(Tcl_Interp *interp);
static int TestasyncCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
+static int TestbytestringObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int TestcmdinfoCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestcmdtokenCmd(ClientData dummy,
@@ -408,13 +412,19 @@ static int TestNumUtfCharsCmd(ClientData clientData,
static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+
+static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int TestNREUnwind(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int TestNRELevels(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestInterpResolverCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
static int TestcpuidCmd(ClientData dummy,
Tcl_Interp* interp, int objc,
Tcl_Obj *const objv[]);
@@ -556,9 +566,10 @@ Tcltest_Init(
* Create additional commands and math functions for testing Tcl.
*/
- Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
@@ -681,7 +692,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
(ClientData) 0, NULL);
#endif
@@ -692,6 +703,8 @@ Tcltest_Init(
NULL);
#endif /* TCL_NO_DEPRECATED */
+ Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
@@ -923,7 +936,7 @@ TestasyncCmd(
static int
AsyncHandlerProc(
- ClientData clientData, /* If of TestAsyncHandler structure.
+ ClientData clientData, /* If of TestAsyncHandler structure.
* in global list. */
Tcl_Interp *interp, /* Interpreter in which command was
* executed, or NULL. */
@@ -953,7 +966,7 @@ AsyncHandlerProc(
listArgv[3] = NULL;
cmd = Tcl_Merge(3, listArgv);
if (interp != NULL) {
- code = Tcl_Eval(interp, cmd);
+ code = Tcl_EvalEx(interp, cmd, -1, 0);
} else {
/*
* this should not happen, but by definition of how async handlers are
@@ -1236,7 +1249,7 @@ TestcmdtraceCmd(
if (strcmp(argv[1], "tracetest") == 0) {
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
- result = Tcl_Eval(interp, argv[2]);
+ result = Tcl_EvalEx(interp, argv[2], -1, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1252,13 +1265,13 @@ TestcmdtraceCmd(
*/
cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
- Tcl_Eval(interp, argv[2]);
+ Tcl_EvalEx(interp, argv[2], -1, 0);
} else if (strcmp(argv[1], "leveltest") == 0) {
Interp *iPtr = (Interp *) interp;
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
&buffer);
- result = Tcl_Eval(interp, argv[2]);
+ result = Tcl_EvalEx(interp, argv[2], -1, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1982,7 +1995,7 @@ EncodingToUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);
+ Tcl_EvalEx(encodingPtr->interp,encodingPtr->toUtfCmd,-1,TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
@@ -2014,7 +2027,7 @@ EncodingFromUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);
+ Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd,-1,TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
@@ -2301,9 +2314,9 @@ TesteventDeleteProc(
return 0;
}
targetName = (Tcl_Obj *) clientData;
- targetNameStr = (char *) Tcl_GetStringFromObj(targetName, NULL);
+ targetNameStr = (char *) Tcl_GetString(targetName);
ev = (TestEvent *) event;
- evNameStr = Tcl_GetStringFromObj(ev->tag, NULL);
+ evNameStr = Tcl_GetString(ev->tag);
if (strcmp(evNameStr, targetNameStr) == 0) {
Tcl_DecrRefCount(ev->tag);
Tcl_DecrRefCount(ev->command);
@@ -4408,8 +4421,26 @@ TestseterrorcodeCmd(
Tcl_SetResult(interp, "too many args", TCL_STATIC);
return TCL_ERROR;
}
- Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
- argv[5], NULL);
+ switch (argc) {
+ case 1:
+ Tcl_SetErrorCode(interp, "NONE", NULL);
+ break;
+ case 2:
+ Tcl_SetErrorCode(interp, argv[1], NULL);
+ break;
+ case 3:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
+ break;
+ case 4:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
+ break;
+ case 5:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
+ break;
+ case 6:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
+ argv[5], NULL);
+ }
return TCL_ERROR;
}
@@ -4484,7 +4515,7 @@ TestfeventCmd(
return TCL_ERROR;
}
if (interp2 != NULL) {
- code = Tcl_GlobalEval(interp2, argv[2]);
+ code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
return code;
} else {
@@ -4648,7 +4679,6 @@ TestgetvarfullnameCmd(
Tcl_Namespace *namespacePtr;
Tcl_CallFrame *framePtr;
Tcl_Var variable;
- int result;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name scope");
@@ -4676,11 +4706,8 @@ TestgetvarfullnameCmd(
if (namespacePtr == NULL) {
return TCL_ERROR;
}
- result = TclPushStackFrame(interp, &framePtr, namespacePtr,
+ (void) TclPushStackFrame(interp, &framePtr, namespacePtr,
/*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- return result;
- }
}
variable = Tcl_FindNamespaceVar(interp, name, NULL,
@@ -4699,7 +4726,7 @@ TestgetvarfullnameCmd(
/*
*----------------------------------------------------------------------
*
- * GetTimesCmd --
+ * GetTimesObjCmd --
*
* This procedure implements the "gettimes" command. It is used for
* computing the time needed for various basic operations such as reading
@@ -4715,11 +4742,11 @@ TestgetvarfullnameCmd(
*/
static int
-GetTimesCmd(
+GetTimesObjCmd(
ClientData unused, /* Unused. */
Tcl_Interp *interp, /* The current interpreter. */
- int argc, /* The number of arguments. */
- const char **argv) /* The argument strings. */
+ int notused1, /* Number of arguments. */
+ Tcl_Obj *const notused2[]) /* The argument objects. */
{
Interp *iPtr = (Interp *) interp;
int i, n;
@@ -4933,6 +4960,42 @@ NoopObjCmd(
/*
*----------------------------------------------------------------------
*
+ * TestbytestringObjCmd --
+ *
+ * This object-based procedure constructs a string which can
+ * possibly contain invalid UTF-8 bytes.
+ *
+ * Results:
+ * Returns the TCL_OK result code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestbytestringObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ int n;
+ const char *p;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
+ return TCL_ERROR;
+ }
+ p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestsetCmd --
*
* Implements the "testset{err,noerr}" cmds that are used when testing
@@ -6630,7 +6693,7 @@ TestNumUtfCharsCmd(
return TCL_OK;
}
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------
*
@@ -6791,6 +6854,51 @@ TestgetintCmd(
}
static int
+NREUnwind_callback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ int none;
+
+ if (data[0] == INT2PTR(-1)) {
+ Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1),
+ INT2PTR(-1), NULL);
+ } else if (data[1] == INT2PTR(-1)) {
+ Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
+ INT2PTR(-1), NULL);
+ } else if (data[2] == INT2PTR(-1)) {
+ Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
+ &none, NULL);
+ } else {
+ Tcl_Obj *idata[3];
+ idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0]));
+ idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
+ idata[2] = Tcl_NewIntObj((int) ((char *) &none - (char *) data[0]));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
+ }
+ return TCL_OK;
+}
+
+static int
+TestNREUnwind(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ /*
+ * Insure that callbacks effectively run at the proper level during the
+ * unwinding of the NRE stack.
+ */
+
+ Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
+ INT2PTR(-1), NULL);
+ return TCL_OK;
+}
+
+
+static int
TestNRELevels(
ClientData clientData,
Tcl_Interp *interp,
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index a3f89f6..4d32c5a 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -143,7 +143,7 @@ RegisterCommand(
if (cmdTablePtr->exportIt) {
sprintf(buf, "namespace eval %s { namespace export %s }",
namespace, cmdTablePtr->cmdName);
- if (Tcl_Eval(interp, buf) != TCL_OK) {
+ if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) {
return TCL_ERROR;
}
}
@@ -245,7 +245,7 @@ ProcBodyTestProcObjCmd(
* Find the Command pointer to this procedure
*/
- fullName = Tcl_GetStringFromObj(objv[3], NULL);
+ fullName = Tcl_GetString(objv[3]);
procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
if (procCmd == NULL) {
return TCL_ERROR;
diff --git a/generic/tclThread.c b/generic/tclThread.c
index d1f2691..198fa6a 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -339,8 +339,9 @@ Tcl_ConditionFinalize(
*
* TclFinalizeThreadData --
*
- * This function cleans up the thread-local storage. This is called once
- * for each thread.
+ * This function cleans up the thread-local storage. Secondary, it cleans
+ * thread alloc cache.
+ * This is called once for each thread before thread exits.
*
* Results:
* None.
@@ -352,9 +353,17 @@ Tcl_ConditionFinalize(
*/
void
-TclFinalizeThreadData(void)
+TclFinalizeThreadData(int quick)
{
TclFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ if (!quick) {
+ /*
+ * Quick exit principle makes it useless to terminate allocators
+ */
+ TclFinalizeThreadAllocThread();
+ }
+#endif
}
/*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index abd5af5..018f006 100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -84,6 +84,7 @@ typedef union Block {
typedef struct Bucket {
Block *firstPtr; /* First block available */
+ Block *lastPtr; /* End of block list */
long numFree; /* Number of blocks available */
/* All fields below for accounting only */
@@ -107,6 +108,7 @@ typedef struct Cache {
Tcl_ThreadId owner; /* Which thread's cache is this? */
Tcl_Obj *firstObjPtr; /* List of free objects for thread */
int numObjects; /* Number of objects for thread */
+ Tcl_Obj *lastPtr; /* Last object in this cache */
int totalAssigned; /* Total space assigned to thread */
Bucket buckets[NBUCKETS]; /* The buckets for this thread */
} Cache;
@@ -135,6 +137,7 @@ static int GetBlocks(Cache *cachePtr, int bucket);
static Block * Ptr2Block(char *ptr);
static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
+static void PutObjs(Cache *fromPtr, int numMove);
/*
* Local variables defined in this file and initialized at startup.
@@ -217,10 +220,11 @@ GetCache(void)
cachePtr = TclpGetAllocCache();
if (cachePtr == NULL) {
- cachePtr = calloc(1, sizeof(Cache));
+ cachePtr = TclpSysAlloc(sizeof(Cache), 0);
if (cachePtr == NULL) {
Tcl_Panic("alloc: could not allocate new cache");
}
+ memset(cachePtr, 0, sizeof(Cache));
Tcl_MutexLock(listLockPtr);
cachePtr->nextPtr = firstCachePtr;
firstCachePtr = cachePtr;
@@ -270,9 +274,7 @@ TclFreeAllocCache(
*/
if (cachePtr->numObjects > 0) {
- Tcl_MutexLock(objLockPtr);
- MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
- Tcl_MutexUnlock(objLockPtr);
+ PutObjs(cachePtr, cachePtr->numObjects);
}
/*
@@ -287,7 +289,7 @@ TclFreeAllocCache(
*nextPtrPtr = cachePtr->nextPtr;
cachePtr->nextPtr = NULL;
Tcl_MutexUnlock(listLockPtr);
- free(cachePtr);
+ TclpSysFree(cachePtr);
}
/*
@@ -332,7 +334,7 @@ TclpAlloc(
/*
* Increment the requested size to include room for the Block structure.
- * Call malloc() directly if the required amount is greater than the
+ * Call TclpSysAlloc() directly if the required amount is greater than the
* largest block, otherwise pop the smallest block large enough,
* allocating more blocks if necessary.
*/
@@ -344,7 +346,7 @@ TclpAlloc(
#endif
if (size > MAXALLOC) {
bucket = NBUCKETS;
- blockPtr = malloc(size);
+ blockPtr = TclpSysAlloc(size, 0);
if (blockPtr != NULL) {
cachePtr->totalAssigned += reqSize;
}
@@ -407,13 +409,16 @@ TclpFree(
bucket = blockPtr->sourceBucket;
if (bucket == NBUCKETS) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
- free(blockPtr);
+ TclpSysFree(blockPtr);
return;
}
cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
cachePtr->buckets[bucket].firstPtr = blockPtr;
+ if (cachePtr->buckets[bucket].numFree == 0) {
+ cachePtr->buckets[bucket].lastPtr = blockPtr;
+ }
cachePtr->buckets[bucket].numFree++;
cachePtr->buckets[bucket].numInserts++;
@@ -472,7 +477,7 @@ TclpRealloc(
/*
* If the block is not a system block and fits in place, simply return the
* existing pointer. Otherwise, if the block is a system block and the new
- * size would also require a system block, call realloc() directly.
+ * size would also require a system block, call TclpSysRealloc() directly.
*/
blockPtr = Ptr2Block(ptr);
@@ -495,7 +500,7 @@ TclpRealloc(
} else if (size > MAXALLOC) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
cachePtr->totalAssigned += reqSize;
- blockPtr = realloc(blockPtr, size);
+ blockPtr = TclpSysRealloc(blockPtr, size);
if (blockPtr == NULL) {
return NULL;
}
@@ -567,15 +572,17 @@ TclThreadAllocObj(void)
Tcl_Obj *newObjsPtr;
cachePtr->numObjects = numMove = NOBJALLOC;
- newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
+ newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
if (newObjsPtr == NULL) {
Tcl_Panic("alloc: could not allocate %d new objects", numMove);
}
+ cachePtr->lastPtr = newObjsPtr + numMove - 1;
+ objPtr = cachePtr->firstObjPtr; /* NULL */
while (--numMove >= 0) {
- objPtr = &newObjsPtr[numMove];
- objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
- cachePtr->firstObjPtr = objPtr;
+ newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
+ objPtr = newObjsPtr + numMove;
}
+ cachePtr->firstObjPtr = newObjsPtr;
}
}
@@ -623,6 +630,9 @@ TclThreadFreeObj(
objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
+ if (cachePtr->numObjects == 0) {
+ cachePtr->lastPtr = objPtr;
+ }
cachePtr->numObjects++;
/*
@@ -631,9 +641,7 @@ TclThreadFreeObj(
*/
if (cachePtr->numObjects > NOBJHIGH) {
- Tcl_MutexLock(objLockPtr);
- MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
- Tcl_MutexUnlock(objLockPtr);
+ PutObjs(cachePtr, NOBJALLOC);
}
}
@@ -731,13 +739,67 @@ MoveObjs(
* just have to update the first and last.
*/
- objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
+ toPtr->lastPtr = objPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
toPtr->firstObjPtr = fromFirstObjPtr;
}
/*
*----------------------------------------------------------------------
*
+ * PutObjs --
+ *
+ * Move Tcl_Obj's from thread cache to shared cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PutObjs(
+ Cache *fromPtr,
+ int numMove)
+{
+ int keep = fromPtr->numObjects - numMove;
+ Tcl_Obj *firstPtr, *lastPtr = NULL;
+
+ fromPtr->numObjects = keep;
+ firstPtr = fromPtr->firstObjPtr;
+ if (keep == 0) {
+ fromPtr->firstObjPtr = NULL;
+ } else {
+ do {
+ lastPtr = firstPtr;
+ firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
+ } while (--keep > 0);
+ lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ }
+
+ /*
+ * Move all objects as a block - they are already linked to each other, we
+ * just have to update the first and last.
+ */
+
+ Tcl_MutexLock(objLockPtr);
+ fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
+ sharedPtr->firstObjPtr = firstPtr;
+ if (sharedPtr->numObjects == 0) {
+ sharedPtr->lastPtr = fromPtr->lastPtr;
+ }
+ sharedPtr->numObjects += numMove;
+ Tcl_MutexUnlock(objLockPtr);
+
+ fromPtr->lastPtr = lastPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Block2Ptr, Ptr2Block --
*
* Convert between internal blocks and user pointers.
@@ -847,20 +909,25 @@ PutBlocks(
int bucket,
int numMove)
{
- register Block *lastPtr, *firstPtr;
- register int n = numMove;
-
/*
- * Before acquiring the lock, walk the block list to find the last block
- * to be moved.
+ * We have numFree. Want to shed numMove. So compute how many
+ * Blocks to keep.
*/
- firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
- while (--n > 0) {
- lastPtr = lastPtr->nextBlock;
+ int keep = cachePtr->buckets[bucket].numFree - numMove;
+ Block *lastPtr = NULL, *firstPtr;
+
+ cachePtr->buckets[bucket].numFree = keep;
+ firstPtr = cachePtr->buckets[bucket].firstPtr;
+ if (keep == 0) {
+ cachePtr->buckets[bucket].firstPtr = NULL;
+ } else {
+ do {
+ lastPtr = firstPtr;
+ firstPtr = firstPtr->nextBlock;
+ } while (--keep > 0);
+ lastPtr->nextBlock = NULL;
}
- cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
- cachePtr->buckets[bucket].numFree -= numMove;
/*
* Aquire the lock and place the list of blocks at the front of the shared
@@ -868,10 +935,17 @@ PutBlocks(
*/
LockBucket(cachePtr, bucket);
- lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].lastPtr->nextBlock
+ = sharedPtr->buckets[bucket].firstPtr;
sharedPtr->buckets[bucket].firstPtr = firstPtr;
+ if (sharedPtr->buckets[bucket].numFree == 0) {
+ sharedPtr->buckets[bucket].lastPtr
+ = cachePtr->buckets[bucket].lastPtr;
+ }
sharedPtr->buckets[bucket].numFree += numMove;
UnlockBucket(cachePtr, bucket);
+
+ cachePtr->buckets[bucket].lastPtr = lastPtr;
}
/*
@@ -918,6 +992,8 @@ GetBlocks(
if (n >= sharedPtr->buckets[bucket].numFree) {
cachePtr->buckets[bucket].firstPtr =
sharedPtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].lastPtr =
+ sharedPtr->buckets[bucket].lastPtr;
cachePtr->buckets[bucket].numFree =
sharedPtr->buckets[bucket].numFree;
sharedPtr->buckets[bucket].firstPtr = NULL;
@@ -931,6 +1007,7 @@ GetBlocks(
blockPtr = blockPtr->nextBlock;
}
sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
+ cachePtr->buckets[bucket].lastPtr = blockPtr;
blockPtr->nextBlock = NULL;
}
}
@@ -964,7 +1041,7 @@ GetBlocks(
if (blockPtr == NULL) {
size = MAXALLOC;
- blockPtr = malloc(size);
+ blockPtr = TclpSysAlloc(size, 0);
if (blockPtr == NULL) {
return 0;
}
@@ -982,6 +1059,7 @@ GetBlocks(
((char *) blockPtr + bucketInfo[bucket].blockSize);
blockPtr = blockPtr->nextBlock;
}
+ cachePtr->buckets[bucket].lastPtr = blockPtr;
blockPtr->nextBlock = NULL;
}
return 1;
@@ -1023,6 +1101,33 @@ TclFinalizeThreadAlloc(void)
TclpFreeAllocCache(NULL);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ * This procedure is used to destroy single thread private resources used
+ * in this file.
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ if (cachePtr != NULL) {
+ TclpFreeAllocCache(cachePtr);
+ }
+}
+
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 4b09e1c..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -14,7 +14,7 @@
#include "tclInt.h"
-#ifdef WIN32
+#ifdef _WIN32
/*
* The information about each joinable thread is remembered in a structure as
@@ -305,7 +305,7 @@ TclSignalExitThread(
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
-#endif /* WIN32 */
+#endif /* _WIN32 */
/*
* Local Variables:
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index f24e334..755a461 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -208,12 +208,12 @@ TclThreadStorageKeyGet(
*
* This procedure set an association of value with the key passed. The
* associated value may be retrieved with TclThreadDataKeyGet().
- *
+ *
* Results:
* None.
*
* Side effects:
- * The thread-specific table may be created or reallocated.
+ * The thread-specific table may be created or reallocated.
*
*----------------------------------------------------------------------
*/
@@ -285,7 +285,7 @@ TclThreadStorageKeySet(
*----------------------------------------------------------------------
*/
-void
+void
TclFinalizeThreadDataThread(void)
{
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 02ee038..9c66313 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -613,7 +613,7 @@ NewTestThread(
*/
Tcl_Preserve(tsdPtr->interp);
- result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
+ result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
@@ -834,7 +834,7 @@ ThreadSend(
if (threadId == Tcl_GetCurrentThread()) {
Tcl_MutexUnlock(&threadMutex);
- return Tcl_GlobalEval(interp, script);
+ return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
}
/*
@@ -1029,7 +1029,7 @@ ThreadEventProc(
Tcl_Preserve(interp);
Tcl_ResetResult(interp);
Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
- code = Tcl_GlobalEval(interp, threadEventPtr->script);
+ code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL);
Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
if (code != TCL_OK) {
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index ea3abb1..610a031 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -1,9 +1,8 @@
# tclTomMath.decls --
#
-# This file contains the declarations for the functions in
-# 'libtommath' that are contained within the Tcl library.
-# This file is used to generate the 'tclTomMathDecls.h' and
-# 'tclTomMathStub.c' files.
+# This file contains the declarations for the functions in 'libtommath'
+# that are contained within the Tcl library. This file is used to
+# generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files.
#
# If you edit this file, advance the revision number (and the epoch
# if the new stubs are not backward compatible) in tclTomMathDecls.h
@@ -221,3 +220,19 @@ declare 62 {
declare 63 {
int TclBN_mp_cnt_lsb(const mp_int *a)
}
+
+# Formerly internal API to allow initialisation of bignums without knowing the
+# typedefs of how a bignum works internally.
+declare 64 {
+ void TclBNInitBignumFromLong(mp_int *bignum, long initVal)
+}
+declare 65 {
+ void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
+}
+declare 66 {
+ void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index ef22153..2ce9d5a 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -134,6 +134,10 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
@@ -275,6 +279,14 @@ EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i);
EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i);
/* 63 */
EXTERN int TclBN_mp_cnt_lsb(const mp_int *a);
+/* 64 */
+EXTERN void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
+/* 65 */
+EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum,
+ Tcl_WideInt initVal);
+/* 66 */
+EXTERN void TclBNInitBignumFromWideUInt(mp_int *bignum,
+ Tcl_WideUInt initVal);
typedef struct TclTomMathStubs {
int magic;
@@ -344,12 +356,13 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
+ void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
+ void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
+ void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
} TclTomMathStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclTomMathStubs *tclTomMathStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -488,6 +501,12 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
#define TclBN_mp_cnt_lsb \
(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
+#define TclBNInitBignumFromLong \
+ (tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */
+#define TclBNInitBignumFromWideInt \
+ (tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
+#define TclBNInitBignumFromWideUInt \
+ (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index c0cde49..4e74c54 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -544,7 +544,7 @@ TraceExecutionObjCmd(
tcmdPtr->flags = 0;
}
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
break;
@@ -748,7 +748,7 @@ TraceCommandObjCmd(
Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
TraceCommandProc, clientData);
tcmdPtr->flags |= TCL_TRACE_DESTROYED;
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
break;
@@ -1130,7 +1130,7 @@ Tcl_TraceCommand(
/*
* Bug 3484621: up the interp's epoch if this is a BC'ed command
*/
-
+
if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
Interp *iPtr = (Interp *) interp;
iPtr->compileEpoch++;
@@ -1138,7 +1138,7 @@ Tcl_TraceCommand(
cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
}
-
+
return TCL_OK;
}
@@ -1223,7 +1223,7 @@ Tcl_UntraceCommand(
}
tracePtr->flags = 0;
- if ((--tracePtr->refCount) <= 0) {
+ if (tracePtr->refCount-- <= 1) {
ckfree(tracePtr);
}
@@ -1245,7 +1245,7 @@ Tcl_UntraceCommand(
/*
* Bug 3484621: up the interp's epoch if this is a BC'ed command
*/
-
+
if (cmdPtr->compileProc != NULL) {
Interp *iPtr = (Interp *) interp;
iPtr->compileEpoch++;
@@ -1382,7 +1382,7 @@ TraceCommandProc(
Tcl_RestoreInterpState(interp, state);
tcmdPtr->refCount--;
}
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
}
@@ -1474,7 +1474,7 @@ TclCheckExecutionTraces(
}
traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
command, (Tcl_Command) cmdPtr, objc, objv);
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
}
@@ -1721,7 +1721,7 @@ CommandObjTraceDeleted(
{
TraceCommandInfo *tcmdPtr = clientData;
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
}
@@ -1889,7 +1889,8 @@ TraceExecutionProc(
* interpreter.
*/
- traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+ traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+ Tcl_DStringLength(&cmd), 0);
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
/*
@@ -1936,7 +1937,7 @@ TraceExecutionProc(
}
}
if (call) {
- if ((--tcmdPtr->refCount) <= 0) {
+ if (tcmdPtr->refCount-- <= 1) {
ckfree(tcmdPtr);
}
}
@@ -2511,6 +2512,9 @@ TclObjCallVarTraces(
if (!part1Ptr) {
part1Ptr = localName(iPtr->varFramePtr, index);
}
+ if (!part1Ptr) {
+ Tcl_Panic("Cannot trace a variable with no name");
+ }
part1 = TclGetString(part1Ptr);
part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index 5c88639..1ca119d 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -30,35 +30,35 @@ static const unsigned short pageMap[] = {
1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344,
1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728,
1760, 1792, 1792, 1824, 1792, 1856, 1888, 1920, 1952, 1984, 2016, 2048,
- 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2016, 2400,
- 2432, 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784,
- 2816, 2848, 2752, 2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136,
- 3168, 1792, 3200, 3232, 3264, 1792, 3296, 3328, 3360, 3392, 3424, 3456,
- 3488, 1792, 1344, 3520, 3552, 3584, 3616, 3648, 3680, 3712, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3744, 1344, 3776, 3808,
- 3840, 1344, 3872, 1344, 3904, 3936, 3968, 1344, 1344, 4000, 4032, 1344,
+ 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432,
+ 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816,
+ 2848, 2880, 2784, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168,
+ 3200, 1792, 3232, 3264, 3296, 1792, 3328, 3360, 3392, 3424, 3456, 3488,
+ 3520, 1792, 1344, 3552, 3584, 3616, 3648, 3680, 3712, 3744, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3776, 1344, 3808, 3840,
+ 3872, 1344, 3904, 1344, 3936, 3968, 4000, 4032, 4032, 4064, 4096, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 4064, 4096, 1344, 1344, 4128, 4160, 4192,
- 4224, 4256, 1344, 4288, 4320, 4352, 4384, 1344, 4416, 4448, 1344, 4480,
- 1344, 4512, 4544, 4576, 4608, 4640, 1344, 4672, 4704, 4736, 4768, 1344,
- 4800, 4832, 4864, 4896, 1792, 1792, 4928, 4960, 4992, 5024, 5056, 5088,
- 1344, 5120, 1344, 5152, 5184, 5216, 1792, 1792, 5248, 5280, 5312, 5344,
- 5376, 5408, 5440, 5376, 704, 5472, 224, 224, 224, 224, 5504, 224, 224,
- 224, 5536, 5568, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856,
- 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240,
- 6272, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6336, 6368, 4736,
- 6400, 6432, 6464, 6496, 6528, 4736, 6560, 6592, 6624, 6656, 6688, 6720,
- 6752, 4736, 4736, 4736, 4736, 4736, 6784, 6816, 6848, 4736, 4736, 4736,
- 6880, 4736, 4736, 4736, 4736, 6912, 4736, 4736, 6944, 6976, 4736, 7008,
- 7040, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 6304, 6304, 6304,
- 6304, 7072, 6304, 7104, 7136, 6304, 6304, 6304, 6304, 6304, 6304, 6304,
- 6304, 4736, 7168, 7200, 1792, 1792, 1792, 1792, 1792, 7232, 7264, 7296,
- 7328, 224, 224, 224, 7360, 7392, 7424, 1344, 7456, 7488, 7520, 7520,
- 704, 7552, 7584, 1792, 1792, 7616, 4736, 4736, 7648, 4736, 4736, 4736,
- 4736, 4736, 4736, 7680, 7712, 7744, 7776, 3104, 1344, 7808, 4032, 1344,
- 7840, 7872, 7904, 1344, 1344, 7936, 7968, 4736, 8000, 8032, 8064, 8096,
- 4736, 8064, 8128, 4736, 8032, 4736, 4736, 4736, 4736, 4736, 4736, 4736,
- 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 4128, 4160, 1344, 1344, 4192, 4224, 4256,
+ 4288, 4320, 1344, 4352, 4384, 4416, 4448, 1344, 4480, 4512, 1344, 4544,
+ 1344, 4576, 4608, 4640, 4672, 4704, 1344, 4736, 4768, 4800, 4832, 1344,
+ 4864, 4896, 4928, 4960, 1792, 1792, 4992, 5024, 5056, 5088, 5120, 5152,
+ 1344, 5184, 1344, 5216, 5248, 5280, 1792, 1792, 5312, 5344, 5376, 5408,
+ 5440, 5472, 5504, 5440, 704, 5536, 224, 224, 224, 224, 5568, 224, 224,
+ 224, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856, 5888, 5920,
+ 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240, 6272, 6304,
+ 6336, 6368, 6368, 6368, 6368, 6368, 6368, 6368, 6368, 6400, 6432, 4800,
+ 6464, 6496, 6528, 6560, 6592, 4800, 6624, 6656, 6688, 6720, 6752, 6784,
+ 6816, 4800, 4800, 4800, 4800, 4800, 6848, 6880, 6912, 4800, 4800, 4800,
+ 6944, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 6976, 7008, 4800, 7040,
+ 7072, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 6368, 6368, 6368,
+ 6368, 7104, 6368, 7136, 7168, 6368, 6368, 6368, 6368, 6368, 6368, 6368,
+ 6368, 4800, 7200, 7232, 7264, 7296, 7328, 7360, 7392, 7424, 7456, 7488,
+ 7520, 224, 224, 224, 7552, 7584, 7616, 1344, 7648, 7680, 7712, 7712,
+ 704, 7744, 7776, 7808, 1792, 7840, 4800, 4800, 7872, 4800, 4800, 4800,
+ 4800, 4800, 4800, 7904, 7936, 7968, 8000, 3136, 1344, 8032, 4096, 1344,
+ 8064, 8096, 8128, 1344, 1344, 8160, 8192, 4800, 8224, 8256, 8288, 8320,
+ 4800, 8288, 8352, 4800, 8256, 4800, 4800, 4800, 4800, 4800, 4800, 4800,
+ 4800, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
@@ -75,7 +75,7 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 4512, 4736, 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 4576, 4800, 4800, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
@@ -129,16 +129,16 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8160,
- 1792, 8192, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4576,
+ 1792, 8384, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 8224, 4736, 8256, 5216, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 8288, 8320, 224, 8352, 8384, 1344, 1344, 8416, 8448, 8480, 224,
- 8512, 8544, 8576, 1792, 8608, 8640, 8672, 1344, 8704, 8736, 8768, 8800,
- 8832, 1632, 8864, 8896, 4544, 1888, 8928, 8960, 1792, 1344, 8992, 9024,
- 9056, 1344, 9088, 9120, 9152, 9184, 9216, 1792, 1792, 1792, 1792, 1344,
- 9248, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 8416, 4800, 8448, 5280, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 8480, 8512, 224, 8544, 8576, 1344, 1344, 8608, 8640, 8672, 224,
+ 8704, 8736, 8768, 1792, 8800, 8832, 8864, 1344, 8896, 8928, 8960, 8992,
+ 9024, 1632, 9056, 9088, 9120, 1888, 9152, 9184, 9216, 1344, 9248, 9280,
+ 9312, 1344, 9344, 9376, 9408, 9440, 9472, 9504, 9536, 9568, 9568, 1344,
+ 9600, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
@@ -167,61 +167,62 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 9280, 9312, 9344, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
- 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
- 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
- 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
- 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
- 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
- 9408, 9408, 9408, 9408, 9408, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 9440, 1344, 1344, 9472, 1792, 9504, 9536, 9568,
- 1344, 1344, 9600, 9632, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 9664, 9696, 1344, 9728, 1344, 9760, 9792, 9824, 9856, 9888,
- 9920, 1344, 1344, 1344, 9952, 9984, 64, 10016, 10048, 10080, 10112,
- 10144, 10176
+ 1344, 1344, 9632, 9664, 9696, 9728, 9728, 9728, 9728, 9728, 9728, 9728,
+ 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728,
+ 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728,
+ 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728,
+ 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728,
+ 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760,
+ 9760, 9760, 9760, 9760, 9760, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 9792, 1344, 1344, 9824, 1792, 9856, 9888, 9920,
+ 1344, 1344, 9952, 9984, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 10016, 10048, 1344, 10080, 1344, 10112, 10144, 10176, 10208,
+ 10240, 10272, 1344, 1344, 1344, 10304, 10336, 64, 10368, 10400, 10432,
+ 4608, 10464, 10496
#if TCL_UTF_MAX > 3
- ,10208, 10240, 10272, 1792, 1344, 1344, 1344, 7968, 10304, 10336, 10368,
- 10400, 10432, 1792, 10464, 10496, 1792, 1792, 1792, 1792, 4544, 1344,
- 10528, 1792, 10112, 10560, 10592, 1792, 10624, 1344, 10656, 1792, 10688,
- 10720, 10752, 1344, 10784, 10816, 1792, 1792, 1792, 1792, 1792, 1792,
+ ,10528, 10560, 10592, 1792, 1344, 1344, 1344, 8192, 10624, 10656, 10688,
+ 10720, 10752, 10784, 10816, 10848, 1792, 1792, 1792, 1792, 9120, 1344,
+ 10880, 10912, 1344, 10944, 10976, 11008, 11040, 1344, 11072, 1792,
+ 11104, 11136, 11168, 1344, 11200, 11232, 1792, 1792, 1344, 11264, 1344,
+ 11296, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 7680, 4576, 10112, 1792, 1792, 1792, 1792, 11328,
+ 11360, 11392, 11424, 4608, 11456, 1792, 11488, 11520, 11552, 1792,
+ 1792, 1344, 11584, 11616, 6688, 11648, 11680, 11712, 11744, 11776,
+ 1792, 11808, 11840, 1344, 11872, 11904, 11936, 11968, 12000, 1792,
+ 1792, 1344, 1344, 12032, 1792, 12064, 12096, 12128, 12160, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12192, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12224,
+ 12256, 12288, 12320, 5120, 12352, 12384, 12416, 12448, 12480, 12512,
+ 12544, 5120, 12576, 12608, 12640, 12672, 12704, 1792, 1792, 12736,
+ 12768, 12800, 12832, 12864, 2304, 12896, 12928, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1344, 12960, 12992, 1792, 1792, 1792, 1792,
+ 1792, 1344, 13024, 13056, 1792, 1344, 13088, 13120, 1792, 1344, 13152,
+ 11232, 1792, 13184, 13216, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 13248, 13280, 13312, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 13344,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 10848, 10880, 10912,
- 1792, 1792, 1792, 1792, 1792, 10944, 10976, 1792, 1792, 1344, 11008,
- 1792, 1792, 11040, 11072, 11104, 11136, 1792, 1792, 1792, 1792, 1344,
- 11168, 11200, 11232, 1792, 1792, 1792, 1792, 1344, 1344, 11264, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 11296, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 11328, 11360, 11392, 11424, 5056, 11456,
- 11488, 11520, 11552, 11584, 11616, 1792, 5056, 11648, 11680, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1344, 11712, 10816, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11744, 1792, 1792,
- 1792, 1792, 10368, 10368, 10368, 11776, 1792, 1792, 1792, 1792, 1792,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9824, 1792, 1792, 1792,
+ 10688, 10688, 10688, 13376, 1344, 1344, 1344, 1344, 1344, 1344, 13408,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -229,12 +230,9 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 11744, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 13440,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -245,6 +243,9 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 13472, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -266,12 +267,13 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 11808, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 13344, 4608, 13504, 1792, 1792, 10048, 13536, 1344, 13568, 13600, 13632,
+ 13664, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1344, 1344, 13696, 13728, 13760, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1344, 1344, 11840, 11872, 11904, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -313,14 +315,16 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 13792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 11936,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344,
+ 1344, 1344, 13824, 13856, 13888, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -333,43 +337,40 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 7904,
+ 4800, 13920, 4800, 13952, 13984, 14016, 4800, 14048, 4800, 4800, 14080,
+ 1792, 1792, 1792, 1792, 1792, 4800, 4800, 14112, 14144, 1792, 1792,
+ 1792, 1792, 14176, 14208, 14240, 14272, 14304, 14336, 14368, 14400,
+ 14432, 14464, 14496, 14528, 14560, 14176, 14208, 14592, 14272, 14624,
+ 14656, 14688, 14400, 14720, 14752, 14784, 14816, 14848, 14880, 14912,
+ 14944, 14976, 15008, 15040, 4800, 4800, 4800, 4800, 4800, 4800, 4800,
+ 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 704, 15072, 704,
+ 15104, 15136, 15168, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 7680, 4736,
- 11968, 4736, 12000, 12032, 12064, 12096, 1792, 4736, 4736, 12128, 1792,
- 1792, 1792, 1792, 1792, 4736, 4736, 12160, 12192, 1792, 1792, 1792,
- 1792, 12224, 12256, 12288, 12320, 12352, 12384, 12416, 12448, 12480,
- 12512, 12544, 12576, 12608, 12224, 12256, 12640, 12320, 12672, 12704,
- 12736, 12448, 12768, 12800, 12832, 12864, 12896, 12928, 12960, 12992,
- 13024, 13056, 13088, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 15200, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 15232, 15264, 15296, 15328, 15360, 15392, 1792, 15424,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 4800, 15456, 4800,
+ 4800, 7872, 15488, 15520, 7904, 15552, 15584, 4800, 15456, 15616, 1792,
+ 1792, 15648, 15680, 15616, 15712, 1792, 1792, 1792, 1792, 1792, 4800,
+ 4800, 4800, 4800, 4800, 4800, 4800, 15744, 4800, 4800, 4800, 4800,
+ 4800, 4800, 4800, 4800, 4800, 4800, 4800, 7840, 4800, 15776, 4800,
+ 4800, 4800, 4800, 4800, 4800, 4800, 4800, 15808, 15840, 4800, 4800,
+ 4800, 7872, 4800, 4800, 15872, 1792, 15456, 4800, 15904, 4800, 15936,
+ 15968, 1792, 1792, 16000, 1792, 1792, 1792, 16032, 1792, 10784, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 13120, 13152, 13184, 13216, 13248, 13280, 1792, 13312, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 4736, 13344, 4736, 4736, 7648,
- 13376, 13408, 1792, 13440, 13472, 4736, 13344, 13504, 1792, 1792, 13536,
- 13568, 13504, 13600, 1792, 1792, 1792, 1792, 1792, 4736, 13632, 4736,
- 13664, 7648, 4736, 13696, 13728, 4736, 8032, 13760, 4736, 4736, 4736,
- 4736, 13792, 4736, 12096, 13824, 13856, 1792, 1792, 1792, 13888, 4736,
- 4736, 13920, 1792, 4736, 4736, 13952, 1792, 4736, 4736, 4736, 7648,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
@@ -480,8 +481,8 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7488, 1792,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 7680, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
@@ -491,23 +492,23 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4000, 1344, 1344,
- 1344, 1344, 1344, 1344, 10784, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 11200, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 13792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
@@ -535,8 +536,8 @@ static const unsigned short pageMap[] = {
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
- 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
- 1344, 1344, 1344, 1344, 1344, 10784
+ 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11200
#endif /* TCL_UTF_MAX > 3 */
};
@@ -577,325 +578,331 @@ static const unsigned char groupMap[] = {
21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
23, 24, 21, 21, 21, 21, 21, 21, 55, 23, 24, 56, 57, 58, 58, 23, 24,
59, 60, 61, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 62, 63, 64, 65,
- 66, 21, 67, 67, 21, 68, 21, 69, 21, 21, 21, 21, 67, 21, 21, 70, 21,
- 71, 72, 21, 73, 74, 21, 75, 21, 21, 21, 74, 21, 76, 77, 21, 21, 78,
- 21, 21, 21, 21, 21, 21, 21, 79, 21, 21, 80, 21, 21, 80, 21, 21, 21,
- 21, 80, 81, 82, 82, 83, 21, 21, 21, 21, 21, 84, 21, 15, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 85, 85, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
- 11, 11, 11, 11, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 85,
- 11, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
- 11, 11, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 87, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 23, 24, 23,
- 24, 85, 11, 23, 24, 0, 0, 85, 42, 42, 42, 3, 0, 0, 0, 0, 0, 11, 11,
- 88, 3, 89, 89, 89, 0, 90, 0, 91, 91, 21, 10, 10, 10, 10, 10, 10, 10,
+ 66, 21, 67, 67, 21, 68, 21, 69, 70, 21, 21, 21, 67, 71, 21, 72, 21,
+ 73, 74, 21, 75, 76, 21, 77, 78, 21, 21, 76, 21, 79, 80, 21, 21, 81,
+ 21, 21, 21, 21, 21, 21, 21, 82, 21, 21, 83, 21, 21, 83, 21, 21, 21,
+ 84, 83, 85, 86, 86, 87, 21, 21, 21, 21, 21, 88, 21, 15, 21, 21, 21,
+ 21, 21, 21, 21, 21, 89, 90, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 91, 91, 91, 11, 11, 11, 11, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 91, 91, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 91, 91, 91, 91, 91, 11, 11, 11, 11, 11, 11, 11, 91,
+ 11, 91, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 93, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 23, 24, 23,
+ 24, 91, 11, 23, 24, 0, 0, 91, 42, 42, 42, 3, 94, 0, 0, 0, 0, 11, 11,
+ 95, 3, 96, 96, 96, 0, 97, 0, 98, 98, 21, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10,
- 10, 10, 10, 92, 93, 93, 93, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 13, 13, 13, 13, 13, 94, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 95, 96, 96, 97, 98, 99, 100, 100, 100, 101, 102, 103, 23, 24, 23,
- 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
- 23, 24, 23, 24, 104, 105, 106, 21, 107, 108, 7, 23, 24, 109, 23, 24,
- 21, 54, 54, 54, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
- 110, 110, 110, 110, 110, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 99, 100, 100, 100, 21, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 101, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 102, 103, 103, 104, 105, 106, 107, 107, 107, 108, 109, 110,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 111, 112, 113, 114, 115, 116, 7, 23, 24,
+ 117, 23, 24, 21, 54, 54, 54, 118, 118, 118, 118, 118, 118, 118, 118,
+ 118, 118, 118, 118, 118, 118, 118, 118, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
- 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
- 105, 105, 105, 105, 23, 24, 14, 86, 86, 86, 86, 86, 111, 111, 23, 24,
- 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 23, 24, 112, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 113, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 0, 85, 3, 3, 3, 3,
- 3, 3, 0, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
- 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
- 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 21, 0,
- 3, 8, 0, 0, 0, 0, 4, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 8, 86, 3, 86, 86, 3, 86, 86, 3, 86, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 3, 3, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 0, 7, 7, 7, 3, 3,
- 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 0,
- 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 86, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 15, 86, 86, 86,
- 86, 86, 86, 86, 17, 14, 86, 86, 86, 86, 86, 86, 85, 85, 86, 86, 14,
- 86, 86, 86, 86, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 14,
- 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 17, 15, 86, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 85, 85, 14, 3, 3, 3, 85, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
- 86, 86, 86, 85, 86, 86, 86, 86, 86, 86, 86, 86, 86, 85, 86, 86, 86,
- 85, 86, 86, 86, 86, 86, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 0, 0, 3, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 86, 86, 86, 116,
+ 13, 13, 13, 13, 13, 13, 112, 112, 112, 112, 112, 112, 112, 112, 112,
+ 112, 112, 112, 112, 112, 112, 112, 23, 24, 14, 92, 92, 92, 92, 92,
+ 119, 119, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 120, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 121, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 0, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
+ 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
+ 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
+ 0, 0, 91, 3, 3, 3, 3, 3, 3, 0, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 21, 0, 3, 8, 0, 0, 14, 14, 4, 0, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 8, 92, 3, 92, 92, 3, 92, 92, 3, 92, 0, 0, 0, 0,
+ 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
+ 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17,
+ 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 92,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 86, 116, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 86,
- 86, 86, 116, 116, 116, 116, 86, 116, 116, 15, 86, 86, 86, 86, 86, 86,
- 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 3, 3, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 3, 85, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
- 15, 15, 15, 15, 0, 86, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15, 15,
- 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
- 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 86, 15, 116, 116, 116, 86,
- 86, 86, 86, 0, 0, 116, 116, 0, 0, 116, 116, 86, 15, 0, 0, 0, 0, 0,
- 0, 0, 0, 116, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 86, 86, 0, 0, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4,
- 0, 0, 0, 0, 0, 86, 86, 116, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
- 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
- 15, 0, 15, 15, 0, 15, 15, 0, 0, 86, 0, 116, 116, 116, 86, 86, 0, 0,
- 0, 0, 86, 86, 0, 0, 86, 86, 86, 0, 0, 0, 86, 0, 0, 0, 0, 0, 0, 0, 15,
- 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 86, 86, 15, 15, 15, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86,
- 116, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15,
- 15, 15, 0, 0, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 0, 86, 86,
- 116, 0, 116, 116, 86, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15,
- 15, 0, 0, 86, 15, 116, 86, 116, 86, 86, 86, 86, 0, 0, 116, 116, 0,
- 0, 116, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0, 86, 116, 0, 0, 0, 0, 15, 15,
- 0, 15, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15,
- 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 0, 15,
- 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0,
- 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0,
- 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116,
- 116, 86, 116, 116, 0, 0, 0, 116, 116, 116, 0, 116, 116, 116, 86, 0,
- 0, 15, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14,
- 4, 14, 0, 0, 0, 0, 0, 0, 116, 116, 116, 0, 15, 15, 15, 15, 15, 15,
- 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 0, 15, 86, 86,
- 86, 116, 116, 116, 116, 0, 86, 86, 86, 0, 86, 86, 86, 86, 0, 0, 0,
- 0, 0, 0, 0, 86, 86, 0, 15, 15, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86, 0,
- 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18,
- 18, 18, 18, 18, 14, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15,
- 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 86, 15, 116, 86, 116,
- 116, 116, 116, 116, 0, 86, 116, 116, 0, 116, 116, 86, 86, 0, 0, 0,
- 0, 0, 0, 0, 116, 116, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 86, 86, 0,
- 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 116,
- 116, 116, 86, 86, 86, 86, 0, 116, 116, 116, 0, 116, 116, 116, 86, 15,
- 0, 0, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86,
- 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 0, 0, 0,
- 14, 15, 15, 15, 15, 15, 15, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15,
+ 15, 3, 15, 92, 92, 92, 92, 92, 92, 92, 17, 14, 92, 92, 92, 92, 92,
+ 92, 91, 91, 92, 92, 14, 92, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 15, 15, 15, 14, 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 0, 17, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0,
- 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 0, 0, 0, 0, 116, 116, 116,
- 86, 86, 86, 0, 86, 0, 116, 116, 116, 116, 116, 116, 116, 116, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 3, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 15, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0,
- 4, 15, 15, 15, 15, 15, 15, 85, 86, 86, 86, 86, 86, 86, 86, 86, 3, 9,
- 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0,
- 15, 15, 0, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15,
- 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15,
- 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 0, 86, 86, 15, 0, 0,
- 15, 15, 15, 15, 15, 0, 85, 0, 86, 86, 86, 86, 86, 86, 0, 0, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 86, 86, 14,
- 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 14, 86, 14, 86, 14, 86, 5, 6, 5, 6, 116, 116, 15,
- 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 3,
- 86, 86, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 0, 14, 14, 14, 14, 14, 14, 14, 14, 86, 14, 14, 14,
- 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0,
- 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 86, 86,
- 86, 86, 116, 86, 86, 86, 86, 86, 86, 116, 86, 86, 116, 116, 86, 86,
- 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15,
- 15, 15, 116, 116, 86, 86, 15, 15, 15, 15, 86, 86, 86, 15, 116, 116,
- 116, 15, 15, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15, 86, 86,
- 86, 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116,
- 116, 86, 86, 116, 116, 116, 116, 116, 116, 86, 15, 116, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 116, 116, 116, 86, 14, 14, 117, 117, 117, 117, 117,
- 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,
- 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,
- 117, 117, 117, 117, 117, 0, 117, 0, 0, 0, 0, 0, 117, 0, 0, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 3, 85, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
- 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
- 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
- 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 0, 0, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
- 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 91, 91, 14, 3, 3, 3, 91, 0, 0, 0, 0, 0,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 92, 92, 92, 92, 91, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 91, 92, 92, 92, 91, 92, 92, 92, 92, 92, 0, 0, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92,
+ 92, 92, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 15, 124,
+ 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 92, 124,
+ 124, 15, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 92, 92, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 91, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15,
+ 0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 0, 0,
+ 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 0, 15, 15,
+ 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15,
+ 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 0, 0, 0, 0, 0, 92, 92, 124, 0,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 0,
+ 0, 92, 0, 124, 124, 124, 92, 92, 0, 0, 0, 0, 92, 92, 0, 0, 92, 92,
+ 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 0, 0,
+ 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 15, 15, 15, 92,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 124, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124,
+ 124, 124, 92, 92, 92, 92, 92, 0, 92, 92, 124, 0, 124, 124, 92, 0, 0,
+ 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 92, 0,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, 0, 0, 0, 0, 15, 0,
+ 0, 0, 0, 0, 0, 0, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, 92, 124, 92,
+ 92, 92, 92, 0, 0, 124, 124, 0, 0, 124, 124, 92, 0, 0, 0, 0, 0, 0, 0,
+ 0, 92, 124, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 92, 15, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15,
+ 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0,
+ 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 124, 124, 92, 124, 124, 0, 0, 0, 124, 124,
+ 124, 0, 124, 124, 124, 92, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18,
+ 18, 18, 14, 14, 14, 14, 14, 14, 4, 14, 0, 0, 0, 0, 0, 92, 124, 124,
+ 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 0, 0, 15, 92, 92, 92, 124, 124, 124, 124, 0, 92, 92,
+ 92, 0, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 92, 92, 0, 15, 15, 15,
+ 0, 0, 0, 0, 0, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 14, 0, 92, 124,
+ 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 0, 0, 92, 15, 124, 92, 124, 124, 124, 124, 124, 0, 92, 124,
+ 124, 0, 124, 124, 92, 92, 0, 0, 0, 0, 0, 0, 0, 124, 124, 0, 0, 0, 0,
+ 0, 0, 0, 15, 0, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 0, 15, 124, 124, 124, 92, 92, 92, 92, 0, 124,
+ 124, 124, 0, 124, 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 15, 15, 15, 15, 15, 15,
+ 0, 0, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 0, 0, 0, 92, 0, 0, 0, 0, 124, 124, 124, 92, 92, 92, 0, 92, 0, 124,
+ 124, 124, 124, 124, 124, 124, 124, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 0, 0, 124, 124, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3,
- 3, 118, 118, 118, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15,
+ 15, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15,
+ 15, 91, 92, 92, 92, 92, 92, 92, 92, 92, 3, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0, 15, 15, 0, 15, 0, 0,
+ 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 15, 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15, 15, 15, 15, 92, 15,
+ 15, 92, 92, 92, 92, 92, 92, 0, 92, 92, 15, 0, 0, 15, 15, 15, 15, 15,
+ 0, 91, 0, 92, 92, 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 92, 92, 14, 14, 14, 14, 14, 14,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 14, 92, 14, 92, 14, 92, 5, 6, 5, 6, 124, 124, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 3, 92, 92, 15, 15, 15,
+ 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0,
+ 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 14, 14, 14, 14, 0, 14,
+ 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, 92, 92, 124, 92,
+ 92, 92, 92, 92, 92, 124, 92, 92, 124, 124, 92, 92, 15, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 124, 124,
+ 92, 92, 15, 15, 15, 15, 92, 92, 92, 15, 124, 124, 124, 15, 15, 124,
+ 124, 124, 124, 124, 124, 124, 15, 15, 15, 92, 92, 92, 92, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92, 124,
+ 124, 124, 124, 124, 124, 92, 15, 124, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 124, 124, 124, 92, 14, 14, 125, 125, 125, 125, 125, 125, 125, 125,
+ 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
+ 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
+ 125, 125, 0, 125, 0, 0, 0, 0, 0, 125, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 3, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15,
+ 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0,
+ 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
- 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 3, 3, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 92, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 126, 126,
+ 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
+ 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
+ 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
+ 126, 126, 126, 126, 104, 104, 104, 104, 104, 104, 0, 0, 110, 110, 110,
+ 110, 110, 110, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3,
+ 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 127, 127, 127, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 92, 92, 92, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
- 0, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86,
- 116, 86, 86, 86, 86, 86, 86, 86, 116, 116, 116, 116, 116, 116, 116,
- 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3,
- 3, 85, 3, 3, 3, 4, 15, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
- 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
- 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 2, 0, 9, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 3, 3, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 92, 92, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 124, 92, 92, 92, 92,
+ 92, 92, 92, 124, 124, 124, 124, 124, 124, 124, 124, 92, 124, 124, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 91, 3, 3, 3, 4, 15,
+ 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8,
+ 3, 3, 3, 3, 92, 92, 92, 17, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
+ 0, 0, 0, 0, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
- 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 92, 92, 92, 124, 124, 124, 124, 92, 92, 124, 124,
+ 124, 0, 0, 0, 0, 124, 124, 92, 124, 124, 124, 124, 124, 124, 92, 92,
+ 92, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, 86,
- 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, 116,
- 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15,
- 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, 116, 116, 116,
- 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15,
- 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
+ 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, 116, 116,
- 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, 86, 86,
- 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116,
- 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 86,
- 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3,
- 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86,
- 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116,
- 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, 116, 116,
- 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, 15, 15,
- 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, 116, 116,
- 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, 116, 116,
- 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116,
- 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
- 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, 3, 3,
- 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86,
- 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 92, 92, 124, 124, 92, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92,
+ 124, 92, 92, 92, 92, 92, 92, 92, 0, 92, 124, 92, 124, 124, 92, 92,
+ 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 0, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
+ 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3,
+ 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 0, 0, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 119, 0, 92, 92, 92, 92, 124, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 92, 92, 92,
+ 92, 124, 92, 124, 124, 124, 124, 124, 92, 124, 124, 15, 15, 15, 15,
+ 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3,
+ 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 92, 92, 124,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92,
+ 92, 124, 124, 92, 92, 124, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92,
+ 92, 124, 124, 124, 92, 124, 92, 92, 92, 124, 124, 0, 0, 0, 0, 0, 0,
+ 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 124, 124, 124, 124, 124, 124, 124,
+ 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 0, 0, 0, 3,
+ 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 91, 91, 91, 91, 91, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0,
+ 0, 0, 0, 0, 0, 0, 92, 92, 92, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 92,
+ 15, 15, 15, 15, 124, 124, 92, 15, 15, 0, 92, 92, 0, 0, 0, 0, 0, 0,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
- 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 91, 128, 21, 21, 21, 129, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, 86, 86,
- 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, 21,
- 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, 124,
- 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, 124,
- 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124,
- 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, 123,
- 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123,
- 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, 123,
- 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, 123,
- 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, 126,
- 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, 123,
- 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, 123,
- 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131,
- 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131,
- 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, 133,
- 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, 136,
- 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, 137,
- 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, 138,
- 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, 140,
- 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17,
+ 21, 21, 91, 91, 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 92,
+ 92, 92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 130, 21, 21, 131,
+ 21, 132, 132, 132, 132, 132, 132, 132, 132, 133, 133, 133, 133, 133,
+ 133, 133, 133, 132, 132, 132, 132, 132, 132, 0, 0, 133, 133, 133, 133,
+ 133, 133, 0, 0, 132, 132, 132, 132, 132, 132, 132, 132, 133, 133, 133,
+ 133, 133, 133, 133, 133, 132, 132, 132, 132, 132, 132, 132, 132, 133,
+ 133, 133, 133, 133, 133, 133, 133, 132, 132, 132, 132, 132, 132, 0,
+ 0, 133, 133, 133, 133, 133, 133, 0, 0, 21, 132, 21, 132, 21, 132, 21,
+ 132, 0, 133, 0, 133, 0, 133, 0, 133, 132, 132, 132, 132, 132, 132,
+ 132, 132, 133, 133, 133, 133, 133, 133, 133, 133, 134, 134, 135, 135,
+ 135, 135, 136, 136, 137, 137, 138, 138, 139, 139, 0, 0, 132, 132, 132,
+ 132, 132, 132, 132, 132, 140, 140, 140, 140, 140, 140, 140, 140, 132,
+ 132, 132, 132, 132, 132, 132, 132, 140, 140, 140, 140, 140, 140, 140,
+ 140, 132, 132, 132, 132, 132, 132, 132, 132, 140, 140, 140, 140, 140,
+ 140, 140, 140, 132, 132, 21, 141, 21, 0, 21, 21, 133, 133, 142, 142,
+ 143, 11, 144, 11, 11, 11, 21, 141, 21, 0, 21, 21, 145, 145, 145, 145,
+ 143, 11, 11, 11, 132, 132, 21, 21, 0, 0, 21, 21, 133, 133, 146, 146,
+ 0, 11, 11, 11, 132, 132, 21, 21, 21, 113, 21, 21, 133, 133, 147, 147,
+ 117, 11, 11, 11, 0, 0, 21, 141, 21, 0, 21, 21, 148, 148, 149, 149,
+ 143, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17,
8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3,
- 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 150, 151, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3,
16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17,
- 17, 17, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, 18, 18,
- 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
- 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
- 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, 100,
- 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, 100,
- 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, 100,
- 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, 21,
- 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, 147,
+ 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 91, 0, 0, 18,
+ 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 91, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 7, 7, 7, 5, 6, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
+ 91, 91, 91, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 119, 119, 119, 119, 92, 119, 119, 119, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 14, 14, 107, 14, 14, 14, 14, 107, 14, 14, 21, 107, 107, 107,
+ 21, 21, 107, 107, 107, 21, 14, 107, 14, 14, 7, 107, 107, 107, 107,
+ 107, 14, 14, 14, 14, 14, 14, 107, 14, 152, 14, 107, 14, 153, 154, 107,
+ 107, 14, 21, 107, 107, 155, 107, 21, 15, 15, 15, 15, 21, 14, 14, 21,
+ 21, 107, 107, 7, 7, 7, 7, 7, 107, 21, 21, 21, 21, 14, 7, 14, 14, 156,
14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148,
- 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149,
- 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, 18,
- 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14,
+ 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157,
+ 157, 157, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+ 158, 158, 158, 158, 127, 127, 127, 23, 24, 127, 127, 127, 127, 18,
+ 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14,
14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7,
@@ -903,7 +910,7 @@ static const unsigned char groupMap[] = {
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14,
- 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14,
14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
@@ -914,209 +921,225 @@ static const unsigned char groupMap[] = {
7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 150, 150, 150, 150, 150, 150, 150, 150,
- 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150,
- 150, 150, 150, 150, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151,
- 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151,
- 151, 151, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 160, 160, 160, 160, 160, 160, 160, 160, 160,
+ 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160,
+ 160, 160, 160, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7,
+ 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18,
+ 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6,
- 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
- 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 0, 0, 0, 0, 0, 0, 114, 114, 114, 114, 114, 114, 114, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
- 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 115, 115,
- 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
- 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
- 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
- 115, 115, 115, 0, 23, 24, 152, 153, 154, 155, 156, 23, 24, 23, 24,
- 23, 24, 157, 158, 159, 160, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21,
- 21, 85, 85, 161, 161, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23,
- 24, 23, 24, 86, 86, 86, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3,
- 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162,
- 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162,
- 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 0, 162, 0, 0, 0,
- 0, 0, 162, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 85,
- 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
- 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
- 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6,
- 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 8, 8, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14,
+ 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
+ 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
- 0, 0, 0, 2, 3, 3, 3, 14, 85, 15, 118, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
- 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 118, 118, 118, 118,
- 118, 118, 118, 118, 118, 86, 86, 86, 86, 116, 116, 8, 85, 85, 85, 85,
- 85, 14, 14, 118, 118, 118, 85, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 0, 0, 86, 86, 11, 11, 85, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14,
+ 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 122, 122, 122, 122, 122, 122, 122,
+ 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
+ 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
+ 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 0, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
+ 123, 123, 123, 123, 0, 23, 24, 161, 162, 163, 164, 165, 23, 24, 23,
+ 24, 23, 24, 166, 167, 168, 169, 21, 23, 24, 21, 23, 24, 21, 21, 21,
+ 21, 21, 91, 91, 170, 170, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14,
+ 23, 24, 23, 24, 92, 92, 92, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18,
+ 3, 3, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171,
+ 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171,
+ 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 0, 171, 0, 0,
+ 0, 0, 0, 171, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
+ 91, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5,
+ 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 91, 15,
+ 127, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6,
+ 8, 5, 6, 6, 14, 127, 127, 127, 127, 127, 127, 127, 127, 127, 92, 92,
+ 92, 92, 124, 124, 8, 91, 91, 91, 91, 91, 14, 14, 127, 127, 127, 91,
+ 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 11, 11, 91, 91,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 91, 91, 91, 15, 0, 0,
+ 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 3, 85, 85, 85, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
- 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14,
- 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18,
- 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, 15, 15,
+ 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 3, 3, 3, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 3, 3, 3, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 15, 86, 111, 111, 111, 3, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 3, 85, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
- 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15,
- 15, 15, 15, 15, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 86,
- 86, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11,
+ 24, 15, 92, 119, 119, 119, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 3, 91, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 91, 92, 92,
+ 15, 15, 15, 15, 15, 15, 127, 127, 127, 127, 127, 127, 127, 127, 127,
+ 127, 92, 92, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11,
11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
- 85, 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 23, 24, 23, 24, 23, 24,
- 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23,
- 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
- 23, 24, 23, 24, 23, 24, 85, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24,
- 23, 24, 163, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 85, 11, 11, 23,
- 24, 164, 21, 0, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 165, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 85, 21, 15, 15, 15, 15,
- 15, 15, 15, 86, 15, 15, 15, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 116, 116, 86, 86, 116, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18,
- 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3,
- 3, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 116, 116, 116, 116,
- 116, 116, 116, 116, 116, 116, 116, 116, 116, 86, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 86, 116, 116, 86, 86, 86, 86, 116, 116, 86,
- 116, 116, 116, 116, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 85, 9,
- 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 86, 86, 86, 86, 86, 86, 116, 116, 86, 86, 116, 116, 86,
- 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 86, 15, 15, 15, 15, 15,
- 15, 15, 15, 86, 116, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3,
- 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 85, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 116, 0, 0, 0, 0, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 86,
- 86, 86, 15, 15, 86, 86, 15, 15, 15, 15, 15, 86, 86, 15, 86, 15, 0,
+ 11, 11, 11, 91, 91, 91, 91, 91, 91, 91, 91, 91, 11, 11, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 21, 21, 21, 21, 21, 21, 21,
+ 21, 23, 24, 23, 24, 172, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91,
+ 11, 11, 23, 24, 173, 21, 15, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 174,
+ 175, 176, 177, 0, 0, 178, 179, 180, 181, 23, 24, 23, 24, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 15, 15, 85, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116,
- 86, 86, 116, 116, 3, 3, 15, 85, 85, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
- 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 116, 116, 86, 116, 116, 86, 116, 116,
- 3, 116, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15,
- 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 0, 0, 0, 0, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166,
- 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166,
- 166, 166, 166, 166, 166, 166, 166, 166, 167, 167, 167, 167, 167, 167,
- 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167,
- 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
+ 0, 0, 0, 0, 15, 91, 91, 21, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15,
+ 15, 92, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92,
+ 124, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4,
+ 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 124, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
+ 124, 124, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 3, 3, 3,
+ 15, 3, 15, 0, 0, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92,
+ 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 124, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92,
+ 92, 92, 124, 124, 92, 124, 124, 124, 124, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 0, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3,
+ 15, 15, 15, 15, 15, 92, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 124, 124,
+ 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15,
+ 15, 15, 15, 15, 92, 124, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
+ 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 91, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 124, 92, 124, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 92, 15, 92, 92, 92, 15, 15, 92, 92, 15, 15, 15, 15, 15, 92, 92, 15,
+ 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 15, 15, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 124, 92, 92, 124, 124, 3, 3, 15, 91, 91, 124, 92, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
+ 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 182, 21, 21, 21,
+ 21, 21, 21, 21, 11, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
+ 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
+ 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
+ 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 15, 15, 15, 124,
+ 124, 92, 124, 124, 92, 124, 124, 3, 124, 92, 0, 0, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15,
- 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15,
- 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 184, 184, 184,
+ 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184,
+ 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184,
+ 184, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185,
+ 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185,
+ 185, 185, 185, 185, 185, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11,
- 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21,
+ 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21,
+ 21, 21, 21, 0, 0, 0, 0, 0, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 6, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 4,
+ 14, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 3, 3, 3, 3, 3, 3, 3, 5, 6, 3, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 8, 8, 12, 12, 5,
+ 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3,
+ 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7,
+ 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 86, 86, 86, 86, 86,
- 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 5,
- 6, 3, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
- 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3,
- 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0,
- 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4,
- 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3,
- 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5,
- 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0,
- 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
- 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0
+ 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3,
+ 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 91, 91, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
+ 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4,
+ 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 17, 17, 17, 14, 14, 0, 0
#if TCL_UTF_MAX > 3
,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
@@ -1127,213 +1150,308 @@ static const unsigned char groupMap[] = {
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
- 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
- 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
- 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 18,
+ 14, 14, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
+ 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
+ 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
+ 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 18,
18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 18, 18, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 0, 0, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 118, 15, 15, 15, 15, 15, 15, 15, 15, 118, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 127, 15, 15, 15, 15, 15, 15, 15, 15,
+ 127, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15,
+ 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 127, 127, 127,
+ 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 186, 186, 186, 186, 186, 186,
+ 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186,
+ 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186,
+ 186, 186, 186, 186, 186, 186, 187, 187, 187, 187, 187, 187, 187, 187,
+ 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187,
+ 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187,
+ 187, 187, 187, 187, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, 0, 0, 0,
- 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 118, 118, 118, 118, 118, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 168, 168, 168, 168, 168, 168, 168, 168, 168,
- 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
- 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
- 168, 168, 168, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
- 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
- 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
- 169, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
+ 0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18,
+ 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18,
+ 18, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0,
+ 0, 0, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18,
+ 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 92, 92, 92, 0, 92, 92,
+ 0, 0, 0, 0, 0, 92, 92, 92, 92, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 0, 0, 0,
+ 0, 92, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 18, 18, 18,
+ 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18,
+ 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18,
+ 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 97,
+ 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
+ 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
+ 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 124, 92, 124, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, 0, 0, 15, 15, 15,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3,
+ 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92,
+ 92, 124, 124, 92, 92, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15,
+ 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 15,
- 15, 15, 86, 86, 86, 0, 86, 86, 0, 0, 0, 0, 0, 86, 86, 86, 86, 15, 15,
- 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
- 0, 0, 0, 86, 86, 86, 0, 0, 0, 0, 86, 18, 18, 18, 18, 18, 18, 18, 18,
- 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0,
- 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15,
+ 15, 92, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 15, 15, 15, 15, 3, 3,
+ 3, 3, 3, 92, 92, 92, 3, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3,
+ 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
- 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18,
- 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 116, 86, 116, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 124, 124,
+ 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 0,
+ 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3,
- 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 86,
- 86, 86, 86, 116, 116, 86, 86, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
- 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86, 86,
- 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 92, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 124, 124, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 124, 124, 0, 0, 124,
+ 124, 0, 0, 124, 124, 124, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 124, 124, 0, 0, 92, 92, 92, 92, 92, 92, 92,
+ 0, 0, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
+ 92, 92, 92, 92, 92, 92, 124, 92, 124, 124, 124, 124, 92, 92, 124, 92,
+ 92, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 124,
+ 124, 92, 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
+ 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 124, 92, 92, 3, 3, 3,
+ 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124,
+ 92, 124, 124, 92, 92, 92, 92, 92, 92, 124, 92, 0, 0, 0, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 92, 92, 92, 124, 124,
+ 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86, 86,
- 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 127, 127, 127, 127, 127, 127,
+ 127, 127, 127, 127, 127, 127, 127, 127, 127, 0, 3, 3, 3, 3, 3, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 15, 15,
- 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
- 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 116, 86, 0, 0, 0, 0, 0,
- 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 118, 118, 118, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
- 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 116, 116,
- 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
- 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
- 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
- 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86,
- 86, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 15, 15, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 116, 116, 86, 86, 86, 14, 14, 14, 116,
- 116, 116, 116, 116, 116, 17, 17, 17, 17, 17, 17, 17, 17, 86, 86, 86,
- 86, 86, 86, 86, 86, 14, 14, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 92, 92, 92, 92, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 3, 3, 14, 14, 14, 14, 91, 91,
+ 91, 91, 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 124, 124, 124, 124,
+ 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
+ 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
+ 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 91,
+ 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 15, 15, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 0, 14, 92, 92, 3, 17, 17, 17, 17, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 86, 86, 86, 14, 14, 14,
+ 14, 14, 14, 124, 124, 92, 92, 92, 14, 14, 14, 124, 124, 124, 124, 124,
+ 124, 17, 17, 17, 17, 17, 17, 17, 17, 92, 92, 92, 92, 92, 92, 92, 92,
+ 14, 14, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 86, 86, 86,
- 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21,
+ 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 14, 14, 92, 92, 92, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21,
- 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 0,
- 100, 100, 0, 0, 100, 0, 0, 100, 100, 0, 0, 100, 100, 100, 100, 0, 100,
- 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 0, 21, 0, 21, 21,
- 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100, 100, 100, 0, 0,
- 100, 100, 100, 100, 100, 100, 100, 100, 0, 100, 100, 100, 100, 100,
- 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100,
- 100, 100, 0, 100, 100, 100, 100, 100, 0, 100, 0, 0, 0, 100, 100, 100,
- 100, 100, 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 107, 0, 107, 107, 0, 0, 107, 0, 0, 107, 107, 0, 0,
+ 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 107, 107, 107, 21,
+ 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 0,
+ 107, 107, 107, 107, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 0,
+ 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21,
+ 21, 107, 107, 0, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 0,
+ 107, 0, 0, 0, 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 0, 0, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7,
- 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21,
+ 21, 21, 21, 21, 21, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21,
- 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21,
+ 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
- 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 21, 0, 0, 9, 9, 9, 9, 9, 9,
+ 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21,
+ 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107,
+ 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
- 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
- 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
- 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0,
- 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15,
- 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15,
- 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15,
- 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14,
+ 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
+ 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 92, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92,
+ 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15,
+ 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0,
+ 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15,
+ 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
- 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
- 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 14, 14, 14, 14, 14,
+ 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11, 14,
+ 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
+ 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14,
- 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
- 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0
+ 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
#endif /* TCL_UTF_MAX > 3 */
};
@@ -1361,19 +1479,22 @@ static const int groups[] = {
53057, -24702, 54081, 53569, -41598, 54593, -33150, 54849, 55873,
55617, 56129, -14206, 609, 451, 674, 20354, -24767, -14271, -33215,
2763585, -41663, 2762817, -2768510, -49855, 17729, 18241, -2760318,
- -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, 53122,
- -10823550, -10830718, 53634, 54146, -2750078, -2751614, 54658,
- 54914, -2745982, 55938, 17794, 55682, 18306, 56194, 4, 6, -21370,
- 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113,
- 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, -15295,
- 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418, 8, 1859649,
- 10, -9044862, -976254, 15234, -1949375, -1918, -1983, -18814,
- -21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879,
- -2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14,
- -1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813,
- -2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679,
- -2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -10830783,
- 18, 17, 10305, 10370
+ -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, -10833534,
+ -10832510, 53122, -10823550, -10830718, 53634, 54146, -2750078,
+ -10829950, -2751614, 54658, 54914, -2745982, 55938, -10824062,
+ 17794, 55682, 18306, 56194, -10818686, -10817918, 4, 6, -21370,
+ 29761, 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258,
+ 2113, 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662,
+ 29826, -15295, 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418,
+ 8, 1859649, 9949249, 10, -9044862, -976254, 15234, -1949375, -1918,
+ -1983, -18814, -21886, -25470, -32638, -28542, -32126, -1981,
+ -2174, -18879, -2237, 1844610, -21951, -25535, -28607, -32703,
+ -32191, 13, 14, -1924287, -2145983, -2115007, 7233, 7298, 4170,
+ 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650, 2762882,
+ -2759615, -2751679, -2760383, -2760127, -2768575, 1859714, -9044927,
+ -10823615, -10830783, -10833599, -10832575, -10830015, -10817983,
+ -10824127, -10818751, 237633, 237698, 9949314, 18, 17, 10305,
+ 10370
};
#if TCL_UTF_MAX > 3
@@ -1435,4 +1556,8 @@ enum {
* Unicode character tables.
*/
-#define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#if TCL_UTF_MAX > 3
+# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1fffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#else
+# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#endif
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 15529c7..b878149 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -117,19 +117,10 @@ UtfCount(
if (ch <= 0x7FF) {
return 2;
}
- if (ch <= 0xFFFF) {
- return 3;
- }
#if TCL_UTF_MAX > 3
- if (ch <= 0x1FFFFF) {
+ if ((ch > 0xFFFF) && (ch <= 0x10FFFF)) {
return 4;
}
- if (ch <= 0x3FFFFFF) {
- return 5;
- }
- if (ch <= 0x7FFFFFFF) {
- return 6;
- }
#endif
return 3;
}
@@ -172,6 +163,23 @@ Tcl_UniCharToUtf(
return 2;
}
if (ch <= 0xFFFF) {
+#if TCL_UTF_MAX == 4
+ if ((ch & 0xF800) == 0xD800) {
+ if (ch & 0x0400) {
+ /* Low surrogate */
+ buf[3] = (char) ((ch | 0x80) & 0xBF);
+ buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
+ return 4;
+ } else {
+ /* High surrogate */
+ ch += 0x40;
+ buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
+ buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
+ buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
+ return 0;
+ }
+ }
+#endif
three:
buf[2] = (char) ((ch | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
@@ -180,30 +188,13 @@ Tcl_UniCharToUtf(
}
#if TCL_UTF_MAX > 3
- if (ch <= 0x1FFFFF) {
+ if (ch <= 0x10FFFF) {
buf[3] = (char) ((ch | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 18) | 0xF0);
return 4;
}
- if (ch <= 0x3FFFFFF) {
- buf[4] = (char) ((ch | 0x80) & 0xBF);
- buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
- buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
- buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
- buf[0] = (char) ((ch >> 24) | 0xF8);
- return 5;
- }
- if (ch <= 0x7FFFFFFF) {
- buf[5] = (char) ((ch | 0x80) & 0xBF);
- buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
- buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
- buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
- buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
- buf[0] = (char) ((ch >> 30) | 0xFC);
- return 6;
- }
#endif
}
@@ -1365,6 +1356,11 @@ int
Tcl_UniCharIsAlnum(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}
@@ -1388,6 +1384,11 @@ int
Tcl_UniCharIsAlpha(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}
@@ -1411,6 +1412,18 @@ int
Tcl_UniCharIsControl(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ if ((ch == 0xe0001) || ((ch >= 0xe0020) && (ch <= 0xe007f))) {
+ return 1;
+ }
+ if ((ch >= 0xf0000) && ((ch & 0xffff) <= 0xfffd)) {
+ return 1;
+ }
+ return 0;
+ }
+#endif
return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}
@@ -1434,6 +1447,11 @@ int
Tcl_UniCharIsDigit(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}
@@ -1457,6 +1475,12 @@ int
Tcl_UniCharIsGraph(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ return (ch >= 0xe0100) && (ch <= 0xe01ef);
+ }
+#endif
return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}
@@ -1480,6 +1504,11 @@ int
Tcl_UniCharIsLower(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == LOWERCASE_LETTER);
}
@@ -1503,6 +1532,12 @@ int
Tcl_UniCharIsPrint(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ return (ch >= 0xe0100) && (ch <= 0xe01ef);
+ }
+#endif
return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}
@@ -1526,6 +1561,11 @@ int
Tcl_UniCharIsPunct(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}
@@ -1549,16 +1589,27 @@ int
Tcl_UniCharIsSpace(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ /* Ignore upper 11 bits. */
+ ch &= 0x1fffff;
+#else
+ /* Ignore upper 16 bits. */
+ ch &= 0xffff;
+#endif
+
/*
* If the character is within the first 127 characters, just use the
* standard C function, otherwise consult the Unicode table.
*/
- if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
+ if (ch < 0x80) {
return TclIsSpaceProc((char) ch);
- } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
- || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
- || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
+#if TCL_UTF_MAX > 3
+ } else if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+#endif
+ } else if (ch == 0x0085 || ch == 0x180e || ch == 0x200b
+ || ch == 0x202f || ch == 0x2060 || ch == 0xfeff) {
return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
@@ -1585,6 +1636,11 @@ int
Tcl_UniCharIsUpper(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == UPPERCASE_LETTER);
}
@@ -1608,6 +1664,11 @@ int
Tcl_UniCharIsWordChar(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((WORD_BITS >> GetCategory(ch)) & 1);
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 27e2474..2b0fb72 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -14,6 +14,7 @@
#include "tclInt.h"
#include "tclParse.h"
+#include "tclStringTrim.h"
#include <math.h>
/*
@@ -81,7 +82,7 @@ static ProcessGlobalValue executableName = {
* in other cases this means an overestimate of the
* required size.
*
- * For more details, see the comments on the Tcl*Scan*Element and
+ * For more details, see the comments on the Tcl*Scan*Element and
* Tcl*Convert*Element routines.
*/
@@ -110,7 +111,11 @@ static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int SetEndOffsetFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
-
+static int FindElement(Tcl_Interp *interp, const char *string,
+ int stringLength, const char *typeStr,
+ const char *typeCode, const char **elementPtr,
+ const char **nextPtr, int *sizePtr,
+ int *literalPtr);
/*
* The following is the Tcl object type definition for an object that
* represents a list index in the form, "end-offset". It is used as a
@@ -175,7 +180,7 @@ const Tcl_ObjType tclEndOffsetType = {
*
* NOTE: This means that if and when backslash substitution rules ever change
* for command parsing, the interpretation of strings as lists also changes.
- *
+ *
* Backslash substitution replaces an "escape sequence" of one or more
* characters starting with
* \u005c \ BACKSLASH
@@ -188,7 +193,7 @@ const Tcl_ObjType tclEndOffsetType = {
*
* * If the first character of a formatted substring is
* \u007b { OPEN BRACE
- * then the end of the substring is the matching
+ * then the end of the substring is the matching
* \u007d } CLOSE BRACE
* character, where matching is determined by counting nesting levels, and
* not including any brace characters that are contained within a backslash
@@ -210,7 +215,7 @@ const Tcl_ObjType tclEndOffsetType = {
* includes an unbalanced brace not in a backslash escape sequence, and any
* value that ends with a backslash not itself in a backslash escape
* sequence.
- *
+ *
* * If the first character of a formatted substring is
* \u0022 " QUOTE
* then the end of the substring is the next QUOTE character, not counting
@@ -236,7 +241,7 @@ const Tcl_ObjType tclEndOffsetType = {
* of either braces or quotes to delimit it.
*
* This collection of parsing rules is implemented in the routine
- * TclFindElement().
+ * FindElement().
*
* In order to produce lists that can be parsed by these rules, we need the
* ability to distinguish between characters that are part of a list element
@@ -337,7 +342,7 @@ const Tcl_ObjType tclEndOffsetType = {
* directives. This makes it easy to experiment with eliminating this
* formatting mode simply with "#define COMPAT 0" above. I believe this is
* worth considering.
- *
+ *
* Another consideration is the treatment of QUOTE characters in list
* elements. TclConvertElement() must have the ability to produce the escape
* sequence \" so that when a list element begins with a QUOTE we do not
@@ -397,7 +402,7 @@ TclMaxListLength(
* No list element before leading white space.
*/
- count += 1 - TclIsSpaceProc(*bytes);
+ count += 1 - TclIsSpaceProc(*bytes);
/*
* Count white space runs as potential element separators.
@@ -433,7 +438,7 @@ TclMaxListLength(
* No list element following trailing white space.
*/
- count -= TclIsSpaceProc(bytes[-1]);
+ count -= TclIsSpaceProc(bytes[-1]);
done:
if (endPtr) {
@@ -501,12 +506,73 @@ TclFindElement(
* indicate that the substring of *sizePtr
* bytes starting at **elementPtr is/is not
* the literal list element and therefore
- * does not/does require a call to
+ * does not/does require a call to
* TclCopyAndCollapse() by the caller. */
{
- const char *p = list;
+ return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
+ nextPtr, sizePtr, literalPtr);
+}
+
+int
+TclFindDictElement(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ const char *dict, /* Points to the first byte of a string
+ * containing a Tcl dictionary with zero or
+ * more keys and values (possibly in
+ * braces). */
+ int dictLength, /* Number of bytes in the dict's string. */
+ const char **elementPtr, /* Where to put address of first significant
+ * character in the first element (i.e., key
+ * or value) of dict. */
+ const char **nextPtr, /* Fill in with location of character just
+ * after all white space following end of
+ * element (next arg or end of list). */
+ int *sizePtr, /* If non-zero, fill in with size of
+ * element. */
+ int *literalPtr) /* If non-zero, fill in with non-zero/zero to
+ * indicate that the substring of *sizePtr
+ * bytes starting at **elementPtr is/is not
+ * the literal key or value and therefore
+ * does not/does require a call to
+ * TclCopyAndCollapse() by the caller. */
+{
+ return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
+ elementPtr, nextPtr, sizePtr, literalPtr);
+}
+
+static int
+FindElement(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ const char *string, /* Points to the first byte of a string
+ * containing a Tcl list or dictionary with
+ * zero or more elements (possibly in
+ * braces). */
+ int stringLength, /* Number of bytes in the string. */
+ const char *typeStr, /* The name of the type of thing we are
+ * parsing, for error messages. */
+ const char *typeCode, /* The type code for thing we are parsing, for
+ * error messages. */
+ const char **elementPtr, /* Where to put address of first significant
+ * character in first element. */
+ const char **nextPtr, /* Fill in with location of character just
+ * after all white space following end of
+ * argument (next arg or end of list/dict). */
+ int *sizePtr, /* If non-zero, fill in with size of
+ * element. */
+ int *literalPtr) /* If non-zero, fill in with non-zero/zero to
+ * indicate that the substring of *sizePtr
+ * bytes starting at **elementPtr is/is not
+ * the literal list/dict element and therefore
+ * does not/does require a call to
+ * TclCopyAndCollapse() by the caller. */
+{
+ const char *p = string;
const char *elemStart; /* Points to first byte of first element. */
- const char *limit; /* Points just after list's last byte. */
+ const char *limit; /* Points just after list/dict's last byte. */
int openBraces = 0; /* Brace nesting level during parse. */
int inQuotes = 0;
int size = 0; /* lint. */
@@ -516,11 +582,11 @@ TclFindElement(
/*
* Skim off leading white space and check for an opening brace or quote.
- * We treat embedded NULLs in the list as bytes belonging to a list
- * element.
+ * We treat embedded NULLs in the list/dict as bytes belonging to a list
+ * element (or dictionary key or value).
*/
- limit = (list + listLength);
+ limit = (string + stringLength);
while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
@@ -581,9 +647,9 @@ TclFindElement(
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "list element in braces followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ "%s element in braces followed by \"%.*s\" "
+ "instead of space", typeStr, (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
NULL);
}
return TCL_ERROR;
@@ -650,9 +716,9 @@ TclFindElement(
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "list element in quotes followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ "%s element in quotes followed by \"%.*s\" "
+ "instead of space", typeStr, (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
NULL);
}
return TCL_ERROR;
@@ -663,23 +729,23 @@ TclFindElement(
}
/*
- * End of list: terminate element.
+ * End of list/dict: terminate element.
*/
if (p == limit) {
if (openBraces != 0) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched open brace in list", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unmatched open brace in %s", typeStr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
NULL);
}
return TCL_ERROR;
} else if (inQuotes) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched open quote in list", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unmatched open quote in %s", typeStr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
NULL);
}
return TCL_ERROR;
@@ -968,7 +1034,7 @@ TclScanElement(
int preferBrace = 0; /* CONVERT_MASK mode. */
int braceCount = 0; /* Count of all braces '{' '}' seen. */
#endif /* COMPAT */
-
+
if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
/*
* Empty string element must be brace quoted.
@@ -1046,7 +1112,7 @@ TclScanElement(
* Final backslash. Cannot format with brace quoting.
*/
- requireEscape = 1;
+ requireEscape = 1;
break;
}
if (p[1] == '\n') {
@@ -1440,7 +1506,7 @@ TclConvertElement(
return p - dst;
}
- /*
+ /*
* If we reach this point, there's an embedded NULL in the string
* range being processed, which should not happen when the
* encoding rules for Tcl strings are properly followed. If the
@@ -1768,8 +1834,7 @@ TclTrimLeft(
*/
/* The whitespace characters trimmed during [concat] operations */
-#define CONCAT_WS " \f\v\r\t\n"
-#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
char *
Tcl_Concat(
@@ -1817,7 +1882,7 @@ Tcl_Concat(
for (p = result, i = 0; i < argc; i++) {
int trim, elemLength;
const char *element;
-
+
element = argv[i];
elemLength = strlen(argv[i]);
@@ -1825,7 +1890,8 @@ Tcl_Concat(
* Trim away the leading whitespace.
*/
- trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1834,7 +1900,8 @@ Tcl_Concat(
* a final backslash character.
*/
- trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
@@ -1914,7 +1981,11 @@ Tcl_ConcatObj(
continue;
}
if (resPtr) {
- Tcl_ListObjAppendList(NULL, resPtr, objPtr);
+ if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
+ /* Abandon ship! */
+ Tcl_DecrRefCount(resPtr);
+ goto slow;
+ }
} else {
resPtr = TclListObjCopy(NULL, objPtr);
}
@@ -1925,6 +1996,7 @@ Tcl_ConcatObj(
return resPtr;
}
+ slow:
/*
* Something cannot be determined to be safe, so build the concatenation
* the slow way, using the string representations.
@@ -1947,19 +2019,20 @@ Tcl_ConcatObj(
*/
TclNewObj(resPtr);
- Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
+ (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
Tcl_SetObjLength(resPtr, 0);
for (i = 0; i < objc; i++) {
int trim;
-
+
element = TclGetStringFromObj(objv[i], &elemLength);
/*
* Trim away the leading whitespace.
*/
- trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1968,7 +2041,8 @@ Tcl_ConcatObj(
* a final backslash character.
*/
- trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
@@ -2934,7 +3008,7 @@ TclDStringToObj(
/*
* Static buffer, so must copy.
*/
-
+
TclNewStringObj(result, dsPtr->string, dsPtr->length);
}
} else {
@@ -3052,7 +3126,7 @@ Tcl_PrintDouble(
/*
* Handle NaN.
*/
-
+
if (TclIsNaN(value)) {
TclFormatNaN(value, dst);
return;
@@ -3061,12 +3135,12 @@ Tcl_PrintDouble(
/*
* Handle infinities.
*/
-
+
if (TclIsInfinite(value)) {
/*
* Remember to copy the terminating NUL too.
*/
-
+
if (value < 0) {
memcpy(dst, "-Inf", 5);
} else {
@@ -3078,7 +3152,7 @@ Tcl_PrintDouble(
/*
* Ordinary (normal and denormal) values.
*/
-
+
if (*precisionPtr == 0) {
digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
&exponent, &signum, &end);
@@ -3123,7 +3197,7 @@ Tcl_PrintDouble(
*/
digits = TclDoubleDigits(value, *precisionPtr,
- TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
+ TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
&exponent, &signum, &end);
}
if (signum) {
@@ -3134,7 +3208,7 @@ Tcl_PrintDouble(
/*
* E format for numbers < 1e-3 or >= 1e17.
*/
-
+
*dst++ = *p++;
c = *p;
if (c != '\0') {
@@ -3159,7 +3233,7 @@ Tcl_PrintDouble(
/*
* F format for others.
*/
-
+
if (exponent < 0) {
*dst++ = '0';
}
@@ -3580,10 +3654,9 @@ UpdateStringOfEndOffset(
register Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + 5];
- register int len;
+ register int len = 3;
memcpy(buffer, "end", 4);
- len = sizeof("end") - 1;
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
@@ -4181,7 +4254,8 @@ TclReToGlob(
const char *reStr,
int reStrLen,
Tcl_DString *dsPtr,
- int *exactPtr)
+ int *exactPtr,
+ int *quantifiersFoundPtr)
{
int anchorLeft, anchorRight, lastIsStar, numStars;
char *dsStr, *dsStrStart;
@@ -4189,6 +4263,9 @@ TclReToGlob(
strEnd = reStr + reStrLen;
Tcl_DStringInit(dsPtr);
+ if (quantifiersFoundPtr != NULL) {
+ *quantifiersFoundPtr = 0;
+ }
/*
* "***=xxx" == "*xxx*", watch for glob-sensitive chars.
@@ -4301,6 +4378,9 @@ TclReToGlob(
}
break;
case '.':
+ if (quantifiersFoundPtr != NULL) {
+ *quantifiersFoundPtr = 1;
+ }
anchorLeft = 0; /* prevent exact match */
if (p+1 < strEnd) {
if (p[1] == '*') {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index af1a563..5574f30 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -215,9 +215,9 @@ static Tcl_SetFromAnyProc PanicOnSetVarName;
* Types of Tcl_Objs used to cache variable lookups.
*
* localVarName - INTERNALREP DEFINITION:
- * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache
+ * twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache
* or NULL if it is this same obj
- * ptrAndLongRep.value: index into locals table
+ * twoPtrValue.ptr2: index into locals table
*
* nsVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the namespace containing the reference
@@ -235,25 +235,6 @@ static const Tcl_ObjType localVarNameType = {
FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
};
-/*
- * Caching of namespace variables disabled: no simple way was found to avoid
- * interfering with the resolver's idea of variable existence. A cached
- * varName may keep a variable's name in the namespace's hash table, which is
- * the resolver's criterion for existence (see test namespace-17.10).
- */
-
-#define ENABLE_NS_VARNAME_CACHING 0
-
-#if ENABLE_NS_VARNAME_CACHING
-static Tcl_FreeInternalRepProc FreeNsVarName;
-static Tcl_DupInternalRepProc DupNsVarName;
-
-static const Tcl_ObjType tclNsVarNameType = {
- "namespaceVarName",
- FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
-};
-#endif
-
static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
@@ -554,32 +535,15 @@ TclObjLookupVarEx(
const Tcl_ObjType *typePtr = part1Ptr->typePtr;
const char *errMsg = NULL;
CallFrame *varFramePtr = iPtr->varFramePtr;
-#if ENABLE_NS_VARNAME_CACHING
- Namespace *nsPtr;
-#endif
const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
char *newPart2 = NULL;
-
*arrayPtrPtr = NULL;
-#if ENABLE_NS_VARNAME_CACHING
- if (varFramePtr) {
- nsPtr = varFramePtr->nsPtr;
- } else {
- /*
- * Some variables in the global ns have to be initialized before the
- * root call frame is in place.
- */
-
- nsPtr = NULL;
- }
-#endif
-
if (typePtr == &localVarNameType) {
int localIndex;
localVarNameTypeHandling:
- localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
+ localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -587,7 +551,7 @@ TclObjLookupVarEx(
* Use the cached index if the names coincide.
*/
- Tcl_Obj *namePtr = part1Ptr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -597,44 +561,6 @@ TclObjLookupVarEx(
}
}
goto doneParsing;
-#if ENABLE_NS_VARNAME_CACHING
- } else if (typePtr == &tclNsVarNameType) {
- int useGlobal, useReference;
- Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1;
- varPtr = part1Ptr->internalRep.twoPtrValue.ptr2;
-
- useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
- (flags & TCL_GLOBAL_ONLY) ||
- (part1[0]==':' && part1[1]==':') ||
- (!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr)));
-
- useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
- (flags & TCL_NAMESPACE_ONLY) ||
- (!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) &&
- /*
- * Careful: an undefined ns variable could be hiding a valid
- * global reference.
- */
- !TclIsVarUndefined(varPtr))));
-
- if (useReference && !TclIsVarDeadHash(varPtr)) {
- /*
- * A straight global or namespace reference, use it. It isn't so
- * simple to deal with 'implicit' namespace references, i.e.,
- * those where the reference could be to either a namespace or a
- * global variable. Those we lookup again.
- *
- * If TclIsVarDeadHash(varPtr), this might be a reference to a
- * variable in a deleted namespace, kept alive by e.g. part1Ptr.
- * We could conceivably be so unlucky that a new namespace was
- * created at the same address as the deleted one, so to be safe
- * we test for a valid hPtr.
- */
-
- goto donePart1;
- }
- goto doneParsing;
-#endif
}
/*
@@ -674,7 +600,7 @@ TclObjLookupVarEx(
}
part1 = TclGetStringFromObj(part1Ptr, &len1);
- if (!parsed && (*(part1 + len1 - 1) == ')')) {
+ if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {
/*
* part1Ptr is possibly an unparsed array element.
*/
@@ -771,31 +697,20 @@ TclObjLookupVarEx(
/*
* An indexed local variable.
*/
+ Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);
part1Ptr->typePtr = &localVarNameType;
- if (part1Ptr != localName(iPtr->varFramePtr, index)) {
- part1Ptr->internalRep.ptrAndLongRep.ptr =
- localName(iPtr->varFramePtr, index);
- Tcl_IncrRefCount((Tcl_Obj *)
- part1Ptr->internalRep.ptrAndLongRep.ptr);
+ if (part1Ptr != cachedNamePtr) {
+ part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
+ Tcl_IncrRefCount(cachedNamePtr);
+ if (cachedNamePtr->typePtr != &localVarNameType
+ || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
+ TclFreeIntRep(cachedNamePtr);
+ }
} else {
- part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
+ part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
}
- part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
-#if ENABLE_NS_VARNAME_CACHING
- } else if (index > -3) {
- /*
- * A cacheable namespace or global variable.
- */
-
- Namespace *nsPtr;
-
- nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
- varPtr->refCount++;
- part1Ptr->typePtr = &tclNsVarNameType;
- part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
- part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
-#endif
+ part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
} else {
/*
* At least mark part1Ptr as already parsed.
@@ -807,18 +722,6 @@ TclObjLookupVarEx(
}
donePart1:
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
- if (varPtr == NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- part1 = TclGetString(part1Ptr);
- TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
- "cached variable reference is NULL.", -1);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- TclGetString(part1Ptr), NULL);
- }
- return NULL;
- }
-#endif
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -1605,7 +1508,7 @@ Tcl_SetVar(
Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(varNamePtr);
- varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+ varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL,
Tcl_NewStringObj(newValue, -1), flags);
Tcl_DecrRefCount(varNamePtr);
@@ -1912,17 +1815,6 @@ TclPtrSetVar(
varPtr->value.objPtr = NULL;
}
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
- /*
- * Can't happen now!
- */
-
- if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
- TclDecrRefCount(oldValuePtr); /* Discard old value. */
- varPtr->value.objPtr = NULL;
- oldValuePtr = NULL;
- }
-#endif
if (flags & TCL_LIST_ELEMENT) { /* Append list element. */
if (oldValuePtr == NULL) {
TclNewObj(oldValuePtr);
@@ -1958,6 +1850,9 @@ TclPtrSetVar(
Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
}
Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+ if (newValuePtr->refCount == 0) {
+ Tcl_DecrRefCount(newValuePtr);
+ }
}
}
} else if (newValuePtr != oldValuePtr) {
@@ -2146,7 +2041,7 @@ TclPtrIncrObjVar(
if (Tcl_IsShared(varValuePtr)) {
/* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
-
+
if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
varValuePtr, flags, index);
@@ -2385,18 +2280,6 @@ TclPtrUnsetVar(
}
}
-#if ENABLE_NS_VARNAME_CACHING
- /*
- * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
- * keeping a reference. This removes some additional exteriorisations of
- * [Bug 736729], but may be a good thing independently of the bug.
- */
-
- if (part1Ptr->typePtr == &tclNsVarNameType) {
- TclFreeIntRep(part1Ptr);
- }
-#endif
-
/*
* Finally, if the variable is truly not in use then free up its Var
* structure and remove it from its hash table, if any. The ref count of
@@ -2514,8 +2397,8 @@ UnsetVarStruct(
tracePtr = NULL;
if (TclIsVarTraced(&dummyVar)) {
tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
- tracePtr = Tcl_GetHashValue(tPtr);
if (tPtr) {
+ tracePtr = Tcl_GetHashValue(tPtr);
Tcl_DeleteHashEntry(tPtr);
}
}
@@ -3850,6 +3733,53 @@ ArrayNamesCmd(
/*
*----------------------------------------------------------------------
*
+ * TclFindArrayPtrElements --
+ *
+ * Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
+ * for each existing element of the given array. The provided hash table
+ * is assumed to be initially empty.
+ *
+ * Result:
+ * none
+ *
+ * Side effects:
+ * The keys of the array gain an extra reference. The supplied hash table
+ * has elements added to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFindArrayPtrElements(
+ Var *arrayPtr,
+ Tcl_HashTable *tablePtr)
+{
+ Var *varPtr;
+ Tcl_HashSearch search;
+
+ if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
+ || TclIsVarUndefined(arrayPtr)) {
+ return;
+ }
+
+ for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
+ varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *nameObj;
+ int dummy;
+
+ if (TclIsVarUndefined(varPtr)) {
+ continue;
+ }
+ nameObj = VarHashGetKey(varPtr);
+ hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
+ Tcl_SetHashValue(hPtr, nameObj);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ArraySetCmd --
*
* This object-based function is invoked to process the "array set" Tcl
@@ -4355,8 +4285,8 @@ ObjMakeUpvar(
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
- "bad variable name \"%s\": upvar won't create "
- "namespace variable that refers to procedure variable",
+ "bad variable name \"%s\": can't create namespace "
+ "variable that refers to procedure variable",
TclGetString(myNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
@@ -4413,7 +4343,7 @@ TclPtrMakeUpvar(
}
/* Callers must Incr myNamePtr if they plan to Decr it. */
-
+
int
TclPtrObjMakeUpvar(
Tcl_Interp *interp, /* Interpreter containing variables. Used for
@@ -4456,9 +4386,8 @@ TclPtrObjMakeUpvar(
*/
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
- "bad variable name \"%s\": upvar won't create a"
- " scalar variable that looks like an array element",
- myName));
+ "bad variable name \"%s\": can't create a scalar "
+ "variable that looks like an array element", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
NULL);
return TCL_ERROR;
@@ -4697,7 +4626,7 @@ Tcl_GetVariableFullName(
} else if (iPtr->varFramePtr->procPtr) {
int index = varPtr - iPtr->varFramePtr->compiledLocals;
- if (index < iPtr->varFramePtr->numCompiledLocals) {
+ if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) {
namePtr = localName(iPtr->varFramePtr, index);
Tcl_AppendObjToObj(objPtr, namePtr);
}
@@ -5614,16 +5543,16 @@ PanicOnSetVarName(
* localVarName -
*
* INTERNALREP DEFINITION:
- * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache
+ * twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache
* or NULL if it is this same obj
- * ptrAndLongRep.value: index into locals table
+ * twoPtrValue.ptr2: index into locals table
*/
static void
FreeLocalVarName(
Tcl_Obj *objPtr)
{
- Tcl_Obj *namePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (namePtr) {
Tcl_DecrRefCount(namePtr);
@@ -5636,60 +5565,19 @@ DupLocalVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
if (!namePtr) {
namePtr = srcPtr;
}
- dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
+ dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
Tcl_IncrRefCount(namePtr);
- dupPtr->internalRep.ptrAndLongRep.value =
- srcPtr->internalRep.ptrAndLongRep.value;
+ dupPtr->internalRep.twoPtrValue.ptr2 =
+ srcPtr->internalRep.twoPtrValue.ptr2;
dupPtr->typePtr = &localVarNameType;
}
-#if ENABLE_NS_VARNAME_CACHING
-/*
- * nsVarName -
- *
- * INTERNALREP DEFINITION:
- * twoPtrValue.ptr1: pointer to the namespace containing the reference.
- * twoPtrValue.ptr2: pointer to the corresponding Var
- */
-
-static void
-FreeNsVarName(
- Tcl_Obj *objPtr)
-{
- register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
-
- if (TclIsVarInHash(varPtr)) {
- varPtr->refCount--;
- if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
- CleanupVar(varPtr, NULL);
- }
- }
- objPtr->typePtr = NULL;
-}
-
-static void
-DupNsVarName(
- Tcl_Obj *srcPtr,
- Tcl_Obj *dupPtr)
-{
- Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;
-
- dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
- dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
- if (TclIsVarInHash(varPtr)) {
- varPtr->refCount++;
- }
- dupPtr->typePtr = &tclNsVarNameType;
-}
-#endif
-
/*
* parsedVarName -
*
@@ -6479,11 +6367,10 @@ CompareVarKeys(
/*
* If the object pointers are the same then they match.
- */
+ * OPT: this comparison was moved to the caller
- if (objPtr1 == objPtr2) {
- return 1;
- }
+ if (objPtr1 == objPtr2) return 1;
+ */
/*
* Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 9bceb4c..691d57a 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -26,7 +26,7 @@
* interface, even if that is mostly true).
*/
-#define TCL_ZLIB_VERSION "2.0"
+#define TCL_ZLIB_VERSION "2.0.1"
/*
* Magic flags used with wbits fields to indicate that we're handling the gzip
@@ -643,7 +643,6 @@ Tcl_ZlibStreamInit(
int e;
ZlibStreamHandle *zshPtr = NULL;
Tcl_DString cmdname;
- Tcl_CmdInfo cmdinfo;
GzipHeader *gzHeaderPtr = NULL;
switch (mode) {
@@ -763,14 +762,14 @@ Tcl_ZlibStreamInit(
*/
if (interp != NULL) {
- if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
+ if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) {
goto error;
}
Tcl_DStringInit(&cmdname);
TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
- if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
- &cmdinfo) == 1) {
+ if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname),
+ NULL, 0) != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"BUG: Stream command name already exists", -1));
Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
@@ -1165,6 +1164,14 @@ Tcl_ZlibStreamPut(
zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
zshPtr->stream.avail_in = size;
+ /*
+ * Must not do a zero-length compress. [Bug 25842c161]
+ */
+
+ if (size == 0) {
+ return TCL_OK;
+ }
+
if (HaveDictToSet(zshPtr)) {
e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
if (e != Z_OK) {
@@ -1187,32 +1194,28 @@ Tcl_ZlibStreamPut(
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
- if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) {
- if (outSize - zshPtr->stream.avail_out > 0) {
- /*
- * Output buffer too small.
- */
-
- obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
- outSize - zshPtr->stream.avail_out);
+ while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
+ /*
+ * Output buffer too small to hold the data being generated or we
+ * are doing the end-of-stream flush (which can spit out masses of
+ * data). This means we need to put a new buffer into place after
+ * saving the old generated data to the outData list.
+ */
- /*
- * Now append the compressed data to the outData list.
- */
+ obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
+ Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
- Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
- }
if (outSize < 0xFFFF) {
outSize = 0xFFFF; /* There may be *lots* of data left to
* output... */
- ckfree(dataTmp);
- dataTmp = ckalloc(outSize);
+ dataTmp = ckrealloc(dataTmp, outSize);
}
zshPtr->stream.avail_out = outSize;
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
}
+
if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
if (zshPtr->interp) {
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
@@ -1535,7 +1538,7 @@ Tcl_ZlibDeflate(
if (!interp) {
return TCL_ERROR;
}
-
+
/*
* Compressed format is specified by the wbits parameter. See zlib.h for
* details.
@@ -1758,6 +1761,7 @@ Tcl_ZlibInflate(
if (headerPtr) {
e = inflateGetHeader(&stream, headerPtr);
if (e != Z_OK) {
+ inflateEnd(&stream);
goto error;
}
}
@@ -1781,7 +1785,7 @@ Tcl_ZlibInflate(
if ((stream.avail_in == 0) && (stream.avail_out > 0)) {
e = Z_STREAM_ERROR;
- goto error;
+ break;
}
newBufferSize = bufferSize + 5 * stream.avail_in;
if (newBufferSize == bufferSize) {
@@ -2911,6 +2915,10 @@ ZlibTransformClose(
* Release all memory.
*/
+ if (cd->compDictObj) {
+ Tcl_DecrRefCount(cd->compDictObj);
+ cd->compDictObj = NULL;
+ }
Tcl_DStringFree(&cd->decompressed);
if (cd->inBuffer) {
@@ -2994,47 +3002,18 @@ ZlibTransformInput(
*/
if (readBytes < 0) {
- /*
- * Report errors to caller. The state of the seek system is
- * unchanged!
- */
-
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- /*
- * EAGAIN is a special situation. If we had some data before
- * we report that instead of the request to re-try.
- */
+ /* See ReflectInput() in tclIORTrans.c */
+ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
return gotBytes;
}
*errorCodePtr = Tcl_GetErrno();
return -1;
- } else if (readBytes == 0) {
- /*
- * Check wether we hit on EOF in 'parent' or not. If not,
- * differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
- */
-
- if (!Tcl_Eof(cd->parent)) {
- /*
- * The state of the seek system is unchanged!
- */
-
- if ((gotBytes == 0) && (cd->flags & ASYNC)) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
- return gotBytes;
- }
-
+ }
+ if (readBytes == 0) {
/*
- * (Semi-)Eof in parent.
+ * Eof in parent.
*
* Now this is a bit different. The partial data waiting is
* converted and returned.
@@ -3052,12 +3031,6 @@ ZlibTransformInput(
return gotBytes;
}
-
- /*
- * Reset eof, force caller to drain result buffer.
- */
-
- ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
} else /* readBytes > 0 */ {
/*
* Transform the read chunk, which was not empty. Anything we get
@@ -3137,6 +3110,64 @@ ZlibTransformOutput(
/*
*----------------------------------------------------------------------
*
+ * ZlibTransformFlush --
+ *
+ * How to perform a flush of a compressing transform.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformFlush(
+ Tcl_Interp *interp,
+ ZlibChannelData *cd,
+ int flushType)
+{
+ int e, len;
+
+ cd->outStream.avail_in = 0;
+ do {
+ /*
+ * Get the bytes to go out of the compression engine.
+ */
+
+ cd->outStream.next_out = (Bytef *) cd->outBuffer;
+ cd->outStream.avail_out = cd->outAllocated;
+
+ e = deflate(&cd->outStream, flushType);
+ if (e != Z_OK && e != Z_BUF_ERROR) {
+ ConvertError(interp, e, cd->outStream.adler);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write the bytes we've received to the next layer.
+ */
+
+ len = cd->outStream.next_out - (Bytef *) cd->outBuffer;
+ if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "problem flushing channel: %s",
+ Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ /*
+ * If we get to this point, either we're in the Z_OK or the
+ * Z_BUF_ERROR state. In the former case, we're done. In the latter
+ * case, it's because there's more bytes to go than would fit in the
+ * buffer we provided, and we need to go round again to get some more.
+ *
+ * We also stop the loop if we would have done a zero-length write.
+ * Those can cause problems at the OS level.
+ */
+ } while (len > 0 && e == Z_BUF_ERROR);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ZlibTransformSetOption --
*
* Writing side of [fconfigure] on our channel.
@@ -3209,32 +3240,7 @@ ZlibTransformSetOption( /* not used */
* Try to actually do the flush now.
*/
- cd->outStream.avail_in = 0;
- while (1) {
- int e;
-
- cd->outStream.next_out = (Bytef *) cd->outBuffer;
- cd->outStream.avail_out = cd->outAllocated;
-
- e = deflate(&cd->outStream, flushType);
- if (e == Z_BUF_ERROR) {
- break;
- } else if (e != Z_OK) {
- ConvertError(interp, e, cd->outStream.adler);
- return TCL_ERROR;
- } else if (cd->outStream.avail_out == 0) {
- break;
- }
-
- if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
- cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "problem flushing channel: %s",
- Tcl_PosixError(interp)));
- return TCL_ERROR;
- }
- }
- return TCL_OK;
+ return ZlibTransformFlush(interp, cd, flushType);
}
} else {
if (optionName && strcmp(optionName, "-limit") == 0) {
@@ -3847,7 +3853,7 @@ TclZlibInit(
* commands.
*/
- Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}");
+ Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0);
/*
* Create the public scripted interface to this file's functionality.