#include "tclInt.h"
#include "tclCompile.h"
static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
#define TCL_CREATE_VAR 1
#define TCL_NO_LARGE_INDEX 2
AuxDataType tclForeachInfoType = {
"ForeachInfo",
DupForeachInfo,
FreeForeachInfo
};
int
TclCompileAppendCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
numWords = parsePtr->numWords;
if (numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"append varName ?value value ...?\"",
-1);
return TCL_ERROR;
} else if (numWords == 2) {
return TclCompileSetCmd(interp, parsePtr, envPtr);
} else if (numWords > 3) {
return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
if (numWords > 2) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
}
}
if (simpleVarName) {
if (isScalar) {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
}
} else {
TclEmitOpcode(INST_APPEND_STK, envPtr);
}
} else {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
}
} else {
TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
}
}
} else {
TclEmitOpcode(INST_APPEND_STK, envPtr);
}
done:
return code;
}
int
TclCompileBreakCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
if (parsePtr->numWords != 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"break\"", -1);
return TCL_ERROR;
}
TclEmitOpcode(INST_BREAK, envPtr);
return TCL_OK;
}
int
TclCompileCatchCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
CONST char *name;
int localIndex, nameChars, range, startOffset, jumpDist;
int code;
int savedStackDepth = envPtr->currStackDepth;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"catch command ?varName?\"", -1);
return TCL_ERROR;
}
if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
return TCL_OUT_LINE_COMPILE;
}
localIndex = -1;
cmdTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
if (parsePtr->numWords == 3) {
nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
name = nameTokenPtr[1].start;
nameChars = nameTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_OUT_LINE_COMPILE;
}
localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
nameTokenPtr[1].size, 1,
VAR_SCALAR, envPtr->procPtr);
} else {
return TCL_OUT_LINE_COMPILE;
}
}
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
startOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
} else {
code = TclCompileTokens(interp, cmdTokenPtr+1,
cmdTokenPtr->numComponents, envPtr);
startOffset = (envPtr->codeNext - envPtr->codeStart);
TclEmitOpcode(INST_EVAL_STK, envPtr);
}
envPtr->exceptArrayPtr[range].codeOffset = startOffset;
if (code != TCL_OK) {
code = TCL_OUT_LINE_COMPILE;
goto done;
}
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - startOffset;
if (localIndex != -1) {
if (localIndex <= 255) {
TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
}
}
TclEmitOpcode(INST_POP, envPtr);
TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[range].catchOffset =
(envPtr->codeNext - envPtr->codeStart);
if (localIndex != -1) {
TclEmitOpcode(INST_PUSH_RESULT, envPtr);
if (localIndex <= 255) {
TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
}
TclEmitOpcode(INST_POP, envPtr);
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
jumpDist = (envPtr->codeNext - envPtr->codeStart)
- jumpFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
}
TclEmitOpcode(INST_END_CATCH, envPtr);
done:
envPtr->currStackDepth = savedStackDepth + 1;
envPtr->exceptDepth--;
return code;
}
int
TclCompileContinueCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
if (parsePtr->numWords != 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"continue\"", -1);
return TCL_ERROR;
}
TclEmitOpcode(INST_CONTINUE, envPtr);
return TCL_OK;
}
int
TclCompileExprCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *firstWordPtr;
if (parsePtr->numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"expr arg ?arg ...?\"", -1);
return TCL_ERROR;
}
firstWordPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
envPtr);
}
int
TclCompileForCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
if (parsePtr->numWords != 5) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"for start test next command\"", -1);
return TCL_ERROR;
}
startTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_OUT_LINE_COMPILE;
}
nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
|| (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
return TCL_OUT_LINE_COMPILE;
}
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
code = TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" initial command)", -1);
}
goto done;
}
TclEmitOpcode(INST_POP, envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"for\" body line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
goto done;
}
envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" loop-end command)", -1);
}
goto done;
}
envPtr->exceptArrayPtr[nextRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- nextCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
envPtr->currStackDepth = savedStackDepth;
testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
bodyCodeOffset += 3;
nextCodeOffset += 3;
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" test expression)", -1);
}
goto done;
}
envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
envPtr->exceptArrayPtr[bodyRange].breakOffset =
envPtr->exceptArrayPtr[nextRange].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
code = TCL_OK;
done:
envPtr->exceptDepth--;
return code;
}
int
TclCompileForeachCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr;
int firstValueTemp;
int loopCtTemp;
Tcl_Token *tokenPtr, *bodyTokenPtr;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
#define STATIC_VAR_LIST_SIZE 5
int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
CONST char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
int *varcList = varcListStaticSpace;
CONST char ***varvList = varvListStaticSpace;
if (procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
return TCL_ERROR;
}
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
}
bodyTokenPtr = tokenPtr;
if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_OUT_LINE_COMPILE;
}
numLists = (numWords - 2)/2;
if (numLists > STATIC_VAR_LIST_SIZE) {
varcList = (int *) ckalloc(numLists * sizeof(int));
varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
}
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
varcList[loopIndex] = 0;
varvList[loopIndex] = NULL;
}
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (i%2 == 1) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TCL_OUT_LINE_COMPILE;
goto done;
} else {
Tcl_DString varList;
Tcl_DStringInit(&varList);
Tcl_DStringAppend(&varList, tokenPtr[1].start,
tokenPtr[1].size);
code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
goto done;
}
numVars = varcList[loopIndex];
for (j = 0; j < numVars; j++) {
CONST char *varName = varvList[loopIndex][j];
if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
code = TCL_OUT_LINE_COMPILE;
goto done;
}
}
}
loopIndex++;
}
}
firstValueTemp = -1;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
tempVar = TclFindCompiledLocal(NULL, 0,
1, VAR_SCALAR, procPtr);
if (loopIndex == 0) {
firstValueTemp = tempVar;
}
}
loopCtTemp = TclFindCompiledLocal(NULL, 0,
1, VAR_SCALAR, procPtr);
infoPtr = (ForeachInfo *) ckalloc((unsigned)
(sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
infoPtr->numLists = numLists;
infoPtr->firstValueTemp = firstValueTemp;
infoPtr->loopCtTemp = loopCtTemp;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
ForeachVarList *varListPtr;
numVars = varcList[loopIndex];
varListPtr = (ForeachVarList *) ckalloc((unsigned)
sizeof(ForeachVarList) + (numVars * sizeof(int)));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
CONST char *varName = varvList[loopIndex][j];
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
nameChars, 1, VAR_SCALAR, procPtr);
}
infoPtr->varLists[loopIndex] = varListPtr;
}
infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
if ((i%2 == 0) && (i > 0)) {
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
} else {
TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
}
TclEmitOpcode(INST_POP, envPtr);
loopIndex++;
}
}
TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
envPtr->exceptArrayPtr[range].continueOffset =
(envPtr->codeNext - envPtr->codeStart);
TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
envPtr->exceptArrayPtr[range].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"foreach\" body line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
goto done;
}
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[range].codeOffset;
TclEmitOpcode(INST_POP, envPtr);
jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
jumpBackDist =
(jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
if (jumpBackDist > 120) {
TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
} else {
TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
}
jumpDist = (envPtr->codeNext - envPtr->codeStart)
- jumpFalseFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
envPtr->exceptArrayPtr[range].codeOffset += 3;
jumpBackOffset += 3;
jumpPc = (envPtr->codeStart + jumpBackOffset);
jumpBackDist += 3;
if (jumpBackDist > 120) {
TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
} else {
TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
}
}
envPtr->exceptArrayPtr[range].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != (CONST char **) NULL) {
ckfree((char *) varvList[loopIndex]);
}
}
if (varcList != varcListStaticSpace) {
ckfree((char *) varcList);
ckfree((char *) varvList);
}
envPtr->exceptDepth--;
return code;
}
static ClientData
DupForeachInfo(clientData)
ClientData clientData;
{
register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
ForeachInfo *dupPtr;
register ForeachVarList *srcListPtr, *dupListPtr;
int numLists = srcPtr->numLists;
int numVars, i, j;
dupPtr = (ForeachInfo *) ckalloc((unsigned)
(sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
dupPtr->numLists = numLists;
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
dupPtr->loopCtTemp = srcPtr->loopCtTemp;
for (i = 0; i < numLists; i++) {
srcListPtr = srcPtr->varLists[i];
numVars = srcListPtr->numVars;
dupListPtr = (ForeachVarList *) ckalloc((unsigned)
sizeof(ForeachVarList) + numVars*sizeof(int));
dupListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
}
dupPtr->varLists[i] = dupListPtr;
}
return (ClientData) dupPtr;
}
static void
FreeForeachInfo(clientData)
ClientData clientData;
{
register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
register ForeachVarList *listPtr;
int numLists = infoPtr->numLists;
register int i;
for (i = 0; i < numLists; i++) {
listPtr = infoPtr->varLists[i];
ckfree((char *) listPtr);
}
ckfree((char *) infoPtr);
}
int
TclCompileIfCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
JumpFixupArray jumpFalseFixupArray;
JumpFixupArray jumpEndFixupArray;
Tcl_Token *tokenPtr, *testTokenPtr;
int jumpDist, jumpFalseDist;
int jumpIndex = 0;
int numWords, wordIdx, numBytes, j, code;
CONST char *word;
char buffer[100];
int savedStackDepth = envPtr->currStackDepth;
int realCond = 1;
int boolVal;
int compileScripts = 1;
tokenPtr = parsePtr->tokenPtr;
wordIdx = 0;
numWords = parsePtr->numWords;
for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_OUT_LINE_COMPILE;
}
tokenPtr += 2;
}
TclInitJumpFixupArray(&jumpFalseFixupArray);
TclInitJumpFixupArray(&jumpEndFixupArray);
code = TCL_OK;
tokenPtr = parsePtr->tokenPtr;
wordIdx = 0;
while (wordIdx < numWords) {
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((tokenPtr == parsePtr->tokenPtr)
|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
} else {
break;
}
if (wordIdx >= numWords) {
sprintf(buffer,
"wrong # args: no expression after \"%.30s\" argument",
word);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
code = TCL_ERROR;
goto done;
}
envPtr->currStackDepth = savedStackDepth;
testTokenPtr = tokenPtr;
if (realCond) {
Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
realCond = 0;
if (!boolVal) {
compileScripts = 0;
}
} else {
Tcl_ResetResult(interp);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (\"if\" test expression)", -1);
}
goto done;
}
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
jumpIndex = jumpFalseFixupArray.next;
jumpFalseFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
&(jumpFalseFixupArray.fixup[jumpIndex]));
}
}
tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
sprintf(buffer, "wrong # args: no script following \"%.20s\" argument", testTokenPtr->start);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
code = TCL_ERROR;
goto done;
}
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: no script following \"then\" argument", -1);
code = TCL_ERROR;
goto done;
}
}
}
if (compileScripts) {
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"if\" then script line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
goto done;
}
}
if (realCond) {
if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
TclExpandJumpFixupArray(&jumpEndFixupArray);
}
jumpEndFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
&(jumpEndFixupArray.fixup[jumpIndex]));
jumpDist = (envPtr->codeNext - envPtr->codeStart)
- jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
if (TclFixupForwardJump(envPtr,
&(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
}
} else if (boolVal) {
compileScripts = 0;
} else {
realCond = 1;
compileScripts = 1;
}
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
}
envPtr->currStackDepth = savedStackDepth;
if ((wordIdx < numWords)
&& (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: no script following \"else\" argument", -1);
code = TCL_ERROR;
goto done;
}
}
if (compileScripts) {
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"if\" else script line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
goto done;
}
}
wordIdx++;
if (wordIdx < numWords) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: extra words after \"else\" clause in \"if\" command", -1);
code = TCL_ERROR;
goto done;
}
} else {
if (compileScripts) {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
for (j = jumpEndFixupArray.next; j > 0; j--) {
jumpIndex = (j - 1);
jumpDist = (envPtr->codeNext - envPtr->codeStart)
- jumpEndFixupArray.fixup[jumpIndex].codeOffset;
if (TclFixupForwardJump(envPtr,
&(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
unsigned char *ifFalsePc = envPtr->codeStart
+ jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
unsigned char opCode = *ifFalsePc;
if (opCode == INST_JUMP_FALSE1) {
jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
jumpFalseDist += 3;
TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
} else if (opCode == INST_JUMP_FALSE4) {
jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
jumpFalseDist += 3;
TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
} else {
panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
}
}
}
done:
envPtr->currStackDepth = savedStackDepth + 1;
TclFreeJumpFixupArray(&jumpFalseFixupArray);
TclFreeJumpFixupArray(&jumpEndFixupArray);
return code;
}
int
TclCompileIncrCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
int code = TCL_OK;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"incr varName ?increment?\"", -1);
return TCL_ERROR;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr,
(TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
&localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
haveImmValue = 0;
immValue = 0;
if (parsePtr->numWords == 3) {
incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
CONST char *word = incrTokenPtr[1].start;
int numBytes = incrTokenPtr[1].size;
int validLength = TclParseInteger(word, numBytes);
long n;
if (validLength == numBytes) {
int code;
Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes);
Tcl_IncrRefCount(longObj);
code = Tcl_GetLongFromObj(NULL, longObj, &n);
Tcl_DecrRefCount(longObj);
if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) {
haveImmValue = 1;
immValue = n;
}
}
if (!haveImmValue) {
TclEmitPush(
TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
code = TclCompileTokens(interp, incrTokenPtr+1,
incrTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (increment expression)", -1);
}
goto done;
}
}
} else {
haveImmValue = 1;
immValue = 1;
}
if (simpleVarName) {
if (isScalar) {
if (localIndex >= 0) {
if (haveImmValue) {
TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
TclEmitInt1(immValue, envPtr);
} else {
TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
}
} else {
if (haveImmValue) {
TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
} else {
TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
}
}
} else {
if (localIndex >= 0) {
if (haveImmValue) {
TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
TclEmitInt1(immValue, envPtr);
} else {
TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
}
} else {
if (haveImmValue) {
TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
} else {
TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
}
}
}
} else {
if (haveImmValue) {
TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
} else {
TclEmitOpcode(INST_INCR_STK, envPtr);
}
}
done:
return code;
}
int
TclCompileLappendCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int numValues, simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
if (envPtr->procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
numWords = parsePtr->numWords;
if (numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"lappend varName ?value value ...?\"", -1);
return TCL_ERROR;
}
if (numWords != 3) {
return TCL_OUT_LINE_COMPILE;
}
numValues = (numWords - 2);
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
if (numWords > 2) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
}
#if 0
} else {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
numValues = 1;
#endif
}
if (simpleVarName) {
if (isScalar) {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
}
} else {
TclEmitOpcode(INST_LAPPEND_STK, envPtr);
}
} else {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
} else {
TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
}
} else {
TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
}
}
} else {
TclEmitOpcode(INST_LAPPEND_STK, envPtr);
}
done:
return code;
}
int
TclCompileLindexCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr;
int code, i;
int numWords;
numWords = parsePtr->numWords;
if ( numWords <= 1 ) {
return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
for ( i = 1 ; i < numWords ; i++ ) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(
TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
if ( numWords == 3 ) {
TclEmitOpcode( INST_LIST_INDEX, envPtr );
} else {
TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr );
}
return TCL_OK;
}
int
TclCompileListCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
if (envPtr->procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
if (parsePtr->numWords == 1) {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
} else {
Tcl_Token *valueTokenPtr;
int i, code, numWords;
numWords = parsePtr->numWords;
valueTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
for (i = 1; i < numWords; i++) {
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
}
TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
}
return TCL_OK;
}
int
TclCompileLlengthCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr;
int code;
if (parsePtr->numWords != 2) {
Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
TCL_STATIC);
return TCL_ERROR;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
TclEmitOpcode(INST_LIST_LENGTH, envPtr);
return TCL_OK;
}
int
TclCompileLsetCmd( interp, parsePtr, envPtr )
Tcl_Interp* interp;
Tcl_Parse* parsePtr;
CompileEnv* envPtr;
{
int tempDepth;
Tcl_Token* varTokenPtr;
int result;
int localIndex;
int simpleVarName;
int isScalar;
int i;
if ( parsePtr->numWords < 3 ) {
return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
result = TclPushVarName( interp, varTokenPtr, envPtr,
TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
if (result != TCL_OK) {
return result;
}
for ( i = 2; i < parsePtr->numWords; ++i ) {
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
result = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if ( result != TCL_OK ) {
return result;
}
}
}
if ( !simpleVarName || localIndex < 0 ) {
if ( !simpleVarName || isScalar ) {
tempDepth = parsePtr->numWords - 2;
} else {
tempDepth = parsePtr->numWords - 1;
}
TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
}
if ( simpleVarName && !isScalar ) {
if ( localIndex < 0 ) {
tempDepth = parsePtr->numWords - 1;
} else {
tempDepth = parsePtr->numWords - 2;
}
TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
}
if ( !simpleVarName ) {
TclEmitOpcode( INST_LOAD_STK, envPtr );
} else if ( isScalar ) {
if ( localIndex < 0 ) {
TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr );
} else if ( localIndex < 0x100 ) {
TclEmitInstInt1( INST_LOAD_SCALAR1, localIndex, envPtr );
} else {
TclEmitInstInt4( INST_LOAD_SCALAR4, localIndex, envPtr );
}
} else {
if ( localIndex < 0 ) {
TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr );
} else if ( localIndex < 0x100 ) {
TclEmitInstInt1( INST_LOAD_ARRAY1, localIndex, envPtr );
} else {
TclEmitInstInt4( INST_LOAD_ARRAY4, localIndex, envPtr );
}
}
if ( parsePtr->numWords == 4 ) {
TclEmitOpcode( INST_LSET_LIST, envPtr );
} else {
TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr );
}
if ( !simpleVarName ) {
TclEmitOpcode( INST_STORE_STK, envPtr );
} else if ( isScalar ) {
if ( localIndex < 0 ) {
TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr );
} else if ( localIndex < 0x100 ) {
TclEmitInstInt1( INST_STORE_SCALAR1, localIndex, envPtr );
} else {
TclEmitInstInt4( INST_STORE_SCALAR4, localIndex, envPtr );
}
} else {
if ( localIndex < 0 ) {
TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr );
} else if ( localIndex < 0x100 ) {
TclEmitInstInt1( INST_STORE_ARRAY1, localIndex, envPtr );
} else {
TclEmitInstInt4( INST_STORE_ARRAY4, localIndex, envPtr );
}
}
return TCL_OK;
}
int
TclCompileRegexpCmd(interp, parsePtr, envPtr)
Tcl_Interp* interp;
Tcl_Parse* parsePtr;
CompileEnv* envPtr;
{
Tcl_Token *varTokenPtr;
int i, len, code, exactMatch, nocase;
char *str;
if (parsePtr->numWords < 3) {
return TCL_OUT_LINE_COMPILE;
}
nocase = 0;
varTokenPtr = parsePtr->tokenPtr;
for (i = 1; i < parsePtr->numWords - 2; i++) {
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_OUT_LINE_COMPILE;
}
str = (char *) varTokenPtr[1].start;
len = varTokenPtr[1].size;
if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
i++;
break;
} else if ((len > 1)
&& (strncmp(str, "-nocase", (unsigned) len) == 0)) {
nocase = 1;
} else {
return TCL_OUT_LINE_COMPILE;
}
}
if ((parsePtr->numWords - i) != 2) {
return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
str = (char *) varTokenPtr[1].start;
len = varTokenPtr[1].size;
if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
return TCL_OUT_LINE_COMPILE;
}
if (len == 0) {
TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
return TCL_OK;
}
str = (char *) ckalloc((unsigned) len + 1);
strncpy(str, varTokenPtr[1].start, (size_t) len);
str[len] = '\0';
#if 0
if ((len > 2) && (*str == '.') && (str[1] == '*')) {
str += 2; len -= 2;
}
if ((len > 2) && (str[len-3] != '\\')
&& (str[len-2] == '.') && (str[len-1] == '*')) {
len -= 2;
}
#endif
if ((len > 1) && (str[0] == '^') && (str[len-1] == '$')
&& (str[len-2] != '\\')) {
exactMatch = 1;
} else {
exactMatch = 0;
}
if ((strpbrk(str, "*+?{}()[].\\|^$") != NULL)
|| (Tcl_RegExpCompile(NULL, str) == NULL)) {
ckfree((char *) str);
return TCL_OUT_LINE_COMPILE;
}
if (exactMatch) {
TclEmitPush(TclRegisterNewLiteral(envPtr, str+1, len-2), envPtr);
} else {
char *newStr = ckalloc((unsigned) len + 3);
newStr[0] = '*';
strncpy(newStr + 1, str, (size_t) len);
newStr[len+1] = '*';
newStr[len+2] = '\0';
TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len+2), envPtr);
ckfree((char *) newStr);
}
ckfree((char *) str);
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
if (exactMatch && !nocase) {
TclEmitOpcode(INST_STR_EQ, envPtr);
} else {
TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
}
return TCL_OK;
}
int
TclCompileReturnCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr;
int code;
if (envPtr->procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
switch (parsePtr->numWords) {
case 1: {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
break;
}
case 2: {
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
break;
}
default: {
return TCL_OUT_LINE_COMPILE;
}
}
TclEmitOpcode(INST_DONE, envPtr);
return TCL_OK;
}
int
TclCompileSetCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
int code = TCL_OK;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"set varName ?newValue?\"", -1);
return TCL_ERROR;
}
isAssignment = (numWords == 3);
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
if (isAssignment) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
}
}
if (simpleVarName) {
if (isScalar) {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1((isAssignment?
INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
localIndex, envPtr);
} else {
TclEmitInstInt4((isAssignment?
INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
localIndex, envPtr);
}
} else {
TclEmitOpcode((isAssignment?
INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
}
} else {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1((isAssignment?
INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
localIndex, envPtr);
} else {
TclEmitInstInt4((isAssignment?
INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
localIndex, envPtr);
}
} else {
TclEmitOpcode((isAssignment?
INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
}
}
} else {
TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
}
done:
return code;
}
int
TclCompileStringCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *opTokenPtr, *varTokenPtr;
Tcl_Obj *opObj;
int index;
int code;
static CONST char *options[] = {
"bytelength", "compare", "equal", "first",
"index", "is", "last", "length",
"map", "match", "range", "repeat",
"replace", "tolower", "toupper", "totitle",
"trim", "trimleft", "trimright",
"wordend", "wordstart", (char *) NULL
};
enum options {
STR_BYTELENGTH, STR_COMPARE, STR_EQUAL, STR_FIRST,
STR_INDEX, STR_IS, STR_LAST, STR_LENGTH,
STR_MAP, STR_MATCH, STR_RANGE, STR_REPEAT,
STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE,
STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
STR_WORDEND, STR_WORDSTART
};
if (parsePtr->numWords < 2) {
return TCL_OUT_LINE_COMPILE;
}
opTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
&index) != TCL_OK) {
Tcl_DecrRefCount(opObj);
Tcl_ResetResult(interp);
return TCL_OUT_LINE_COMPILE;
}
Tcl_DecrRefCount(opObj);
varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1);
switch ((enum options) index) {
case STR_BYTELENGTH:
case STR_FIRST:
case STR_IS:
case STR_LAST:
case STR_MAP:
case STR_RANGE:
case STR_REPEAT:
case STR_REPLACE:
case STR_TOLOWER:
case STR_TOUPPER:
case STR_TOTITLE:
case STR_TRIM:
case STR_TRIMLEFT:
case STR_TRIMRIGHT:
case STR_WORDEND:
case STR_WORDSTART:
return TCL_OUT_LINE_COMPILE;
case STR_COMPARE:
case STR_EQUAL: {
int i;
if (parsePtr->numWords != 4) {
return TCL_OUT_LINE_COMPILE;
}
for (i = 0; i < 2; i++) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
INST_STR_CMP : INST_STR_EQ), envPtr);
return TCL_OK;
}
case STR_INDEX: {
int i;
if (parsePtr->numWords != 4) {
return TCL_OUT_LINE_COMPILE;
}
for (i = 0; i < 2; i++) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
TclEmitOpcode(INST_STR_INDEX, envPtr);
return TCL_OK;
}
case STR_LENGTH: {
if (parsePtr->numWords != 3) {
return TCL_OUT_LINE_COMPILE;
}
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
char buf[TCL_INTEGER_SPACE];
int len = Tcl_NumUtfChars(varTokenPtr[1].start,
varTokenPtr[1].size);
len = sprintf(buf, "%d", len);
TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
return TCL_OK;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
TclEmitOpcode(INST_STR_LEN, envPtr);
return TCL_OK;
}
case STR_MATCH: {
int i, length, exactMatch = 0, nocase = 0;
CONST char *str;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
return TCL_OUT_LINE_COMPILE;
}
if (parsePtr->numWords == 5) {
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_OUT_LINE_COMPILE;
}
str = varTokenPtr[1].start;
length = varTokenPtr[1].size;
if ((length > 1) &&
strncmp(str, "-nocase", (size_t) length) == 0) {
nocase = 1;
} else {
return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
for (i = 0; i < 2; i++) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
str = varTokenPtr[1].start;
length = varTokenPtr[1].size;
if (!nocase && (i == 0)) {
Tcl_Obj *copy = Tcl_NewStringObj(str, length);
Tcl_IncrRefCount(copy);
exactMatch = (strpbrk(Tcl_GetString(copy),
"*[]?\\") == NULL);
Tcl_DecrRefCount(copy);
}
TclEmitPush(
TclRegisterNewLiteral(envPtr, str, length), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
if (exactMatch) {
TclEmitOpcode(INST_STR_EQ, envPtr);
} else {
TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
}
return TCL_OK;
}
}
return TCL_OK;
}
int
TclCompileVariableCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *varTokenPtr;
int i, numWords;
CONST char *varName, *tail;
if (envPtr->procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
numWords = parsePtr->numWords;
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
for (i = 1; i < numWords; i += 2) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
varName = varTokenPtr[1].start;
tail = varName + varTokenPtr[1].size - 1;
if ((*tail == ')') || (tail < varName)) continue;
while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
tail--;
}
if ((*tail == ':') && (tail > varName)) {
tail++;
}
(void) TclFindCompiledLocal(tail, (tail-varName+1),
1, 0, envPtr->procPtr);
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
}
return TCL_OUT_LINE_COMPILE;
}
int
TclCompileWhileCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp;
Tcl_Parse *parsePtr;
CompileEnv *envPtr;
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist;
int range, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
int loopMayEnd = 1;
Tcl_Obj *boolObj;
int boolVal;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"while test command\"", -1);
return TCL_ERROR;
}
testTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
|| (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
return TCL_OUT_LINE_COMPILE;
}
boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
if (boolVal) {
loopMayEnd = 0;
} else {
goto pushResult;
}
}
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
if (loopMayEnd) {
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
testCodeOffset = 0;
} else {
testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
}
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"while\" body line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
goto error;
}
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
if (loopMayEnd) {
testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
bodyCodeOffset += 3;
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
"\n (\"while\" test expression)", -1);
}
goto error;
}
envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
} else {
jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
} else {
TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
}
}
envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
envPtr->exceptArrayPtr[range].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
pushResult:
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->exceptDepth--;
return TCL_OK;
error:
envPtr->exceptDepth--;
return code;
}
static int
TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
simpleVarNamePtr, isScalarPtr)
Tcl_Interp *interp;
Tcl_Token *varTokenPtr;
CompileEnv *envPtr;
int flags;
int *localIndexPtr;
int *simpleVarNamePtr;
int *isScalarPtr;
{
register CONST char *p;
CONST char *name, *elName;
register int i, n;
int nameChars, elNameChars, simpleVarName, localIndex;
int code = TCL_OK;
Tcl_Token *elemTokenPtr = NULL;
int elemTokenCount = 0;
int allocedTokens = 0;
int removedParen = 0;
simpleVarName = 0;
name = elName = NULL;
nameChars = elNameChars = 0;
localIndex = -1;
if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
(varTokenPtr->start[0] != '{')) {
simpleVarName = 1;
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if ( *(name + nameChars - 1) == ')') {
for (i = 0, p = name; i < nameChars; i++, p++) {
if (*p == '(') {
elName = p + 1;
elNameChars = nameChars - i - 2;
nameChars = i ;
break;
}
}
if ((elName != NULL) && elNameChars) {
elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
elemTokenPtr->size = elNameChars;
elemTokenPtr->numComponents = 0;
elemTokenCount = 1;
}
}
} else if (((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
simpleVarName = 0;
for (i = 0, p = varTokenPtr[1].start;
i < varTokenPtr[1].size; i++, p++) {
if (*p == '(') {
simpleVarName = 1;
break;
}
}
if (simpleVarName) {
int remainingChars;
if (varTokenPtr[n].size == 1) {
--n;
} else {
--varTokenPtr[n].size;
removedParen = n;
}
name = varTokenPtr[1].start;
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
if (remainingChars) {
elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
elemTokenPtr->size = remainingChars;
elemTokenPtr->numComponents = 0;
elemTokenCount = n;
memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
((n-1) * sizeof(Tcl_Token)));
} else {
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
}
}
}
if (simpleVarName) {
int hasNsQualifiers = 0;
for (i = 0, p = name; i < nameChars; i++, p++) {
if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
hasNsQualifiers = 1;
break;
}
}
if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
localIndex = TclFindCompiledLocal(name, nameChars,
(flags & TCL_CREATE_VAR),
((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
envPtr->procPtr);
if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
localIndex = -1;
}
}
if (localIndex < 0) {
TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
}
if (elName != NULL) {
if (elNameChars) {
code = TclCompileTokens(interp, elemTokenPtr,
elemTokenCount, envPtr);
if (code != TCL_OK) {
goto done;
}
} else {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
}
done:
if (removedParen) {
++varTokenPtr[removedParen].size;
}
if (allocedTokens) {
ckfree((char *) elemTokenPtr);
}
*localIndexPtr = localIndex;
*simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
return code;
}