Compare commits

...
44 Commits
Author SHA1 Message Date
mig 9c09a80711 merge trunk 2013-05-07 18:08:41 +00:00
mig 2ce3260c4c merge trunk 2013-03-20 14:10:04 +00:00
mig 632fa6ddd5 merge trunk 2013-03-05 23:44:15 +00:00
mig e98abcdeb7 merge trunk 2013-02-28 13:03:52 +00:00
mig 75d40131d0 merge trunk 2013-02-24 12:17:30 +00:00
mig 5e4497097e revert unnecessary invalidate string rep 2013-02-22 13:40:45 +00:00
mig 67aaf516cf merge trunk 2013-02-22 13:25:50 +00:00
mig 6d5cb21c25 clear the string rep of bcSrcPtr if it was generated by a trace 2013-02-22 13:24:46 +00:00
mig 5d0d57699c merge trunk 2013-02-15 14:41:50 +00:00
mig e525c1709d merge trunk 2013-02-10 17:33:15 +00:00
mig d4335e7b53 merge trunk 2013-02-08 11:48:41 +00:00
mig d06ed1965d merge trunk 2013-02-01 09:46:32 +00:00
mig a0bdc30283 back out 418e8da - removal of one trampoline bounce 2013-02-01 09:32:32 +00:00
mig 982242f7df restore memdebug, accidentally broken 2013-01-31 21:41:29 +00:00
mig 624876b318 merge trunk 2013-01-30 20:11:50 +00:00
mig 17ab854a29 merge removal of one trampoline bounce in 'mig-retest' 2013-01-29 09:26:47 +00:00
mig d818399b7b Remove one trampoline bounce in EvalObjv. 2013-01-29 09:24:44 +00:00
mig 8f59b772cc merge trunk 2013-01-28 20:52:50 +00:00
mig 3b47e4270b merge trunk 2013-01-25 18:48:31 +00:00
mig 818ac05aa3 merge trunk 2013-01-25 13:18:03 +00:00
mig f41f07066c fix leak (not present in trunk) 2013-01-23 13:57:56 +00:00
mig 1e7a05e5c8 remove tip348: errorstack 2013-01-21 18:27:03 +00:00
mig db98a285d2 remove stray tip280 remains 2013-01-21 18:20:16 +00:00
mig 96fc002bf9 merge trunk, keep no280 "pure" 2013-01-21 18:17:24 +00:00
mig 07d3ddab92 merge trunk 2013-01-01 16:54:48 +00:00
mig 178985197d missing update in last merge 2013-01-01 15:26:12 +00:00
mig 5b0b0b2ebe merge trunk 2011-09-28 01:39:34 +00:00
mig f18725b93e merge trunk; FIXME: symbols=mem build broken 2011-08-02 11:18:47 +00:00
mig 5cd87d3025 merge trunk onto devel branch 2011-07-06 18:25:02 +00:00
mig a264f75d26 merge trunk 2011-06-13 19:36:28 +00:00
mig 2ce05888c7 merge trunk 2011-06-06 22:36:53 +00:00
mig 4708a19126 merge trunk 2011-05-24 13:46:10 +00:00
mig 905b9e972f merge trunk 2011-05-07 20:39:27 +00:00
mig 97db7170af merge trunk 2011-04-19 14:24:37 +00:00
mig 8f87fdcd28 merge trunk 2011-04-11 11:09:35 +00:00
mig 8b9fac43b6 fix incomplete merge 2011-04-07 03:03:00 +00:00
mig 2fff4b469c merge trunk to feature branch 2011-04-07 02:57:52 +00:00
mig e0c01d21ae why was I undefining MODULE_SCOPE? 2011-04-06 19:05:27 +00:00
mig 8d7ec7c576 merge trunk to feature branch 2011-04-06 18:18:03 +00:00
dkf 12dbf3de12 Merge to feature branch 2011-04-04 14:22:16 +00:00
mig 31a9bc1834 merge trunk to feature branch 2011-03-29 12:57:44 +00:00
mig 39878dbe95 merge trunk to feature branch 2011-03-27 22:49:35 +00:00
mig 9aaa527752 merge trunk to branch 2011-03-27 10:21:12 +00:00
mig 0d02084a65 branch with tip #280 removed, for perf impact measurements 2011-03-24 23:42:09 +00:00
42 changed files with 433 additions and 4908 deletions
+24 -31
View File
@@ -234,6 +234,8 @@ typedef struct AssemblyEnv {
static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*,
BasicBlock*);
static void AdvanceLines(int *line, const char *start,
const char *end);
static BasicBlock * AllocBB(AssemblyEnv*);
static int AssembleOneLine(AssemblyEnv* envPtr);
static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed,
@@ -323,22 +325,6 @@ static const Tcl_ObjType assembleCodeType = {
NULL /* setFromAnyProc */
};
/*
* TIP #280: Remember the per-word line information of the current command. An
* index is used instead of a pointer as recursive compilation may reallocate,
* i.e. move, the array. This is also the reason to save the nuloc now, it may
* change during the course of the function.
*
* Macro to encapsulate the variable definition and setup.
*/
#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)]
/*
* Flags bits used by PushVarName.
@@ -527,6 +513,21 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_INFO_LEVEL_NUM, /* 152 */
INST_RESOLVE_COMMAND /* 154 */
};
static void
AdvanceLines(
int *line,
const char *start,
const char *end)
{
register const char *p;
for (p = start; p < end; p++) {
if (*p == '\n') {
(*line)++;
}
}
}
/*
* Helper macros.
@@ -870,17 +871,14 @@ CompileAssembleObj(
FreeAssembleCodeInternalRep(objPtr);
}
/*
* Set up the compilation environment, and assemble the code.
*/
/* Set up the compilation environment, and assemble the code */
source = TclGetStringFromObj(objPtr, &sourceLen);
TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
TclInitCompileEnv(interp, &compEnv, source, sourceLen);
status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
if (status != TCL_OK) {
/*
* Assembly failed. Clean up and report the error.
*/
/* Assembly failed. Clean up and report the error */
TclFreeCompileEnv(&compEnv);
return NULL;
}
@@ -1045,10 +1043,8 @@ TclAssembleCode(
* Advance the pointers around any leading commentary.
*/
TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
AdvanceLines(&assemEnvPtr->cmdLine, instPtr,
parsePtr->commandStart);
TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
parsePtr->commandStart - envPtr->source);
/*
* Process the line of code.
@@ -1086,10 +1082,8 @@ TclAssembleCode(
nextPtr = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= (nextPtr - instPtr);
instPtr = nextPtr;
TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
AdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
instPtr);
TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
instPtr - envPtr->source);
Tcl_FreeParse(parsePtr);
} while (bytesLeft > 0);
@@ -1130,8 +1124,7 @@ NewAssemblyEnv(
assemEnvPtr->envPtr = envPtr;
assemEnvPtr->parsePtr = parsePtr;
assemEnvPtr->cmdLine = envPtr->line;
assemEnvPtr->clNext = envPtr->clNext;
assemEnvPtr->cmdLine = 1;
/*
* Make the hashtables that store symbol resolution.
+70 -1098
View File
File diff suppressed because it is too large Load Diff
+9 -45
View File
@@ -303,7 +303,6 @@ TclNRCatchObjCmd(
{
Tcl_Obj *varNamePtr = NULL;
Tcl_Obj *optionVarNamePtr = NULL;
Interp *iPtr = (Interp *) interp;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -321,11 +320,7 @@ TclNRCatchObjCmd(
TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
varNamePtr, optionVarNamePtr, NULL);
/*
* TIP #280. Make invoking context available to caught script.
*/
return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
return TclNREvalObjEx(interp, objv[1], 0);
}
static int
@@ -760,9 +755,6 @@ TclNREvalObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Tcl_Obj *objPtr;
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -770,28 +762,18 @@ TclNREvalObjCmd(
}
if (objc == 2) {
/*
* TIP #280. Make argument location available to eval'd script.
*/
invoker = iPtr->cmdFramePtr;
word = 1;
objPtr = objv[1];
TclArgumentGet(interp, objPtr, &invoker, &word);
} else {
/*
* More than one argument: concatenate them together with spaces
* between, then evaluate the result. Tcl_EvalObjEx will delete the
* object when it decrements its refcount after eval'ing it.
*
* TIP #280. Make invoking context available to eval'd script, done
* with the default values.
*/
objPtr = Tcl_ConcatObj(objc-1, objv+1);
}
TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
return TclNREvalObjEx(interp, objPtr, 0);
}
/*
@@ -2408,12 +2390,11 @@ TclNRForObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
ForIterData *iterPtr;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
return TCL_ERROR;
Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
return TCL_ERROR;
}
TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
@@ -2421,15 +2402,9 @@ TclNRForObjCmd(
iterPtr->body = objv[4];
iterPtr->next = objv[3];
iterPtr->msg = "\n (\"for\" body line %d)";
iterPtr->word = 4;
TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
/*
* TIP #280. Make invoking context available to initial script.
*/
return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
return TclNREvalObjEx(interp, objv[1], 0);
}
static int
@@ -2492,7 +2467,6 @@ ForCondCallback(
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
ForIterData *iterPtr = data[0];
Tcl_Obj *boolObj = data[1];
int value;
@@ -2509,7 +2483,6 @@ ForCondCallback(
Tcl_DecrRefCount(boolObj);
if (value) {
/* TIP #280. */
if (iterPtr->next) {
TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
NULL);
@@ -2517,8 +2490,7 @@ ForCondCallback(
TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
NULL, NULL);
}
return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
iterPtr->word);
return TclNREvalObjEx(interp, iterPtr->body, 0);
}
TclSmallFreeEx(interp, iterPtr);
return result;
@@ -2530,19 +2502,13 @@ ForNextCallback(
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
ForIterData *iterPtr = data[0];
Tcl_Obj *next = iterPtr->next;
if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
NULL);
/*
* TIP #280. Make invoking context available to next script.
*/
return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
return TclNREvalObjEx(interp, next, 0);
}
TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
@@ -2736,8 +2702,7 @@ EachloopCmd(
}
TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0,
((Interp *) interp)->cmdFramePtr, objc-1);
return TclNREvalObjEx(interp, objv[objc-1], 0);
}
/*
@@ -2802,8 +2767,7 @@ ForeachLoopStep(
}
TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
return TclNREvalObjEx(interp, statePtr->bodyPtr, 0);
}
/*
+3 -418
View File
@@ -119,12 +119,6 @@ static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
/* TIP #348 - New 'info' subcommand 'errorstack' */
static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
/* TIP #280 - New 'info' subcommand 'frame' */
static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
@@ -168,9 +162,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
{"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0},
{"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, 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},
@@ -254,7 +246,6 @@ IfConditionCallback(
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
int objc = PTR2INT(data[0]);
Tcl_Obj *const *objv = data[1];
int i = PTR2INT(data[2]);
@@ -297,12 +288,7 @@ IfConditionCallback(
i++;
if (i >= objc) {
if (thenScriptIndex) {
/*
* TIP #280. Make invoking context available to branch.
*/
return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
iPtr->cmdFramePtr, thenScriptIndex);
return TclNREvalObjEx(interp, objv[thenScriptIndex], 0);
}
return TCL_OK;
}
@@ -354,14 +340,9 @@ IfConditionCallback(
return TCL_ERROR;
}
if (thenScriptIndex) {
/*
* TIP #280. Make invoking context available to branch/else.
*/
return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
iPtr->cmdFramePtr, thenScriptIndex);
return TclNREvalObjEx(interp, objv[thenScriptIndex], 0);
}
return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
return TclNREvalObjEx(interp, objv[i], 0);
missingScript:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1025,55 +1006,6 @@ InfoDefaultCmd(
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* InfoErrorStackCmd --
*
* Called to implement the "info errorstack" command that returns information
* about the last error's call stack. Handles the following syntax:
*
* info errorstack ?interp?
*
* Results:
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is an
* error, the result is an error message.
*
*----------------------------------------------------------------------
*/
static int
InfoErrorStackCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
Interp *iPtr;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
return TCL_ERROR;
}
target = interp;
if (objc == 2) {
target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
if (target == NULL) {
return TCL_ERROR;
}
}
iPtr = (Interp *) target;
Tcl_SetObjResult(interp, iPtr->errorStack);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -1117,353 +1049,6 @@ TclInfoExistsCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* InfoFrameCmd --
* TIP #280
*
* Called to implement the "info frame" command that returns the location
* of either the currently executing command, or its caller. Handles the
* following syntax:
*
* info frame ?number?
*
* Results:
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is an
* error, the result is an error message.
*
*----------------------------------------------------------------------
*/
static int
InfoFrameCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
int level, topLevel, code = TCL_OK;
CmdFrame *runPtr, *framePtr;
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
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;
/* TODO - deal with overflow */
topLevel += corPtr->caller.cmdFramePtr->level;
while (runPtr) {
runPtr->level += corPtr->caller.cmdFramePtr->level;
lastPtr = runPtr;
runPtr = runPtr->nextPtr;
}
if (lastPtr) {
lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
} else {
iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
}
}
if (objc == 1) {
/*
* Just "info frame".
*/
Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
goto done;
}
/*
* We've got "info frame level" and must parse the level first.
*/
if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
code = TCL_ERROR;
goto done;
}
if ((level > topLevel) || (level <= - topLevel)) {
levelError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
TclGetString(objv[1]), NULL);
code = TCL_ERROR;
goto done;
}
/*
* Let us convert to relative so that we know how many levels to go back
*/
if (level > 0) {
level -= topLevel;
}
framePtr = iPtr->cmdFramePtr;
while (++level <= 0) {
framePtr = framePtr->nextPtr;
if (!framePtr) {
goto levelError;
}
}
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
done:
if (corPtr) {
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;
}
runPtr->level = 1;
runPtr->nextPtr = NULL;
}
}
return code;
}
/*
*----------------------------------------------------------------------
*
* TclInfoFrame --
*
* Core of InfoFrameCmd, returns TIP280 dict for a given frame.
*
* Results:
* Returns TIP280 dict.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclInfoFrame(
Tcl_Interp *interp, /* Current interpreter. */
CmdFrame *framePtr) /* Frame to get info for. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *tmpObj;
Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
* the dict. */
int lc = 0;
/*
* This array is indexed by the TCL_LOCATION_... values, except
* for _LAST.
*/
static const char *const typeString[TCL_LOCATION_LAST] = {
"eval", "eval", "eval", "precompiled", "source", "proc"
};
Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
/*
* Pull the information and construct the dictionary to return, as list.
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
*/
#define ADD_PAIR(name, value) \
TclNewLiteralStringObj(tmpObj, name); \
lv[lc++] = tmpObj; \
lv[lc++] = (value)
switch (framePtr->type) {
case TCL_LOCATION_EVAL:
/*
* Evaluation, dynamic script. Type, line, cmd, the latter through
* str.
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
framePtr->cmd.str.len));
break;
case TCL_LOCATION_EVAL_LIST:
/*
* List optimized evaluation. Type, line, cmd, the latter through
* listPtr, possibly a frame.
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
ADD_PAIR("line", Tcl_NewIntObj(1));
/*
* We put a duplicate of the command list obj into the result to
* ensure that the 'pure List'-property of the command itself is not
* destroyed. Otherwise the query here would disable the list
* optimization path in Tcl_EvalObjEx.
*/
ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
break;
case TCL_LOCATION_PREBC:
/*
* Precompiled. Result contains the type as signal, nothing else.
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
break;
case TCL_LOCATION_BC: {
/*
* Execution of bytecode. Talk to the BC engine to fill out the frame.
*/
CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*fPtr = *framePtr;
/*
* Note:
* Type BC => f.data.eval.path is not used.
* f.data.tebc.codePtr is used instead.
*/
TclGetSrcInfoForPc(fPtr);
/*
* Now filled: cmd.str.(cmd,len), line
* Possibly modified: type, path!
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
if (fPtr->line) {
ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
}
if (fPtr->type == TCL_LOCATION_SOURCE) {
ADD_PAIR("file", fPtr->data.eval.path);
/*
* Death of reference by TclGetSrcInfoForPc.
*/
Tcl_DecrRefCount(fPtr->data.eval.path);
}
ADD_PAIR("cmd",
Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
TclStackFree(interp, fPtr);
break;
}
case TCL_LOCATION_SOURCE:
/*
* Evaluation of a script file.
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
ADD_PAIR("file", framePtr->data.eval.path);
/*
* Refcount framePtr->data.eval.path goes up when lv is converted into
* the result list object.
*/
ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
framePtr->cmd.str.len));
break;
case TCL_LOCATION_PROC:
Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
break;
}
/*
* 'proc'. Common to all frame types. Conditional on having an associated
* Procedure CallFrame.
*/
if (procPtr != NULL) {
Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
if (namePtr) {
Tcl_Obj *procNameObj;
/*
* This is a regular command.
*/
TclNewObj(procNameObj);
Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
procNameObj);
ADD_PAIR("proc", procNameObj);
} else if (procPtr->cmdPtr->clientData) {
ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
int i;
/*
* This is a non-standard command. Luckily, it's told us how to
* render extra information about its frame.
*/
for (i=0 ; i<efiPtr->length ; i++) {
lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
if (efiPtr->fields[i].proc) {
lv[lc++] =
efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
} else {
lv[lc++] = efiPtr->fields[i].clientData;
}
}
}
}
/*
* 'level'. Common to all frame types. Conditional on having an associated
* _visible_ CallFrame.
*/
if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
CallFrame *current = framePtr->framePtr;
CallFrame *top = iPtr->varFramePtr;
CallFrame *idx;
for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
if (idx == current) {
int c = framePtr->framePtr->level;
int t = iPtr->varFramePtr->level;
ADD_PAIR("level", Tcl_NewIntObj(t - c));
break;
}
}
}
return Tcl_NewListObj(lc, lv);
}
/*
*----------------------------------------------------------------------
*
+7 -158
View File
@@ -3481,12 +3481,6 @@ TclNRSwitchObjCmd(
Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
Tcl_Obj *const *savedObjv = objv;
Tcl_RegExp regExpr = NULL;
Interp *iPtr = (Interp *) interp;
int pc = 0;
int bidx = 0; /* Index of body argument. */
Tcl_Obj *blist = NULL; /* List obj which is the body */
CmdFrame *ctxPtr; /* Copy of the topmost cmdframe, to allow us
* to mess with the line information */
/*
* If you add options that make -e and -g not unique prefixes of -exact or
@@ -3610,22 +3604,16 @@ TclNRSwitchObjCmd(
stringObj = objv[i];
objc -= i + 1;
objv += i + 1;
bidx = i + 1; /* First after the match string. */
/*
* If all of the pattern/command pairs are lumped into a single argument,
* split them out again.
*
* TIP #280: Determine the lines the words in the list start at, based on
* the same data for the list word itself. The cmdFramePtr line
* information is manipulated directly.
*/
splitObjs = 0;
if (objc == 1) {
Tcl_Obj **listv;
blist = objv[0];
if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
return TCL_ERROR;
}
@@ -3853,58 +3841,6 @@ TclNRSwitchObjCmd(
*/
matchFound:
ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*ctxPtr = *iPtr->cmdFramePtr;
if (splitObjs) {
/*
* We have to perform the GetSrc and other type dependent handling of
* the frame here because we are munging with the line numbers,
* something the other commands like if, etc. are not doing. Them are
* fine with simply passing the CmdFrame through and having the
* special handling done in 'info frame', or the bc compiler
*/
if (ctxPtr->type == TCL_LOCATION_BC) {
/*
* Type BC => ctxPtr->data.eval.path is not used.
* ctxPtr->data.tebc.codePtr is used instead.
*/
TclGetSrcInfoForPc(ctxPtr);
pc = 1;
/*
* The line information in the cmdFrame is now a copy we do not
* own.
*/
}
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
int bline = ctxPtr->line[bidx];
ctxPtr->line = ckalloc(objc * sizeof(int));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
/*
* This is either a dynamic code word, when all elements are
* relative to themselves, or something else less expected and
* where we have no information. The result is the same in both
* cases; tell the code to come that it doesn't know where it is,
* which triggers reversion to the old behavior.
*/
int k;
ctxPtr->line = ckalloc(objc * sizeof(int));
ctxPtr->nline = objc;
for (k=0; k < objc; k++) {
ctxPtr->line[k] = -1;
}
}
}
for (j = i + 1; ; j += 2) {
if (j >= objc) {
/*
@@ -3919,13 +3855,8 @@ TclNRSwitchObjCmd(
}
}
/*
* TIP #280: Make invoking context available to switch branch.
*/
Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
INT2PTR(pc), (ClientData) pattern);
return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
Tcl_NRAddCallback(interp, SwitchPostProc, (ClientData) pattern, NULL, NULL, NULL);
return TclNREvalObjEx(interp, objv[j], 0);
}
static int
@@ -3936,27 +3867,9 @@ SwitchPostProc(
{
/* Unpack the preserved data */
int splitObjs = PTR2INT(data[0]);
CmdFrame *ctxPtr = data[1];
int pc = PTR2INT(data[2]);
const char *pattern = data[3];
const char *pattern = data[0];
int patternLength = strlen(pattern);
/*
* Clean up TIP 280 context information
*/
if (splitObjs) {
ckfree(ctxPtr->line);
if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
/*
* Death of SrcInfo reference.
*/
Tcl_DecrRefCount(ctxPtr->data.eval.path);
}
}
/*
* Generate an error message if necessary.
*/
@@ -3970,7 +3883,6 @@ SwitchPostProc(
(overflow ? limit : patternLength), pattern,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
TclStackFree(interp, ctxPtr);
return result;
}
@@ -4299,8 +4211,7 @@ TclNRTryObjCmd(
Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
(ClientData)objv, INT2PTR(objc));
return TclNREvalObjEx(interp, bodyObj, 0,
((Interp *) interp)->cmdFramePtr, 1);
return TclNREvalObjEx(interp, bodyObj, 0);
}
/*
@@ -4515,8 +4426,7 @@ TryPostBody(
Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0],
INT2PTR((finallyObj == NULL) ? 0 : objc - 1));
Tcl_DecrRefCount(handlersObj);
return TclNREvalObjEx(interp, handlerBodyObj, 0,
((Interp *) interp)->cmdFramePtr, 4*i + 5);
return TclNREvalObjEx(interp, handlerBodyObj, 0);
handlerFailed:
resultObj = Tcl_GetObjResult(interp);
@@ -4542,8 +4452,7 @@ TryPostBody(
if (finallyObj != NULL) {
Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
NULL);
return TclNREvalObjEx(interp, finallyObj, 0,
((Interp *) interp)->cmdFramePtr, objc - 1);
return TclNREvalObjEx(interp, finallyObj, 0);
}
/*
@@ -4622,14 +4531,11 @@ TryPostHandler(
*/
if (finallyObj != NULL) {
Interp *iPtr = (Interp *) interp;
Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
NULL);
/* The 'finally' script is always the last argument word. */
return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
finally);
return TclNREvalObjEx(interp, finallyObj, 0);
}
/*
@@ -4755,69 +4661,12 @@ TclNRWhileObjCmd(
iterPtr->body = objv[2];
iterPtr->next = NULL;
iterPtr->msg = "\n (\"while\" body line %d)";
iterPtr->word = 2;
TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclListLines --
*
* ???
*
* Results:
* Filled in array of line numbers?
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclListLines(
Tcl_Obj *listObj, /* Pointer to obj holding a string with list
* structure. Assumed to be valid. Assumed to
* contain n elements. */
int line, /* Line the list as a whole starts on. */
int n, /* #elements in lines */
int *lines, /* Array of line numbers, to fill. */
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
* derived continuation data */
{
const char *listStr = Tcl_GetString(listObj);
const char *listHead = listStr;
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
TclAdvanceLines(&line, listStr, element);
/* Leading whitespace */
TclAdvanceContinuations(&line, &clNext, element - listHead);
if (elems && clNext) {
TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
}
lines[i] = line;
length -= (next - listStr);
TclAdvanceLines(&line, element, next);
/* Element */
listStr = next;
if (*element == 0) {
/* ASSERT i == n */
break;
}
}
}
/*
* Local Variables:
* mode: c
+84 -190
View File
File diff suppressed because it is too large Load Diff
+19 -150
View File
@@ -30,8 +30,7 @@ static void PrintJumptableInfo(ClientData clientData,
static int PushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *simpleVarNamePtr, int *isScalarPtr,
int line, int *clNext);
int *simpleVarNamePtr, int *isScalarPtr);
static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, const char *identity,
int instruction, CompileEnv *envPtr);
@@ -45,17 +44,13 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, int instruction,
CompileEnv *envPtr);
static void IssueSwitchChainedTests(Tcl_Interp *interp,
CompileEnv *envPtr, ExtCmdLoc *mapPtr,
int eclIndex, int mode, int noCase,
CompileEnv *envPtr, int mode, int noCase,
int valueIndex, Tcl_Token *valueTokenPtr,
int numWords, Tcl_Token **bodyToken,
int *bodyLines, int **bodyNext);
int numWords, Tcl_Token **bodyToken);
static void IssueSwitchJumpTable(Tcl_Interp *interp,
CompileEnv *envPtr, ExtCmdLoc *mapPtr,
int eclIndex, int valueIndex,
CompileEnv *envPtr, int valueIndex,
Tcl_Token *valueTokenPtr, int numWords,
Tcl_Token **bodyToken, int *bodyLines,
int **bodyContLines);
Tcl_Token **bodyToken);
static int IssueTryFinallyInstructions(Tcl_Interp *interp,
CompileEnv *envPtr, Tcl_Token *bodyToken,
int numHandlers, int *matchCodes,
@@ -81,34 +76,10 @@ static int IssueTryInstructions(Tcl_Interp *interp,
TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
(tokenPtr)[1].size), (envPtr)); \
} else { \
envPtr->line = mapPtr->loc[eclIndex].line[word]; \
envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
(envPtr)); \
}
/*
* TIP #280: Remember the per-word line information of the current command. An
* index is used instead of a pointer as recursive compilation may reallocate,
* i.e. move, the array. This is also the reason to save the nuloc now, it may
* change during the course of the function.
*
* Macro to encapsulate the variable definition and setup.
*/
#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)]
#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
PushVarName(i,v,e,f,l,s,sc, \
mapPtr->loc[eclIndex].line[(word)], \
mapPtr->loc[eclIndex].next[(word)])
/*
* Flags bits used by PushVarName.
*/
@@ -138,7 +109,7 @@ const AuxDataType tclJumptableInfoType = {
#define OP44(name,val1,val2) \
TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define BODY(token,index) \
SetLineInformation((index));CompileBody(envPtr,(token),interp)
CompileBody(envPtr,(token),interp)
#define PUSH(str) \
PushLiteral(envPtr,(str),strlen(str))
#define JUMP(var,name) \
@@ -179,7 +150,6 @@ TclCompileSetCmd(
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
@@ -196,8 +166,8 @@ TclCompileSetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar, 1);
PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar);
/*
* If we are doing an assignment, push the new value.
@@ -276,7 +246,6 @@ TclCompileStringCmpCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/*
@@ -308,7 +277,6 @@ TclCompileStringEqualCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/*
@@ -340,7 +308,6 @@ TclCompileStringFirstCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/*
@@ -372,7 +339,6 @@ TclCompileStringLastCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/*
@@ -404,7 +370,6 @@ TclCompileStringIndexCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
if (parsePtr->numWords != 3) {
@@ -432,7 +397,6 @@ TclCompileStringMatchCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i, length, exactMatch = 0, nocase = 0;
const char *str;
@@ -486,7 +450,6 @@ TclCompileStringMatchCmd(
}
PushLiteral(envPtr, str, length);
} else {
SetLineInformation(i+1+nocase);
CompileTokens(envPtr, tokenPtr, interp);
}
tokenPtr = TokenAfter(tokenPtr);
@@ -513,7 +476,6 @@ TclCompileStringLenCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
Tcl_Obj *objPtr;
@@ -536,7 +498,6 @@ TclCompileStringLenCmd(
len = sprintf(buf, "%d", len);
PushLiteral(envPtr, buf, len);
} else {
SetLineInformation(1);
CompileTokens(envPtr, tokenPtr, interp);
TclEmitOpcode(INST_STR_LEN, envPtr);
}
@@ -553,7 +514,6 @@ TclCompileStringMapCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *mapTokenPtr, *stringTokenPtr;
Tcl_Obj *mapObj, **objv;
char *bytes;
@@ -616,7 +576,6 @@ TclCompileStringRangeCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
Tcl_Obj *tmpObj;
int idx1, idx2, result;
@@ -731,7 +690,6 @@ TclCompileSubstCmd(
Tcl_Obj **objv/*, *toSubst = NULL*/;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
int code = TCL_ERROR;
DefineLineInformation; /* TIP #280 */
if (numArgs == 0) {
return TCL_ERROR;
@@ -775,9 +733,8 @@ TclCompileSubstCmd(
return TCL_ERROR;
}
SetLineInformation(numArgs);
TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
flags, envPtr);
/* TclDecrRefCount(toSubst);*/
return TCL_OK;
@@ -789,11 +746,10 @@ TclSubstCompile(
const char *bytes,
int numBytes,
int flags,
int line,
CompileEnv *envPtr)
{
Tcl_Token *endTokenPtr, *tokenPtr;
int breakOffset = 0, count = 0, bline = line;
int breakOffset = 0, count = 0;
Tcl_Parse parse;
Tcl_InterpState state = NULL;
@@ -825,8 +781,6 @@ TclSubstCompile(
literal = TclRegisterNewLiteral(envPtr,
tokenPtr->start, tokenPtr->size);
TclEmitPush(literal, envPtr);
TclAdvanceLines(&bline, tokenPtr->start,
tokenPtr->start + tokenPtr->size);
count++;
continue;
case TCL_TOKEN_BS:
@@ -859,9 +813,7 @@ TclSubstCompile(
}
}
envPtr->line = bline;
TclCompileVarSubst(interp, tokenPtr, envPtr);
bline = envPtr->line;
count++;
continue;
}
@@ -890,7 +842,6 @@ TclSubstCompile(
}
}
envPtr->line = bline;
catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
OP4( BEGIN_CATCH4, catchRange);
ExceptionRangeStarts(envPtr, catchRange);
@@ -1007,7 +958,6 @@ TclSubstCompile(
Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
(int) (CurrentOffset(envPtr) - endFixup.codeOffset));
}
bline = envPtr->line;
}
while (count > 255) {
@@ -1074,15 +1024,10 @@ TclCompileSwitchCmd(
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
* items. */
int **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
DefineLineInformation; /* TIP #280 */
int *clNext = envPtr->clNext;
/*
* Only handle the following versions:
@@ -1221,10 +1166,6 @@ TclCompileSwitchCmd(
if (numWords == 1) {
const char *bytes;
int maxLen, numBytes;
int bline; /* TIP #280: line of the pattern/action list,
* and start of list for when tracking the
* location. This list comes immediately after
* the value we switch on. */
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
@@ -1239,10 +1180,7 @@ TclCompileSwitchCmd(
}
bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen);
bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
bodyLines = ckalloc(sizeof(int) * maxLen);
bodyContLines = ckalloc(sizeof(int*) * maxLen);
bline = mapPtr->loc[eclIndex].line[valueIndex+1];
numWords = 0;
while (numBytes > 0) {
@@ -1259,20 +1197,6 @@ TclCompileSwitchCmd(
bodyTokenArray[numWords].numComponents = 0;
bodyToken[numWords] = bodyTokenArray + numWords;
/*
* TIP #280: Now determine the line the list element starts on
* (there is no need to do it earlier, due to the possibility of
* aborting, see above).
*/
TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
TclAdvanceContinuations(&bline, &clNext,
bodyTokenArray[numWords].start - envPtr->source);
bodyLines[numWords] = bline;
bodyContLines[numWords] = clNext;
TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);
numBytes -= (bytes - prevBytes);
numWords++;
}
@@ -1280,8 +1204,6 @@ TclCompileSwitchCmd(
abort:
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
ckfree((char *) bodyContLines);
return TCL_ERROR;
}
} else if (numWords % 2 || numWords == 0) {
@@ -1300,8 +1222,6 @@ TclCompileSwitchCmd(
*/
bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords);
bodyLines = ckalloc(sizeof(int) * numWords);
bodyContLines = ckalloc(sizeof(int*) * numWords);
bodyTokenArray = NULL;
for (i=0 ; i<numWords ; i++) {
/*
@@ -1315,12 +1235,6 @@ TclCompileSwitchCmd(
}
bodyToken[i] = tokenPtr+1;
/*
* TIP #280: Copy line information from regular cmd info.
*/
bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
tokenPtr = TokenAfter(tokenPtr);
}
}
@@ -1344,12 +1258,11 @@ TclCompileSwitchCmd(
*/
if (mode == Switch_Exact) {
IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
IssueSwitchJumpTable(interp, envPtr, valueIndex,
valueTokenPtr, numWords, bodyToken);
} else {
IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase,
valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines,
bodyContLines);
IssueSwitchChainedTests(interp, envPtr, mode,noCase,
valueIndex, valueTokenPtr, numWords, bodyToken);
}
result = TCL_OK;
@@ -1359,8 +1272,6 @@ TclCompileSwitchCmd(
freeTemporaries:
ckfree(bodyToken);
ckfree(bodyLines);
ckfree(bodyContLines);
if (bodyTokenArray != NULL) {
ckfree(bodyTokenArray);
}
@@ -1387,9 +1298,6 @@ static void
IssueSwitchChainedTests(
Tcl_Interp *interp, /* Context for compiling script bodies. */
CompileEnv *envPtr, /* Holds resulting instructions. */
ExtCmdLoc *mapPtr, /* For mapping tokens to their source code
* location. */
int eclIndex,
int mode, /* Exact, Glob or Regexp */
int noCase, /* Case-insensitivity flag. */
int valueIndex, /* The value to match against. */
@@ -1397,10 +1305,7 @@ IssueSwitchChainedTests(
int numBodyTokens, /* Number of tokens describing things the
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
int *bodyLines, /* Array of line numbers for body list
* items. */
int **bodyContLines) /* Array of continuation line info. */
Tcl_Token **bodyToken) /* Array of pointers to pattern list items. */
{
enum {Switch_Exact, Switch_Glob, Switch_Regexp};
int savedStackDepth = envPtr->currStackDepth;
@@ -1422,7 +1327,6 @@ IssueSwitchChainedTests(
* First, we push the value we're matching against on the stack.
*/
SetLineInformation(valueIndex);
CompileTokens(envPtr, valueTokenPtr, interp);
/*
@@ -1576,8 +1480,6 @@ IssueSwitchChainedTests(
OP( POP);
envPtr->currStackDepth = savedStackDepth + 1;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
if (!foundDefault) {
@@ -1654,18 +1556,12 @@ static void
IssueSwitchJumpTable(
Tcl_Interp *interp, /* Context for compiling script bodies. */
CompileEnv *envPtr, /* Holds resulting instructions. */
ExtCmdLoc *mapPtr, /* For mapping tokens to their source code
* location. */
int eclIndex,
int valueIndex, /* The value to match against. */
Tcl_Token *valueTokenPtr,
int numBodyTokens, /* Number of tokens describing things the
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
int *bodyLines, /* Array of line numbers for body list
* items. */
int **bodyContLines) /* Array of continuation line info. */
Tcl_Token **bodyToken) /* Array of pointers to pattern list items. */
{
JumptableInfo *jtPtr;
int savedStackDepth = envPtr->currStackDepth;
@@ -1678,7 +1574,6 @@ IssueSwitchJumpTable(
* First, we push the value we're matching against on the stack.
*/
SetLineInformation(valueIndex);
CompileTokens(envPtr, valueTokenPtr, interp);
/*
@@ -1782,8 +1677,6 @@ IssueSwitchJumpTable(
*/
envPtr->currStackDepth = savedStackDepth;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
/*
@@ -1944,7 +1837,6 @@ TclCompileTailcallCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int i;
@@ -1990,7 +1882,6 @@ TclCompileThrowCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int numWords = parsePtr->numWords;
int savedStackDepth = envPtr->currStackDepth;
Tcl_Token *codeToken, *msgToken;
@@ -2123,8 +2014,6 @@ TclCompileTryCmd(
* No handlers or finally; do nothing beyond evaluating the body.
*/
DefineLineInformation; /* TIP #280 */
SetLineInformation(1);
CompileBody(envPtr, bodyToken, interp);
return TCL_OK;
}
@@ -2339,7 +2228,6 @@ IssueTryInstructions(
int *optionVars,
Tcl_Token **handlerTokens)
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar;
int savedStackDepth = envPtr->currStackDepth;
int i, j, len, forwardsNeedFixing = 0;
@@ -2493,7 +2381,6 @@ IssueTryFinallyInstructions(
Tcl_Token **handlerTokens,
Tcl_Token *finallyToken) /* Not NULL */
{
DefineLineInformation; /* TIP #280 */
int savedStackDepth = envPtr->currStackDepth;
int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
@@ -2733,7 +2620,6 @@ TclCompileUnsetCmd(
Tcl_Token *varTokenPtr;
int isScalar, simpleVarName, localIndex, numWords, flags, i;
Tcl_Obj *leadingWord;
DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords-1;
flags = 1;
@@ -2771,8 +2657,8 @@ TclCompileUnsetCmd(
* namespace qualifiers.
*/
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar, 1);
PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar);
/*
* Emit instructions to unset the variable.
@@ -2834,7 +2720,6 @@ TclCompileWhileCmd(
int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
* infinite loop. */
Tcl_Obj *boolObj;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 3) {
return TCL_ERROR;
@@ -2922,7 +2807,6 @@ TclCompileWhileCmd(
* Compile the loop body.
*/
SetLineInformation(2);
bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
@@ -2942,7 +2826,6 @@ TclCompileWhileCmd(
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
SetLineInformation(1);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -3013,7 +2896,6 @@ TclCompileYieldCmd(
if (parsePtr->numWords == 1) {
PushLiteral(envPtr, "", 0);
} else {
DefineLineInformation; /* TIP #280 */
Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, valueTokenPtr, interp, 1);
@@ -3049,10 +2931,7 @@ PushVarName(
int flags, /* TCL_NO_LARGE_INDEX. */
int *localIndexPtr, /* Must not be NULL. */
int *simpleVarNamePtr, /* Must not be NULL. */
int *isScalarPtr, /* Must not be NULL. */
int line, /* Line the token starts on. */
int *clNext) /* Reference to offset of next hidden cont.
* line. */
int *isScalarPtr) /* Must not be NULL. */
{
register const char *p;
const char *name, *elName;
@@ -3232,8 +3111,6 @@ PushVarName(
if (elName != NULL) {
if (elNameChars) {
envPtr->line = line;
envPtr->clNext = clNext;
TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
envPtr);
} else {
@@ -3245,8 +3122,6 @@ PushVarName(
* The var name isn't simple: compile and push it.
*/
envPtr->line = line;
envPtr->clNext = clNext;
CompileTokens(envPtr, varTokenPtr, interp);
}
@@ -3288,7 +3163,6 @@ CompileUnaryOpCmd(
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -3330,7 +3204,6 @@ CompileAssociativeBinaryOpCmd(
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
int words;
for (words=1 ; words<parsePtr->numWords ; words++) {
@@ -3414,7 +3287,6 @@ CompileComparisonOpCmd(
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords < 3) {
PushLiteral(envPtr, "1", 1);
@@ -3580,7 +3452,6 @@ TclCompilePowOpCmd(
*/
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
int words;
for (words=1 ; words<parsePtr->numWords ; words++) {
@@ -3750,7 +3621,6 @@ TclCompileMinusOpCmd(
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
int words;
if (parsePtr->numWords == 1) {
@@ -3795,7 +3665,6 @@ TclCompileDivOpCmd(
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
DefineLineInformation; /* TIP #280 */
int words;
if (parsePtr->numWords == 1) {
+1 -5
View File
@@ -2142,10 +2142,6 @@ TclCompileExpr(
Tcl_Obj *const *litObjv;
Tcl_Obj **funcObjv;
/* TIP #280 : Track Lines within the expression */
TclAdvanceLines(&envPtr->line, script,
script + TclParseAllWhiteSpace(script, numBytes));
TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
@@ -2199,7 +2195,7 @@ ExecConstantExprTree(
*/
envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
TclInitCompileEnv(interp, envPtr, NULL, 0);
CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
0 /* optimize */);
TclEmitOpcode(INST_DONE, envPtr);
+7 -719
View File
@@ -564,17 +564,6 @@ static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
static void PrintSourceToObj(Tcl_Obj *appendObj,
const char *stringPtr, int maxChars);
static void UpdateStringOfInstName(Tcl_Obj *objPtr);
/*
* TIP #280: Helper for building the per-word line information of all compiled
* commands.
*/
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
@@ -602,18 +591,6 @@ static const Tcl_ObjType substCodeType = {
NULL, /* setFromAnyProc */
};
/*
* The structure below defines an instruction name Tcl object to allow
* reporting of inner contexts in errorstack without string allocation.
*/
static const Tcl_ObjType tclInstNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
/*
*----------------------------------------------------------------------
@@ -649,12 +626,10 @@ TclSetByteCodeFromAny(
CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
ClientData clientData) /* Hook procedure private data. */
{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
int length, result = TCL_OK;
const char *stringPtr;
ContLineLoc *clLocPtr;
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
@@ -668,14 +643,7 @@ TclSetByteCodeFromAny(
stringPtr = TclGetStringFromObj(objPtr, &length);
/*
* TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
* use to initialize the tracking in the compiler. This information was
* stored by TclCompEvalObj and ProcCompileProc.
*/
TclInitCompileEnv(interp, &compEnv, stringPtr, length,
iPtr->invokeCmdFramePtr, iPtr->invokeWord);
TclInitCompileEnv(interp, &compEnv, stringPtr, length);
/*
* Now we check if we have data about invisible continuation lines for the
@@ -689,13 +657,6 @@ TclSetByteCodeFromAny(
* "tclObj.c".
*/
clLocPtr = TclContinuationsGet(objPtr);
if (clLocPtr) {
compEnv.clLoc = clLocPtr;
compEnv.clNext = &compEnv.clLoc->loc[0];
Tcl_Preserve(compEnv.clLoc);
}
TclCompileScript(interp, stringPtr, length, &compEnv);
/*
@@ -854,7 +815,6 @@ TclCleanupByteCode(
register ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
Interp *iPtr = (Interp *) interp;
int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
register Tcl_Obj **objArrayPtr, *objPtr;
@@ -867,7 +827,7 @@ TclCleanupByteCode(
Tcl_Time destroyTime;
int lifetimeSec, lifetimeMicroSec, log2;
statsPtr = &iPtr->stats;
statsPtr = &((Interp *)interp)->stats;
statsPtr->numByteCodesFreed++;
statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
@@ -946,24 +906,6 @@ TclCleanupByteCode(
auxDataPtr++;
}
/*
* TIP #280. Release the location data associated with this byte code
* structure, if any. NOTE: The interp we belong to may be gone already,
* and the data with it.
*
* See also tclBasic.c, DeleteInterpProc
*/
if (iPtr) {
Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
(char *) codePtr);
if (hePtr) {
ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
Tcl_DeleteHashEntry(hePtr);
}
}
if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
TclFreeLocalCache(interp, codePtr->localCachePtr);
}
@@ -1086,10 +1028,9 @@ CompileSubstObj(
int numBytes;
const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
/* TODO: Check for more TIP 280 */
TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);
TclInitCompileEnv(interp, &compEnv, bytes, numBytes);
TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
TclSubstCompile(interp, bytes, numBytes, flags, &compEnv);
TclEmitOpcode(INST_DONE, &compEnv);
TclInitByteCodeObj(objPtr, &compEnv);
@@ -1141,27 +1082,6 @@ FreeSubstCodeInternalRep(
}
}
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);
}
/*
*----------------------------------------------------------------------
@@ -1187,10 +1107,7 @@ TclInitCompileEnv(
register CompileEnv *envPtr,/* Points to the CompileEnv structure to
* initialize. */
const char *stringPtr, /* The source string to be compiled. */
int numBytes, /* Number of bytes in source string. */
const CmdFrame *invoker, /* Location context invoking the bcc */
int word) /* Index of the word in that context getting
* compiled */
int numBytes) /* Number of bytes in source string. */
{
Interp *iPtr = (Interp *) interp;
@@ -1226,138 +1143,6 @@ TclInitCompileEnv(
envPtr->mallocedCmdMap = 0;
envPtr->atCmdStart = 1;
/*
* TIP #280: Set up the extended command location information, based on
* the context invoking the byte code compiler. This structure is used to
* keep the per-word line information for all compiled commands.
*
* See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
* non-compiling evaluator
*/
envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
envPtr->extCmdMapPtr->loc = NULL;
envPtr->extCmdMapPtr->nloc = 0;
envPtr->extCmdMapPtr->nuloc = 0;
envPtr->extCmdMapPtr->path = NULL;
Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS);
if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) {
/*
* Initialize the compiler for relative counting in case of a
* dynamic context.
*/
envPtr->line = 1;
if (iPtr->evalFlags & TCL_EVAL_FILE) {
iPtr->evalFlags &= ~TCL_EVAL_FILE;
envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE;
if (iPtr->scriptFile) {
/*
* Normalization here, to have the correct pwd. Should have
* negligible impact on performance, as the norm should have
* been done already by the 'source' invoking us, and it
* caches the result.
*/
Tcl_Obj *norm =
Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
if (norm == NULL) {
/*
* Error message in the interp result. No place to put it.
* And no place to serve the error itself to either. Fake
* a path, empty string.
*/
TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
} else {
envPtr->extCmdMapPtr->path = norm;
}
} else {
TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
}
Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
} else {
envPtr->extCmdMapPtr->type =
(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
}
} else {
/*
* Initialize the compiler using the context, making counting absolute
* to that context. Note that the context can be byte code execution.
* In that case we have to fill out the missing pieces (line, path,
* ...) which may make change the type as well.
*/
CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
int pc = 0;
*ctxPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
/*
* Note: Type BC => ctx.data.eval.path is not used.
* ctx.data.tebc.codePtr is used instead.
*/
TclGetSrcInfoForPc(ctxPtr);
pc = 1;
}
if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
/*
* Word is not a literal, relative counting.
*/
envPtr->line = 1;
envPtr->extCmdMapPtr->type =
(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
/*
* The reference made by 'TclGetSrcInfoForPc' is dead.
*/
Tcl_DecrRefCount(ctxPtr->data.eval.path);
}
} else {
envPtr->line = ctxPtr->line[word];
envPtr->extCmdMapPtr->type = ctxPtr->type;
if (ctxPtr->type == TCL_LOCATION_SOURCE) {
envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path;
if (pc) {
/*
* The reference 'TclGetSrcInfoForPc' made is transfered.
*/
ctxPtr->data.eval.path = NULL;
} else {
/*
* We have a new reference here.
*/
Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
}
}
}
TclStackFree(interp, ctxPtr);
}
envPtr->extCmdMapPtr->start = envPtr->line;
/*
* Initialize the data about invisible continuation lines as empty, i.e.
* not used. The caller (TclSetByteCodeFromAny) will set this up, if such
* data is available.
*/
envPtr->clLoc = NULL;
envPtr->clNext = NULL;
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
envPtr->auxDataArrayNext = 0;
@@ -1436,20 +1221,6 @@ TclFreeCompileEnv(
if (envPtr->mallocedAuxDataArray) {
ckfree(envPtr->auxDataArrayPtr);
}
if (envPtr->extCmdMapPtr) {
ReleaseCmdWordData(envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
}
/*
* If we used data about invisible continuation lines, then now is the
* time to release on our hold on it. The lock was set in function
* TclSetByteCodeFromAny(), found in this file.
*/
if (envPtr->clLoc) {
Tcl_Release(envPtr->clLoc);
}
}
/*
@@ -1575,9 +1346,6 @@ TclCompileScript(
Tcl_Token *tokenPtr;
int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
Tcl_DString ds;
/* TIP #280 */
ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines, wlineat, cmdLine, *clNext;
Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
if (envPtr->iPtr == NULL) {
@@ -1605,8 +1373,6 @@ TclCompileScript(
p = script;
bytesLeft = numBytes;
cmdLine = envPtr->line;
clNext = envPtr->clNext;
do {
if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
/*
@@ -1622,18 +1388,6 @@ TclCompileScript(
break;
}
/*
* TIP #280: We have to count newlines before the command even in the
* degenerate case when the command has no words. (See test
* info-30.33).
* So make that counting here, and not in the (numWords > 0) branch
* below.
*/
TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
TclAdvanceContinuations(&cmdLine, &clNext,
parsePtr->commandStart - envPtr->source);
if (parsePtr->numWords > 0) {
int expand = 0; /* Set if there are dynamic expansions to
* handle */
@@ -1710,20 +1464,6 @@ TclCompileScript(
TclEmitOpcode(INST_EXPAND_START, envPtr);
}
/*
* TIP #280. Scan the words and compute the extended location
* information. The map first contain full per-word line
* information for use by the compiler. This is later replaced by
* a reduced form which signals non-literal words, stored in
* 'wlines'.
*/
EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
parsePtr->tokenPtr, parsePtr->commandStart,
parsePtr->commandSize, parsePtr->numWords, cmdLine,
clNext, &wlines, envPtr);
wlineat = eclPtr->nuloc - 1;
/*
* Each iteration of the following loop compiles one word from the
* command.
@@ -1733,8 +1473,6 @@ TclCompileScript(
wordIdx < parsePtr->numWords; wordIdx++,
tokenPtr += tokenPtr->numComponents + 1) {
envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
* The word is not a simple string of characters.
@@ -1910,13 +1648,6 @@ TclCompileScript(
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
if (envPtr->clNext) {
TclContinuationsEnterDerived(
TclFetchLiteral(envPtr, objIndex),
tokenPtr[1].start - envPtr->source,
eclPtr->loc[wlineat].next[wordIdx]);
}
}
TclEmitPush(objIndex, envPtr);
} /* for loop */
@@ -1946,16 +1677,6 @@ TclCompileScript(
TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
TclAdjustStackDepth((1-wordIdx), envPtr);
} else if (wordIdx > 0) {
/*
* Save PC -> command map for the TclArgumentBC* functions.
*/
int isnew;
Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
INT2PTR(envPtr->codeNext - envPtr->codeStart),
&isnew);
Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
@@ -1973,15 +1694,6 @@ TclCompileScript(
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
isFirstCmd = 0;
/*
* TIP #280: Free full form of per-word line data and insert the
* reduced form now
*/
ckfree(eclPtr->loc[wlineat].line);
ckfree(eclPtr->loc[wlineat].next);
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
} /* end if parsePtr->numWords > 0 */
/*
@@ -1991,24 +1703,9 @@ TclCompileScript(
next = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= next - p;
p = next;
/*
* TIP #280: Track lines in the just compiled command.
*/
TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
Tcl_FreeParse(parsePtr);
} while (bytesLeft > 0);
/*
* TIP #280: Bring the line counts in the CompEnv up to date.
* See tests info-30.33,34,35 .
*/
envPtr->line = cmdLine;
envPtr->clNext = clNext;
/*
* If the source script yielded no instructions (e.g., if it was empty),
* push an empty string as the command's result.
@@ -2091,9 +1788,6 @@ TclCompileVarSubst(
* Emit instructions to load the variable.
*/
TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
tokenPtr[1].start + tokenPtr[1].size);
if (tokenPtr->numComponents == 1) {
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
@@ -2126,42 +1820,8 @@ TclCompileTokens(
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
int i, numObjsToConcat, length;
int numObjsToConcat, length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
/*
* For the handling of continuation lines in literals we first check if
* this is actually a literal. For if not we can forego the additional
* processing. Otherwise we pre-allocate a small table to store the
* locations of all continuation lines we find in this literal, if any.
* The table is extended if needed.
*
* Note: Different to the equivalent code in function 'TclSubstTokens()'
* (see file "tclParse.c") we do not seem to need the 'adjust' variable.
* We also do not seem to need code which merges continuation line
* information of multiple words which concat'd at runtime. Either that or
* I have not managed to find a test case for these two possibilities yet.
* It might be a difference between compile- versus run-time processing.
*/
numCL = 0;
maxNumCL = 0;
isLiteral = 1;
for (i=0 ; i < count; i++) {
if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
&& (tokenPtr[i].type != TCL_TOKEN_BS)) {
isLiteral = 0;
break;
}
}
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = ckalloc(maxNumCL * sizeof(int));
}
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
@@ -2169,8 +1829,6 @@ TclCompileTokens(
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
TclDStringAppendToken(&textBuffer, tokenPtr);
TclAdvanceLines(&envPtr->line, tokenPtr->start,
tokenPtr->start + tokenPtr->size);
break;
case TCL_TOKEN_BS:
@@ -2178,34 +1836,8 @@ TclCompileTokens(
NULL, buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
/*
* If the backslash sequence we found is in a literal, and
* represented a continuation line, we compute and store its
* location (as char offset to the beginning of the _result_
* script). We may have to extend the table of locations.
*
* Note that the continuation line information is relevant even if
* the word we are processing is not a literal, as it can affect
* nested commands. See the branch for TCL_TOKEN_COMMAND below,
* where the adjustment we are tracking here is taken into
* account. The good thing is that we do not need a table of
* everything, just the number of lines we have to add as
* correction.
*/
if ((length == 1) && (buffer[0] == ' ') &&
(tokenPtr->start[1] == '\n')) {
if (isLiteral) {
int clPos = Tcl_DStringLength(&textBuffer);
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = ckrealloc(clPosition,
maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
numCL ++;
}
}
break;
@@ -2220,12 +1852,6 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
if (numCL) {
TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
numCL, clPosition);
}
numCL = 0;
}
TclCompileScript(interp, tokenPtr->start+1,
@@ -2268,11 +1894,6 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
if (numCL) {
TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
numCL, clPosition);
}
numCL = 0;
}
/*
@@ -2295,15 +1916,6 @@ TclCompileTokens(
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
Tcl_DStringFree(&textBuffer);
/*
* Release the temp table we used to collect the locations of continuation
* lines, if any.
*/
if (maxNumCL) {
ckfree(clPosition);
}
}
/*
@@ -2513,7 +2125,7 @@ TclInitByteCodeObj(
#endif
int numLitObjects = envPtr->literalArrayNext;
Namespace *namespacePtr;
int i, isNew;
int i;
Interp *iPtr;
if (envPtr->iPtr == NULL) {
@@ -2650,15 +2262,6 @@ TclInitByteCodeObj(
objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
objPtr->typePtr = &tclByteCodeType;
/*
* TIP #280. Associate the extended per-word line information with the
* byte code object (internal rep), for use with the bc compiler.
*/
Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
&isNew), envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
/* We've used up the CompileEnv. Mark as uninitialized. */
envPtr->iPtr = NULL;
@@ -2969,86 +2572,6 @@ EnterCmdExtentData(
cmdLocPtr->numCodeBytes = numCodeBytes;
}
/*
*----------------------------------------------------------------------
* TIP #280
*
* EnterCmdWordData --
*
* Registers the lines for the words of a command. This information is
* used at runtime by 'info frame'.
*
* Results:
* None.
*
* Side effects:
* Inserts word location information into the compilation environment
* envPtr for the command at index cmdIndex. The compilation
* environment's ExtCmdLoc.ECL array is grown if necessary.
*
*----------------------------------------------------------------------
*/
static void
EnterCmdWordData(
ExtCmdLoc *eclPtr, /* Points to the map environment structure in
* which to enter command location
* information. */
int srcOffset, /* Offset of first char of the command. */
Tcl_Token *tokenPtr,
const char *cmd,
int len,
int numWords,
int line,
int *clNext,
int **wlines,
CompileEnv *envPtr)
{
ECL *ePtr;
const char *last;
int wordIdx, wordLine, *wwlines, *wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
* Expand the ECL array by allocating more storage from the heap. The
* currently allocated ECL entries are stored from eclPtr->loc[0] up
* to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
*/
size_t currElems = eclPtr->nloc;
size_t newElems = (currElems ? 2*currElems : 1);
size_t newBytes = newElems * sizeof(ECL);
eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
eclPtr->nloc = newElems;
}
ePtr = &eclPtr->loc[eclPtr->nuloc];
ePtr->srcOffset = srcOffset;
ePtr->line = ckalloc(numWords * sizeof(int));
ePtr->next = ckalloc(numWords * sizeof(int *));
ePtr->nline = numWords;
wwlines = ckalloc(numWords * sizeof(int));
last = cmd;
wordLine = line;
wordNext = clNext;
for (wordIdx=0 ; wordIdx<numWords;
wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
TclAdvanceLines(&wordLine, last, tokenPtr->start);
TclAdvanceContinuations(&wordLine, &wordNext,
tokenPtr->start - envPtr->source);
wwlines[wordIdx] =
(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
ePtr->line[wordIdx] = wordLine;
ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
}
*wlines = wwlines;
eclPtr->nuloc ++;
}
/*
*----------------------------------------------------------------------
*
@@ -3479,70 +3002,6 @@ TclFixupForwardJump(
rangePtr->type);
}
}
/*
* TIP #280: Adjust the mapping from PC values to the per-command
* information about arguments and their line numbers.
*
* Note: We cannot simply remove an out-of-date entry and then reinsert
* with the proper PC, because then we might overwrite another entry which
* was at that location. Therefore we pull (copy + delete) all effected
* entries (beyond the fixed PC) into an array, update them there, and at
* last reinsert them all.
*/
{
ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
/* A helper structure */
typedef struct {
int pc;
int cmd;
} MAP;
/*
* And the helper array. At most the whole hashtable is placed into
* this.
*/
MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
Tcl_HashSearch hSearch;
Tcl_HashEntry* hPtr;
int n, k, isnew;
/*
* Phase I: Locate the affected entries, and save them in adjusted
* form to the array. This removes them from the hash.
*/
for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));
if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
Tcl_DeleteHashEntry(hPtr);
map [n].pc += 3;
n++;
}
}
/*
* Phase II: Re-insert the modified entries into the hash.
*/
for (k=0;k<n;k++) {
hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
}
ckfree (map);
}
return 1; /* the jump was grown */
}
@@ -4470,177 +3929,6 @@ FormatInstruction(
return numBytes;
}
/*
*----------------------------------------------------------------------
*
* TclGetInnerContext --
*
* If possible, returns a list capturing the inner context. Otherwise
* return NULL.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclGetInnerContext(
Tcl_Interp *interp,
const unsigned char *pc,
Tcl_Obj **tosPtr)
{
int objc = 0, off = 0;
Tcl_Obj *result;
Interp *iPtr = (Interp *) interp;
switch (*pc) {
case INST_STR_LEN:
case INST_LNOT:
case INST_BITNOT:
case INST_UMINUS:
case INST_UPLUS:
case INST_TRY_CVT_TO_NUMERIC:
case INST_EXPAND_STKTOP:
case INST_EXPR_STK:
objc = 1;
break;
case INST_LIST_IN:
case INST_LIST_NOT_IN: /* Basic list containment operators. */
case INST_STR_EQ:
case INST_STR_NEQ: /* String (in)equality check */
case INST_STR_CMP: /* String compare. */
case INST_STR_INDEX:
case INST_STR_MATCH:
case INST_REGEXP:
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
case INST_LE:
case INST_GE:
case INST_MOD:
case INST_LSHIFT:
case INST_RSHIFT:
case INST_BITOR:
case INST_BITXOR:
case INST_BITAND:
case INST_EXPON:
case INST_ADD:
case INST_SUB:
case INST_DIV:
case INST_MULT:
objc = 2;
break;
case INST_RETURN_STK:
/* early pop. TODO: dig out opt dict too :/ */
objc = 1;
break;
case INST_SYNTAX:
case INST_RETURN_IMM:
objc = 2;
break;
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
break;
case INST_INVOKE_STK1:
objc = TclGetUInt1AtPtr(pc+1);
break;
}
result = iPtr->innerContext;
if (Tcl_IsShared(result)) {
Tcl_DecrRefCount(result);
iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
Tcl_IncrRefCount(result);
} else {
int len;
/*
* Reset while keeping the list intrep as much as possible.
*/
Tcl_ListObjLength(interp, result, &len);
Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
}
Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
for (; objc>0 ; objc--) {
Tcl_Obj *objPtr;
objPtr = tosPtr[1 - objc + off];
if (!objPtr) {
Tcl_Panic("InnerContext: bad tos -- appending null object");
}
if ((objPtr->refCount<=0)
#ifdef TCL_MEM_DEBUG
|| (objPtr->refCount==0x61616161)
#endif
) {
Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
objPtr);
}
Tcl_ListObjAppendElement(NULL, result, objPtr);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* TclNewInstNameObj --
*
* Creates a new InstName Tcl_Obj based on the given instruction
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->typePtr = &tclInstNameType;
objPtr->internalRep.longValue = (long) inst;
objPtr->bytes = NULL;
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfInstName --
*
* Update the string representation for an instruction name object.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
int inst = objPtr->internalRep.longValue;
char *s, buf[20];
int len;
if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
sprintf(buf, "inst_%d", inst);
s = buf;
} else {
s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
}
len = strlen(s);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, s, len + 1);
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
+2 -64
View File
@@ -114,46 +114,6 @@ typedef struct CmdLocation {
int numSrcBytes; /* Number of command source chars. */
} CmdLocation;
/*
* TIP #280
* Structure to record additional location information for byte code. This
* information is internal and not saved. i.e. tbcload'ed code will not have
* this information. It records the lines for all words of all commands found
* in the byte code. The association with a ByteCode structure BC is done
* through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
* Also recorded is information coming from the context, i.e. type of the
* frame and associated information, like the path of a sourced file.
*/
typedef struct ECL {
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
* command. */
int **next; /* Transient information used by the compiler
* for tracking of hidden continuation
* lines. */
} ECL;
typedef struct ExtCmdLoc {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
* tclCompileObj. */
Tcl_Obj *path; /* Path of the sourced file the command is
* in. */
ECL *loc; /* Command word locations (lines). */
int nloc; /* Number of allocated entries in 'loc'. */
int nuloc; /* Number of used entries in 'loc'. */
Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the
* information accessible per command and
* argument, not per whole bytecode. Value is
* index of command in 'loc', giving us the
* literals to associate with line information
* as command argument, see
* TclArgumentBCEnter() */
} ExtCmdLoc;
/*
* CompileProcs need the ability to record information during compilation that
* can be used by bytecode instructions during execution. The AuxData
@@ -300,23 +260,10 @@ typedef struct CompileEnv {
/* Initial storage for cmd location map. */
AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
/* Initial storage for aux data array. */
/* TIP #280 */
ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
* 'info frame'. */
int line; /* First line of the script, based on the
* invoking context, then the line of the
* command currently compiled. */
int atCmdStart; /* Flag to say whether an INST_START_CMD
* should be issued; they should never be
* issued repeatedly, as that is significantly
* inefficient. */
ContLineLoc *clLoc; /* If not NULL, the table holding the
* locations of the invisible continuation
* lines in the input script, to adjust the
* line counter. */
int *clNext; /* If not NULL, it refers to the next slot in
* clLoc to check for an invisible
* continuation line. */
} CompileEnv;
/*
@@ -906,8 +853,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
*----------------------------------------------------------------
*/
MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
const CmdFrame *invoker, int word);
MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------
@@ -968,7 +914,7 @@ MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
int numBytes, const CmdFrame *invoker, int word);
int numBytes);
MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
#ifdef TCL_COMPILE_STATS
@@ -1008,14 +954,6 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
const char *script,
const char *command, int length,
const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
/*
*----------------------------------------------------------------
+8 -22
View File
@@ -2375,7 +2375,6 @@ DictForNRCmd(
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
Tcl_DictSearch *searchPtr;
@@ -2445,7 +2444,7 @@ DictForNRCmd(
TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
valueVarObj, scriptObj);
return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
return TclNREvalObjEx(interp, scriptObj, 0);
/*
* For unwinding everything on error.
@@ -2466,7 +2465,6 @@ DictForLoopCallback(
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_DictSearch *searchPtr = data[0];
Tcl_Obj *keyVarObj = data[1];
Tcl_Obj *valueVarObj = data[2];
@@ -2527,7 +2525,7 @@ DictForLoopCallback(
TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
valueVarObj, scriptObj);
return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
return TclNREvalObjEx(interp, scriptObj, 0);
/*
* For unwinding everything once the iterating is done.
@@ -2567,7 +2565,6 @@ DictMapNRCmd(
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj **varv, *keyObj, *valueObj;
DictMapStorage *storagePtr;
int varc, done;
@@ -2646,8 +2643,7 @@ DictMapNRCmd(
*/
TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
iPtr->cmdFramePtr, 3);
return TclNREvalObjEx(interp, storagePtr->scriptObj, 0);
/*
* For unwinding everything on error.
@@ -2669,7 +2665,6 @@ DictMapLoopCallback(
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
DictMapStorage *storagePtr = data[0];
Tcl_Obj *keyObj, *valueObj;
int done;
@@ -2736,8 +2731,7 @@ DictMapLoopCallback(
*/
TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
iPtr->cmdFramePtr, 3);
return TclNREvalObjEx(interp, storagePtr->scriptObj, 0);
/*
* For unwinding everything once the iterating is done.
@@ -2897,7 +2891,6 @@ DictFilterCmd(
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
static const char *const filters[] = {
"key", "script", "value", NULL
};
@@ -3081,11 +3074,7 @@ DictFilterCmd(
goto abnormalResult;
}
/*
* TIP #280. Make invoking context available to loop body.
*/
result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4);
result = Tcl_EvalObjEx(interp, scriptObj, 0);
switch (result) {
case TCL_OK:
boolObj = Tcl_GetObjResult(interp);
@@ -3184,7 +3173,6 @@ DictUpdateCmd(
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
int i, dummy;
@@ -3228,7 +3216,7 @@ DictUpdateCmd(
Tcl_IncrRefCount(objv[1]);
TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
return TclNREvalObjEx(interp, objv[objc-1], 0);
}
static int
@@ -3343,7 +3331,6 @@ DictWithCmd(
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
if (objc < 3) {
@@ -3367,8 +3354,7 @@ DictWithCmd(
Tcl_IncrRefCount(keysPtr);
/*
* Execute the body, while making the invoking context available to the
* loop body (TIP#280) and postponing the cleanup until later (NRE).
* Execute the body, while postponing the cleanup until later (NRE).
*/
pathPtr = NULL;
@@ -3380,7 +3366,7 @@ DictWithCmd(
TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
return TclNREvalObjEx(interp, objv[objc-1], 0);
}
static int
+1 -21
View File
@@ -92,12 +92,6 @@ const Tcl_ObjType tclEnsembleCmdType = {
* 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(
@@ -1915,7 +1909,7 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE);
}
unknownOrAmbiguousSubcommand:
@@ -3148,7 +3142,6 @@ CompileToInvokedCommand(
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
@@ -3165,17 +3158,8 @@ CompileToInvokedCommand(
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);
@@ -3228,7 +3212,6 @@ CompileBasicNArgCommand(
Tcl_Obj *objPtr;
char *bytes;
int length, i, literal;
DefineLineInformation;
/*
* Push the name of the command we're actually dispatching to as part of
@@ -3249,9 +3232,6 @@ CompileBasicNArgCommand(
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 {
+50 -244
View File
@@ -173,13 +173,13 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
typedef struct TEBCdata {
ByteCode *codePtr; /* Constant until the BC returns */
Tcl_Obj *srcPtr;
/* -----------------------------------------*/
const unsigned char *pc; /* These fields are used on return TO this */
ptrdiff_t *catchTop; /* this level: they record the state when a */
int cleanup; /* new codePtr was received for NR */
Tcl_Obj *auxObjList; /* execution. */
int checkInterp;
CmdFrame cmdFrame;
void *stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
@@ -796,6 +796,35 @@ ReleaseDictIterator(
objPtr->typePtr = NULL;
}
static void UpdateStringOfBcSource(Tcl_Obj *objPtr);
static const Tcl_ObjType bcSourceType = {
"bcSource", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfBcSource, /* updateStringProc */
NULL /* setFromAnyProc */
};
static void
UpdateStringOfBcSource(
Tcl_Obj *objPtr)
{
int len;
const char *bytes;
unsigned char *pc = objPtr->internalRep.twoPtrValue.ptr1;
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr2;
bytes = GetSrcInfoForPc(pc, codePtr, &len, NULL);
objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
memcpy(objPtr->bytes, bytes, len);
objPtr->bytes[len] = '\0';
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
@@ -1504,14 +1533,10 @@ CompileExprObj(
}
}
if (objPtr->typePtr != &exprCodeType) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
*/
int length;
const char *string = TclGetStringFromObj(objPtr, &length);
TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
TclInitCompileEnv(interp, &compEnv, string, length);
TclCompileExpr(interp, string, length, &compEnv, 0);
/*
@@ -1634,9 +1659,7 @@ FreeExprCodeInternalRep(
ByteCode *
TclCompileObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
const CmdFrame *invoker,
int word)
Tcl_Obj *objPtr)
{
register Interp *iPtr = (Interp *) interp;
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
@@ -1691,109 +1714,13 @@ TclCompileObj(
goto recompileObj;
}
/*
* #280.
* Literal sharing fix. This part of the fix is not required by 8.4
* nor 8.5, because they eval-direct any literals, so just saving the
* argument locations per command in bytecode is enough, embedded
* 'eval' commands, etc. get the correct information.
*
* But in 8.6 all the embedded script are compiled, and the resulting
* bytecode stored in the literal. Now the shared literal has bytecode
* with location data for _one_ particular location this literal is
* found at. If we get executed from a different location the bytecode
* has to be recompiled to get the correct locations. Not doing this
* will execute the saved bytecode with data for a different location,
* causing 'info frame' to point to the wrong place in the sources.
*
* Future optimizations ...
* (1) Save the location data (ExtCmdLoc) keyed by start line. In that
* case we recompile once per location of the literal, but not
* continously, because the moment we have all locations we do not
* need to recompile any longer.
*
* (2) Alternative: Do not recompile, tell the execution engine the
* offset between saved starting line and actual one. Then modify
* the users to adjust the locations they have by this offset.
*
* (3) Alternative 2: Do not fully recompile, adjust just the location
* information.
*/
if (invoker == NULL) {
return codePtr;
} else {
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
ExtCmdLoc *eclPtr;
CmdFrame *ctxCopyPtr;
int redo;
if (!hePtr) {
return codePtr;
}
eclPtr = Tcl_GetHashValue(hePtr);
redo = 0;
ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*ctxCopyPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
/*
* Note: Type BC => ctx.data.eval.path is not used.
* ctx.data.tebc.codePtr used instead
*/
TclGetSrcInfoForPc(ctxCopyPtr);
if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
/*
* The reference made by 'TclGetSrcInfoForPc' is dead.
*/
Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
ctxCopyPtr->data.eval.path = NULL;
}
}
if (word < ctxCopyPtr->nline) {
/*
* Note: We do not care if the line[word] is -1. This is a
* difference and requires a recompile (location changed from
* absolute to relative, literal is used fixed and through
* variable)
*
* Example:
* test info-32.0 using literal of info-24.8
* (dict with ... vs set body ...).
*/
redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
&& (eclPtr->start != ctxCopyPtr->line[word]))
|| ((eclPtr->type == TCL_LOCATION_BC)
&& (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
}
TclStackFree(interp, ctxCopyPtr);
if (!redo) {
return codePtr;
}
}
return codePtr;
}
recompileObj:
iPtr->errorLine = 1;
/*
* TIP #280. Remember the invoker for a moment in the interpreter
* structures so that the byte code compiler can pick it up when
* initializing the compilation environment, i.e. the extended location
* information.
*/
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
@@ -1946,7 +1873,6 @@ TclIncrObj(
*
*----------------------------------------------------------------------
*/
#define bcFramePtr (&TD->cmdFrame)
#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1]))
#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
#define esPtr (iPtr->execEnvPtr->execStackPtr)
@@ -1973,7 +1899,7 @@ TclNRExecuteByteCode(
* Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
*
* The execution uses a unified stack: first a TEBCdata, immediately
* above it a CmdFrame, then the catch stack, then the execution stack.
* above it the catch stack, then the execution stack.
*
* Make sure the catch stack is large enough to hold the maximum number of
* catch commands that could ever be executing at the same time (this will
@@ -1985,31 +1911,16 @@ TclNRExecuteByteCode(
esPtr->tosPtr = initTosPtr;
TD->codePtr = codePtr;
TD->srcPtr = Tcl_NewObj();
TD->srcPtr->typePtr = &bcSourceType;
TclInvalidateStringRep(TD->srcPtr);
TD->pc = codePtr->codeStart;
TD->catchTop = initCatchTop;
TD->cleanup = 0;
TD->auxObjList = NULL;
TD->checkInterp = 0;
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
* every time that we call out from this TD, popped when we return to it.
*/
bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
bcFramePtr->numLevels = iPtr->numLevels;
bcFramePtr->framePtr = iPtr->framePtr;
bcFramePtr->nextPtr = iPtr->cmdFramePtr;
bcFramePtr->nline = 0;
bcFramePtr->line = NULL;
bcFramePtr->litarg = NULL;
bcFramePtr->data.tebc.codePtr = codePtr;
bcFramePtr->data.tebc.pc = NULL;
bcFramePtr->cmd.str.cmd = NULL;
bcFramePtr->cmd.str.len = 0;
#ifdef TCL_COMPILE_STATS
iPtr->stats.numExecutions++;
#endif
@@ -2075,6 +1986,7 @@ TEBCresume(
#define auxObjList (TD->auxObjList)
#define catchTop (TD->catchTop)
#define codePtr (TD->codePtr)
#define srcPtr (TD->srcPtr)
#define checkInterp (TD->checkInterp)
/* Indicates when a check of interp readyness is
* necessary. Set by CACHE_STACK_INFO() */
@@ -2115,7 +2027,6 @@ TEBCresume(
int starting = 1;
traceInstructions = (tclTraceExec == 3);
#endif
TEBC_DATA_DIG();
#ifdef TCL_COMPILE_DEBUG
@@ -2130,11 +2041,6 @@ TEBCresume(
if (iPtr->execEnvPtr->rewind) {
result = TCL_ERROR;
}
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
}
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
@@ -2392,6 +2298,7 @@ TEBCresume(
NULL);
goto gotError;
}
NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
#ifdef TCL_COMPILE_DEBUG
TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
@@ -2399,17 +2306,6 @@ TEBCresume(
fprintf(stdout, "\n");
}
#endif
/* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
codePtr, bcFramePtr, pc - codePtr->codeStart);
}
pc++;
cleanup = 1;
@@ -2757,8 +2653,6 @@ TEBCresume(
case INST_EXPR_STK: {
ByteCode *newCodePtr;
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
DECACHE_STACK_INFO();
newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
CACHE_STACK_INFO();
@@ -2774,13 +2668,10 @@ TEBCresume(
instEvalStk:
case INST_EVAL_STK:
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
cleanup = 1;
pc += 1;
TEBC_YIELD();
return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
return TclNREvalObjEx(interp, OBJ_AT_TOS, 0);
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
@@ -2833,21 +2724,14 @@ TEBCresume(
/*
* Finally, let TclEvalObjv handle the command.
*
* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
codePtr, bcFramePtr, pc - codePtr->codeStart);
if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
srcPtr->internalRep.twoPtrValue.ptr1 = (unsigned char *) pc;
srcPtr->internalRep.twoPtrValue.ptr2 = codePtr;
iPtr->cmdSourcePtr = srcPtr;
}
DECACHE_STACK_INFO();
pc += pcAdjustment;
TEBC_YIELD();
return TclNREvalObjv(interp, objc, objv,
@@ -2985,12 +2869,6 @@ TEBCresume(
}
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;
@@ -3000,7 +2878,7 @@ TEBCresume(
TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
TclSkipTailcall(interp);
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE);
/*
* -----------------------------------------------------------------
@@ -6902,8 +6780,8 @@ TEBCresume(
bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
DECACHE_STACK_INFO();
TclLogCommandInfo(interp, codePtr->source, bytes,
bytes ? length : 0, pcBeg, tosPtr);
Tcl_LogCommandInfo(interp, codePtr->source, bytes,
bytes ? length : 0);
CACHE_STACK_INFO();
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -7042,10 +6920,9 @@ TEBCresume(
(unsigned) CURR_DEPTH, (unsigned) 0);
Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
}
CLANG_ASSERT(bcFramePtr);
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
TclDecrRefCount(srcPtr);
if (--codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
@@ -7091,9 +6968,8 @@ TEBCresume(
}
#undef codePtr
#undef srcPtr
#undef iPtr
#undef bcFramePtr
#undef initCatchTop
#undef initTosPtr
#undef auxObjList
#undef catchTop
@@ -8680,76 +8556,6 @@ IllegalExprOperandType(
*----------------------------------------------------------------------
*/
const char *
TclGetSrcInfoForCmd(
Interp *iPtr,
int *lenPtr)
{
CmdFrame *cfPtr = iPtr->cmdFramePtr;
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
codePtr, lenPtr, NULL);
}
void
TclGetSrcInfoForPc(
CmdFrame *cfPtr)
{
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
if (cfPtr->cmd.str.cmd == NULL) {
cfPtr->cmd.str.cmd = GetSrcInfoForPc(
(unsigned char *) cfPtr->data.tebc.pc, codePtr,
&cfPtr->cmd.str.len, NULL);
}
if (cfPtr->cmd.str.cmd != NULL) {
/*
* We now have the command. We can get the srcOffset back and from
* there find the list of word locations for this command.
*/
ExtCmdLoc *eclPtr;
ECL *locPtr = NULL;
int srcOffset, i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
if (!hePtr) {
return;
}
srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
eclPtr = Tcl_GetHashValue(hePtr);
for (i=0; i < eclPtr->nuloc; i++) {
if (eclPtr->loc[i].srcOffset == srcOffset) {
locPtr = eclPtr->loc+i;
break;
}
}
if (locPtr == NULL) {
Tcl_Panic("LocSearch failure");
}
cfPtr->line = locPtr->line;
cfPtr->nline = locPtr->nline;
cfPtr->type = eclPtr->type;
if (eclPtr->type == TCL_LOCATION_SOURCE) {
cfPtr->data.eval.path = eclPtr->path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
}
/*
* Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for
* cfPtr->data.tebc.codePtr.
*/
}
}
static const char *
GetSrcInfoForPc(
const unsigned char *pc, /* The program counter value for which to
+2 -10
View File
@@ -1801,12 +1801,8 @@ Tcl_FSEvalFileEx(
Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
/*
* TIP #280 Force the evaluator to open a frame for a sourced file.
*/
iPtr->evalFlags |= TCL_EVAL_FILE;
result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
result = Tcl_EvalEx(interp, string, length, 0);
/*
* Now we have to be careful; the script may have changed the
@@ -1937,14 +1933,10 @@ TclNREvalFile(
iPtr->scriptFile = pathPtr;
Tcl_IncrRefCount(iPtr->scriptFile);
/*
* TIP #280: Force the evaluator to open a frame for a sourced file.
*/
iPtr->evalFlags |= TCL_EVAL_FILE;
TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
NULL);
return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
return TclNREvalObjEx(interp, objPtr, 0);
}
static int
+8 -9
View File
@@ -922,13 +922,13 @@ declare 231 {
}
# Bits and pieces of TIP#280's guts
declare 232 {
int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
const CmdFrame *invoker, int word)
}
declare 233 {
void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}
#declare 232 {
# int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
# const CmdFrame *invoker, int word)
#}
#declare 233 {
# void TclGetSrcInfoForPc(CmdFrame *contextPtr)
#}
# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
declare 234 {
@@ -965,8 +965,7 @@ declare 240 {
struct NRE_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
const CmdFrame *invoker, int word)
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 242 {
int TclNREvalObjv(Tcl_Interp *interp, int objc,
+4 -284
View File
@@ -1136,192 +1136,6 @@ typedef struct CallFrame {
* been confirmed to refer to a class. Part of
* TIP#257. */
/*
* TIP #280
* The structure below defines a command frame. A command frame provides
* location information for all commands executing a tcl script (source, eval,
* uplevel, procedure bodies, ...). The runtime structure essentially contains
* the stack trace as it would be if the currently executing command were to
* throw an error.
*
* For commands where it makes sense it refers to the associated CallFrame as
* well.
*
* The structures are chained in a single list, with the top of the stack
* anchored in the Interp structure.
*
* Instances can be allocated on the C stack, or the heap, the former making
* cleanup a bit simpler.
*/
typedef struct CmdFrame {
/*
* General data. Always available.
*/
int type; /* Values see below. */
int level; /* Number of frames in stack, prevent O(n)
* scan of list. */
int *line; /* Lines the words of the command start on. */
int nline;
CallFrame *framePtr; /* Procedure activation record, may be
* NULL. */
struct CmdFrame *nextPtr; /* Link to calling frame. */
/*
* Data needed for Eval vs TEBC
*
* EXECUTION CONTEXTS and usage of CmdFrame
*
* Field TEBC EvalEx EvalObjEx
* ======= ==== ====== =========
* level yes yes yes
* type BC/PREBC SRC/EVAL EVAL_LIST
* line0 yes yes yes
* framePtr yes yes yes
* ======= ==== ====== =========
*
* ======= ==== ====== ========= union data
* line1 - yes -
* line3 - yes -
* path - yes -
* ------- ---- ------ ---------
* codePtr yes - -
* pc yes - -
* ======= ==== ====== =========
*
* ======= ==== ====== ========= | union cmd
* listPtr - - yes |
* ------- ---- ------ --------- |
* cmd yes yes - |
* cmdlen yes yes - |
* ------- ---- ------ --------- |
*/
union {
struct {
Tcl_Obj *path; /* Path of the sourced file the command is
* in. */
} eval;
struct {
const void *codePtr;/* Byte code currently executed... */
const char *pc; /* ... and instruction pointer. */
} tebc;
} data;
union {
struct {
const char *cmd; /* The executed command, if possible... */
int len; /* ... and its length. */
} str;
Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list. */
} cmd;
int numLevels; /* Value of interp's numLevels when the frame
* was pushed. */
const struct CFWordBC *litarg;
/* Link to set of literal arguments which have
* ben pushed on the lineLABCPtr stack by
* TclArgumentBCEnter(). These will be removed
* by TclArgumentBCRelease. */
} CmdFrame;
typedef struct CFWord {
CmdFrame *framePtr; /* CmdFrame to access. */
int word; /* Index of the word in the command. */
int refCount; /* Number of times the word is on the
* stack. */
} CFWord;
typedef struct CFWordBC {
CmdFrame *framePtr; /* CmdFrame to access. */
int pc; /* Instruction pointer of a command in
* ExtCmdLoc.loc[.] */
int word; /* Index of word in
* ExtCmdLoc.loc[cmd]->line[.] */
struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */
struct CFWordBC *nextPtr; /* Next entry for same command call. See
* CmdFrame litarg field for the list start. */
Tcl_Obj *obj; /* Back reference to hashtable key */
} CFWordBC;
/*
* Structure to record the locations of invisible continuation lines in
* literal scripts, as character offset from the beginning of the script. Both
* compiler and direct evaluator use this information to adjust their line
* counters when tracking through the script, because when it is invoked the
* continuation line marker as a whole has been removed already, meaning that
* the \n which was part of it is gone as well, breaking regular line
* tracking.
*
* These structures are allocated and filled by both the function
* TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
* file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
* file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
* TclCompileScript(), both found in the file "tclCompile.c". Their memory is
* released by the function TclFreeObj(), in the file "tclObj.c", and also by
* the function TclThreadFinalizeObjects(), in the same file.
*/
#define CLL_END (-1)
typedef struct ContLineLoc {
int num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
int loc[1]; /* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
* value -1 is put after the last location, as
* end-marker/sentinel. */
} ContLineLoc;
/*
* The following macros define the allowed values for the type field of the
* CmdFrame structure above. Some of the values occur only in the extended
* location data referenced via the 'baseLocPtr'.
*
* TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx.
* TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
* optimization path of EvalObjEx.
* TCL_LOCATION_BC : Frame is for bytecode.
* TCL_LOCATION_PREBC : Frame is for precompiled bytecode.
* TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a
* sourced file.
* TCL_LOCATION_PROC : Frame is for bytecode of a procedure.
*
* A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
* types, per the context of the byte code in execution.
*/
#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */
#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script,
* list-path. */
#define TCL_LOCATION_BC (2) /* Location in byte code. */
#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
* location. */
#define TCL_LOCATION_SOURCE (4) /* Location in a file. */
#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */
#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */
/*
* Structure passed to describe procedure-like "procedures" that are not
* procedures (e.g. a lambda) so that their details can be reported correctly
* by [info frame]. Contains a sub-structure for each extra field.
*/
typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData);
typedef struct {
const char *name; /* Name of this field. */
GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the
* clientData, or just use the clientData
* directly (after casting) if NULL. */
ClientData clientData; /* Context for above function, or Tcl_Obj* if
* proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
int length; /* Length of array. */
ExtraFrameInfoField fields[2];
/* Really as long as necessary, but this is
* long enough for nearly anything. */
} ExtraFrameInfo;
/*
*----------------------------------------------------------------
@@ -1432,8 +1246,6 @@ typedef struct ExecStack {
typedef struct CorContext {
struct CallFrame *framePtr;
struct CallFrame *varFramePtr;
struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */
Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */
} CorContext;
typedef struct CoroutineData {
@@ -1446,7 +1258,6 @@ typedef struct CoroutineData {
* coroutine. */
CorContext caller;
CorContext running;
Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */
void *stackLevel;
int auxNumLevels; /* While the coroutine is running the
* numLevels of the create/resume command is
@@ -2013,54 +1824,6 @@ typedef struct Interp {
* NULL), takes precedence over a POSIX error
* code returned by a channel operation. */
/*
* Source code origin information (TIP #280).
*/
CmdFrame *cmdFramePtr; /* Points to the command frame containing the
* location information for the current
* command. */
const CmdFrame *invokeCmdFramePtr;
/* Points to the command frame which is the
* invoking context of the bytecode compiler.
* NULL when the byte code compiler is not
* active. */
int invokeWord; /* Index of the word in the command which
* is getting compiled. */
Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
* defined procedure the location information
* for its body. It is keyed by the address of
* the Proc structure for a procedure. The
* values are "struct CmdFrame*". */
Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode
* object the location information for its
* body. It is keyed by the address of the
* Proc structure for a procedure. The values
* are "struct ExtCmdLoc*". (See
* tclCompile.h) */
Tcl_HashTable *lineLABCPtr;
Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a
* command on the execution stack the index of
* the argument in the command, and the
* location data of the command. It is keyed
* by the address of the Tcl_Obj containing
* the argument. The values are "struct
* CFWord*" (See tclBasic.c). This allows
* commands like uplevel, eval, etc. to find
* location information for their arguments,
* if they are a proper literal argument to an
* invoking command. Alt view: An index to the
* CmdFrame stack keyed by command argument
* holders. */
ContLineLoc *scriptCLLocPtr;/* This table points to the location data for
* invisible continuation lines in the script,
* if any. This pointer is set by the function
* TclEvalObjEx() in file "tclBasic.c", and
* used by function ...() in the same file.
* It does for the eval/direct path of script
* execution what CompileEnv.clLoc does for
* the bytecode compiler.
*/
/*
* TIP #268. The currently active selection mode, i.e. the package require
* preferences.
@@ -2124,16 +1887,6 @@ typedef struct Interp {
* over the default error messages returned by
* a script cancellation operation. */
/*
* TIP #348 IMPLEMENTATION - Substituted error stack
*/
Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */
Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */
Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */
Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */
Tcl_Obj *innerContext; /* cached list for fast reallocation */
int resetErrorStack; /* controls cleaning up of ::errorStack */
#ifdef TCL_COMPILE_STATS
/*
* Statistical information about the bytecode compiler and interpreter's
@@ -2143,6 +1896,7 @@ typedef struct Interp {
ByteCodeStats stats; /* Holds compilation and execution statistics
* for this interpreter. */
#endif /* TCL_COMPILE_STATS */
Tcl_Obj *cmdSourcePtr; /* Command source obj, used for command traces */
} Interp;
/*
@@ -2738,7 +2492,7 @@ MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
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
* NRE the 'for' and 'while' commands. We need a separate structure because we
* have more than the 4 client data entries we can provide directly thorugh
@@ -2753,7 +2507,6 @@ typedef struct ForIterData {
Tcl_Obj *body; /* Loop body. */
Tcl_Obj *next; /* Loop step script, NULL for 'while'. */
const char *msg; /* Error message part. */
int word; /* Index of the body script in the command */
} ForIterData;
/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
@@ -2811,21 +2564,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 TclAdvanceContinuations(int *line, int **next,
int loc);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
const char *end);
MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc, CmdFrame *cf);
MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc);
MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc,
void *codePtr, CmdFrame *cfPtr, int pc);
MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
@@ -2840,20 +2578,9 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
Tcl_Interp *interp, int result);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
int start, int *clNext);
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);
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,
int numBytes, int flags, int line,
int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
@@ -2912,7 +2639,6 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
const char *modeString, int *seekFlagPtr,
int *binaryPtr);
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
@@ -2924,7 +2650,6 @@ MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
@@ -2969,7 +2694,6 @@ MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes,
MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int TclNokia770Doubles(void);
MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
@@ -3076,16 +2800,14 @@ MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
int numBytes, int flags, int line,
struct CompileEnv *envPtr);
int numBytes, int flags, struct CompileEnv *envPtr);
MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts,
Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
int numBytes, int flags, Tcl_Parse *parsePtr,
Tcl_InterpState *statePtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count, int *tokensLeftPtr, int line,
int *clNextOuter, const char *outerScript);
int count, int *tokensLeftPtr);
MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
@@ -3116,8 +2838,6 @@ MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
/*
*----------------------------------------------------------------
* Command procedures in the generic core:
+8 -13
View File
@@ -554,11 +554,8 @@ EXTERN Var * TclObjLookupVar(Tcl_Interp *interp,
/* 231 */
EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
/* 232 */
EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
/* 233 */
EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr);
/* Slot 232 is reserved */
/* Slot 233 is reserved */
/* 234 */
EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
const char *key, int *newPtr);
@@ -582,7 +579,7 @@ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result,
struct NRE_callback *rootPtr);
/* 241 */
EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
int flags);
/* 242 */
EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags,
@@ -847,8 +844,8 @@ typedef struct TclIntStubs {
int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
void (*reserved232)(void);
void (*reserved233)(void);
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
@@ -856,7 +853,7 @@ typedef struct TclIntStubs {
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
@@ -1259,10 +1256,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclObjLookupVar) /* 230 */
#define TclGetNamespaceFromObj \
(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
#define TclEvalObjEx \
(tclIntStubsPtr->tclEvalObjEx) /* 232 */
#define TclGetSrcInfoForPc \
(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
/* Slot 232 is reserved */
/* Slot 233 is reserved */
#define TclVarHashCreateVar \
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
+1 -11
View File
@@ -2800,17 +2800,7 @@ SlaveEval(
Tcl_AllowExceptions(slaveInterp);
if (objc == 1) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = iPtr->cmdFramePtr;
int word = 0;
TclArgumentGet(interp, objv[0], &invoker, &word);
result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
} else {
Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
+8 -175
View File
@@ -3235,8 +3235,6 @@ NRNamespaceEvalCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker;
int word;
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
Tcl_Obj *objPtr;
@@ -3290,14 +3288,7 @@ NRNamespaceEvalCmd(
}
if (objc == 3) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
objPtr = objv[2];
invoker = iPtr->cmdFramePtr;
word = 3;
TclArgumentGet(interp, objPtr, &invoker, &word);
} else {
/*
* More than one argument: concatenate them together with spaces
@@ -3306,17 +3297,11 @@ NRNamespaceEvalCmd(
*/
objPtr = Tcl_ConcatObj(objc-2, objv+2);
invoker = NULL;
word = 0;
}
/*
* TIP #280: Make invoking context available to eval'd script.
*/
TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
NULL, NULL);
return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
return TclNREvalObjEx(interp, objPtr, 0);
}
static int
@@ -3761,7 +3746,7 @@ NRNamespaceInscopeCmd(
TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
NULL, NULL);
return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
return TclNREvalObjEx(interp, cmdObjPtr, 0);
}
/*
@@ -4790,37 +4775,31 @@ TclGetNamespaceChildTable(
/*
*----------------------------------------------------------------------
*
* TclLogCommandInfo --
* Tcl_LogCommandInfo --
*
* This function is invoked after an error occurs in an interpreter. It
* adds information to iPtr->errorInfo/errorStack fields to describe the
* command that was being executed when the error occurred. When pc and
* tosPtr are non-NULL, conveying a bytecode execution "inner context",
* and the offending instruction is suitable, that inner context is
* recorded in errorStack.
* adds information to iPtr->errorInfo fields to describe the
* command that was being executed when the error occurred.
*
* Results:
* None.
*
* Side effects:
* Information about the command is added to errorInfo/errorStack and the
* Information about the command is added to errorInfo and the
* line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
void
TclLogCommandInfo(
Tcl_LogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
int length, /* Number of bytes in command (-1 means use
int length) /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
const unsigned char *pc, /* Current pc of bytecode execution context */
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
register const char *p;
Interp *iPtr = (Interp *) interp;
@@ -4887,153 +4866,7 @@ TclLogCommandInfo(
}
}
}
/*
* TIP #348
*/
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list intrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
if (pc != NULL) {
Tcl_Obj *innerContext;
innerContext = TclGetInnerContext(interp, pc, tosPtr);
if (innerContext != NULL) {
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
}
} else if (command != NULL) {
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(command, length));
}
}
if (!iPtr->framePtr->objc) {
/*
* Special frame, nothing to report.
*/
} else if (iPtr->varFramePtr != iPtr->framePtr) {
/*
* uplevel case, [lappend errorstack UP $relativelevel]
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
iPtr->framePtr->level - iPtr->varFramePtr->level));
} else if (iPtr->framePtr != iPtr->rootFramePtr) {
/*
* normal case, [lappend errorstack CALL [info level 0]]
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
iPtr->framePtr->objc, iPtr->framePtr->objv));
}
}
/*
*----------------------------------------------------------------------
*
* TclErrorStackResetIf --
*
* The TIP 348 reset/no-bc part of TLCI, for specific use by
* TclCompileSyntaxError.
*
* Results:
* None.
*
* Side effects:
* Reset errorstack if it needs be, and in that case remember the
* passed-in error message as inner context.
*
*----------------------------------------------------------------------
*/
void
TclErrorStackResetIf(
Tcl_Interp *interp,
const char *msg,
int length)
{
Interp *iPtr = (Interp *) interp;
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list intrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(msg, length));
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_LogCommandInfo --
*
* This function is invoked after an error occurs in an interpreter. It
* adds information to iPtr->errorInfo/errorStack fields to describe the
* command that was being executed when the error occurred.
*
* Results:
* None.
*
* Side effects:
* Information about the command is added to errorInfo/errorStack and the
* line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
void
Tcl_LogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
int length) /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
{
TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}
/*
* Local Variables:
+1 -4
View File
@@ -404,7 +404,6 @@ TclOO_Object_Eval(
CallFrame *framePtr, **framePtrPtr = &framePtr;
Tcl_Obj *scriptPtr;
int result;
CmdFrame *invoker;
if (objc-1 < skip) {
Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
@@ -439,10 +438,8 @@ TclOO_Object_Eval(
if (objc != skip+1) {
scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
invoker = NULL;
} else {
scriptPtr = objv[skip];
invoker = ((Interp *) interp)->cmdFramePtr;
}
/*
@@ -451,7 +448,7 @@ TclOO_Object_Eval(
*/
TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
return TclNREvalObjEx(interp, scriptPtr, 0);
}
static int
+3 -6
View File
@@ -841,8 +841,7 @@ TclOODefineObjCmd(
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
result = Tcl_EvalObjEx(interp, objv[2], 0);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class");
}
@@ -955,8 +954,7 @@ TclOOObjDefObjCmd(
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
result = Tcl_EvalObjEx(interp, objv[2], 0);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "object");
}
@@ -1069,8 +1067,7 @@ TclOODefineSelfObjCmd(
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
((Interp *)interp)->cmdFramePtr, 2);
result = Tcl_EvalObjEx(interp, objv[1], 0);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
-3
View File
@@ -94,9 +94,6 @@ typedef struct ProcedureMethod {
TclOO_PostCallProc *postCallProc;
/* Callback to allow for additional cleanup
* after the method executes. */
GetFrameInfoValueProc *gfivProc;
/* Callback to allow for fine tuning of how
* the method reports itself. */
} ProcedureMethod;
#define TCLOO_PROCEDURE_METHOD_VERSION 0
-197
View File
@@ -16,17 +16,6 @@
#include "tclOOInt.h"
#include "tclCompile.h"
/*
* Structure used to help delay computing names of objects or classes for
* [info frame] until needed, making invokation faster in the normal case.
*/
struct PNI {
Tcl_Interp *interp; /* Interpreter in which to compute the name of
* a method. */
Tcl_Method method; /* Method to compute the name of. */
};
/*
* Structure used to contain all the information needed about a call frame
* used in a procedure-like method.
@@ -38,11 +27,8 @@ typedef struct {
ProcErrorProc *errProc; /* The error handler for the body. */
Tcl_Obj *nameObj; /* The "name" of the command. */
Command cmd; /* The command structure. Mostly bogus. */
ExtraFrameInfo efi; /* Extra information used for [info frame]. */
Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a
* recursive call returns. */
struct PNI pni; /* Specialist information used in the efi
* field for this type of call. */
} PMFrameData;
/*
@@ -88,7 +74,6 @@ static void ConstructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void DestructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static Tcl_Obj * RenderDeclarerName(ClientData clientData);
static int InvokeForwardMethod(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
@@ -458,7 +443,6 @@ TclOOMakeProcInstanceMethod(
* inside the structure indicated by the
* pointer in clientData. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr;
if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
@@ -468,69 +452,6 @@ TclOOMakeProcInstanceMethod(
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
if (iPtr->cmdFramePtr) {
CmdFrame context = *iPtr->cmdFramePtr;
if (context.type == TCL_LOCATION_BC) {
/*
* Retrieve source information from the bytecode, if possible. If
* the information is retrieved successfully, context.type will be
* TCL_LOCATION_SOURCE and the reference held by
* context.data.eval.path will be counted.
*/
TclGetSrcInfoForPc(&context);
} else if (context.type == TCL_LOCATION_SOURCE) {
/*
* The copy into 'context' up above has created another reference
* to 'context.data.eval.path'; account for it.
*/
Tcl_IncrRefCount(context.data.eval.path);
}
if (context.type == TCL_LOCATION_SOURCE) {
/*
* We can account for source location within a proc only if the
* proc body was not created by substitution.
* (FIXME: check that this is sane and correct!)
*/
if (context.line
&& (context.nline >= 4) && (context.line[3] >= 0)) {
int isNew;
CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
Tcl_HashEntry *hPtr;
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
cfPtr->nextPtr = NULL;
cfPtr->data.eval.path = context.data.eval.path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
cfPtr->cmd.str.cmd = NULL;
cfPtr->cmd.str.len = 0;
hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
(char *) procPtr, &isNew);
Tcl_SetHashValue(hPtr, cfPtr);
}
/*
* 'context' is going out of scope; account for the reference that
* it's holding to the path name.
*/
Tcl_DecrRefCount(context.data.eval.path);
context.data.eval.path = NULL;
}
}
return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
typePtr, clientData);
}
@@ -571,7 +492,6 @@ TclOOMakeProcMethod(
* inside the structure indicated by the
* pointer in clientData. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr;
if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
@@ -581,69 +501,6 @@ TclOOMakeProcMethod(
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
if (iPtr->cmdFramePtr) {
CmdFrame context = *iPtr->cmdFramePtr;
if (context.type == TCL_LOCATION_BC) {
/*
* Retrieve source information from the bytecode, if possible. If
* the information is retrieved successfully, context.type will be
* TCL_LOCATION_SOURCE and the reference held by
* context.data.eval.path will be counted.
*/
TclGetSrcInfoForPc(&context);
} else if (context.type == TCL_LOCATION_SOURCE) {
/*
* The copy into 'context' up above has created another reference
* to 'context.data.eval.path'; account for it.
*/
Tcl_IncrRefCount(context.data.eval.path);
}
if (context.type == TCL_LOCATION_SOURCE) {
/*
* We can account for source location within a proc only if the
* proc body was not created by substitution.
* (FIXME: check that this is sane and correct!)
*/
if (context.line
&& (context.nline >= 4) && (context.line[3] >= 0)) {
int isNew;
CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
Tcl_HashEntry *hPtr;
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
cfPtr->nextPtr = NULL;
cfPtr->data.eval.path = context.data.eval.path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
cfPtr->cmd.str.cmd = NULL;
cfPtr->cmd.str.len = 0;
hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
(char *) procPtr, &isNew);
Tcl_SetHashValue(hPtr, cfPtr);
}
/*
* 'context' is going out of scope; account for the reference that
* it's holding to the path name.
*/
Tcl_DecrRefCount(context.data.eval.path);
context.data.eval.path = NULL;
}
}
return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
clientData);
}
@@ -845,10 +702,8 @@ PushMethodCallFrame(
* Compile the body. This operation may fail.
*/
fdPtr->efi.length = 2;
memset(&fdPtr->cmd, 0, sizeof(Command));
fdPtr->cmd.nsPtr = nsPtr;
fdPtr->cmd.clientData = &fdPtr->efi;
pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
/*
@@ -886,32 +741,6 @@ PushMethodCallFrame(
fdPtr->framePtr->objv = objv;
fdPtr->framePtr->procPtr = pmPtr->procPtr;
/*
* Finish filling out the extra frame info so that [info frame] works.
*/
fdPtr->efi.fields[0].name = "method";
fdPtr->efi.fields[0].proc = NULL;
fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
if (pmPtr->gfivProc != NULL) {
fdPtr->efi.fields[1].name = "";
fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
fdPtr->efi.fields[1].clientData = pmPtr;
} else {
register Tcl_Method method =
Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);
if (Tcl_MethodDeclarerObject(method) != NULL) {
fdPtr->efi.fields[1].name = "object";
} else {
fdPtr->efi.fields[1].name = "class";
}
fdPtr->efi.fields[1].proc = RenderDeclarerName;
fdPtr->efi.fields[1].clientData = &fdPtr->pni;
fdPtr->pni.interp = interp;
fdPtr->pni.method = method;
}
return TCL_OK;
/*
@@ -1117,32 +946,6 @@ ProcedureMethodCompiledVarResolver(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* RenderDeclarerName --
*
* Returns the name of the entity (object or class) which declared a
* method. Used for producing information for [info frame] in such a way
* that the expensive part of this (generating the object or class name
* itself) isn't done until it is needed.
*
* ----------------------------------------------------------------------
*/
static Tcl_Obj *
RenderDeclarerName(
ClientData clientData)
{
struct PNI *pni = clientData;
Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
if (object == NULL) {
object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
}
return TclOOObjectName(pni->interp, (Object *) object);
}
/*
* ----------------------------------------------------------------------
*
-394
View File
@@ -77,17 +77,6 @@ typedef struct ObjData {
*/
typedef struct ThreadSpecificData {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
* generated by a call to the function
* TclSubstTokens() from a literal text
* where bs+nl sequences occured in it, if
* any. I.e. this table keeps track of
* invisible and stripped continuation lines.
* Its keys are Tcl_Obj pointers, the values
* are ContLineLoc pointers. See the file
* tclCompile.h for the definition of this
* structure, and for references to all
* related places in the core. */
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
* that a Tcl_Obj was not allocated by some
@@ -97,10 +86,6 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
static void ContLineLocFree(char *clientData);
static void TclThreadFinalizeContLines(ClientData clientData);
static ThreadSpecificData *TclGetContLineTable(void);
/*
* Nested Tcl_Obj deletion management support
*
@@ -509,341 +494,6 @@ TclFinalizeObjects(void)
Tcl_MutexUnlock(&tclObjMutex);
}
/*
*----------------------------------------------------------------------
*
* TclGetContLineTable --
*
* This procedure is a helper which returns the thread-specific
* hash-table used to track continuation line information associated with
* Tcl_Obj*, and the objThreadMap, etc.
*
* Results:
* A reference to the thread-data.
*
* Side effects:
* May allocate memory for the thread-data.
*
* TIP #280
*----------------------------------------------------------------------
*/
static ThreadSpecificData *
TclGetContLineTable(void)
{
/*
* Initialize the hashtable tracking invisible continuation lines. For
* the release we use a thread exit handler to ensure that this is done
* before TSD blocks are made invalid. The TclFinalizeObjects() which
* would be the natural place for this is invoked afterwards, meaning that
* we try to operate on a data structure already gone.
*/
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->lineCLPtr) {
tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
return tsdPtr;
}
/*
*----------------------------------------------------------------------
*
* TclContinuationsEnter --
*
* This procedure is a helper which saves the continuation line
* information associated with a Tcl_Obj*.
*
* Results:
* A reference to the newly created continuation line location table.
*
* Side effects:
* Allocates memory for the table of continuation line locations.
*
* TIP #280
*----------------------------------------------------------------------
*/
ContLineLoc *
TclContinuationsEnter(
Tcl_Obj *objPtr,
int num,
int *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
/*
* We're entering ContLineLoc data for the same value more than one
* time. Taking care not to leak the old entry.
*
* This can happen when literals in a proc body are shared. See for
* example test info-30.19 where the action (code) for all branches of
* the switch command is identical, mapping them all to the same
* literal. An interesting result of this is that the number and
* locations (offset) of invisible continuation lines in the literal
* are the same for all occurences.
*
* Note that while reusing the existing entry is possible it requires
* the same actions as for a new entry because we have to copy the
* incoming num/loc data even so. Because we are called from
* TclContinuationsEnterDerived for this case, which modified the
* stored locations (Rebased to the proper relative offset). Just
* returning the stored entry would rebase them a second time, or
* more, hosing the data. It is easier to simply replace, as we are
* doing.
*/
ckfree(Tcl_GetHashValue(hPtr));
}
clLocPtr->num = num;
memcpy(&clLocPtr->loc, loc, num*sizeof(int));
clLocPtr->loc[num] = CLL_END; /* Sentinel */
Tcl_SetHashValue(hPtr, clLocPtr);
return clLocPtr;
}
/*
*----------------------------------------------------------------------
*
* TclContinuationsEnterDerived --
*
* This procedure is a helper which computes the continuation line
* information associated with a Tcl_Obj* cut from the middle of a
* script.
*
* Results:
* None.
*
* Side effects:
* Allocates memory for the table of continuation line locations.
*
* TIP #280
*----------------------------------------------------------------------
*/
void
TclContinuationsEnterDerived(
Tcl_Obj *objPtr,
int start,
int *clNext)
{
int length, end, num;
int *wordCLLast = clNext;
/*
* We have to handle invisible continuations lines here as well, despite
* the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If
* our script is the sole argument to an 'eval' command, for example, the
* scriptCLLocPtr we are using was generated by a previous call to TST,
* and while the words we have here may contain continuation lines they
* are invisible already, and the inner call to TST had no bs+nl sequences
* to trigger its code.
*
* Luckily for us, the table we have to create here for the current word
* has to be a slice of the table currently in use, with the locations
* suitably modified to be relative to the start of the word instead of
* relative to the script.
*
* That is what we are doing now. Determine the slice we need, and if not
* empty, wrap it into a new table, and save the result into our
* thread-global hashtable, as usual.
*/
/*
* First compute the range of the word within the script. (Is there a
* better way which doesn't shimmer?)
*/
Tcl_GetStringFromObj(objPtr, &length);
end = start + length; /* First char after the word */
/*
* Then compute the table slice covering the range of the word.
*/
while (*wordCLLast >= 0 && *wordCLLast < end) {
wordCLLast++;
}
/*
* And generate the table from the slice, if it was not empty.
*/
num = wordCLLast - clNext;
if (num) {
int i;
ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
/*
* Re-base the locations.
*/
for (i=0 ; i<num ; i++) {
clLocPtr->loc[i] -= start;
/*
* Continuation lines coming before the string and affecting us
* should not happen, due to the proper maintenance of clNext
* during compilation.
*/
if (clLocPtr->loc[i] < 0) {
Tcl_Panic("Derived ICL data for object using offsets from before the script");
}
}
}
}
/*
*----------------------------------------------------------------------
*
* TclContinuationsCopy --
*
* This procedure is a helper which copies the continuation line
* information associated with a Tcl_Obj* to another Tcl_Obj*. It is
* assumed that both contain the same string/script. Use this when a
* script is duplicated because it was shared.
*
* Results:
* None.
*
* Side effects:
* Allocates memory for the table of continuation line locations.
*
* TIP #280
*----------------------------------------------------------------------
*/
void
TclContinuationsCopy(
Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr)
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
if (hPtr) {
ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
}
}
/*
*----------------------------------------------------------------------
*
* TclContinuationsGet --
*
* This procedure is a helper which retrieves the continuation line
* information associated with a Tcl_Obj*, if it has any.
*
* Results:
* A reference to the continuation line location table, or NULL if the
* Tcl_Obj* has no such information associated with it.
*
* Side effects:
* None.
*
* TIP #280
*----------------------------------------------------------------------
*/
ContLineLoc *
TclContinuationsGet(
Tcl_Obj *objPtr)
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (!hPtr) {
return NULL;
}
return Tcl_GetHashValue(hPtr);
}
/*
*----------------------------------------------------------------------
*
* TclThreadFinalizeContLines --
*
* This procedure is a helper which releases all continuation line
* information currently known. It is run as a thread exit handler.
*
* Results:
* None.
*
* Side effects:
* Releases memory.
*
* TIP #280
*----------------------------------------------------------------------
*/
static void
TclThreadFinalizeContLines(
ClientData clientData)
{
/*
* Release the hashtable tracking invisible continuation lines.
*/
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
/*
* We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
* here we can be sure that the compiler will not hold references to
* the data in the hashtable, and using TEF might bork the
* finalization sequence.
*/
ContLineLocFree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
ckfree(tsdPtr->lineCLPtr);
tsdPtr->lineCLPtr = NULL;
}
/*
*----------------------------------------------------------------------
*
* ContLineLocFree --
*
* The freProc for continuation line location tables.
*
* Results:
* None.
*
* Side effects:
* Releases memory.
*
* TIP #280
*----------------------------------------------------------------------
*/
static void
ContLineLocFree(
char *clientData)
{
ckfree(clientData);
}
/*
*--------------------------------------------------------------
*
@@ -1388,28 +1038,6 @@ TclFreeObj(
ObjDeletionUnlock(context);
}
/*
* We cannot use TclGetContinuationTable() here, because that may
* re-initialize the thread-data for calls coming after the finalization.
* We have to access it using the low-level call and then check for
* validity. This function can be called after TclFinalizeThreadData() has
* already killed the thread-global data structures. Performing
* TCL_TSD_INIT will leave us with an un-initialized memory block upon
* which we crash (if we where to access the uninitialized hashtable).
*/
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashEntry *hPtr;
if (tsdPtr->lineCLPtr) {
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
Tcl_DeleteHashEntry(hPtr);
}
}
}
}
#else /* TCL_MEM_DEBUG */
@@ -1479,28 +1107,6 @@ TclFreeObj(
}
}
/*
* We cannot use TclGetContinuationTable() here, because that may
* re-initialize the thread-data for calls coming after the finalization.
* We have to access it using the low-level call and then check for
* validity. This function can be called after TclFinalizeThreadData() has
* already killed the thread-global data structures. Performing
* TCL_TSD_INIT will leave us with an un-initialized memory block upon
* which we crash (if we where to access the uninitialized hashtable).
*/
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashEntry *hPtr;
if (tsdPtr->lineCLPtr) {
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
Tcl_DeleteHashEntry(hPtr);
}
}
}
}
#endif /* TCL_MEM_DEBUG */
+5 -117
View File
@@ -1566,7 +1566,7 @@ Tcl_ParseVar(
}
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
NULL, 1, NULL, NULL);
NULL);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
@@ -2110,33 +2110,13 @@ TclSubstTokens(
* evaluate and concatenate. */
int count, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
int *tokensLeftPtr, /* If not NULL, points to memory where an
int *tokensLeftPtr) /* If not NULL, points to memory where an
* integer representing the number of tokens
* left to be substituted will be written */
int line, /* The line the script starts on. */
int *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set by
* EvalEx() to properly handle [...]-nested
* commands. The 'outerScript' refers to the
* most-outer script containing the embedded
* command, which is refered to by 'script'.
* The 'clNextOuter' refers to the current
* entry in the table of continuation lines in
* this "master script", and the character
* offsets are relative to the 'outerScript'
* as well.
*
* If outerScript == script, then this call is
* for words in the outer-most script or
* command. See Tcl_EvalEx and TclEvalObjEx
* for the places generating arguments for
* which this is true. */
{
Tcl_Obj *result;
int code = TCL_OK;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL, i, adjust;
int *clPosition = NULL;
Interp *iPtr = (Interp *) interp;
int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
@@ -2150,31 +2130,6 @@ TclSubstTokens(
* of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
*/
/*
* For the handling of continuation lines in literals we first check if
* this is actually a literal. For if not we can forego the additional
* processing. Otherwise we pre-allocate a small table to store the
* locations of all continuation lines we find in this literal, if any.
* The table is extended if needed.
*/
numCL = 0;
maxNumCL = 0;
isLiteral = 1;
for (i=0 ; i < count; i++) {
if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
&& (tokenPtr[i].type != TCL_TOKEN_BS)) {
isLiteral = 0;
break;
}
}
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = ckalloc(maxNumCL * sizeof(int));
}
adjust = 0;
result = NULL;
for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
Tcl_Obj *appendObj = NULL;
@@ -2192,47 +2147,9 @@ TclSubstTokens(
appendByteLength = TclParseBackslash(tokenPtr->start,
tokenPtr->size, NULL, utfCharBytes);
append = utfCharBytes;
/*
* If the backslash sequence we found is in a literal, and
* represented a continuation line, we compute and store its
* location (as char offset to the beginning of the _result_
* script). We may have to extend the table of locations.
*
* Note that the continuation line information is relevant even if
* the word we are processing is not a literal, as it can affect
* nested commands. See the branch for TCL_TOKEN_COMMAND below,
* where the adjustment we are tracking here is taken into
* account. The good thing is that we do not need a table of
* everything, just the number of lines we have to add as
* correction.
*/
if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
&& (tokenPtr->start[1] == '\n')) {
if (isLiteral) {
int clPos;
if (result == 0) {
clPos = 0;
} else {
Tcl_GetStringFromObj(result, &clPos);
}
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = ckrealloc(clPosition,
maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
numCL++;
}
adjust++;
}
break;
case TCL_TOKEN_COMMAND: {
/* TIP #280: Transfer line information to nested command */
iPtr->numLevels++;
code = TclInterpReady(interp);
if (code == TCL_OK) {
@@ -2240,16 +2157,8 @@ TclSubstTokens(
* Test cases: info-30.{6,8,9}
*/
int theline;
TclAdvanceContinuations(&line, &clNextOuter,
tokenPtr->start - outerScript);
theline = line + adjust;
code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
0, theline, clNextOuter, outerScript);
TclAdvanceLines(&line, tokenPtr->start+1,
tokenPtr->start + tokenPtr->size - 1);
code = Tcl_EvalEx(interp, tokenPtr->start+1,
tokenPtr->size-2, 0);
/*
* Restore flag reset by nested eval for future bracketed
@@ -2276,7 +2185,7 @@ TclSubstTokens(
*/
code = TclSubstTokens(interp, tokenPtr+2,
tokenPtr->numComponents - 1, NULL, line, NULL, NULL);
tokenPtr->numComponents - 1, NULL);
arrayIndex = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(arrayIndex);
}
@@ -2360,27 +2269,6 @@ TclSubstTokens(
if (code != TCL_ERROR) { /* Keep error message in result! */
if (result != NULL) {
Tcl_SetObjResult(interp, result);
/*
* If the code found continuation lines (which implies that this
* word is a literal), then we store the accumulated table of
* locations in the thread-global data structure for the bytecode
* compiler to find later, assuming that the literal is a script
* which will be compiled.
*/
if (numCL) {
TclContinuationsEnter(result, numCL, clPosition);
}
/*
* Release the temp table we used to collect the locations of
* continuation lines, if any.
*/
if (maxNumCL) {
ckfree(clPosition);
}
} else {
Tcl_ResetResult(interp);
}
+2 -276
View File
@@ -25,7 +25,6 @@
typedef struct {
int isRootEnsemble;
Command cmd;
ExtraFrameInfo efi;
} ApplyExtraData;
/*
@@ -213,101 +212,6 @@ Tcl_ProcObjCmd(
procPtr->cmdPtr = (Command *) cmd;
/*
* TIP #280: Remember the line the procedure body is starting on. In a
* bytecode context we ask the engine to provide us with the necessary
* information. This is for the initialization of the byte code compiler
* when the body is used for the first time.
*
* This code is nearly identical to the #280 code in SetLambdaFromAny, see
* this file. The differences are the different index of the body in the
* line array of the context, and the lamdba code requires some special
* processing. Find a way to factor the common elements into a single
* function.
*/
if (iPtr->cmdFramePtr) {
CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*contextPtr = *iPtr->cmdFramePtr;
if (contextPtr->type == TCL_LOCATION_BC) {
/*
* Retrieve source information from the bytecode, if possible. If
* the information is retrieved successfully, context.type will be
* TCL_LOCATION_SOURCE and the reference held by
* context.data.eval.path will be counted.
*/
TclGetSrcInfoForPc(contextPtr);
} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
/*
* The copy into 'context' up above has created another reference
* to 'context.data.eval.path'; account for it.
*/
Tcl_IncrRefCount(contextPtr->data.eval.path);
}
if (contextPtr->type == TCL_LOCATION_SOURCE) {
/*
* We can account for source location within a proc only if the
* proc body was not created by substitution.
*/
if (contextPtr->line
&& (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
int isNew;
Tcl_HashEntry *hePtr;
CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
cfPtr->nextPtr = NULL;
cfPtr->data.eval.path = contextPtr->data.eval.path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
cfPtr->cmd.str.cmd = NULL;
cfPtr->cmd.str.len = 0;
hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
procPtr, &isNew);
if (!isNew) {
/*
* Get the old command frame and release it. See also
* TclProcCleanupProc in this file. Currently it seems as
* if only the procbodytest::proc command of the testsuite
* is able to trigger this situation.
*/
CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(cfOldPtr->data.eval.path);
cfOldPtr->data.eval.path = NULL;
}
ckfree(cfOldPtr->line);
cfOldPtr->line = NULL;
ckfree(cfOldPtr);
}
Tcl_SetHashValue(hePtr, cfPtr);
}
/*
* 'contextPtr' is going out of scope; account for the reference
* that it's holding to the path name.
*/
Tcl_DecrRefCount(contextPtr->data.eval.path);
contextPtr->data.eval.path = NULL;
}
TclStackFree(interp, contextPtr);
}
/*
* Optimize for no-op procs: if the body is not precompiled (like a TclPro
* procbody), and the argument list is just "args" and the body is empty,
@@ -442,18 +346,8 @@ TclCreateProc(
*/
if (Tcl_IsShared(bodyPtr)) {
Tcl_Obj *sharedBodyPtr = bodyPtr;
bytes = TclGetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
/*
* TIP #280.
* Ensure that the continuation line data for the original body is
* not lost and applies to the new body as well.
*/
TclContinuationsCopy(bodyPtr, sharedBodyPtr);
}
/*
@@ -967,8 +861,6 @@ TclNRUplevelObjCmd(
{
register Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
@@ -1005,13 +897,7 @@ TclNRUplevelObjCmd(
*/
if (objc == 1) {
/*
* TIP #280. Make actual argument location available to eval'd script
*/
TclArgumentGet(interp, objv[0], &invoker, &word);
objPtr = objv[0];
} else {
/*
* More than one argument: concatenate them together with spaces
@@ -1024,7 +910,7 @@ TclNRUplevelObjCmd(
TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
NULL);
return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
return TclNREvalObjEx(interp, objPtr, 0);
}
/*
@@ -1794,14 +1680,6 @@ TclNRInterpProcCore(
TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
a[8], a[9]);
}
if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
const char *a[6]; int i[2];
TclDTraceInfo(info, a, i);
TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
TclDecrRefCount(info);
}
if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
@@ -2007,8 +1885,6 @@ TclProcCompileProc(
}
if (bodyPtr->typePtr != &tclByteCodeType) {
Tcl_HashEntry *hePtr;
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 1) {
/*
@@ -2074,21 +1950,7 @@ TclProcCompileProc(
TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
/* isProcCallFrame */ 0);
/*
* TIP #280: We get the invoking context from the cmdFrame which
* was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
*/
hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
/*
* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
*/
iPtr->invokeWord = 0;
iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
TclPopStackFrame(interp);
} else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
/*
@@ -2194,9 +2056,6 @@ TclProcCleanupProc(
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
Tcl_Obj *defPtr;
Tcl_ResolvedVarInfo *resVarInfo;
Tcl_HashEntry *hePtr = NULL;
CmdFrame *cfPtr = NULL;
Interp *iPtr = procPtr->iPtr;
if (bodyPtr != NULL) {
Tcl_DecrRefCount(bodyPtr);
@@ -2221,34 +2080,6 @@ TclProcCleanupProc(
localPtr = nextPtr;
}
ckfree(procPtr);
/*
* TIP #280: Release the location data associated with this Proc
* structure, if any. The interpreter may not exist (For example for
* procbody structures created by tbcload.
*/
if (iPtr == NULL) {
return;
}
hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
if (!hePtr) {
return;
}
cfPtr = Tcl_GetHashValue(hePtr);
if (cfPtr) {
if (cfPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(cfPtr->data.eval.path);
cfPtr->data.eval.path = NULL;
}
ckfree(cfPtr->line);
cfPtr->line = NULL;
ckfree(cfPtr);
}
Tcl_DeleteHashEntry(hePtr);
}
/*
@@ -2475,11 +2306,9 @@ SetLambdaFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int isNew, objc, result;
CmdFrame *cfPtr = NULL;
int objc, result;
Proc *procPtr;
if (interp == NULL) {
@@ -2524,93 +2353,6 @@ SetLambdaFromAny(
procPtr->cmdPtr = NULL;
/*
* TIP #280: Remember the line the apply body is starting on. In a Byte
* code context we ask the engine to provide us with the necessary
* information. This is for the initialization of the byte code compiler
* when the body is used for the first time.
*
* NOTE: The body is the second word in the 'objPtr'. Its location,
* accessible through 'context.line[1]' (see below) is therefore only the
* first approximation of the actual line the body is on. We have to use
* the string rep of the 'objPtr' to determine the exact line. This is
* available already through 'name'. Use 'TclListLines', see 'switch'
* (tclCmdMZ.c).
*
* This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see
* this file. The differences are the different index of the body in the
* line array of the context, and the special processing mentioned in the
* previous paragraph to track into the list. Find a way to factor the
* common elements into a single function.
*/
if (iPtr->cmdFramePtr) {
CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*contextPtr = *iPtr->cmdFramePtr;
if (contextPtr->type == TCL_LOCATION_BC) {
/*
* Retrieve the source context from the bytecode. This call
* accounts for the reference to the source file, if any, held in
* 'context.data.eval.path'.
*/
TclGetSrcInfoForPc(contextPtr);
} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
/*
* We created a new reference to the source file path name when we
* created 'context' above. Account for the reference.
*/
Tcl_IncrRefCount(contextPtr->data.eval.path);
}
if (contextPtr->type == TCL_LOCATION_SOURCE) {
/*
* We can record source location within a lambda only if the body
* was not created by substitution.
*/
if (contextPtr->line
&& (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
int buf[2];
/*
* Move from approximation (line of list cmd word) to actual
* location (line of 2nd list element).
*/
cfPtr = ckalloc(sizeof(CmdFrame));
TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
cfPtr->nextPtr = NULL;
cfPtr->data.eval.path = contextPtr->data.eval.path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
cfPtr->cmd.str.cmd = NULL;
cfPtr->cmd.str.len = 0;
}
/*
* 'contextPtr' is going out of scope. Release the reference that
* it's holding to the source file path
*/
Tcl_DecrRefCount(contextPtr->data.eval.path);
}
TclStackFree(interp, contextPtr);
}
Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
&isNew), cfPtr);
/*
* Set the namespace for this lambda: given by objv[2] understood as a
* global reference, or else global per default.
@@ -2749,22 +2491,6 @@ TclNRApplyObjCmd(
procPtr->cmdPtr = &extraPtr->cmd;
extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
/*
* TIP#280 (semi-)HACK!
*
* Using cmd.clientData to tell [info frame] how to render the lambdaPtr.
* The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL.
* This condition holds here because of the memset() above, and nowhere
* else (in the core). Regular commands always have a valid hPtr, and
* lambda's never.
*/
extraPtr->efi.length = 1;
extraPtr->efi.fields[0].name = "lambda";
extraPtr->efi.fields[0].proc = NULL;
extraPtr->efi.fields[0].clientData = lambdaPtr;
extraPtr->cmd.clientData = &extraPtr->efi;
isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = objv;
+1 -115
View File
@@ -17,7 +17,7 @@
enum returnKeys {
KEY_CODE, KEY_ERRORCODE, KEY_ERRORINFO, KEY_ERRORLINE,
KEY_LEVEL, KEY_OPTIONS, KEY_ERRORSTACK, KEY_LAST
KEY_LEVEL, KEY_OPTIONS, KEY_LAST
};
/*
@@ -44,8 +44,6 @@ typedef struct InterpState {
Tcl_Obj *errorCode;
Tcl_Obj *returnOpts;
Tcl_Obj *objResult;
Tcl_Obj *errorStack;
int resetErrorStack;
} InterpState;
/*
@@ -82,8 +80,6 @@ Tcl_SaveInterpState(
statePtr->returnLevel = iPtr->returnLevel;
statePtr->returnCode = iPtr->returnCode;
statePtr->errorInfo = iPtr->errorInfo;
statePtr->errorStack = iPtr->errorStack;
statePtr->resetErrorStack = iPtr->resetErrorStack;
if (statePtr->errorInfo) {
Tcl_IncrRefCount(statePtr->errorInfo);
}
@@ -95,9 +91,6 @@ Tcl_SaveInterpState(
if (statePtr->returnOpts) {
Tcl_IncrRefCount(statePtr->returnOpts);
}
if (statePtr->errorStack) {
Tcl_IncrRefCount(statePtr->errorStack);
}
statePtr->objResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(statePtr->objResult);
return (Tcl_InterpState) statePtr;
@@ -135,7 +128,6 @@ Tcl_RestoreInterpState(
iPtr->returnLevel = statePtr->returnLevel;
iPtr->returnCode = statePtr->returnCode;
iPtr->resetErrorStack = statePtr->resetErrorStack;
if (iPtr->errorInfo) {
Tcl_DecrRefCount(iPtr->errorInfo);
}
@@ -150,13 +142,6 @@ Tcl_RestoreInterpState(
if (iPtr->errorCode) {
Tcl_IncrRefCount(iPtr->errorCode);
}
if (iPtr->errorStack) {
Tcl_DecrRefCount(iPtr->errorStack);
}
iPtr->errorStack = statePtr->errorStack;
if (iPtr->errorStack) {
Tcl_IncrRefCount(iPtr->errorStack);
}
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
@@ -201,9 +186,6 @@ Tcl_DiscardInterpState(
if (statePtr->returnOpts) {
Tcl_DecrRefCount(statePtr->returnOpts);
}
if (statePtr->errorStack) {
Tcl_DecrRefCount(statePtr->errorStack);
}
Tcl_DecrRefCount(statePtr->objResult);
ckfree(statePtr);
}
@@ -941,7 +923,6 @@ Tcl_ResetResult(
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
iPtr->resetErrorStack = 1;
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
if (iPtr->returnOpts) {
@@ -1176,7 +1157,6 @@ GetKeys(void)
TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
TclNewLiteralStringObj(keys[KEY_ERRORSTACK],"-errorstack");
TclNewLiteralStringObj(keys[KEY_LEVEL], "-level");
TclNewLiteralStringObj(keys[KEY_OPTIONS], "-options");
@@ -1283,40 +1263,6 @@ TclProcessReturn(
iPtr->flags |= ERR_ALREADY_LOGGED;
}
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
&valuePtr);
if (valuePtr != NULL) {
int len, valueObjc;
Tcl_Obj **valueObjv;
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
/*
* List extraction done after duplication to avoid moving the rug
* if someone does [return -errorstack [info errorstack]]
*/
if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc,
&valueObjv) == TCL_ERROR) {
return TCL_ERROR;
}
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list intrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
valueObjv);
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
&valuePtr);
if (valuePtr != NULL) {
@@ -1480,40 +1426,6 @@ TclMergeReturnOptions(
}
}
/*
* Check for bogus -errorstack value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
if (valuePtr != NULL) {
int length;
if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorstack.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad -errorstack value: expected a list but got \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
NULL);
goto error;
}
if (length % 2) {
/*
* Errorstack must always be an even-sized list
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"forbidden odd-sized list for -errorstack: \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT",
"ODDSIZEDLIST_ERRORSTACK", NULL);
goto error;
}
}
/*
* Convert [return -code return -level X] to [return -code ok -level X+1]
*/
@@ -1591,7 +1503,6 @@ Tcl_GetReturnOptions(
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "");
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
}
if (iPtr->errorCode) {
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
@@ -1604,31 +1515,6 @@ Tcl_GetReturnOptions(
return options;
}
/*
*-------------------------------------------------------------------------
*
* TclNoErrorStack --
*
* Removes the -errorstack entry from an options dict to avoid reference
* cycles.
*
* Results:
* The (unshared) argument options dict, modified in -place.
*
*-------------------------------------------------------------------------
*/
Tcl_Obj *
TclNoErrorStack(
Tcl_Interp *interp,
Tcl_Obj *options)
{
Tcl_Obj **keys = GetKeys();
Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
return options;
}
/*
*-------------------------------------------------------------------------
*
+2 -2
View File
@@ -533,8 +533,8 @@ static const TclIntStubs tclIntStubs = {
TclPtrMakeUpvar, /* 229 */
TclObjLookupVar, /* 230 */
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
0, /* 232 */
0, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
TclBackgroundException, /* 236 */
+5 -6
View File
@@ -6800,7 +6800,7 @@ TestNRELevels(
Interp *iPtr = (Interp *) interp;
static ptrdiff_t *refDepth = NULL;
ptrdiff_t depth;
Tcl_Obj *levels[6];
Tcl_Obj *levels[5];
int i = 0;
NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
@@ -6812,18 +6812,17 @@ TestNRELevels(
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[2] = Tcl_NewIntObj(iPtr->varFramePtr->level);
levels[3] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
levels[5] = Tcl_NewIntObj(i);
levels[4] = Tcl_NewIntObj(i);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels));
return TCL_OK;
}
-3
View File
@@ -1950,9 +1950,6 @@ TclPtrSetVar(
} else {
if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
+5 -5
View File
@@ -151,7 +151,7 @@ test cmdMZ-return-2.10 {return option handling} -body {
list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
} -match glob -result {1 {-code 1 -errorcode NONE -errorinfo {
while executing
"return -level 0 -code error"} -errorline 1 -errorstack * -level 0}}
"return -level 0 -code error"} -errorline 1 -level 0}}
test cmdMZ-return-2.11 {return option handling} {
list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
} {3 {-code 3 -level 0}}
@@ -187,9 +187,9 @@ test cmdMZ-return-2.17 {return opton handling} {
} {1 c {a b}}
test cmdMZ-return-2.18 {return option handling} {
list [catch {
return -code error -errorstack [list CALL a CALL b] yo
} -> foo] [dictSort $foo] [info errorstack]
} {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}
return -code error yo
} -> foo] [dictSort $foo]
} {2 {-code 1 -errorcode NONE -level 1}}
# Check that the result of a [return -options $opts $result] is
# indistinguishable from that of the originally caught script, no matter what
@@ -208,7 +208,7 @@ foreach {testid script} {
cmdMZ-return-3.10 {return -code error -errorinfo foo}
cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz}
cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10}
cmdMZ-return-3.13 {return -options {x y z 2}}
cmdMZ-return-3.14 {return -level 3 -code break sdf}
} {
+4 -3
View File
@@ -19,6 +19,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint memory [llength [info commands memory]]
testConstraint infoframe [expr ![catch {info frame 0}]]
set lambda [list {{start 0} {stop 10}} {
# init
@@ -296,7 +297,7 @@ test coroutine-3.2 {info frame computation} -setup {
} -cleanup {
rename a {}
rename b {}
} -result 1
} -result 1 -constraints infoframe
test coroutine-3.3 {info coroutine} -setup {
proc a {} {info coroutine}
proc b {} a
@@ -341,7 +342,7 @@ test coroutine-3.6 {info frame, bug #2910094} -setup {
} -cleanup {
rename stack {}
rename a {}
} -result {}
} -result {} -constraints infoframe
test coroutine-4.1 {bug #2093188} -setup {
proc foo {} {
@@ -483,7 +484,7 @@ test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels}
}
set res {}
} -body {
set base [getNumLevel]
set base [relativeLevel 0]
lappend res [relativeLevel $base]
eval {coroutine a foo}
# back to base level
+10
View File
@@ -1568,6 +1568,8 @@ test dict-22.23 {dict with: compiled} {
}}
} 1,2
if 0 {
# TEST REMOVED: uses [info frame]
proc linenumber {} {
dict get [info frame -1] line
}
@@ -1586,6 +1588,7 @@ test dict-23.1 {dict compilation crash: Bug 3487626} {
}
}} [linenumber]}}
} 5
test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
# Something isn't quite right in line number and continuation line
# tracking; at time of writing, this test produces 7, not 5, which
@@ -1618,6 +1621,7 @@ j
}} [linenumber]}}
} 5
rename linenumber {}
}
test dict-24.1 {dict map command: syntax} -returnCodes error -body {
dict map
@@ -1802,6 +1806,9 @@ test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
concat "c=$y,$args"
}} {} 1 2 3
} {c=1,2 3}
if 0 {
# TEST REMOVED: uses [info frame]
proc linenumber {} {
dict get [info frame -1] line
}
@@ -1820,6 +1827,7 @@ test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
}
}} [linenumber]}}
} 5
test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug {
apply {{} {apply {n {
set e {}
@@ -1848,6 +1856,8 @@ j
}} [linenumber]}}
} 5
rename linenumber {}
}
test dict-24.22 {dict map results (non-compiled)} {
dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
return -level 0 "$k,$v"
-23
View File
@@ -167,19 +167,6 @@ test error-4.5 {errorInfo and errorCode variables} {
list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 {}}
test error-4.6 {errorstack via info } -body {
proc f x {g $x$x}
proc g x {error G:$x}
catch {f 12}
info errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
proc f x {g $x$x}
proc g x {error G:$x}
catch {f 12} m d
dict get $d -errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
# Errors in error command itself
test error-5.1 {errors in error command} {
@@ -234,16 +221,6 @@ test error-6.9 {catch must reset error state} {
catch foo
list $::errorCode
} {NONE}
test error-6.10 {catch must reset errorstack} -body {
proc f x {g $x$x}
proc g x {error G:$x}
catch {f 12}
set e1 [info errorstack]
catch {f 13}
set e2 [info errorstack]
list $e1 $e2
} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
test error-7.1 {Bug 1397843} -body {
variable cmds
proc EIWrite args {
+1 -1
View File
@@ -972,7 +972,7 @@ test execute-8.5 {Bug 2038069} -setup {
demo
} -cleanup {
rename demo {}
} -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO
} -match glob -result {-code 1 -level 0 -errorcode NONE -errorinfo {FOO
while executing
"error FOO"
invoked from within
+12 -4
View File
@@ -678,16 +678,24 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
## DONE!! The rest is [info frame]
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return
##
# ### ### ### ######### ######### #########
+1 -2
View File
@@ -44,7 +44,6 @@ set helperscript {
# This forces the return options to be in the order that the test expects!
variable optorder {
-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
-errorstack !?!
}
proc noteOpts opts {
variable optorder
@@ -1088,7 +1087,7 @@ proc inthread {chan script args} {
proc noteOpts opts {
lappend ::notes [dict merge {
-code !?! -level !?! -errorcode !?! -errorline !?!
-errorinfo !?! -errorstack !?!
-errorinfo !?!
} $opts]
}
}
+28 -27
View File
@@ -28,8 +28,8 @@ if {[testConstraint testnrelevels]} {
namespace eval testnre {
namespace path ::tcl::mathop
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
# cmdFrame level, callFrame level, tosPtr and callback depth
# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
# callFrame level, tosPtr and callback depth
#
variable last [testnrelevels]
proc depthDiff {} {
@@ -52,7 +52,7 @@ if {[testConstraint testnrelevels]} {
namespace upvar [namespace qualifiers \
[namespace origin depthDiff]] abs abs
incr abs [lindex [testnrelevels] 0]
return [list [lrange $x 0 3] $abs]
return [list [lrange $x 0 2] $abs]
}
}
proc makebody txt {
@@ -63,7 +63,7 @@ if {[testConstraint testnrelevels]} {
}
namespace import testnre::*
}
test nre-1.1 {self-recursive procs} -setup {
proc a i [makebody {a $i}]
} -body {
@@ -73,7 +73,7 @@ test nre-1.1 {self-recursive procs} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-1.2 {self-recursive lambdas} -setup {
set a [list i [makebody {apply $::a $i}]]
} -body {
@@ -83,7 +83,7 @@ test nre-1.2 {self-recursive lambdas} -setup {
unset a
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-1.3 {mutually recursive procs and lambdas} -setup {
proc a i {
apply $::b [incr i]
@@ -97,7 +97,7 @@ test nre-1.3 {mutually recursive procs and lambdas} -setup {
unset b
} -constraints {
testnrelevels
} -result {{0 2 2 2} 0}
} -result {{0 2 2} 0}
#
# Test that aliases are non-recursive
@@ -114,7 +114,7 @@ test nre-2.1 {alias is not recursive} -setup {
rename b {}
} -constraints {
testnrelevels
} -result {{0 2 1 1} 0}
} -result {{0 2 1} 0}
#
# Test that imports are non-recursive
@@ -134,7 +134,7 @@ test nre-3.1 {imports are not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
} -result {{0 2 1 1} 0}
} -result {{0 2 1} 0}
test nre-4.1 {ensembles are not recursive} -setup {
proc a i [makebody {b foo $i}]
@@ -149,7 +149,7 @@ test nre-4.1 {ensembles are not recursive} -setup {
rename b {}
} -constraints {
testnrelevels
} -result {{0 2 1 1} 0}
} -result {{0 2 1} 0}
test nre-5.1 {[namespace eval] is not recursive} -setup {
namespace eval ::foo {
@@ -162,7 +162,8 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
} -result {{0 2 2 2} 0}
} -result {{0 2 2} 0}
test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace eval ::foo {
setabs
@@ -174,7 +175,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
} -result {{0 2 2 2} 0}
} -result {{0 2 2} 0}
test nre-6.1 {[uplevel] is not recursive} -setup {
proc a i [makebody {uplevel 1 [list a $i]}]
@@ -185,7 +186,7 @@ test nre-6.1 {[uplevel] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
} -result {{0 2 0} 0}
test nre-6.2 {[uplevel] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "set x $i; a $i"}]
@@ -195,7 +196,7 @@ test nre-6.2 {[uplevel] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
} -result {{0 2 0} 0}
test nre-7.1 {[catch] is not recursive} -setup {
setabs
@@ -206,7 +207,7 @@ test nre-7.1 {[catch] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 3 3 0} 0}
} -result {{0 3 0} 0}
test nre-7.2 {[if] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
@@ -216,7 +217,7 @@ test nre-7.2 {[if] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
} -result {{0 2 0} 0}
test nre-7.3 {[while] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
@@ -226,7 +227,7 @@ test nre-7.3 {[while] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
} -result {{0 2 0} 0}
test nre-7.4 {[for] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
@@ -236,7 +237,7 @@ test nre-7.4 {[for] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
} -result {{0 2 0} 0}
test nre-7.5 {[foreach] is not recursive} -setup {
#
# Enable once [foreach] is NR-enabled
@@ -249,7 +250,7 @@ test nre-7.5 {[foreach] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 3 3 0} 0}
} -result {{0 3 0} 0}
test nre-7.6 {[eval] is not recursive} -setup {
proc a i [makebody {eval [list a $i]}]
} -body {
@@ -259,7 +260,7 @@ test nre-7.6 {[eval] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 1} 0}
} -result {{0 2 1} 0}
test nre-7.7 {[eval] is not recursive} -setup {
proc a i [makebody {eval "a $i"}]
} -body {
@@ -269,7 +270,7 @@ test nre-7.7 {[eval] is not recursive} -setup {
rename a {}
} -constraints {
testnrelevels
} -result {{0 2 2 1} 0}
} -result {{0 2 1} 0}
test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
proc foo args {}
foo
@@ -333,7 +334,7 @@ test nre-oo.1 {really deep calls in oo - direct} -setup {
foo destroy
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
oo::object create foo
oo::objdefine foo method bar i [makebody {[self] bar $i}]
@@ -344,7 +345,7 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
foo destroy
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-oo.3 {really deep calls in oo - private calls} -setup {
oo::object create foo
oo::objdefine foo method bar i [makebody {my bar $i}]
@@ -355,7 +356,7 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup {
foo destroy
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-oo.4 {really deep calls in oo - overriding} -setup {
oo::class create foo {
method bar i [makebody {my bar $i}]
@@ -371,7 +372,7 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup {
foo destroy
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
} -result {{0 1 1} 0}
test nre-oo.5 {really deep calls in oo - forwards} -setup {
oo::object create foo
set body [makebody {my boo $i}]
@@ -386,7 +387,7 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
foo destroy
} -constraints {
testnrelevels
} -result {{0 2 1 1} 0}
} -result {{0 2 1} 0}
#
# NASTY BUG found by tcllib's interp package
@@ -409,7 +410,7 @@ test nre-X.1 {eval in wrong interp} -setup {
} -cleanup {
interp delete $i
} -result {::foo ::foo {} {}}
# cleanup
::tcltest::cleanupTests
+4 -2
View File
@@ -13,6 +13,8 @@ if {"::tcltest" in [namespace children]} {
namespace import -force ::tcltest::*
}
testConstraint infoframe [expr ![catch {info frame 0}]]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
@@ -2610,7 +2612,7 @@ test oo-22.1 {OO and info frame} -setup {
}
}
list [i level] [i frames] [dict get [c frame] object]
} -cleanup {
} -constraints infoframe -cleanup {
c destroy
} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
test oo-22.2 {OO and info frame: Bug 3001438} -setup {
@@ -2622,7 +2624,7 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup {
info frame 0
}
[c new] test
} -match glob -cleanup {
} -match glob -constraints infoframe -cleanup {
c destroy
} -result {* cmd {info frame 0} method test class ::c level 0}
+5 -5
View File
@@ -830,12 +830,12 @@ test regexpComp-21.5 {regexp command compiling tests} {
} 0
test regexpComp-21.6 {regexp command compiling tests} {
evalInProc {
regexp -n foo dogfoOd
regexp -nocase foo dogfoOd
}
} 1
test regexpComp-21.7 {regexp command compiling tests} {
evalInProc {
regexp -no -- FoO dogfood
regexp -nocase -- FoO dogfood
}
} 1
test regexpComp-21.8 {regexp command compiling tests} {
@@ -945,13 +945,13 @@ test regexpComp-24.5 {regexp command compiling tests} {
test regexpComp-24.6 {regexp command compiling tests} {
evalInProc {
set re foo
regexp -n $re dogfoOd
regexp -nocase $re dogfoOd
}
} 1
test regexpComp-24.7 {regexp command compiling tests} {
evalInProc {
set re FoO
regexp -no -- $re dogfood
regexp -nocase -- $re dogfood
}
} 1
test regexpComp-24.8 {regexp command compiling tests} {
@@ -982,7 +982,7 @@ test regexpComp-24.11 {regexp command compiling tests} {
regexp -- $re $text
}
} 1
# cleanup
::tcltest::cleanupTests
return
-8
View File
@@ -134,14 +134,6 @@ test result-6.3 {Bug 2383005} {
catch {return -code error -errorcode {{}a} eek} m
set m
} {bad -errorcode value: expected a list but got "{}a"}
test result-6.4 {non-list -errorstack} -body {
catch {return -code error -errorstack {{}a} eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
test result-6.5 {odd-sized-list -errorstack} -body {
catch {return -code error -errorstack a eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
# cleanup
cleanupTests
return
+28 -38
View File
@@ -27,13 +27,17 @@ testConstraint testnrelevels [llength [info commands testnrelevels]]
if {[testConstraint testnrelevels]} {
namespace eval testnre {
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
# cmdFrame level, callFrame level, tosPtr and callback depth
# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
# callFrame level, tosPtr and callback depth
#
variable last [testnrelevels]
proc depthDiff {} {
variable last
set depth [testnrelevels]
if {![info exists last]} {
set last $depth
return $last
}
set res {}
foreach t $depth l $last {
lappend res [expr {$t-$l}]
@@ -57,11 +61,9 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup
# ($i==0) due to the fact that the first is from an eval. Successive
# calls should add nothing to any stack depths.
#
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
tailcall a $i
}
@@ -69,15 +71,13 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup
a 0
} -cleanup {
rename a {}
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
set a { i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
upvar 1 a a
tailcall apply $a $i
@@ -86,15 +86,13 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup
apply $a 0
} -cleanup {
unset a
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
proc a i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
tailcall b $i
}
@@ -104,18 +102,16 @@ test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup
} -cleanup {
rename a {}
rename b {}
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
namespace eval ::ns {
namespace export *
}
proc ::ns::a i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
set b [uplevel 1 [list namespace which b]]
tailcall $b $i
@@ -127,15 +123,13 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup
} -cleanup {
rename b {}
namespace delete ::ns
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
proc b i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
tailcall a b $i
}
@@ -145,18 +139,16 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup
} -cleanup {
rename a {}
rename b {}
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup {
#
# This test fails because ns-unknown is not NR-enabled
#
proc c i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
tailcall a b $i
}
@@ -170,17 +162,15 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known
rename a {}
rename c {}
rename d {}
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup {
catch {rename foo {}}
oo::class create foo {
method b i {
if {$i == 1} {
depthDiff
}
set x [depthDiff]
if {[incr i] > 10} {
return [depthDiff]
return $x
}
tailcall [self] b $i
}
@@ -191,7 +181,7 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup
} -cleanup {
rename a {}
rename foo {}
} -result {0 0 0 0 0 0}
} -result {0 0 0 0 0}
test tailcall-1 {tailcall} -body {
namespace eval a {