aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/tcl/generic/tclCompile.c
diff options
context:
space:
mode:
authorPoul-Henning Kamp <phk@FreeBSD.org>1997-10-01 13:19:13 +0000
committerPoul-Henning Kamp <phk@FreeBSD.org>1997-10-01 13:19:13 +0000
commit539e1e66ff6f99c987c8e03872ddaea5260db8f7 (patch)
treebca582e352640f318b35228d0c250ddde3bd0e0b /contrib/tcl/generic/tclCompile.c
parent3d33409926539d866dcea9fc5cb14113b312adf0 (diff)
downloadsrc-539e1e66ff6f99c987c8e03872ddaea5260db8f7.tar.gz
src-539e1e66ff6f99c987c8e03872ddaea5260db8f7.zip
Upgrade to 8.0 release.
Notes
Notes: svn path=/vendor/tcl/dist/; revision=30037
Diffstat (limited to 'contrib/tcl/generic/tclCompile.c')
-rw-r--r--contrib/tcl/generic/tclCompile.c1242
1 files changed, 803 insertions, 439 deletions
diff --git a/contrib/tcl/generic/tclCompile.c b/contrib/tcl/generic/tclCompile.c
index e8aa99cc747a..d4fad0c74c7d 100644
--- a/contrib/tcl/generic/tclCompile.c
+++ b/contrib/tcl/generic/tclCompile.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tclCompile.c 1.61 97/06/23 18:43:46
+ * SCCS: @(#) tclCompile.c 1.76 97/08/12 13:35:43
*/
#include "tclInt.h"
@@ -29,11 +29,26 @@ int tclTraceCompile = 0;
static int traceInitialized = 0;
/*
- * Count of the number of compilations.
+ * Count of the number of compilations and various other compilation-
+ * related statistics.
*/
#ifdef TCL_COMPILE_STATS
long tclNumCompilations = 0;
+double tclTotalSourceBytes = 0.0;
+double tclTotalCodeBytes = 0.0;
+
+double tclTotalInstBytes = 0.0;
+double tclTotalObjBytes = 0.0;
+double tclTotalExceptBytes = 0.0;
+double tclTotalAuxBytes = 0.0;
+double tclTotalCmdMapBytes = 0.0;
+
+double tclCurrentSourceBytes = 0.0;
+double tclCurrentCodeBytes = 0.0;
+
+int tclSourceCount[32];
+int tclByteCodeCount[32];
#endif /* TCL_COMPILE_STATS */
/*
@@ -365,6 +380,9 @@ static int CreateExceptionRange _ANSI_ARGS_((
static void DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
+static unsigned char * EncodeCmdLocMap _ANSI_ARGS_((
+ CompileEnv *envPtr, ByteCode *codePtr,
+ unsigned char *startPtr));
static void EnterCmdExtentData _ANSI_ARGS_((
CompileEnv *envPtr, int cmdNumber,
int numSrcChars, int numCodeBytes));
@@ -377,6 +395,8 @@ static void FreeForeachInfo _ANSI_ARGS_((
static void FreeByteCodeInternalRep _ANSI_ARGS_((
Tcl_Obj *objPtr));
static void FreeArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static int GetCmdLocEncodingSize _ANSI_ARGS_((
+ CompileEnv *envPtr));
static void InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
static int LookupCompiledLocal _ANSI_ARGS_((
char *name, int nameChars, int createIfNew,
@@ -421,12 +441,11 @@ TclPrintByteCodeObj(interp, objPtr)
Tcl_Obj *objPtr; /* The bytecode object to disassemble. */
{
ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- Proc *procPtr;
- CmdLocation *mapPtr;
- ExceptionRange *excRangeArrayPtr;
- unsigned char *codeStart, *codeLimit, *pc, *start;
- int numCmds, numRanges, cmd, maxChars, i;
- char *source;
+ unsigned char *codeStart, *codeLimit, *pc;
+ unsigned char *codeDeltaNext, *codeLengthNext;
+ unsigned char *srcDeltaNext, *srcLengthNext;
+ int codeOffset, codeLen, srcOffset, srcLen;
+ int numCmds, numObjs, delta, objBytes, i;
if (codePtr->refCount <= 0) {
return; /* already freed */
@@ -434,28 +453,60 @@ TclPrintByteCodeObj(interp, objPtr)
codeStart = codePtr->codeStart;
codeLimit = (codeStart + codePtr->numCodeBytes);
- source = codePtr->source;
- procPtr = codePtr->procPtr;
- numCmds = codePtr->numCommands;
- numRanges = codePtr->numExcRanges;
- mapPtr = codePtr->cmdMapPtr;
- excRangeArrayPtr = codePtr->excRangeArrayPtr;
-
- fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x, interp epoch %u\n",
+ numCmds = codePtr->numCommands;
+ numObjs = codePtr->numObjects;
+
+ objBytes = (numObjs * sizeof(Tcl_Obj));
+ for (i = 0; i < numObjs; i++) {
+ Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
+ if (litObjPtr->bytes != NULL) {
+ objBytes += litObjPtr->length;
+ }
+ }
+
+ /*
+ * Print header lines describing the ByteCode.
+ */
+
+ fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
(unsigned int) codePtr, codePtr->refCount,
codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
codePtr->iPtr->compileEpoch);
- if (procPtr != NULL) {
+ fprintf(stdout, " Source ");
+ TclPrintSource(stdout, codePtr->source,
+ TclMin(codePtr->numSrcChars, 70));
+ fprintf(stdout, "\n Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
+ numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+ codePtr->numAuxDataItems, codePtr->maxStackDepth,
+ (codePtr->numSrcChars?
+ ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
+ fprintf(stdout, " Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
+ codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
+ objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+ (codePtr->numAuxDataItems * sizeof(AuxData)),
+ codePtr->numCmdLocBytes);
+
+ /*
+ * If the ByteCode is the compiled body of a Tcl procedure, print
+ * information about that procedure. Note that we don't know the
+ * procedure's name since ByteCode's can be shared among procedures.
+ */
+
+ if (codePtr->procPtr != NULL) {
+ Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
fprintf(stdout,
- " Proc 0x%x, ref ct=%d, %d args, %d compiled locals\n",
+ " Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
(unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
for (i = 0; i < numCompiledLocals; i++) {
- fprintf(stdout, " %d: frame index=%d, flags=0x%x%s%s",
- i, localPtr->frameIndex, localPtr->flags,
+ fprintf(stdout, " %d: slot %d%s%s%s%s%s",
+ i, localPtr->frameIndex,
+ ((localPtr->flags & VAR_SCALAR)? ", scalar" : ""),
+ ((localPtr->flags & VAR_ARRAY)? ", array" : ""),
+ ((localPtr->flags & VAR_LINK)? ", link" : ""),
(localPtr->isArg? ", arg" : ""),
(localPtr->isTemp? ", temp" : ""));
if (localPtr->isTemp) {
@@ -467,21 +518,43 @@ TclPrintByteCodeObj(interp, objPtr)
}
}
}
- fprintf(stdout, " Source: ");
- TclPrintSource(stdout, source, TclMin(codePtr->numSrcChars, 70));
- fprintf(stdout, "\n Chars=%d, bytes=%u, objs=%u, stk depth=%u, exc depth=%d, aux items=%d\n",
- codePtr->numSrcChars, codePtr->numCodeBytes,
- codePtr->numObjects, codePtr->maxStackDepth,
- codePtr->maxExcRangeDepth, codePtr->numAuxDataItems);
/*
+ * Print the ExceptionRange array.
+ */
+
+ if (codePtr->numExcRanges > 0) {
+ fprintf(stdout, " Exception ranges %d, depth %d:\n",
+ codePtr->numExcRanges, codePtr->maxExcRangeDepth);
+ for (i = 0; i < codePtr->numExcRanges; i++) {
+ ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
+ fprintf(stdout, " %d: level %d, %s, pc %d-%d, ",
+ i, rangePtr->nestingLevel,
+ ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop":"catch"),
+ rangePtr->codeOffset,
+ (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+ switch (rangePtr->type) {
+ case LOOP_EXCEPTION_RANGE:
+ fprintf(stdout, "continue %d, break %d\n",
+ rangePtr->continueOffset, rangePtr->breakOffset);
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
+ break;
+ default:
+ panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
+ rangePtr->type);
+ }
+ }
+ }
+
+ /*
* If there were no commands (e.g., an expression or an empty string
- * was compiled), just print all instructions.
+ * was compiled), just print all instructions and return.
*/
if (numCmds == 0) {
- start = codeStart;
- pc = start;
+ pc = codeStart;
while (pc < codeLimit) {
fprintf(stdout, " ");
pc += TclPrintInstruction(codePtr, pc);
@@ -490,68 +563,128 @@ TclPrintByteCodeObj(interp, objPtr)
}
/*
- * Print table giving the source and object locations for each command.
+ * Print table showing the code offset, source offset, and source
+ * length for each command. These are encoded as a sequence of bytes.
*/
- fprintf(stdout, " Commands=%d\n", numCmds);
+ fprintf(stdout, " Commands %d:", numCmds);
+ codeDeltaNext = codePtr->codeDeltaStart;
+ codeLengthNext = codePtr->codeLengthStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
for (i = 0; i < numCmds; i++) {
- fprintf(stdout, " %d: source=%d-%d, code=%d-%d\n",
- (i+1), mapPtr[i].srcOffset,
- (mapPtr[i].srcOffset + mapPtr[i].numSrcChars - 1),
- mapPtr[i].codeOffset,
- (mapPtr[i].codeOffset + mapPtr[i].numCodeBytes - 1));
- }
-
- /*
- * Print the ExceptionRange array.
- */
+ if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
- fprintf(stdout, " Exception ranges=%d\n", numRanges);
- for (i = 0; i < numRanges; i++) {
- ExceptionRange *rangePtr = &(excRangeArrayPtr[i]);
- fprintf(stdout, " %d: level=%d, type=%s, pc range=%d-%d, ",
- i, rangePtr->nestingLevel,
- ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop" : "catch"),
- rangePtr->codeOffset,
- (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- fprintf(stdout, "continue=%d, break=%d\n",
- rangePtr->continueOffset, rangePtr->breakOffset);
- break;
- case CATCH_EXCEPTION_RANGE:
- fprintf(stdout, "catch=%d\n", rangePtr->catchOffset);
- break;
- default:
- fprintf(stdout, "unrecognized ExceptionRange type %d\n",
- rangePtr->type);
+ if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+ codeLengthNext++;
+ codeLen = TclGetInt4AtPtr(codeLengthNext);
+ codeLengthNext += 4;
+ } else {
+ codeLen = TclGetInt1AtPtr(codeLengthNext);
+ codeLengthNext++;
+ }
+
+ if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
}
+
+ fprintf(stdout, "%s%4d: pc %d-%d, source %d-%d",
+ ((i % 2)? " " : "\n "),
+ (i+1), codeOffset, (codeOffset + codeLen - 1),
+ srcOffset, (srcOffset + srcLen - 1));
+ }
+ if ((numCmds > 0) && ((numCmds % 2) != 0)) {
+ fprintf(stdout, "\n");
}
/*
* Print each instruction. If the instruction corresponds to the start
- * of a command, print the command's source.
+ * of a command, print the command's source. Note that we don't need
+ * the code length here.
*/
- start = codeStart;
- cmd = 0;
- pc = start;
- while (pc < codeLimit) {
- int pcOffset = (pc - start);
- while ((cmd < numCmds) && (pcOffset >= mapPtr[cmd].codeOffset)) {
- /*
- * The start of the command with index cmd.
- */
-
- maxChars = TclMin(mapPtr[cmd].numSrcChars, 70);
- fprintf(stdout, " Command %d: ", (cmd+1));
- TclPrintSource(stdout, (source + mapPtr[cmd].srcOffset),
- maxChars);
- fprintf(stdout, "\n");
- cmd++;
+ codeDeltaNext = codePtr->codeDeltaStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
+ pc = codeStart;
+ for (i = 0; i < numCmds; i++) {
+ if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ /*
+ * Print instructions before command i.
+ */
+
+ while ((pc-codeStart) < codeOffset) {
+ fprintf(stdout, " ");
+ pc += TclPrintInstruction(codePtr, pc);
+ }
+
+ fprintf(stdout, " Command %d: ", (i+1));
+ TclPrintSource(stdout, (codePtr->source + srcOffset),
+ TclMin(srcLen, 70));
+ fprintf(stdout, "\n");
+ }
+ if (pc < codeLimit) {
+ /*
+ * Print instructions after the last command.
+ */
+
+ while (pc < codeLimit) {
+ fprintf(stdout, " ");
+ pc += TclPrintInstruction(codePtr, pc);
}
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
}
}
@@ -590,7 +723,7 @@ TclPrintInstruction(codePtr, pc)
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
- opnd = TclGetInt1AtPc(pc+1+i);
+ opnd = TclGetInt1AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP1)
|| (opCode == INST_JUMP_TRUE1)
|| (opCode == INST_JUMP_FALSE1))) {
@@ -600,7 +733,7 @@ TclPrintInstruction(codePtr, pc)
}
break;
case OPERAND_INT4:
- opnd = TclGetInt4AtPc(pc+1+i);
+ opnd = TclGetInt4AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP4)
|| (opCode == INST_JUMP_TRUE4)
|| (opCode == INST_JUMP_FALSE4))) {
@@ -610,7 +743,7 @@ TclPrintInstruction(codePtr, pc)
}
break;
case OPERAND_UINT1:
- opnd = TclGetUInt1AtPc(pc+1+i);
+ opnd = TclGetUInt1AtPtr(pc+1+i);
if ((i == 0) && (opCode == INST_PUSH1)) {
elemPtr = codePtr->objArrayPtr[opnd];
string = Tcl_GetStringFromObj(elemPtr, &elemLen);
@@ -642,7 +775,7 @@ TclPrintInstruction(codePtr, pc)
}
break;
case OPERAND_UINT4:
- opnd = TclGetUInt4AtPc(pc+1+i);
+ opnd = TclGetUInt4AtPtr(pc+1+i);
if (opCode == INST_PUSH4) {
elemPtr = codePtr->objArrayPtr[opnd];
string = Tcl_GetStringFromObj(elemPtr, &elemLen);
@@ -812,6 +945,11 @@ TclCleanupByteCode(codePtr)
register Tcl_Obj *elemPtr;
register int i;
+#ifdef TCL_COMPILE_STATS
+ tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
+ tclCurrentCodeBytes -= (double) codePtr->totalSize;
+#endif /* TCL_COMPILE_STATS */
+
/*
* A single heap object holds the ByteCode structure and its code,
* object, command location, and auxiliary data arrays. This means we
@@ -864,50 +1002,54 @@ DupByteCodeInternalRep(srcPtr, copyPtr)
{
ByteCode *codePtr = (ByteCode *) srcPtr->internalRep.otherValuePtr;
register ByteCode *dupPtr;
- int codeBytes = codePtr->numCodeBytes;
- int numObjects = codePtr->numObjects;
- int numAuxDataItems = codePtr->numAuxDataItems;
register AuxData *srcAuxDataPtr, *dupAuxDataPtr;
- size_t objArrayBytes, rangeArrayBytes, cmdLocBytes, auxDataBytes;
+ size_t objArrayBytes, exceptArrayBytes, cmdLocBytes, auxDataBytes;
register size_t size;
register char *p;
- int i;
+ int codeBytes, numObjects, i;
/*
* Allocate a single heap object to hold the copied ByteCode structure
* and its code, object, command location, and auxiliary data arrays.
*/
- objArrayBytes = numObjects * sizeof(Tcl_Obj *);
- rangeArrayBytes = (codePtr->numExcRanges * sizeof(ExceptionRange));
- cmdLocBytes = codePtr->numCommands * sizeof(CmdLocation);
- auxDataBytes = numAuxDataItems * sizeof(AuxData);
-
- size = TCL_ALIGN(sizeof(ByteCode));
- size += TCL_ALIGN(codeBytes);
- size += TCL_ALIGN(objArrayBytes);
- size += TCL_ALIGN(rangeArrayBytes);
- size += TCL_ALIGN(cmdLocBytes);
- size += TCL_ALIGN(auxDataBytes);
+ codeBytes = codePtr->numCodeBytes;
+ numObjects = codePtr->numObjects;
+ objArrayBytes = (numObjects * sizeof(Tcl_Obj *));
+ exceptArrayBytes = (codePtr->numExcRanges * sizeof(ExceptionRange));
+ auxDataBytes = (codePtr->numAuxDataItems * sizeof(AuxData));
+ cmdLocBytes = codePtr->numCmdLocBytes;
+
+ size = sizeof(ByteCode);
+ size += TCL_ALIGN(codeBytes); /* align object array */
+ size += TCL_ALIGN(objArrayBytes); /* align exception range array */
+ size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+ size += auxDataBytes;
+ size += cmdLocBytes;
p = (char *) ckalloc(size);
dupPtr = (ByteCode *) p;
memcpy((VOID *) dupPtr, (VOID *) codePtr, size);
- p += TCL_ALIGN(sizeof(ByteCode));
+ p += sizeof(ByteCode);
dupPtr->codeStart = (unsigned char *) p;
- p += TCL_ALIGN(codeBytes);
+ p += TCL_ALIGN(codeBytes); /* object array is aligned */
dupPtr->objArrayPtr = (Tcl_Obj **) p;
- p += TCL_ALIGN(objArrayBytes);
+ p += TCL_ALIGN(objArrayBytes); /* exception range array is aligned */
dupPtr->excRangeArrayPtr = (ExceptionRange *) p;
- p += TCL_ALIGN(rangeArrayBytes);
- dupPtr->cmdMapPtr = (CmdLocation *) p;
-
- p += TCL_ALIGN(cmdLocBytes);
+ p += TCL_ALIGN(exceptArrayBytes); /* AuxData array is aligned */
dupPtr->auxDataArrayPtr = (AuxData *) p;
+
+ p += auxDataBytes;
+ dupPtr->codeDeltaStart = ((unsigned char *) dupPtr) +
+ (codePtr->codeDeltaStart - (unsigned char *) codePtr);
+ dupPtr->srcDeltaStart = ((unsigned char *) dupPtr) +
+ (codePtr->srcDeltaStart - (unsigned char *) codePtr);
+ dupPtr->srcLengthStart = ((unsigned char *) dupPtr) +
+ (codePtr->srcLengthStart - (unsigned char *) codePtr);
/*
* Increment the ref counts for objects in the object array since we are
@@ -924,7 +1066,7 @@ DupByteCodeInternalRep(srcPtr, copyPtr)
srcAuxDataPtr = codePtr->auxDataArrayPtr;
dupAuxDataPtr = dupPtr->auxDataArrayPtr;
- for (i = 0; i < numAuxDataItems; i++) {
+ for (i = 0; i < codePtr->numAuxDataItems; i++) {
if (srcAuxDataPtr->dupProc != NULL) {
dupAuxDataPtr->clientData =
srcAuxDataPtr->dupProc(srcAuxDataPtr->clientData);
@@ -937,6 +1079,11 @@ DupByteCodeInternalRep(srcPtr, copyPtr)
copyPtr->internalRep.otherValuePtr = (VOID *) dupPtr;
copyPtr->typePtr = &tclByteCodeType;
+
+#ifdef TCL_COMPILE_STATS
+ tclCurrentSourceBytes += (double) codePtr->numSrcChars;
+ tclCurrentCodeBytes += (double) codePtr->totalSize;
+#endif /* TCL_COMPILE_STATS */
}
/*
@@ -984,10 +1131,6 @@ SetByteCodeFromAny(interp, objPtr)
traceInitialized = 1;
}
-#ifdef TCL_COMPILE_STATS
- tclNumCompilations++;
-#endif /* TCL_COMPILE_STATS */
-
string = Tcl_GetStringFromObj(objPtr, &length);
TclInitCompileEnv(interp, &compEnv, string);
result = TclCompileString(interp, string, string+length,
@@ -1105,6 +1248,7 @@ TclInitCompileEnv(interp, envPtr, string)
envPtr->wordIsSimple = 0;
envPtr->numSimpleWordChars = 0;
envPtr->exprIsJustVarRef = 0;
+ envPtr->exprIsComparison = 0;
envPtr->termOffset = 0;
envPtr->codeStart = envPtr->staticCodeSpace;
@@ -1204,67 +1348,121 @@ TclFreeCompileEnv(envPtr)
void
TclInitByteCodeObj(objPtr, envPtr)
- Tcl_Obj *objPtr; /* Points object that should be
- * initialized, and whose string rep
- * contains the source code. */
+ Tcl_Obj *objPtr; /* Points object that should be
+ * initialized, and whose string rep
+ * contains the source code. */
register CompileEnv *envPtr; /* Points to the CompileEnv structure from
* which to create a ByteCode structure. */
{
register ByteCode *codePtr;
- size_t codeBytes, objArrayBytes, rangeArrayBytes, cmdLocBytes;
+ size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
size_t auxDataArrayBytes;
- register size_t size;
- register char *p;
+ register size_t size, objBytes, totalSize;
+ register unsigned char *p;
+ unsigned char *nextPtr;
+ int srcLen = envPtr->termOffset;
+ int numObjects, i;
+#ifdef TCL_COMPILE_STATS
+ int srcLenLog2, sizeLog2;
+#endif /*TCL_COMPILE_STATS*/
+
+ codeBytes = (envPtr->codeNext - envPtr->codeStart);
+ numObjects = envPtr->objArrayNext;
+ objArrayBytes = (envPtr->objArrayNext * sizeof(Tcl_Obj *));
+ exceptArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
+ auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
+ cmdLocBytes = GetCmdLocEncodingSize(envPtr);
+
+ size = sizeof(ByteCode);
+ size += TCL_ALIGN(codeBytes); /* align object array */
+ size += TCL_ALIGN(objArrayBytes); /* align exception range array */
+ size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+ size += auxDataArrayBytes;
+ size += cmdLocBytes;
+
+ /*
+ * Compute the total number of bytes needed for this bytecode
+ * including the storage for the Tcl objects in its object array.
+ */
+
+ objBytes = (numObjects * sizeof(Tcl_Obj));
+ for (i = 0; i < numObjects; i++) {
+ Tcl_Obj *litObjPtr = envPtr->objArrayPtr[i];
+ if (litObjPtr->bytes != NULL) {
+ objBytes += litObjPtr->length;
+ }
+ }
+ totalSize = (size + objBytes);
- codeBytes = envPtr->codeNext - envPtr->codeStart;
- objArrayBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
- rangeArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
- cmdLocBytes = envPtr->numCommands * sizeof(CmdLocation);
- auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
+#ifdef TCL_COMPILE_STATS
+ tclNumCompilations++;
+ tclTotalSourceBytes += (double) srcLen;
+ tclTotalCodeBytes += (double) totalSize;
- size = TCL_ALIGN(sizeof(ByteCode));
- size += TCL_ALIGN(codeBytes);
- size += TCL_ALIGN(objArrayBytes);
- size += TCL_ALIGN(rangeArrayBytes);
- size += TCL_ALIGN(cmdLocBytes);
- size += TCL_ALIGN(auxDataArrayBytes);
+ tclTotalInstBytes += (double) codeBytes;
+ tclTotalObjBytes += (double) objBytes;
+ tclTotalExceptBytes += exceptArrayBytes;
+ tclTotalAuxBytes += (double) auxDataArrayBytes;
+ tclTotalCmdMapBytes += (double) cmdLocBytes;
+
+ tclCurrentSourceBytes += (double) srcLen;
+ tclCurrentCodeBytes += (double) totalSize;
+
+ srcLenLog2 = TclLog2(srcLen);
+ sizeLog2 = TclLog2((int) totalSize);
+ if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
+ panic("TclInitByteCodeObj: bad source or code sizes\n");
+ }
+ tclSourceCount[srcLenLog2]++;
+ tclByteCodeCount[sizeLog2]++;
+#endif /* TCL_COMPILE_STATS */
- p = (char *) ckalloc(size);
+ p = (unsigned char *) ckalloc(size);
codePtr = (ByteCode *) p;
codePtr->iPtr = envPtr->iPtr;
codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
codePtr->refCount = 1;
codePtr->source = envPtr->source;
codePtr->procPtr = envPtr->procPtr;
+ codePtr->totalSize = totalSize;
codePtr->numCommands = envPtr->numCommands;
- codePtr->numSrcChars = envPtr->termOffset;
+ codePtr->numSrcChars = srcLen;
codePtr->numCodeBytes = codeBytes;
- codePtr->numObjects = envPtr->objArrayNext;
+ codePtr->numObjects = numObjects;
codePtr->numExcRanges = envPtr->excRangeArrayNext;
codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
+ codePtr->numCmdLocBytes = cmdLocBytes;
codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
codePtr->maxStackDepth = envPtr->maxStackDepth;
- p += TCL_ALIGN(sizeof(ByteCode));
- codePtr->codeStart = (unsigned char *) p;
+ p += sizeof(ByteCode);
+ codePtr->codeStart = p;
memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
- p += TCL_ALIGN(codeBytes);
+ p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);
-
- p += TCL_ALIGN(objArrayBytes);
- codePtr->excRangeArrayPtr = (ExceptionRange *) p;
- memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr, rangeArrayBytes);
-
- p += TCL_ALIGN(rangeArrayBytes);
- codePtr->cmdMapPtr = (CmdLocation *) p;
- memcpy((VOID *) p, (VOID *) envPtr->cmdMapPtr, cmdLocBytes);
- p += TCL_ALIGN(cmdLocBytes);
- codePtr->auxDataArrayPtr = (AuxData *) p;
- memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr, auxDataArrayBytes);
+ p += TCL_ALIGN(objArrayBytes); /* align exception range array */
+ if (exceptArrayBytes > 0) {
+ codePtr->excRangeArrayPtr = (ExceptionRange *) p;
+ memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr,
+ exceptArrayBytes);
+ }
+
+ p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+ if (auxDataArrayBytes > 0) {
+ codePtr->auxDataArrayPtr = (AuxData *) p;
+ memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
+ auxDataArrayBytes);
+ }
+ p += auxDataArrayBytes;
+ nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
+ if (((size_t)(nextPtr - p)) != cmdLocBytes) {
+ panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
+ }
+
/*
* Free the old internal rep then convert the object to a
* bytecode object by making its internal rep point to the just
@@ -1282,6 +1480,204 @@ TclInitByteCodeObj(objPtr, envPtr)
/*
*----------------------------------------------------------------------
*
+ * GetCmdLocEncodingSize --
+ *
+ * Computes the total number of bytes needed to encode the command
+ * location information for some compiled code.
+ *
+ * Results:
+ * The byte count needed to encode the compiled location information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCmdLocEncodingSize(envPtr)
+ CompileEnv *envPtr; /* Points to compilation environment
+ * structure containing the CmdLocation
+ * structure to encode. */
+{
+ register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+ int numCmds = envPtr->numCommands;
+ int codeDelta, codeLen, srcDelta, srcLen;
+ int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
+ /* The offsets in their respective byte
+ * sequences where the next encoded offset
+ * or length should go. */
+ int prevCodeOffset, prevSrcOffset, i;
+
+ codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
+ prevCodeOffset = prevSrcOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
+ if (codeDelta < 0) {
+ panic("GetCmdLocEncodingSize: bad code offset");
+ } else if (codeDelta <= 127) {
+ codeDeltaNext++;
+ } else {
+ codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */
+ }
+ prevCodeOffset = mapPtr[i].codeOffset;
+
+ codeLen = mapPtr[i].numCodeBytes;
+ if (codeLen < 0) {
+ panic("GetCmdLocEncodingSize: bad code length");
+ } else if (codeLen <= 127) {
+ codeLengthNext++;
+ } else {
+ codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ }
+
+ srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
+ if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ srcDeltaNext++;
+ } else {
+ srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */
+ }
+ prevSrcOffset = mapPtr[i].srcOffset;
+
+ srcLen = mapPtr[i].numSrcChars;
+ if (srcLen < 0) {
+ panic("GetCmdLocEncodingSize: bad source length");
+ } else if (srcLen <= 127) {
+ srcLengthNext++;
+ } else {
+ srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ }
+ }
+
+ return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodeCmdLocMap --
+ *
+ * Encode the command location information for some compiled code into
+ * a ByteCode structure. The encoded command location map is stored as
+ * three adjacent byte sequences.
+ *
+ * Results:
+ * Pointer to the first byte after the encoded command location
+ * information.
+ *
+ * Side effects:
+ * The encoded information is stored into the block of memory headed
+ * by codePtr. Also records pointers to the start of the four byte
+ * sequences in fields in codePtr's ByteCode header structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned char *
+EncodeCmdLocMap(envPtr, codePtr, startPtr)
+ CompileEnv *envPtr; /* Points to compilation environment
+ * structure containing the CmdLocation
+ * structure to encode. */
+ ByteCode *codePtr; /* ByteCode in which to encode envPtr's
+ * command location information. */
+ unsigned char *startPtr; /* Points to the first byte in codePtr's
+ * memory block where the location
+ * information is to be stored. */
+{
+ register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+ int numCmds = envPtr->numCommands;
+ register unsigned char *p = startPtr;
+ int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
+ register int i;
+
+ /*
+ * Encode the code offset for each command as a sequence of deltas.
+ */
+
+ codePtr->codeDeltaStart = p;
+ prevOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ codeDelta = (mapPtr[i].codeOffset - prevOffset);
+ if (codeDelta < 0) {
+ panic("EncodeCmdLocMap: bad code offset");
+ } else if (codeDelta <= 127) {
+ TclStoreInt1AtPtr(codeDelta, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(codeDelta, p);
+ p += 4;
+ }
+ prevOffset = mapPtr[i].codeOffset;
+ }
+
+ /*
+ * Encode the code length for each command.
+ */
+
+ codePtr->codeLengthStart = p;
+ for (i = 0; i < numCmds; i++) {
+ codeLen = mapPtr[i].numCodeBytes;
+ if (codeLen < 0) {
+ panic("EncodeCmdLocMap: bad code length");
+ } else if (codeLen <= 127) {
+ TclStoreInt1AtPtr(codeLen, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(codeLen, p);
+ p += 4;
+ }
+ }
+
+ /*
+ * Encode the source offset for each command as a sequence of deltas.
+ */
+
+ codePtr->srcDeltaStart = p;
+ prevOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ srcDelta = (mapPtr[i].srcOffset - prevOffset);
+ if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ TclStoreInt1AtPtr(srcDelta, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(srcDelta, p);
+ p += 4;
+ }
+ prevOffset = mapPtr[i].srcOffset;
+ }
+
+ /*
+ * Encode the source length for each command.
+ */
+
+ codePtr->srcLengthStart = p;
+ for (i = 0; i < numCmds; i++) {
+ srcLen = mapPtr[i].numSrcChars;
+ if (srcLen < 0) {
+ panic("EncodeCmdLocMap: bad source length");
+ } else if (srcLen <= 127) {
+ TclStoreInt1AtPtr(srcLen, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(srcLen, p);
+ p += 4;
+ }
+ }
+
+ return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileString --
*
* Compile a Tcl script in a null-terminated binary string.
@@ -1308,8 +1704,8 @@ int
TclCompileString(interp, string, lastChar, flags, envPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
+ char *lastChar; /* Pointer to terminating character of
+ * string. */
int flags; /* Flags to control compilation (same as
* passed to Tcl_Eval). */
CompileEnv *envPtr; /* Holds resulting instructions. */
@@ -1326,7 +1722,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
char *cmdSrcStart = NULL; /* Points to first non-blank char in each
* command. Initialized to avoid compiler
* warning. */
- int cmdIndex = -1; /* The index of the current command in the
+ int cmdIndex; /* The index of the current command in the
* compilation environment's command
* location table. Initialized to avoid
* compiler warning. */
@@ -1379,7 +1775,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
if (src[1] == '\n') {
src += 2;
} else {
- break; /* no longer white space */
+ break;
}
} else {
src++;
@@ -1418,7 +1814,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
type = CHAR_TYPE(src, lastChar);
if ((type == TCL_COMMAND_END)
&& ((c != ']') || (flags & TCL_BRACKET_TERM))) {
- continue; /* ignore empty command; restart outer cmd loop */
+ continue; /* empty command; restart outer cmd loop */
}
/*
@@ -1449,45 +1845,42 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
* of compilation procedures. If a word other than the first is
* simple and represents an integer whose formatted representation
* is the same as the word, just push an integer object. Also record
- * starting source and object information for the command if we are
- * at the top level (i.e. we were called directly from
- * SetByteCodeFromAny and are not compiling a substring enclosed in
- * square brackets).
+ * starting source and object information for the command.
*/
cmdSrcStart = src;
cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
cmdWords = 0;
- if (!(flags & TCL_BRACKET_TERM)) {
- envPtr->numCommands++;
- cmdIndex = (envPtr->numCommands - 1);
- EnterCmdStartData(envPtr, cmdIndex,
- (cmdSrcStart - envPtr->source), cmdCodeOffset);
+
+ envPtr->numCommands++;
+ cmdIndex = (envPtr->numCommands - 1);
+ EnterCmdStartData(envPtr, cmdIndex,
+ (cmdSrcStart - envPtr->source), cmdCodeOffset);
- if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
- /*
- * Display a line summarizing the top level command we
- * are about to compile.
- */
-
- char *p = cmdSrcStart;
- int numChars;
- char *ellipsis = "";
-
- while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
- || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
- p++;
- }
- numChars = (p - cmdSrcStart);
- if (numChars > 60) {
- numChars = 60;
- ellipsis = " ...";
- } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
- ellipsis = " ...";
- }
- fprintf(stdout, "Compiling: %.*s%s\n",
- numChars, cmdSrcStart, ellipsis);
+ if ((!(flags & TCL_BRACKET_TERM))
+ && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+ /*
+ * Display a line summarizing the top level command we are about
+ * to compile.
+ */
+
+ char *p = cmdSrcStart;
+ int numChars, complete;
+
+ while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+ || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+ p++;
+ }
+ numChars = (p - cmdSrcStart);
+ complete = 1;
+ if (numChars > 60) {
+ numChars = 60;
+ complete = 0;
+ } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+ complete = 0;
}
+ fprintf(stdout, "Compiling: %.*s%s\n",
+ numChars, cmdSrcStart, (complete? "" : " ..."));
}
while ((type != TCL_COMMAND_END)
@@ -1502,7 +1895,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
if (src[1] == '\n') {
src += 2;
} else {
- break; /* no longer white space */
+ break;
}
} else {
src++;
@@ -1520,9 +1913,9 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
* avoid an extra procedure call.
*/
- envPtr->pushSimpleWords = 0; /* we will handle simple words */
+ envPtr->pushSimpleWords = 0;
if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++; /* advance over the " or { */
+ src++;
if (type == TCL_QUOTE) {
result = TclCompileQuotes(interp, src, lastChar,
'"', flags, envPtr);
@@ -1590,18 +1983,29 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
* traces). Look up the first word in the interpreter's
* hashtable of commands. If a compilation procedure is
* found, let it compile the command after resetting
- * error logging information.
+ * error logging information. Note that if we are
+ * compiling a procedure, we must look up the command
+ * in the procedure's namespace and not the current
+ * namespace.
*/
+ Namespace *cmdNsPtr;
+
+ if (envPtr->procPtr != NULL) {
+ cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+ } else {
+ cmdNsPtr = NULL;
+ }
+
cmdPtr = NULL;
cmd = Tcl_FindCommand(interp, src,
- (Tcl_Namespace *) NULL, /*flags*/ 0);
+ (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
if (cmd != (Tcl_Command) NULL) {
cmdPtr = (Command *) cmd;
}
if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
char *firstArg = termPtr;
- src[numChars] = savedChar; /* restore chr */
+ src[numChars] = savedChar;
iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
| ERROR_CODE_SET);
result = (*(cmdPtr->compileProc))(interp,
@@ -1609,9 +2013,9 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
if (result == TCL_OK) {
src = (firstArg + envPtr->termOffset);
maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- goto finishCommand; /* done with command */
+ goto finishCommand;
} else if (result == TCL_OUT_LINE_COMPILE) {
- result = TCL_OK; /* reset result */
+ result = TCL_OK;
src[numChars] = '\0';
} else {
src = firstArg;
@@ -1652,8 +2056,9 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
resPtr->refNsCmdEpoch = nsPtr->cmdRefEpoch;
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
resPtr->refCount = 1;
- objPtr->internalRep.otherValuePtr =
- (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 =
+ (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
cmdPtr->refCount++;
}
@@ -1671,7 +2076,8 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
char buf[40];
if (TclLooksLikeInt(src)) {
- if (TclGetLong(interp, src, &n) == TCL_OK) {
+ int code = TclGetLong(interp, src, &n);
+ if (code == TCL_OK) {
TclFormatInt(buf, n);
if (strcmp(src, buf) == 0) {
isCompilableInt = 1;
@@ -1684,6 +2090,8 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
objPtr->internalRep.longValue = n;
objPtr->typePtr = &tclIntType;
}
+ } else {
+ Tcl_ResetResult(interp);
}
}
if (!isCompilableInt) {
@@ -1691,7 +2099,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
}
}
- src[numChars] = savedChar; /* restore the saved char */
+ src[numChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = TclMax((cmdWords + 1), maxDepth);
} else { /* not a simple word */
@@ -1709,13 +2117,6 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
* was found for the command we called it and skipped this.
*/
-#ifdef TCL_COMPILE_DEBUG
- if ((cmdWords < 0) || (cmdWords > 10000)) {
- fprintf(stderr, "\nTclCompileString: bad cmdWords value %d\n",
- cmdWords);
- panic("TclCompileString: bad cmdWords value %d");
- }
-#endif /*TCL_COMPILE_DEBUG*/
if (cmdWords > 0) {
if (cmdWords <= 255) {
TclEmitInstUInt1(INST_INVOKE_STK1, cmdWords, envPtr);
@@ -1726,18 +2127,13 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
/*
* Update the compilation environment structure. Record
- * source/object information for the command if we are at the top
- * level (i.e. we we called directly from SetByteCodeFromAny and are
- * not compiling a substring enclosed in square brackets).
+ * source/object information for the command.
*/
finishCommand:
- if (!(flags & TCL_BRACKET_TERM)) {
- int cmdSrcChars = (src - cmdSrcStart);
- cmdCodeBytes =
- (envPtr->codeNext - envPtr->codeStart - cmdCodeOffset);
- EnterCmdExtentData(envPtr, cmdIndex, cmdSrcChars, cmdCodeBytes);
- }
+ cmdCodeBytes = envPtr->codeNext - envPtr->codeStart - cmdCodeOffset;
+ EnterCmdExtentData(envPtr, cmdIndex, src-cmdSrcStart, cmdCodeBytes);
+
isFirstCmd = 0;
envPtr->termOffset = (src - string);
c = *src;
@@ -1754,7 +2150,7 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
/*inHeap*/ 0, envPtr);
TclEmitPush(objIndex, envPtr);
- maxDepth = 1; /* we pushed 1 word for the empty string */
+ maxDepth = 1;
}
} else {
/*
@@ -1762,8 +2158,8 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
* where the error occurred.
*/
- int numChars;
register char *p;
+ int numChars;
char buf[200];
iPtr->errorLine = 1;
@@ -1780,14 +2176,22 @@ TclCompileString(interp, string, lastChar, flags, envPtr)
/*
* Figure out how much of the command to print (up to a certain
- * number of characters, or up to the first newline).
+ * number of characters, or up to the end of the command).
*/
- numChars = (src - cmdSrcStart);
+ p = cmdSrcStart;
+ while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+ || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+ p++;
+ }
+ numChars = (p - cmdSrcStart);
if (numChars > 150) {
numChars = 150;
ellipsis = " ...";
+ } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+ ellipsis = " ...";
}
+
sprintf(buf, "\n while compiling\n\"%.*s%s\"",
numChars, cmdSrcStart, ellipsis);
Tcl_AddObjErrorInfo(interp, buf, -1);
@@ -1902,7 +2306,7 @@ CompileWord(interp, string, lastChar, flags, envPtr)
*/
if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++; /* advance over the " or { */
+ src++;
if (type == TCL_QUOTE) {
result = TclCompileQuotes(interp, src, lastChar, '"', flags,
envPtr);
@@ -2080,7 +2484,7 @@ CompileMultipartWord(interp, string, lastChar, flags, envPtr)
if (src[1] == '\n') {
src += numRead;
type = TCL_SPACE; /* force word end */
- break; /* exit loop: \newline is word separator */
+ break;
}
src += numRead;
} else {
@@ -2131,7 +2535,7 @@ CompileMultipartWord(interp, string, lastChar, flags, envPtr)
if (*p == '\\') {
*dst = Tcl_Backslash(p, &numRead);
if (p[1] == '\n') {
- break; /* end of word */
+ break;
}
p += numRead;
dst++;
@@ -2146,7 +2550,7 @@ CompileMultipartWord(interp, string, lastChar, flags, envPtr)
objIndex = TclObjIndexForString(start, numChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
}
- start[numChars] = savedChar; /* restore the saved char */
+ start[numChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = TclMax((numParts + 1), maxDepth);
} else if (type == TCL_DOLLAR) {
@@ -2167,7 +2571,7 @@ CompileMultipartWord(interp, string, lastChar, flags, envPtr)
(flags | TCL_BRACKET_TERM), envPtr);
termPtr = (src + envPtr->termOffset);
if (*termPtr == ']') {
- termPtr++; /* advance over the ']'. */
+ termPtr++;
} else if (*termPtr == '\0') {
/*
* Missing ] at end of nested command.
@@ -2327,7 +2731,7 @@ TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
(flags | TCL_BRACKET_TERM), envPtr);
termPtr = (src + envPtr->termOffset);
if (*termPtr == ']') {
- termPtr++; /* advance over the ']'. */
+ termPtr++;
}
src = termPtr;
if (result != TCL_OK) {
@@ -2384,7 +2788,7 @@ TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
result = TCL_ERROR;
} else {
- src++; /* advance over termChar */
+ src++;
}
envPtr->wordIsSimple = 1;
envPtr->numSimpleWordChars = (src - string - 1);
@@ -2425,7 +2829,7 @@ TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
objIndex = TclObjIndexForString(start, numChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
}
- start[numChars] = savedChar; /* restore the saved char */
+ start[numChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = TclMax((numParts + 1), maxDepth);
}
@@ -2445,7 +2849,7 @@ TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
result = TCL_ERROR;
goto done;
} else {
- src++; /* advance over termChar */
+ src++;
}
if (numParts == 0) {
@@ -2577,8 +2981,7 @@ CompileBraces(interp, string, lastChar, flags, envPtr)
--level;
if (level == 0) {
src++;
- last = (src - 2); /* i.e. point just before
- * terminating } */
+ last = (src - 2); /* point just before terminating } */
break;
}
} else if (c == '\\') {
@@ -2645,7 +3048,7 @@ CompileBraces(interp, string, lastChar, flags, envPtr)
objIndex = TclObjIndexForString(string, numChars, /*allocStrRep*/ 1,
/*inHeap*/ 0, envPtr);
}
- string[numChars] = savedChar; /* restore the saved char */
+ string[numChars] = savedChar;
TclEmitPush(objIndex, envPtr);
done:
@@ -2755,7 +3158,7 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
char *p;
- src++; /* advance over the '{'. */
+ src++;
name = src;
c = *src;
while (c != '}') {
@@ -2788,9 +3191,9 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
if (c == ':') {
if (*(src+1) == ':') {
nameHasNsSeparators = 1;
- src += 2; /* skip over the initial :: */
+ src += 2;
while (*src == ':') {
- src++; /* skip over a subsequent : */
+ src++;
}
c = *src;
} else {
@@ -2826,11 +3229,11 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
if (!isArrayRef) { /* scalar reference */
if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars]; /* save char just after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
maxDepth = 1;
@@ -2846,11 +3249,11 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
}
maxDepth = 0;
} else {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
maxDepth = 1;
@@ -2858,11 +3261,11 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
}
} else { /* array reference */
if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
} else {
@@ -2870,11 +3273,11 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
/*createIfNew*/ 0, /*flagsIfCreated*/ 0,
envPtr->procPtr);
if (localIndex < 0) {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
}
@@ -2885,11 +3288,11 @@ TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
* just as is done for quoted strings.
*/
- src++; /* advance over the '(' */
+ src++;
envPtr->pushSimpleWords = 1;
result = TclCompileQuotes(interp, src, lastChar, ')', flags,
envPtr);
- src += envPtr->termOffset; /* advance beyond the terminating ) */
+ src += envPtr->termOffset;
if (result != TCL_OK) {
char msg[200];
sprintf(msg, "\n (parsing index for array \"%.*s\")",
@@ -3122,7 +3525,7 @@ TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
if (*p == '(') {
if (*lastChar == ')') { /* we have an array element */
result = TCL_OUT_LINE_COMPILE;
- goto done; /* only scalar loop vars for now */
+ goto done;
}
}
p++;
@@ -3165,11 +3568,11 @@ TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
bodyStart = argInfo.startArray[0];
bodyEnd = argInfo.endArray[0];
- savedChar = *(bodyEnd+1); /* save char after body */
+ savedChar = *(bodyEnd+1);
*(bodyEnd+1) = '\0';
result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
flags, envPtr);
- *(bodyEnd+1) = savedChar; /* restore the saved char */
+ *(bodyEnd+1) = savedChar;
if (result != TCL_OK) {
if (result == TCL_ERROR) {
@@ -3199,7 +3602,7 @@ TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
}
}
- TclEmitOpcode(INST_POP, envPtr); /* pop the result */
+ TclEmitOpcode(INST_POP, envPtr);
objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0, /*inHeap*/ 0,
envPtr);
@@ -3224,14 +3627,7 @@ TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
* catch's error target.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
- panic("TclCompileCatchCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /*TCL_COMPILE_DEBUG*/
envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
-
if (localIndex != -1) {
TclEmitOpcode(INST_PUSH_RESULT, envPtr);
if (localIndex <= 255) {
@@ -3239,7 +3635,7 @@ TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
} else {
TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
}
- TclEmitOpcode(INST_POP, envPtr); /* pop the result */
+ TclEmitOpcode(INST_POP, envPtr);
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
@@ -3405,6 +3801,7 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
char c;
int savePushSimpleWords = envPtr->pushSimpleWords;
int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+ int saveExprIsComparison = envPtr->exprIsComparison;
/*
* Scan the words of the command and record the start and finish of
@@ -3458,10 +3855,10 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
* Simple case: a single argument word in {}'s.
*/
- *wordEnd = '\0'; /* temporarily replace the '}' by a null */
+ *wordEnd = '\0';
result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
flags, envPtr);
- *wordEnd = '}'; /* restore the '}' */
+ *wordEnd = '}';
envPtr->termOffset = (wordEnd + 1) - string;
envPtr->pushSimpleWords = savePushSimpleWords;
@@ -3529,7 +3926,7 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
envPtr->excRangeDepth++;
envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+ TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
@@ -3539,23 +3936,36 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
savedChar = *(last + 1);
- *(last + 1) = '\0'; /* replace term. char with null */
+ *(last + 1) = '\0';
result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
- *(last + 1) = savedChar; /* restore the saved char */
+ *(last + 1) = savedChar;
maxDepth = envPtr->maxStackDepth;
envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+ TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
- if ((envPtr->exprIsJustVarRef) || (result != TCL_OK)) {
+ if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+ || (envPtr->exprIsComparison)) {
/*
- * We must call the expr command at runtime since the expression
- * consisted of just a single variable reference (and a second
- * round of substitutions might be needed) or there was a
- * compilation error. Delete the inline code by backing up the
- * code pc and catch index. Note that if there was a compilation
- * error, we can't report the error yet since the expression
- * might be valid after the second round of substitutions.
+ * We must call the expr command at runtime. Either there was a
+ * compilation error or the inline code might fail to give the
+ * correct 2 level substitution semantics.
+ *
+ * The latter can happen if the expression consisted of just a
+ * single variable reference or if the top-level operator in the
+ * expr is a comparison (which might operate on strings). In the
+ * latter case, the expression's code might execute (apparently)
+ * successfully but produce the wrong result. We depend on its
+ * execution failing if a second level of substitutions is
+ * required. This causes the "catch" code we generate around the
+ * inline code to back off to a call on the expr command at
+ * runtime, and this always gives the right 2 level substitution
+ * semantics.
+ *
+ * We delete the inline code by backing up the code pc and catch
+ * index. Note that if there was a compilation error, we can't
+ * report the error yet since the expression might be valid
+ * after the second round of substitutions.
*/
envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
@@ -3579,10 +3989,10 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
wordStart = argInfo.startArray[i];
wordEnd = argInfo.endArray[i];
savedChar = *(wordEnd + 1);
- *(wordEnd + 1) = '\0'; /* replace term. char with null */
+ *(wordEnd + 1) = '\0';
envPtr->pushSimpleWords = 1;
result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
- *(wordEnd + 1) = savedChar; /* restore the saved char */
+ *(wordEnd + 1) = savedChar;
if (result != TCL_OK) {
break;
}
@@ -3620,13 +4030,6 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
* target since it, being after the jump, also moved down.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
- panic("TclCompileExprCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
envPtr->excRangeArrayPtr[range].catchOffset += 3;
}
}
@@ -3643,6 +4046,7 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
}
envPtr->pushSimpleWords = savePushSimpleWords;
envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+ envPtr->exprIsComparison = saveExprIsComparison;
envPtr->maxStackDepth = maxDepth;
FreeArgInfo(&argInfo);
return result;
@@ -3849,13 +4253,6 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
jumpBackOffset = TclCurrCodeOffset();
jumpBackDist = (jumpBackOffset - testCodeOffset);
-#ifdef TCL_COMPILE_DEBUG
- if (jumpBackDist > MAX_JUMP_DIST) {
- fprintf(stderr, "\nTclCompileForCmd: bad distance %u for unconditional jump\n",
- jumpBackDist);
- panic("TclCompileForCmd: bad distance for unconditional jump");
- }
-#endif /*TCL_COMPILE_DEBUG*/
if (jumpBackDist > 120) {
TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
} else {
@@ -3878,12 +4275,6 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
* record since it also moved down.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range1].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileForCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range1].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
envPtr->excRangeArrayPtr[range1].codeOffset += 3;
envPtr->excRangeArrayPtr[range1].continueOffset += 3;
envPtr->excRangeArrayPtr[range2].codeOffset += 3;
@@ -3911,12 +4302,6 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
* is the loop's break target.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range1].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileForCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range1].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
envPtr->excRangeArrayPtr[range1].breakOffset =
envPtr->excRangeArrayPtr[range2].breakOffset = TclCurrCodeOffset();
@@ -3928,7 +4313,7 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
envPtr);
TclEmitPush(objIndex, envPtr);
if (maxDepth == 0) {
- maxDepth = 1; /* since we just pushed one object */
+ maxDepth = 1;
}
done:
@@ -4104,11 +4489,11 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
* NOTE: THIS NEEDS TO BE CONVERTED TO AN OBJECT LIST.
*/
- savedChar = *(varListEnd+1); /* save char after var list */
+ savedChar = *(varListEnd+1);
*(varListEnd+1) = '\0';
result = Tcl_SplitList(interp, varListStart,
&varcList[i], &varvList[i]);
- *(varListEnd+1) = savedChar; /* restore the saved char */
+ *(varListEnd+1) = savedChar;
if (result != TCL_OK) {
goto done;
}
@@ -4135,7 +4520,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
q--;
if (*q == ')') { /* we have an array element */
result = TCL_OUT_LINE_COMPILE;
- goto done; /* only scalar loop vars for now */
+ goto done;
}
}
p++;
@@ -4224,7 +4609,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
} else {
TclEmitInstUInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
}
- TclEmitOpcode(INST_POP, envPtr); /* no longer need list on the stk */
+ TclEmitOpcode(INST_POP, envPtr);
}
/*
@@ -4257,12 +4642,12 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
bodyStart = argInfo.startArray[numWords - 1];
bodyEnd = argInfo.endArray[numWords - 1];
- savedChar = *(bodyEnd+1); /* save char after body */
+ savedChar = *(bodyEnd+1);
*(bodyEnd+1) = '\0';
envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
envPtr);
- *(bodyEnd+1) = savedChar; /* restore the saved char */
+ *(bodyEnd+1) = savedChar;
if (result != TCL_OK) {
if (result == TCL_ERROR) {
char msg[60];
@@ -4293,12 +4678,6 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
jumpBackOffset = TclCurrCodeOffset();
jumpBackDist =
(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
-#ifdef TCL_COMPILE_DEBUG
- if (jumpBackDist > MAX_JUMP_DIST) {
- fprintf(stderr, "\nTclCompileForeachCmd: bad distance %u for unconditional jump\n", jumpBackDist);
- panic("TclCompileForeachCmd: bad distance for unconditional jump");
- }
-#endif /*TCL_COMPILE_DEBUG*/
if (jumpBackDist > 120) {
TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
} else {
@@ -4318,12 +4697,6 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
* Update the loop body's starting PC offset since it moved down.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileForeachCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /*TCL_COMPILE_DEBUG*/
envPtr->excRangeArrayPtr[range].codeOffset += 3;
/*
@@ -4349,12 +4722,6 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
* break target.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileForeachCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /*TCL_COMPILE_DEBUG*/
envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
/*
@@ -4365,7 +4732,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
envPtr);
TclEmitPush(objIndex, envPtr);
if (maxDepth == 0) {
- maxDepth = 1; /* since we just pushed one object */
+ maxDepth = 1;
}
done:
@@ -4541,7 +4908,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
* a script to execute if the expression is true.
*/
- AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+ AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type == TCL_COMMAND_END) {
@@ -4557,7 +4924,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
*/
testSrcStart = src;
- envPtr->pushSimpleWords = 1; /* process words normally */
+ envPtr->pushSimpleWords = 1;
result = CompileExprWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
@@ -4602,7 +4969,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
if ((*src == 't') && (strncmp(src, "then", 4) == 0)) {
type = CHAR_TYPE(src+4, lastChar);
if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 4; /* skip over the "then" */
+ src += 4;
AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
@@ -4623,7 +4990,10 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"if\" body script)", -1);
+ char msg[60];
+ sprintf(msg, "\n (\"if\" then script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
}
goto done;
}
@@ -4676,7 +5046,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
&& ((*src == 'e') && (strncmp(src, "elseif", 6) == 0))) {
type = CHAR_TYPE(src+6, lastChar);
if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 6; /* skip over the "elseif" */
+ src += 6;
AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
@@ -4690,7 +5060,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
continue; /* continue the "expr then body" loop */
}
}
- break; /* exit the loop */
+ break;
} /* end of the "expr then body" loop */
/*
@@ -4702,7 +5072,7 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
if ((*src == 'e') && (strncmp(src, "else", 4) == 0)) {
type = CHAR_TYPE(src+4, lastChar);
if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 4; /* skip over the "else" */
+ src += 4;
AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
@@ -4723,7 +5093,10 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"if\" else script)", -1);
+ char msg[60];
+ sprintf(msg, "\n (\"if\" else script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
}
goto done;
}
@@ -4780,13 +5153,13 @@ TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
ifFalsePc = (envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
opCode = *ifFalsePc;
if (opCode == INST_JUMP_FALSE1) {
- jumpFalseDist = TclGetInt1AtPc(ifFalsePc + 1);
+ jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
jumpFalseDist += 3;
- TclUpdateInt1AtPc(jumpFalseDist, (ifFalsePc + 1));
+ TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
} else if (opCode == INST_JUMP_FALSE4) {
- jumpFalseDist = TclGetInt4AtPc(ifFalsePc + 1);
+ jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
jumpFalseDist += 3;
- TclUpdateInt4AtPc(jumpFalseDist, (ifFalsePc + 1));
+ TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
} else {
panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
}
@@ -4886,7 +5259,7 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
* an optional "elName". Otherwise, if not simple, just push the name.
*/
- AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+ AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type == TCL_COMMAND_END) {
@@ -4898,7 +5271,7 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
goto done;
}
- envPtr->pushSimpleWords = 0; /* we will process the varName */
+ envPtr->pushSimpleWords = 0;
result = CompileWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
goto done;
@@ -4908,7 +5281,7 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
name = src;
nameChars = envPtr->numSimpleWordChars;
if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- name++; /* advance over the " or { */
+ name++;
}
elName = NULL;
elNameChars = 0;
@@ -4955,11 +5328,11 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
if (simpleVarName) {
if (procPtr == NULL) {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
} else {
@@ -4970,11 +5343,11 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
if (localIndex > 255) { /* we'll push the name */
localIndex = -1;
}
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
} else {
@@ -4988,12 +5361,12 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
* substitutions on it, just as is done for quoted strings.
*/
- savedChar = elName[elNameChars]; /* save char after elName */
+ savedChar = elName[elNameChars];
elName[elNameChars] = '\0';
envPtr->pushSimpleWords = 1;
result = TclCompileQuotes(interp, elName, elName+elNameChars,
0, flags, envPtr);
- elName[elNameChars] = savedChar; /* restore the saved char */
+ elName[elNameChars] = savedChar;
if (result != TCL_OK) {
char msg[200];
sprintf(msg, "\n (parsing index for array \"%.*s\")",
@@ -5011,17 +5384,17 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
if (incrementGiven) {
type = CHAR_TYPE(src, lastChar);
- envPtr->pushSimpleWords = 0; /* we will handle simple words */
+ envPtr->pushSimpleWords = 0;
result = CompileWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
- "\n (reading increment)", -1);
+ "\n (increment expression)", -1);
}
goto done;
}
if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++; /* advance over the " or { */
+ src++;
}
if (envPtr->wordIsSimple) {
/*
@@ -5040,7 +5413,8 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
src[numChars] = '\0';
if (TclLooksLikeInt(src)) {
- if (TclGetLong(interp, src, &n) == TCL_OK) {
+ int code = TclGetLong(interp, src, &n);
+ if (code == TCL_OK) {
if ((-127 <= n) && (n <= 127)) {
isCompilableInt = 1;
isImmIncrValue = 1;
@@ -5062,6 +5436,8 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
maxDepth += 1;
}
}
+ } else {
+ Tcl_ResetResult(interp);
}
}
if (!isCompilableInt) {
@@ -5070,7 +5446,7 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
TclEmitPush(objIndex, envPtr);
maxDepth += 1;
}
- src[numChars] = savedChar; /* restore the saved char */
+ src[numChars] = savedChar;
} else {
maxDepth += envPtr->maxStackDepth;
}
@@ -5088,10 +5464,6 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
* Now emit instructions to increment the variable.
*/
- if ((localIndex >= 0) && (localIndex > 255)) {
- panic("TclCompileIncrCmd: bad localIndex %d\n", localIndex);
- return TCL_ERROR;
- }
if (simpleVarName) {
if (elName == NULL) { /* scalar */
if (localIndex >= 0) {
@@ -5146,7 +5518,7 @@ TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type != TCL_COMMAND_END) {
- goto badArgs; /* too many arguments */
+ goto badArgs;
}
}
@@ -5263,7 +5635,7 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
* runtime.
*/
- envPtr->pushSimpleWords = 0; /* we will process the varName */
+ envPtr->pushSimpleWords = 0;
result = CompileWord(interp, wordStart, argInfo.endArray[0] + 1,
flags, envPtr);
if (result != TCL_OK) {
@@ -5344,11 +5716,11 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
*/
if ((procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
} else {
@@ -5360,11 +5732,11 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
if (localIndex >= 0) {
maxDepth = 0;
} else {
- savedChar = name[nameChars]; /* save char after name */
+ savedChar = name[nameChars];
name[nameChars] = '\0';
objIndex = TclObjIndexForString(name, nameChars,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar; /* restore the saved char */
+ name[nameChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth = 1;
}
@@ -5377,12 +5749,12 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
*/
if (elName != NULL) {
- savedChar = elName[elNameChars]; /* save char after elName */
+ savedChar = elName[elNameChars];
elName[elNameChars] = '\0';
envPtr->pushSimpleWords = 1;
result = TclCompileQuotes(interp, elName, elName+elNameChars,
0, flags, envPtr);
- elName[elNameChars] = savedChar; /* restore the saved char */
+ elName[elNameChars] = savedChar;
if (result != TCL_OK) {
char msg[200];
sprintf(msg, "\n (parsing index for array \"%.*s\")",
@@ -5425,13 +5797,14 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
p = wordStart;
if ((*wordStart == '"') || (*wordStart == '{')) {
- p++; /* advance over the " or { */
+ p++;
}
savedChar = p[envPtr->numSimpleWordChars];
p[envPtr->numSimpleWordChars] = '\0';
isCompilableInt = 0;
if (TclLooksLikeInt(p)) {
- if (TclGetLong(interp, p, &n) == TCL_OK) {
+ int code = TclGetLong(interp, p, &n);
+ if (code == TCL_OK) {
TclFormatInt(buf, n);
if (strcmp(p, buf) == 0) {
isCompilableInt = 1;
@@ -5444,6 +5817,8 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
objPtr->internalRep.longValue = n;
objPtr->typePtr = &tclIntType;
}
+ } else {
+ Tcl_ResetResult(interp);
}
}
if (!isCompilableInt) {
@@ -5451,7 +5826,7 @@ TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
/*inHeap*/ 0, envPtr);
}
- p[envPtr->numSimpleWordChars] = savedChar; /* restore char */
+ p[envPtr->numSimpleWordChars] = savedChar;
TclEmitPush(objIndex, envPtr);
maxDepth += 1;
}
@@ -5575,7 +5950,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
- AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+ AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type == TCL_COMMAND_END) {
@@ -5605,7 +5980,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
* Compile the next word: the test expression.
*/
- envPtr->pushSimpleWords = 1; /* process words normally */
+ envPtr->pushSimpleWords = 1;
result = CompileExprWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
@@ -5630,7 +6005,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
* starting PC offset and byte length in the its ExceptionRange record.
*/
- AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+ AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type == TCL_COMMAND_END) {
@@ -5670,12 +6045,6 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
jumpBackOffset = TclCurrCodeOffset();
jumpBackDist =
(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
-#ifdef TCL_COMPILE_DEBUG
- if (jumpBackDist > MAX_JUMP_DIST) {
- fprintf(stderr, "\nTclCompileWhileCmd: bad distance %u for unconditional jump\n", jumpBackDist);
- panic("TclCompileWhileCmd: bad distance for unconditional jump");
- }
-#endif /*TCL_COMPILE_DEBUG*/
if (jumpBackDist > 120) {
TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
} else {
@@ -5695,12 +6064,6 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
* Update the loop body's starting PC offset since it moved down.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileWhileCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
envPtr->excRangeArrayPtr[range].codeOffset += 3;
/*
@@ -5726,12 +6089,6 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
* break target.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
- panic("TclCompileWhileCmd: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
/*
@@ -5742,7 +6099,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
envPtr);
TclEmitPush(objIndex, envPtr);
if (maxDepth == 0) {
- maxDepth = 1; /* since we just pushed one object */
+ maxDepth = 1;
}
/*
@@ -5755,7 +6112,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
if (type != TCL_COMMAND_END) {
- goto badArgs; /* too many arguments */
+ goto badArgs;
}
}
@@ -5827,6 +6184,7 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
char c;
int savePushSimpleWords = envPtr->pushSimpleWords;
int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+ int saveExprIsComparison = envPtr->exprIsComparison;
int numChars, result;
/*
@@ -5872,7 +6230,7 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
first = src+1;
src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (*src == 0) { /* word doesn't end properly. */
+ if (*src == 0) {
goto badArgs;
}
if (*src != '}') {
@@ -5882,12 +6240,12 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
numChars = (last - first + 1);
savedChar = first[numChars];
- first[numChars] = '\0'; /* replace term. char with null */
+ first[numChars] = '\0';
result = TclCompileExpr(interp, first, first+numChars,
flags, envPtr);
- first[numChars] = savedChar; /* restore the saved char */
+ first[numChars] = savedChar;
- src++; /* advance src after terminating '}' */
+ src++;
maxDepth = envPtr->maxStackDepth;
} else {
/*
@@ -5945,24 +6303,36 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
numChars = (last - first + 1);
savedChar = first[numChars];
- first[numChars] = '\0'; /* replace term. char with null */
+ first[numChars] = '\0';
result = TclCompileExpr(interp, first, first + numChars,
flags, envPtr);
- first[numChars] = savedChar; /* restore the saved char */
+ first[numChars] = savedChar;
envPtr->excRangeArrayPtr[range].numCodeBytes =
TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
- if ((envPtr->exprIsJustVarRef) || (result != TCL_OK)) {
+ if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+ || (envPtr->exprIsComparison)) {
/*
- * We must call the expr command at runtime since the
- * expression consisted of just a single variable reference
- * (and a second round of substitutions might be needed) or
- * there was a compilation error. Delete the inline code by
- * backing up the code pc and catch index. Note that if
- * there was a compilation error, we can't report the error
- * yet since the expression might be valid after the second
- * round of substitutions.
+ * We must call the expr command at runtime. Either there
+ * was a compilation error or the inline code might fail to
+ * give the correct 2 level substitution semantics.
+ *
+ * The latter can happen if the expression consisted of just
+ * a single variable reference or if the top-level operator
+ * in the expr is a comparison (which might operate on
+ * strings). In the latter case, the expression's code might
+ * execute (apparently) successfully but produce the wrong
+ * result. We depend on its execution failing if a second
+ * level of substitutions is required. This causes the
+ * "catch" code we generate around the inline code to back
+ * off to a call on the expr command at runtime, and this
+ * always gives the right 2 level substitution semantics.
+ *
+ * We delete the inline code by backing up the code pc and
+ * catch index. Note that if there was a compilation error,
+ * we can't report the error yet since the expression might
+ * be valid after the second round of substitutions.
*/
envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
@@ -6001,13 +6371,6 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
* target since it, being after the jump, also moved down.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
- panic("CompileExprWord: bad body ExceptionRange type %d\n",
- envPtr->excRangeArrayPtr[range].type);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
envPtr->excRangeArrayPtr[range].catchOffset += 3;
}
}
@@ -6018,6 +6381,7 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
envPtr->maxStackDepth = maxDepth;
envPtr->pushSimpleWords = savePushSimpleWords;
envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+ envPtr->exprIsComparison = saveExprIsComparison;
return result;
}
@@ -6079,8 +6443,8 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
type = CHAR_TYPE(src, lastChar);
if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++; /* advance over the " or { */
- envPtr->pushSimpleWords = 0; /* we process a simple word below */
+ src++;
+ envPtr->pushSimpleWords = 0;
if (type == TCL_QUOTE) {
result = TclCompileQuotes(interp, src, lastChar,
'"', flags, envPtr);
@@ -6132,7 +6496,7 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
*closeCharPos = '\0';
result = TclCompileString(interp, src, closeCharPos,
(flags & ~TCL_BRACKET_TERM), envPtr);
- *closeCharPos = savedChar; /* restore the saved char */
+ *closeCharPos = savedChar;
if (result != TCL_OK) {
goto done;
}
@@ -6168,7 +6532,7 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
Tcl_Command cmd;
Command *cmdPtr = NULL;
- int wasCompiled = 0; /* set 1 if word has compile proc. */
+ int wasCompiled = 0;
savedChar = *p;
*p = '\0';
@@ -6179,7 +6543,7 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
cmdPtr = (Command *) cmd;
}
if (cmdPtr != NULL && cmdPtr->compileProc != NULL) {
- *p = savedChar; /* restore the saved char */
+ *p = savedChar;
src = p;
iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
| ERROR_CODE_SET);
@@ -6194,7 +6558,7 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
if (!wasCompiled) {
objIndex = TclObjIndexForString(src, p-src,
/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- *p = savedChar; /* restore the saved char */
+ *p = savedChar;
TclEmitPush(objIndex, envPtr);
TclEmitInstUInt1(INST_INVOKE_STK1, 1, envPtr);
src = p;
@@ -6205,7 +6569,7 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
* Push the word and call eval at runtime.
*/
- envPtr->pushSimpleWords = 1; /* process words normally */
+ envPtr->pushSimpleWords = 1;
result = CompileWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
goto done;
@@ -6312,7 +6676,7 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
localPtr->flags = flagsIfCreated;
localPtr->defValuePtr = NULL;
if (name != NULL) {
- strncpy(localPtr->name, name, (unsigned) nameChars);
+ memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
}
localPtr->name[nameChars] = '\0';
procPtr->numCompiledLocals++;
@@ -6387,12 +6751,12 @@ AdvanceToNextWord(string, envPtr)
char
Tcl_Backslash(src, readPtr)
- char *src; /* Points to the backslash character of
+ CONST char *src; /* Points to the backslash character of
* a backslash sequence. */
int *readPtr; /* Fill in with number of characters read
* from src, unless NULL. */
{
- register char *p = src+1;
+ CONST char *p = src + 1;
char result;
int count;
@@ -6547,7 +6911,7 @@ TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
if (!new) { /* already in object table and array */
objIndex = (int) Tcl_GetHashValue(hPtr);
if (inHeap) {
- ckfree(string); /* since we own the string */
+ ckfree(string);
}
return objIndex;
}
@@ -6562,17 +6926,18 @@ TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
if (allocStrRep) {
if (inHeap) { /* use input string for obj's string rep */
objPtr->bytes = string;
- } else { /* must allocate string rep */
+ } else {
if (length > 0) {
objPtr->bytes = ckalloc((unsigned) length + 1);
- memcpy(objPtr->bytes, string, (size_t) length);
+ memcpy((VOID *) objPtr->bytes, (VOID *) string,
+ (size_t) length);
objPtr->bytes[length] = '\0';
}
}
objPtr->length = length;
} else { /* leave the string rep NULL */
if (inHeap) {
- ckfree(string); /* since we own the string */
+ ckfree(string);
}
}
@@ -6581,7 +6946,7 @@ TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
}
objIndex = envPtr->objArrayNext;
envPtr->objArrayPtr[objIndex] = objPtr;
- Tcl_IncrRefCount(objPtr); /* since obj array now has a reference */
+ Tcl_IncrRefCount(objPtr);
envPtr->objArrayNext++;
if (hPtr) {
@@ -6754,10 +7119,16 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
envPtr->mallocedCmdMap = 1;
}
+ if (cmdIndex > 0) {
+ if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
+ panic("EnterCmdStartData: cmd map table not sorted by code offset");
+ }
+ }
+
cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+ cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->srcOffset = srcOffset;
cmdLocPtr->numSrcChars = -1;
- cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->numCodeBytes = -1;
}
@@ -6766,7 +7137,7 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
*
* EnterCmdExtentData --
*
- * Registers the source and bytecode length of a command. This
+ * Registers the source and bytecode length for a command. This
* information is used at runtime to map between instruction pc and
* source locations.
*
@@ -6895,7 +7266,7 @@ CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
} else if (*src == '"') {
wordStart = src;
src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (src == lastChar) { /* word doesn't end properly. */
+ if (src == lastChar) {
badStringTermination:
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -6905,9 +7276,9 @@ CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
prev = (src-1);
if (*src == '"') {
wordEnd = src;
- src++; /* skip over terminating '"' */
+ src++;
} else if ((*src == ';') && (*prev == '"')) {
- scanningArgs = 0; /* found a terminating ';' */
+ scanningArgs = 0;
wordEnd = prev;
} else {
goto badStringTermination;
@@ -6915,7 +7286,7 @@ CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
} else if (*src == '{') {
wordStart = src;
src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (src == lastChar) { /* word doesn't end properly. */
+ if (src == lastChar) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"missing close-brace", -1);
@@ -6924,9 +7295,9 @@ CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
prev = (src-1);
if (*src == '}') {
wordEnd = src;
- src++; /* skip over terminating '}' */
+ src++;
} else if ((*src == ';') && (*prev == '}')) {
- scanningArgs = 0; /* found a terminating ';' */
+ scanningArgs = 0;
wordEnd = prev;
} else {
Tcl_ResetResult(interp);
@@ -6938,17 +7309,17 @@ CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
wordStart = src;
src = TclWordEnd(src, lastChar, nestedCmd, NULL);
prev = (src-1);
- if (src == lastChar) { /* word doesn't end properly. */
+ if (src == lastChar) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"missing close-bracket or close-brace", -1);
return TCL_ERROR;
} else if (*src == ';') {
- scanningArgs = 0; /* found a terminating ';' */
+ scanningArgs = 0;
wordEnd = prev;
} else {
wordEnd = src;
- src++; /* advance to char after word */
+ src++;
if ((src == lastChar) || (*src == '\n')
|| ((*src == ']') && nestedCmd)) {
scanningArgs = 0;
@@ -7378,13 +7749,6 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
int firstCmd, lastCmd, firstRange, lastRange, k;
unsigned int numBytes;
-#ifdef TCL_COMPILE_DEBUG
- if (jumpDist > MAX_JUMP_DIST) {
- fprintf(stderr, "\nTclFixupForwardJump: bad jump distance %u\n", jumpDist);
- panic("TclFixupForwardJump: bad jump distance");
- }
-#endif /*TCL_COMPILE_DEBUG*/
-
if (jumpDist <= distThreshold) {
jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
switch (jumpFixupPtr->jumpType) {
@@ -7398,7 +7762,7 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
break;
}
- return 0; /* no need to grow the jump */
+ return 0;
}
/*