summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/Tcl.n39
-rw-r--r--generic/tclBasic.c3
-rw-r--r--generic/tclCmdIL.c76
-rw-r--r--generic/tclCompCmds.c32
-rw-r--r--generic/tclCompCmdsGR.c2
-rw-r--r--generic/tclCompCmdsSZ.c1
-rw-r--r--generic/tclCompile.c38
-rw-r--r--generic/tclCompile.h31
-rw-r--r--generic/tclInt.decls6
-rw-r--r--generic/tclInt.h9
-rw-r--r--generic/tclIntDecls.h6
-rw-r--r--generic/tclLiteral.c3
-rw-r--r--generic/tclOptimize.c2
-rw-r--r--generic/tclStubInit.c1
-rw-r--r--tests/coroutine.test3
-rw-r--r--tools/man2help2.tcl2
-rw-r--r--tools/tcltk-man2html-utils.tcl1
17 files changed, 172 insertions, 83 deletions
diff --git a/doc/Tcl.n b/doc/Tcl.n
index 8b17f93..c7fa9f6 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -108,8 +108,8 @@ Variable substitution may take any of the following forms:
\fIName\fR is the name of a scalar variable; the name is a sequence
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
@@ -117,8 +117,8 @@ Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
@@ -158,25 +158,25 @@ handled specially, along with the value that replaces each sequence.
.RS
.TP 7
\e\fBa\fR
-Audible alert (bell) (0x7).
+Audible alert (bell) (Unicode U+000007).
.TP 7
\e\fBb\fR
-Backspace (0x8).
+Backspace (Unicode U+000008).
.TP 7
\e\fBf\fR
-Form feed (0xc).
+Form feed (Unicode U+00000C).
.TP 7
\e\fBn\fR
-Newline (0xa).
+Newline (Unicode U+00000A).
.TP 7
\e\fBr\fR
-Carriage-return (0xd).
+Carriage-return (Unicode U+00000D).
.TP 7
\e\fBt\fR
-Tab (0x9).
+Tab (Unicode U+000009).
.TP 7
\e\fBv\fR
-Vertical tab (0xb).
+Vertical tab (Unicode U+00000B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
@@ -194,8 +194,9 @@ Backslash
\e\fIooo\fR
.
The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal
-value for the Unicode character that will be inserted, in the range \fI000\fR
-- \fI377\fR. The parser will stop just before this range overflows, or when
+value for the Unicode character that will be inserted, in the range
+\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
+The parser will stop just before this range overflows, or when
the maximum of three digits is reached. The upper bits of the Unicode
character will be 0.
.TP 7
@@ -203,23 +204,27 @@ character will be 0.
.
The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
hexadecimal value for the Unicode character that will be inserted. The upper
-bits of the Unicode character will be 0.
+bits of the Unicode character will be 0 (i.e., the character will be in the
+range U+000000\(enU+0000FF).
.TP 7
\e\fBu\fIhhhh\fR
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
-inserted. The upper bits of the Unicode character will be 0.
+inserted. The upper bits of the Unicode character will be 0 (i.e., the
+character will be in the range U+000000\(enU+00FFFF).
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
twenty-one-bit hexadecimal value for the Unicode character that will be
-inserted, in the range U+0000..U+10FFFF. The parser will stop just
+inserted, in the range U+000000\(enU+10FFFF. The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached. The upper bits of the Unicode character will be 0.
+.RS
.PP
-The range U+010000..U+10FFFD is reserved for the future.
+The range U+010000\(enU+10FFFD is reserved for the future.
+.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8d77cc5..7c02706 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -526,6 +526,9 @@ Tcl_CreateInterp(void)
iPtr->hiddenCmdTablePtr = NULL;
iPtr->interpInfo = NULL;
+ TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+ iPtr->extra.optimizer = TclOptimizeBytecode;
+
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
iPtr->framePtr = NULL; /* Initialise as soon as :: is available */
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fa4ead4..41c1eb6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1147,41 +1147,38 @@ InfoFrameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level, topLevel, code = TCL_OK;
- CmdFrame *runPtr, *framePtr;
+ int level, code = TCL_OK;
+ CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ int topLevel = 0;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?number?");
return TCL_ERROR;
}
- topLevel = ((iPtr->cmdFramePtr == NULL)
- ? 0
- : iPtr->cmdFramePtr->level);
-
- if (corPtr) {
- /*
- * A coroutine: must fix the level computations AND the cmdFrame chain,
- * which is interrupted at the base.
- */
-
- CmdFrame *lastPtr = NULL;
-
- runPtr = iPtr->cmdFramePtr;
+ while (corPtr) {
+ while (*cmdFramePtrPtr) {
+ topLevel++;
+ cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+ }
+ if (corPtr->caller.cmdFramePtr) {
+ *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+ }
+ corPtr = corPtr->callerEEPtr->corPtr;
+ }
+ topLevel += (*cmdFramePtrPtr)->level;
- /* TODO - deal with overflow */
- topLevel += corPtr->caller.cmdFramePtr->level;
- while (runPtr) {
- runPtr->level += corPtr->caller.cmdFramePtr->level;
- lastPtr = runPtr;
- runPtr = runPtr->nextPtr;
+ if (topLevel != iPtr->cmdFramePtr->level) {
+ framePtr = iPtr->cmdFramePtr;
+ while (framePtr) {
+ framePtr->level = topLevel--;
+ framePtr = framePtr->nextPtr;
}
- if (lastPtr) {
- lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
- } else {
- iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+ if (topLevel) {
+ Tcl_Panic("Broken frame level calculation");
}
+ topLevel = iPtr->cmdFramePtr->level;
}
if (objc == 1) {
@@ -1231,20 +1228,27 @@ InfoFrameCmd(
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
done:
- if (corPtr) {
+ cmdFramePtrPtr = &iPtr->cmdFramePtr;
+ corPtr = iPtr->execEnvPtr->corPtr;
+ while (corPtr) {
+ CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+ if (endPtr) {
+ if (*cmdFramePtrPtr == endPtr) {
+ *cmdFramePtrPtr = NULL;
+ } else {
+ CmdFrame *runPtr = *cmdFramePtrPtr;
- if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
- iPtr->cmdFramePtr = NULL;
- } else {
- runPtr = iPtr->cmdFramePtr;
- while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
- runPtr->level -= corPtr->caller.cmdFramePtr->level;
- runPtr = runPtr->nextPtr;
+ while (runPtr->nextPtr != endPtr) {
+ runPtr->level -= endPtr->level;
+ runPtr = runPtr->nextPtr;
+ }
+ runPtr->level = 1;
+ runPtr->nextPtr = NULL;
}
- runPtr->level = 1;
- runPtr->nextPtr = NULL;
+ cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
}
-
+ corPtr = corPtr->callerEEPtr->corPtr;
}
return code;
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d027f1c..51ac9ed 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -496,17 +496,14 @@ TclCompileBreakCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopBreakFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real break.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_BREAK, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -540,9 +537,10 @@ TclCompileCatchCmd(
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
- int resultIndex, optsIndex, range;
+ int resultIndex, optsIndex, range, dropScript = 0;
DefineLineInformation; /* TIP #280 */
-
+ int depth = TclGetStackDepth(envPtr);
+
/*
* If syntax does not match what we expect for [catch], do not compile.
* Let runtime checks determine if syntax has changed.
@@ -615,16 +613,19 @@ TclCompileCatchCmd(
TclEmitOpcode( INST_DUP, envPtr);
TclEmitInvoke(envPtr, INST_EVAL_STK);
/* drop the script */
+ dropScript = 1;
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
ExceptionRangeEnds(envPtr, range);
+
/*
* Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
* and jump around the "error case" code.
*/
+ TclCheckStackDepth(depth+1, envPtr);
PushStringLiteral(envPtr, "0");
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
@@ -633,8 +634,14 @@ TclCompileCatchCmd(
* return code.
*/
- TclAdjustStackDepth(-2, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclSetStackDepth(depth + dropScript, envPtr);
+
+ if (dropScript) {
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+
/* Stack at this point is empty */
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
@@ -683,6 +690,7 @@ TclCompileCatchCmd(
}
TclEmitOpcode( INST_POP, envPtr);
+ TclCheckStackDepth(depth+1, envPtr);
return TCL_OK;
}
@@ -824,17 +832,14 @@ TclCompileContinueCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopContinueFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real continue.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_CONTINUE, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -2370,6 +2375,7 @@ TclCompileForCmd(
SetLineInformation(2);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 50fb8e9..fc54620 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -281,6 +281,7 @@ TclCompileIfCmd(
SetLineInformation(wordIdx);
Tcl_ResetResult(interp);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
@@ -530,6 +531,7 @@ TclCompileIncrCmd(
} else {
SetLineInformation(2);
CompileTokens(envPtr, incrTokenPtr, interp);
+ TclClearNumConversion(envPtr);
}
} else { /* No incr amount given so use 1. */
haveImmValue = 1;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index e7b3ddc..110476e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -3383,6 +3383,7 @@ TclCompileWhileCmd(
}
SetLineInformation(1);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 14d9451..db97c45 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -816,7 +816,9 @@ TclSetByteCodeFromAny(
* instruction generator boundaries.
*/
- TclOptimizeBytecode(&compEnv);
+ if (iPtr->extra.optimizer) {
+ (iPtr->extra.optimizer)(&compEnv);
+ }
/*
* Invoke the compilation hook procedure if one exists.
@@ -1771,7 +1773,7 @@ TclCompileInvocation(
int numWords,
CompileEnv *envPtr)
{
- int wordIdx = 0;
+ int wordIdx = 0, depth = TclGetStackDepth(envPtr);
DefineLineInformation;
if (cmdObj) {
@@ -1804,6 +1806,7 @@ TclCompileInvocation(
} else {
TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
static void
@@ -1816,7 +1819,8 @@ CompileExpanded(
{
int wordIdx = 0;
DefineLineInformation;
-
+ int depth = TclGetStackDepth(envPtr);
+
StartExpanding(envPtr);
if (cmdObj) {
CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -1862,6 +1866,7 @@ CompileExpanded(
*/
TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+ TclCheckStackDepth(depth+1, envPtr);
}
static int
@@ -1873,6 +1878,7 @@ CompileCmdCompileProc(
{
int unwind = 0, incrOffset = -1;
DefineLineInformation;
+ int depth = TclGetStackDepth(envPtr);
/*
* Emit of the INST_START_CMD instruction is controlled by the value of
@@ -1920,6 +1926,7 @@ CompileCmdCompileProc(
TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
}
}
+ TclCheckStackDepth(depth+1, envPtr);
return TCL_OK;
}
@@ -1962,7 +1969,8 @@ CompileCommandTokens(
int *clNext = envPtr->clNext;
int cmdIdx = envPtr->numCommands;
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-
+ int depth = TclGetStackDepth(envPtr);
+
assert (parsePtr->numWords > 0);
/* Pre-Compile */
@@ -2053,6 +2061,7 @@ CompileCommandTokens(
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
+ TclCheckStackDepth(depth, envPtr);
return cmdIdx;
}
@@ -2072,6 +2081,7 @@ TclCompileScript(
* Initial value of -1 indicates this routine
* has not yet generated any bytecode. */
const char *p = script; /* Where we are in our compile. */
+ int depth = TclGetStackDepth(envPtr);
if (envPtr->iPtr == NULL) {
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2183,6 +2193,7 @@ TclCompileScript(
envPtr->codeNext--;
envPtr->currStackDepth++;
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2293,6 +2304,7 @@ TclCompileTokens(
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
+ int depth = TclGetStackDepth(envPtr);
/*
* For the handling of continuation lines in literals we first check if
@@ -2470,6 +2482,7 @@ TclCompileTokens(
if (maxNumCL) {
ckfree(clPosition);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -3985,7 +3998,8 @@ TclEmitInvoke(
ExceptionAux *auxBreakPtr, *auxContinuePtr;
int arg1, arg2, wordCount = 0, expandCount = 0;
int loopRange = 0, breakRange = 0, continueRange = 0;
-
+ int cleanup, depth = TclGetStackDepth(envPtr);
+
/*
* Parse the arguments.
*/
@@ -3993,30 +4007,31 @@ TclEmitInvoke(
va_start(argList, opcode);
switch (opcode) {
case INST_INVOKE_STK1:
- wordCount = arg1 = va_arg(argList, int);
+ wordCount = arg1 = cleanup = va_arg(argList, int);
arg2 = 0;
break;
case INST_INVOKE_STK4:
- wordCount = arg1 = va_arg(argList, int);
+ wordCount = arg1 = cleanup = va_arg(argList, int);
arg2 = 0;
break;
case INST_INVOKE_REPLACE:
arg1 = va_arg(argList, int);
arg2 = va_arg(argList, int);
wordCount = arg1 + arg2 - 1;
+ cleanup = arg1 + 1;
break;
default:
Tcl_Panic("unexpected opcode");
case INST_EVAL_STK:
- wordCount = 1;
+ wordCount = cleanup = 1;
arg1 = arg2 = 0;
break;
case INST_RETURN_STK:
- wordCount = 2;
+ wordCount = cleanup = 2;
arg1 = arg2 = 0;
break;
case INST_INVOKE_EXPANDED:
- wordCount = arg1 = va_arg(argList, int);
+ wordCount = arg1 = cleanup = va_arg(argList, int);
arg2 = 0;
expandCount = 1;
break;
@@ -4119,6 +4134,7 @@ TclEmitInvoke(
ExceptionRangeTarget(envPtr, loopRange, breakOffset);
TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+ TclAdjustStackDepth(1, envPtr);
envPtr->currStackDepth = savedStackDepth;
envPtr->expandCount = savedExpandCount;
@@ -4130,6 +4146,7 @@ TclEmitInvoke(
ExceptionRangeTarget(envPtr, loopRange, continueOffset);
TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+ TclAdjustStackDepth(1, envPtr);
envPtr->currStackDepth = savedStackDepth;
envPtr->expandCount = savedExpandCount;
@@ -4138,6 +4155,7 @@ TclEmitInvoke(
TclFinalizeLoopExceptionRange(envPtr, loopRange);
TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
}
+ TclCheckStackDepth(depth+1-cleanup, envPtr);
}
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b2a4b52..6226f7f 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1074,7 +1074,7 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
#endif
-MODULE_SCOPE void TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -1089,8 +1089,6 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *isScalarPtr);
-MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
- char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
@@ -1181,6 +1179,21 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
(envPtr)->currStackDepth += (delta); \
} while (0)
+#define TclGetStackDepth(envPtr) \
+ ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr) \
+ (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr) \
+ do { \
+ int dd = (depth); \
+ if (dd != (envPtr)->currStackDepth) { \
+ Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+ (envPtr)->currStackDepth, dd); \
+ } \
+ } while (0)
+
/*
* Macro used to update the stack requirements. It is called by the macros
* TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
@@ -1321,6 +1334,18 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
} while (0)
/*
+ * If the expr compiler finished with TRY_CONVERT, macro to remove it when the
+ * job is done by the following instruction.
+ */
+
+#define TclClearNumConversion(envPtr) \
+ do { \
+ if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) { \
+ envPtr->codeNext--; \
+ } \
+ } while (0)
+
+/*
* Macros to update a (signed or unsigned) integer starting at a pointer. The
* two variants depend on the number of bytes. The ANSI C "prototypes" for
* these macros are:
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f0e907f..9f7b106 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1006,6 +1006,12 @@ declare 249 {
declare 250 {
void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}
+
+# Allow extensions for optimization
+declare 251 {
+ int TclRegisterLiteral(void *envPtr,
+ char *bytes, int length, int flags)
+}
##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ad17415..1ad32df 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1809,7 +1809,14 @@ typedef struct Interp {
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
- Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */
+ union {
+ void (*optimizer)(void *envPtr);
+ Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
+ * unused space in interp was repurposed for
+ * pluggable bytecode optimizers. The core
+ * contains one optimizer, which can be
+ * selectively overriden by extensions. */
+ } extra;
/*
* Information related to procedures and variables. See tclProc.c and
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 47c6afd..f95f999 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -614,6 +614,9 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
/* 250 */
EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
int force);
+/* 251 */
+EXTERN int TclRegisterLiteral(void *envPtr, char *bytes,
+ int length, int flags);
typedef struct TclIntStubs {
int magic;
@@ -870,6 +873,7 @@ typedef struct TclIntStubs {
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
@@ -1299,6 +1303,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclDoubleDigits) /* 249 */
#define TclSetSlaveCancelFlags \
(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclRegisterLiteral \
+ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 11da6f8..2b0cc7e 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -358,7 +358,7 @@ TclFetchLiteral(
int
TclRegisterLiteral(
- CompileEnv *envPtr, /* Points to the CompileEnv in whose object
+ void *ePtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
register char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
@@ -372,6 +372,7 @@ TclRegisterLiteral(
* the literal should not be shared accross
* namespaces. */
{
+ CompileEnv *envPtr = ePtr;
Interp *iPtr = envPtr->iPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
LiteralEntry *globalPtr, *localPtr;
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 3196b83..827d89d 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -427,7 +427,7 @@ AdvanceJumps(
void
TclOptimizeBytecode(
- CompileEnv *envPtr)
+ void *envPtr)
{
ConvertZeroEffectToNOP(envPtr);
AdvanceJumps(envPtr);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 3f1c27b..e1918ef 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -551,6 +551,7 @@ static const TclIntStubs tclIntStubs = {
TclCopyChannel, /* 248 */
TclDoubleDigits, /* 249 */
TclSetSlaveCancelFlags, /* 250 */
+ TclRegisterLiteral, /* 251 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 03c63ad..a360fd5 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -342,6 +342,9 @@ test coroutine-3.6 {info frame, bug #2910094} -setup {
rename stack {}
rename a {}
} -result {}
+test coroutine-3.7 {bug 0b874c344d} {
+ dict get [coroutine X coroutine Y info frame 0] cmd
+} {coroutine X coroutine Y info frame 0}
test coroutine-4.1 {bug #2093188} -setup {
proc foo {} {
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl
index fe4e7ad..9c8f503 100644
--- a/tools/man2help2.tcl
+++ b/tools/man2help2.tcl
@@ -717,7 +717,7 @@ proc char {name} {
textSetup
puts -nonewline $file "\\'d7 "
}
- {\(em} {
+ {\(em} - {\(en} {
textSetup
puts -nonewline $file "-"
}
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index bdd0079..8fd1245 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -142,6 +142,7 @@ proc process-text {text} {
{\(+-} "&#177;" \
{\(co} "&copy;" \
{\(em} "&#8212;" \
+ {\(en} "&#8211;" \
{\(fm} "&#8242;" \
{\(mu} "&#215;" \
{\(mi} "&#8722;" \
generated by cgit v0.12 at 2024-11-17 01:06:46 (GMT)