summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-03-06 13:41:23 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-03-06 13:41:23 (GMT)
commit292be1554df2e6a02eab708e38cbbd0ab5977466 (patch)
tree7a20dbd5e4014a5d022ed40337476dc657d45cdb /generic
parenta30135ba031c53d2726673256a21b95ddf1b3551 (diff)
parentc5e46efb954d7d3ec9a1594489918053bde2e758 (diff)
downloadtcl-292be1554df2e6a02eab708e38cbbd0ab5977466.zip
tcl-292be1554df2e6a02eab708e38cbbd0ab5977466.tar.gz
tcl-292be1554df2e6a02eab708e38cbbd0ab5977466.tar.bz2
merge novemnovem_remove_va
Diffstat (limited to 'generic')
-rw-r--r--generic/regc_locale.c22
-rw-r--r--generic/regc_nfa.c100
-rw-r--r--generic/regcomp.c2
-rw-r--r--generic/regguts.h2
-rw-r--r--generic/tcl.decls175
-rw-r--r--generic/tcl.h45
-rw-r--r--generic/tclAssembly.c60
-rw-r--r--generic/tclBasic.c286
-rw-r--r--generic/tclBinary.c79
-rw-r--r--generic/tclCkalloc.c6
-rw-r--r--generic/tclClock.c20
-rw-r--r--generic/tclCmdAH.c74
-rw-r--r--generic/tclCmdIL.c50
-rw-r--r--generic/tclCmdMZ.c97
-rw-r--r--generic/tclCompCmds.c137
-rw-r--r--generic/tclCompCmdsSZ.c44
-rw-r--r--generic/tclCompExpr.c17
-rw-r--r--generic/tclCompile.c192
-rw-r--r--generic/tclCompile.h17
-rw-r--r--generic/tclConfig.c6
-rw-r--r--generic/tclDecls.h266
-rw-r--r--generic/tclDictObj.c93
-rw-r--r--generic/tclEncoding.c16
-rw-r--r--generic/tclEnsemble.c686
-rw-r--r--generic/tclEvent.c24
-rw-r--r--generic/tclExecute.c359
-rw-r--r--generic/tclFCmd.c18
-rw-r--r--generic/tclFileName.c4
-rw-r--r--generic/tclGet.c2
-rw-r--r--generic/tclIO.c134
-rw-r--r--generic/tclIO.h125
-rw-r--r--generic/tclIOCmd.c42
-rw-r--r--generic/tclIORChan.c8
-rw-r--r--generic/tclIORTrans.c22
-rw-r--r--generic/tclIOUtil.c17
-rw-r--r--generic/tclIndexObj.c119
-rw-r--r--generic/tclInt.decls107
-rw-r--r--generic/tclInt.h189
-rw-r--r--generic/tclIntDecls.h122
-rw-r--r--generic/tclIntPlatDecls.h13
-rw-r--r--generic/tclInterp.c61
-rw-r--r--generic/tclLink.c23
-rw-r--r--generic/tclListObj.c35
-rw-r--r--generic/tclLiteral.c51
-rw-r--r--generic/tclLoadNone.c33
-rw-r--r--generic/tclMain.c6
-rw-r--r--generic/tclNamesp.c120
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOO.h2
-rw-r--r--generic/tclOOBasic.c61
-rw-r--r--generic/tclOOCall.c11
-rw-r--r--generic/tclOOInfo.c92
-rw-r--r--generic/tclOOMethod.c2
-rw-r--r--generic/tclOOStubLib.c72
-rw-r--r--generic/tclObj.c261
-rw-r--r--generic/tclPathObj.c10
-rw-r--r--generic/tclPkg.c46
-rw-r--r--generic/tclPort.h5
-rw-r--r--generic/tclPreserve.c2
-rw-r--r--generic/tclProc.c52
-rw-r--r--generic/tclRegexp.c14
-rw-r--r--generic/tclResult.c104
-rw-r--r--generic/tclScan.c2
-rw-r--r--generic/tclStringObj.c10
-rw-r--r--generic/tclStubInit.c81
-rw-r--r--generic/tclStubLib.c54
-rw-r--r--generic/tclTest.c156
-rw-r--r--generic/tclTestObj.c80
-rw-r--r--generic/tclTestProcBodyObj.c6
-rw-r--r--generic/tclThreadAlloc.c14
-rw-r--r--generic/tclThreadStorage.c2
-rw-r--r--generic/tclThreadTest.c16
-rw-r--r--generic/tclTimer.c6
-rw-r--r--generic/tclTomMathInterface.c6
-rw-r--r--generic/tclTomMathStubLib.c32
-rw-r--r--generic/tclTrace.c130
-rw-r--r--generic/tclUniData.c194
-rw-r--r--generic/tclUtf.c5
-rw-r--r--generic/tclUtil.c69
-rw-r--r--generic/tclVar.c400
-rw-r--r--generic/tclZlib.c18
81 files changed, 2955 insertions, 3192 deletions
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index f3db471..7d15f8b 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;
@@ -191,6 +191,10 @@ static const crange alphaRangeTable[] = {
{0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
{0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
+ {0xdc02, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
+ {0xdd02, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
+ {0xde02, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
+ {0xdf02, 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},
@@ -242,7 +246,8 @@ static const chr alphaCharTable[] = {
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
+ 0xaab6, 0xaac0, 0xaac2, 0xdc00, 0xdd00, 0xde00, 0xdf00, 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,
@@ -260,7 +265,7 @@ static const chr alphaCharTable[] = {
static const crange controlRangeTable[] = {
{0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, {0x202a, 0x202e},
- {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb}
+ {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd}
#endif
@@ -269,7 +274,7 @@ static const crange controlRangeTable[] = {
#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
@@ -636,7 +641,11 @@ static const crange graphRangeTable[] = {
{0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 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},
+ {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
+ {0xdc42, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
+ {0xdd42, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
+ {0xde42, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
+ {0xdf42, 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, 0xfe26},
@@ -695,7 +704,8 @@ static const chr graphCharTable[] = {
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
+ 0xa9df, 0xdc40, 0xdd40, 0xde40, 0xdf40, 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,
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 4fb3ea6..65147d4 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -759,7 +759,9 @@ duptraverse(
* Arbitrary depth limit. Needs tuning, but this value is sufficient to
* make all normal tests (not reg-33.14) pass.
*/
-#define DUPTRAVERSE_MAX_DEPTH 500
+#ifndef DUPTRAVERSE_MAX_DEPTH
+#define DUPTRAVERSE_MAX_DEPTH 700
+#endif
if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
NERR(REG_ESPACE);
@@ -1246,6 +1248,7 @@ fixempties(
{
struct state *s;
struct state *nexts;
+ struct state *to;
struct arc *a;
struct arc *nexta;
int progress;
@@ -1256,15 +1259,50 @@ fixempties(
do {
progress = 0;
- for (s = nfa->states; s != NULL && !NISERR()
- && s->no != FREESTATE; s = nexts) {
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
nexts = s->next;
- for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+ for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
+ if (a->type == EMPTY) {
+
+ /*
+ * Mark a for deletion; copy arcs to preserve graph
+ * connectivity after it is gone.
+ */
+
+ unempty(nfa, a);
+ }
+ }
+
+ /*
+ * Now pass through and delete the marked arcs. Doing all the
+ * deletion after all the marking prevents arc copying from
+ * resurrecting deleted arcs which can cause failure to converge.
+ * [Tcl Bug 3604074]
+ */
+
+ for (a = s->outs; a != NULL; a = nexta) {
nexta = a->outchain;
- if (a->type == EMPTY && unempty(nfa, a)) {
+ if (a->from == NULL) {
progress = 1;
+ to = a->to;
+ a->from = s;
+ freearc(nfa, a);
+ if (to->nins == 0) {
+ while ((a = to->outs)) {
+ freearc(nfa, a);
+ }
+ if (nexts == to) {
+ nexts = to->next;
+ }
+ freestate(nfa, to);
+ }
+ if (s->nouts == 0) {
+ while ((a = s->ins)) {
+ freearc(nfa, a);
+ }
+ freestate(nfa, s);
+ }
}
- assert(nexta == NULL || s->no != FREESTATE);
}
}
if (progress && f != NULL) {
@@ -1286,7 +1324,6 @@ unempty(
{
struct state *from = a->from;
struct state *to = a->to;
- int usefrom; /* work on from, as opposed to to? */
assert(a->type == EMPTY);
assert(from != nfa->pre && to != nfa->post);
@@ -1297,47 +1334,30 @@ unempty(
}
/*
- * Decide which end to work on.
+ * Mark arc for deletion.
*/
- usefrom = 1; /* default: attack from */
+ a->from = NULL;
+
if (from->nouts > to->nins) {
- usefrom = 0;
- } else if (from->nouts == to->nins) {
- /*
- * Decide on secondary issue: move/copy fewest arcs.
- */
-
- if (from->nins > to->nouts) {
- usefrom = 0;
- }
+ copyouts(nfa, to, from);
+ return 1;
+ }
+ if (from->nouts < to->nins) {
+ copyins(nfa, from, to);
+ return 1;
}
- freearc(nfa, a);
- if (usefrom) {
- if (from->nouts == 0) {
- /*
- * Was the state's only outarc.
- */
-
- moveins(nfa, from, to);
- freestate(nfa, from);
- } else {
- copyins(nfa, from, to);
- }
- } else {
- if (to->nins == 0) {
- /*
- * Was the state's only inarc.
- */
+ /*
+ * from->nouts == to->nins . decide on secondary issue: copy fewest arcs
+ */
- moveouts(nfa, to, from);
- freestate(nfa, to);
- } else {
- copyouts(nfa, to, from);
- }
+ if (from->nins > to->nouts) {
+ copyouts(nfa, to, from);
+ return 1;
}
+ copyins(nfa, from, to);
return 1;
}
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 65555aa..b15117b 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -738,6 +738,7 @@ parsebranch(
/* NB, recursion in parseqatom() may swallow rest of branch */
parseqatom(v, stopper, type, lp, right, t);
+ NOERRN();
}
if (!seencontent) { /* empty branch */
@@ -1234,6 +1235,7 @@ parseqatom(
EMPTYARC(atom->end, rp);
t->right = subre(v, '=', 0, atom->end, rp);
}
+ NOERR();
assert(SEE('|') || SEE(stopper) || SEE(EOS));
t->flags |= COMBINE(t->flags, t->right->flags);
top->flags |= COMBINE(top->flags, t->flags);
diff --git a/generic/regguts.h b/generic/regguts.h
index e57b8f8..67f9625 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -366,7 +366,7 @@ struct subre {
*/
struct fns {
- VOID FUNCPTR(free, (regex_t *));
+ void FUNCPTR(free, (regex_t *));
};
/*
diff --git a/generic/tcl.decls b/generic/tcl.decls
index e9ab7c0..0a96781 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -104,9 +104,10 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 22 {
- Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
-}
+# Removed in 9.0:
+#declare 22 {
+# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
+#}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
const char *file, int line)
@@ -152,10 +153,11 @@ declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
-declare 36 {
- int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
-}
+# Removed in 9.0
+#declare 36 {
+# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+# const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
+#}
declare 37 {
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
@@ -198,18 +200,20 @@ declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
-declare 49 {
- Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
-}
+# Removed in 9.0:
+#declare 49 {
+# Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
+#}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
-declare 52 {
- Tcl_Obj *Tcl_NewIntObj(int intValue)
-}
+# Removed in 9.0:
+#declare 52 {
+# Tcl_Obj *Tcl_NewIntObj(int intValue)
+#}
declare 53 {
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
@@ -222,9 +226,10 @@ declare 55 {
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
-declare 57 {
- void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
-}
+# Removed from 9.0:
+#declare 57 {
+# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
+#}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
@@ -235,9 +240,10 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
-declare 61 {
- void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
-}
+# Removed in 9.0:
+#declare 61 {
+# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
+#}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
@@ -250,13 +256,15 @@ declare 64 {
declare 65 {
void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
-declare 66 {
- void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
-}
-declare 67 {
- void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
- int length)
-}
+# Removed in 9.0:
+#declare 66 {
+# void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
+#}
+# Removed in 9.0:
+#declare 67 {
+# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
+# int length)
+#}
declare 68 {
void Tcl_AllowExceptions(Tcl_Interp *interp)
}
@@ -467,16 +475,18 @@ declare 127 {
declare 128 {
const char *Tcl_ErrnoMsg(int err)
}
-declare 129 {
- int Tcl_Eval(Tcl_Interp *interp, const char *script)
-}
+# Removed in 9.0:
+#declare 129 {
+# int Tcl_Eval(Tcl_Interp *interp, const char *script)
+#}
# Removed in 9.0:
#declare 130 {
# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
#}
-declare 131 {
- int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
-}
+# Removed in 9.0:
+#declare 131 {
+# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+#}
declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
@@ -627,10 +637,11 @@ declare 173 {
declare 174 {
const char *Tcl_GetStringResult(Tcl_Interp *interp)
}
-declare 175 {
- const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
- int flags)
-}
+# Removed in 9.0
+#declare 175 {
+# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
+# int flags)
+#}
declare 176 {
const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags)
@@ -639,6 +650,7 @@ declare 176 {
#declare 177 {
# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
#}
+# Removed in 9.0
#declare 178 {
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
@@ -839,10 +851,11 @@ declare 235 {
declare 236 {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
-declare 237 {
- const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
- const char *newValue, int flags)
-}
+# Removed in 9.0:
+#declare 237 {
+# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
+# const char *newValue, int flags)
+#}
declare 238 {
const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue, int flags)
@@ -875,10 +888,11 @@ declare 245 {
#declare 246 {
# int Tcl_TellOld(Tcl_Channel chan)
#}
-declare 247 {
- int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData)
-}
+# Removed in Tcl 9
+#declare 247 {
+# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
+# Tcl_VarTraceProc *proc, ClientData clientData)
+#}
declare 248 {
int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags, Tcl_VarTraceProc *proc, ClientData clientData)
@@ -896,17 +910,19 @@ declare 251 {
declare 252 {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 253 {
- int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
-}
+# Removed in 9.0:
+#declare 253 {
+# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
+#}
declare 254 {
int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags)
}
-declare 255 {
- void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData)
-}
+# Removed in 9.0:
+#declare 255 {
+# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
+# Tcl_VarTraceProc *proc, ClientData clientData)
+#}
declare 256 {
void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags, Tcl_VarTraceProc *proc,
@@ -915,10 +931,11 @@ declare 256 {
declare 257 {
void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
-declare 258 {
- int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
- const char *varName, const char *localName, int flags)
-}
+# Removed in 9.0
+#declare 258 {
+# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+# const char *varName, const char *localName, int flags)
+#}
declare 259 {
int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
const char *part2, const char *localName, int flags)
@@ -927,10 +944,11 @@ declare 259 {
#declare 260 {
# int Tcl_VarEval(Tcl_Interp *interp, ...)
#}
-declare 261 {
- ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
- int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
-}
+# Removed in 9.0
+#declare 261 {
+# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
+# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
+#}
declare 262 {
ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags, Tcl_VarTraceProc *procPtr,
@@ -964,10 +982,11 @@ declare 270 {
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr)
}
-declare 271 {
- const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
- const char *version, int exact)
-}
+# Removed in 9.0, converted to macro
+#declare 271 {
+# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+# const char *version, int exact)
+#}
declare 272 {
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
@@ -979,10 +998,11 @@ declare 273 {
const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
-declare 274 {
- const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
- const char *version, int exact)
-}
+# Removed in 9.0, converted to macro
+#declare 274 {
+# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+# const char *version, int exact)
+#}
# Removed in 9.0
#declare 275 {
# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
@@ -1054,9 +1074,10 @@ declare 288 {
declare 289 {
void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
-declare 290 {
- void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
-}
+# Removed in 9.0:
+#declare 290 {
+# void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
+#}
declare 291 {
int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes,
int flags)
@@ -1137,12 +1158,14 @@ declare 313 {
int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
int appendFlag)
}
-declare 314 {
- void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
-}
-declare 315 {
- void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
-}
+# Removed in 9.0:
+#declare 314 {
+# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
+#}
+# Removed in 9.0:
+#declare 315 {
+# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
+#}
declare 316 {
int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index 98736ea..693b503 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -321,7 +321,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;
@@ -337,7 +337,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
struct {long tv_sec;} st_ctim;
/* Here is a 4-byte gap */
} Tcl_StatBuf;
-#elif defined(HAVE_STRUCT_STAT64)
+#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
typedef struct stat64 Tcl_StatBuf;
#else
typedef struct stat Tcl_StatBuf;
@@ -678,14 +678,11 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------------------
- * The following structure contains the state needed by Tcl_SaveResult. No-one
- * outside of Tcl should access any of these fields. This structure is
- * typically allocated on the stack.
+ * The following type contains the state needed by Tcl_SaveResult. This
+ * structure is typically allocated on the stack.
*/
-typedef struct Tcl_SavedResult {
- Tcl_Obj *objResultPtr;
-} Tcl_SavedResult;
+typedef Tcl_Obj *Tcl_SavedResult;
/*
*----------------------------------------------------------------------------
@@ -2185,18 +2182,21 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
* main library in case an extension is statically linked into an application.
*/
-const char * TclInitStubs(Tcl_Interp *interp, const char *version,
+const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact, const char *tclversion, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
-/*
- * When not using stubs, make it a macro.
- */
-
#ifdef USE_TCL_STUBS
-#define Tcl_InitStubs(interp, version, exact) \
- TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC)
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+# define Tcl_InitStubs(interp, version, exact) \
+ (Tcl_InitStubs)((interp), (version), (exact)|(int)sizeof(size_t), \
+ TCL_VERSION, TCL_STUB_MAGIC)
+#else
+# define Tcl_InitStubs(interp, version, exact) \
+ (Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, 1|(int)sizeof(size_t), \
+ TCL_VERSION, TCL_STUB_MAGIC)
+#endif
#else
#define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, exact)
@@ -2328,9 +2328,6 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# undef Tcl_NewDoubleObj
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
-# undef Tcl_NewIntObj
-# define Tcl_NewIntObj(val) \
- Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewListObj
# define Tcl_NewListObj(objc, objv) \
Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
@@ -2394,18 +2391,6 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */
-/*
- *----------------------------------------------------------------------------
- * Deprecated Tcl functions:
- */
-
-#ifndef TCL_NO_DEPRECATED
-# undef Tcl_EvalObj
-# define Tcl_EvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),0)
-
-#endif /* !TCL_NO_DEPRECATED */
-
#endif /* RC_INVOKED */
/*
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7833105..5786975 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -798,12 +798,10 @@ TclNRAssembleObjCmd(
if (codePtr == NULL) {
Tcl_AddErrorInfo(interp, "\n (\"");
- Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+ Tcl_AppendObjToErrorInfo(interp, objv[0]);
Tcl_AddErrorInfo(interp, "\" body, line ");
backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
- Tcl_IncrRefCount(backtrace);
- Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
- Tcl_DecrRefCount(backtrace);
+ Tcl_AppendObjToErrorInfo(interp, backtrace);
Tcl_AddErrorInfo(interp, ")");
return TCL_ERROR;
}
@@ -841,16 +839,11 @@ CompileAssembleObj(
CompileEnv compEnv; /* Compilation environment structure */
register ByteCode *codePtr = NULL;
/* Bytecode resulting from the assembly */
- register const AuxData * auxDataPtr;
- /* Pointer to an auxiliary data element
- * in a compilation environment being
- * destroyed. */
Namespace* namespacePtr; /* Namespace in which variable and command
* names in the bytecode resolve */
int status; /* Status return from Tcl_AssembleCode */
const char* source; /* String representation of the source code */
int sourceLen; /* Length of the source code in bytes */
- int i;
/*
@@ -860,7 +853,7 @@ CompileAssembleObj(
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
@@ -888,44 +881,6 @@ CompileAssembleObj(
/*
* Assembly failed. Clean up and report the error.
*/
-
- /*
- * Free any literals that were constructed for the assembly.
- */
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, compEnv.literalArrayPtr[i].objPtr);
- }
-
- /*
- * Free any auxiliary data that was attached to the bytecode
- * under construction.
- */
-
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- auxDataPtr = compEnv.auxDataArrayPtr + i;
- if (auxDataPtr->type->freeProc != NULL) {
- (auxDataPtr->type->freeProc)(auxDataPtr->clientData);
- }
- }
-
- /*
- * TIP 280. If there is extended command line information,
- * we need to clean it up.
- */
-
- if (compEnv.extCmdMapPtr != NULL) {
- if (compEnv.extCmdMapPtr->type == TCL_LOCATION_SOURCE) {
- Tcl_DecrRefCount(compEnv.extCmdMapPtr->path);
- }
- for (i = 0; i < compEnv.extCmdMapPtr->nuloc; ++i) {
- ckfree(compEnv.extCmdMapPtr->loc[i].line);
- }
- if (compEnv.extCmdMapPtr->loc != NULL) {
- ckfree(compEnv.extCmdMapPtr->loc);
- }
- Tcl_DeleteHashTable(&(compEnv.extCmdMapPtr->litInfo));
- }
-
TclFreeCompileEnv(&compEnv);
return NULL;
}
@@ -945,7 +900,7 @@ CompileAssembleObj(
* Record the local variable context to which the bytecode pertains
*/
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -4270,11 +4225,11 @@ AddBasicBlockRangeToErrorInfo(
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
lineNo = Tcl_NewIntObj(bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
- Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
- Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
}
@@ -4338,14 +4293,13 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4f70cee..d31777e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -146,10 +146,7 @@ static Tcl_NRPostProc TEOV_Exception;
static Tcl_NRPostProc TEOV_NotFoundCallback;
static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
-static Tcl_NRPostProc YieldToCallback;
-static void ClearTailcall(Tcl_Interp *interp,
- struct NRE_callback *tailcallPtr);
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
MODULE_SCOPE const TclStubs tclStubs;
@@ -3770,7 +3767,8 @@ TclNREvalObjv(
int result;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
Command **cmdPtrPtr;
-
+ NRE_callback *callbackPtr;
+
iPtr->lookupNsPtr = NULL;
/*
@@ -3783,15 +3781,14 @@ TclNREvalObjv(
* finishes the source command and not just the target.
*/
- if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
- TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv);
- iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
+ if (iPtr->deferredCallbacks) {
+ callbackPtr = iPtr->deferredCallbacks;
+ iPtr->deferredCallbacks = NULL;
} else {
- TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv);
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+ callbackPtr = TOP_CB(interp);
}
- cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
-
- TclNRSpliceDeferred(interp);
+ cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
iPtr->numLevels++;
result = TclInterpReady(interp);
@@ -3918,14 +3915,6 @@ TclNREvalObjv(
}
}
-void
-TclPushTailcallPoint(
- Tcl_Interp *interp)
-{
- TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
- ((Interp *) interp)->numLevels++;
-}
-
int
TclNRRunCallbacks(
Tcl_Interp *interp,
@@ -3962,6 +3951,14 @@ NRCommand(
}
((Interp *)interp)->numLevels--;
+ /*
+ * If there is a tailcall, schedule it
+ */
+
+ if (data[1] && (data[1] != INT2PTR(1))) {
+ TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+ }
+
/* OPT ??
* Do not interrupt a series of cleanups with async or limit checks:
* just check at the end?
@@ -4219,9 +4216,9 @@ TEOV_NotFound(
savedNsPtr = varFramePtr->nsPtr;
varFramePtr->nsPtr = lookupNsPtr;
}
- TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
+ TclSkipTailcall(interp);
+ TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
newObjv, savedNsPtr, NULL);
- iPtr->evalFlags |= TCL_EVAL_REDIRECT;
return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
}
@@ -5341,63 +5338,6 @@ TclArgumentGet(
/*
*----------------------------------------------------------------------
*
- * Tcl_Eval --
- *
- * Execute a Tcl command in a string. This function executes the script
- * directly, rather than compiling it to bytecodes. Before the arrival of
- * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used
- * for executing Tcl commands, but nowadays it isn't used much.
- *
- * Results:
- * The return value is one of the return codes defined in tcl.h (such as
- * TCL_OK), and interp's result contains a value to supplement the return
- * code. The value of the result will persist only until the next call to
- * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it!
- *
- * Side effects:
- * Can be almost arbitrary, depending on the commands in the script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Eval(
- Tcl_Interp *interp, /* Token for command interpreter (returned by
- * previous call to Tcl_CreateInterp). */
- const char *script) /* Pointer to TCL command to execute. */
-{
- return Tcl_EvalEx(interp, script, -1, 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObj --
- *
- * These functions are deprecated but we keep them around for backwards
- * compatibility reasons.
- *
- * Results:
- * See the functions they call.
- *
- * Side effects:
- * See the functions they call.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_EvalObj
-int
-Tcl_EvalObj(
- Tcl_Interp *interp,
- Tcl_Obj *objPtr)
-{
- return Tcl_EvalObjEx(interp, objPtr, 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_EvalObjEx, TclEvalObjEx --
*
* Execute Tcl commands stored in a Tcl object. These commands are
@@ -5541,7 +5481,8 @@ TclNREvalObjEx(
iPtr->cmdFramePtr = eoFramePtr;
}
- TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
NULL, NULL);
ListObjGetElements(listPtr, objc, objv);
@@ -6261,72 +6202,10 @@ Tcl_AppendObjToErrorInfo(
Tcl_Obj *objPtr) /* Message to record. */
{
int length;
+ register Interp *iPtr = (Interp *) interp;
const char *message = TclGetStringFromObj(objPtr, &length);
Tcl_IncrRefCount(objPtr);
- Tcl_AddObjErrorInfo(interp, message, length);
- Tcl_DecrRefCount(objPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AddErrorInfo --
- *
- * Add information to the errorInfo field that describes the current
- * error.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The contents of message are appended to the errorInfo field. If we are
- * just starting to log an error, errorInfo is initialized from the error
- * message in the interpreter's result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AddErrorInfo(
- Tcl_Interp *interp, /* Interpreter to which error information
- * pertains. */
- const char *message) /* Message to record. */
-{
- Tcl_AddObjErrorInfo(interp, message, -1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AddObjErrorInfo --
- *
- * Add information to the errorInfo field that describes the current
- * error. This routine differs from Tcl_AddErrorInfo by taking a byte
- * pointer and length.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "length" bytes from "message" are appended to the errorInfo field. If
- * "length" is negative, use bytes up to the first NULL byte. If we are
- * just starting to log an error, errorInfo is initialized from the error
- * message in the interpreter's result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AddObjErrorInfo(
- Tcl_Interp *interp, /* Interpreter to which error information
- * pertains. */
- const char *message, /* Points to the first byte of an array of
- * bytes of the message. */
- int length) /* The number of bytes in the message. If < 0,
- * then append all bytes up to a NULL byte. */
-{
- register Interp *iPtr = (Interp *) interp;
/*
* If we are just starting to log an error, errorInfo is initialized from
@@ -6354,6 +6233,7 @@ Tcl_AddObjErrorInfo(
}
Tcl_AppendToObj(iPtr->errorInfo, message, length);
}
+ Tcl_DecrRefCount(objPtr);
}
/*
@@ -7650,29 +7530,58 @@ Tcl_NRCmdSwap(
*/
void
-TclSpliceTailcall(
+TclMarkTailcall(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->deferredCallbacks == NULL) {
+ TclNRAddCallback(interp, NRCommand, NULL, NULL,
+ NULL, NULL);
+ iPtr->deferredCallbacks = TOP_CB(interp);
+ }
+}
+
+void
+TclSkipTailcall(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ TclMarkTailcall(interp);
+ iPtr->deferredCallbacks->data[1] = INT2PTR(1);
+}
+
+void
+TclPushTailcallPoint(
+ Tcl_Interp *interp)
+{
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+ ((Interp *) interp)->numLevels++;
+}
+
+void
+TclSetTailcall(
Tcl_Interp *interp,
- NRE_callback *tailcallPtr)
+ Tcl_Obj *listPtr)
{
/*
* Find the splicing spot: right before the NRCommand of the thing
- * being tailcalled. Note that we skip NRCommands marked in data[1]
+ * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
* (used by command redirectors).
*/
NRE_callback *runPtr;
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
- if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+ if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
break;
}
}
if (!runPtr) {
Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
}
-
- tailcallPtr->nextPtr = runPtr->nextPtr;
- runPtr->nextPtr = tailcallPtr;
+ runPtr->data[1] = listPtr;
}
int
@@ -7702,7 +7611,7 @@ TclNRTailcallObjCmd(
*/
if (iPtr->varFramePtr->tailcallPtr) {
- ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+ Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
iPtr->varFramePtr->tailcallPtr = NULL;
}
@@ -7717,23 +7626,20 @@ TclNRTailcallObjCmd(
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
- NRE_callback *tailcallPtr;
- listPtr = Tcl_NewListObj(objc-1, objv+1);
- Tcl_IncrRefCount(listPtr);
+ /* 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);
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|| (nsPtr != ns1Ptr)) {
Tcl_Panic("Tailcall failed to find the proper namespace");
}
- Tcl_IncrRefCount(nsObjPtr);
-
- TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
- NULL, NULL);
- tailcallPtr = TOP_CB(interp);
- TOP_CB(interp) = tailcallPtr->nextPtr;
- iPtr->varFramePtr->tailcallPtr = tailcallPtr;
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
+ iPtr->varFramePtr->tailcallPtr = listPtr;
}
return TCL_RETURN;
}
@@ -7745,12 +7651,14 @@ TclNRTailcallEval(
int result)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *listPtr = data[0];
- Tcl_Obj *nsObjPtr = data[1];
+ Tcl_Obj *listPtr = data[0], *nsObjPtr;
Tcl_Namespace *nsPtr;
int objc;
Tcl_Obj **objv;
+ Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
+ nsObjPtr = objv[0];
+
if (result == TCL_OK) {
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
}
@@ -7769,10 +7677,10 @@ TclNRTailcallEval(
* Perform the tailcall
*/
- TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL);
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
iPtr->lookupNsPtr = (Namespace *) nsPtr;
- ListObjGetElements(listPtr, objc, objv);
- return TclNREvalObjv(interp, objc, objv, 0, NULL);
+ return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}
static int
@@ -7782,19 +7690,9 @@ TailcallCleanup(
int result)
{
Tcl_DecrRefCount((Tcl_Obj *) data[0]);
- Tcl_DecrRefCount((Tcl_Obj *) data[1]);
return result;
}
-static void
-ClearTailcall(
- Tcl_Interp *interp,
- NRE_callback *tailcallPtr)
-{
- TailcallCleanup(tailcallPtr->data, interp, TCL_OK);
- TCLNR_FREE(interp, tailcallPtr);
-}
-
void
Tcl_NRAddCallback(
@@ -7896,50 +7794,32 @@ TclNRYieldToObjCmd(
* This is essentially code from TclNRTailcallObjCmd
*/
- listPtr = Tcl_NewListObj(objc-1, objv+1);
- Tcl_IncrRefCount(listPtr);
+ /*
+ * Add the tailcall in the caller env, then just yield.
+ *
+ * This is essentially code from TclNRTailcallObjCmd
+ */
+
+ 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");
}
- Tcl_IncrRefCount(nsObjPtr);
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
iPtr->execEnvPtr = corPtr->callerEEPtr;
- TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr,
- NULL);
+ TclSetTailcall(interp, listPtr);
iPtr->execEnvPtr = corPtr->eePtr;
return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
-
-static int
-YieldToCallback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- /* CoroutineData *corPtr = data[0];*/
- Tcl_Obj *listPtr = data[1];
- ClientData nsPtr = data[2];
- NRE_callback *cbPtr;
-
- /*
- * yieldTo: invoke the command using tailcall tech.
- */
-
- TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL);
- cbPtr = TOP_CB(interp);
- TOP_CB(interp) = cbPtr->nextPtr;
-
- TclSpliceTailcall(interp, cbPtr);
- return TCL_OK;
-}
static int
RewindCoroutineCallback(
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 5c33308..4f60ac8 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -128,6 +128,30 @@ static const char B64Digits[65] = {
};
/*
+ * How to construct the ensembles.
+ */
+
+static const EnsembleImplMap binaryMap[] = {
+ { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
+ { "scan", BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },
+ { "encode", NULL, NULL, NULL, NULL, 0 },
+ { "decode", NULL, NULL, NULL, NULL, 0 },
+ { 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 },
+ { NULL, NULL, NULL, NULL, NULL, 0 }
+};
+static const EnsembleImplMap decodeMap[] = {
+ { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { NULL, NULL, NULL, NULL, NULL, 0 }
+};
+
+/*
* The following object type represents an array of bytes. An array of bytes
* is not equivalent to an internationalized string. Conceptually, a string is
* an array of 16-bit quantities organized as a sequence of properly formed
@@ -167,7 +191,7 @@ const Tcl_ObjType tclByteArrayType = {
* fewer mallocs.
*/
-typedef struct ByteArray {
+typedef struct {
int used; /* The number of bytes used in the byte
* array. */
int allocated; /* The amount of space actually allocated
@@ -180,9 +204,10 @@ typedef struct ByteArray {
#define BYTEARRAY_SIZE(len) \
((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
- ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
+ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.otherValuePtr = (void *) (baPtr)
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+
/*
*----------------------------------------------------------------------
@@ -301,7 +326,7 @@ Tcl_SetByteArrayObj(
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
TclFreeIntRep(objPtr);
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
if (length < 0) {
length = 0;
@@ -396,7 +421,7 @@ Tcl_SetByteArrayLength(
byteArrayPtr->allocated = length;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
byteArrayPtr->used = length;
return byteArrayPtr->bytes;
}
@@ -667,7 +692,7 @@ TclAppendBytesToByteArray(
if (len > 0) {
memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
byteArrayPtr->used += len;
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
}
}
@@ -688,26 +713,6 @@ TclAppendBytesToByteArray(
*----------------------------------------------------------------------
*/
-static const EnsembleImplMap binaryMap[] = {
-{ "format", BinaryFormatCmd, NULL, NULL, NULL, 0 },
-{ "scan", BinaryScanCmd, NULL, NULL, NULL, 0 },
-{ "encode", NULL, NULL, NULL, NULL, 0 },
-{ "decode", NULL, NULL, NULL, NULL, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-static const EnsembleImplMap encodeMap[] = {
-{ "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits, 0 },
-{ "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 },
-{ "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-static const EnsembleImplMap decodeMap[] = {
-{ "hex", BinaryDecodeHex, NULL, NULL, NULL, 0 },
-{ "uuencode", BinaryDecodeUu, NULL, NULL, NULL, 0 },
-{ "base64", BinaryDecode64, NULL, NULL, NULL, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-
Tcl_Command
TclInitBinaryCmd(
Tcl_Interp *interp)
@@ -2357,12 +2362,12 @@ BinaryDecodeHex(
static const char *const optStrings[] = { "-strict", NULL };
if (objc < 2 || objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
return TCL_ERROR;
}
for (i = 1; i < objc-1; ++i) {
- if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
@@ -2481,8 +2486,8 @@ BinaryEncode64(
return TCL_ERROR;
}
for (i = 1; i < objc-1; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
@@ -2571,12 +2576,12 @@ BinaryDecodeUu(
static const char *const optStrings[] = { "-strict", NULL };
if (objc < 2 || objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
return TCL_ERROR;
}
for (i = 1; i < objc-1; ++i) {
- if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
@@ -2667,12 +2672,12 @@ BinaryDecode64(
static const char *const optStrings[] = { "-strict", NULL };
if (objc < 2 || objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
return TCL_ERROR;
}
for (i = 1; i < objc-1; ++i) {
- if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index ab977cb..ede0d67 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -33,7 +33,7 @@
* "memory tag" command is invoked, to hold the current tag.
*/
-typedef struct MemTag {
+typedef struct {
int refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
@@ -156,6 +156,10 @@ TclInitDbCkalloc(void)
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
+#ifndef TCL_THREADS
+ /* Silence compiler warning */
+ (void)ckallocMutexPtr;
+#endif
}
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 6d2976d..98ca02d 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -91,7 +91,7 @@ static const char *const literals[] = {
* Structure containing the client data for [clock]
*/
-typedef struct ClockClientData {
+typedef struct {
int refCount; /* Number of live references. */
Tcl_Obj **literals; /* Pool of object literals. */
} ClockClientData;
@@ -100,7 +100,7 @@ typedef struct ClockClientData {
* Structure containing the fields used in [clock format] and [clock scan]
*/
-typedef struct TclDateFields {
+typedef struct {
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
* epoch */
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
@@ -548,8 +548,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
}
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_GetIndexFromObjStruct(interp, fieldPtr, eras,
+ sizeof(char *), "era", TCL_EXACT, &era) != TCL_OK
|| Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
&fieldPtr) != TCL_OK
|| TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
@@ -638,8 +638,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
}
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_GetIndexFromObjStruct(interp, fieldPtr, eras,
+ sizeof(char *), "era", TCL_EXACT, &era) != TCL_OK
|| Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
&fieldPtr) != TCL_OK
|| TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK
@@ -1697,8 +1697,8 @@ ClockClicksObjCmd(
case 1:
break;
case 2:
- if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], clicksSwitches,
+ sizeof(char *), "switch", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
break;
@@ -1867,8 +1867,8 @@ 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,
- &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) {
Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
Tcl_GetString(objv[i]), NULL);
return TCL_ERROR;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4be8b2a..fd62ede 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -395,8 +395,8 @@ Tcl_EncodingObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -612,7 +612,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
@@ -813,40 +813,40 @@ TclInitFileCmd(
*/
static const EnsembleImplMap initMap[] = {
- {"atime", FileAttrAccessTimeCmd, NULL, NULL, NULL, 0},
- {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
- {"channels", TclChannelNamesCmd, NULL, NULL, NULL, 0},
- {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
- {"delete", TclFileDeleteCmd, NULL, NULL, NULL, 0},
- {"dirname", PathDirNameCmd, NULL, NULL, NULL, 0},
- {"executable", FileAttrIsExecutableCmd, NULL, NULL, NULL, 0},
- {"exists", FileAttrIsExistingCmd, NULL, NULL, NULL, 0},
- {"extension", PathExtensionCmd, NULL, NULL, NULL, 0},
- {"isdirectory", FileAttrIsDirectoryCmd, NULL, NULL, NULL, 0},
- {"isfile", FileAttrIsFileCmd, NULL, NULL, NULL, 0},
- {"join", PathJoinCmd, NULL, NULL, NULL, 0},
- {"link", TclFileLinkCmd, NULL, NULL, NULL, 0},
- {"lstat", FileAttrLinkStatCmd, NULL, NULL, NULL, 0},
- {"mtime", FileAttrModifyTimeCmd, NULL, NULL, NULL, 0},
- {"mkdir", TclFileMakeDirsCmd, NULL, NULL, NULL, 0},
- {"nativename", PathNativeNameCmd, NULL, NULL, NULL, 0},
- {"normalize", PathNormalizeCmd, NULL, NULL, NULL, 0},
- {"owned", FileAttrIsOwnedCmd, NULL, NULL, NULL, 0},
- {"pathtype", PathTypeCmd, NULL, NULL, NULL, 0},
- {"readable", FileAttrIsReadableCmd, NULL, NULL, NULL, 0},
- {"readlink", TclFileReadLinkCmd, NULL, NULL, NULL, 0},
- {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
- {"rootname", PathRootNameCmd, NULL, NULL, NULL, 0},
- {"separator", FilesystemSeparatorCmd, NULL, NULL, NULL, 0},
- {"size", FileAttrSizeCmd, NULL, NULL, NULL, 0},
- {"split", PathSplitCmd, NULL, NULL, NULL, 0},
- {"stat", FileAttrStatCmd, NULL, NULL, NULL, 0},
- {"system", PathFilesystemCmd, NULL, NULL, NULL, 0},
- {"tail", PathTailCmd, NULL, NULL, NULL, 0},
- {"tempfile", TclFileTemporaryCmd, NULL, NULL, NULL, 0},
- {"type", FileAttrTypeCmd, NULL, NULL, NULL, 0},
- {"volumes", FilesystemVolumesCmd, NULL, NULL, NULL, 0},
- {"writable", FileAttrIsWritableCmd, NULL, NULL, NULL, 0},
+ {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
+ {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
+ {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
+ {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
+ {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "file", initMap);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 155e8e4..7fdab05 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
* The following structure is used to pass this information.
*/
-typedef struct SortInfo {
+typedef struct {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
* defined below. */
@@ -161,30 +161,30 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
*/
static const EnsembleImplMap defaultInfoMap[] = {
- {"args", InfoArgsCmd, NULL, NULL, NULL, 0},
- {"body", InfoBodyCmd, NULL, NULL, NULL, 0},
- {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0},
+ {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0},
- {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0},
+ {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
- {"default", InfoDefaultCmd, NULL, NULL, NULL, 0},
- {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0},
+ {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0},
+ {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0},
- {"frame", InfoFrameCmd, NULL, NULL, NULL, 0},
- {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0},
- {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0},
- {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0},
+ {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0},
- {"library", InfoLibraryCmd, NULL, NULL, NULL, 0},
- {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0},
- {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0},
- {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0},
- {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0},
- {"procs", InfoProcsCmd, NULL, NULL, NULL, 0},
- {"script", InfoScriptCmd, NULL, NULL, NULL, 0},
- {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL, 0},
- {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL, 0},
- {"vars", TclInfoVarsCmd, NULL, NULL, NULL, 0},
+ {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -2962,8 +2962,8 @@ Tcl_LsearchObjCmd(
}
for (i = 1; i < objc-2; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
@@ -3691,8 +3691,8 @@ Tcl_LsortObjCmd(
groupOffset = 0;
indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], switches,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index fc957c4..9c67fbf 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -159,8 +159,8 @@ Tcl_RegexpObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) {
goto optionError;
}
switch ((enum options) index) {
@@ -335,7 +335,7 @@ Tcl_RegexpObjCmd(
*/
if (!doinline) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
}
return TCL_OK;
}
@@ -457,7 +457,7 @@ Tcl_RegexpObjCmd(
if (doinline) {
Tcl_SetObjResult(interp, resultPtr);
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(all ? all-1 : 1));
}
return TCL_OK;
}
@@ -517,8 +517,8 @@ Tcl_RegsubObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[idx], options,
+ sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) {
goto optionError;
}
switch ((enum options) index) {
@@ -847,7 +847,7 @@ Tcl_RegsubObjCmd(
* holding the number of matches.
*/
- Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(numMatches));
}
} else {
/*
@@ -1003,8 +1003,8 @@ TclNRSourceObjCmd(
};
int index;
- if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options,
- "option", TCL_EXACT, &index)) {
+ if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "option", TCL_EXACT, &index)) {
return TCL_ERROR;
}
encodingName = TclGetString(objv[2]);
@@ -1260,7 +1260,7 @@ StringFirstCmd(
}
str_first_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(match));
return TCL_OK;
}
@@ -1358,7 +1358,7 @@ StringLastCmd(
}
str_last_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(match));
return TCL_OK;
}
@@ -1485,8 +1485,8 @@ StringIsCmd(
"class ?-strict? ?-failindex var? str");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses,
+ sizeof(char *), "class", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1494,8 +1494,8 @@ StringIsCmd(
for (i = 2; i < objc-1; i++) {
int idx2;
- if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0,
- &idx2) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions,
+ sizeof(char *), "option", 0, &idx2) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum isOptions) idx2) {
@@ -1540,7 +1540,8 @@ StringIsCmd(
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
- if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) {
+ if ((objPtr->typePtr != &tclBooleanType)
+ && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
if (strict) {
result = 0;
} else {
@@ -1797,11 +1798,11 @@ StringIsCmd(
str_is_done:
if ((result == 0) && (failVarObj != NULL) &&
- Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
+ Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewLongObj(failat),
TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(result!=0));
return TCL_OK;
}
@@ -2136,8 +2137,8 @@ StringMatchCmd(
return TCL_ERROR;
}
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(
+ TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)!=0));
return TCL_OK;
}
@@ -2467,7 +2468,7 @@ StringStartCmd(
cur += 1;
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(cur));
return TCL_OK;
}
@@ -2529,7 +2530,7 @@ StringEndCmd(
} else {
cur = numChars;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(cur));
return TCL_OK;
}
@@ -2611,7 +2612,7 @@ StringEqualCmd(
* Always match at 0 chars of if it is the same obj.
*/
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
return TCL_OK;
}
@@ -2679,7 +2680,7 @@ StringEqualCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(match==0));
return TCL_OK;
}
@@ -2761,7 +2762,7 @@ StringCmpCmd(
* Always match at 0 chars of if it is the same obj.
*/
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
@@ -2826,7 +2827,7 @@ StringCmpCmd(
}
Tcl_SetObjResult(interp,
- Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
+ Tcl_NewLongObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
return TCL_OK;
}
@@ -2864,7 +2865,7 @@ StringBytesCmd(
}
(void) TclGetStringFromObj(objv[1], &length);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(length));
return TCL_OK;
}
@@ -2898,7 +2899,7 @@ StringLenCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_GetCharLength(objv[1])));
return TCL_OK;
}
@@ -3324,7 +3325,7 @@ TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
- {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0},
+ {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
@@ -3335,17 +3336,17 @@ TclInitStringCmd(
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
- {"repeat", StringReptCmd, NULL, NULL, NULL, 0},
+ {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"replace", StringRplcCmd, NULL, NULL, NULL, 0},
- {"reverse", StringRevCmd, NULL, NULL, NULL, 0},
- {"tolower", StringLowerCmd, NULL, NULL, NULL, 0},
- {"toupper", StringUpperCmd, NULL, NULL, NULL, 0},
- {"totitle", StringTitleCmd, NULL, NULL, NULL, 0},
- {"trim", StringTrimCmd, NULL, NULL, NULL, 0},
- {"trimleft", StringTrimLCmd, NULL, NULL, NULL, 0},
- {"trimright", StringTrimRCmd, NULL, NULL, NULL, 0},
- {"wordend", StringEndCmd, NULL, NULL, NULL, 0},
- {"wordstart", StringStartCmd, NULL, 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},
+ {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -3388,8 +3389,8 @@ TclSubstOptions(
for (i = 0; i < numOpts; i++) {
int optionIndex;
- if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
- &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, opts[i], substOptions,
+ sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch (optionIndex) {
@@ -3513,8 +3514,8 @@ TclNRSwitchObjCmd(
if (TclGetString(objv[i])[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
@@ -3790,7 +3791,7 @@ TclNRSwitchObjCmd(
rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
} else {
- rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
+ rangeObjAry[0] = rangeObjAry[1] = Tcl_NewLongObj(-1);
}
/*
@@ -4110,7 +4111,7 @@ Tcl_TimeObjCmd(
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
- objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
+ objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec);
} else {
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
}
@@ -4190,8 +4191,8 @@ TclNRTryObjCmd(
int type;
Tcl_Obj *info[5];
- if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
- 0, &type) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], handlerNames,
+ sizeof(char *), "handler type", 0, &type) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4264,7 +4265,7 @@ TclNRTryObjCmd(
}
info[0] = objv[i]; /* type */
- TclNewIntObj(info[1], code); /* returnCode */
+ TclNewLongObj(info[1], code); /* returnCode */
if (info[2] == NULL) { /* errorCodePrefix */
TclNewObj(info[2]);
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 160fa3c..40348fa 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -107,6 +107,7 @@ static int CompileDictEachCmd(Tcl_Interp *interp,
*/
#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
/*
* The structures below define the AuxData types defined in this file.
@@ -259,7 +260,7 @@ TclCompileArrayExistsCmd(
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
@@ -283,7 +284,7 @@ TclCompileArraySetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
- Tcl_Token *tokenPtr;
+ Tcl_Token *varTokenPtr, *dataTokenPtr;
int simpleVarName, isScalar, localIndex;
int dataVar, iterVar, keyVar, valVar, infoIndex;
int back, fwd, offsetBack, offsetFwd, savedStackDepth;
@@ -293,20 +294,21 @@ TclCompileArraySetCmd(
return TCL_ERROR;
}
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
+ dataTokenPtr = TokenAfter(varTokenPtr);
if (!isScalar) {
return TCL_ERROR;
}
- tokenPtr = TokenAfter(tokenPtr);
/*
* Special case: literal empty value argument is just an "ensure array"
* operation.
*/
- if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) {
+ if (dataTokenPtr->type == TCL_TOKEN_SIMPLE_WORD
+ && dataTokenPtr[1].size == 0) {
if (localIndex >= 0) {
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
@@ -329,14 +331,37 @@ TclCompileArraySetCmd(
* Prepare for the internal foreach.
*/
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
- }
dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ if (dataVar < 0) {
+ /*
+ * Right number of arguments, but not compilable as we can't allocate
+ * (unnamed) local variables to manage the internal iteration.
+ */
+
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ char *bytes;
+ int length, cmdLit;
+
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
+ TclEmitPush(cmdLit, envPtr);
+ TclDecrRefCount(objPtr);
+ if (localIndex >= 0) {
+ CompileWord(envPtr, varTokenPtr, interp, 1);
+ } else {
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ }
+ CompileWord(envPtr, dataTokenPtr, interp, 2);
+ TclEmitInstInt1(INST_INVOKE_STK1, 3, envPtr);
+ return TCL_OK;
+ }
+
infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
infoPtr->numLists = 1;
infoPtr->firstValueTemp = dataVar;
@@ -351,7 +376,7 @@ TclCompileArraySetCmd(
* Start issuing instructions to write to the array.
*/
- CompileWord(envPtr, tokenPtr, interp, 2);
+ CompileWord(envPtr, dataTokenPtr, interp, 2);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
PushLiteral(envPtr, "1", 1);
@@ -434,10 +459,10 @@ TclCompileArrayUnsetCmd(
int simpleVarName, isScalar, localIndex, savedStackDepth;
if (parsePtr->numWords != 2) {
- return TCL_ERROR;
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
- PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
@@ -928,7 +953,7 @@ TclCompileDictIncrCmd(
incrTokenPtr = TokenAfter(keyTokenPtr);
if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
}
word = incrTokenPtr[1].start;
numBytes = incrTokenPtr[1].size;
@@ -938,7 +963,7 @@ TclCompileDictIncrCmd(
code = TclGetIntFromObj(NULL, intObj, &incrAmount);
TclDecrRefCount(intObj);
if (code != TCL_OK) {
- return TCL_ERROR;
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
}
} else {
incrAmount = 1;
@@ -951,16 +976,16 @@ TclCompileDictIncrCmd(
*/
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if (dictVarIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1078,16 +1103,16 @@ TclCompileDictUnsetCmd(
tokenPtr = TokenAfter(parsePtr->tokenPtr);
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
name = tokenPtr[1].start;
nameChars = tokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if (dictVarIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1178,7 +1203,7 @@ TclCompileDictCreateCmd(
nonConstant:
worker = TclFindCompiledLocal(NULL, 0, 1, envPtr);
if (worker < 0) {
- return TCL_ERROR;
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
PushLiteral(envPtr, "", 0);
@@ -1239,7 +1264,7 @@ TclCompileDictMergeCmd(
workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
if (workerIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
@@ -1365,11 +1390,11 @@ CompileDictEachCmd(
Tcl_DString buffer;
/*
- * There must be at least three argument after the command.
+ * There must be three arguments after the command.
*/
if (parsePtr->numWords != 4) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -1377,7 +1402,7 @@ CompileDictEachCmd(
bodyTokenPtr = TokenAfter(dictTokenPtr);
if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1389,7 +1414,7 @@ CompileDictEachCmd(
collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
envPtr);
if (collectVar < 0) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
}
@@ -1403,31 +1428,31 @@ CompileDictEachCmd(
if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
&argv) != TCL_OK) {
Tcl_DStringFree(&buffer);
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
Tcl_DStringFree(&buffer);
if (numVars != 2) {
ckfree(argv);
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
nameChars = strlen(argv[0]);
if (!TclIsLocalScalar(argv[0], nameChars)) {
ckfree(argv);
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr);
nameChars = strlen(argv[1]);
if (!TclIsLocalScalar(argv[1], nameChars)) {
ckfree(argv);
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr);
ckfree(argv);
if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1439,7 +1464,7 @@ CompileDictEachCmd(
infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
if (infoIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1636,16 +1661,16 @@ TclCompileDictUpdateCmd(
dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
name = dictVarTokenPtr[1].start;
nameChars = dictVarTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
dictIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if (dictIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1696,7 +1721,7 @@ TclCompileDictUpdateCmd(
failedUpdateInfoAssembly:
ckfree(duiPtr);
TclStackFree(interp, keyTokenPtrs);
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
bodyTokenPtr = tokenPtr;
@@ -1794,17 +1819,17 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(parsePtr->tokenPtr);
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else {
register const char *name = tokenPtr[1].start;
register int nameChars = tokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if (dictVarIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
}
}
@@ -1855,16 +1880,16 @@ TclCompileDictLappendCmd(
keyTokenPtr = TokenAfter(varTokenPtr);
valueTokenPtr = TokenAfter(keyTokenPtr);
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if (dictVarIndex < 0) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
CompileWord(envPtr, keyTokenPtr, interp, 3);
CompileWord(envPtr, valueTokenPtr, interp, 4);
@@ -1908,7 +1933,7 @@ TclCompileDictWithCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1920,7 +1945,8 @@ TclCompileDictWithCmd(
for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr,
+ envPtr);
}
bodyIsEmpty = 0;
break;
@@ -3082,7 +3108,7 @@ TclCompileFormatCmd(
* after our attempt to spot a literal).
*/
- for (; --i>=0 ;) {
+ for (; i>=0 ; i--) {
Tcl_DecrRefCount(objv[i]);
}
ckfree(objv);
@@ -3747,7 +3773,9 @@ TclCompileInfoCommandsCmd(
* We require one compile-time known argument for the case we can compile.
*/
- if (parsePtr->numWords != 2) {
+ if (parsePtr->numWords == 1) {
+ return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ } else if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3784,7 +3812,7 @@ TclCompileInfoCommandsCmd(
notCompilable:
Tcl_DecrRefCount(objPtr);
- return TCL_ERROR;
+ return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
int
@@ -5791,7 +5819,7 @@ TclCompileVariableCmd(
*/
valueTokenPtr = parsePtr->tokenPtr;
- for (i=2; i<=numWords; i+=2) {
+ for (i=1; i<numWords; i+=2) {
varTokenPtr = TokenAfter(valueTokenPtr);
valueTokenPtr = TokenAfter(varTokenPtr);
@@ -5801,15 +5829,15 @@ TclCompileVariableCmd(
return TCL_ERROR;
}
- CompileWord(envPtr, varTokenPtr, interp, 1);
+ CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
- if (i != numWords) {
+ if (i+1 < numWords) {
/*
* A value has been given: set the variable, pop the value
*/
- CompileWord(envPtr, valueTokenPtr, interp, 1);
+ CompileWord(envPtr, valueTokenPtr, interp, i+1);
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
@@ -6006,7 +6034,7 @@ PushVarName(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Token *varTokenPtr, /* Points to a variable token. */
CompileEnv *envPtr, /* Holds resulting instructions. */
- int flags, /* TCL_NO_LARGE_INDEX. */
+ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
int *localIndexPtr, /* Must not be NULL. */
int *simpleVarNamePtr, /* Must not be NULL. */
int *isScalarPtr, /* Must not be NULL. */
@@ -6187,10 +6215,11 @@ PushVarName(
}
/*
- * Compile the element script, if any.
+ * Compile the element script, if any, and only if not inhibited. [Bug
+ * 3600328]
*/
- if (elName != NULL) {
+ if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
if (elNameChars) {
envPtr->line = line;
envPtr->clNext = clNext;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 9c93fb2..f73beca 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -448,7 +448,7 @@ TclCompileStringMatchCmd(
if (parsePtr->numWords == 4) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
str = tokenPtr[1].start;
length = tokenPtr[1].size;
@@ -457,7 +457,7 @@ TclCompileStringMatchCmd(
* Fail at run time, not in compilation.
*/
- return TCL_ERROR;
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
nocase = 1;
tokenPtr = TokenAfter(tokenPtr);
@@ -578,13 +578,13 @@ TclCompileStringMapCmd(
Tcl_IncrRefCount(mapObj);
if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
Tcl_DecrRefCount(mapObj);
- return TCL_ERROR;
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
Tcl_DecrRefCount(mapObj);
- return TCL_ERROR;
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (len != 2) {
Tcl_DecrRefCount(mapObj);
- return TCL_ERROR;
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -836,6 +836,34 @@ TclSubstCompile(
TclEmitPush(literal, envPtr);
count++;
continue;
+ case TCL_TOKEN_VARIABLE:
+ /*
+ * Check for simple variable access; see if we can only generate
+ * TCL_OK or TCL_ERROR from the substituted variable read; if so,
+ * there is no need to generate elaborate exception-management
+ * code. Note that the first component of TCL_TOKEN_VARIABLE is
+ * always TCL_TOKEN_TEXT...
+ */
+
+ if (tokenPtr->numComponents > 1) {
+ int i, foundCommand = 0;
+
+ for (i=2 ; i<=tokenPtr->numComponents ; i++) {
+ if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
+ foundCommand = 1;
+ break;
+ }
+ }
+ if (foundCommand) {
+ break;
+ }
+ }
+
+ envPtr->line = bline;
+ TclCompileVarSubst(interp, tokenPtr, envPtr);
+ bline = envPtr->line;
+ count++;
+ continue;
}
while (count > 255) {
@@ -1925,11 +1953,13 @@ TclCompileTailcallCmd(
return TCL_ERROR;
}
+ /* make room for the nsObjPtr */
+ CompileWord(envPtr, tokenPtr, interp, 0);
for (i=1 ; i<parsePtr->numWords ; i++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, i);
}
- TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords-1, envPtr);
+ TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr);
return TCL_OK;
}
@@ -2709,7 +2739,7 @@ TclCompileUnsetCmd(
flags = 1;
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
leadingWord = Tcl_NewObj();
- if (TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
int len;
const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 890d518..2062dc8 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -22,7 +22,7 @@
* The tree is composed of OpNodes.
*/
-typedef struct OpNode {
+typedef struct {
int left; /* "Pointer" to the left operand. */
int right; /* "Pointer" to the right operand. */
union {
@@ -2207,7 +2207,7 @@ ExecConstantExprTree(
TclInitByteCodeObj(byteCodeObj, envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
- byteCodePtr = byteCodeObj->internalRep.otherValuePtr;
+ byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
TclNRExecuteByteCode(interp, byteCodePtr);
code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
Tcl_DecrRefCount(byteCodeObj);
@@ -2445,14 +2445,11 @@ CompileExprTree(
Tcl_Obj *literal = *litObjv;
if (optimize) {
- int length, index;
+ int length;
const char *bytes = TclGetStringFromObj(literal, &length);
- LiteralEntry *lePtr;
- Tcl_Obj *objPtr;
-
- index = TclRegisterNewLiteral(envPtr, bytes, length);
- lePtr = envPtr->literalArrayPtr + index;
- objPtr = lePtr->objPtr;
+ int index = TclRegisterNewLiteral(envPtr, bytes, length);
+ Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
+
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2511,7 +2508,7 @@ CompileExprTree(
index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
objPtr->length);
- tableValue = envPtr->literalArrayPtr[index].objPtr;
+ tableValue = TclFetchLiteral(envPtr, index);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 309682d..5427759 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -529,6 +529,11 @@ InstructionDesc const tclInstructionTable[] = {
/* Forces the variable indexed by opnd to be an array. Does not touch
* the stack. */
+ {"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}},
+ /* Invoke command named objv[0], replacing the first two words with
+ * the word at the top of the stack;
+ * <objc,objv> = <op4,top op4 after popping 1> */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -552,6 +557,7 @@ static int GetCmdLocEncodingSize(CompileEnv *envPtr);
#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 int FormatInstruction(ByteCode *codePtr,
@@ -568,6 +574,7 @@ static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
Tcl_Token *tokenPtr, const char *cmd, int len,
int numWords, int line, int *clNext, int **lines,
CompileEnv *envPtr);
+static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
/*
* The structure below defines the bytecode Tcl object type by means of
@@ -645,9 +652,6 @@ TclSetByteCodeFromAny(
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
- register const AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- register int i;
int length, result = TCL_OK;
const char *stringPtr;
ContLineLoc *clLocPtr;
@@ -717,35 +721,14 @@ TclSetByteCodeFromAny(
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- TclInitByteCodeObj(objPtr, &compEnv);
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- if (result != TCL_OK) {
- /*
- * Handle any error from the hookProc
- */
-
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
+ if (result == TCL_OK) {
+ TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
- }
- auxDataPtr++;
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
}
+#endif /* TCL_COMPILE_DEBUG */
}
TclFreeCompileEnv(&compEnv);
@@ -784,8 +767,7 @@ SetByteCodeFromAny(
if (interp == NULL) {
return TCL_ERROR;
}
- TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
- return TCL_OK;
+ return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
}
/*
@@ -839,10 +821,9 @@ static void
FreeByteCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
@@ -862,9 +843,8 @@ FreeByteCodeInternalRep(
* None.
*
* Side effects:
- * Frees objPtr's bytecode internal representation and sets its type and
- * objPtr->internalRep.otherValuePtr NULL. Also releases its literals and
- * frees its auxiliary data items.
+ * Frees objPtr's bytecode internal representation and sets its type NULL
+ * Also releases its literals and frees its auxiliary data items.
*
*----------------------------------------------------------------------
*/
@@ -939,7 +919,7 @@ TclCleanupByteCode(
* released.
*/
- if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
objArrayPtr = codePtr->objArrayPtr;
for (i = 0; i < numLitObjects; i++) {
@@ -952,17 +932,9 @@ TclCleanupByteCode(
codePtr->numLitObjects = 0;
} else {
objArrayPtr = codePtr->objArrayPtr;
- for (i = 0; i < numLitObjects; i++) {
- /*
- * TclReleaseLiteral sets a ByteCode's object array entry NULL to
- * indicate that it has already freed the literal.
- */
-
- objPtr = *objArrayPtr;
- if (objPtr != NULL) {
- TclReleaseLiteral(interp, objPtr);
- }
- objArrayPtr++;
+ while (numLitObjects--) {
+ /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */
+ TclReleaseLiteral(interp, *objArrayPtr++);
}
}
@@ -987,22 +959,7 @@ TclCleanupByteCode(
(char *) codePtr);
if (hePtr) {
- ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
-
- if (eclPtr->type == TCL_LOCATION_SOURCE) {
- Tcl_DecrRefCount(eclPtr->path);
- }
- for (i=0 ; i<eclPtr->nuloc ; i++) {
- ckfree(eclPtr->loc[i].line);
- }
-
- if (eclPtr->loc != NULL) {
- ckfree(eclPtr->loc);
- }
-
- Tcl_DeleteHashTable(&eclPtr->litInfo);
-
- ckfree(eclPtr);
+ ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
Tcl_DeleteHashEntry(hePtr);
}
}
@@ -1139,7 +1096,7 @@ CompileSubstObj(
objPtr->typePtr = &substCodeType;
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
objPtr->internalRep.ptrAndLongRep.value = flags;
if (iPtr->varFramePtr->localCachePtr) {
@@ -1178,12 +1135,33 @@ FreeSubstCodeInternalRep(
register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
}
+
+static void
+ReleaseCmdWordData(
+ ExtCmdLoc *eclPtr)
+{
+ int i;
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(eclPtr->path);
+ }
+ for (i=0 ; i<eclPtr->nuloc ; i++) {
+ ckfree((char *) eclPtr->loc[i].line);
+ }
+
+ if (eclPtr->loc != NULL) {
+ ckfree((char *) eclPtr->loc);
+ }
+
+ Tcl_DeleteHashTable (&eclPtr->litInfo);
+
+ ckfree((char *) eclPtr);
+}
/*
*----------------------------------------------------------------------
@@ -1417,6 +1395,32 @@ TclFreeCompileEnv(
ckfree(envPtr->localLitTable.buckets);
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
+ if (envPtr->iPtr) {
+ /*
+ * We never converted to Bytecode, so free the things we would
+ * have transferred to it.
+ */
+
+ int i;
+ LiteralEntry *entryPtr = envPtr->literalArrayPtr;
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+
+ for (i = 0; i < envPtr->literalArrayNext; i++) {
+ TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
+ entryPtr++;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(envPtr->iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ for (i = 0; i < envPtr->auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ }
if (envPtr->mallocedCodeArray) {
ckfree(envPtr->codeStart);
}
@@ -1433,7 +1437,8 @@ TclFreeCompileEnv(
ckfree(envPtr->auxDataArrayPtr);
}
if (envPtr->extCmdMapPtr) {
- ckfree(envPtr->extCmdMapPtr);
+ ReleaseCmdWordData(envPtr->extCmdMapPtr);
+ envPtr->extCmdMapPtr = NULL;
}
/*
@@ -1575,6 +1580,10 @@ TclCompileScript(
int *wlines, wlineat, cmdLine, *clNext;
Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
+
Tcl_DStringInit(&ds);
if (numBytes < 0) {
@@ -1887,8 +1896,7 @@ TclCompileScript(
tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
- envPtr->literalArrayPtr[objIndex].objPtr,
- cmdPtr);
+ TclFetchLiteral(envPtr, objIndex), cmdPtr);
}
} else {
/*
@@ -1905,7 +1913,7 @@ TclCompileScript(
if (envPtr->clNext) {
TclContinuationsEnterDerived(
- envPtr->literalArrayPtr[objIndex].objPtr,
+ TclFetchLiteral(envPtr, objIndex),
tokenPtr[1].start - envPtr->source,
eclPtr->loc[wlineat].next[wordIdx]);
}
@@ -2214,9 +2222,8 @@ TclCompileTokens(
Tcl_DStringFree(&textBuffer);
if (numCL) {
- TclContinuationsEnter(
- envPtr->literalArrayPtr[literal].objPtr, numCL,
- clPosition);
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
+ numCL, clPosition);
}
numCL = 0;
}
@@ -2262,7 +2269,7 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
if (numCL) {
- TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
numCL, clPosition);
}
numCL = 0;
@@ -2509,6 +2516,10 @@ TclInitByteCodeObj(
int i, isNew;
Interp *iPtr;
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+ }
+
iPtr = envPtr->iPtr;
codeBytes = envPtr->codeNext - envPtr->codeStart;
@@ -2566,7 +2577,9 @@ TclInitByteCodeObj(
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; i++) {
- if (objPtr == envPtr->literalArrayPtr[i].objPtr) {
+ Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
+
+ if (objPtr == fetched) {
/*
* Prevent circular reference where the bytecode intrep of
* a value contains a literal which is that same value.
@@ -2585,7 +2598,7 @@ TclInitByteCodeObj(
Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
Tcl_DecrRefCount(objPtr);
} else {
- codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+ codePtr->objArrayPtr[i] = fetched;
}
}
@@ -2634,7 +2647,7 @@ TclInitByteCodeObj(
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = codePtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
objPtr->typePtr = &tclByteCodeType;
/*
@@ -2646,6 +2659,9 @@ TclInitByteCodeObj(
&isNew), envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->iPtr = NULL;
+
codePtr->localCachePtr = NULL;
}
@@ -3558,7 +3574,7 @@ TclGetInstructionTable(void)
/*
*--------------------------------------------------------------
*
- * TclRegisterAuxDataType --
+ * RegisterAuxDataType --
*
* This procedure is called to register a new AuxData type in the table
* of all AuxData types supported by Tcl.
@@ -3574,8 +3590,8 @@ TclGetInstructionTable(void)
*--------------------------------------------------------------
*/
-void
-TclRegisterAuxDataType(
+static void
+RegisterAuxDataType(
const AuxDataType *typePtr) /* Information about object type; storage must
* be statically allocated (must live forever;
* will not be deallocated). */
@@ -3679,9 +3695,9 @@ TclInitAuxDataTypeTable(void)
* There are only two AuxData type at this time, so register them here.
*/
- TclRegisterAuxDataType(&tclForeachInfoType);
- TclRegisterAuxDataType(&tclJumptableInfoType);
- TclRegisterAuxDataType(&tclDictUpdateInfoType);
+ RegisterAuxDataType(&tclForeachInfoType);
+ RegisterAuxDataType(&tclJumptableInfoType);
+ RegisterAuxDataType(&tclDictUpdateInfoType);
}
/*
@@ -4053,7 +4069,7 @@ Tcl_Obj *
TclDisassembleByteCodeObj(
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
@@ -4558,7 +4574,11 @@ TclGetInnerContext(
if (!objPtr) {
Tcl_Panic("InnerContext: bad tos -- appending null object");
}
- if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) {
+ if ((objPtr->refCount<=0)
+#ifdef TCL_MEM_DEBUG
+ || (objPtr->refCount==0x61616161)
+#endif
+ ) {
Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
objPtr);
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 3302f9b..f5edfaa 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -80,7 +80,7 @@ typedef enum {
* to a catch PC offset. */
} ExceptionRangeType;
-typedef struct ExceptionRange {
+typedef struct {
ExceptionRangeType type; /* The kind of ExceptionRange. */
int nestingLevel; /* Static depth of the exception range. Used
* to find the most deeply-nested range
@@ -107,7 +107,7 @@ typedef struct ExceptionRange {
* source offset is not monotonic.
*/
-typedef struct CmdLocation {
+typedef struct {
int codeOffset; /* Offset of first byte of command code. */
int numCodeBytes; /* Number of bytes for command's code. */
int srcOffset; /* Offset of first char of the command. */
@@ -125,7 +125,7 @@ typedef struct CmdLocation {
* frame and associated information, like the path of a sourced file.
*/
-typedef struct ECL {
+typedef struct {
int srcOffset; /* Command location to find the entry. */
int nline; /* Number of words in the command */
int *line; /* Line information for all words in the
@@ -135,7 +135,7 @@ typedef struct ECL {
* lines. */
} ECL;
-typedef struct ExtCmdLoc {
+typedef struct {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
@@ -711,8 +711,10 @@ typedef struct ByteCode {
#define INST_ARRAY_MAKE_STK 161
#define INST_ARRAY_MAKE_IMM 162
+#define INST_INVOKE_REPLACE 163
+
/* The last opcode */
-#define LAST_INST_OPCODE 162
+#define LAST_INST_OPCODE 163
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -952,11 +954,10 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
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 LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
JumpFixup *jumpFixupPtr, int jumpDist,
int distThreshold);
@@ -965,7 +966,6 @@ MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitAuxDataTypeTable(void);
MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
CompileEnv *envPtr);
-MODULE_SCOPE void TclInitCompilation(void);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
int numBytes, const CmdFrame *invoker, int word);
@@ -985,7 +985,6 @@ MODULE_SCOPE void TclPrintObject(FILE *outFile,
Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void TclPrintSource(FILE *outFile,
const char *string, int maxChars);
-MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index a4ba71a..ce36047 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -31,7 +31,7 @@
* and the (Tcl_Interp *) in which it is stored.
*/
-typedef struct QCCD {
+typedef struct {
Tcl_Obj *pkg;
Tcl_Interp *interp;
} QCCD;
@@ -223,8 +223,8 @@ QueryConfigObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmdStrings,
+ sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 6d6a03c..cc3ce06 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -94,9 +94,7 @@ TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
/* 21 */
TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
-/* 22 */
-TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
- int line);
+/* Slot 22 is reserved */
/* 23 */
TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int length, const char *file, int line);
@@ -133,10 +131,7 @@ TCLAPI int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
/* 35 */
TCLAPI int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, double *doublePtr);
-/* 36 */
-TCLAPI int Tcl_GetIndexFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr, const char *const *tablePtr,
- const char *msg, int flags, int *indexPtr);
+/* Slot 36 is reserved */
/* 37 */
TCLAPI int Tcl_GetInt(Tcl_Interp *interp, const char *src,
int *intPtr);
@@ -173,15 +168,13 @@ TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp,
TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp,
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
-/* 49 */
-TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
+/* Slot 49 is reserved */
/* 50 */
TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
/* 51 */
TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
-/* 52 */
-TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue);
+/* Slot 52 is reserved */
/* 53 */
TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
@@ -190,8 +183,7 @@ TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue);
TCLAPI Tcl_Obj * Tcl_NewObj(void);
/* 56 */
TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
-/* 57 */
-TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+/* Slot 57 is reserved */
/* 58 */
TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
@@ -199,8 +191,7 @@ TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, int length);
/* 60 */
TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
-/* 61 */
-TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+/* Slot 61 is reserved */
/* 62 */
TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
Tcl_Obj *const objv[]);
@@ -211,12 +202,8 @@ TCLAPI void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
TCLAPI void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
int length);
-/* 66 */
-TCLAPI void Tcl_AddErrorInfo(Tcl_Interp *interp,
- const char *message);
-/* 67 */
-TCLAPI void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
- const char *message, int length);
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
/* 68 */
TCLAPI void Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
@@ -385,11 +372,9 @@ TCLAPI int Tcl_Eof(Tcl_Channel chan);
TCLAPI const char * Tcl_ErrnoId(void);
/* 128 */
TCLAPI const char * Tcl_ErrnoMsg(int err);
-/* 129 */
-TCLAPI int Tcl_Eval(Tcl_Interp *interp, const char *script);
+/* Slot 129 is reserved */
/* Slot 130 is reserved */
-/* 131 */
-TCLAPI int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+/* Slot 131 is reserved */
/* 132 */
TCLAPI void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
@@ -514,9 +499,7 @@ TCLAPI Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
TCLAPI Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp);
-/* 175 */
-TCLAPI const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
- int flags);
+/* Slot 175 is reserved */
/* 176 */
TCLAPI const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
@@ -671,9 +654,7 @@ TCLAPI void Tcl_SetObjResult(Tcl_Interp *interp,
Tcl_Obj *resultObjPtr);
/* 236 */
TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type);
-/* 237 */
-TCLAPI const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
- const char *newValue, int flags);
+/* Slot 237 is reserved */
/* 238 */
TCLAPI const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue,
@@ -699,10 +680,7 @@ TCLAPI void Tcl_StaticPackage(Tcl_Interp *interp,
/* 245 */
TCLAPI int Tcl_StringMatch(const char *str, const char *pattern);
/* Slot 246 is reserved */
-/* 247 */
-TCLAPI int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
- int flags, Tcl_VarTraceProc *proc,
- ClientData clientData);
+/* Slot 247 is reserved */
/* 248 */
TCLAPI int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags,
@@ -720,17 +698,11 @@ TCLAPI void Tcl_UnlinkVar(Tcl_Interp *interp,
/* 252 */
TCLAPI int Tcl_UnregisterChannel(Tcl_Interp *interp,
Tcl_Channel chan);
-/* 253 */
-TCLAPI int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
- int flags);
+/* Slot 253 is reserved */
/* 254 */
TCLAPI int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
-/* 255 */
-TCLAPI void Tcl_UntraceVar(Tcl_Interp *interp,
- const char *varName, int flags,
- Tcl_VarTraceProc *proc,
- ClientData clientData);
+/* Slot 255 is reserved */
/* 256 */
TCLAPI void Tcl_UntraceVar2(Tcl_Interp *interp,
const char *part1, const char *part2,
@@ -739,20 +711,13 @@ TCLAPI void Tcl_UntraceVar2(Tcl_Interp *interp,
/* 257 */
TCLAPI void Tcl_UpdateLinkedVar(Tcl_Interp *interp,
const char *varName);
-/* 258 */
-TCLAPI int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
- const char *varName, const char *localName,
- int flags);
+/* Slot 258 is reserved */
/* 259 */
TCLAPI int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
const char *part1, const char *part2,
const char *localName, int flags);
/* Slot 260 is reserved */
-/* 261 */
-TCLAPI ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
- const char *varName, int flags,
- Tcl_VarTraceProc *procPtr,
- ClientData prevClientData);
+/* Slot 261 is reserved */
/* 262 */
TCLAPI ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp,
const char *part1, const char *part2,
@@ -774,9 +739,7 @@ TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr);
-/* 271 */
-TCLAPI const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
- const char *version, int exact);
+/* Slot 271 is reserved */
/* 272 */
TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version,
@@ -784,9 +747,7 @@ TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
/* 273 */
TCLAPI int TclPkgProvide(Tcl_Interp *interp, const char *name,
const char *version);
-/* 274 */
-TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
- const char *version, int exact);
+/* Slot 274 is reserved */
/* Slot 275 is reserved */
/* Slot 276 is reserved */
/* 277 */
@@ -821,8 +782,7 @@ TCLAPI void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
/* 289 */
TCLAPI void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
-/* 290 */
-TCLAPI void Tcl_DiscardResult(Tcl_SavedResult *statePtr);
+/* Slot 290 is reserved */
/* 291 */
TCLAPI int Tcl_EvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags);
@@ -886,12 +846,8 @@ TCLAPI int Tcl_NumUtfChars(const char *src, int length);
/* 313 */
TCLAPI int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
int charsToRead, int appendFlag);
-/* 314 */
-TCLAPI void Tcl_RestoreResult(Tcl_Interp *interp,
- Tcl_SavedResult *statePtr);
-/* 315 */
-TCLAPI void Tcl_SaveResult(Tcl_Interp *interp,
- Tcl_SavedResult *statePtr);
+/* Slot 314 is reserved */
+/* Slot 315 is reserved */
/* 316 */
TCLAPI int Tcl_SetSystemEncoding(Tcl_Interp *interp,
const char *name);
@@ -1808,7 +1764,7 @@ typedef struct TclStubs {
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
- Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
+ void (*reserved22)(void);
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
@@ -1822,7 +1778,7 @@ typedef struct TclStubs {
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
- int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
+ void (*reserved36)(void);
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
@@ -1835,25 +1791,25 @@ typedef struct TclStubs {
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
- Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+ void (*reserved49)(void);
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
- Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+ void (*reserved52)(void);
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
- void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+ void (*reserved57)(void);
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
- void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+ void (*reserved61)(void);
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
- void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
- void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
+ void (*reserved66)(void);
+ void (*reserved67)(void);
void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
@@ -1915,9 +1871,9 @@ typedef struct TclStubs {
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
const char * (*tcl_ErrnoId) (void); /* 127 */
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
- int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
+ void (*reserved129)(void);
void (*reserved130)(void);
- int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
+ void (*reserved131)(void);
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
@@ -1969,7 +1925,7 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
- const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
+ void (*reserved175)(void);
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
void (*reserved177)(void);
void (*reserved178)(void);
@@ -2031,7 +1987,7 @@ typedef struct TclStubs {
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
- const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
+ void (*reserved237)(void);
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
const char * (*tcl_SignalId) (int sig); /* 239 */
const char * (*tcl_SignalMsg) (int sig); /* 240 */
@@ -2041,21 +1997,21 @@ typedef struct TclStubs {
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
void (*reserved246)(void);
- int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
+ void (*reserved247)(void);
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
- int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
+ void (*reserved253)(void);
int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
- void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+ void (*reserved255)(void);
void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
- int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
+ void (*reserved258)(void);
int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
void (*reserved260)(void);
- ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+ void (*reserved261)(void);
ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
@@ -2065,10 +2021,10 @@ typedef struct TclStubs {
void (*reserved268)(void);
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
- const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
+ void (*reserved271)(void);
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
- const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
+ void (*reserved274)(void);
void (*reserved275)(void);
void (*reserved276)(void);
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
@@ -2084,7 +2040,7 @@ typedef struct TclStubs {
Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
- void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */
+ void (*reserved290)(void);
int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
@@ -2108,8 +2064,8 @@ typedef struct TclStubs {
void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
- void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
- void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
+ void (*reserved314)(void);
+ void (*reserved315)(void);
int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
@@ -2497,8 +2453,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
(tclStubsPtr->tcl_DbIsShared) /* 21 */
-#define Tcl_DbNewBooleanObj \
- (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
+/* Slot 22 is reserved */
#define Tcl_DbNewByteArrayObj \
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
@@ -2525,8 +2480,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetDouble) /* 34 */
#define Tcl_GetDoubleFromObj \
(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
-#define Tcl_GetIndexFromObj \
- (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
+/* Slot 36 is reserved */
#define Tcl_GetInt \
(tclStubsPtr->tcl_GetInt) /* 37 */
#define Tcl_GetIntFromObj \
@@ -2551,14 +2505,12 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ListObjLength) /* 47 */
#define Tcl_ListObjReplace \
(tclStubsPtr->tcl_ListObjReplace) /* 48 */
-#define Tcl_NewBooleanObj \
- (tclStubsPtr->tcl_NewBooleanObj) /* 49 */
+/* Slot 49 is reserved */
#define Tcl_NewByteArrayObj \
(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
-#define Tcl_NewIntObj \
- (tclStubsPtr->tcl_NewIntObj) /* 52 */
+/* Slot 52 is reserved */
#define Tcl_NewListObj \
(tclStubsPtr->tcl_NewListObj) /* 53 */
#define Tcl_NewLongObj \
@@ -2567,16 +2519,14 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
(tclStubsPtr->tcl_NewStringObj) /* 56 */
-#define Tcl_SetBooleanObj \
- (tclStubsPtr->tcl_SetBooleanObj) /* 57 */
+/* Slot 57 is reserved */
#define Tcl_SetByteArrayLength \
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
-#define Tcl_SetIntObj \
- (tclStubsPtr->tcl_SetIntObj) /* 61 */
+/* Slot 61 is reserved */
#define Tcl_SetListObj \
(tclStubsPtr->tcl_SetListObj) /* 62 */
#define Tcl_SetLongObj \
@@ -2585,10 +2535,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_SetObjLength) /* 64 */
#define Tcl_SetStringObj \
(tclStubsPtr->tcl_SetStringObj) /* 65 */
-#define Tcl_AddErrorInfo \
- (tclStubsPtr->tcl_AddErrorInfo) /* 66 */
-#define Tcl_AddObjErrorInfo \
- (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
#define Tcl_AllowExceptions \
(tclStubsPtr->tcl_AllowExceptions) /* 68 */
#define Tcl_AppendElement \
@@ -2709,11 +2657,9 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ErrnoId) /* 127 */
#define Tcl_ErrnoMsg \
(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
-#define Tcl_Eval \
- (tclStubsPtr->tcl_Eval) /* 129 */
+/* Slot 129 is reserved */
/* Slot 130 is reserved */
-#define Tcl_EvalObj \
- (tclStubsPtr->tcl_EvalObj) /* 131 */
+/* Slot 131 is reserved */
#define Tcl_EventuallyFree \
(tclStubsPtr->tcl_EventuallyFree) /* 132 */
#define Tcl_Exit \
@@ -2805,8 +2751,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetStdChannel) /* 173 */
#define Tcl_GetStringResult \
(tclStubsPtr->tcl_GetStringResult) /* 174 */
-#define Tcl_GetVar \
- (tclStubsPtr->tcl_GetVar) /* 175 */
+/* Slot 175 is reserved */
#define Tcl_GetVar2 \
(tclStubsPtr->tcl_GetVar2) /* 176 */
/* Slot 177 is reserved */
@@ -2925,8 +2870,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_SetObjResult) /* 235 */
#define Tcl_SetStdChannel \
(tclStubsPtr->tcl_SetStdChannel) /* 236 */
-#define Tcl_SetVar \
- (tclStubsPtr->tcl_SetVar) /* 237 */
+/* Slot 237 is reserved */
#define Tcl_SetVar2 \
(tclStubsPtr->tcl_SetVar2) /* 238 */
#define Tcl_SignalId \
@@ -2944,8 +2888,7 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_StringMatch \
(tclStubsPtr->tcl_StringMatch) /* 245 */
/* Slot 246 is reserved */
-#define Tcl_TraceVar \
- (tclStubsPtr->tcl_TraceVar) /* 247 */
+/* Slot 247 is reserved */
#define Tcl_TraceVar2 \
(tclStubsPtr->tcl_TraceVar2) /* 248 */
#define Tcl_TranslateFileName \
@@ -2956,23 +2899,19 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_UnlinkVar) /* 251 */
#define Tcl_UnregisterChannel \
(tclStubsPtr->tcl_UnregisterChannel) /* 252 */
-#define Tcl_UnsetVar \
- (tclStubsPtr->tcl_UnsetVar) /* 253 */
+/* Slot 253 is reserved */
#define Tcl_UnsetVar2 \
(tclStubsPtr->tcl_UnsetVar2) /* 254 */
-#define Tcl_UntraceVar \
- (tclStubsPtr->tcl_UntraceVar) /* 255 */
+/* Slot 255 is reserved */
#define Tcl_UntraceVar2 \
(tclStubsPtr->tcl_UntraceVar2) /* 256 */
#define Tcl_UpdateLinkedVar \
(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
-#define Tcl_UpVar \
- (tclStubsPtr->tcl_UpVar) /* 258 */
+/* Slot 258 is reserved */
#define Tcl_UpVar2 \
(tclStubsPtr->tcl_UpVar2) /* 259 */
/* Slot 260 is reserved */
-#define Tcl_VarTraceInfo \
- (tclStubsPtr->tcl_VarTraceInfo) /* 261 */
+/* Slot 261 is reserved */
#define Tcl_VarTraceInfo2 \
(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#define Tcl_Write \
@@ -2989,14 +2928,12 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_HashStats) /* 269 */
#define Tcl_ParseVar \
(tclStubsPtr->tcl_ParseVar) /* 270 */
-#define Tcl_PkgPresent \
- (tclStubsPtr->tcl_PkgPresent) /* 271 */
+/* Slot 271 is reserved */
#define Tcl_PkgPresentEx \
(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
#define TclPkgProvide \
(tclStubsPtr->tclPkgProvide) /* 273 */
-#define Tcl_PkgRequire \
- (tclStubsPtr->tcl_PkgRequire) /* 274 */
+/* Slot 274 is reserved */
/* Slot 275 is reserved */
/* Slot 276 is reserved */
#define Tcl_WaitPid \
@@ -3023,8 +2960,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
#define Tcl_DeleteThreadExitHandler \
(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
-#define Tcl_DiscardResult \
- (tclStubsPtr->tcl_DiscardResult) /* 290 */
+/* Slot 290 is reserved */
#define Tcl_EvalEx \
(tclStubsPtr->tcl_EvalEx) /* 291 */
#define Tcl_EvalObjv \
@@ -3071,10 +3007,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_NumUtfChars) /* 312 */
#define Tcl_ReadChars \
(tclStubsPtr->tcl_ReadChars) /* 313 */
-#define Tcl_RestoreResult \
- (tclStubsPtr->tcl_RestoreResult) /* 314 */
-#define Tcl_SaveResult \
- (tclStubsPtr->tcl_SaveResult) /* 315 */
+/* Slot 314 is reserved */
+/* Slot 315 is reserved */
#define Tcl_SetSystemEncoding \
(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
#define Tcl_SetVar2Ex \
@@ -3711,15 +3645,15 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_GetStringResult
# undef Tcl_Init
# undef Tcl_SetPanicProc
-# undef Tcl_SetVar2
+# undef Tcl_ObjSetVar2
# undef Tcl_StaticPackage
# undef TclFSGetNativePath
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
-# define Tcl_SetVar2(interp, part1, part2, newValue, flags) \
- (tclStubsPtr->tcl_SetVar2(interp, part1, part2, newValue, flags))
+# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
+ (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif
#if defined(_WIN32) && defined(UNICODE)
@@ -3729,7 +3663,69 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
+#define Tcl_PkgPresent(interp, name, version, exact) \
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#define Tcl_PkgProvide(interp, name, version) \
Tcl_PkgProvideEx(interp, name, version, NULL)
+#define Tcl_PkgRequire(interp, name, version, exact) \
+ Tcl_PkgRequireEx(interp, name, version, exact, NULL)
+#define Tcl_Eval(interp,objPtr) \
+ Tcl_EvalEx((interp),(objPtr),-1,0)
+#define Tcl_GlobalEval(interp,objPtr) \
+ Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL)
+#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
+ Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \
+ sizeof(char *), (msg), (flags), (indexPtr))
+#define Tcl_NewIntObj Tcl_NewLongObj
+#define Tcl_SetIntObj Tcl_SetLongObj
+#define Tcl_NewBooleanObj(boolValue) \
+ Tcl_NewLongObj((boolValue)!=0)
+#define Tcl_DbNewBooleanObj(boolValue, file, line) \
+ Tcl_DbNewLongObj((boolValue)!=0, file, line)
+#define Tcl_SetBooleanObj(objPtr, boolValue) \
+ Tcl_SetLongObj((objPtr), (boolValue)!=0)
+#define Tcl_AddErrorInfo(interp, message) \
+ Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1))
+#define Tcl_AddObjErrorInfo(interp, message, length) \
+ Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), length))
+#define Tcl_SaveResult(interp, statePtr) \
+ do { \
+ *(statePtr) = Tcl_GetObjResult(interp); \
+ Tcl_IncrRefCount(*(statePtr)); \
+ Tcl_SetObjResult((interp), Tcl_NewObj()); \
+ } while(0)
+#define Tcl_RestoreResult(interp, statePtr) \
+ do { \
+ Tcl_ResetResult(interp); \
+ Tcl_SetObjResult((interp), *(statePtr)); \
+ Tcl_DecrRefCount(*(statePtr)); \
+ } while(0)
+#define Tcl_DiscardResult(statePtr) \
+ Tcl_DecrRefCount(*(statePtr))
+#define Tcl_SetVar(interp, varName, newValue, flags) \
+ Tcl_SetVar2(interp, varName, NULL, newValue, flags)
+#define Tcl_UnsetVar(interp, varName, flags) \
+ Tcl_UnsetVar2(interp, varName, NULL, flags)
+#define Tcl_GetVar(interp, varName, flags) \
+ Tcl_GetVar2(interp, varName, NULL, flags)
+#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
+#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
+#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
+ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
+#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
+ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+
+/*
+ * Deprecated Tcl procedures:
+ */
+
+#ifndef TCL_NO_DEPRECATED
+# define Tcl_EvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),0)
+# define Tcl_GlobalEvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+#endif /* !TCL_NO_DEPRECATED */
#endif /* _TCLDECLS */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index eb3625e..ad24017 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -91,22 +91,22 @@ static const EnsembleImplMap implementationMap[] = {
{"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 },
{"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 },
{"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 },
- {"filter", DictFilterCmd, NULL, NULL, NULL, 0 },
+ {"filter", DictFilterCmd, NULL, NULL, NULL, 0 },
{"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
{"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 },
{"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 },
- {"info", DictInfoCmd, NULL, NULL, NULL, 0 },
- {"keys", DictKeysCmd, NULL, NULL, NULL, 0 },
+ {"info", DictInfoCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ {"keys", DictKeysCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
{"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
{"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
{"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
- {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 },
+ {"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
- {"size", DictSizeCmd, NULL, NULL, NULL, 0 },
+ {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
- {"values", DictValuesCmd, NULL, NULL, NULL, 0 },
+ {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
{"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -361,7 +361,7 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = srcPtr->internalRep.otherValuePtr;
+ Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
Dict *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
@@ -396,7 +396,7 @@ DupDictInternalRep(
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -422,14 +422,12 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
dict->refcount--;
if (dict->refcount <= 0) {
DeleteDict(dict);
}
-
- dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */
dictPtr->typePtr = NULL;
}
@@ -487,15 +485,14 @@ static void
UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
-#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = dictPtr->internalRep.otherValuePtr;
+#define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
- const int maxFlags = UINT_MAX / sizeof(int);
/*
* This field is the most useful one in the whole hash structure, and it
@@ -517,10 +514,8 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
- } else if (numElems > maxFlags) {
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = ckalloc(numElems * sizeof(int));
+ flagPtr = ckalloc(numElems);
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
@@ -624,7 +619,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) {
@@ -715,7 +710,7 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = dict;
+ objPtr->internalRep.twoPtrValue.ptr1 = dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
@@ -784,7 +779,7 @@ TclTraceDictPath(
return NULL;
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -827,7 +822,7 @@ TclTraceDictPath(
}
}
- newDict = tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -835,7 +830,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
}
newDict->chain = dictPtr;
@@ -870,17 +865,17 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = dictObj->internalRep.otherValuePtr;
+ Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
do {
- Tcl_InvalidateStringRep(dictObj);
+ TclInvalidateStringRep(dictObj);
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
- dict = dictObj->internalRep.otherValuePtr;
+ dict = dictObj->internalRep.twoPtrValue.ptr1;
} while (dict != NULL);
}
@@ -927,9 +922,9 @@ Tcl_DictObjPut(
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -980,7 +975,7 @@ Tcl_DictObjGet(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
@@ -1029,9 +1024,9 @@ Tcl_DictObjRemove(
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (DeleteChainEntry(dict, keyPtr)) {
dict->epoch++;
}
@@ -1071,7 +1066,7 @@ Tcl_DictObjSize(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1126,7 +1121,7 @@ Tcl_DictObjFirst(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
@@ -1301,7 +1296,7 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -1357,7 +1352,7 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1397,13 +1392,13 @@ Tcl_NewDictObj(void)
Dict *dict;
TclNewObj(dictPtr);
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1446,13 +1441,13 @@ Tcl_DbNewDictObj(
Dict *dict;
TclDbNewObj(dictPtr, file, line);
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1974,7 +1969,7 @@ DictSizeCmd(
}
result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(size));
}
return result;
}
@@ -2016,9 +2011,9 @@ DictExistsCmd(
if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
|| Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
&valuePtr) != TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(valuePtr != NULL));
}
return TCL_OK;
}
@@ -2064,7 +2059,7 @@ DictInfoCmd(
return result;
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
statsStr = Tcl_HashStats(&dict->table);
Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2157,7 +2152,7 @@ DictIncrCmd(
Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
}
} else {
- Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+ Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewLongObj(1));
}
} else {
/*
@@ -2171,7 +2166,7 @@ DictIncrCmd(
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
} else {
- Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
+ Tcl_Obj *incrPtr = Tcl_NewLongObj(1);
Tcl_IncrRefCount(incrPtr);
code = TclIncrObj(interp, valuePtr, incrPtr);
@@ -2179,7 +2174,7 @@ DictIncrCmd(
}
}
if (code == TCL_OK) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
dictPtr, TCL_LEAVE_ERR_MSG);
if (valuePtr == NULL) {
@@ -2268,7 +2263,7 @@ DictLappendCmd(
if (allocatedValue) {
Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
} else if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
@@ -2916,8 +2911,8 @@ DictFilterCmd(
Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
- 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], filters,
+ sizeof(char *), "filterType", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index d2c7bc8..27a443f 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src);
* convert between various character sets and UTF-8.
*/
-typedef struct Encoding {
+typedef struct {
char *name; /* Name of encoding. Malloced because (1) hash
* table entry that owns this encoding may be
* freed prior to this encoding being freed,
@@ -57,7 +57,7 @@ typedef struct Encoding {
* encoding.
*/
-typedef struct TableEncodingData {
+typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -91,7 +91,7 @@ typedef struct TableEncodingData {
* for switching character sets.
*/
-typedef struct EscapeSubTable {
+typedef struct {
unsigned sequenceLen; /* Length of following string. */
char sequence[16]; /* Escape code that marks this encoding. */
char name[32]; /* Name for encoding. */
@@ -100,7 +100,7 @@ typedef struct EscapeSubTable {
* yet. */
} EscapeSubTable;
-typedef struct EscapeEncodingData {
+typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -270,7 +270,7 @@ static int Iso88591ToUtfProc(ClientData clientData,
int *dstCharsPtr);
/*
- * A Tcl_ObjType for holding a cached Tcl_Encoding in the otherValuePtr field
+ * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
* of the intrep. This should help the lifetime of encodings be more useful.
* See concerns raised in [Bug 1077262].
*/
@@ -313,7 +313,7 @@ Tcl_GetEncodingFromObj(
return TCL_ERROR;
}
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = encoding;
+ objPtr->internalRep.twoPtrValue.ptr1 = encoding;
objPtr->typePtr = &encodingType;
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
@@ -334,7 +334,7 @@ static void
FreeEncodingIntRep(
Tcl_Obj *objPtr)
{
- Tcl_FreeEncoding(objPtr->internalRep.otherValuePtr);
+ Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -353,7 +353,7 @@ DupEncodingIntRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- dupPtr->internalRep.otherValuePtr = Tcl_GetEncoding(NULL, srcPtr->bytes);
+ dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
}
/*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index b76c603..03f5edf 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -4,7 +4,7 @@
* Contains support for ensembles (see TIP#112), which provide simple
* mechanism for creating composite commands on top of namespaces.
*
- * Copyright (c) 2005-2010 Donal K. Fellows.
+ * Copyright (c) 2005-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.
@@ -35,6 +35,15 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
+static int CompileToCompiledCommand(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+ CompileEnv *envPtr);
+static void CompileToInvokedCommand(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Tcl_Obj *replacements,
+ Command *cmdPtr, CompileEnv *envPtr);
+static int CompileBasicNArgCommand(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ CompileEnv *envPtr);
/*
* The lists of subcommands and options for the [namespace ensemble] command.
@@ -78,6 +87,17 @@ const Tcl_ObjType tclEnsembleCmdType = {
StringOfEnsembleCmdRep, /* updateStringProc */
NULL /* setFromAnyProc */
};
+
+/*
+ * Copied from tclCompCmds.c
+ */
+
+#define DefineLineInformation \
+ ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
+ int eclIndex = mapPtr->nuloc - 1
+#define SetLineInformation(word) \
+ envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
+ envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
static inline Tcl_Obj *
NewNsObj(
@@ -142,8 +162,8 @@ TclNamespaceEnsembleCmd(
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands,
- "subcommand", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], ensembleSubcommands,
+ sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -187,8 +207,8 @@ TclNamespaceEnsembleCmd(
*/
for (; objc>1 ; objc-=2,objv+=2) {
- if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0], ensembleCreateOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
@@ -361,8 +381,8 @@ TclNamespaceEnsembleCmd(
if (objc == 4) {
Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */
- if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], ensembleConfigOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum EnsConfigOpts) index) {
@@ -482,8 +502,8 @@ TclNamespaceEnsembleCmd(
*/
for (; objc>0 ; objc-=2,objv+=2) {
- if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0],ensembleConfigOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
freeMapAndError:
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
@@ -1565,21 +1585,23 @@ TclMakeEnsemble(
NULL);
}
cmdPtr->compileProc = map[i].compileProc;
- if (map[i].compileProc != NULL) {
- ensembleFlags |= ENSEMBLE_COMPILE;
- }
}
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
- if (ensembleFlags & ENSEMBLE_COMPILE) {
- Tcl_SetEnsembleFlags(interp, ensemble, ensembleFlags);
- }
+
+ /*
+ * Switch on compilation always for core ensembles now that we can do
+ * nice bytecode things with them.
+ */
+
+ Tcl_SetEnsembleFlags(interp, ensemble,
+ ensembleFlags | ENSEMBLE_COMPILE);
}
Tcl_DStringFree(&buf);
Tcl_DStringFree(&hiddenBuf);
if (nameParts != NULL) {
- Tcl_Free((char *) nameParts);
+ ckfree((char *) nameParts);
}
return ensemble;
}
@@ -1696,7 +1718,7 @@ NsEnsembleImplementationCmdNR(
if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
- ->internalRep.otherValuePtr;
+ ->internalRep.twoPtrValue.ptr1;
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
ensembleCmd->epoch == ensemblePtr->epoch &&
@@ -1892,7 +1914,7 @@ NsEnsembleImplementationCmdNR(
* Hand off to the target command.
*/
- iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+ TclSkipTailcall(interp);
return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
}
@@ -2100,7 +2122,7 @@ EnsembleUnknownCallback(
*/
Tcl_Preserve(ensemblePtr);
- ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+ TclSkipTailcall(interp);
result = Tcl_EvalObjv(interp, paramc, paramv, 0);
if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
if (!Tcl_InterpDeleted(interp)) {
@@ -2174,7 +2196,7 @@ EnsembleUnknownCallback(
}
Tcl_AddErrorInfo(interp, "\n result of "
"ensemble unknown subcommand handler: ");
- Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+ Tcl_AppendObjToErrorInfo(interp, unknownCmd);
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
NULL);
} else {
@@ -2216,7 +2238,7 @@ MakeCachedEnsembleCommand(
int length;
if (objPtr->typePtr == &tclEnsembleCmdType) {
- ensembleCmd = objPtr->internalRep.otherValuePtr;
+ ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
TclNsDecrRefCount(ensembleCmd->nsPtr);
ckfree(ensembleCmd->fullSubcmdName);
@@ -2228,7 +2250,7 @@ MakeCachedEnsembleCommand(
TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
- objPtr->internalRep.otherValuePtr = ensembleCmd;
+ objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
objPtr->typePtr = &tclEnsembleCmdType;
}
@@ -2623,7 +2645,7 @@ static void
FreeEnsembleCmdRep(
Tcl_Obj *objPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr;
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
ckfree(ensembleCmd->fullSubcmdName);
@@ -2655,12 +2677,12 @@ DupEnsembleCmdRep(
Tcl_Obj *objPtr,
Tcl_Obj *copyPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr;
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
int length = strlen(ensembleCmd->fullSubcmdName);
copyPtr->typePtr = &tclEnsembleCmdType;
- copyPtr->internalRep.otherValuePtr = ensembleCopy;
+ copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
ensembleCopy->nsPtr = ensembleCmd->nsPtr;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
@@ -2693,7 +2715,7 @@ static void
StringOfEnsembleCmdRep(
Tcl_Obj *objPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr;
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
int length = strlen(ensembleCmd->fullSubcmdName);
objPtr->length = length;
@@ -2731,25 +2753,33 @@ TclCompileEnsemble(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+ Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
Tcl_Command ensemble = (Tcl_Command) cmdPtr;
- Tcl_Parse synthetic;
- int len, result, flags = 0, i;
+ Command *oldCmdPtr = cmdPtr, *newCmdPtr;
+ int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
+ int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
- if (parsePtr->numWords < 2) {
- return TCL_ERROR;
- }
+ Tcl_IncrRefCount(replaced);
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ /*
+ * 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;
+ }
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
* Too hard.
*/
- return TCL_ERROR;
+ goto failed;
}
word = tokenPtr[1].start;
@@ -2768,7 +2798,7 @@ TclCompileEnsemble(
* to proceed.
*/
- return TCL_ERROR;
+ goto failed;
}
/*
@@ -2782,7 +2812,7 @@ TclCompileEnsemble(
* Figuring out how to compile this has become too much. Bail out.
*/
- return TCL_ERROR;
+ goto failed;
}
/*
@@ -2805,7 +2835,7 @@ TclCompileEnsemble(
Tcl_Obj *matchObj = NULL;
if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
- return TCL_ERROR;
+ goto failed;
}
for (i=0 ; i<len ; i++) {
str = Tcl_GetStringFromObj(elems[i], &sclen);
@@ -2816,8 +2846,9 @@ TclCompileEnsemble(
result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
if (result != TCL_OK || targetCmdObj == NULL) {
- return TCL_ERROR;
+ goto failed;
}
+ replacement = elems[i];
goto doneMapLookup;
}
@@ -2833,18 +2864,19 @@ TclCompileEnsemble(
if ((flags & TCL_ENSEMBLE_PREFIX)
&& strncmp(word, str, numBytes) == 0) {
if (matchObj != NULL) {
- return TCL_ERROR;
+ goto failed;
}
matchObj = elems[i];
}
}
if (matchObj == NULL) {
- return TCL_ERROR;
+ goto failed;
}
result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
if (result != TCL_OK || targetCmdObj == NULL) {
- return TCL_ERROR;
+ goto failed;
}
+ replacement = matchObj;
} else {
Tcl_DictSearch s;
int done, matched;
@@ -2856,14 +2888,15 @@ TclCompileEnsemble(
TclNewStringObj(subcmdObj, word, (int) numBytes);
result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
- TclDecrRefCount(subcmdObj);
if (result == TCL_OK && targetCmdObj != NULL) {
/*
* Got it. Skip the fiddling around with prefixes.
*/
+ replacement = subcmdObj;
goto doneMapLookup;
}
+ TclDecrRefCount(subcmdObj);
/*
* We've not literally got a valid subcommand. But maybe we have a
@@ -2871,7 +2904,7 @@ TclCompileEnsemble(
*/
if (!(flags & TCL_ENSEMBLE_PREFIX)) {
- return TCL_ERROR;
+ goto failed;
}
/*
@@ -2881,6 +2914,7 @@ TclCompileEnsemble(
Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done);
matched = 0;
+ replacement = NULL; /* Silence, fool compiler! */
while (!done) {
if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
if (matched++) {
@@ -2891,6 +2925,7 @@ TclCompileEnsemble(
break;
}
+ replacement = subcmdObj;
targetCmdObj = tmpObj;
}
Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
@@ -2903,7 +2938,8 @@ TclCompileEnsemble(
*/
if (matched != 1) {
- return TCL_ERROR;
+ invokeAnyway = 1;
+ goto failed;
}
}
@@ -2917,75 +2953,157 @@ TclCompileEnsemble(
*/
doneMapLookup:
+ Tcl_ListObjAppendElement(NULL, replaced, replacement);
if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
- return TCL_ERROR;
- }
- if (len > 1 && Tcl_IsSafe(interp)) {
- return TCL_ERROR;
+ goto failed;
+ } else if (len != 1) {
+ /*
+ * Note that at this point we know we can't issue any special
+ * instruction sequence as the mapping isn't one that we support at
+ * the compiled level.
+ */
+
+ goto cleanup;
}
targetCmdObj = elems[0];
+ oldCmdPtr = cmdPtr;
Tcl_IncrRefCount(targetCmdObj);
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+ newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
TclDecrRefCount(targetCmdObj);
- if (cmdPtr == NULL || cmdPtr->compileProc == NULL
- || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
- || cmdPtr->flags * CMD_HAS_EXEC_TRACES
+ if (newCmdPtr == NULL || Tcl_IsSafe(interp)
+ || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
+ || newCmdPtr->flags & CMD_HAS_EXEC_TRACES
|| ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
/*
* Maps to an undefined command or a command without a compiler.
* Cannot compile.
*/
- return TCL_ERROR;
+ goto cleanup;
+ }
+ cmdPtr = newCmdPtr;
+ depth++;
+
+ /*
+ * See whether we have a nested ensemble. If we do, we can go round the
+ * mulberry bush again, consuming the next word.
+ */
+
+ if (cmdPtr->compileProc == TclCompileEnsemble) {
+ tokenPtr = TokenAfter(tokenPtr);
+ ensemble = (Tcl_Command) cmdPtr;
+ goto checkNextWord;
}
/*
* Now we've done the mapping process, can now actually try to compile.
- * We do this by handing off to the subcommand's actual compiler. But to
- * do that, we have to perform some trickery to rewrite the arguments.
+ * If there is a subcommand compiler and that successfully produces code,
+ * we'll use that. Otherwise, we fall back to generating opcodes to do the
+ * invoke at runtime.
*/
- TclParseInit(interp, NULL, 0, &synthetic);
- synthetic.numWords = parsePtr->numWords - 2 + len;
- TclGrowParseTokenArray(&synthetic, 2*len);
- synthetic.numTokens = 2*len;
+ invokeAnyway = 1;
+ if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr,
+ envPtr) == TCL_OK) {
+ ourResult = TCL_OK;
+ goto cleanup;
+ }
/*
- * Now we have the space to work in, install something rewritten. Note
- * that we are here praying for all our might that none of these words are
- * a script; the error detection code will crash if that happens and there
- * is nothing we can do to avoid it!
+ * Failed to do a full compile for some reason. Try to do a direct invoke
+ * instead of going through the ensemble lookup process again.
*/
- for (i=0 ; i<len ; i++) {
- int sclen;
- const char *str = Tcl_GetStringFromObj(elems[i], &sclen);
+ failed:
+ if (depth < 250) {
+ if (depth > 1) {
+ if (!invokeAnyway) {
+ cmdPtr = oldCmdPtr;
+ depth--;
+ }
+ (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
+ }
+ CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
+ ourResult = TCL_OK;
+ }
+
+ /*
+ * Release the memory we allocated. If we've got here, we've either done
+ * something useful or we're in a case that we can't compile at all and
+ * we're just giving up.
+ */
+
+ cleanup:
+ Tcl_DecrRefCount(replaced);
+ return ourResult;
+}
+
+/*
+ * How to compile a subcommand using its own command compiler. To do that, we
+ * have to perform some trickery to rewrite the arguments, as compilers *must*
+ * have parse tokens that refer to addresses in the original script.
+ */
+
+static int
+CompileToCompiledCommand(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ int depth,
+ Command *cmdPtr,
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Parse synthetic;
+ Tcl_Token *tokenPtr;
+ int result, i;
+ int savedNumCmds = envPtr->numCommands;
+ int savedStackDepth = envPtr->currStackDepth;
+ unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
- synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD;
- synthetic.tokenPtr[2*i].start = str;
- synthetic.tokenPtr[2*i].size = sclen;
- synthetic.tokenPtr[2*i].numComponents = 1;
+ if (cmdPtr->compileProc == NULL) {
+ return TCL_ERROR;
+ }
- synthetic.tokenPtr[2*i+1].type = TCL_TOKEN_TEXT;
- synthetic.tokenPtr[2*i+1].start = str;
- synthetic.tokenPtr[2*i+1].size = sclen;
- synthetic.tokenPtr[2*i+1].numComponents = 0;
+ TclParseInit(interp, NULL, 0, &synthetic);
+ synthetic.numWords = parsePtr->numWords - depth + 1;
+ TclGrowParseTokenArray(&synthetic, 2);
+ synthetic.numTokens = 2;
+
+ /*
+ * Now we have the space to work in, install something rewritten. The
+ * first word will "officially" be the bytes of the structured ensemble
+ * name. That's technically wrong, but nobody will care; we just need
+ * *something* here...
+ */
+
+ synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD;
+ synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start;
+ synthetic.tokenPtr[0].numComponents = 1;
+ synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT;
+ synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start;
+ synthetic.tokenPtr[1].numComponents = 0;
+ for (i=0,tokenPtr=parsePtr->tokenPtr ; i<depth ; i++) {
+ int sclen = (tokenPtr->start - synthetic.tokenPtr[0].start)
+ + tokenPtr->size;
+
+ synthetic.tokenPtr[0].size = sclen;
+ synthetic.tokenPtr[1].size = sclen;
+ tokenPtr = TokenAfter(tokenPtr);
}
/*
* Copy over the real argument tokens.
*/
- for (i=len; i<synthetic.numWords; i++) {
+ for (i=1; i<synthetic.numWords; i++) {
int toCopy;
- tokenPtr = TokenAfter(tokenPtr);
toCopy = tokenPtr->numComponents + 1;
TclGrowParseTokenArray(&synthetic, toCopy);
memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
sizeof(Tcl_Token) * toCopy);
synthetic.numTokens += toCopy;
+ tokenPtr = TokenAfter(tokenPtr);
}
/*
@@ -2995,12 +3113,428 @@ TclCompileEnsemble(
result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
/*
+ * If our target fails to compile, revert the number of commands and the
+ * pointer to the place to issue the next instruction. [Bug 3600328]
+ */
+
+ if (result != TCL_OK) {
+ envPtr->numCommands = savedNumCmds;
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+ }
+
+ /*
* Clean up if necessary.
*/
Tcl_FreeParse(&synthetic);
return result;
}
+
+/*
+ * How to compile a subcommand to a _replacing_ invoke of its implementation
+ * command.
+ */
+
+static void
+CompileToInvokedCommand(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Tcl_Obj *replacements,
+ Command *cmdPtr,
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokPtr;
+ Tcl_Obj *objPtr, **words;
+ char *bytes;
+ int length, i, numWords, cmdLit;
+ DefineLineInformation;
+
+ /*
+ * Push the words of the command. Take care; the command words may be
+ * scripts that have backslashes in them, and [info frame 0] can see the
+ * difference. Hence the call to TclContinuationsEnterDerived...
+ */
+
+ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
+ for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+ if (i > 0 && i < numWords+1) {
+ bytes = Tcl_GetStringFromObj(words[i-1], &length);
+ PushLiteral(envPtr, bytes, length);
+ } else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ int literal = TclRegisterNewLiteral(envPtr,
+ tokPtr[1].start, tokPtr[1].size);
+
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(
+ TclFetchLiteral(envPtr, literal),
+ tokPtr[1].start - envPtr->source,
+ mapPtr->loc[eclIndex].next[i]);
+ }
+ TclEmitPush(literal, envPtr);
+ } else {
+ if (envPtr->clNext) {
+ SetLineInformation(i);
+ }
+ CompileTokens(envPtr, tokPtr, interp);
+ }
+ tokPtr = TokenAfter(tokPtr);
+ }
+
+ /*
+ * Push the name of the command we're actually dispatching to as part of
+ * the implementation.
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
+ TclEmitPush(cmdLit, envPtr);
+ TclDecrRefCount(objPtr);
+
+ /*
+ * Do the replacing dispatch.
+ */
+
+ TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr);
+ TclEmitInt1(numWords+1, envPtr);
+ TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */
+}
+
+/*
+ * Helpers that do issuing of instructions for commands that "don't have
+ * compilers" (well, they do; these). They all work by just generating base
+ * code to invoke the command; they're intended for ensemble subcommands so
+ * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out
+ * that they're not needed.
+ *
+ * Note that these are NOT suitable for commands where there's an argument
+ * that is a script, as an [info level] or [info frame] in the inner context
+ * can see the difference.
+ */
+
+static int
+CompileBasicNArgCommand(
+ 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;
+ Tcl_Obj *objPtr;
+ char *bytes;
+ int length, i, literal;
+ DefineLineInformation;
+
+ /*
+ * Push the name of the command we're actually dispatching to as part of
+ * the implementation.
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
+ TclEmitPush(literal, envPtr);
+ TclDecrRefCount(objPtr);
+
+ /*
+ * Push the words of the command.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i=1 ; i<parsePtr->numWords ; i++) {
+ if (envPtr->clNext) {
+ SetLineInformation(i);
+ }
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
+ } else {
+ CompileTokens(envPtr, tokenPtr, interp);
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Do the standard dispatch.
+ */
+
+ if (i <= 255) {
+ TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
+ } else {
+ TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
+ }
+ return TCL_OK;
+}
+
+int
+TclCompileBasic0ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 1) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0Or1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 1 && parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1Or2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2Or3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0To2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 1 || parsePtr->numWords > 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1To3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin0ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 1) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
/*
* Local Variables:
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 0b585b6..16e0bf3 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -37,7 +37,7 @@ typedef struct BgError {
* pending background errors for the interpreter.
*/
-typedef struct ErrAssocData {
+typedef struct {
Tcl_Interp *interp; /* Interpreter in which error occurred. */
Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */
BgError *firstBgPtr; /* First in list of all background errors
@@ -891,7 +891,7 @@ Tcl_SetExitProc(
*----------------------------------------------------------------------
*/
static void
-InvokeExitHandlers(void)
+InvokeExitHandlers(void)
{
ExitHandler *exitPtr;
@@ -967,22 +967,22 @@ 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();
}
TclpExit(status);
@@ -1094,7 +1094,7 @@ Tcl_Finalize(void)
* Invoke exit handlers first.
*/
- InvokeExitHandlers();
+ InvokeExitHandlers();
TclpInitLock();
if (subsystemsInitialized == 0) {
@@ -1402,7 +1402,7 @@ Tcl_VwaitObjCmd(
return TCL_ERROR;
}
nameString = Tcl_GetString(objv[1]);
- if (Tcl_TraceVar(interp, nameString,
+ if (Tcl_TraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &done) != TCL_OK) {
return TCL_ERROR;
@@ -1420,7 +1420,7 @@ Tcl_VwaitObjCmd(
break;
}
}
- Tcl_UntraceVar(interp, nameString,
+ Tcl_UntraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &done);
@@ -1498,8 +1498,8 @@ Tcl_UpdateObjCmd(
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
} else if (objc == 2) {
- if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
- "option", 0, &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], updateOptions,
+ sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum updateOptions) optionIndex) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cb1864c40..b872bd9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -114,7 +114,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
* Minimal data required to fully reconstruct the execution state.
*/
-typedef struct TEBCdata {
+typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
const unsigned char *pc; /* These fields are used on return TO this */
@@ -194,13 +194,27 @@ VarHashCreateVar(
* otherwise, push objResultPtr. If (result < 0), objResultPtr already
* has the correct reference count.
*
- * We use the new compile-time assertions to cheack that nCleanup is constant
+ * We use the new compile-time assertions to check that nCleanup is constant
* and within range.
*/
-#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
+/* Verify the stack depth, only when no expansion is in progress */
+
+#if TCL_COMPILE_DEBUG
+#define CHECK_STACK() \
+ do { \
+ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \
+ /*checkStack*/ !(starting || auxObjList)); \
+ starting = 0; \
+ } while (0)
+#else
+#define CHECK_STACK()
+#endif
+
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
do { \
TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \
+ CHECK_STACK(); \
if (nCleanup == 0) { \
if (resultHandling != 0) { \
if ((resultHandling) > 0) { \
@@ -229,7 +243,8 @@ VarHashCreateVar(
} \
} while (0)
-#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
+#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
+ CHECK_STACK(); \
do { \
pc += (pcAdjustment); \
cleanup = (nCleanup); \
@@ -628,7 +643,7 @@ static void PrintByteCodeInfo(ByteCode *codePtr);
static const char * StringForResultCode(int result);
static void ValidatePcAndStackTop(ByteCode *codePtr,
const unsigned char *pc, int stackTop,
- int stackLowerBound, int checkStack);
+ int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void DeleteExecStack(ExecStack *esPtr);
@@ -797,9 +812,9 @@ TclCreateExecEnv(
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
- TclNewBooleanObj(eePtr->constants[0], 0);
+ TclNewLongObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
- TclNewBooleanObj(eePtr->constants[1], 1);
+ TclNewLongObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
@@ -991,6 +1006,7 @@ GrowEvaluationStack(
return MEMSTART(markerPtr);
}
} else {
+#ifndef PURIFY
Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
int offset = OFFSET(tmpMarkerPtr);
@@ -1007,6 +1023,7 @@ GrowEvaluationStack(
*esPtr->markerPtr = (Tcl_Obj *) markerPtr;
return memStart;
}
+#endif
}
/*
@@ -1020,6 +1037,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!)
@@ -1049,10 +1067,15 @@ GrowEvaluationStack(
* including the elements to be copied over and the new marker.
*/
+#ifndef PURIFY
newElems = 2*currElems;
while (needed > newElems) {
newElems *= 2;
}
+#else
+ newElems = needed;
+#endif
+
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
oldPtr = esPtr;
@@ -1155,7 +1178,7 @@ TclStackFree(
Tcl_Obj **markerPtr, *marker;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- Tcl_Free((char *) freePtr);
+ ckfree((char *) freePtr);
return;
}
@@ -1201,6 +1224,10 @@ TclStackFree(
}
if (esPtr->prevPtr) {
eePtr->execStackPtr = esPtr->prevPtr;
+#ifdef PURIFY
+ eePtr->execStackPtr->nextPtr = NULL;
+ DeleteExecStack(esPtr);
+#endif
} else {
eePtr->execStackPtr = esPtr;
}
@@ -1215,7 +1242,7 @@ TclStackAlloc(
int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Alloc(numBytes);
+ return (void *) ckalloc(numBytes);
}
return (void *) StackAllocWords(interp, numWords);
@@ -1234,7 +1261,7 @@ TclStackRealloc(
int numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Realloc((char *) ptr, numBytes);
+ return (void *) ckrealloc((char *) ptr, numBytes);
}
eePtr = iPtr->execEnvPtr;
@@ -1410,7 +1437,7 @@ CompileExprObj(
if (objPtr->typePtr == &exprCodeType) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1450,7 +1477,7 @@ CompileExprObj(
TclInitByteCodeObj(objPtr, &compEnv);
objPtr->typePtr = &exprCodeType;
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1522,10 +1549,9 @@ static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
@@ -1583,7 +1609,7 @@ TclCompileObj(
* here.
*/
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1711,7 +1737,7 @@ TclCompileObj(
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -2003,7 +2029,8 @@ TEBCresume(
Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
* stack. */
const unsigned char *pc; /* The current program counter. */
-
+ unsigned char inst; /* The currently running instruction */
+
/*
* Transfer variables - needed only between opcodes, but not while
* executing an instruction.
@@ -2028,6 +2055,7 @@ TEBCresume(
#endif
#ifdef TCL_COMPILE_DEBUG
+ int starting = 1;
traceInstructions = (tclTraceExec == 3);
#endif
@@ -2169,24 +2197,6 @@ TEBCresume(
}
cleanup0:
-#ifdef TCL_COMPILE_DEBUG
- /*
- * Skip the stack depth check if an expansion is in progress.
- */
-
- ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
- /*checkStack*/ auxObjList == NULL);
- if (traceInstructions) {
- fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
- TclPrintInstruction(codePtr, pc);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.instructionCount[*pc]++;
-#endif
-
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
* ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
@@ -2218,8 +2228,6 @@ TEBCresume(
CACHE_STACK_INFO();
}
- TCL_DTRACE_INST_NEXT();
-
/*
* These two instructions account for 26% of all instructions (according
* to measurements on tclbench by Ben Vitale
@@ -2229,13 +2237,53 @@ TEBCresume(
* reduces total obj size.
*/
- if (*pc == INST_LOAD_SCALAR1) {
- goto instLoadScalar1;
- } else if (*pc == INST_PUSH1) {
- goto instPush1Peephole;
+ inst = *pc;
+
+ peepholeStart:
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.instructionCount[*pc]++;
+#endif
+
+#ifdef TCL_COMPILE_DEBUG
+ /*
+ * Skip the stack depth check if an expansion is in progress.
+ */
+
+ CHECK_STACK();
+ if (traceInstructions) {
+ fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
+ TclPrintInstruction(codePtr, pc);
+ fflush(stdout);
}
+#endif /* TCL_COMPILE_DEBUG */
- switch (*pc) {
+ TCL_DTRACE_INST_NEXT();
+
+ if (inst == INST_LOAD_SCALAR1) {
+ goto instLoadScalar1;
+ } else if (inst == INST_PUSH1) {
+ PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+ TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
+ inst = *(pc += 2);
+ goto peepholeStart;
+ } else if (inst == INST_START_CMD) {
+ /*
+ * Peephole: do not run INST_START_CMD, just skip it
+ */
+
+ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
+ if (checkInterp) {
+ checkInterp = 0;
+ if ((codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) {
+ goto instStartCmdFailed;
+ }
+ }
+ inst = *(pc += 9);
+ goto peepholeStart;
+ }
+
+ switch (inst) {
case INST_SYNTAX:
case INST_RETURN_IMM: {
int code = TclGetInt4AtPtr(pc+1);
@@ -2319,7 +2367,6 @@ TEBCresume(
case INST_TAILCALL: {
Tcl_Obj *listPtr, *nsObjPtr;
- NRE_callback *tailcallPtr;
opnd = TclGetUInt1AtPtr(pc+1);
@@ -2353,18 +2400,12 @@ TEBCresume(
listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
- Tcl_IncrRefCount(listPtr);
- Tcl_IncrRefCount(nsObjPtr);
- TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
- NULL, NULL);
-
- /*
- * Unstitch ourselves and do a [return].
- */
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+ if (iPtr->varFramePtr->tailcallPtr) {
+ Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+ }
+ iPtr->varFramePtr->tailcallPtr = listPtr;
- tailcallPtr = TOP_CB(interp);
- TOP_CB(interp) = tailcallPtr->nextPtr;
- iPtr->varFramePtr->tailcallPtr = tailcallPtr;
result = TCL_RETURN;
cleanup = opnd;
goto processExceptionReturn;
@@ -2392,23 +2433,6 @@ TEBCresume(
(void) POP_OBJECT();
goto abnormalReturn;
- case INST_PUSH1:
- instPush1Peephole:
- PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
- TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
- pc += 2;
-#if !TCL_COMPILE_DEBUG
- /*
- * Runtime peephole optimisation: check if we are pushing again.
- */
-
- if (*pc == INST_PUSH1) {
- TCL_DTRACE_INST_NEXT();
- goto instPush1Peephole;
- }
-#endif
- NEXT_INST_F(0, 0, 0);
-
case INST_PUSH4:
objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
@@ -2418,68 +2442,10 @@ TEBCresume(
TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
objPtr = POP_OBJECT();
TclDecrRefCount(objPtr);
-
- /*
- * Runtime peephole optimisation: an INST_POP is scheduled at the end
- * of most commands. If the next instruction is an INST_START_CMD,
- * fall through to it.
- */
-
- pc++;
-#if !TCL_COMPILE_DEBUG
- if (*pc == INST_START_CMD) {
- TCL_DTRACE_INST_NEXT();
- goto instStartCmdPeephole;
- }
-#endif
- NEXT_INST_F(0, 0, 0);
-
- case INST_START_CMD:
-#if !TCL_COMPILE_DEBUG
- instStartCmdPeephole:
-#endif
- /*
- * Remark that if the interpreter is marked for deletion its
- * compileEpoch is modified, so that the epoch check also verifies
- * that the interp is not deleted. If no outside call has been made
- * since the last check, it is safe to omit the check.
- */
-
- iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
- if (!checkInterp) {
- goto instStartCmdOK;
- } else if (((codePtr->compileEpoch == iPtr->compileEpoch)
- && (codePtr->nsEpoch == iPtr->varFramePtr->nsPtr->resolverEpoch))
- || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
- checkInterp = 0;
- instStartCmdOK:
- NEXT_INST_F(9, 0, 0);
- } else {
- const char *bytes;
-
- length = 0;
-
- /*
- * We used to switch to direct eval; for NRE-awareness we now
- * compile and eval the command so that this evaluation does not
- * add a new TEBC instance. [Bug 2910748]
- */
-
- if (TclInterpReady(interp) == TCL_ERROR) {
- goto gotError;
- }
-
- codePtr->flags |= TCL_BYTECODE_RECOMPILE;
- bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
- opnd = TclGetUInt4AtPtr(pc+1);
- pc += (opnd-1);
- PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
- goto instEvalStk;
- }
+ NEXT_INST_F(1, 0, 0);
case INST_NOP:
- pc += 1;
- goto cleanup0;
+ NEXT_INST_F(1, 0, 0);
case INST_DUP:
objResultPtr = OBJ_AT_TOS;
@@ -2840,6 +2806,70 @@ TEBCresume(
case INST_CALL_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+ case INST_INVOKE_REPLACE:
+ objc = TclGetUInt4AtPtr(pc+1);
+ opnd = TclGetUInt1AtPtr(pc+5);
+ objPtr = POP_OBJECT();
+ objv = &OBJ_AT_DEPTH(objc-1);
+ cleanup = objc;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ int i;
+
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
+ } else {
+ fprintf(stdout,
+ "%d: (%u) invoking (using implementation %s) ",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ O2S(objPtr));
+ }
+ for (i = 0; i < objc; i++) {
+ if (i < opnd) {
+ fprintf(stdout, "<");
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, ">");
+ } else {
+ TclPrintObject(stdout, objv[i], 15);
+ }
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ {
+ Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
+ register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj **copyObjv = &listRepPtr->elements;
+ int i;
+
+ listRepPtr->elemCount = objc - opnd + 1;
+ copyObjv[0] = objPtr;
+ memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
+ for (i=1 ; i<objc-opnd+1 ; i++) {
+ Tcl_IncrRefCount(copyObjv[i]);
+ }
+ objPtr = copyPtr;
+ }
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+ codePtr, bcFramePtr, pc - codePtr->codeStart);
+ }
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = opnd;
+ iPtr->ensembleRewrite.numInsertedObjs = 1;
+ DECACHE_STACK_INFO();
+ pc += 6;
+ TEBC_YIELD();
+
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
+ TclSkipTailcall(interp);
+ return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
+
/*
* -----------------------------------------------------------------
* Start of INST_LOAD instructions.
@@ -3301,8 +3331,8 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
if (!varPtr) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
+ Tcl_AddErrorInfo(interp,
+ "\n (reading value of variable to increment)");
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(incrPtr);
goto gotError;
@@ -4134,7 +4164,7 @@ TEBCresume(
NEXT_INST_F(1, 0, 1);
}
case INST_INFO_LEVEL_NUM:
- TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
+ TclNewLongObj(objResultPtr, iPtr->varFramePtr->level);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
case INST_INFO_LEVEL_ARGS: {
@@ -4263,7 +4293,7 @@ TEBCresume(
Tcl_GetObjResult(interp));
goto gotError;
}
- TclNewIntObj(objResultPtr, length);
+ TclNewLongObj(objResultPtr, length);
TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
@@ -4730,7 +4760,7 @@ TEBCresume(
}
}
if (match < 0) {
- TclNewIntObj(objResultPtr, -1);
+ TclNewLongObj(objResultPtr, -1);
} else {
objResultPtr = TCONST(match > 0);
}
@@ -4741,7 +4771,7 @@ TEBCresume(
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
length = Tcl_GetCharLength(valuePtr);
- TclNewIntObj(objResultPtr, length);
+ TclNewLongObj(objResultPtr, length);
TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
@@ -4929,7 +4959,7 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
@@ -4950,7 +4980,7 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
}
@@ -5290,7 +5320,7 @@ TEBCresume(
if (l1 > 0L) {
objResultPtr = TCONST(0);
} else {
- TclNewIntObj(objResultPtr, -1);
+ TclNewLongObj(objResultPtr, -1);
}
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
@@ -5972,7 +6002,7 @@ TEBCresume(
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
- TclNewIntObj(objResultPtr, result);
+ TclNewLongObj(objResultPtr, result);
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
@@ -6890,6 +6920,42 @@ TEBCresume(
TclStackFree(interp, TD); /* free my stack */
return result;
+
+ /*
+ * INST_START_CMD failure case removed where it doesn't bother that much
+ *
+ * Remark that if the interpreter is marked for deletion its
+ * compileEpoch is modified, so that the epoch check also verifies
+ * that the interp is not deleted. If no outside call has been made
+ * since the last check, it is safe to omit the check.
+
+ * case INST_START_CMD:
+ */
+
+ instStartCmdFailed:
+ {
+ const char *bytes;
+
+ checkInterp = 1;
+ length = 0;
+
+ /*
+ * We used to switch to direct eval; for NRE-awareness we now
+ * compile and eval the command so that this evaluation does not
+ * add a new TEBC instance. [Bug 2910748]
+ */
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ goto gotError;
+ }
+
+ codePtr->flags |= TCL_BYTECODE_RECOMPILE;
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pc += (opnd-1);
+ PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
+ goto instEvalStk;
+ }
}
#undef codePtr
@@ -8353,11 +8419,10 @@ ValidatePcAndStackTop(
int stackTop, /* Current stack top. Must be between
* stackLowerBound and stackUpperBound
* (inclusive). */
- int stackLowerBound, /* Smallest legal value for stackTop. */
int checkStack) /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ int stackUpperBound = codePtr->maxStackDepth;
/* Greatest legal value for stackTop. */
unsigned relativePc = (unsigned) (pc - codePtr->codeStart);
unsigned long codeStart = (unsigned long) codePtr->codeStart;
@@ -8375,13 +8440,13 @@ ValidatePcAndStackTop(
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
- ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+ if (checkStack &&
+ ((stackTop < 0) || (stackTop > stackUpperBound))) {
int numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
- fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
- stackTop, relativePc, stackLowerBound, stackUpperBound);
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
+ stackTop, relativePc, stackUpperBound);
if (cmd != NULL) {
Tcl_Obj *message;
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 33c1496..036a82c 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;
}
@@ -831,8 +831,8 @@ FileForceOption(
if (TclGetString(objv[i])[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
- &idx) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "option", TCL_EXACT, &idx) != TCL_OK) {
return -1;
}
if (idx == 0 /* -force */) {
@@ -1081,8 +1081,8 @@ TclFileAttrsCmd(
goto end;
}
- if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
goto end;
}
if (attributeStringsAllocated != NULL) {
@@ -1109,8 +1109,8 @@ TclFileAttrsCmd(
}
for (i = 0; i < objc ; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
goto end;
}
if (attributeStringsAllocated != NULL) {
@@ -1199,8 +1199,8 @@ TclFileLinkCmd(
static const char *const linkTypes[] = {
"-symbolic", "-hard", NULL
};
- if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
- &linkAction) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], linkTypes,
+ sizeof(char *), "switch", 0, &linkAction) != TCL_OK) {
return TCL_ERROR;
}
if (linkAction == 0) {
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index a519f0e..847a97a 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1256,8 +1256,8 @@ Tcl_GlobObjCmd(
dir = PATH_NONE;
typePtr = NULL;
for (i = 1; i < objc; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
string = Tcl_GetStringFromObj(objv[i], &length);
if (string[0] == '-') {
/*
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 4c19b55..97e8c7b 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -137,7 +137,7 @@ Tcl_GetBoolean(
obj.length = strlen(src);
obj.typePtr = NULL;
- code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
+ code = TclSetBooleanFromAny(interp, &obj);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0568d77..8e2c405 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -16,6 +16,108 @@
#include <assert.h>
/*
+ * For each channel handler registered in a call to Tcl_CreateChannelHandler,
+ * there is one record of the following type. All of records for a specific
+ * channel are chained together in a singly linked list which is stored in
+ * the channel structure.
+ */
+
+typedef struct ChannelHandler {
+ Channel *chanPtr; /* The channel structure for this channel. */
+ int mask; /* Mask of desired events. */
+ Tcl_ChannelProc *proc; /* Procedure to call in the type of
+ * Tcl_CreateChannelHandler. */
+ ClientData clientData; /* Argument to pass to procedure. */
+ struct ChannelHandler *nextPtr;
+ /* Next one in list of registered handlers. */
+} ChannelHandler;
+
+/*
+ * This structure keeps track of the current ChannelHandler being invoked in
+ * the current invocation of ChannelHandlerEventProc. 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
+ * 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
+ * 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.
+ */
+
+typedef struct NextChannelHandler {
+ ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
+ * this invocation. */
+ struct NextChannelHandler *nestedHandlerPtr;
+ /* Next nested invocation of
+ * ChannelHandlerEventProc. */
+} 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.
+ */
+
+typedef struct GetsState {
+ Tcl_Obj *objPtr; /* The object to which UTF-8 characters
+ * will be appended. */
+ char **dstPtr; /* Pointer into objPtr's string rep where
+ * next character should be stored. */
+ Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
+ * to UTF-8. */
+ ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
+ * emptied. */
+ Tcl_EncodingState state; /* The encoding state just before the last
+ * external to UTF-8 conversion in
+ * FilterInputBytes(). */
+ int rawRead; /* The number of bytes removed from bufPtr
+ * in the last call to FilterInputBytes(). */
+ int bytesWrote; /* The number of bytes of UTF-8 data
+ * appended to objPtr during the last call to
+ * FilterInputBytes(). */
+ int charsWrote; /* The corresponding number of UTF-8
+ * characters appended to objPtr during the
+ * last call to FilterInputBytes(). */
+ int totalChars; /* The total number of UTF-8 characters
+ * appended to objPtr so far, just before the
+ * last call to FilterInputBytes(). */
+} GetsState;
+
+/*
+ * The following structure encapsulates the state for a background channel
+ * copy. Note that the data buffer for the copy will be appended to this
+ * structure.
+ */
+
+typedef struct CopyState {
+ struct Channel *readPtr; /* Pointer to input channel. */
+ struct Channel *writePtr; /* Pointer to output channel. */
+ int readFlags; /* Original read channel flags. */
+ int writeFlags; /* Original write channel flags. */
+ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */
+ Tcl_WideInt total; /* Total bytes transferred (written). */
+ Tcl_Interp *interp; /* Interp that started the copy. */
+ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
+ int bufSize; /* Size of appended buffer. */
+ char buffer[1]; /* Copy buffer, this must be the last
+ * field. */
+} CopyState;
+
+/*
* All static variables used in this file are collected into a single instance
* of the following structure. For multi-threaded implementations, there is
* one instance of this structure for each thread.
@@ -24,7 +126,7 @@
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
* ChannelHandlerEventProc invocations. */
@@ -44,6 +146,18 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
+ * Structure to record a close callback. One such record exists for
+ * each close callback registered for a channel.
+ */
+
+typedef struct CloseCallback {
+ Tcl_CloseProc *proc; /* The procedure to call. */
+ ClientData clientData; /* Arbitrary one-word data to pass
+ * to the callback. */
+ struct CloseCallback *nextPtr; /* For chaining close callbacks. */
+} CloseCallback;
+
+/*
* Static functions in this file:
*/
@@ -221,9 +335,9 @@ static const Tcl_ObjType tclChannelType = {
};
#define GET_CHANNELSTATE(objPtr) \
- ((ChannelState *) (objPtr)->internalRep.otherValuePtr)
+ ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_CHANNELSTATE(objPtr, storePtr) \
- ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr))
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
#define GET_CHANNELINTERP(objPtr) \
((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
@@ -398,11 +512,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) {
@@ -454,9 +568,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) ||
@@ -695,6 +809,8 @@ Tcl_DeleteCloseHandler(
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
if (cbPrevPtr == NULL) {
statePtr->closeCbPtr = cbPtr->nextPtr;
+ } else {
+ cbPrevPtr->nextPtr = cbPtr->nextPtr;
}
ckfree(cbPtr);
break;
@@ -8860,8 +8976,8 @@ Tcl_FileEventObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
- &modeIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], modeOptions,
+ sizeof(char *), "event name", 0, &modeIndex) != TCL_OK) {
return TCL_ERROR;
}
mask = maskArray[modeIndex];
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 1e89878..e84f300 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -30,26 +30,6 @@
#endif
/*
- * The following structure encapsulates the state for a background channel
- * copy. Note that the data buffer for the copy will be appended to this
- * structure.
- */
-
-typedef struct CopyState {
- struct Channel *readPtr; /* Pointer to input channel. */
- struct Channel *writePtr; /* Pointer to output channel. */
- int readFlags; /* Original read channel flags. */
- int writeFlags; /* Original write channel flags. */
- Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */
- Tcl_WideInt total; /* Total bytes transferred (written). */
- Tcl_Interp *interp; /* Interp that started the copy. */
- Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
- int bufSize; /* Size of appended buffer. */
- char buffer[1]; /* Copy buffer, this must be the last
- * field. */
-} CopyState;
-
-/*
* struct ChannelBuffer:
*
* Buffers data being sent to or from a channel.
@@ -86,19 +66,6 @@ typedef struct ChannelBuffer {
#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
/*
- * Structure to record a close callback. One such record exists for each close
- * callback registered for a channel.
- */
-
-typedef struct CloseCallback {
- Tcl_CloseProc *proc; /* The procedure to call. */
- ClientData clientData; /* Arbitrary one-word data to pass to the
- * callback. */
- struct CloseCallback *nextPtr;
- /* For chaining close callbacks. */
-} CloseCallback;
-
-/*
* The following structure describes the information saved from a call to
* "fileevent". This is used later when the event being waited for to invoke
* the saved script in the interpreter designed in this record.
@@ -195,7 +162,8 @@ typedef struct ChannelState {
* value is the POSIX error code. */
int refCount; /* How many interpreters hold references to
* this IO channel? */
- CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
+ struct CloseCallback *closeCbPtr;
+ /* Callbacks registered to be called when the
* channel is closed. */
char *outputStage; /* Temporary staging buffer used when
* translating EOL before converting from
@@ -217,8 +185,10 @@ typedef struct ChannelState {
* handlers ("fileevent") on this channel. */
int bufSize; /* What size buffers to allocate? */
Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
- CopyState *csPtrR; /* State of background copy for which channel is input, or NULL. */
- CopyState *csPtrW; /* State of background copy for which channel is output, or NULL. */
+ struct CopyState *csPtrR; /* State of background copy for which channel
+ * is input, or NULL. */
+ struct CopyState *csPtrW; /* State of background copy for which channel
+ * is output, or NULL. */
Channel *topChanPtr; /* Refers to topmost channel in a stack. Never
* NULL. */
Channel *bottomChanPtr; /* Refers to bottommost channel in a stack.
@@ -342,89 +312,6 @@ typedef struct ChannelState {
* the channel is allowed. */
/*
- * For each channel handler registered in a call to Tcl_CreateChannelHandler,
- * there is one record of the following type. All of records for a specific
- * channel are chained together in a singly linked list which is stored in the
- * channel structure.
- */
-
-typedef struct ChannelHandler {
- Channel *chanPtr; /* The channel structure for this channel. */
- int mask; /* Mask of desired events. */
- Tcl_ChannelProc *proc; /* Procedure to call in the type of
- * Tcl_CreateChannelHandler. */
- ClientData clientData; /* Argument to pass to procedure. */
- struct ChannelHandler *nextPtr;
- /* Next one in list of registered handlers. */
-} ChannelHandler;
-
-/*
- * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. 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
- * 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
- * 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.
- */
-
-typedef struct NextChannelHandler {
- ChannelHandler *nextHandlerPtr;
- /* The next handler to be invoked in this
- * invocation. */
- struct NextChannelHandler *nestedHandlerPtr;
- /* Next nested invocation of
- * ChannelHandlerEventProc. */
-} 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.
- */
-
-typedef struct GetsState {
- Tcl_Obj *objPtr; /* The object to which UTF-8 characters will
- * be appended. */
- char **dstPtr; /* Pointer into objPtr's string rep where next
- * character should be stored. */
- Tcl_Encoding encoding; /* The encoding to use to convert raw bytes to
- * UTF-8. */
- ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
- * emptied. */
- Tcl_EncodingState state; /* The encoding state just before the last
- * external to UTF-8 conversion in
- * FilterInputBytes(). */
- int rawRead; /* The number of bytes removed from bufPtr in
- * the last call to FilterInputBytes(). */
- int bytesWrote; /* The number of bytes of UTF-8 data appended
- * to objPtr during the last call to
- * FilterInputBytes(). */
- int charsWrote; /* The corresponding number of UTF-8
- * characters appended to objPtr during the
- * last call to FilterInputBytes(). */
- int totalChars; /* The total number of UTF-8 characters
- * appended to objPtr so far, just before the
- * last call to FilterInputBytes(). */
-} GetsState;
-
-/*
* The length of time to wait between synthetic timer events. Must be zero or
* bad things tend to happen.
*/
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 27f156f..8f561b0 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -15,7 +15,7 @@
* Callback structure for accept callback in a TCP server.
*/
-typedef struct AcceptCallback {
+typedef struct {
char *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -25,7 +25,7 @@ typedef struct AcceptCallback {
* It must be per-thread because of std channel limitations.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
} ThreadSpecificData;
@@ -1929,25 +1929,25 @@ TclInitChanCmd(
* function at the moment.
*/
static const EnsembleImplMap initMap[] = {
- {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL, 0},
- {"close", Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
- {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
- {"create", TclChanCreateObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"eof", Tcl_EofObjCmd, NULL, NULL, NULL, 0},
- {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
- {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
- {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
- {"names", TclChannelNamesCmd, NULL, NULL, NULL, 0},
- {"pending", ChanPendingObjCmd, NULL, NULL, NULL, 0}, /* TIP #287 */
- {"pop", TclChanPopObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"push", TclChanPushObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
- {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
- {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
- {"pipe", ChanPipeObjCmd, NULL, NULL, NULL, 0}, /* TIP #304 */
- {"tell", Tcl_TellObjCmd, NULL, NULL, NULL, 0},
- {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL, 0}, /* TIP #208 */
+ {"blocked", Tcl_FblockedObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"close", Tcl_CloseObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
+ {"create", TclChanCreateObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"event", Tcl_FileEventObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+ {"flush", Tcl_FlushObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"gets", Tcl_GetsObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"names", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"pending", ChanPendingObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #287 */
+ {"pipe", ChanPipeObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, /* TIP #304 */
+ {"pop", TclChanPopObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, /* TIP #230 */
+ {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */
+ {"push", TclChanPushObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #230 */
+ {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
+ {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
+ {"seek", Tcl_SeekObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+ {"tell", Tcl_TellObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */
{NULL, NULL, NULL, NULL, NULL, 0}
};
static const char *const extras[] = {
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index cb0282a..4b61538 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -256,7 +256,7 @@ typedef enum {
* sharing problems.
*/
-typedef struct ForwardParamBase {
+typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -331,7 +331,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
-typedef struct ForwardingEvent {
+typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
@@ -368,7 +368,7 @@ struct ForwardingResult {
* results. */
};
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* Table of all reflected channels owned by this thread. This is the
* per-thread version of the per-interpreter map.
@@ -774,7 +774,7 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
-typedef struct ReflectEvent {
+typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
int events;
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 2b9efb9..2ab634c 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = {
* layers upon reading from the channel, plus the functions to manage such.
*/
-typedef struct _ResultBuffer_ {
+typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
int allocated; /* Allocated size of the buffer area. */
int used; /* Number of bytes in the buffer,
@@ -252,7 +252,7 @@ typedef enum {
* sharing problems.
*/
-typedef struct ForwardParamBase {
+typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -297,7 +297,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
-typedef struct ForwardingEvent {
+typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
@@ -328,7 +328,7 @@ struct ForwardingResult {
* results. */
};
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* Table of all reflected transformations owned by this thread.
*/
@@ -615,8 +615,8 @@ TclChanPushObjCmd(
methods = 0;
while (listc > 0) {
- if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
- "method", TCL_EXACT, &methIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames,
+ sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned %s",
Tcl_GetString(cmdObj),
@@ -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;
@@ -2942,7 +2942,7 @@ ResultClear(
return;
}
- Tcl_Free((char *) rPtr->buf);
+ ckfree((char *) rPtr->buf);
rPtr->buf = NULL;
rPtr->allocated = 0;
}
@@ -2977,10 +2977,10 @@ ResultAdd(
if (rPtr->allocated == 0) {
rPtr->allocated = toWrite + RB_INCREMENT;
- rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
+ rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
} else {
rPtr->allocated += toWrite + RB_INCREMENT;
- rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
+ rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
rPtr->allocated));
}
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 8773cb6..f325a74 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -18,9 +18,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#if defined(HAVE_SYS_STAT_H) && !defined _WIN32
-# include <sys/stat.h>
-#endif
#include "tclInt.h"
#ifdef __WIN32__
# include "tclWinInt.h"
@@ -54,7 +51,7 @@ typedef struct FilesystemRecord {
* this information each time the corresponding epoch counter changes.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized;
int cwdPathEpoch;
int filesystemEpoch;
@@ -243,7 +240,7 @@ static Tcl_ThreadDataKey fsDataKey;
* code.
*/
-typedef struct FsDivertLoad {
+typedef struct {
Tcl_LoadHandle loadHandle;
Tcl_FSUnloadFileProc *unloadProcPtr;
Tcl_Obj *divertedFile;
@@ -2475,8 +2472,8 @@ TclFSFileAttrIndex(
Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1);
int result;
- result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT,
- indexPtr);
+ result = Tcl_GetIndexFromObjStruct(NULL, tmpObj, attrTable,
+ sizeof(char *), NULL, TCL_EXACT, indexPtr);
TclDecrRefCount(tmpObj);
if (listObj != NULL) {
TclDecrRefCount(listObj);
@@ -3360,7 +3357,7 @@ Tcl_LoadFile(
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.
*/
@@ -3369,7 +3366,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
@@ -3389,7 +3386,7 @@ Tcl_LoadFile(
*----------------------------------------------------------------------
*
* DivertFindSymbol --
- *
+ *
* Find a symbol in a shared library loaded by copy-from-VFS.
*
*----------------------------------------------------------------------
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index cb345e2..b80d649 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -53,7 +53,7 @@ static const Tcl_ObjType indexType = {
/*
* The definition of the internal representation of the "index" object; The
- * internalRep.otherValuePtr field of an object of "index" type will be a
+ * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
* pointer to one of these structures.
*
* Keep this structure declaration in sync with tclTestObj.c
@@ -69,74 +69,12 @@ typedef struct {
* The following macros greatly simplify moving through a table...
*/
-#define STRING_AT(table, offset, index) \
- (*((const char *const *)(((char *)(table)) + ((offset) * (index)))))
+#define STRING_AT(table, offset) \
+ (*((const char *const *)(((char *)(table)) + (offset))))
#define NEXT_ENTRY(table, offset) \
- (&(STRING_AT(table, offset, 1)))
+ (&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
- STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetIndexFromObj --
- *
- * This function looks up an object's value in a table of strings and
- * returns the index of the matching string, if any.
- *
- * Results:
- * If the value of objPtr is identical to or a unique abbreviation for
- * one of the entries in tablePtr, then the return value is TCL_OK and the
- * index of the matching entry is stored at *indexPtr. If there isn't a
- * proper match, then TCL_ERROR is returned and an error message is left
- * in interp's result (unless interp is NULL). The msg argument is used
- * in the error message; for example, if msg has the value "option" then
- * the error message will say something flag 'bad option "foo": must be
- * ...'
- *
- * Side effects:
- * The result of the lookup is cached as the internal rep of objPtr, so
- * that repeated lookups can be done quickly.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetIndexFromObj(
- Tcl_Interp *interp, /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr, /* Object containing the string to lookup. */
- const char *const*tablePtr, /* Array of strings to compare against the
- * value of objPtr; last entry must be NULL
- * and there must not be duplicate entries. */
- const char *msg, /* Identifying word to use in error
- * messages. */
- int flags, /* 0 or TCL_EXACT */
- int *indexPtr) /* Place to store resulting integer index. */
-{
-
- /*
- * See if there is a valid cached result from a previous lookup (doing the
- * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
- * the common case where the result is cached).
- */
-
- if (objPtr->typePtr == &indexType) {
- IndexRep *indexRep = objPtr->internalRep.otherValuePtr;
-
- /*
- * Here's hoping we don't get hit by unfortunate packing constraints
- * on odd platforms like a Cray PVP...
- */
-
- if (indexRep->tablePtr == (void *) tablePtr
- && indexRep->offset == sizeof(char *)) {
- *indexPtr = indexRep->index;
- return TCL_OK;
- }
- }
- return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
- msg, flags, indexPtr);
-}
+ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
/*
*----------------------------------------------------------------------
@@ -238,7 +176,7 @@ GetIndexFromObjList(
* a proper match, then TCL_ERROR is returned and an error message is
* left in interp's result (unless interp is NULL). The msg argument is
* used in the error message; for example, if msg has the value "option"
- * then the error message will say something flag 'bad option "foo": must
+ * then the error message will say something like 'bad option "foo": must
* be ...'
*
* Side effects:
@@ -270,12 +208,16 @@ Tcl_GetIndexFromObjStruct(
Tcl_Obj *resultPtr;
IndexRep *indexRep;
+ /* Protect against invalid values, like -1 or 0. */
+ if (offset < (int)sizeof(char *)) {
+ offset = (int)sizeof(char *);
+ }
/*
* See if there is a valid cached result from a previous lookup.
*/
if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.otherValuePtr;
+ indexRep = objPtr->internalRep.twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
*indexPtr = indexRep->index;
return TCL_OK;
@@ -336,11 +278,11 @@ Tcl_GetIndexFromObjStruct(
*/
if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.otherValuePtr;
+ indexRep = objPtr->internalRep.twoPtrValue.ptr1;
} else {
TclFreeIntRep(objPtr);
indexRep = ckalloc(sizeof(IndexRep));
- objPtr->internalRep.otherValuePtr = indexRep;
+ objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
objPtr->typePtr = &indexType;
}
indexRep->tablePtr = (void *) tablePtr;
@@ -443,7 +385,7 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
- IndexRep *indexRep = objPtr->internalRep.otherValuePtr;
+ IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
register char *buf;
register unsigned len;
register const char *indexStr = EXPAND_OF(indexRep);
@@ -478,11 +420,11 @@ DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr;
+ IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.otherValuePtr = dupIndexRep;
+ dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
dupPtr->typePtr = &indexType;
}
@@ -507,7 +449,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(objPtr->internalRep.otherValuePtr);
+ ckfree(objPtr->internalRep.twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -533,9 +475,9 @@ TclInitPrefixCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap prefixImplMap[] = {
- {"all", PrefixAllObjCmd, NULL, NULL, NULL, 0},
- {"longest", PrefixLongestObjCmd, NULL, NULL, NULL, 0},
- {"match", PrefixMatchObjCmd, NULL, NULL, NULL, 0},
+ {"all", PrefixAllObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"match", PrefixMatchObjCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
Tcl_Command prefixCmd;
@@ -587,8 +529,8 @@ PrefixMatchObjCmd(
}
for (i = 1; i < (objc - 2); i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum matchOptions) index) {
@@ -657,7 +599,7 @@ PrefixMatchObjCmd(
}
Tcl_ListObjAppendElement(interp, errorPtr,
Tcl_NewStringObj("-code", 5));
- Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewLongObj(result));
return Tcl_SetReturnOptions(interp, errorPtr);
}
@@ -873,7 +815,8 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
- int i, len, elemLen, flags;
+ int i, len, elemLen;
+ char flags;
Interp *iPtr = (Interp *) interp;
const char *elementStr;
@@ -948,13 +891,13 @@ Tcl_WrongNumArgs(
if (origObjv[i]->typePtr == &indexType) {
register IndexRep *indexRep =
- origObjv[i]->internalRep.otherValuePtr;
+ origObjv[i]->internalRep.twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
} else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
register EnsembleCmdRep *ecrPtr =
- origObjv[i]->internalRep.otherValuePtr;
+ origObjv[i]->internalRep.twoPtrValue.ptr1;
elementStr = ecrPtr->fullSubcmdName;
elemLen = strlen(elementStr);
@@ -1003,12 +946,12 @@ Tcl_WrongNumArgs(
*/
if (objv[i]->typePtr == &indexType) {
- register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr;
+ register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
register EnsembleCmdRep *ecrPtr =
- objv[i]->internalRep.otherValuePtr;
+ objv[i]->internalRep.twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
} else {
@@ -1459,8 +1402,8 @@ TclGetCompletionCodeFromObj(
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
- if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
- codePtr) == TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes,
+ sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) {
return TCL_OK;
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 8c46e55..b840d04 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -457,29 +457,35 @@ declare 111 {
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
-declare 112 {
- int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- Tcl_Obj *objPtr)
-}
-declare 113 {
- Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
- ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
-}
-declare 114 {
- void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
-}
-declare 115 {
- int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- const char *pattern, int resetListFirst)
-}
-declare 116 {
- Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
- Tcl_Namespace *contextNsPtr, int flags)
-}
-declare 117 {
- Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
- Tcl_Namespace *contextNsPtr, int flags)
-}
+# Removed in 9.0:
+#declare 112 {
+# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+# Tcl_Obj *objPtr)
+#}
+# Removed in 9.0:
+#declare 113 {
+# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
+# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
+#}
+# Removed in 9.0:
+#declare 114 {
+# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
+#}
+# Removed in 9.0:
+#declare 115 {
+# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+# const char *pattern, int resetListFirst)
+#}
+# Removed in 9.0:
+#declare 116 {
+# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+# Tcl_Namespace *contextNsPtr, int flags)
+#}
+# Removed in 9.0:
+#declare 117 {
+# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
+# Tcl_Namespace *contextNsPtr, int flags)
+#}
declare 118 {
int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolverInfo *resInfo)
@@ -492,31 +498,37 @@ declare 120 {
Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 121 {
- int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- const char *pattern)
-}
-declare 122 {
- Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
-}
-declare 123 {
- void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
- Tcl_Obj *objPtr)
-}
-declare 124 {
- Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
-}
-declare 125 {
- Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
-}
+# Removed in 9.0:
+#declare 121 {
+# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+# const char *pattern)
+#}
+# Removed in 9.0:
+#declare 122 {
+# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+#}
+# Removed in 9.0:
+#declare 123 {
+# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
+# Tcl_Obj *objPtr)
+#}
+# Removed in 9.0:
+#declare 124 {
+# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
+#}
+# Removed in 9.0:
+#declare 125 {
+# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
+#}
declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
-declare 127 {
- int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- const char *pattern, int allowOverwrite)
-}
+# Removed in 9.0:
+#declare 127 {
+# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+# const char *pattern, int allowOverwrite)
+#}
declare 128 {
void Tcl_PopCallFrame(Tcl_Interp *interp)
}
@@ -1046,9 +1058,10 @@ declare 5 win {
# declare 5 win {
# HINSTANCE TclWinLoadLibrary(char *name)
# }
-declare 6 win {
- unsigned short TclWinNToHS(unsigned short ns)
-}
+# Removed in 8.1:
+#declare 6 win {
+# unsigned short TclWinNToHS(unsigned short ns)
+#}
declare 7 win {
int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8a78b94..343d1c4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -397,7 +397,7 @@ struct NamespacePathEntry {
/*
* The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
- * otherValuePtr field). This structure is not shared between Tcl_Objs
+ * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
* referring to the same subcommand, even where one is a duplicate of another.
*/
@@ -590,30 +590,6 @@ typedef struct ActiveVarTrace {
} ActiveVarTrace;
/*
- * The following structure describes an enumerative search in progress on an
- * array variable; this are invoked with options to the "array" command.
- */
-
-typedef struct ArraySearch {
- int id; /* Integer id used to distinguish among
- * multiple concurrent searches for the same
- * array. */
- struct Var *varPtr; /* Pointer to array variable that's being
- * searched. */
- Tcl_HashSearch search; /* Info kept by the hash module about progress
- * through the array. */
- Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
- * be enumerated (it's leftover from the
- * Tcl_FirstHashEntry call or from an "array
- * anymore" command). NULL means must call
- * Tcl_NextHashEntry to get value to
- * return. */
- struct ArraySearch *nextPtr;/* Next in list of all active searches for
- * this variable, or NULL if this is the last
- * one. */
-} ArraySearch;
-
-/*
* The structure below defines a variable, which associates a string name with
* a Tcl_Obj value. These structures are kept in procedure call frames (for
* local variables recognized by the compiler) or in the heap (for global
@@ -1155,7 +1131,7 @@ typedef struct CallFrame {
* meaning of the value is, which we do not
* specify. */
LocalCache *localCachePtr;
- struct NRE_callback *tailcallPtr;
+ Tcl_Obj *tailcallPtr;
/* NULL if no tailcall is scheduled */
} CallFrame;
@@ -2176,17 +2152,6 @@ typedef struct Interp {
(iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND))
/*
- * General list of interpreters. Doubly linked for easier removal of items
- * deep in the list.
- */
-
-typedef struct InterpList {
- Interp *interpPtr;
- struct InterpList *prevPtr;
- struct InterpList *nextPtr;
-} InterpList;
-
-/*
* Macros for splicing into and out of doubly linked lists. They assume
* existence of struct items 'prevPtr' and 'nextPtr'.
*
@@ -2224,7 +2189,6 @@ typedef struct InterpList {
#define TCL_ALLOW_EXCEPTIONS 4
#define TCL_EVAL_FILE 2
#define TCL_EVAL_CTX 8
-#define TCL_EVAL_REDIRECT 16
/*
* Flag bits for Interp structures:
@@ -2292,35 +2256,6 @@ typedef struct InterpList {
#define MAX_NESTING_DEPTH 1000
/*
- * TIP#143 limit handler internal representation.
- */
-
-struct LimitHandler {
- int flags; /* The state of this particular handler. */
- Tcl_LimitHandlerProc *handlerProc;
- /* The handler callback. */
- ClientData clientData; /* Opaque argument to the handler callback. */
- Tcl_LimitHandlerDeleteProc *deleteProc;
- /* How to delete the clientData. */
- LimitHandler *prevPtr; /* Previous item in linked list of
- * handlers. */
- LimitHandler *nextPtr; /* Next item in linked list of handlers. */
-};
-
-/*
- * Values for the LimitHandler flags field.
- * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
- * processed; handlers are never to be entered reentrantly.
- * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
- * should not normally be observed because when a handler is
- * deleted it is also spliced out of the list of handlers, but
- * even so we will be careful.
- */
-
-#define LIMIT_HANDLER_ACTIVE 0x01
-#define LIMIT_HANDLER_DELETED 0x02
-
-/*
* The macro below is used to modify a "char" value (e.g. by casting it to an
* unsigned character) so that it can be used safely with macros such as
* isspace.
@@ -2769,8 +2704,12 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
-MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp,
- struct NRE_callback *tailcallPtr);
+MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
+MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
+
+/* These two can be considered for the public api */
+MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp);
+MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp);
/*
* This structure holds the data for the various iteration callbacks used to
@@ -2845,7 +2784,6 @@ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
const unsigned char *bytes, int len);
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
-MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next,
int loc);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
@@ -2881,7 +2819,7 @@ MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE int TclConvertElement(const char *src, int length,
- char *dst, int flags);
+ char *dst, char flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
@@ -3086,11 +3024,12 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
- int *flagPtr);
+ char *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
mp_int *bignumValue);
+MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Command *cmdPtr);
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
@@ -3672,6 +3611,42 @@ 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 TclCompileBasic0ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic0To2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1To3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin0ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclInvertOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -3973,12 +3948,13 @@ typedef const char *TclDTraceStr;
*/
# define TclAllocObjStorageEx(interp, objPtr) \
- (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+ (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
# define TclFreeObjStorageEx(interp, objPtr) \
ckfree((char *) (objPtr))
#undef USE_THREAD_ALLOC
+#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
/*
@@ -4014,7 +3990,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
(objPtr) = TclThreadAllocObj(); \
} else { \
(objPtr) = cachePtr->firstObjPtr; \
- cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \
+ cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \
--cachePtr->numObjects; \
} \
} while (0)
@@ -4027,7 +4003,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
(cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \
TclThreadFreeObj(objPtr); \
} else { \
- (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
cachePtr->firstObjPtr = objPtr; \
++cachePtr->numObjects; \
} \
@@ -4055,14 +4031,14 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex;
} \
(objPtr) = tclFreeObjList; \
tclFreeObjList = (Tcl_Obj *) \
- tclFreeObjList->internalRep.otherValuePtr; \
+ tclFreeObjList->internalRep.twoPtrValue.ptr1; \
Tcl_MutexUnlock(&tclObjMutex); \
} while (0)
# define TclFreeObjStorageEx(interp, objPtr) \
do { \
Tcl_MutexLock(&tclObjMutex); \
- (objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
tclFreeObjList = (objPtr); \
Tcl_MutexUnlock(&tclObjMutex); \
} while (0)
@@ -4389,15 +4365,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* core. They should only be called on unshared objects. The ANSI C
* "prototypes" for these macros are:
*
- * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue);
* MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue);
- * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue);
* MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
-#define TclSetIntObj(objPtr, i) \
+#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
@@ -4405,9 +4379,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
(objPtr)->typePtr = &tclIntType; \
} while (0)
-#define TclSetLongObj(objPtr, l) \
- TclSetIntObj((objPtr), (l))
-
/*
* NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
* programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
@@ -4415,9 +4386,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* value of strings like: "yes", "no", "true", "false", "on", "off".
*/
-#define TclSetBooleanObj(objPtr, b) \
- TclSetIntObj((objPtr), ((b)? 1 : 0));
-
#ifndef NO_WIDE_TYPE
#define TclSetWideIntObj(objPtr, w) \
do { \
@@ -4442,9 +4410,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* types, avoiding the corresponding function calls in time critical parts of
* the core. The ANSI C "prototypes" for these macros are:
*
- * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, int i);
* MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l);
- * MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b);
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
@@ -4454,7 +4420,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
+#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
@@ -4465,16 +4431,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
-#define TclNewLongObj(objPtr, l) \
- TclNewIntObj((objPtr), (l))
-
-/*
- * NOTE: There is to be no such thing as a "pure" boolean.
- * See comment above TclSetBooleanObj macro above.
- */
-#define TclNewBooleanObj(objPtr, b) \
- TclNewIntObj((objPtr), ((b)? 1 : 0))
-
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
@@ -4497,15 +4453,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
} while (0)
#else /* TCL_MEM_DEBUG */
-#define TclNewIntObj(objPtr, i) \
- (objPtr) = Tcl_NewIntObj(i)
-
#define TclNewLongObj(objPtr, l) \
(objPtr) = Tcl_NewLongObj(l)
-#define TclNewBooleanObj(objPtr, b) \
- (objPtr) = Tcl_NewBooleanObj(b)
-
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
@@ -4736,35 +4686,6 @@ typedef struct NRE_callback {
TOP_CB(interp) = callbackPtr; \
} while (0)
-#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \
- do { \
- NRE_callback *callbackPtr; \
- TCLNR_ALLOC((interp), (callbackPtr)); \
- callbackPtr->procPtr = (postProcPtr); \
- callbackPtr->data[0] = (ClientData)(data0); \
- callbackPtr->data[1] = (ClientData)(data1); \
- callbackPtr->data[2] = (ClientData)(data2); \
- callbackPtr->data[3] = (ClientData)(data3); \
- callbackPtr->nextPtr = ((Interp *)interp)->deferredCallbacks; \
- ((Interp *)interp)->deferredCallbacks = callbackPtr; \
- } while (0)
-
-#define TclNRSpliceCallbacks(interp, topPtr) \
- do { \
- NRE_callback *bottomPtr = topPtr; \
- while (bottomPtr->nextPtr) { \
- bottomPtr = bottomPtr->nextPtr; \
- } \
- bottomPtr->nextPtr = TOP_CB(interp); \
- TOP_CB(interp) = topPtr; \
- } while (0)
-
-#define TclNRSpliceDeferred(interp) \
- if (((Interp *)interp)->deferredCallbacks) { \
- TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \
- ((Interp *)interp)->deferredCallbacks = NULL; \
- }
-
#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 65b1888..26b168f 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -17,21 +17,6 @@
#include "tclPort.h"
-/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_AppendExportList
-#undef Tcl_CreateNamespace
-#undef Tcl_DeleteNamespace
-#undef Tcl_Export
-#undef Tcl_FindCommand
-#undef Tcl_FindNamespace
-#undef Tcl_FindNamespaceVar
-#undef Tcl_ForgetImport
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
-#undef Tcl_GetCurrentNamespace
-#undef Tcl_GetGlobalNamespace
-#undef Tcl_Import
-
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -262,25 +247,12 @@ TCLAPI void Tcl_AddInterpResolvers(Tcl_Interp *interp,
Tcl_ResolveCmdProc *cmdProc,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
-/* 112 */
-TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp,
- Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
-/* 113 */
-TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
- const char *name, ClientData clientData,
- Tcl_NamespaceDeleteProc *deleteProc);
-/* 114 */
-TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
-/* 115 */
-TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- const char *pattern, int resetListFirst);
-/* 116 */
-TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
- Tcl_Namespace *contextNsPtr, int flags);
-/* 117 */
-TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
- const char *name,
- Tcl_Namespace *contextNsPtr, int flags);
+/* Slot 112 is reserved */
+/* Slot 113 is reserved */
+/* Slot 114 is reserved */
+/* Slot 115 is reserved */
+/* Slot 116 is reserved */
+/* Slot 117 is reserved */
/* 118 */
TCLAPI int Tcl_GetInterpResolvers(Tcl_Interp *interp,
const char *name, Tcl_ResolverInfo *resInfo);
@@ -292,25 +264,15 @@ TCLAPI int Tcl_GetNamespaceResolvers(
TCLAPI Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
-/* 121 */
-TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp,
- Tcl_Namespace *nsPtr, const char *pattern);
-/* 122 */
-TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
-/* 123 */
-TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp,
- Tcl_Command command, Tcl_Obj *objPtr);
-/* 124 */
-TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
-/* 125 */
-TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+/* Slot 121 is reserved */
+/* Slot 122 is reserved */
+/* Slot 123 is reserved */
+/* Slot 124 is reserved */
+/* Slot 125 is reserved */
/* 126 */
TCLAPI void Tcl_GetVariableFullName(Tcl_Interp *interp,
Tcl_Var variable, Tcl_Obj *objPtr);
-/* 127 */
-TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- const char *pattern, int allowOverwrite);
+/* Slot 127 is reserved */
/* 128 */
TCLAPI void Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
@@ -697,22 +659,22 @@ typedef struct TclIntStubs {
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
- int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
- Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
- void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
- int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
- Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
- Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
+ void (*reserved112)(void);
+ void (*reserved113)(void);
+ void (*reserved114)(void);
+ void (*reserved115)(void);
+ void (*reserved116)(void);
+ void (*reserved117)(void);
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
- int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
- Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
- void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
- Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
- Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
+ void (*reserved121)(void);
+ void (*reserved122)(void);
+ void (*reserved123)(void);
+ void (*reserved124)(void);
+ void (*reserved125)(void);
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
- int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
+ void (*reserved127)(void);
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
@@ -1022,38 +984,26 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
-#define Tcl_AppendExportList \
- (tclIntStubsPtr->tcl_AppendExportList) /* 112 */
-#define Tcl_CreateNamespace \
- (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
-#define Tcl_DeleteNamespace \
- (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
-#define Tcl_Export \
- (tclIntStubsPtr->tcl_Export) /* 115 */
-#define Tcl_FindCommand \
- (tclIntStubsPtr->tcl_FindCommand) /* 116 */
-#define Tcl_FindNamespace \
- (tclIntStubsPtr->tcl_FindNamespace) /* 117 */
+/* Slot 112 is reserved */
+/* Slot 113 is reserved */
+/* Slot 114 is reserved */
+/* Slot 115 is reserved */
+/* Slot 116 is reserved */
+/* Slot 117 is reserved */
#define Tcl_GetInterpResolvers \
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
-#define Tcl_ForgetImport \
- (tclIntStubsPtr->tcl_ForgetImport) /* 121 */
-#define Tcl_GetCommandFromObj \
- (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
-#define Tcl_GetCommandFullName \
- (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
-#define Tcl_GetCurrentNamespace \
- (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
-#define Tcl_GetGlobalNamespace \
- (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
+/* Slot 121 is reserved */
+/* Slot 122 is reserved */
+/* Slot 123 is reserved */
+/* Slot 124 is reserved */
+/* Slot 125 is reserved */
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
-#define Tcl_Import \
- (tclIntStubsPtr->tcl_Import) /* 127 */
+/* Slot 127 is reserved */
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index f7eb442..010fe88 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -101,8 +101,7 @@ TCLAPI int TclWinGetSockOpt(SOCKET s, int level, int optname,
TCLAPI HINSTANCE TclWinGetTclInstance(void);
/* 5 */
TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout);
-/* 6 */
-TCLAPI unsigned short TclWinNToHS(unsigned short ns);
+/* Slot 6 is reserved */
/* 7 */
TCLAPI int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen);
@@ -278,7 +277,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
- unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
+ void (*reserved6)(void);
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
@@ -412,8 +411,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
-#define TclWinNToHS \
- (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
+/* Slot 6 is reserved */
#define TclWinSetSockOpt \
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
@@ -518,10 +516,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
/* !END!: Do not edit above this line. */
-#if defined(__WIN32__) || defined(__CYGWIN__)
-# undef TclWinNToHS
-# define TclWinNToHS ntohs
-#else
+#if !defined(__WIN32__) && !defined(__CYGWIN__)
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
#endif
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0b0f652..241d428 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL;
struct Target;
/*
- * struct Alias:
+ * Alias:
*
* Stores information about an alias. Is stored in the slave interpreter and
* used by the source command to find the target command in the master when
* the source command is invoked.
*/
-typedef struct Alias {
+typedef struct {
Tcl_Obj *token; /* Token for the alias command in the slave
* interp. This used to be the command name in
* the slave when the alias was first
@@ -73,7 +73,7 @@ typedef struct Alias {
* slave interpreter, e.g. what aliases are defined in it.
*/
-typedef struct Slave {
+typedef struct {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
@@ -84,7 +84,7 @@ typedef struct Slave {
Tcl_Interp *slaveInterp; /* The slave interpreter. */
Tcl_Command interpCmd; /* Interpreter object command. */
Tcl_HashTable aliasTable; /* Table which maps from names of commands in
- * slave interpreter to struct Alias defined
+ * slave interpreter to Alias defined
* below. */
} Slave;
@@ -127,7 +127,7 @@ typedef struct Target {
* only load safe extensions.
*/
-typedef struct Master {
+typedef struct {
Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
* from command names to Slave records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
@@ -144,7 +144,7 @@ typedef struct Master {
* on a per-interp basis.
*/
-typedef struct InterpInfo {
+typedef struct {
Master master; /* Keeps track of all interps for which this
* interp is the Master. */
Slave slave; /* Information necessary for this interp to
@@ -158,7 +158,7 @@ typedef struct InterpInfo {
* likely to work properly on 64-bit architectures.
*/
-typedef struct ScriptLimitCallback {
+typedef struct {
Tcl_Interp *interp; /* The interpreter in which to execute the
* callback. */
Tcl_Obj *scriptObj; /* The script to execute to perform the
@@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback {
* table. */
} ScriptLimitCallback;
-typedef struct ScriptLimitCallbackKey {
+typedef struct {
Tcl_Interp *interp; /* The interpreter that the limit callback was
* attached to. This is not the interpreter
* that the callback runs in! */
@@ -179,6 +179,37 @@ typedef struct ScriptLimitCallbackKey {
} ScriptLimitCallbackKey;
/*
+ * TIP#143 limit handler internal representation.
+ */
+
+struct LimitHandler {
+ int flags; /* The state of this particular handler. */
+ Tcl_LimitHandlerProc *handlerProc;
+ /* The handler callback. */
+ ClientData clientData; /* Opaque argument to the handler callback. */
+ Tcl_LimitHandlerDeleteProc *deleteProc;
+ /* How to delete the clientData. */
+ LimitHandler *prevPtr; /* Previous item in linked list of
+ * handlers. */
+ LimitHandler *nextPtr; /* Next item in linked list of handlers. */
+};
+
+/*
+ * Values for the LimitHandler flags field.
+ * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
+ * processed; handlers are never to be entered reentrantly.
+ * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
+ * should not normally be observed because when a handler is
+ * deleted it is also spliced out of the list of handlers, but
+ * even so we will be careful.
+ */
+
+#define LIMIT_HANDLER_ACTIVE 0x01
+#define LIMIT_HANDLER_DELETED 0x02
+
+
+
+/*
* Prototypes for local static functions:
*/
@@ -299,7 +330,7 @@ Tcl_Init(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
if (tclPreInitScript != NULL) {
- if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+ if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
return TCL_ERROR;
}
}
@@ -345,7 +376,7 @@ Tcl_Init(
* alternate tclInit command before calling Tcl_Init().
*/
- return Tcl_Eval(interp,
+ return Tcl_EvalEx(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
" proc tclInit {} {\n"
" global tcl_libPath tcl_library env tclDefaultLibrary\n"
@@ -407,7 +438,7 @@ Tcl_Init(
" error $msg\n"
" }\n"
"}\n"
-"tclInit");
+"tclInit", -1, 0);
}
/*
@@ -1798,9 +1829,9 @@ AliasNRCmd(
*/
if (isRootEnsemble) {
- TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
- iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+ TclSkipTailcall(interp);
return Tcl_NREvalObj(interp, listPtr, flags);
}
@@ -3141,8 +3172,8 @@ Tcl_MakeSafe(
* Assume these functions all work. [Bug 2895741]
*/
- (void) Tcl_Eval(interp,
- "namespace eval ::tcl {namespace eval mathfunc {}}");
+ (void) Tcl_EvalEx(interp,
+ "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
"::tcl::mathfunc::min", 0, NULL);
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
diff --git a/generic/tclLink.c b/generic/tclLink.c
index a3b42bd..1d1ed21 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -21,7 +21,7 @@
* variable.
*/
-typedef struct Link {
+typedef struct {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
Tcl_Obj *varName; /* Name of variable (must be global). This is
* needed during trace callbacks, since the
@@ -112,8 +112,8 @@ Tcl_LinkVar(
Link *linkPtr;
int code;
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
if (linkPtr != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"variable '%s' is already linked", varName));
@@ -138,8 +138,9 @@ Tcl_LinkVar(
ckfree(linkPtr);
return TCL_ERROR;
}
- code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
- |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
+ code = Tcl_TraceVar2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ LinkTraceProc, linkPtr);
if (code != TCL_OK) {
Tcl_DecrRefCount(linkPtr->varName);
ckfree(linkPtr);
@@ -170,13 +171,13 @@ Tcl_UnlinkVar(
Tcl_Interp *interp, /* Interpreter containing variable to unlink */
const char *varName) /* Global variable in interp to unlink. */
{
- Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
if (linkPtr == NULL) {
return;
}
- Tcl_UntraceVar(interp, varName,
+ Tcl_UntraceVar2(interp, varName, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
@@ -207,7 +208,7 @@ Tcl_UpdateLinkedVar(
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *varName) /* Name of global variable that is linked. */
{
- Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
int savedFlag;
@@ -221,8 +222,8 @@ Tcl_UpdateLinkedVar(
/*
* Callback may have unlinked the variable. [Bug 1740631]
*/
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, NULL);
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
if (linkPtr != NULL) {
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -278,7 +279,7 @@ LinkTraceProc(
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+ Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 3668b45..f5123e8 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -237,7 +237,7 @@ Tcl_NewListObj(
* Now create the object.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
@@ -302,7 +302,7 @@ Tcl_DbNewListObj(
* Now create the object.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
ListSetIntRep(listPtr, listRepPtr);
return listPtr;
@@ -362,7 +362,7 @@ Tcl_SetListObj(
*/
TclFreeIntRep(objPtr);
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
/*
* Set the object's type to "list" and initialize the internal rep.
@@ -697,7 +697,7 @@ Tcl_ListObjAppendElement(
* representation has changed.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
return TCL_OK;
}
@@ -909,6 +909,10 @@ Tcl_ListObjReplace(
isShared = (listRepPtr->refCount > 1);
numRequired = numElems - count + objc;
+ for (i = 0; i < objc; i++) {
+ Tcl_IncrRefCount(objv[i]);
+ }
+
if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
int shift;
@@ -963,6 +967,10 @@ Tcl_ListObjReplace(
if (listRepPtr == NULL) {
listRepPtr = AttemptNewList(interp, numRequired, NULL);
if (listRepPtr == NULL) {
+ for (i = 0; i < objc; i++) {
+ /* See bug 3598580 */
+ Tcl_DecrRefCount(objv[i]);
+ }
return TCL_ERROR;
}
}
@@ -1027,14 +1035,11 @@ Tcl_ListObjReplace(
}
/*
- * Insert the new elements into elemPtrs before "first". We don't do a
- * memcpy here because we must increment the reference counts for the
- * added elements, so we must explicitly loop anyway.
+ * Insert the new elements into elemPtrs before "first".
*/
for (i=0,j=first ; i<objc ; i++,j++) {
elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
}
/*
@@ -1048,7 +1053,7 @@ Tcl_ListObjReplace(
* reflects the list's internal representation.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
return TCL_OK;
}
@@ -1514,7 +1519,7 @@ TclLsetFlat(
* containing lists.
*/
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
}
/*
@@ -1550,7 +1555,7 @@ TclLsetFlat(
} else {
TclListObjSetElement(NULL, subListPtr, index, valuePtr);
}
- Tcl_InvalidateStringRep(subListPtr);
+ TclInvalidateStringRep(subListPtr);
Tcl_IncrRefCount(retValuePtr);
return retValuePtr;
}
@@ -1727,8 +1732,6 @@ FreeListInternalRep(
ckfree(listRepPtr);
}
- listPtr->internalRep.twoPtrValue.ptr1 = NULL;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listPtr->typePtr = NULL;
}
@@ -1918,8 +1921,8 @@ static void
UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
-# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+# define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
int i, length, bytesNeeded = 0;
@@ -1956,7 +1959,7 @@ UpdateStringOfList(
* We know numElems <= LIST_MAX, so this is safe.
*/
- flagPtr = ckalloc(numElems * sizeof(int));
+ flagPtr = ckalloc(numElems);
}
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 441ea91..e2ee9b4 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -32,6 +32,10 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr,
Tcl_Obj *objPtr, int localHash);
static void ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned HashString(const char *string, int length);
+#ifdef TCL_COMPILE_DEBUG
+static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+#endif
static void RebuildLiteralTable(LiteralTable *tablePtr);
/*
@@ -239,7 +243,7 @@ TclCreateLiteral(
}
#ifdef TCL_COMPILE_DEBUG
- if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
+ if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
"TclRegisterLiteral", (length>60? 60 : length), bytes);
}
@@ -301,6 +305,33 @@ TclCreateLiteral(
/*
*----------------------------------------------------------------------
*
+ * TclFetchLiteral --
+ *
+ * Fetch from a CompileEnv the literal value identified by an index
+ * value, as returned by a prior call to TclRegisterLiteral().
+ *
+ * Results:
+ * The literal value, or NULL if the index is out of range.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFetchLiteral(
+ CompileEnv *envPtr, /* Points to the CompileEnv from which to
+ * fetch the registered literal value. */
+ unsigned int index) /* Index of the desired literal, as returned
+ * by prior call to TclRegisterLiteral() */
+{
+ if (index >= envPtr->literalArrayNext) {
+ return NULL;
+ }
+ return envPtr->literalArrayPtr[index].objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclRegisterLiteral --
*
* Find, or if necessary create, an object in a CompileEnv literal array
@@ -414,10 +445,11 @@ TclRegisterLiteral(
return objIndex;
}
+#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
- * TclLookupLiteralEntry --
+ * LookupLiteralEntry --
*
* Finds the LiteralEntry that corresponds to a literal Tcl object
* holding a literal.
@@ -431,8 +463,8 @@ TclRegisterLiteral(
*----------------------------------------------------------------------
*/
-LiteralEntry *
-TclLookupLiteralEntry(
+static LiteralEntry *
+LookupLiteralEntry(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
@@ -456,6 +488,7 @@ TclLookupLiteralEntry(
return NULL;
}
+#endif
/*
*----------------------------------------------------------------------
*
@@ -750,11 +783,16 @@ TclReleaseLiteral(
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
- LiteralTable *globalTablePtr = &iPtr->literalTable;
+ LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
const char *bytes;
int length, index;
+ if (iPtr == NULL) {
+ goto done;
+ }
+
+ globalTablePtr = &iPtr->literalTable;
bytes = TclGetStringFromObj(objPtr, &length);
index = (HashString(bytes, length) & globalTablePtr->mask);
@@ -798,6 +836,7 @@ TclReleaseLiteral(
* Remove the reference corresponding to the local literal table entry.
*/
+ done:
Tcl_DecrRefCount(objPtr);
}
@@ -1090,7 +1129,7 @@ TclVerifyLocalLiteralTable(
"TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes, localPtr->refCount);
}
- if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
+ if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" is not global",
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index f030d89..c22c4c4 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -82,6 +82,39 @@ TclGuessPackageName(
}
/*
+ * These functions are fallbacks if we somehow determine that the platform can
+ * do loading from memory but the user wishes to disable it. They just report
+ * (gracefully) that they fail.
+ */
+
+#ifdef TCL_LOAD_FROM_MEMORY
+
+MODULE_SCOPE void *
+TclpLoadMemoryGetBuffer(
+ Tcl_Interp *interp, /* Dummy: unused by this implementation */
+ int size) /* Dummy: unused by this implementation */
+{
+ return NULL;
+}
+
+MODULE_SCOPE int
+TclpLoadMemory(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ void *buffer, /* Dummy: unused by this implementation */
+ 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)
+ /* Dummy: unused by this implementation */
+{
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+ "is not available on this system", -1));
+ return TCL_ERROR;
+}
+
+#endif /* TCL_LOAD_FROM_MEMORY */
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 6c71fbb..63e7464 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -109,7 +109,7 @@ typedef enum {
PROMPT_CONTINUE /* Print prompt for command continuation */
} PromptType;
-typedef struct InteractiveState {
+typedef struct {
Tcl_Channel input; /* The standard input channel from which lines
* are read. */
int tty; /* Non-zero means standard input is a
@@ -362,7 +362,7 @@ Tcl_MainEx(
argc--;
argv++;
- Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewLongObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
@@ -376,7 +376,7 @@ Tcl_MainEx(
is.tty = isatty(0);
Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
- Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
+ Tcl_NewLongObj(!path && is.tty), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 02d517f..edc1a88 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -31,7 +31,7 @@
* limited to a single interpreter.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
long numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
@@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey;
* with some information that is used to check the cached pointer's validity.
*/
-typedef struct ResolvedNsName {
+typedef struct {
Namespace *nsPtr; /* A cached pointer to the Namespace that the
* name resolved to. */
Namespace *refNsPtr; /* Points to the namespace context in which
@@ -160,23 +160,23 @@ static const Tcl_ObjType nsNameType = {
*/
static const EnsembleImplMap defaultNamespaceMap[] = {
- {"children", NamespaceChildrenCmd, NULL, NULL, NULL, 0},
+ {"children", NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
{"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0},
{"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
- {"delete", NamespaceDeleteCmd, NULL, NULL, NULL, 0},
+ {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
{"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0},
- {"exists", NamespaceExistsCmd, NULL, NULL, NULL, 0},
- {"export", NamespaceExportCmd, NULL, NULL, NULL, 0},
- {"forget", NamespaceForgetCmd, NULL, NULL, NULL, 0},
- {"import", NamespaceImportCmd, NULL, NULL, NULL, 0},
+ {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
- {"origin", NamespaceOriginCmd, NULL, NULL, NULL, 0},
- {"parent", NamespaceParentCmd, NULL, NULL, NULL, 0},
- {"path", NamespacePathCmd, NULL, NULL, NULL, 0},
+ {"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
{"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0},
- {"unknown", NamespaceUnknownCmd, NULL, NULL, NULL, 0},
+ {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
{"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0},
{NULL, NULL, NULL, 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.
@@ -423,7 +423,7 @@ Tcl_PopCallFrame(
framePtr->nsPtr = NULL;
if (framePtr->tailcallPtr) {
- TclSpliceTailcall(interp, framePtr->tailcallPtr);
+ TclSetTailcall(interp, framePtr->tailcallPtr);
}
}
@@ -505,9 +505,9 @@ EstablishErrorCodeTraces(
const char *name2,
int flags)
{
- Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+ Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
ErrorCodeRead, NULL);
- Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+ Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
EstablishErrorCodeTraces, NULL);
return NULL;
}
@@ -579,9 +579,9 @@ EstablishErrorInfoTraces(
const char *name2,
int flags)
{
- Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+ Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
ErrorInfoRead, NULL);
- Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+ Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
EstablishErrorInfoTraces, NULL);
return NULL;
}
@@ -697,8 +697,7 @@ Tcl_CreateNamespace(
* Find the parent for the new namespace.
*/
- TclGetNamespaceForQualName(interp, name, NULL,
- /*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+ TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
/*
@@ -1330,8 +1329,7 @@ Tcl_Export(
* Check that the pattern doesn't have namespace qualifiers.
*/
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
@@ -1545,8 +1543,7 @@ Tcl_Import(
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
return TCL_ERROR;
}
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
@@ -1791,8 +1788,7 @@ Tcl_ForgetImport(
* simple pattern.
*/
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
@@ -1945,7 +1941,7 @@ InvokeImportedNRCmd(
ImportedCmdData *dataPtr = clientData;
Command *realCmdPtr = dataPtr->realCmdPtr;
- ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+ TclSkipTailcall(interp);
return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
}
@@ -3025,7 +3021,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;
@@ -3387,7 +3383,7 @@ NamespaceExistsCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(
GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
return TCL_OK;
}
@@ -3435,10 +3431,7 @@ NamespaceExportCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- const char *pattern, *string;
- int resetListFirst = 0;
- int firstArg, patternCt, i, result;
+ int firstArg, i;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
@@ -3446,42 +3439,27 @@ NamespaceExportCmd(
}
/*
- * Process the optional "-clear" argument.
+ * If no pattern arguments are given, and "-clear" isn't specified, return
+ * the namespace's current export pattern list.
*/
- firstArg = 1;
- if (firstArg < objc) {
- string = TclGetString(objv[firstArg]);
- if (strcmp(string, "-clear") == 0) {
- resetListFirst = 1;
- firstArg++;
- }
+ if (objc == 1) {
+ Tcl_Obj *listPtr = Tcl_NewObj();
+
+ (void) Tcl_AppendExportList(interp, NULL, listPtr);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
}
/*
- * If no pattern arguments are given, and "-clear" isn't specified, return
- * the namespace's current export pattern list.
+ * Process the optional "-clear" argument.
*/
- patternCt = objc - firstArg;
- if (patternCt == 0) {
- if (firstArg > 1) {
- return TCL_OK;
- } else {
- /*
- * Create list with export patterns.
- */
-
- Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
-
- result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr,
- listPtr);
- if (result != TCL_OK) {
- return result;
- }
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
- }
+ firstArg = 1;
+ if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
+ Tcl_Export(interp, NULL, "::", 1);
+ Tcl_ResetResult(interp);
+ firstArg++;
}
/*
@@ -3489,9 +3467,7 @@ NamespaceExportCmd(
*/
for (i = firstArg; i < objc; i++) {
- pattern = TclGetString(objv[i]);
- result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
- ((i == firstArg)? resetListFirst : 0));
+ int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0);
if (result != TCL_OK) {
return result;
}
@@ -4570,8 +4546,8 @@ NamespaceWhichCmd(
* Look for a flag controlling the lookup.
*/
- if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
- &lookupType) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], opts,
+ sizeof(char *), "option", 0, &lookupType) != TCL_OK) {
/*
* Preserve old style of error message!
*/
@@ -4918,7 +4894,7 @@ TclLogCommandInfo(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -4950,7 +4926,7 @@ TclLogCommandInfo(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(command, length));
}
- }
+ }
if (!iPtr->framePtr->objc) {
/*
@@ -4962,7 +4938,7 @@ TclLogCommandInfo(
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewLongObj(
iPtr->framePtr->level - iPtr->varFramePtr->level));
} else if (iPtr->framePtr != iPtr->rootFramePtr) {
/*
@@ -5003,7 +4979,7 @@ TclErrorStackResetIf(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -5023,7 +4999,7 @@ TclErrorStackResetIf(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(msg, length));
- }
+ }
}
/*
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d6d2d6a..2593234 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -267,7 +267,7 @@ TclOOInit(
* to be fully provided.
*/
- if (Tcl_Eval(interp, initScript) != TCL_OK) {
+ if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -458,7 +458,7 @@ InitFoundation(
if (TclOODefineSlots(fPtr) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_Eval(interp, slotScript);
+ return Tcl_EvalEx(interp, slotScript, -1, 0);
}
/*
@@ -843,7 +843,7 @@ ObjectRenamedTrace(
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
contextPtr, 0, NULL);
if (result != TCL_OK) {
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, result);
}
Tcl_RestoreInterpState(interp, state);
TclOODeleteContext(contextPtr);
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 280481c..cf253b1 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs(
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "0.7"
+#define TCLOO_VERSION "1.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
/*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 0676618..5e29512 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -687,52 +687,51 @@ TclOO_Object_VarName(
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
- Interp *iPtr = (Interp *) interp;
Var *varPtr, *aryVar;
- Tcl_Obj *varNamePtr;
+ Tcl_Obj *varNamePtr, *argPtr;
+ const char *arg;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"varName");
return TCL_ERROR;
}
+ argPtr = objv[objc-1];
+ arg = Tcl_GetString(argPtr);
/*
- * Switch to the object's namespace for the duration of this call. Like
- * this, the variable is looked up in the namespace of the object, and not
- * in the namespace of the caller. Otherwise this would only work if the
- * caller was a method of the object itself, which might not be true if
- * the method was exported. This is a bit of a hack, but the simplest way
- * to do this (pushing a stack frame would be horribly expensive by
- * comparison, and is only done when we'd otherwise interfere with the
- * global namespace).
+ * Convert the variable name to fully-qualified form if it wasn't already.
+ * This has to be done prior to lookup because we can run into problems
+ * with resolvers otherwise. [Bug 3603695]
+ *
+ * We still need to do the lookup; the variable could be linked to another
+ * variable and we want the target's name.
*/
- if (iPtr->varFramePtr == NULL) {
- Tcl_CallFrame *dummyFrame;
-
- TclPushStackFrame(interp, &dummyFrame,
- Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0);
- varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
- TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
- TclPopStackFrame(interp);
+ if (arg[0] == ':' && arg[1] == ':') {
+ varNamePtr = argPtr;
} else {
- Namespace *savedNsPtr;
-
- savedNsPtr = iPtr->varFramePtr->nsPtr;
- iPtr->varFramePtr->nsPtr = (Namespace *)
+ Tcl_Namespace *namespacePtr =
Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
- varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
- TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
- iPtr->varFramePtr->nsPtr = savedNsPtr;
- }
+ varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
+ Tcl_AppendToObj(varNamePtr, "::", 2);
+ Tcl_AppendObjToObj(varNamePtr, argPtr);
+ }
+ Tcl_IncrRefCount(varNamePtr);
+ varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
+ TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
+ Tcl_DecrRefCount(varNamePtr);
if (varPtr == NULL) {
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE",
- TclGetString(objv[objc-1]), NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
return TCL_ERROR;
}
+ /*
+ * Now that we've pinned down what variable we're really talking about
+ * (including traversing variable links), convert back to a name.
+ */
+
varNamePtr = Tcl_NewObj();
if (aryVar != NULL) {
Tcl_HashEntry *hPtr;
@@ -979,8 +978,8 @@ TclOOSelfObjCmd(
return TCL_ERROR;
} else if (objc == 1) {
index = SELF_OBJECT;
- } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0,
- &index) != TCL_OK) {
+ } else if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds,
+ sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1149,7 +1148,7 @@ TclOOSelfObjCmd(
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
- result[1] = Tcl_NewIntObj(contextPtr->index);
+ result[1] = Tcl_NewLongObj(contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index a79e4fa..26fd09f 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -178,7 +178,7 @@ StashCallChain(
callPtr->refCount++;
TclFreeIntRep(objPtr);
objPtr->typePtr = &methodNameType;
- objPtr->internalRep.otherValuePtr = callPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
}
void
@@ -205,10 +205,10 @@ DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
- register CallChain *callPtr = srcPtr->internalRep.otherValuePtr;
+ register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
dstPtr->typePtr = &methodNameType;
- dstPtr->internalRep.otherValuePtr = callPtr;
+ dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
callPtr->refCount++;
}
@@ -216,10 +216,9 @@ static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
- register CallChain *callPtr = objPtr->internalRep.otherValuePtr;
+ register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
TclOODeleteChain(callPtr);
- objPtr->internalRep.otherValuePtr = NULL;
objPtr->typePtr = NULL;
}
@@ -952,7 +951,7 @@ TclOOGetCallContext(
const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
if (cacheInThisObj->typePtr == &methodNameType) {
- callPtr = cacheInThisObj->internalRep.otherValuePtr;
+ callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index e09ee4e..cbf49d3 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -48,18 +48,18 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd;
*/
static const EnsembleImplMap infoObjectCmds[] = {
- {"call", InfoObjectCallCmd, NULL, NULL, NULL, 0},
+ {"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
- {"definition", InfoObjectDefnCmd, NULL, NULL, NULL, 0},
- {"filters", InfoObjectFiltersCmd, NULL, NULL, NULL, 0},
- {"forward", InfoObjectForwardCmd, NULL, NULL, NULL, 0},
+ {"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0},
- {"methods", InfoObjectMethodsCmd, NULL, NULL, NULL, 0},
- {"methodtype", InfoObjectMethodTypeCmd, NULL, NULL, NULL, 0},
- {"mixins", InfoObjectMixinsCmd, NULL, NULL, NULL, 0},
+ {"methods", InfoObjectMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
- {"variables", InfoObjectVariablesCmd, NULL, NULL, NULL, 0},
- {"vars", InfoObjectVarsCmd, NULL, NULL, NULL, 0},
+ {"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -68,19 +68,19 @@ static const EnsembleImplMap infoObjectCmds[] = {
*/
static const EnsembleImplMap infoClassCmds[] = {
- {"call", InfoClassCallCmd, NULL, NULL, NULL, 0},
- {"constructor", InfoClassConstrCmd, NULL, NULL, NULL, 0},
- {"definition", InfoClassDefnCmd, NULL, NULL, NULL, 0},
- {"destructor", InfoClassDestrCmd, NULL, NULL, NULL, 0},
- {"filters", InfoClassFiltersCmd, NULL, NULL, NULL, 0},
- {"forward", InfoClassForwardCmd, NULL, NULL, NULL, 0},
- {"instances", InfoClassInstancesCmd, NULL, NULL, NULL, 0},
- {"methods", InfoClassMethodsCmd, NULL, NULL, NULL, 0},
- {"methodtype", InfoClassMethodTypeCmd, NULL, NULL, NULL, 0},
- {"mixins", InfoClassMixinsCmd, NULL, NULL, NULL, 0},
- {"subclasses", InfoClassSubsCmd, NULL, NULL, NULL, 0},
- {"superclasses", InfoClassSupersCmd, NULL, NULL, NULL, 0},
- {"variables", InfoClassVariablesCmd, NULL, NULL, NULL, 0},
+ {"call", InfoClassCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"constructor", InfoClassConstrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"definition", InfoClassDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"destructor", InfoClassDestrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"filters", InfoClassFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"forward", InfoClassForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"instances", InfoClassInstancesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"methods", InfoClassMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"methodtype", InfoClassMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -100,6 +100,7 @@ TclOOInitInfo(
Tcl_Interp *interp)
{
Tcl_Command infoCmd;
+ Tcl_Obj *mapDict;
/*
* Build the ensembles used to implement [info object] and [info class].
@@ -113,25 +114,12 @@ TclOOInitInfo(
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
- if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) {
- Tcl_Obj *mapDict, *objectObj, *classObj;
-
- Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
- if (mapDict != NULL) {
- objectObj = Tcl_NewStringObj("object", -1);
- classObj = Tcl_NewStringObj("class", -1);
-
- Tcl_IncrRefCount(objectObj);
- Tcl_IncrRefCount(classObj);
- Tcl_DictObjPut(NULL, mapDict, objectObj,
- Tcl_NewStringObj("::oo::InfoObject", -1));
- Tcl_DictObjPut(NULL, mapDict, classObj,
- Tcl_NewStringObj("::oo::InfoClass", -1));
- Tcl_DecrRefCount(objectObj);
- Tcl_DecrRefCount(classObj);
- Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
- }
- }
+ Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
+ Tcl_NewStringObj("::oo::InfoObject", -1));
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
+ Tcl_NewStringObj("::oo::InfoClass", -1));
+ Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
}
/*
@@ -209,11 +197,11 @@ InfoObjectClassCmd(
FOREACH(mixinPtr, oPtr->mixins) {
if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
return TCL_OK;
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(
TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
return TCL_OK;
}
@@ -430,7 +418,7 @@ InfoObjectIsACmd(
if (!ok) {
Tcl_ResetResult(interp);
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(ok!=0));
return TCL_OK;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
@@ -444,7 +432,7 @@ InfoObjectIsACmd(
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(oPtr->classPtr!=NULL));
return TCL_OK;
case IsMetaclass:
if (objc != 3) {
@@ -452,12 +440,12 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
} else {
Class *classCls = TclOOGetFoundation(interp)->classCls;
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(
+ TclOOIsReachable(classCls, oPtr->classPtr)!=0));
}
return TCL_OK;
case IsMixin:
@@ -479,12 +467,12 @@ InfoObjectIsACmd(
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr == o2Ptr->classPtr) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
return TCL_OK;
}
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
case IsType:
if (objc != 4) {
@@ -502,9 +490,9 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
}
return TCL_OK;
case IsObject:
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 28820e0..98b4078 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -860,7 +860,7 @@ PushMethodCallFrame(
if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
ByteCode *codePtr =
- pmPtr->procPtr->bodyPtr->internalRep.otherValuePtr;
+ pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
codePtr->nsPtr = nsPtr;
}
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 55f2378..921aced 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -2,19 +2,6 @@
* ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
*/
-/*
- * We need to ensure that we use the tcl stub macros so that this file
- * contains no references to any of the tcl stub functions.
- */
-
-#undef USE_TCL_STUBS
-#define USE_TCL_STUBS
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#define USE_TCLOO_STUBS 1
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
@@ -35,51 +22,48 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
* to indicate that an error occurred.
*
* Side effects:
- * Sets the stub table pointer.
+ * Sets the stub table pointers.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char *
TclOOInitializeStubs(
- Tcl_Interp *interp, const char *version)
+ Tcl_Interp *interp,
+ const char *version)
{
int exact = 0;
const char *packageName = "TclOO";
const char *errMsg = NULL;
- ClientData clientData = NULL;
- const char *actualVersion =
- Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);
+ TclOOStubs *stubsPtr = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, exact, &stubsPtr);
- if (clientData == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error loading %s package; package not present or incomplete",
- packageName));
+ if (actualVersion == NULL) {
return NULL;
+ }
+ if (stubsPtr == NULL) {
+ errMsg = "missing stub table pointer";
} else {
- const TclOOStubs * const stubsPtr = clientData;
- const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ?
- stubsPtr->hooks->tclOOIntStubs : NULL;
-
- if (!actualVersion) {
- return NULL;
- }
-
- if (!stubsPtr || !intStubsPtr) {
- errMsg = "missing stub table pointer";
- goto error;
- }
-
tclOOStubsPtr = stubsPtr;
- tclOOIntStubsPtr = intStubsPtr;
+ if (stubsPtr->hooks) {
+ tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
+ } else {
+ tclOOIntStubsPtr = NULL;
+ }
return actualVersion;
-
- error:
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
- " (requested version '%s', loaded version '%s'): %s",
- packageName, version, actualVersion, errMsg));
- return NULL;
}
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 74cb29e..b62c088 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -58,7 +58,7 @@ char *tclEmptyStringRep = &tclEmptyString;
* for sanity checking purposes.
*/
-typedef struct ObjData {
+typedef struct {
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
const char *file; /* The name of the source file calling this
* function; used for debugging. */
@@ -208,7 +208,6 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*/
static int ParseBoolean(Tcl_Obj *objPtr);
-static int SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
@@ -250,14 +249,14 @@ static const Tcl_ObjType oldBooleanType = {
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
"double", /* name */
@@ -1006,7 +1005,12 @@ Tcl_ConvertToType(
*/
if (typePtr->setFromAnyProc == NULL) {
- Tcl_Panic("may not convert object to type %s", typePtr->name);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't convert value to type %s", typePtr->name));
+ Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL);
+ }
+ return TCL_ERROR;
}
return typePtr->setFromAnyProc(interp, objPtr);
@@ -1255,7 +1259,7 @@ Tcl_DbNewObj(
* Side effects:
* tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
* first of a number of free Tcl_Obj's linked together by their
- * internalRep.otherValuePtrs.
+ * internalRep.twoPtrValue.ptr1's.
*
*----------------------------------------------------------------------
*/
@@ -1284,7 +1288,7 @@ TclAllocateFreeObjects(void)
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
- objPtr->internalRep.otherValuePtr = prevPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
prevPtr = objPtr;
objPtr++;
}
@@ -1709,142 +1713,6 @@ Tcl_InvalidateStringRep(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewBooleanObj --
- *
- * This function is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
- * initializes it from the argument boolean value. A nonzero "boolValue"
- * is coerced to 1.
- *
- * When TCL_MEM_DEBUG is defined, this function just returns the result
- * of calling the debugging version Tcl_DbNewBooleanObj.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewBooleanObj
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
- register int boolValue) /* Boolean used to initialize new object. */
-{
- return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
- register int boolValue) /* Boolean used to initialize new object. */
-{
- register Tcl_Obj *objPtr;
-
- TclNewBooleanObj(objPtr, boolValue);
- return objPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewBooleanObj --
- *
- * This function is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- * same as the Tcl_NewBooleanObj function above except that it calls
- * Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the [memory active]
- * command will report the correct file name and line number when
- * reporting objects that haven't been freed.
- *
- * When TCL_MEM_DEBUG is not defined, this function just returns the
- * result of calling Tcl_NewBooleanObj.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
- register int boolValue, /* Boolean used to initialize new object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- register Tcl_Obj *objPtr;
-
- TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.longValue = (boolValue? 1 : 0);
- objPtr->typePtr = &tclIntType;
- return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
- register int boolValue, /* Boolean used to initialize new object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- return Tcl_NewBooleanObj(boolValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetBooleanObj --
- *
- * Modify an object to be a boolean object and to have the specified
- * boolean value. A nonzero "boolValue" is coerced to 1.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's old string rep, if any, is freed. Also, any old internal
- * rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetBooleanObj(
- register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
- register int boolValue) /* Boolean used to set object's value. */
-{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
- }
-
- TclSetBooleanObj(objPtr, boolValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetBooleanFromObj --
*
* Attempt to return a boolean from the Tcl object "objPtr". This
@@ -1911,7 +1779,7 @@ Tcl_GetBooleanFromObj(
/*
*----------------------------------------------------------------------
*
- * SetBooleanFromAny --
+ * TclSetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
* "objPtr".
@@ -1928,8 +1796,8 @@ Tcl_GetBooleanFromObj(
*----------------------------------------------------------------------
*/
-static int
-SetBooleanFromAny(
+int
+TclSetBooleanFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
@@ -2362,89 +2230,6 @@ UpdateStringOfDouble(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewIntObj --
- *
- * If a client is compiled with TCL_MEM_DEBUG defined, calls to
- * Tcl_NewIntObj to create a new integer object end up calling the
- * debugging function Tcl_DbNewLongObj instead.
- *
- * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- * calls to Tcl_NewIntObj result in a call to one of the two
- * Tcl_NewIntObj implementations below. We provide two implementations so
- * that the Tcl core can be compiled to do memory debugging of the core
- * even if a client does not request it for itself.
- *
- * Integer and long integer objects share the same "integer" type
- * implementation. We store all integers as longs and Tcl_GetIntFromObj
- * checks whether the current value of the long can be represented by an
- * int.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewIntObj
-
-Tcl_Obj *
-Tcl_NewIntObj(
- register int intValue) /* Int used to initialize the new object. */
-{
- return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewIntObj(
- register int intValue) /* Int used to initialize the new object. */
-{
- register Tcl_Obj *objPtr;
-
- TclNewIntObj(objPtr, intValue);
- return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetIntObj --
- *
- * Modify an object to be an integer and to have the specified integer
- * value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's old string rep, if any, is freed. Also, any old internal
- * rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetIntObj(
- register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
- register int intValue) /* Integer used to set object's value. */
-{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
- }
-
- TclSetIntObj(objPtr, intValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetIntFromObj --
*
* Attempt to return an int from the Tcl object "objPtr". If the object
@@ -2616,11 +2401,11 @@ Tcl_NewLongObj(
* Tcl_DbNewLongObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
- * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
- * objects end up calling the debugging function Tcl_DbNewLongObj
- * instead. We provide two implementations of Tcl_DbNewLongObj so that
- * whether the Tcl core is compiled to do memory debugging of the core is
- * independent of whether a client requests debugging for itself.
+ * Tcl_NewLongObj to create new long integer objects end up calling the
+ * debugging function Tcl_DbNewLongObj instead. We provide two
+ * implementations of Tcl_DbNewLongObj so that whether the Tcl core is
+ * compiled to do memory debugging of the core is independent of whether
+ * a client requests debugging for itself.
*
* When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
* calls Tcl_DbCkalloc directly with the file name and line number from
@@ -3784,7 +3569,7 @@ Tcl_DbDecrRefCount(
* If the Tcl_Obj is going to be deleted, remove the entry.
*/
- if ((objPtr->refCount - 1) <= 0) {
+ if (objPtr->refCount < 2) {
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
@@ -3797,7 +3582,7 @@ Tcl_DbDecrRefCount(
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */
- if (--(objPtr)->refCount <= 0) {
+ if ((objPtr)->refCount-- < 2) {
TclFreeObj(objPtr);
}
}
@@ -4171,7 +3956,7 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
+ if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
return NULL;
}
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -4390,7 +4175,7 @@ SetCmdNameFromAny(
if (cmdPtr) {
cmdPtr->refCount++;
- resPtr = objPtr->internalRep.otherValuePtr;
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr == &tclCmdNameType)
&& resPtr && (resPtr->refCount == 1)) {
/*
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 2b9ff87..ea5c1b8 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -71,7 +71,7 @@ static const Tcl_ObjType tclFsPathType = {
*
*/
-typedef struct FsPath {
+typedef struct {
Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
* is NULL, then this is a pure normalized,
* absolute path object, in which the parent
@@ -109,9 +109,9 @@ typedef struct FsPath {
* fields.
*/
-#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.otherValuePtr)
+#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
#define SETPATHOBJ(pathPtr,fsPathPtr) \
- ((pathPtr)->internalRep.otherValuePtr = (void *) (fsPathPtr))
+ ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
@@ -1156,7 +1156,7 @@ Tcl_FSConvertToPathType(
FreeFsPathInternalRep(pathPtr);
}
- return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+ return SetFsPathFromAny(interp, pathPtr);
/*
* We used to have more complex code here:
@@ -1873,7 +1873,7 @@ Tcl_FSGetNormalizedPath(
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
+ if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
return NULL;
}
fsPathPtr = PATHOBJ(pathPtr);
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 312524a..ec5d0e6 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -39,7 +39,7 @@ typedef struct PkgAvail {
* "Tk" (no version number).
*/
-typedef struct Package {
+typedef struct {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
@@ -88,7 +88,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgProvide / Tcl_PkgProvideEx --
+ * Tcl_PkgProvideEx --
*
* This function is invoked to declare that a particular version of a
* particular package is now present in an interpreter. There must not be
@@ -154,7 +154,7 @@ Tcl_PkgProvideEx(
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
+ * Tcl_PkgRequireEx / Tcl_PkgRequireProc --
*
* This function is called by code that depends on a particular version
* of a particular package. If the package is not already provided in the
@@ -179,20 +179,6 @@ Tcl_PkgProvideEx(
*/
const char *
-Tcl_PkgRequire(
- Tcl_Interp *interp, /* Interpreter in which package is now
- * available. */
- const char *name, /* Name of desired package. */
- const char *version, /* Version string for desired version; NULL
- * means use the latest version available. */
- int exact) /* Non-zero means that only the particular
- * version given is acceptable. Zero means use
- * the latest compatible version. */
-{
- return Tcl_PkgRequireEx(interp, name, version, exact, NULL);
-}
-
-const char *
Tcl_PkgRequireEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
@@ -642,7 +628,7 @@ PkgRequireCore(
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgPresent / Tcl_PkgPresentEx --
+ * Tcl_PkgPresentEx --
*
* Checks to see whether the specified package is present. If it is not
* then no additional action is taken.
@@ -661,20 +647,6 @@ PkgRequireCore(
*/
const char *
-Tcl_PkgPresent(
- Tcl_Interp *interp, /* Interpreter in which package is now
- * available. */
- const char *name, /* Name of desired package. */
- const char *version, /* Version string for desired version; NULL
- * means use the latest version available. */
- int exact) /* Non-zero means that only the particular
- * version given is acceptable. Zero means use
- * the latest compatible version. */
-{
- return Tcl_PkgPresentEx(interp, name, version, exact, NULL);
-}
-
-const char *
Tcl_PkgPresentEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
@@ -936,7 +908,7 @@ Tcl_PackageObjCmd(
version = TclGetString(objv[3]);
}
}
- Tcl_PkgPresent(interp, name, version, exact);
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL);
return TCL_ERROR;
break;
}
@@ -961,7 +933,7 @@ Tcl_PackageObjCmd(
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_PkgProvide(interp, argv2, argv3);
+ return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
case PKG_REQUIRE:
require:
if (objc < 3) {
@@ -1880,7 +1852,7 @@ Tcl_PkgInitStubsCheck(
const char * version,
int exact)
{
- const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
+ const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);
if (exact && actualVersion) {
const char *p = version;
@@ -1892,11 +1864,11 @@ Tcl_PkgInitStubsCheck(
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
- Tcl_PkgPresent(interp, "Tcl", version, 1);
+ Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
- return Tcl_PkgPresent(interp, "Tcl", version, 1);
+ return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
}
}
return actualVersion;
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 7021b8d..12a60db 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -19,11 +19,10 @@
#endif
#if defined(_WIN32)
# include "tclWinPort.h"
-#endif
-#include "tcl.h"
-#if !defined(_WIN32)
+#else
# include "tclUnixPort.h"
#endif
+#include "tcl.h"
#if !defined(LLONG_MIN)
# ifdef TCL_WIDE_INT_IS_LONG
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 0bd8f93..62c8de4 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
* objects that we don't want to live any longer than necessary.
*/
-typedef struct HandleStruct {
+typedef struct {
void *ptr; /* Pointer to the memory block being tracked.
* This field will become NULL when the memory
* block is deleted. This field must be the
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 933e7d2..29f0772 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -421,7 +421,7 @@ TclCreateProc(
* will be holding a reference to it.
*/
- procPtr = bodyPtr->internalRep.otherValuePtr;
+ procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
@@ -1197,7 +1197,7 @@ TclInitCompiledLocals(
if (bodyPtr->typePtr != &tclByteCodeType) {
Tcl_Panic("body object for proc attached to frame is not a byte code type");
}
- codePtr = bodyPtr->internalRep.otherValuePtr;
+ codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
if (framePtr->numCompiledLocals) {
if (!codePtr->localCachePtr) {
@@ -1347,17 +1347,9 @@ TclFreeLocalCache(
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
register Tcl_Obj *objPtr = *namePtrPtr;
- /*
- * Note that this can be called with interp==NULL, on interp deletion.
- * In that case, the literal table and objects go away on their own.
- */
-
if (objPtr) {
- if (interp) {
- TclReleaseLiteral(interp, objPtr);
- } else {
- Tcl_DecrRefCount(objPtr);
- }
+ /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
+ TclReleaseLiteral(interp, objPtr);
}
}
ckfree(localCachePtr);
@@ -1368,7 +1360,7 @@ InitLocalCache(
Proc *procPtr)
{
Interp *iPtr = procPtr->iPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
int localCt = procPtr->numCompiledLocals;
int numArgs = procPtr->numArgs, i = 0;
@@ -1445,7 +1437,7 @@ InitArgsAndLocals(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
register Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
@@ -1632,7 +1624,7 @@ PushProcCallFrame(
* commands and/or resolver changes are considered).
*/
- codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+ codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
@@ -1833,7 +1825,7 @@ TclNRInterpProcCore(
*/
procPtr->refCount++;
- codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+ codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
@@ -1975,7 +1967,7 @@ TclProcCompileProc(
{
Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
- ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
/*
* If necessary, compile the procedure's body. The compiler will allocate
@@ -2095,7 +2087,7 @@ TclProcCompileProc(
iPtr->invokeWord = 0;
iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
- tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+ TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
TclPopStackFrame(interp);
} else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
@@ -2365,7 +2357,7 @@ TclNewProcBodyObj(
TclNewObj(objPtr);
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.otherValuePtr = procPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
procPtr->refCount++;
}
@@ -2395,10 +2387,10 @@ ProcBodyDup(
Tcl_Obj *srcPtr, /* Object to copy. */
Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
- Proc *procPtr = srcPtr->internalRep.otherValuePtr;
+ Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
dupPtr->typePtr = &tclProcBodyType;
- dupPtr->internalRep.otherValuePtr = procPtr;
+ dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
procPtr->refCount++;
}
@@ -2425,10 +2417,9 @@ static void
ProcBodyFree(
Tcl_Obj *objPtr) /* The object to clean up. */
{
- Proc *procPtr = objPtr->internalRep.otherValuePtr;
+ Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
- procPtr->refCount--;
- if (procPtr->refCount <= 0) {
+ if (procPtr->refCount-- < 2) {
TclProcCleanupProc(procPtr);
}
}
@@ -2721,7 +2712,6 @@ TclNRApplyObjCmd(
else {
/*
* Joe English's suggestion to allow cmdNames to function as lambdas.
- * Also requires making tclCmdNameType non-static in tclObj.c
*/
Tcl_Obj *elemPtr;
@@ -2881,7 +2871,8 @@ Tcl_DisassembleObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], types,
+ sizeof(char *), "type", 0, &idx) != TCL_OK){
return TCL_ERROR;
}
@@ -2961,10 +2952,9 @@ Tcl_DisassembleObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
- if (objv[2]->typePtr != &tclByteCodeType) {
- if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
- return TCL_ERROR;
- }
+ if ((objv[2]->typePtr != &tclByteCodeType)
+ && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+ return TCL_ERROR;
}
codeObjPtr = objv[2];
break;
@@ -3061,7 +3051,7 @@ Tcl_DisassembleObjCmd(
* Do the actual disassembly.
*/
- if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
+ if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags
& TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 6c1dc08..030be1d 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -64,7 +64,7 @@
#define NUM_REGEXPS 30
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
* expression patterns. NULL means that this
@@ -578,7 +578,7 @@ Tcl_GetRegExpFromObj(
* TclRegexp* when the type is tclRegexpType.
*/
- regexpPtr = objPtr->internalRep.otherValuePtr;
+ regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
pattern = TclGetStringFromObj(objPtr, &length);
@@ -601,7 +601,7 @@ Tcl_GetRegExpFromObj(
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = regexpPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
objPtr->typePtr = &tclRegexpType;
}
return (Tcl_RegExp) regexpPtr;
@@ -672,7 +672,7 @@ TclRegAbout(
resultObj = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
+ Tcl_NewLongObj((long) regexpPtr->re.re_nsub));
/*
* Now append a list of all the bit-flags set for the RE.
@@ -749,7 +749,7 @@ static void
FreeRegexpInternalRep(
Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
- TclRegexp *regexpRepPtr = objPtr->internalRep.otherValuePtr;
+ TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
/*
* If this is the last reference to the regexp, free it.
@@ -783,10 +783,10 @@ DupRegexpInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- TclRegexp *regexpPtr = srcPtr->internalRep.otherValuePtr;
+ TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
regexpPtr->refCount++;
- copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->typePtr = &tclRegexpType;
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index ad45c41..a22f83f 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -34,7 +34,7 @@ static void ResetObjResult(Interp *iPtr);
* then back up to the result or the error that was previously in progress.
*/
-typedef struct InterpState {
+typedef struct {
int status; /* return code status */
int flags; /* Each remaining field saves the */
int returnLevel; /* corresponding field of the Interp */
@@ -210,106 +210,6 @@ Tcl_DiscardInterpState(
/*
*----------------------------------------------------------------------
*
- * Tcl_SaveResult --
- *
- * Takes a snapshot of the current result state of the interpreter. The
- * snapshot can be restored at any point by Tcl_RestoreResult. Note that
- * this routine does not preserve the errorCode, errorInfo, or flags
- * fields so it should not be used if an error is in progress.
- *
- * Once a snapshot is saved, it must be restored by calling
- * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Resets the interpreter result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SaveResult(
- Tcl_Interp *interp, /* Interpreter to save. */
- Tcl_SavedResult *statePtr) /* Pointer to state structure. */
-{
- Interp *iPtr = (Interp *) interp;
-
- /*
- * Move the result object into the save state. Note that we don't need to
- * change its refcount because we're moving it, not adding a new
- * reference. Put an empty object into the interpreter.
- */
-
- statePtr->objResultPtr = iPtr->objResultPtr;
- iPtr->objResultPtr = Tcl_NewObj();
- Tcl_IncrRefCount(iPtr->objResultPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RestoreResult --
- *
- * Restores the state of the interpreter to a snapshot taken by
- * Tcl_SaveResult. After this call, the token for the interpreter state
- * is no longer valid.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Restores the interpreter result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_RestoreResult(
- Tcl_Interp *interp, /* Interpreter being restored. */
- Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
-{
- Interp *iPtr = (Interp *) interp;
-
- Tcl_ResetResult(interp);
-
- /*
- * Restore the object result.
- */
-
- Tcl_DecrRefCount(iPtr->objResultPtr);
- iPtr->objResultPtr = statePtr->objResultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DiscardResult --
- *
- * Frees the memory associated with an interpreter snapshot taken by
- * Tcl_SaveResult. If the snapshot is not restored, this function must be
- * called to discard it, or the memory will be lost.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DiscardResult(
- Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
-{
- TclDecrRefCount(statePtr->objResultPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_SetResult --
*
* Arrange for "result" to be the Tcl return value.
@@ -1231,7 +1131,7 @@ Tcl_GetReturnOptions(
}
if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "", -1);
+ Tcl_AddErrorInfo(interp, "");
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
}
if (iPtr->errorCode) {
diff --git a/generic/tclScan.c b/generic/tclScan.c
index ef7eedf..c54395d 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -28,7 +28,7 @@
* character set.
*/
-typedef struct CharSet {
+typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index b38f521..73e7c06 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -104,7 +104,7 @@ const Tcl_ObjType tclStringType = {
* tcl.h, but do not do that unless you are sure what you're doing!
*/
-typedef struct String {
+typedef struct {
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
@@ -140,9 +140,9 @@ typedef struct String {
#define stringAttemptRealloc(ptr, numChars) \
(String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \
- ((String *) (objPtr)->internalRep.otherValuePtr)
+ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
- ((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
/*
* TCL STRING GROWTH ALGORITHM
@@ -2043,7 +2043,7 @@ Tcl_AppendFormatToObj(
const char *bytes;
if (useShort) {
- pure = Tcl_NewIntObj((int) s);
+ pure = Tcl_NewLongObj((long) s);
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
} else if (useBig) {
@@ -2517,7 +2517,7 @@ AppendPrintfToObjVA(
break;
case '*':
lastNum = (int) va_arg(argList, int);
- Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(lastNum));
p++;
break;
case '0': case '1': case '2': case '3': case '4':
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 39d1262..2a10d25 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -25,10 +25,8 @@
#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
-#undef Tcl_NewBooleanObj
#undef Tcl_NewByteArrayObj
#undef Tcl_NewDoubleObj
-#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_NewObj
@@ -42,6 +40,7 @@
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef TclPkgProvide
+#undef Tcl_SetIntObj
#define TclPkgProvide pkgProvide
static int TclPkgProvide(
@@ -66,14 +65,6 @@ static int TclPkgProvide(
return TCL_ERROR;
}
-#if defined(_WIN32) || defined(__CYGWIN__)
-#undef TclWinNToHS
-#define TclWinNToHS winNToHS
-static unsigned short TclWinNToHS(unsigned short ns) {
- return ntohs(ns);
-}
-#endif
-
#ifdef __WIN32__
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
@@ -310,22 +301,22 @@ static const TclIntStubs tclIntStubs = {
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
- Tcl_AppendExportList, /* 112 */
- Tcl_CreateNamespace, /* 113 */
- Tcl_DeleteNamespace, /* 114 */
- Tcl_Export, /* 115 */
- Tcl_FindCommand, /* 116 */
- Tcl_FindNamespace, /* 117 */
+ 0, /* 112 */
+ 0, /* 113 */
+ 0, /* 114 */
+ 0, /* 115 */
+ 0, /* 116 */
+ 0, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
- Tcl_ForgetImport, /* 121 */
- Tcl_GetCommandFromObj, /* 122 */
- Tcl_GetCommandFullName, /* 123 */
- Tcl_GetCurrentNamespace, /* 124 */
- Tcl_GetGlobalNamespace, /* 125 */
+ 0, /* 121 */
+ 0, /* 122 */
+ 0, /* 123 */
+ 0, /* 124 */
+ 0, /* 125 */
Tcl_GetVariableFullName, /* 126 */
- Tcl_Import, /* 127 */
+ 0, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
@@ -494,7 +485,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclWinGetSockOpt, /* 3 */
TclWinGetTclInstance, /* 4 */
TclUnixWaitForFile, /* 5 */
- TclWinNToHS, /* 6 */
+ 0, /* 6 */
TclWinSetSockOpt, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
@@ -684,7 +675,7 @@ const TclStubs tclStubs = {
Tcl_DbDecrRefCount, /* 19 */
Tcl_DbIncrRefCount, /* 20 */
Tcl_DbIsShared, /* 21 */
- Tcl_DbNewBooleanObj, /* 22 */
+ 0, /* 22 */
Tcl_DbNewByteArrayObj, /* 23 */
Tcl_DbNewDoubleObj, /* 24 */
Tcl_DbNewListObj, /* 25 */
@@ -698,7 +689,7 @@ const TclStubs tclStubs = {
Tcl_GetByteArrayFromObj, /* 33 */
Tcl_GetDouble, /* 34 */
Tcl_GetDoubleFromObj, /* 35 */
- Tcl_GetIndexFromObj, /* 36 */
+ 0, /* 36 */
Tcl_GetInt, /* 37 */
Tcl_GetIntFromObj, /* 38 */
Tcl_GetLongFromObj, /* 39 */
@@ -711,25 +702,25 @@ const TclStubs tclStubs = {
Tcl_ListObjIndex, /* 46 */
Tcl_ListObjLength, /* 47 */
Tcl_ListObjReplace, /* 48 */
- Tcl_NewBooleanObj, /* 49 */
+ 0, /* 49 */
Tcl_NewByteArrayObj, /* 50 */
Tcl_NewDoubleObj, /* 51 */
- Tcl_NewIntObj, /* 52 */
+ 0, /* 52 */
Tcl_NewListObj, /* 53 */
Tcl_NewLongObj, /* 54 */
Tcl_NewObj, /* 55 */
Tcl_NewStringObj, /* 56 */
- Tcl_SetBooleanObj, /* 57 */
+ 0, /* 57 */
Tcl_SetByteArrayLength, /* 58 */
Tcl_SetByteArrayObj, /* 59 */
Tcl_SetDoubleObj, /* 60 */
- Tcl_SetIntObj, /* 61 */
+ 0, /* 61 */
Tcl_SetListObj, /* 62 */
Tcl_SetLongObj, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
- Tcl_AddErrorInfo, /* 66 */
- Tcl_AddObjErrorInfo, /* 67 */
+ 0, /* 66 */
+ 0, /* 67 */
Tcl_AllowExceptions, /* 68 */
Tcl_AppendElement, /* 69 */
Tcl_AppendResult, /* 70 */
@@ -791,9 +782,9 @@ const TclStubs tclStubs = {
Tcl_Eof, /* 126 */
Tcl_ErrnoId, /* 127 */
Tcl_ErrnoMsg, /* 128 */
- Tcl_Eval, /* 129 */
+ 0, /* 129 */
0, /* 130 */
- Tcl_EvalObj, /* 131 */
+ 0, /* 131 */
Tcl_EventuallyFree, /* 132 */
Tcl_Exit, /* 133 */
Tcl_ExposeCommand, /* 134 */
@@ -845,7 +836,7 @@ const TclStubs tclStubs = {
Tcl_GetSlave, /* 172 */
Tcl_GetStdChannel, /* 173 */
Tcl_GetStringResult, /* 174 */
- Tcl_GetVar, /* 175 */
+ 0, /* 175 */
Tcl_GetVar2, /* 176 */
0, /* 177 */
0, /* 178 */
@@ -907,7 +898,7 @@ const TclStubs tclStubs = {
Tcl_SetObjErrorCode, /* 234 */
Tcl_SetObjResult, /* 235 */
Tcl_SetStdChannel, /* 236 */
- Tcl_SetVar, /* 237 */
+ 0, /* 237 */
Tcl_SetVar2, /* 238 */
Tcl_SignalId, /* 239 */
Tcl_SignalMsg, /* 240 */
@@ -917,21 +908,21 @@ const TclStubs tclStubs = {
Tcl_StaticPackage, /* 244 */
Tcl_StringMatch, /* 245 */
0, /* 246 */
- Tcl_TraceVar, /* 247 */
+ 0, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
Tcl_Ungets, /* 250 */
Tcl_UnlinkVar, /* 251 */
Tcl_UnregisterChannel, /* 252 */
- Tcl_UnsetVar, /* 253 */
+ 0, /* 253 */
Tcl_UnsetVar2, /* 254 */
- Tcl_UntraceVar, /* 255 */
+ 0, /* 255 */
Tcl_UntraceVar2, /* 256 */
Tcl_UpdateLinkedVar, /* 257 */
- Tcl_UpVar, /* 258 */
+ 0, /* 258 */
Tcl_UpVar2, /* 259 */
0, /* 260 */
- Tcl_VarTraceInfo, /* 261 */
+ 0, /* 261 */
Tcl_VarTraceInfo2, /* 262 */
Tcl_Write, /* 263 */
Tcl_WrongNumArgs, /* 264 */
@@ -941,10 +932,10 @@ const TclStubs tclStubs = {
0, /* 268 */
Tcl_HashStats, /* 269 */
Tcl_ParseVar, /* 270 */
- Tcl_PkgPresent, /* 271 */
+ 0, /* 271 */
Tcl_PkgPresentEx, /* 272 */
TclPkgProvide, /* 273 */
- Tcl_PkgRequire, /* 274 */
+ 0, /* 274 */
0, /* 275 */
0, /* 276 */
Tcl_WaitPid, /* 277 */
@@ -960,7 +951,7 @@ const TclStubs tclStubs = {
Tcl_CreateEncoding, /* 287 */
Tcl_CreateThreadExitHandler, /* 288 */
Tcl_DeleteThreadExitHandler, /* 289 */
- Tcl_DiscardResult, /* 290 */
+ 0, /* 290 */
Tcl_EvalEx, /* 291 */
Tcl_EvalObjv, /* 292 */
Tcl_EvalObjEx, /* 293 */
@@ -984,8 +975,8 @@ const TclStubs tclStubs = {
Tcl_ConditionWait, /* 311 */
Tcl_NumUtfChars, /* 312 */
Tcl_ReadChars, /* 313 */
- Tcl_RestoreResult, /* 314 */
- Tcl_SaveResult, /* 315 */
+ 0, /* 314 */
+ 0, /* 315 */
Tcl_SetSystemEncoding, /* 316 */
Tcl_SetVar2Ex, /* 317 */
Tcl_ThreadAlert, /* 318 */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 720d9ef..cadb7b9 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -23,39 +23,16 @@ const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
-static const TclStubs *
-HasStubSupport(
- Tcl_Interp *interp,
- const char *tclversion,
- int magic)
-{
- /* TODO: Whatever additional checks using tclversion
- * and/or magic should be done here. */
-
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->stubTable && iPtr->stubTable->magic == magic) {
- return iPtr->stubTable;
- }
- iPtr->legacyResult
- = "interpreter uses an incompatible stubs mechanism";
- iPtr->legacyFreeProc = 0; /* TCL_STATIC */
- return NULL;
-}
-
/*
- * Use our own isdigit to avoid linking to libc on windows
+ * Use our own ISDIGIT to avoid linking to libc on windows
*/
-static int isDigit(const int c)
-{
- return (c >= '0' && c <= '9');
-}
+#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)
/*
*----------------------------------------------------------------------
*
- * TclInitStubs --
+ * Tcl_InitStubs --
*
* Tries to initialise the stub table pointers and ensures that the
* correct version of Tcl is loaded.
@@ -71,16 +48,17 @@ static int isDigit(const int c)
*/
#undef Tcl_InitStubs
MODULE_SCOPE const char *
-TclInitStubs(
+Tcl_InitStubs(
Tcl_Interp *interp,
const char *version,
int exact,
const char *tclversion,
int magic)
{
+ Interp *iPtr = (Interp *) interp;
const char *actualVersion = NULL;
ClientData pkgData = NULL;
- const TclStubs *stubsPtr;
+ const TclStubs *stubsPtr = iPtr->stubTable;
/*
* We can't optimize this check by caching tclStubsPtr because that
@@ -88,8 +66,9 @@ TclInitStubs(
* times. [Bug 615304]
*/
- stubsPtr = HasStubSupport(interp, tclversion, magic);
- if (!stubsPtr) {
+ if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
+ iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
+ iPtr->legacyFreeProc = 0; /* TCL_STATIC */
return NULL;
}
@@ -97,12 +76,12 @@ TclInitStubs(
if (actualVersion == NULL) {
return NULL;
}
- if (exact) {
+ if (exact&1) {
const char *p = version;
int count = 0;
while (*p) {
- count += !isDigit(*p++);
+ count += !ISDIGIT(*p++);
}
if (count == 1) {
const char *q = actualVersion;
@@ -111,7 +90,7 @@ TclInitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p || isDigit(*q)) {
+ if (*p || ISDIGIT(*q)) {
/* Construct error message */
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
@@ -123,7 +102,14 @@ TclInitStubs(
}
}
}
- tclStubsPtr = (TclStubs *)pkgData;
+
+ if (stubsPtr->reserved77) {
+ /* We are running Tcl 8. Do some additional checks here. */
+ tclStubsPtr = (TclStubs *)pkgData;
+ } else {
+ /* We are running Tcl 9. Do some additional checks here. */
+ tclStubsPtr = stubsPtr;
+ }
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 9b958dd..8caf493 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -90,7 +90,7 @@ static Tcl_Trace cmdTrace;
* TestdelCmd:
*/
-typedef struct DelCmd {
+typedef struct {
Tcl_Interp *interp; /* Interpreter in which command exists. */
char *deleteCmd; /* Script to execute when command is deleted.
* Malloc'ed. */
@@ -101,7 +101,7 @@ typedef struct DelCmd {
* command.
*/
-typedef struct TclEncoding {
+typedef struct {
Tcl_Interp *interp;
char *toUtfCmd;
char *fromUtfCmd;
@@ -117,7 +117,7 @@ static int exitMainLoop = 0;
* Event structure used in testing the event queue management procedures.
*/
-typedef struct TestEvent {
+typedef struct {
Tcl_Event header; /* Header common to all events */
Tcl_Interp *interp; /* Interpreter that will handle the event */
Tcl_Obj *command; /* Command to evaluate when the event occurs */
@@ -521,7 +521,7 @@ Tcltest_Init(
}
/* TIP #268: Full patchlevel instead of just major.minor */
- if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -680,8 +680,8 @@ Tcltest_Init(
if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
- if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
- TCL_EXACT, &index) == TCL_OK)) {
+ if (objc && (Tcl_GetIndexFromObjStruct(NULL, objv[0], specialOptions,
+ sizeof(char *), NULL, TCL_EXACT, &index) == TCL_OK)) {
switch (index) {
case 0:
return TCL_ERROR;
@@ -771,7 +771,7 @@ TestasyncCmd(
if (argc < 2) {
wrongNumArgs:
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
@@ -789,7 +789,7 @@ TestasyncCmd(
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
Tcl_MutexUnlock(&asyncTestMutex);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(asyncPtr->id));
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
Tcl_MutexLock(&asyncTestMutex);
@@ -861,7 +861,7 @@ TestasyncCmd(
if (Tcl_CreateThread(&threadID, AsyncThreadProc,
INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_NOFLAGS) != TCL_OK) {
- Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
+ Tcl_AppendResult(interp, "can't create thread", NULL);
Tcl_MutexUnlock(&asyncTestMutex);
return TCL_ERROR;
}
@@ -885,7 +885,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. */
@@ -915,7 +915,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
@@ -1008,7 +1008,7 @@ TestcmdinfoCmd(
Tcl_DStringResult(interp, &delString);
} else if (strcmp(argv[1], "get") == 0) {
if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
- Tcl_SetResult(interp, "??", TCL_STATIC);
+ Tcl_AppendResult(interp, "??", NULL);
return TCL_OK;
}
if (info.proc == CmdProc1) {
@@ -1043,9 +1043,9 @@ TestcmdinfoCmd(
info.deleteProc = CmdDelProc2;
info.deleteData = (ClientData) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -1135,7 +1135,7 @@ TestcmdtokenCmd(
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(ClientData) "original", NULL);
sprintf(buf, "%p", (void *)token);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
@@ -1198,7 +1198,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);
@@ -1214,13 +1214,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);
@@ -1238,10 +1238,10 @@ TestcmdtraceCmd(
cmdTrace = Tcl_CreateObjTrace(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
(ClientData) &deleteCalled, ObjTraceDeleteProc);
- result = Tcl_Eval(interp, argv[2]);
+ result = Tcl_EvalEx(interp, argv[2], -1, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
- Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
+ Tcl_AppendResult(interp, "Delete wasn't called", NULL);
return TCL_ERROR;
} else {
return result;
@@ -1252,7 +1252,7 @@ TestcmdtraceCmd(
Tcl_DStringInit(&buffer);
t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
t2 = 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);
@@ -1541,7 +1541,7 @@ TestdelCmd(
Tcl_Interp *slave;
if (argc != 4) {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
@@ -1581,7 +1581,7 @@ DelDeleteProc(
{
DelCmd *dPtr = clientData;
- Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
+ Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
Tcl_ResetResult(dPtr->interp);
ckfree(dPtr->deleteCmd);
ckfree(dPtr);
@@ -1693,8 +1693,8 @@ TestdoubledigitsObjCmd(ClientData unused,
}
if (status != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
- || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
- TCL_EXACT, &type) != TCL_OK) {
+ || Tcl_GetIndexFromObjStruct(interp, objv[3], options,
+ sizeof(char *), "conversion type", TCL_EXACT, &type) != TCL_OK) {
fprintf(stderr, "bad value? %g\n", d);
return TCL_ERROR;
}
@@ -1710,7 +1710,7 @@ TestdoubledigitsObjCmd(ClientData unused,
strObj = Tcl_NewStringObj(str, endPtr-str);
ckfree(str);
retval = Tcl_NewListObj(1, &strObj);
- Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
+ Tcl_ListObjAppendElement(NULL, retval, Tcl_NewLongObj(decpt));
strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
Tcl_ListObjAppendElement(NULL, retval, strObj);
Tcl_SetObjResult(interp, retval);
@@ -1746,7 +1746,7 @@ TestdstringCmd(
if (argc < 2) {
wrongNumArgs:
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "append") == 0) {
@@ -1782,9 +1782,9 @@ TestdstringCmd(
goto wrongNumArgs;
}
if (strcmp(argv[2], "staticsmall") == 0) {
- Tcl_SetResult(interp, "short", TCL_STATIC);
+ Tcl_AppendResult(interp, "short", NULL);
} else if (strcmp(argv[2], "staticlarge") == 0) {
- Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
+ Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
} else if (strcmp(argv[2], "free") == 0) {
char *s = ckalloc(100);
strcpy(s, "This is a malloc-ed string");
@@ -1805,7 +1805,7 @@ TestdstringCmd(
if (argc != 2) {
goto wrongNumArgs;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
@@ -1880,8 +1880,8 @@ TestencodingObjCmd(
ENC_CREATE, ENC_DELETE
};
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -2140,8 +2140,8 @@ TesteventObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
- TCL_EXACT, &subCmdIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands,
+ sizeof(char *), "subcommand", TCL_EXACT, &subCmdIndex) != TCL_OK) {
return TCL_ERROR;
}
switch (subCmdIndex) {
@@ -2150,8 +2150,8 @@ TesteventObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "name position script");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[3], positions,
- "position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[3], positions,
+ sizeof(char *), "position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
return TCL_ERROR;
}
ev = ckalloc(sizeof(TestEvent));
@@ -2384,7 +2384,7 @@ TestexprlongCmd(
" expression\"", NULL);
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLong(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2426,7 +2426,7 @@ TestexprlongobjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2469,7 +2469,7 @@ TestexprdoubleCmd(
" expression\"", NULL);
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDouble(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2512,7 +2512,7 @@ TestexprdoubleobjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -3254,8 +3254,8 @@ TestlocaleCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -3452,7 +3452,7 @@ PrintParse(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewIntObj(parsePtr->numWords));
+ Tcl_NewLongObj(parsePtr->numWords));
for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
@@ -3492,7 +3492,7 @@ PrintParse(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewIntObj(tokenPtr->numComponents));
+ Tcl_NewLongObj(tokenPtr->numComponents));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
@@ -3662,8 +3662,8 @@ TestregexpObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
+ sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
@@ -3738,7 +3738,7 @@ TestregexpObjCmd(
* value 0.
*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags&REG_EXPECT) && indices) {
const char *varName;
const char *value;
@@ -3834,7 +3834,7 @@ TestregexpObjCmd(
* Set the interpreter's object result to an integer object w/ value 1.
*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), 1);
return TCL_OK;
}
@@ -4229,7 +4229,7 @@ TestseterrorcodeCmd(
const char **argv) /* Argument strings. */
{
if (argc > 6) {
- Tcl_SetResult(interp, "too many args", TCL_STATIC);
+ Tcl_AppendResult(interp, "too many args", NULL);
return TCL_ERROR;
}
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
@@ -4783,7 +4783,7 @@ TestsetCmd(
const char *value;
if (argc == 2) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
+ Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], NULL, flags);
if (value == NULL) {
return TCL_ERROR;
@@ -4791,7 +4791,7 @@ TestsetCmd(
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 3) {
- Tcl_SetResult(interp, "before set", TCL_STATIC);
+ Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -4815,7 +4815,7 @@ Testset2Cmd(
const char *value;
if (argc == 3) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
+ Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -4823,7 +4823,7 @@ Testset2Cmd(
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 4) {
- Tcl_SetResult(interp, "before set", TCL_STATIC);
+ Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -4880,8 +4880,8 @@ TestsaveresultCmd(
Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
@@ -4891,7 +4891,7 @@ TestsaveresultCmd(
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
case RESULT_SMALL:
- Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+ Tcl_AppendResult(interp, "small result", NULL);
break;
case RESULT_APPEND:
Tcl_AppendResult(interp, "append result", NULL);
@@ -4917,7 +4917,7 @@ TestsaveresultCmd(
if (((enum options) index) == RESULT_OBJECT) {
result = Tcl_EvalObjEx(interp, objv[2], 0);
} else {
- result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
+ result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
}
if (discard) {
@@ -4995,7 +4995,7 @@ TestmainthreadCmd(
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
}
@@ -5796,7 +5796,7 @@ TestWrongNumArgsObjCmd(
* Don't use Tcl_WrongNumArgs here, as that is the function
* we want to test!
*/
- Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
@@ -5813,7 +5813,7 @@ TestWrongNumArgsObjCmd(
/*
* Asked for more arguments than were given.
*/
- Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
@@ -6013,7 +6013,7 @@ TestReport(
}
Tcl_DStringEndSublist(&ds);
Tcl_SaveResult(interp, &savedResult);
- Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
Tcl_DStringFree(&ds);
Tcl_RestoreResult(interp, &savedResult);
}
@@ -6437,7 +6437,7 @@ TestNumUtfCharsCmd(
(void) Tcl_GetStringFromObj(objv[1], &len);
}
len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(len));
}
return TCL_OK;
}
@@ -6491,7 +6491,7 @@ TestcpuidCmd(
return status;
}
for (i=0 ; i<4 ; ++i) {
- regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
+ regsObjs[i] = Tcl_NewLongObj((int) regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
@@ -6532,7 +6532,7 @@ TestHashSystemHashCmd(
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
@@ -6549,13 +6549,13 @@ TestHashSystemHashCmd(
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
@@ -6586,7 +6586,7 @@ TestgetintCmd(
const char **argv)
{
if (argc < 2) {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
} else {
int val, i, total=0;
@@ -6597,7 +6597,7 @@ TestgetintCmd(
}
total += val;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(total));
return TCL_OK;
}
}
@@ -6622,18 +6622,18 @@ TestNRELevels(
depth = (refDepth - &depth);
- levels[0] = Tcl_NewIntObj(depth);
- levels[1] = Tcl_NewIntObj(iPtr->numLevels);
- levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
- levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
- levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
+ levels[0] = Tcl_NewLongObj(depth);
+ levels[1] = Tcl_NewLongObj(iPtr->numLevels);
+ levels[2] = Tcl_NewLongObj(iPtr->cmdFramePtr->level);
+ levels[3] = Tcl_NewLongObj(iPtr->varFramePtr->level);
+ levels[4] = Tcl_NewLongObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
- levels[5] = Tcl_NewIntObj(i);
+ levels[5] = Tcl_NewLongObj(i);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
return TCL_OK;
@@ -6980,8 +6980,8 @@ TestparseargsCmd(
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
- result[0] = Tcl_NewIntObj(foo);
- result[1] = Tcl_NewIntObj(count);
+ result[0] = Tcl_NewLongObj(foo);
+ result[1] = Tcl_NewLongObj(count);
result[2] = Tcl_NewListObj(count, remObjv);
Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
ckfree(remObjv);
@@ -7158,8 +7158,8 @@ TestInterpResolverCmd(
Tcl_WrongNumArgs(interp, 1, objv, "up|down");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT,
- &idx) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], table,
+ sizeof(char *), "operation", TCL_EXACT, &idx) != TCL_OK) {
return TCL_ERROR;
}
switch (idx) {
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 7494beb..adc6063 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -47,7 +47,7 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-typedef struct TestString {
+typedef struct {
int numChars;
int allocated;
int maxChars;
@@ -172,8 +172,8 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[2]);
@@ -346,9 +346,9 @@ TestbooleanobjCmd(
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+ Tcl_SetLongObj(varPtr[varIndex], boolValue!=0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue!=0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
@@ -371,9 +371,9 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+ Tcl_SetLongObj(varPtr[varIndex], boolValue==0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue==0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -554,13 +554,14 @@ TestindexobjCmd(
return TCL_ERROR;
}
- Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
- indexRep = objv[1]->internalRep.otherValuePtr;
+ Tcl_GetIndexFromObjStruct(NULL, objv[1], tablePtr,
+ sizeof(char *), "token", 0, &index);
+ indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
- result = Tcl_GetIndexFromObj(NULL, objv[1],
- tablePtr, "token", 0, &index);
+ result = Tcl_GetIndexFromObjStruct(NULL, objv[1],
+ tablePtr, sizeof(char *), "token", 0, &index);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
}
return result;
}
@@ -592,17 +593,17 @@ TestindexobjCmd(
if (objv[3]->typePtr != NULL
&& !strcmp("index", objv[3]->typePtr->name)) {
- indexRep = objv[3]->internalRep.otherValuePtr;
+ indexRep = objv[3]->internalRep.twoPtrValue.ptr1;
if (indexRep->tablePtr == (void *) argv) {
TclFreeIntRep(objv[3]);
}
}
- result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
- argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
+ result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3],
+ argv, sizeof(char *), "token", (allowAbbrev? 0 : TCL_EXACT), &index);
ckfree(argv);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
}
return result;
}
@@ -669,9 +670,9 @@ TestintobjCmd(
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue);
+ Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
@@ -684,9 +685,9 @@ TestintobjCmd(
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue);
+ Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
} else if (strcmp(subCmd, "setlong") == 0) {
if (objc != 4) {
@@ -780,9 +781,9 @@ TestintobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
+ Tcl_SetLongObj(varPtr[varIndex], intValue * 10);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
@@ -797,9 +798,9 @@ TestintobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
+ Tcl_SetLongObj(varPtr[varIndex], intValue / 10);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -864,8 +865,8 @@ TestlistobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
- 0, &cmdIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands,
+ sizeof(char *), "command", 0, &cmdIndex) != TCL_OK) {
return TCL_ERROR;
}
switch(cmdIndex) {
@@ -963,6 +964,17 @@ TestobjCmd(
}
SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
+ } else if (strcmp(subCmd, "bug3598580") == 0) {
+ Tcl_Obj *listObjPtr, *elemObjPtr;
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
+ elemObjPtr = Tcl_NewLongObj(123);
+ listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
+ /* Replace the single list element through itself, nonsense but legal. */
+ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
const char *typeName;
@@ -1065,7 +1077,7 @@ TestobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
@@ -1150,8 +1162,8 @@ TeststringobjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
switch (option) {
@@ -1229,7 +1241,7 @@ TeststringobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
? varPtr[varIndex]->length : -1);
break;
case 5: /* length2 */
@@ -1239,12 +1251,12 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
+ strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = (int) strPtr->allocated;
} else {
length = -1;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), length);
break;
case 6: /* set */
if (objc != 4) {
@@ -1293,12 +1305,12 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
+ strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = -1;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), length);
break;
case 10: /* getunicode */
if (objc != 3) {
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index a3f89f6..be510fc 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -34,7 +34,7 @@ static const char procCommand[] = "proc";
* procs
*/
-typedef struct CmdTable {
+typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
@@ -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;
}
}
@@ -185,7 +185,7 @@ ProcBodyTestInitInternal(
}
}
- return Tcl_PkgProvide(interp, packageName, packageVersion);
+ return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index e4261d6..438efc5 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -82,7 +82,7 @@ typedef union Block {
* and statistics information.
*/
-typedef struct Bucket {
+typedef struct {
Block *firstPtr; /* First block available */
long numFree; /* Number of blocks available */
@@ -573,7 +573,7 @@ TclThreadAllocObj(void)
}
while (--numMove >= 0) {
objPtr = &newObjsPtr[numMove];
- objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
}
}
@@ -584,7 +584,7 @@ TclThreadAllocObj(void)
*/
objPtr = cachePtr->firstObjPtr;
- cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+ cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
cachePtr->numObjects--;
return objPtr;
}
@@ -621,7 +621,7 @@ TclThreadFreeObj(
* Get this thread's list and push on the free Tcl_Obj.
*/
- objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
cachePtr->numObjects++;
@@ -722,16 +722,16 @@ MoveObjs(
*/
while (--numMove) {
- objPtr = objPtr->internalRep.otherValuePtr;
+ objPtr = objPtr->internalRep.twoPtrValue.ptr1;
}
- fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+ fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
/*
* Move all objects as a block - they are already linked to each other, we
* just have to update the first and last.
*/
- objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
toPtr->firstObjPtr = fromFirstObjPtr;
}
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index f24e334..36bf0a5 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -47,7 +47,7 @@ static struct TSDMaster {
* The type of the data held per thread in a system TSD.
*/
-typedef struct TSDTable {
+typedef struct {
ClientData *tablePtr; /* The table of Tcl TSDs. */
sig_atomic_t allocated; /* The size of the table in the current
* thread. */
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index c1828bb..ccf5101 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -62,7 +62,7 @@ static ThreadSpecificData *threadList = NULL;
*/
typedef struct ThreadCtrl {
- const char *script; /* The Tcl command this thread should
+ const char *script; /* The Tcl command this thread should
* execute */
int flags; /* Initial value of the "flags" field in the
* ThreadSpecificData structure for the new
@@ -229,8 +229,8 @@ ThreadObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
- &option) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], threadOptions,
+ sizeof(char *), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
@@ -368,7 +368,7 @@ ThreadObjCmd(
result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), status);
} else {
char buf[20];
@@ -415,7 +415,7 @@ ThreadObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(
Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
return TCL_OK;
}
@@ -513,7 +513,6 @@ ThreadCreate(
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
- ckfree(ctrl.script);
return TCL_ERROR;
}
@@ -614,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);
}
@@ -927,10 +926,11 @@ ThreadSend(
ckfree(resultPtr->errorInfo);
}
}
- Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+ Tcl_AppendResult(interp, resultPtr->result, NULL);
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
+ ckfree(resultPtr->result);
ckfree(resultPtr);
return code;
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 6b17825..c5f11c9 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -91,7 +91,7 @@ typedef struct IdleHandler {
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
TimerHandler *firstTimerHandlerPtr; /* First event in queue. */
int lastTimerId; /* Timer identifier of most recently created
* timer. */
@@ -823,8 +823,8 @@ Tcl_AfterObjCmd(
|| objv[1]->typePtr == &tclWideIntType
#endif
|| objv[1]->typePtr == &tclBignumType
- || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
- &index) != TCL_OK)) {
+ || (Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds,
+ sizeof(char *), "", 0, &index) != TCL_OK)) {
index = -1;
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 775e86b..48db8c3 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -111,7 +111,7 @@ extern void *
TclBNAlloc(
size_t x)
{
- return (void *) Tcl_Alloc((unsigned int) x);
+ return (void *) ckalloc((unsigned int) x);
}
/*
@@ -135,7 +135,7 @@ TclBNRealloc(
void *p,
size_t s)
{
- return (void *) Tcl_Realloc((char *) p, (unsigned int) s);
+ return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
@@ -161,7 +161,7 @@ extern void
TclBNFree(
void *p)
{
- Tcl_Free((char *) p);
+ ckree((char *) p);
}
#endif
diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
index a3bc4b3..324f2a3 100644
--- a/generic/tclTomMathStubLib.c
+++ b/generic/tclTomMathStubLib.c
@@ -11,15 +11,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-/*
- * We need to ensure that we use the stub macros so that this file contains no
- * references to any of the stub functions. This will make it possible to
- * build an extension that references Tcl_InitStubs but doesn't end up
- * including the rest of the stub functions.
- */
-
-#define USE_TCL_STUBS
-
#include "tclInt.h"
MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;
@@ -55,31 +46,30 @@ TclTomMathInitializeStubs(
int exact = 0;
const char *packageName = "tcl::tommath";
const char *errMsg = NULL;
- ClientData pkgClientData = NULL;
- const char *actualVersion =
- Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
- const TclTomMathStubs *stubsPtr = pkgClientData;
+ TclTomMathStubs *stubsPtr = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, exact, &stubsPtr);
if (actualVersion == NULL) {
return NULL;
}
- if (pkgClientData == NULL) {
+ if (stubsPtr == NULL) {
errMsg = "missing stub table pointer";
- } else if ((stubsPtr->tclBN_epoch)() != epoch) {
+ } else if(stubsPtr->tclBN_epoch() != epoch) {
errMsg = "epoch number mismatch";
- } else if ((stubsPtr->tclBN_revision)() != revision) {
+ } else if(stubsPtr->tclBN_revision() != revision) {
errMsg = "requires a later revision";
} else {
tclTomMathStubsPtr = stubsPtr;
return actualVersion;
}
-
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error loading %s (requested version %s, actual version %s): %s",
- packageName, version, actualVersion, errMsg));
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
return NULL;
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 519f201..bbbbf3c 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -143,7 +143,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1,
* trace procs
*/
-typedef struct StringTraceData {
+typedef struct {
ClientData clientData; /* Client data from Tcl_CreateTrace */
Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
@@ -155,8 +155,8 @@ typedef struct StringTraceData {
#define FOREACH_VAR_TRACE(interp, name, clientData) \
(clientData) = NULL; \
- while (((clientData) = Tcl_VarTraceInfo((interp), (name), 0, \
- TraceVarProc, (clientData))) != NULL)
+ while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
+ 0, TraceVarProc, (clientData))) != NULL)
#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
(clientData) = NULL; \
@@ -1322,7 +1322,7 @@ TraceCommandProc(
Tcl_DStringLength(&cmd), 0);
if (code != TCL_OK) {
/* We ignore errors in these traced commands */
- /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+ /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
}
Tcl_DStringFree(&cmd);
}
@@ -1485,7 +1485,11 @@ TclCheckExecutionTraces(
}
iPtr->activeCmdTracePtr = active.nextPtr;
if (state) {
- Tcl_RestoreInterpState(interp, state);
+ if (traceCode == TCL_OK) {
+ (void) Tcl_RestoreInterpState(interp, state);
+ } else {
+ Tcl_DiscardInterpState(state);
+ }
}
return traceCode;
@@ -1845,7 +1849,7 @@ TraceExecutionProc(
* Append result code.
*/
- resultCode = Tcl_NewIntObj(code);
+ resultCode = Tcl_NewLongObj(code);
resultCodeStr = Tcl_GetString(resultCode);
Tcl_DStringAppendElement(&cmd, resultCodeStr);
Tcl_DecrRefCount(resultCode);
@@ -1885,7 +1889,7 @@ TraceExecutionProc(
* interpreter.
*/
- traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+ traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), -1, 0);
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
/*
@@ -1975,7 +1979,7 @@ TraceVarProc(
int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
- * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
+ * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete]
* which might try to free tvarPtr. We want to use tvarPtr until the end
* of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
* it is not freed while we still need it.
@@ -2797,38 +2801,6 @@ DisposeTraceResult(
/*
*----------------------------------------------------------------------
*
- * Tcl_UntraceVar --
- *
- * Remove a previously-created trace for a variable.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If there exists a trace for the variable given by varName with the
- * given flags, proc, and clientData, then that trace is removed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_UntraceVar(
- Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *varName, /* Name of variable; may end with "(index)" to
- * signify an array reference. */
- int flags, /* OR-ed collection of bits describing current
- * trace, including any of TCL_TRACE_READS,
- * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
- * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc, /* Function assocated with trace. */
- ClientData clientData) /* Arbitrary argument to pass to proc. */
-{
- Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_UntraceVar2 --
*
* Remove a previously-created trace for a variable.
@@ -2959,46 +2931,6 @@ Tcl_UntraceVar2(
/*
*----------------------------------------------------------------------
*
- * Tcl_VarTraceInfo --
- *
- * Return the clientData value associated with a trace on a variable.
- * This function can also be used to step through all of the traces on a
- * particular variable that have the same trace function.
- *
- * Results:
- * The return value is the clientData value associated with a trace on
- * the given variable. Information will only be returned for a trace with
- * proc as trace function. If the clientData argument is NULL then the
- * first such trace is returned; otherwise, the next relevant one after
- * the one given by clientData will be returned. If the variable doesn't
- * exist, or if there are no (more) traces for it, then NULL is returned.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_VarTraceInfo(
- Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *varName, /* Name of variable; may end with "(index)" to
- * signify an array reference. */
- int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_VarTraceProc *proc, /* Function assocated with trace. */
- ClientData prevClientData) /* If non-NULL, gives last value returned by
- * this function, so this call will return the
- * next trace after that one. If NULL, this
- * call will return the first trace. */
-{
- return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
- prevClientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_VarTraceInfo2 --
*
* Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
@@ -3069,44 +3001,6 @@ Tcl_VarTraceInfo2(
/*
*----------------------------------------------------------------------
*
- * Tcl_TraceVar --
- *
- * Arrange for reads and/or writes to a variable to cause a function to
- * be invoked, which can monitor the operations and/or change their
- * actions.
- *
- * Results:
- * A standard Tcl return value.
- *
- * Side effects:
- * A trace is set up on the variable given by varName, such that future
- * references to the variable will be intermediated by proc. See the
- * manual entry for complete details on the calling sequence for proc.
- * The variable's flags are updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_TraceVar(
- Tcl_Interp *interp, /* Interpreter in which variable is to be
- * traced. */
- const char *varName, /* Name of variable; may end with "(index)" to
- * signify an array reference. */
- int flags, /* OR-ed collection of bits, including any of
- * TCL_TRACE_READS, TCL_TRACE_WRITES,
- * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
- * TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc, /* Function to call when specified ops are
- * invoked upon varName. */
- ClientData clientData) /* Arbitrary argument to pass to proc. */
-{
- return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_TraceVar2 --
*
* Arrange for reads and/or writes to a variable to cause a function to
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index 5c88639..946a4a5 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -624,7 +624,7 @@ static const unsigned char groupMap[] = {
15, 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,
+ 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 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,
85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86,
@@ -792,114 +792,114 @@ static const unsigned char groupMap[] = {
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,
+ 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 17, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 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, 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, 15, 15, 15, 15, 15, 15, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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,
- 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,
+ 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, 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, 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, 86, 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, 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,
+ 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, 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,
+ 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, 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,
- 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,
- 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,
- 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,
- 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14,
+ 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, 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, 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, 17, 17, 17, 17, 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, 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, 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, 7, 7, 14, 14, 7,
- 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, 7, 7, 14, 14,
+ 7, 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, 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,
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 93ab34b..02c5eb8 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1516,8 +1516,9 @@ Tcl_UniCharIsSpace(
if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
return isspace(UCHAR(ch)); /* INTL: ISO space */
- } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x200b
- || (Tcl_UniChar) ch == 0x2060 || (Tcl_UniChar) ch == 0xfeff) {
+ } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
+ || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
+ || (Tcl_UniChar) ch == 0xfeff) {
return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 4b69628..bcfdc2a 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -167,7 +167,7 @@ const Tcl_ObjType tclEndOffsetType = {
* separating whitespace, or a string terminator. It is just another
* character in a list element.
*
- * The interpretaton of a formatted substring as a list element follows rules
+ * The interpretation of a formatted substring as a list element follows rules
* similar to the parsing of the words of a command in a Tcl script. Backslash
* substitution plays a key role, and is defined exactly as it is in command
* parsing. The same routine, TclParseBackslash() is used in both command
@@ -179,7 +179,7 @@ const Tcl_ObjType tclEndOffsetType = {
* Backslash substitution replaces an "escape sequence" of one or more
* characters starting with
* \u005c \ BACKSLASH
- * with a single character. The one character escape sequent case happens only
+ * with a single character. The one character escape sequence case happens only
* when BACKSLASH is the last character in the string. In all other cases, the
* escape sequence is at least two characters long.
*
@@ -871,9 +871,9 @@ Tcl_SplitList(
int
Tcl_ScanElement(
- register const char *src, /* String to convert to list element. */
- register int *flagPtr) /* Where to store information to guide
- * Tcl_ConvertCountedElement. */
+ const char *src, /* String to convert to list element. */
+ int *flagPtr) /* Where to store information to guide
+ * Tcl_ConvertCountedElement. */
{
return Tcl_ScanCountedElement(src, -1, flagPtr);
}
@@ -908,7 +908,7 @@ Tcl_ScanCountedElement(
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
- int flags = CONVERT_ANY;
+ char flags = CONVERT_ANY;
int numBytes = TclScanElement(src, length, &flags);
*flagPtr = flags;
@@ -949,7 +949,7 @@ int
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
- int *flagPtr) /* Where to store information to guide
+ char *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
const char *p = src;
@@ -1234,9 +1234,9 @@ TclScanElement(
int
Tcl_ConvertElement(
- register const char *src, /* Source information for list element. */
- register char *dst, /* Place to put list-ified element. */
- register int flags) /* Flags produced by Tcl_ScanElement. */
+ const char *src, /* Source information for list element. */
+ char *dst, /* Place to put list-ified element. */
+ int flags) /* Flags produced by Tcl_ScanElement. */
{
return Tcl_ConvertCountedElement(src, -1, dst, flags);
}
@@ -1300,9 +1300,9 @@ TclConvertElement(
register const char *src, /* Source information for list element. */
int length, /* Number of bytes in src, or -1. */
char *dst, /* Place to put list-ified element. */
- int flags) /* Flags produced by Tcl_ScanElement. */
+ char flags) /* Flags produced by Tcl_ScanElement. */
{
- int conversion = flags & CONVERT_MASK;
+ char conversion = flags & CONVERT_MASK;
char *p = dst;
/*
@@ -1481,11 +1481,10 @@ Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
-#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+#define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE];
int i, bytesNeeded = 0;
- char *result, *dst;
- const int maxFlags = UINT_MAX / sizeof(int);
+ char *result, *dst, *flagPtr = NULL;
/*
* Handle empty list case first, so logic of the general case can be
@@ -1504,22 +1503,8 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
- } else if (argc > maxFlags) {
- /*
- * We cannot allocate a large enough flag array to format this list in
- * one pass. We could imagine converting this routine to a multi-pass
- * implementation, but for sizeof(int) == 4, the limit is a max of
- * 2^30 list elements and since each element is at least one byte
- * formatted, and requires one byte space between it and the next one,
- * that a minimum space requirement of 2^31 bytes, which is already
- * INT_MAX. If we tried to format a list of > maxFlags elements, we're
- * just going to overflow the size limits on the formatted string
- * anyway, so just issue that same panic early.
- */
-
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = ckalloc(argc * sizeof(int));
+ flagPtr = ckalloc(argc);
}
for (i = 0; i < argc; i++) {
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
@@ -2597,7 +2582,7 @@ Tcl_DStringAppendElement(
{
char *dst = dsPtr->string + dsPtr->length;
int needSpace = TclNeedSpace(dsPtr->string, dst);
- int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
+ char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
int newSize = dsPtr->length + needSpace
+ TclScanElement(element, -1, &flags);
@@ -2827,14 +2812,16 @@ TclDStringToObj(
{
Tcl_Obj *result;
- if (dsPtr->length == 0) {
- TclNewObj(result);
- } else if (dsPtr->string == dsPtr->staticSpace) {
- /*
- * Static buffer, so must copy.
- */
-
- TclNewStringObj(result, dsPtr->string, dsPtr->length);
+ if (dsPtr->string == dsPtr->staticSpace) {
+ if (dsPtr->length == 0) {
+ TclNewObj(result);
+ } else {
+ /*
+ * Static buffer, so must copy.
+ */
+
+ TclNewStringObj(result, dsPtr->string, dsPtr->length);
+ }
} else {
/*
* Dynamic buffer, so transfer ownership and reset.
@@ -3141,7 +3128,7 @@ TclPrecTraceProc(
if (flags & TCL_TRACE_READS) {
- Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
+ Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr),
flags & TCL_GLOBAL_ONLY);
return NULL;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index d8a7141..e153fa4 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,6 +47,13 @@ static inline void CleanupVar(Var *varPtr, Var *arrayPtr);
#define VarHashGetValue(hPtr) \
((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in. This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
static inline Var *
VarHashCreateVar(
TclVarHashTable *tablePtr,
@@ -137,6 +144,30 @@ static const char *isArrayElement =
#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
/*
+ * The following structure describes an enumerative search in progress on an
+ * array variable; this are invoked with options to the "array" command.
+ */
+
+typedef struct ArraySearch {
+ int id; /* Integer id used to distinguish among
+ * multiple concurrent searches for the same
+ * array. */
+ struct Var *varPtr; /* Pointer to array variable that's being
+ * searched. */
+ Tcl_HashSearch search; /* Info kept by the hash module about progress
+ * through the array. */
+ Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
+ * be enumerated (it's leftover from the
+ * Tcl_FirstHashEntry call or from an "array
+ * anymore" command). NULL means must call
+ * Tcl_NextHashEntry to get value to
+ * return. */
+ struct ArraySearch *nextPtr;/* Next in list of all active searches for
+ * this variable, or NULL if this is the last
+ * one. */
+} ArraySearch;
+
+/*
* Forward references to functions defined later in this file:
*/
@@ -383,11 +414,12 @@ TclLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part1Ptr;
Var *varPtr;
+ Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
+ if (createPart1) {
+ Tcl_IncrRefCount(part1Ptr);
+ }
varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
createPart1, createPart2, arrayPtrPtr);
@@ -432,6 +464,8 @@ TclLookupVar(
* are 1. The object part1Ptr is converted to one of localVarNameType,
* tclNsVarNameType or tclParsedVarNameType and caches as much of the
* lookup as it can.
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
*
*----------------------------------------------------------------------
*/
@@ -460,14 +494,14 @@ TclObjLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part2Ptr;
+ Tcl_Obj *part2Ptr = NULL;
Var *resPtr;
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
}
resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -480,6 +514,12 @@ TclObjLookupVar(
return resPtr;
}
+/*
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
+ * When createPart2 is 1, callers must IncrRefCount part2Ptr if they
+ * plan to DecrRefCount it.
+ */
Var *
TclObjLookupVarEx(
Tcl_Interp *interp, /* Interpreter to use for lookup. */
@@ -620,7 +660,9 @@ TclObjLookupVarEx(
part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
if (newPart2) {
part2Ptr = Tcl_NewStringObj(newPart2, -1);
- Tcl_IncrRefCount(part2Ptr);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
}
part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
typePtr = part1Ptr->typePtr;
@@ -666,7 +708,9 @@ TclObjLookupVarEx(
*(newPart2+len2) = '\0';
part2 = newPart2;
part2Ptr = Tcl_NewStringObj(newPart2, -1);
- Tcl_IncrRefCount(part2Ptr);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
/*
* Free the internal rep of the original part1Ptr, now renamed
@@ -844,6 +888,7 @@ TclObjLookupVarEx(
*
* Side effects:
* A new hashtable entry may be created if create is 1.
+ * Callers must Incr varNamePtr if they plan to Decr it if create is 1.
*
*----------------------------------------------------------------------
*/
@@ -1072,6 +1117,8 @@ TclLookupSimpleVar(
* The variable at arrayPtr may be converted to be an array if
* createPart1 is 1. A new hashtable entry may be created if createPart2
* is 1.
+ * When createElem is 1, callers must incr elNamePtr if they plan
+ * to decr it.
*
*----------------------------------------------------------------------
*/
@@ -1178,50 +1225,6 @@ TclLookupArrayElement(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetVar --
- *
- * Return the value of a Tcl variable as a string.
- *
- * Results:
- * The return value points to the current value of varName as a string.
- * If the variable is not defined or can't be read because of a clash in
- * array usage then a NULL pointer is returned and an error message is
- * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.
- * Note: the return value is only valid up until the next change to the
- * variable; if you depend on the value lasting longer than that, then
- * make yourself a private copy.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-Tcl_GetVar(
- Tcl_Interp *interp, /* Command interpreter in which varName is to
- * be looked up. */
- const char *varName, /* Name of a variable in interp. */
- int flags) /* OR-ed combination of TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
- * bits. */
-{
- Tcl_Obj *varNamePtr, *resultPtr;
-
- varNamePtr = Tcl_NewStringObj(varName, -1);
- Tcl_IncrRefCount(varNamePtr);
- resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
- TclDecrRefCount(varNamePtr);
-
- if (resultPtr == NULL) {
- return NULL;
- }
- return TclGetString(resultPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetVar2 --
*
* Return the value of a Tcl variable as a string, given a two-part name
@@ -1254,15 +1257,12 @@ Tcl_GetVar2(
* TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
* bits. */
{
- Tcl_Obj *resultPtr, *part1Ptr, *part2Ptr;
+ Tcl_Obj *resultPtr;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1311,15 +1311,11 @@ Tcl_GetVar2Ex(
int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1352,6 +1348,8 @@ Tcl_GetVar2Ex(
* the returned reference; if you want to keep a reference to the object
* you must increment its ref count yourself.
*
+ * Callers must incr part2Ptr if they plan to decr it.
+ *
*----------------------------------------------------------------------
*/
@@ -1525,58 +1523,6 @@ Tcl_SetObjCmd(
/*
*----------------------------------------------------------------------
*
- * Tcl_SetVar --
- *
- * Change the value of a variable.
- *
- * Results:
- * Returns a pointer to the malloc'ed string which is the character
- * representation of the variable's new value. The caller must not modify
- * this string. If the write operation was disallowed then NULL is
- * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
- * message will be left in the interp's result. Note that the returned
- * string may not be the same as newValue; this is because variable
- * traces may modify the variable's value.
- *
- * Side effects:
- * If varName is defined as a local or global variable in interp, its
- * value is changed to newValue. If varName isn't currently defined, then
- * a new global variable by that name is created.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-Tcl_SetVar(
- Tcl_Interp *interp, /* Command interpreter in which varName is to
- * be looked up. */
- const char *varName, /* Name of a variable in interp. */
- const char *newValue, /* New value for varName. */
- int flags) /* Various flags that tell how to set value:
- * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
- * TCL_LEAVE_ERR_MSG. */
-{
- Tcl_Obj *valuePtr, *varNamePtr, *varValuePtr;
-
- varNamePtr = Tcl_NewStringObj(varName, -1);
- Tcl_IncrRefCount(varNamePtr);
- valuePtr = Tcl_NewStringObj(newValue, -1);
- Tcl_IncrRefCount(valuePtr);
-
- varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, valuePtr, flags);
-
- Tcl_DecrRefCount(varNamePtr);
- Tcl_DecrRefCount(valuePtr);
- if (varValuePtr == NULL) {
- return NULL;
- }
- return TclGetString(varValuePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_SetVar2 --
*
* Given a two-part variable name, which may refer either to a scalar
@@ -1615,27 +1561,9 @@ Tcl_SetVar2(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *valuePtr, *part1Ptr, *part2Ptr;
- Tcl_Obj *varValuePtr;
-
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
- if (part2 != NULL) {
- part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
- }
- valuePtr = Tcl_NewStringObj(newValue, -1);
- Tcl_IncrRefCount(valuePtr);
-
- varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags);
+ Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+ Tcl_NewStringObj(newValue, -1), flags);
- Tcl_DecrRefCount(part1Ptr);
- if (part2Ptr != NULL) {
- Tcl_DecrRefCount(part2Ptr);
- }
- Tcl_DecrRefCount(valuePtr);
if (varValuePtr == NULL) {
return NULL;
}
@@ -1694,15 +1622,12 @@ Tcl_SetVar2Ex(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1735,6 +1660,8 @@ Tcl_SetVar2Ex(
* Side effects:
* The value of the given variable is set. If either the array or the
* entry didn't exist then a new variable is created.
+ * Callers must Incr part1Ptr if they plan to Decr it.
+ * Callers must Incr part2Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -2024,6 +1951,8 @@ TclPtrSetVar(
* variable is created. The ref count for the returned object is _not_
* incremented to reflect the returned reference; if you want to keep a
* reference to the object you must increment its ref count yourself.
+ * Callers must Incr part1Ptr if they plan to Decr it.
+ * Callers must Incr part2Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -2049,8 +1978,8 @@ TclIncrObjVar2(
varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
1, 1, &arrayPtr);
if (varPtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
+ Tcl_AddErrorInfo(interp,
+ "\n (reading value of variable to increment)");
return NULL;
}
return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
@@ -2106,8 +2035,7 @@ TclPtrIncrObjVar(
* variable, or -1. Only used when part1Ptr is
* NULL. */
{
- register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
- int duplicated, code;
+ register Tcl_Obj *varValuePtr;
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)++;
@@ -2118,70 +2046,36 @@ TclPtrIncrObjVar(
VarHashRefCount(varPtr)--;
}
if (varValuePtr == NULL) {
- varValuePtr = Tcl_NewIntObj(0);
+ varValuePtr = Tcl_NewLongObj(0);
}
if (Tcl_IsShared(varValuePtr)) {
- duplicated = 1;
+ /* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
- } else {
- duplicated = 0;
- }
- code = TclIncrObj(interp, varValuePtr, incrPtr);
- if (code == TCL_OK) {
- newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
- part2Ptr, varValuePtr, flags, index);
- } else if (duplicated) {
- Tcl_DecrRefCount(varValuePtr);
- }
- return newValuePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_UnsetVar --
- *
- * Delete a variable, so that it may not be accessed anymore.
- *
- * Results:
- * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
- * the variable can't be unset. In the event of an error, if the
- * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
- * interp's result.
- *
- * Side effects:
- * If varName is defined as a local or global variable in interp, it is
- * deleted.
- *
- *----------------------------------------------------------------------
- */
-int
-Tcl_UnsetVar(
- Tcl_Interp *interp, /* Command interpreter in which varName is to
- * be looked up. */
- const char *varName, /* Name of a variable in interp. May be either
- * a scalar name or an array name or an
- * element in an array. */
- int flags) /* OR-ed combination of any of
- * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
- * TCL_LEAVE_ERR_MSG. */
-{
- int result;
- Tcl_Obj *varNamePtr;
-
- varNamePtr = Tcl_NewStringObj(varName, -1);
- Tcl_IncrRefCount(varNamePtr);
-
- /*
- * Filter to pass through only the flags this interface supports.
- */
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ Tcl_DecrRefCount(varValuePtr);
+ return NULL;
+ }
+ } else {
+ /* Unshared - can Incr in place */
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
- flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
- result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags);
+ /*
+ * This seems dumb to write the incremeted value into the var
+ * after we just adjusted the value in place, but the spec for
+ * [incr] requires that write traces fire, and making this call
+ * is the way to make that happen.
+ */
- Tcl_DecrRefCount(varNamePtr);
- return result;
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ return NULL;
+ }
+ }
}
/*
@@ -2216,13 +2110,10 @@ Tcl_UnsetVar2(
* TCL_LEAVE_ERR_MSG. */
{
int result;
- Tcl_Obj *part1Ptr, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
}
/*
@@ -2838,6 +2729,7 @@ Tcl_LappendObjCmd(
*
* Side effects:
* A variable will be created if one does not already exist.
+ * Callers must Incr arrayNameObj if they pland to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -3734,8 +3626,8 @@ ArrayNamesCmd(
* Finish parsing the arguments.
*/
- if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option",
- 0, &mode) != TCL_OK) {
+ if ((objc == 4) && Tcl_GetIndexFromObjStruct(interp, objv[2], options,
+ sizeof(char *), "option", 0, &mode) != TCL_OK) {
return TCL_ERROR;
}
@@ -3947,7 +3839,7 @@ ArraySizeCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(size));
return TCL_OK;
}
@@ -4219,16 +4111,16 @@ TclInitArrayCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap arrayImplMap[] = {
- {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL, 0},
- {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL, 0},
+ {"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
- {"get", ArrayGetCmd, NULL, NULL, NULL, 0},
- {"names", ArrayNamesCmd, NULL, NULL, NULL, 0},
- {"nextelement", ArrayNextElementCmd, NULL, NULL, NULL, 0},
+ {"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0},
- {"size", ArraySizeCmd, NULL, NULL, NULL, 0},
- {"startsearch", ArrayStartSearchCmd, NULL, NULL, NULL, 0},
- {"statistics", ArrayStatsCmd, NULL, NULL, NULL, 0},
+ {"size", ArraySizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"startsearch", ArrayStartSearchCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"statistics", ArrayStatsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -4252,6 +4144,8 @@ TclInitArrayCmd(
* The variable given by myName is linked to the variable in framePtr
* given by otherP1 and otherP2, so that references to myName are
* redirected to the other variable like a symbolic link.
+ * Callers must Incr myNamePtr if they plan to Decr it.
+ * Callers must Incr otherP1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -4360,14 +4254,12 @@ TclPtrMakeUpvar(
int index) /* If the variable to be linked is an indexed
* scalar, this is its index. Otherwise, -1 */
{
- Tcl_Obj *myNamePtr;
+ Tcl_Obj *myNamePtr = NULL;
int result;
if (myName) {
myNamePtr = Tcl_NewStringObj(myName, -1);
Tcl_IncrRefCount(myNamePtr);
- } else {
- myNamePtr = NULL;
}
result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
if (myNamePtr) {
@@ -4376,6 +4268,8 @@ TclPtrMakeUpvar(
return result;
}
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+
int
TclPtrObjMakeUpvar(
Tcl_Interp *interp, /* Interpreter containing variables. Used for
@@ -4497,60 +4391,6 @@ TclPtrObjMakeUpvar(
/*
*----------------------------------------------------------------------
*
- * Tcl_UpVar --
- *
- * This function links one variable to another, just like the "upvar"
- * command.
- *
- * Results:
- * A standard Tcl completion code. If an error occurs then an error
- * message is left in the interp's result.
- *
- * Side effects:
- * The variable in frameName whose name is given by varName becomes
- * accessible under the name localNameStr, so that references to
- * localNameStr are redirected to the other variable like a symbolic
- * link.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_UpVar(
- Tcl_Interp *interp, /* Command interpreter in which varName is to
- * be looked up. */
- const char *frameName, /* Name of the frame containing the source
- * variable, such as "1" or "#0". */
- const char *varName, /* Name of a variable in interp to link to.
- * May be either a scalar name or an element
- * in an array. */
- const char *localNameStr, /* Name of link variable. */
- int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
- * indicates scope of localNameStr. */
-{
- int result;
- CallFrame *framePtr;
- Tcl_Obj *varNamePtr, *localNamePtr;
-
- if (TclGetFrame(interp, frameName, &framePtr) == -1) {
- return TCL_ERROR;
- }
-
- varNamePtr = Tcl_NewStringObj(varName, -1);
- Tcl_IncrRefCount(varNamePtr);
- localNamePtr = Tcl_NewStringObj(localNameStr, -1);
- Tcl_IncrRefCount(localNamePtr);
-
- result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0,
- localNamePtr, flags, -1);
- Tcl_DecrRefCount(varNamePtr);
- Tcl_DecrRefCount(localNamePtr);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_UpVar2 --
*
* This function links one variable to another, just like the "upvar"
@@ -5108,7 +4948,8 @@ ParseSearchId(
* Parse the id.
*/
- if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
+ if ((handleObj->typePtr != &tclArraySearchType)
+ && (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
return NULL;
}
@@ -5239,8 +5080,6 @@ TclDeleteNamespaceVars(
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
Tcl_Obj *objPtr = Tcl_NewObj();
-
- Tcl_IncrRefCount(objPtr);
VarHashRefCount(varPtr)++; /* Make sure we get to remove from
* hash. */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
@@ -5504,15 +5343,10 @@ TclVarErrMsg(
* e.g. "read", "set", or "unset". */
const char *reason) /* String describing why operation failed. */
{
- Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2 = NULL;
}
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -5785,7 +5619,6 @@ Tcl_FindNamespaceVar(
Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
Tcl_Var var;
- Tcl_IncrRefCount(namePtr);
var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
Tcl_DecrRefCount(namePtr);
return var;
@@ -5880,7 +5713,6 @@ ObjFindNamespaceVar(
varPtr = NULL;
if (simpleName != name) {
simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
- Tcl_IncrRefCount(simpleNamePtr);
} else {
simpleNamePtr = namePtr;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 9c1176e..93e5af4 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -371,7 +371,7 @@ ConvertErrorToList(
default:
TclNewLiteralStringObj(objv[2], "UNKNOWN");
- TclNewIntObj(objv[3], code);
+ TclNewLongObj(objv[3], code);
return Tcl_NewListObj(4, objv);
}
}
@@ -545,7 +545,7 @@ ExtractHeader(
&tmp);
SetValue(dictObj, "comment", TclDStringToObj(&tmp));
}
- SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
+ SetValue(dictObj, "crc", Tcl_NewLongObj(headerPtr->hcrc!=0));
if (headerPtr->name != Z_NULL) {
if (latin1enc == NULL) {
/*
@@ -563,7 +563,7 @@ ExtractHeader(
SetValue(dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
- SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ SetValue(dictObj, "os", Tcl_NewLongObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
@@ -763,7 +763,7 @@ 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);
@@ -2581,7 +2581,7 @@ ZlibStreamCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_ZlibStreamEof(zstream)));
return TCL_OK;
case zs_checksum: /* $strm checksum */
if (objc != 2) {
@@ -3111,7 +3111,7 @@ ZlibTransformOutput(
e = deflate(&cd->outStream, Z_NO_FLUSH);
produced = cd->outAllocated - cd->outStream.avail_out;
- if (e == Z_OK && cd->outStream.avail_out > 0) {
+ if (e == Z_OK && produced > 0) {
if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
*errorCodePtr = Tcl_GetErrno();
return -1;
@@ -3847,7 +3847,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.
@@ -3865,13 +3865,13 @@ TclZlibInit(
cfg[0].key = "zlibVersion";
cfg[0].value = zlibVersion();
cfg[1].key = NULL;
- Tcl_RegisterConfig(interp, "zlib", cfg, "ascii");
+ Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
/*
* Formally provide the package as a Tcl built-in.
*/
- return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
+ return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
}
/*