#include "tclInt.h"
#include "tclCompile.h"
static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized;
TCL_DECLARE_MUTEX(tableMutex)
#ifdef TCL_COMPILE_DEBUG
int tclTraceCompile = 0;
static int traceInitialized = 0;
#endif
InstructionDesc tclInstructionTable[] = {
{"done", 1, -1, 0, {OPERAND_NONE}},
{"push1", 2, +1, 1, {OPERAND_UINT1}},
{"push4", 5, +1, 1, {OPERAND_UINT4}},
{"pop", 1, -1, 0, {OPERAND_NONE}},
{"dup", 1, +1, 0, {OPERAND_NONE}},
{"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}},
{"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}},
{"invokeStk4", 5, INT_MIN, 1, {OPERAND_UINT4}},
{"evalStk", 1, 0, 0, {OPERAND_NONE}},
{"exprStk", 1, 0, 0, {OPERAND_NONE}},
{"loadScalar1", 2, 1, 1, {OPERAND_UINT1}},
{"loadScalar4", 5, 1, 1, {OPERAND_UINT4}},
{"loadScalarStk", 1, 0, 0, {OPERAND_NONE}},
{"loadArray1", 2, 0, 1, {OPERAND_UINT1}},
{"loadArray4", 5, 0, 1, {OPERAND_UINT4}},
{"loadArrayStk", 1, -1, 0, {OPERAND_NONE}},
{"loadStk", 1, 0, 0, {OPERAND_NONE}},
{"storeScalar1", 2, 0, 1, {OPERAND_UINT1}},
{"storeScalar4", 5, 0, 1, {OPERAND_UINT4}},
{"storeScalarStk", 1, -1, 0, {OPERAND_NONE}},
{"storeArray1", 2, -1, 1, {OPERAND_UINT1}},
{"storeArray4", 5, -1, 1, {OPERAND_UINT4}},
{"storeArrayStk", 1, -2, 0, {OPERAND_NONE}},
{"storeStk", 1, -1, 0, {OPERAND_NONE}},
{"incrScalar1", 2, 0, 1, {OPERAND_UINT1}},
{"incrScalarStk", 1, -1, 0, {OPERAND_NONE}},
{"incrArray1", 2, -1, 1, {OPERAND_UINT1}},
{"incrArrayStk", 1, -2, 0, {OPERAND_NONE}},
{"incrStk", 1, -1, 0, {OPERAND_NONE}},
{"incrScalar1Imm", 3, +1, 2, {OPERAND_UINT1, OPERAND_INT1}},
{"incrScalarStkImm", 2, 0, 1, {OPERAND_INT1}},
{"incrArray1Imm", 3, 0, 2, {OPERAND_UINT1, OPERAND_INT1}},
{"incrArrayStkImm", 2, -1, 1, {OPERAND_INT1}},
{"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
{"jump1", 2, 0, 1, {OPERAND_INT1}},
{"jump4", 5, 0, 1, {OPERAND_INT4}},
{"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
{"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
{"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
{"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
{"lor", 1, -1, 0, {OPERAND_NONE}},
{"land", 1, -1, 0, {OPERAND_NONE}},
{"bitor", 1, -1, 0, {OPERAND_NONE}},
{"bitxor", 1, -1, 0, {OPERAND_NONE}},
{"bitand", 1, -1, 0, {OPERAND_NONE}},
{"eq", 1, -1, 0, {OPERAND_NONE}},
{"neq", 1, -1, 0, {OPERAND_NONE}},
{"lt", 1, -1, 0, {OPERAND_NONE}},
{"gt", 1, -1, 0, {OPERAND_NONE}},
{"le", 1, -1, 0, {OPERAND_NONE}},
{"ge", 1, -1, 0, {OPERAND_NONE}},
{"lshift", 1, -1, 0, {OPERAND_NONE}},
{"rshift", 1, -1, 0, {OPERAND_NONE}},
{"add", 1, -1, 0, {OPERAND_NONE}},
{"sub", 1, -1, 0, {OPERAND_NONE}},
{"mult", 1, -1, 0, {OPERAND_NONE}},
{"div", 1, -1, 0, {OPERAND_NONE}},
{"mod", 1, -1, 0, {OPERAND_NONE}},
{"uplus", 1, 0, 0, {OPERAND_NONE}},
{"uminus", 1, 0, 0, {OPERAND_NONE}},
{"bitnot", 1, 0, 0, {OPERAND_NONE}},
{"not", 1, 0, 0, {OPERAND_NONE}},
{"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
{"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
{"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
{"break", 1, 0, 0, {OPERAND_NONE}},
{"continue", 1, 0, 0, {OPERAND_NONE}},
{"foreach_start4", 5, 0, 1, {OPERAND_UINT4}},
{"foreach_step4", 5, +1, 1, {OPERAND_UINT4}},
{"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
{"endCatch", 1, 0, 0, {OPERAND_NONE}},
{"pushResult", 1, +1, 0, {OPERAND_NONE}},
{"pushReturnCode", 1, +1, 0, {OPERAND_NONE}},
{"streq", 1, -1, 0, {OPERAND_NONE}},
{"strneq", 1, -1, 0, {OPERAND_NONE}},
{"strcmp", 1, -1, 0, {OPERAND_NONE}},
{"strlen", 1, 0, 0, {OPERAND_NONE}},
{"strindex", 1, -1, 0, {OPERAND_NONE}},
{"strmatch", 2, -1, 1, {OPERAND_INT1}},
{"list", 5, INT_MIN, 1, {OPERAND_UINT4}},
{"listindex", 1, -1, 0, {OPERAND_NONE}},
{"listlength", 1, 0, 0, {OPERAND_NONE}},
{"appendScalar1", 2, 0, 1, {OPERAND_UINT1}},
{"appendScalar4", 5, 0, 1, {OPERAND_UINT4}},
{"appendArray1", 2, -1, 1, {OPERAND_UINT1}},
{"appendArray4", 5, -1, 1, {OPERAND_UINT4}},
{"appendArrayStk", 1, -2, 0, {OPERAND_NONE}},
{"appendStk", 1, -1, 0, {OPERAND_NONE}},
{"lappendScalar1", 2, 0, 1, {OPERAND_UINT1}},
{"lappendScalar4", 5, 0, 1, {OPERAND_UINT4}},
{"lappendArray1", 2, -1, 1, {OPERAND_UINT1}},
{"lappendArray4", 5, -1, 1, {OPERAND_UINT4}},
{"lappendArrayStk", 1, -2, 0, {OPERAND_NONE}},
{"lappendStk", 1, -1, 0, {OPERAND_NONE}},
{"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}},
{"over", 5, +1, 1, {OPERAND_UINT4}},
{"lsetList", 1, -2, 0, {OPERAND_NONE}},
{"lsetFlat", 5, INT_MIN, 1, {OPERAND_UINT4}},
{0}
};
static void DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static unsigned char * EncodeCmdLocMap _ANSI_ARGS_((
CompileEnv *envPtr, ByteCode *codePtr,
unsigned char *startPtr));
static void EnterCmdExtentData _ANSI_ARGS_((
CompileEnv *envPtr, int cmdNumber,
int numSrcBytes, int numCodeBytes));
static void EnterCmdStartData _ANSI_ARGS_((
CompileEnv *envPtr, int cmdNumber,
int srcOffset, int codeOffset));
static void FreeByteCodeInternalRep _ANSI_ARGS_((
Tcl_Obj *objPtr));
static int GetCmdLocEncodingSize _ANSI_ARGS_((
CompileEnv *envPtr));
static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *script, CONST char *command,
int length));
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats _ANSI_ARGS_((
ByteCode *codePtr));
#endif
static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
Tcl_ObjType tclByteCodeType = {
"bytecode",
FreeByteCodeInternalRep,
DupByteCodeInternalRep,
(Tcl_UpdateStringProc *) NULL,
SetByteCodeFromAny
};
int
TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
CompileHookProc *hookProc;
ClientData clientData;
{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv;
LiteralTable *localTablePtr = &(compEnv.localLitTable);
register AuxData *auxDataPtr;
LiteralEntry *entryPtr;
register int i;
int length, nested, result;
char *string;
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
if (Tcl_LinkVar(interp, "tcl_traceCompile",
(char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
}
traceInitialized = 1;
}
#endif
if (iPtr->evalFlags & TCL_BRACKET_TERM) {
nested = 1;
} else {
nested = 0;
}
string = Tcl_GetStringFromObj(objPtr, &length);
TclInitCompileEnv(interp, &compEnv, string, length);
result = TclCompileScript(interp, string, length, nested, &compEnv);
if (result == TCL_OK) {
compEnv.numSrcBytes = iPtr->termOffset;
TclEmitOpcode(INST_DONE, &compEnv);
if (hookProc) {
result = (*hookProc)(interp, &compEnv, clientData);
}
#ifdef TCL_COMPILE_DEBUG
TclVerifyLocalLiteralTable(&compEnv);
#endif
TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 2) {
TclPrintByteCodeObj(interp, objPtr);
}
#endif
}
if (result != TCL_OK) {
entryPtr = compEnv.literalArrayPtr;
for (i = 0; i < compEnv.literalArrayNext; i++) {
TclReleaseLiteral(interp, entryPtr->objPtr);
entryPtr++;
}
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
#endif
auxDataPtr = compEnv.auxDataArrayPtr;
for (i = 0; i < compEnv.auxDataArrayNext; i++) {
if (auxDataPtr->type->freeProc != NULL) {
auxDataPtr->type->freeProc(auxDataPtr->clientData);
}
auxDataPtr++;
}
}
if (localTablePtr->buckets != localTablePtr->staticBuckets) {
ckfree((char *) localTablePtr->buckets);
}
TclFreeCompileEnv(&compEnv);
return result;
}
static int
SetByteCodeFromAny(interp, objPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
{
return TclSetByteCodeFromAny(interp, objPtr,
(CompileHookProc *) NULL, (ClientData) NULL);
}
static void
DupByteCodeInternalRep(srcPtr, copyPtr)
Tcl_Obj *srcPtr;
Tcl_Obj *copyPtr;
{
return;
}
static void
FreeByteCodeInternalRep(objPtr)
register Tcl_Obj *objPtr;
{
register ByteCode *codePtr =
(ByteCode *) objPtr->internalRep.otherValuePtr;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
objPtr->typePtr = NULL;
objPtr->internalRep.otherValuePtr = NULL;
}
void
TclCleanupByteCode(codePtr)
register ByteCode *codePtr;
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
register Tcl_Obj **objArrayPtr;
register AuxData *auxDataPtr;
int i;
#ifdef TCL_COMPILE_STATS
if (interp != NULL) {
ByteCodeStats *statsPtr;
Tcl_Time destroyTime;
int lifetimeSec, lifetimeMicroSec, log2;
statsPtr = &((Interp *) interp)->stats;
statsPtr->numByteCodesFreed++;
statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes;
statsPtr->currentLitBytes -=
(double) (codePtr->numLitObjects * sizeof(Tcl_Obj *));
statsPtr->currentExceptBytes -=
(double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
statsPtr->currentAuxBytes -=
(double) (codePtr->numAuxDataItems * sizeof(AuxData));
statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
Tcl_GetTime(&destroyTime);
lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
if (lifetimeSec > 2000) {
lifetimeSec = 2000;
}
lifetimeMicroSec =
1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
log2 = TclLog2(lifetimeMicroSec);
if (log2 > 31) {
log2 = 31;
}
statsPtr->lifetimeCount[log2]++;
}
#endif
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
register Tcl_Obj *objPtr;
objArrayPtr = codePtr->objArrayPtr;
for (i = 0; i < numLitObjects; i++) {
objPtr = *objArrayPtr;
if (objPtr) {
Tcl_DecrRefCount(objPtr);
}
objArrayPtr++;
}
codePtr->numLitObjects = 0;
} else if (interp != NULL) {
objArrayPtr = codePtr->objArrayPtr;
for (i = 0; i < numLitObjects; i++) {
if (*objArrayPtr != NULL) {
TclReleaseLiteral(interp, *objArrayPtr);
}
objArrayPtr++;
}
}
auxDataPtr = codePtr->auxDataArrayPtr;
for (i = 0; i < numAuxDataItems; i++) {
if (auxDataPtr->type->freeProc != NULL) {
(*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
}
auxDataPtr++;
}
TclHandleRelease(codePtr->interpHandle);
ckfree((char *) codePtr);
}
void
TclInitCompileEnv(interp, envPtr, string, numBytes)
Tcl_Interp *interp;
register CompileEnv *envPtr;
char *string;
int numBytes;
{
Interp *iPtr = (Interp *) interp;
envPtr->iPtr = iPtr;
envPtr->source = string;
envPtr->numSrcBytes = numBytes;
envPtr->procPtr = iPtr->compiledProcPtr;
envPtr->numCommands = 0;
envPtr->exceptDepth = 0;
envPtr->maxExceptDepth = 0;
envPtr->maxStackDepth = 0;
envPtr->currStackDepth = 0;
TclInitLiteralTable(&(envPtr->localLitTable));
envPtr->codeStart = envPtr->staticCodeSpace;
envPtr->codeNext = envPtr->codeStart;
envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
envPtr->mallocedCodeArray = 0;
envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
envPtr->literalArrayNext = 0;
envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
envPtr->mallocedLiteralArray = 0;
envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
envPtr->exceptArrayNext = 0;
envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
envPtr->mallocedExceptArray = 0;
envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
envPtr->mallocedCmdMap = 0;
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
envPtr->auxDataArrayNext = 0;
envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
envPtr->mallocedAuxDataArray = 0;
}
void
TclFreeCompileEnv(envPtr)
register CompileEnv *envPtr;
{
if (envPtr->mallocedCodeArray) {
ckfree((char *) envPtr->codeStart);
}
if (envPtr->mallocedLiteralArray) {
ckfree((char *) envPtr->literalArrayPtr);
}
if (envPtr->mallocedExceptArray) {
ckfree((char *) envPtr->exceptArrayPtr);
}
if (envPtr->mallocedCmdMap) {
ckfree((char *) envPtr->cmdMapPtr);
}
if (envPtr->mallocedAuxDataArray) {
ckfree((char *) envPtr->auxDataArrayPtr);
}
}
int
TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_Interp *interp;
CONST char *script;
int numBytes;
int nested;
CompileEnv *envPtr;
{
Interp *iPtr = (Interp *) interp;
Tcl_Parse parse;
int lastTopLevelCmdIndex = -1;
int startCodeOffset = -1;
unsigned char *entryCodeNext = envPtr->codeNext;
CONST char *p, *next;
Namespace *cmdNsPtr;
Command *cmdPtr;
Tcl_Token *tokenPtr;
int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
int commandLength, objIndex, code;
char prev;
Tcl_DString ds;
Tcl_DStringInit(&ds);
if (numBytes < 0) {
numBytes = strlen(script);
}
Tcl_ResetResult(interp);
isFirstCmd = 1;
p = script;
bytesLeft = numBytes;
gotParse = 0;
while (bytesLeft > 0) {
if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
code = TCL_ERROR;
goto error;
}
gotParse = 1;
if (parse.numWords > 0) {
if (!isFirstCmd) {
TclEmitOpcode(INST_POP, envPtr);
if (!nested) {
envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- startCodeOffset;
}
}
commandLength = parse.commandSize;
prev = '\0';
if (commandLength > 0) {
prev = parse.commandStart[commandLength-1];
}
if (((parse.commandStart+commandLength) != (script+numBytes))
|| ((prev=='\n') || (nested && (prev==']')))) {
commandLength -= 1;
}
#ifdef TCL_COMPILE_DEBUG
if ((tclTraceCompile >= 1)
&& !nested && (envPtr->procPtr == NULL)) {
fprintf(stdout, " Compiling: ");
TclPrintSource(stdout, parse.commandStart,
TclMin(commandLength, 55));
fprintf(stdout, "\n");
}
#endif
envPtr->numCommands++;
currCmdIndex = (envPtr->numCommands - 1);
if (!nested) {
lastTopLevelCmdIndex = currCmdIndex;
}
startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
EnterCmdStartData(envPtr, currCmdIndex,
(parse.commandStart - envPtr->source), startCodeOffset);
for (wordIdx = 0, tokenPtr = parse.tokenPtr;
wordIdx < parse.numWords;
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
if (wordIdx == 0) {
if (envPtr->procPtr != NULL) {
cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
} else {
cmdNsPtr = NULL;
}
Tcl_DStringSetLength(&ds, 0);
Tcl_DStringAppend(&ds, tokenPtr[1].start,
tokenPtr[1].size);
cmdPtr = (Command *) Tcl_FindCommand(interp,
Tcl_DStringValue(&ds),
(Tcl_Namespace *) cmdNsPtr, 0);
if ((cmdPtr != NULL)
&& (cmdPtr->compileProc != NULL)
&& !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
&& !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
code = (*(cmdPtr->compileProc))(interp, &parse,
envPtr);
if (code == TCL_OK) {
goto finishCommand;
} else if (code == TCL_OUT_LINE_COMPILE) {
} else {
envPtr->numCommands--;
goto error;
}
}
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
envPtr->literalArrayPtr[objIndex].objPtr,
cmdPtr);
}
} else {
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
}
TclEmitPush(objIndex, envPtr);
} else {
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto error;
}
}
}
if (wordIdx > 0) {
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
}
}
finishCommand:
EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
isFirstCmd = 0;
}
next = parse.commandStart + parse.commandSize;
bytesLeft -= (next - p);
p = next;
Tcl_FreeParse(&parse);
gotParse = 0;
if (nested && (p[-1] == ']')) {
break;
}
}
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0),
envPtr);
}
if ((nested != 0) && (p > script) && (p[-1] == ']')) {
iPtr->termOffset = (p - 1) - script;
} else {
iPtr->termOffset = (p - script);
}
Tcl_DStringFree(&ds);
return TCL_OK;
error:
commandLength = parse.commandSize;
prev = '\0';
if (commandLength > 0) {
prev = parse.commandStart[commandLength-1];
}
if (((parse.commandStart+commandLength) != (script+numBytes))
|| ((prev == '\n') || (nested && (prev == ']')))) {
commandLength -= 1;
}
LogCompilationInfo(interp, script, parse.commandStart, commandLength);
if (gotParse) {
Tcl_FreeParse(&parse);
}
iPtr->termOffset = (p - script);
Tcl_DStringFree(&ds);
return code;
}
int
TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_Interp *interp;
Tcl_Token *tokenPtr;
int count;
CompileEnv *envPtr;
{
Tcl_DString textBuffer;
char buffer[TCL_UTF_MAX];
CONST char *name, *p;
int numObjsToConcat, nameBytes, localVarName, localVar;
int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
Tcl_DStringAppend(&textBuffer, tokenPtr->start,
tokenPtr->size);
break;
case TCL_TOKEN_BS:
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
break;
case TCL_TOKEN_COMMAND:
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
literal = TclRegisterLiteral(envPtr,
Tcl_DStringValue(&textBuffer),
Tcl_DStringLength(&textBuffer), 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
}
code = TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, 1, envPtr);
if (code != TCL_OK) {
goto error;
}
numObjsToConcat++;
break;
case TCL_TOKEN_VARIABLE:
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
literal = TclRegisterLiteral(envPtr,
Tcl_DStringValue(&textBuffer),
Tcl_DStringLength(&textBuffer), 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
}
name = tokenPtr[1].start;
nameBytes = tokenPtr[1].size;
localVarName = -1;
if (envPtr->procPtr != NULL) {
localVarName = 1;
for (i = 0, p = name; i < nameBytes; i++, p++) {
if ((*p == ':') && (i < (nameBytes-1))
&& (*(p+1) == ':')) {
localVarName = -1;
break;
} else if ((*p == '(')
&& (tokenPtr->numComponents == 1)
&& (*(name + nameBytes - 1) == ')')) {
localVarName = 0;
break;
}
}
}
localVar = -1;
if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes,
localVarName, 0, envPtr->procPtr);
}
if (localVar < 0) {
TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
envPtr);
}
if (tokenPtr->numComponents == 1) {
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
} else if (localVar <= 255) {
TclEmitInstInt1(INST_LOAD_SCALAR1, localVar,
envPtr);
} else {
TclEmitInstInt4(INST_LOAD_SCALAR4, localVar,
envPtr);
}
} else {
code = TclCompileTokens(interp, tokenPtr+2,
tokenPtr->numComponents-1, envPtr);
if (code != TCL_OK) {
char errorBuffer[150];
sprintf(errorBuffer,
"\n (parsing index for array \"%.*s\")",
((nameBytes > 100)? 100 : nameBytes), name);
Tcl_AddObjErrorInfo(interp, errorBuffer, -1);
goto error;
}
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
} else if (localVar <= 255) {
TclEmitInstInt1(INST_LOAD_ARRAY1, localVar,
envPtr);
} else {
TclEmitInstInt4(INST_LOAD_ARRAY4, localVar,
envPtr);
}
}
numObjsToConcat++;
count -= tokenPtr->numComponents;
tokenPtr += tokenPtr->numComponents;
break;
default:
panic("Unexpected token type in TclCompileTokens");
}
}
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
Tcl_DStringLength(&textBuffer), 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
}
while (numObjsToConcat > 255) {
TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
numObjsToConcat -= 254;
}
if (numObjsToConcat > 1) {
TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
}
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0),
envPtr);
}
Tcl_DStringFree(&textBuffer);
return TCL_OK;
error:
Tcl_DStringFree(&textBuffer);
return code;
}
int
TclCompileCmdWord(interp, tokenPtr, count, envPtr)
Tcl_Interp *interp;
Tcl_Token *tokenPtr;
int count;
CompileEnv *envPtr;
{
int code;
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
0, envPtr);
return code;
}
code = TclCompileTokens(interp, tokenPtr, count, envPtr);
if (code != TCL_OK) {
return code;
}
TclEmitOpcode(INST_EVAL_STK, envPtr);
return TCL_OK;
}
int
TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
Tcl_Interp *interp;
Tcl_Token *tokenPtr;
int numWords;
CompileEnv *envPtr;
{
Tcl_Token *wordPtr;
int range, numBytes, i, code;
CONST char *script;
range = -1;
code = TCL_OK;
if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
script = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
code = TclCompileExpr(interp, script, numBytes, envPtr);
return code;
}
wordPtr = tokenPtr;
for (i = 0; i < numWords; i++) {
code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
envPtr);
if (code != TCL_OK) {
break;
}
if (i < (numWords - 1)) {
TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, 0),
envPtr);
}
wordPtr += (wordPtr->numComponents + 1);
}
if (code == TCL_OK) {
int concatItems = 2*numWords - 1;
while (concatItems > 255) {
TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
concatItems -= 254;
}
if (concatItems > 1) {
TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
}
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
return code;
}
void
TclInitByteCodeObj(objPtr, envPtr)
Tcl_Obj *objPtr;
register CompileEnv *envPtr;
{
register ByteCode *codePtr;
size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
size_t auxDataArrayBytes, structureSize;
register unsigned char *p;
unsigned char *nextPtr;
int numLitObjects = envPtr->literalArrayNext;
Namespace *namespacePtr;
int i;
Interp *iPtr;
iPtr = envPtr->iPtr;
codeBytes = (envPtr->codeNext - envPtr->codeStart);
objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
cmdLocBytes = GetCmdLocEncodingSize(envPtr);
structureSize = sizeof(ByteCode);
structureSize += TCL_ALIGN(codeBytes);
structureSize += TCL_ALIGN(objArrayBytes);
structureSize += TCL_ALIGN(exceptArrayBytes);
structureSize += auxDataArrayBytes;
structureSize += cmdLocBytes;
if (envPtr->iPtr->varFramePtr != NULL) {
namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
} else {
namespacePtr = envPtr->iPtr->globalNsPtr;
}
p = (unsigned char *) ckalloc((size_t) structureSize);
codePtr = (ByteCode *) p;
codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = namespacePtr;
codePtr->nsEpoch = namespacePtr->resolverEpoch;
codePtr->refCount = 1;
codePtr->flags = 0;
codePtr->source = envPtr->source;
codePtr->procPtr = envPtr->procPtr;
codePtr->numCommands = envPtr->numCommands;
codePtr->numSrcBytes = envPtr->numSrcBytes;
codePtr->numCodeBytes = codeBytes;
codePtr->numLitObjects = numLitObjects;
codePtr->numExceptRanges = envPtr->exceptArrayNext;
codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
codePtr->numCmdLocBytes = cmdLocBytes;
codePtr->maxExceptDepth = envPtr->maxExceptDepth;
codePtr->maxStackDepth = envPtr->maxStackDepth;
p += sizeof(ByteCode);
codePtr->codeStart = p;
memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
p += TCL_ALIGN(codeBytes);
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; i++) {
codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
}
p += TCL_ALIGN(objArrayBytes);
if (exceptArrayBytes > 0) {
codePtr->exceptArrayPtr = (ExceptionRange *) p;
memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
(size_t) exceptArrayBytes);
} else {
codePtr->exceptArrayPtr = NULL;
}
p += TCL_ALIGN(exceptArrayBytes);
if (auxDataArrayBytes > 0) {
codePtr->auxDataArrayPtr = (AuxData *) p;
memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
(size_t) auxDataArrayBytes);
} else {
codePtr->auxDataArrayPtr = NULL;
}
p += auxDataArrayBytes;
nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
#ifdef TCL_COMPILE_DEBUG
if (((size_t)(nextPtr - p)) != cmdLocBytes) {
panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
}
#endif
#ifdef TCL_COMPILE_STATS
codePtr->structureSize = structureSize
- (sizeof(size_t) + sizeof(Tcl_Time));
Tcl_GetTime(&(codePtr->createTime));
RecordByteCodeStats(codePtr);
#endif
if ((objPtr->typePtr != NULL) &&
(objPtr->typePtr->freeIntRepProc != NULL)) {
(*objPtr->typePtr->freeIntRepProc)(objPtr);
}
objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
objPtr->typePtr = &tclByteCodeType;
}
static void
LogCompilationInfo(interp, script, command, length)
Tcl_Interp *interp;
CONST char *script;
CONST char *command;
int length;
{
char buffer[200];
register CONST char *p;
char *ellipsis = "";
Interp *iPtr = (Interp *) interp;
if (iPtr->flags & ERR_ALREADY_LOGGED) {
return;
}
iPtr->errorLine = 1;
for (p = script; p != command; p++) {
if (*p == '\n') {
iPtr->errorLine++;
}
}
if (length < 0) {
length = strlen(command);
}
if (length > 150) {
length = 150;
ellipsis = "...";
}
sprintf(buffer, "\n while compiling\n\"%.*s%s\"",
length, command, ellipsis);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
int
TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
register CONST char *name;
int nameBytes;
int create;
int flags;
register Proc *procPtr;
{
register CompiledLocal *localPtr;
int localVar = -1;
register int i;
if (name != NULL) {
int localCt = procPtr->numCompiledLocals;
localPtr = procPtr->firstLocalPtr;
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
char *localName = localPtr->name;
if ((nameBytes == localPtr->nameLength)
&& (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
return i;
}
}
localPtr = localPtr->nextPtr;
}
}
if (create || (name == NULL)) {
localVar = procPtr->numCompiledLocals;
localPtr = (CompiledLocal *) ckalloc((unsigned)
(sizeof(CompiledLocal) - sizeof(localPtr->name)
+ nameBytes+1));
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
procPtr->lastLocalPtr->nextPtr = localPtr;
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
localPtr->nameLength = nameBytes;
localPtr->frameIndex = localVar;
localPtr->flags = flags | VAR_UNDEFINED;
if (name == NULL) {
localPtr->flags |= VAR_TEMPORARY;
}
localPtr->defValuePtr = NULL;
localPtr->resolveInfo = NULL;
if (name != NULL) {
memcpy((VOID *) localPtr->name, (VOID *) name,
(size_t) nameBytes);
}
localPtr->name[nameBytes] = '\0';
procPtr->numCompiledLocals++;
}
return localVar;
}
void
TclInitCompiledLocals(interp, framePtr, nsPtr)
Tcl_Interp *interp;
CallFrame *framePtr;
Namespace *nsPtr;
{
register CompiledLocal *localPtr;
Interp *iPtr = (Interp*) interp;
Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
Var *varPtr = framePtr->compiledLocals;
Var *resolvedVarPtr;
ResolverScheme *resPtr;
int result;
for (localPtr = framePtr->procPtr->firstLocalPtr;
localPtr != NULL;
localPtr = localPtr->nextPtr) {
if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
&& (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
resPtr = iPtr->resolverPtr;
if (nsPtr->compiledVarResProc) {
result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
localPtr->name, localPtr->nameLength,
(Tcl_Namespace *) nsPtr, &vinfo);
} else {
result = TCL_CONTINUE;
}
while ((result == TCL_CONTINUE) && resPtr) {
if (resPtr->compiledVarResProc) {
result = (*resPtr->compiledVarResProc)(nsPtr->interp,
localPtr->name, localPtr->nameLength,
(Tcl_Namespace *) nsPtr, &vinfo);
}
resPtr = resPtr->nextPtr;
}
if (result == TCL_OK) {
localPtr->resolveInfo = vinfo;
localPtr->flags |= VAR_RESOLVED;
}
}
resVarInfo = localPtr->resolveInfo;
resolvedVarPtr = NULL;
if (resVarInfo && resVarInfo->fetchProc) {
resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
resVarInfo);
}
if (resolvedVarPtr) {
varPtr->name = localPtr->name;
varPtr->nsPtr = NULL;
varPtr->hPtr = NULL;
varPtr->refCount = 0;
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
varPtr->flags = 0;
TclSetVarLink(varPtr);
varPtr->value.linkPtr = resolvedVarPtr;
resolvedVarPtr->refCount++;
} else {
varPtr->value.objPtr = NULL;
varPtr->name = localPtr->name;
varPtr->nsPtr = NULL;
varPtr->hPtr = NULL;
varPtr->refCount = 0;
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
varPtr->flags = localPtr->flags;
}
varPtr++;
}
}
void
TclExpandCodeArray(envArgPtr)
void *envArgPtr;
{
CompileEnv *envPtr = (CompileEnv*) envArgPtr;
size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
if (envPtr->mallocedCodeArray) {
ckfree((char *) envPtr->codeStart);
}
envPtr->codeStart = newPtr;
envPtr->codeNext = (newPtr + currBytes);
envPtr->codeEnd = (newPtr + newBytes);
envPtr->mallocedCodeArray = 1;
}
static void
EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
CompileEnv *envPtr;
int cmdIndex;
int srcOffset;
int codeOffset;
{
CmdLocation *cmdLocPtr;
if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
}
if (cmdIndex >= envPtr->cmdMapEnd) {
size_t currElems = envPtr->cmdMapEnd;
size_t newElems = 2*currElems;
size_t currBytes = currElems * sizeof(CmdLocation);
size_t newBytes = newElems * sizeof(CmdLocation);
CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
if (envPtr->mallocedCmdMap) {
ckfree((char *) envPtr->cmdMapPtr);
}
envPtr->cmdMapPtr = (CmdLocation *) newPtr;
envPtr->cmdMapEnd = newElems;
envPtr->mallocedCmdMap = 1;
}
if (cmdIndex > 0) {
if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
panic("EnterCmdStartData: cmd map not sorted by code offset");
}
}
cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->srcOffset = srcOffset;
cmdLocPtr->numSrcBytes = -1;
cmdLocPtr->numCodeBytes = -1;
}
static void
EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
CompileEnv *envPtr;
int cmdIndex;
int numSrcBytes;
int numCodeBytes;
{
CmdLocation *cmdLocPtr;
if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
}
if (cmdIndex > envPtr->cmdMapEnd) {
panic("EnterCmdExtentData: missing start data for command %d\n",
cmdIndex);
}
cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
cmdLocPtr->numSrcBytes = numSrcBytes;
cmdLocPtr->numCodeBytes = numCodeBytes;
}
int
TclCreateExceptRange(type, envPtr)
ExceptionRangeType type;
register CompileEnv *envPtr;
{
register ExceptionRange *rangePtr;
int index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
size_t currBytes =
envPtr->exceptArrayNext * sizeof(ExceptionRange);
int newElems = 2*envPtr->exceptArrayEnd;
size_t newBytes = newElems * sizeof(ExceptionRange);
ExceptionRange *newPtr = (ExceptionRange *)
ckalloc((unsigned) newBytes);
memcpy((VOID *) newPtr, (VOID *) envPtr->exceptArrayPtr,
currBytes);
if (envPtr->mallocedExceptArray) {
ckfree((char *) envPtr->exceptArrayPtr);
}
envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
envPtr->exceptArrayEnd = newElems;
envPtr->mallocedExceptArray = 1;
}
envPtr->exceptArrayNext++;
rangePtr = &(envPtr->exceptArrayPtr[index]);
rangePtr->type = type;
rangePtr->nestingLevel = envPtr->exceptDepth;
rangePtr->codeOffset = -1;
rangePtr->numCodeBytes = -1;
rangePtr->breakOffset = -1;
rangePtr->continueOffset = -1;
rangePtr->catchOffset = -1;
return index;
}
int
TclCreateAuxData(clientData, typePtr, envPtr)
ClientData clientData;
AuxDataType *typePtr;
register CompileEnv *envPtr;
{
int index;
register AuxData *auxDataPtr;
index = envPtr->auxDataArrayNext;
if (index >= envPtr->auxDataArrayEnd) {
size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
int newElems = 2*envPtr->auxDataArrayEnd;
size_t newBytes = newElems * sizeof(AuxData);
AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
currBytes);
if (envPtr->mallocedAuxDataArray) {
ckfree((char *) envPtr->auxDataArrayPtr);
}
envPtr->auxDataArrayPtr = newPtr;
envPtr->auxDataArrayEnd = newElems;
envPtr->mallocedAuxDataArray = 1;
}
envPtr->auxDataArrayNext++;
auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
auxDataPtr->clientData = clientData;
auxDataPtr->type = typePtr;
return index;
}
void
TclInitJumpFixupArray(fixupArrayPtr)
register JumpFixupArray *fixupArrayPtr;
{
fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
fixupArrayPtr->next = 0;
fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
fixupArrayPtr->mallocedArray = 0;
}
void
TclExpandJumpFixupArray(fixupArrayPtr)
register JumpFixupArray *fixupArrayPtr;
{
size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
int newElems = 2*(fixupArrayPtr->end + 1);
size_t newBytes = newElems * sizeof(JumpFixup);
JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
if (fixupArrayPtr->mallocedArray) {
ckfree((char *) fixupArrayPtr->fixup);
}
fixupArrayPtr->fixup = (JumpFixup *) newPtr;
fixupArrayPtr->end = newElems;
fixupArrayPtr->mallocedArray = 1;
}
void
TclFreeJumpFixupArray(fixupArrayPtr)
register JumpFixupArray *fixupArrayPtr;
{
if (fixupArrayPtr->mallocedArray) {
ckfree((char *) fixupArrayPtr->fixup);
}
}
void
TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
CompileEnv *envPtr;
TclJumpType jumpType;
JumpFixup *jumpFixupPtr;
{
jumpFixupPtr->jumpType = jumpType;
jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
jumpFixupPtr->cmdIndex = envPtr->numCommands;
jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
switch (jumpType) {
case TCL_UNCONDITIONAL_JUMP:
TclEmitInstInt1(INST_JUMP1, 0, envPtr);
break;
case TCL_TRUE_JUMP:
TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr);
break;
default:
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
break;
}
}
int
TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
CompileEnv *envPtr;
JumpFixup *jumpFixupPtr;
int jumpDist;
int distThreshold;
{
unsigned char *jumpPc, *p;
int firstCmd, lastCmd, firstRange, lastRange, k;
unsigned int numBytes;
if (jumpDist <= distThreshold) {
jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
switch (jumpFixupPtr->jumpType) {
case TCL_UNCONDITIONAL_JUMP:
TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
break;
case TCL_TRUE_JUMP:
TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
break;
default:
TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
break;
}
return 0;
}
if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
TclExpandCodeArray(envPtr);
}
jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
numBytes > 0; numBytes--, p--) {
p[3] = p[0];
}
envPtr->codeNext += 3;
jumpDist += 3;
switch (jumpFixupPtr->jumpType) {
case TCL_UNCONDITIONAL_JUMP:
TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc);
break;
case TCL_TRUE_JUMP:
TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc);
break;
default:
TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
break;
}
firstCmd = jumpFixupPtr->cmdIndex;
lastCmd = (envPtr->numCommands - 1);
if (firstCmd < lastCmd) {
for (k = firstCmd; k <= lastCmd; k++) {
(envPtr->cmdMapPtr[k]).codeOffset += 3;
}
}
firstRange = jumpFixupPtr->exceptIndex;
lastRange = (envPtr->exceptArrayNext - 1);
for (k = firstRange; k <= lastRange; k++) {
ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
rangePtr->codeOffset += 3;
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
rangePtr->breakOffset += 3;
if (rangePtr->continueOffset != -1) {
rangePtr->continueOffset += 3;
}
break;
case CATCH_EXCEPTION_RANGE:
rangePtr->catchOffset += 3;
break;
default:
panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
rangePtr->type);
}
}
return 1;
}
void *
TclGetInstructionTable()
{
return &tclInstructionTable[0];
}
void
TclRegisterAuxDataType(typePtr)
AuxDataType *typePtr;
{
register Tcl_HashEntry *hPtr;
int new;
Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
if (hPtr != (Tcl_HashEntry *) NULL) {
Tcl_DeleteHashEntry(hPtr);
}
hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
Tcl_MutexUnlock(&tableMutex);
}
AuxDataType *
TclGetAuxDataType(typeName)
char *typeName;
{
register Tcl_HashEntry *hPtr;
AuxDataType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
}
Tcl_MutexUnlock(&tableMutex);
return typePtr;
}
void
TclInitAuxDataTypeTable()
{
auxDataTypeTableInitialized = 1;
Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
TclRegisterAuxDataType(&tclForeachInfoType);
}
void
TclFinalizeAuxDataTypeTable()
{
Tcl_MutexLock(&tableMutex);
if (auxDataTypeTableInitialized) {
Tcl_DeleteHashTable(&auxDataTypeTable);
auxDataTypeTableInitialized = 0;
}
Tcl_MutexUnlock(&tableMutex);
}
static int
GetCmdLocEncodingSize(envPtr)
CompileEnv *envPtr;
{
register CmdLocation *mapPtr = envPtr->cmdMapPtr;
int numCmds = envPtr->numCommands;
int codeDelta, codeLen, srcDelta, srcLen;
int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
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;
}
prevCodeOffset = mapPtr[i].codeOffset;
codeLen = mapPtr[i].numCodeBytes;
if (codeLen < 0) {
panic("GetCmdLocEncodingSize: bad code length");
} else if (codeLen <= 127) {
codeLengthNext++;
} else {
codeLengthNext += 5;
}
srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
if ((-127 <= srcDelta) && (srcDelta <= 127)) {
srcDeltaNext++;
} else {
srcDeltaNext += 5;
}
prevSrcOffset = mapPtr[i].srcOffset;
srcLen = mapPtr[i].numSrcBytes;
if (srcLen < 0) {
panic("GetCmdLocEncodingSize: bad source length");
} else if (srcLen <= 127) {
srcLengthNext++;
} else {
srcLengthNext += 5;
}
}
return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
}
static unsigned char *
EncodeCmdLocMap(envPtr, codePtr, startPtr)
CompileEnv *envPtr;
ByteCode *codePtr;
unsigned char *startPtr;
{
register CmdLocation *mapPtr = envPtr->cmdMapPtr;
int numCmds = envPtr->numCommands;
register unsigned char *p = startPtr;
int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
register int i;
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;
}
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;
}
}
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;
}
codePtr->srcLengthStart = p;
for (i = 0; i < numCmds; i++) {
srcLen = mapPtr[i].numSrcBytes;
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;
}
#ifdef TCL_COMPILE_DEBUG
void
TclPrintByteCodeObj(interp, objPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
{
ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
if (codePtr->refCount <= 0) {
return;
}
codeStart = codePtr->codeStart;
codeLimit = (codeStart + codePtr->numCodeBytes);
numCmds = codePtr->numCommands;
fprintf(stdout, "\nByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
(unsigned int) codePtr, codePtr->refCount,
codePtr->compileEpoch, (unsigned int) iPtr,
iPtr->compileEpoch);
fprintf(stdout, " Source ");
TclPrintSource(stdout, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
fprintf(stdout, "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
(codePtr->numSrcBytes?
((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
#else
0.0);
#endif
#ifdef TCL_COMPILE_STATS
fprintf(stdout,
" Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
codePtr->structureSize,
(sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
codePtr->numCodeBytes,
(codePtr->numLitObjects * sizeof(Tcl_Obj *)),
(codePtr->numExceptRanges * sizeof(ExceptionRange)),
(codePtr->numAuxDataItems * sizeof(AuxData)),
codePtr->numCmdLocBytes);
#endif
if (codePtr->procPtr != NULL) {
Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
fprintf(stdout,
" Proc 0x%x, refCt %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, " slot %d%s%s%s%s%s%s", i,
((localPtr->flags & VAR_SCALAR)? ", scalar" : ""),
((localPtr->flags & VAR_ARRAY)? ", array" : ""),
((localPtr->flags & VAR_LINK)? ", link" : ""),
((localPtr->flags & VAR_ARGUMENT)? ", arg" : ""),
((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "\n");
} else {
fprintf(stdout, ", \"%s\"\n", localPtr->name);
}
localPtr = localPtr->nextPtr;
}
}
}
if (codePtr->numExceptRanges > 0) {
fprintf(stdout, " Exception ranges %d, depth %d:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < codePtr->numExceptRanges; i++) {
ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[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("TclPrintByteCodeObj: bad ExceptionRange type %d\n",
rangePtr->type);
}
}
}
if (numCmds == 0) {
pc = codeStart;
while (pc < codeLimit) {
fprintf(stdout, " ");
pc += TclPrintInstruction(codePtr, pc);
}
return;
}
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++) {
if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
} else {
delta = TclGetInt1AtPtr(codeDeltaNext);
codeDeltaNext++;
}
codeOffset += delta;
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, src %d-%d",
((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
}
if (numCmds > 0) {
fprintf(stdout, "\n");
}
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++;
}
while ((pc-codeStart) < codeOffset) {
fprintf(stdout, " ");
pc += TclPrintInstruction(codePtr, pc);
}
fprintf(stdout, " Command %d: ", (i+1));
TclPrintSource(stdout, (codePtr->source + srcOffset),
TclMin(srcLen, 55));
fprintf(stdout, "\n");
}
if (pc < codeLimit) {
while (pc < codeLimit) {
fprintf(stdout, " ");
pc += TclPrintInstruction(codePtr, pc);
}
}
}
#endif
int
TclPrintInstruction(codePtr, pc)
ByteCode* codePtr;
unsigned char *pc;
{
Proc *procPtr = codePtr->procPtr;
unsigned char opCode = *pc;
register InstructionDesc *instDesc = &tclInstructionTable[opCode];
unsigned char *codeStart = codePtr->codeStart;
unsigned int pcOffset = (pc - codeStart);
int opnd, i, j;
fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
opnd = TclGetInt1AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP1)
|| (opCode == INST_JUMP_TRUE1)
|| (opCode == INST_JUMP_FALSE1))) {
fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
} else {
fprintf(stdout, "%d", opnd);
}
break;
case OPERAND_INT4:
opnd = TclGetInt4AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP4)
|| (opCode == INST_JUMP_TRUE4)
|| (opCode == INST_JUMP_FALSE4))) {
fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
} else {
fprintf(stdout, "%d", opnd);
}
break;
case OPERAND_UINT1:
opnd = TclGetUInt1AtPtr(pc+1+i);
if ((i == 0) && (opCode == INST_PUSH1)) {
fprintf(stdout, "%u # ", (unsigned int) opnd);
TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
} else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
|| (opCode == INST_LOAD_ARRAY1)
|| (opCode == INST_STORE_SCALAR1)
|| (opCode == INST_STORE_ARRAY1))) {
int localCt = procPtr->numCompiledLocals;
CompiledLocal *localPtr = procPtr->firstLocalPtr;
if (opnd >= localCt) {
panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
(unsigned int) opnd, localCt);
return instDesc->numBytes;
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "%u # temp var %u",
(unsigned int) opnd, (unsigned int) opnd);
} else {
fprintf(stdout, "%u # var ", (unsigned int) opnd);
TclPrintSource(stdout, localPtr->name, 40);
}
} else {
fprintf(stdout, "%u ", (unsigned int) opnd);
}
break;
case OPERAND_UINT4:
opnd = TclGetUInt4AtPtr(pc+1+i);
if (opCode == INST_PUSH4) {
fprintf(stdout, "%u # ", opnd);
TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
} else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
|| (opCode == INST_LOAD_ARRAY4)
|| (opCode == INST_STORE_SCALAR4)
|| (opCode == INST_STORE_ARRAY4))) {
int localCt = procPtr->numCompiledLocals;
CompiledLocal *localPtr = procPtr->firstLocalPtr;
if (opnd >= localCt) {
panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
(unsigned int) opnd, localCt);
return instDesc->numBytes;
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "%u # temp var %u",
(unsigned int) opnd, (unsigned int) opnd);
} else {
fprintf(stdout, "%u # var ", (unsigned int) opnd);
TclPrintSource(stdout, localPtr->name, 40);
}
} else {
fprintf(stdout, "%u ", (unsigned int) opnd);
}
break;
case OPERAND_NONE:
default:
break;
}
}
fprintf(stdout, "\n");
return instDesc->numBytes;
}
void
TclPrintObject(outFile, objPtr, maxChars)
FILE *outFile;
Tcl_Obj *objPtr;
int maxChars;
{
char *bytes;
int length;
bytes = Tcl_GetStringFromObj(objPtr, &length);
TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
void
TclPrintSource(outFile, string, maxChars)
FILE *outFile;
CONST char *string;
int maxChars;
{
register CONST char *p;
register int i = 0;
if (string == NULL) {
fprintf(outFile, "\"\"");
return;
}
fprintf(outFile, "\"");
p = string;
for (; (*p != '\0') && (i < maxChars); p++, i++) {
switch (*p) {
case '"':
fprintf(outFile, "\\\"");
continue;
case '\f':
fprintf(outFile, "\\f");
continue;
case '\n':
fprintf(outFile, "\\n");
continue;
case '\r':
fprintf(outFile, "\\r");
continue;
case '\t':
fprintf(outFile, "\\t");
continue;
case '\v':
fprintf(outFile, "\\v");
continue;
default:
fprintf(outFile, "%c", *p);
continue;
}
}
fprintf(outFile, "\"");
}
#ifdef TCL_COMPILE_STATS
void
RecordByteCodeStats(codePtr)
ByteCode *codePtr;
{
Interp *iPtr = (Interp *) *codePtr->interpHandle;
register ByteCodeStats *statsPtr = &(iPtr->stats);
statsPtr->numCompilations++;
statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
statsPtr->currentLitBytes +=
(double) (codePtr->numLitObjects * sizeof(Tcl_Obj *));
statsPtr->currentExceptBytes +=
(double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
statsPtr->currentAuxBytes +=
(double) (codePtr->numAuxDataItems * sizeof(AuxData));
statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
}
#endif