summaryrefslogtreecommitdiffstats
path: root/generic/tclAssembly.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclAssembly.c')
-rw-r--r--generic/tclAssembly.c445
1 files changed, 230 insertions, 215 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 754941f..d1866c8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1,5 +1,5 @@
/*
- * tclAssembly,c --
+ * tclAssembly.c --
*
* Assembler for Tcl bytecodes.
*
@@ -20,12 +20,13 @@
*- break and continue - if exception ranges can be sorted out.
*- foreach_start4, foreach_step4
*- returnImm, returnStk
- *- expandStart, expandStkTop, invokeExpanded
+ *- expandStart, expandStkTop, invokeExpanded, expandDrop
*- dictFirst, dictNext, dictDone
*- dictUpdateStart, dictUpdateEnd
*- jumpTable testing
*- syntax (?)
*- returnCodeBranch
+ *- tclooNext, tclooNextClass
*/
#include "tclInt.h"
@@ -49,7 +50,7 @@ typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
BBCS_NONE, /* Block is outside of any catch */
BBCS_INCATCH, /* Block is within a catch context */
- BBCS_CAUGHT, /* Block is within a catch context and
+ BBCS_CAUGHT /* Block is within a catch context and
* may be executed after an exception fires */
} BasicBlockCatchState;
@@ -84,7 +85,7 @@ typedef struct BasicBlock {
* unresolved */
int initialStackDepth; /* Absolute stack depth on entry */
int minStackDepth; /* Low-water relative stack depth */
- int maxStackDepth; /* High-water relative stack depth */
+ int maxStackDepth; /* High-water relative stack depth */
int finalStackDepth; /* Relative stack depth on exit */
enum BasicBlockCatchState catchState;
/* State of the block for 'catch' analysis */
@@ -120,7 +121,7 @@ enum BasicBlockFlags {
* marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
- BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
+ BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction,
* unwinding the catch from the exception
* stack. */
};
@@ -183,7 +184,7 @@ typedef enum TalInstType {
* produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand
* (INCR_STK_IMM) */
- ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
+ ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by
* LVT entry. Fixed arity */
} TalInstType;
@@ -193,7 +194,7 @@ typedef enum TalInstType {
typedef struct TalInstDesc {
const char *name; /* Name of instruction. */
- TalInstType instType; /* The type of instruction */
+ TalInstType instType; /* The type of instruction */
int tclInstCode; /* Instruction code. For instructions having
* 1- and 4-byte variables, tclInstCode is
* ((1byte)<<8) || (4byte) */
@@ -265,7 +266,7 @@ static int CheckStrictlyPositive(Tcl_Interp*, int);
static ByteCode * CompileAssembleObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
- TalInstDesc*);
+ const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
static void DupAssembleCodeInternalRep(Tcl_Obj* src,
@@ -324,33 +325,10 @@ static const Tcl_ObjType assembleCodeType = {
};
/*
- * TIP #280: Remember the per-word line information of the current command. An
- * index is used instead of a pointer as recursive compilation may reallocate,
- * i.e. move, the array. This is also the reason to save the nuloc now, it may
- * change during the course of the function.
- *
- * Macro to encapsulate the variable definition and setup.
- */
-
-#define DefineLineInformation \
- ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
- int eclIndex = mapPtr->nuloc - 1
-
-#define SetLineInformation(word) \
- envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
- envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
-
-/*
- * Flags bits used by PushVarName.
- */
-
-#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
-
-/*
* Source instructions recognized in the Tcl Assembly Language (TAL)
*/
-TalInstDesc TalInstructionTable[] = {
+static const TalInstDesc TalInstructionTable[] = {
/* PUSH must be first, see the code near the end of TclAssembleCode */
{"push", ASSEM_PUSH, (INST_PUSH1<<8
| INST_PUSH4), 0, 1},
@@ -362,18 +340,29 @@ TalInstDesc TalInstructionTable[] = {
| INST_APPEND_ARRAY4), 2, 1},
{"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1},
{"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1},
+ {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1},
+ {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1},
+ {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0},
+ {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0},
{"beginCatch", ASSEM_BEGIN_CATCH,
INST_BEGIN_CATCH4, 0, 0},
{"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1},
{"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
{"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
- {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
+ {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
+ {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1},
+ {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
+ {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
+ {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1},
+ {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1},
{"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
{"dictIncrImm", ASSEM_SINT4_LVT4,
INST_DICT_INCR_IMM, 1, 1},
{"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1},
+ {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0},
+ {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0},
{"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1},
{"dictUnset", ASSEM_DICT_UNSET,
INST_DICT_UNSET, INT_MIN,1},
@@ -400,9 +389,10 @@ TalInstDesc TalInstructionTable[] = {
{"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1},
{"incrImm", ASSEM_LVT1_SINT1,
INST_INCR_SCALAR1_IMM, 0, 1},
- {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1},
- {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM,
- 1, 1},
+ {"incrStk", ASSEM_1BYTE, INST_INCR_STK, 2, 1},
+ {"incrStkImm", ASSEM_SINT1, INST_INCR_STK_IMM, 1, 1},
+ {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1},
+ {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1},
{"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8
| INST_INVOKE_STK4), INT_MIN,1},
{"jump", ASSEM_JUMP, INST_JUMP1, 0, 0},
@@ -425,6 +415,7 @@ TalInstDesc TalInstructionTable[] = {
{"lindexMulti", ASSEM_LINDEX_MULTI,
INST_LIST_INDEX_MULTI, INT_MIN,1},
{"list", ASSEM_LIST, INST_LIST, INT_MIN,1},
+ {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 1},
{"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1},
{"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1},
{"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1},
@@ -435,7 +426,7 @@ TalInstDesc TalInstructionTable[] = {
{"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8
| INST_LOAD_ARRAY4), 1, 1},
{"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
- {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1},
+ {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1},
{"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
{"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
{"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
@@ -447,6 +438,8 @@ TalInstDesc TalInstructionTable[] = {
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
+ {"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1},
+ {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1},
{"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
{"pop", ASSEM_1BYTE, INST_POP, 1, 0},
{"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
@@ -454,6 +447,7 @@ TalInstDesc TalInstructionTable[] = {
0, 1},
{"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1},
{"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1},
+ {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1},
{"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0},
{"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1},
{"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8
@@ -461,14 +455,31 @@ TalInstDesc TalInstructionTable[] = {
{"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8
| INST_STORE_ARRAY4), 2, 1},
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
- {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1},
+ {"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1},
+ {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
+ {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
+ {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
{"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
{"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
+ {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1},
{"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
{"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1},
+ {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1},
{"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
+ {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
+ {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
+ {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
+ {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
+ {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
+ {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1},
{"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
+ {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1},
+ {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
+ {"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
+ {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
+ {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
@@ -478,6 +489,8 @@ TalInstDesc TalInstructionTable[] = {
{"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
{"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1},
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
+ {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0},
+ {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1},
{NULL, 0, 0, 0, 0}
};
@@ -489,14 +502,25 @@ TalInstDesc TalInstructionTable[] = {
* The instructions must be in ascending order by numeric operation code.
*/
-static unsigned char NonThrowingByteCodes[] = {
+static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
INST_JUMP1, INST_JUMP4, /* 34-35 */
INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_LIST, /* 79 */
INST_OVER, /* 95 */
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
- INST_NOP /* 132 */
+ INST_NOP, /* 132 */
+ INST_STR_MAP, /* 143 */
+ INST_STR_FIND, /* 144 */
+ INST_COROUTINE_NAME, /* 149 */
+ INST_NS_CURRENT, /* 151 */
+ INST_INFO_LEVEL_NUM, /* 152 */
+ INST_RESOLVE_COMMAND, /* 154 */
+ INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
+ INST_CONCAT_STK, /* 169 */
+ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
+ INST_NUM_TYPE /* 180 */
};
/*
@@ -644,7 +668,7 @@ BBEmitOpcode(
}
TclEmitInt1(op, envPtr);
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
@@ -676,7 +700,7 @@ BBEmitInstInt4(
* BBEmitInst1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand
+ * operand.
*
*-----------------------------------------------------------------------------
*/
@@ -705,7 +729,7 @@ BBEmitInst1or4(
} else {
TclEmitInt4(param, envPtr);
}
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
@@ -769,12 +793,10 @@ TclNRAssembleObjCmd(
if (codePtr == NULL) {
Tcl_AddErrorInfo(interp, "\n (\"");
- Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+ Tcl_AppendObjToErrorInfo(interp, objv[0]);
Tcl_AddErrorInfo(interp, "\" body, line ");
backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
- Tcl_IncrRefCount(backtrace);
- Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
- Tcl_DecrRefCount(backtrace);
+ Tcl_AppendObjToErrorInfo(interp, backtrace);
Tcl_AddErrorInfo(interp, ")");
return TCL_ERROR;
}
@@ -783,11 +805,6 @@ TclNRAssembleObjCmd(
* Use NRE to evaluate the bytecode from the trampoline.
*/
-#if 0
- Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
- NULL, NULL);
- return TCL_OK;
-#endif
return TclNRExecuteByteCode(interp, codePtr);
}
@@ -823,6 +840,7 @@ CompileAssembleObj(
const char* source; /* String representation of the source code */
int sourceLen; /* Length of the source code in bytes */
+
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
@@ -830,17 +848,21 @@ CompileAssembleObj(
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsPtr != namespacePtr)
- || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
- || (codePtr->localCachePtr
- != iPtr->varFramePtr->localCachePtr)) {
- FreeAssembleCodeInternalRep(objPtr);
- } else {
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (((Interp *) *codePtr->interpHandle == iPtr)
+ && (codePtr->compileEpoch == iPtr->compileEpoch)
+ && (codePtr->nsPtr == namespacePtr)
+ && (codePtr->nsEpoch == namespacePtr->resolverEpoch)
+ && (codePtr->localCachePtr
+ == iPtr->varFramePtr->localCachePtr)) {
return codePtr;
}
+
+ /*
+ * Not valid, so free it and regenerate.
+ */
+
+ FreeAssembleCodeInternalRep(objPtr);
}
/*
@@ -854,7 +876,6 @@ CompileAssembleObj(
/*
* Assembly failed. Clean up and report the error.
*/
-
TclFreeCompileEnv(&compEnv);
return NULL;
}
@@ -874,7 +895,7 @@ CompileAssembleObj(
* Record the local variable context to which the bytecode pertains
*/
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -927,6 +948,10 @@ TclCompileAssembleCmd(
{
Tcl_Token *tokenPtr; /* Token in the input script */
+ int numCommands = envPtr->numCommands;
+ int offset = envPtr->codeNext - envPtr->codeStart;
+ int depth = envPtr->currStackDepth;
+
/*
* Make sure that the command has a single arg that is a simple word.
*/
@@ -940,10 +965,23 @@ TclCompileAssembleCmd(
}
/*
- * Compile the code and return any error from the compilation.
+ * Compile the code and convert any error from the compilation into
+ * bytecode reporting the error;
*/
- return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+ tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.*s\" body, line %d)",
+ parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+ Tcl_GetErrorLine(interp)));
+ envPtr->numCommands = numCommands;
+ envPtr->codeNext = envPtr->codeStart + offset;
+ envPtr->currStackDepth = depth;
+ TclCompileSyntaxError(interp, envPtr);
+ }
+ return TCL_OK;
}
/*
@@ -967,7 +1005,7 @@ TclCompileAssembleCmd(
static int
TclAssembleCode(
- CompileEnv *envPtr, /* Compilation environment that is to receive
+ CompileEnv *envPtr, /* Compilation environment that is to receive
* the generated bytecode */
const char* codePtr, /* Assembly-language code to be processed */
int codeLen, /* Length of the code */
@@ -982,8 +1020,6 @@ TclAssembleCode(
const char* instPtr = codePtr;
/* Where to start looking for a line of code */
- int instLen; /* Length in bytes of the current line of
- * code */
const char* nextPtr; /* Pointer to the end of the line of code */
int bytesLeft = codeLen; /* Number of bytes of source code remaining to
* be parsed */
@@ -997,10 +1033,6 @@ TclAssembleCode(
*/
status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
- instLen = parsePtr->commandSize;
- if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
- --instLen;
- }
/*
* Report errors in the parse.
@@ -1009,7 +1041,7 @@ TclAssembleCode(
if (status != TCL_OK) {
if (flags & TCL_EVAL_DIRECT) {
Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
- instLen);
+ parsePtr->term + 1 - parsePtr->commandStart);
}
FreeAssemblyEnv(assemEnvPtr);
return TCL_ERROR;
@@ -1029,14 +1061,21 @@ TclAssembleCode(
*/
if (parsePtr->numWords > 0) {
+ int instLen = parsePtr->commandSize;
+ /* Length in bytes of the current command */
+
+ if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+ --instLen;
+ }
+
/*
* If tracing, show each line assembled as it happens.
*/
#ifdef TCL_COMPILE_DEBUG
if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
- printf(" %4d Assembling: ",
- envPtr->codeNext - envPtr->codeStart);
+ printf(" %4ld Assembling: ",
+ (long)(envPtr->codeNext - envPtr->codeStart));
TclPrintSource(stdout, parsePtr->commandStart,
TclMin(instLen, 55));
printf("\n");
@@ -1104,7 +1143,7 @@ NewAssemblyEnv(
assemEnvPtr->envPtr = envPtr;
assemEnvPtr->parsePtr = parsePtr;
- assemEnvPtr->cmdLine = envPtr->line;
+ assemEnvPtr->cmdLine = 1;
assemEnvPtr->clNext = envPtr->clNext;
/*
@@ -1173,24 +1212,10 @@ FreeAssemblyEnv(
}
/*
- * Free the label hash.
- */
-
- while (1) {
- Tcl_HashEntry* hashEntry;
- Tcl_HashSearch hashSearch;
-
- hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch);
- if (hashEntry == NULL) {
- break;
- }
- Tcl_DeleteHashEntry(hashEntry);
- }
-
- /*
* Dispose what's left.
*/
+ Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
TclStackFree(interp, assemEnvPtr->parsePtr);
TclStackFree(interp, assemEnvPtr);
}
@@ -1222,13 +1247,12 @@ AssembleOneLine(
Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
/* Parse of the line of code */
Tcl_Token* tokenPtr; /* Current token within the line of code */
- Tcl_Obj* instNameObj = NULL;
- /* Name of the instruction */
+ Tcl_Obj* instNameObj; /* Name of the instruction */
int tblIdx; /* Index in TalInstructionTable of the
* instruction */
enum TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
- /* First operand to the instruction */
+ /* First operand to the instruction */
const char* operand1; /* String rep of the operand */
int operand1Len; /* String length of the operand */
int opnd; /* Integer representation of an operand */
@@ -1244,8 +1268,6 @@ AssembleOneLine(
*/
tokenPtr = parsePtr->tokenPtr;
- instNameObj = Tcl_NewObj();
- Tcl_IncrRefCount(instNameObj);
if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
return TCL_ERROR;
}
@@ -1257,7 +1279,7 @@ AssembleOneLine(
if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
&TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
TCL_EXACT, &tblIdx) != TCL_OK) {
- return TCL_ERROR;
+ goto cleanup;
}
/*
@@ -1326,8 +1348,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
goto cleanup;
}
- if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
@@ -1365,8 +1390,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
@@ -1379,8 +1407,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
@@ -1574,7 +1605,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1585,8 +1617,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
@@ -1597,8 +1629,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)
|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckSignedOneByte(interp, opnd)) {
goto cleanup;
@@ -1612,7 +1644,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1674,8 +1707,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
- if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
@@ -1689,9 +1725,7 @@ AssembleOneLine(
status = TCL_OK;
cleanup:
- if (instNameObj) {
- Tcl_DecrRefCount(instNameObj);
- }
+ Tcl_DecrRefCount(instNameObj);
if (operand1Obj) {
Tcl_DecrRefCount(operand1Obj);
}
@@ -1728,7 +1762,7 @@ static void
CompileEmbeddedScript(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
Tcl_Token* tokenPtr, /* Tcl_Token containing the script */
- TalInstDesc* instPtr) /* Instruction that determines whether
+ const TalInstDesc* instPtr) /* Instruction that determines whether
* the script is 'expr' or 'eval' */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
@@ -1873,7 +1907,7 @@ MoveExceptionRangesToBasicBlock(
curr_bb, exceptionCount, savedExceptArrayNext);
curr_bb->foreignExceptionBase = savedExceptArrayNext;
curr_bb->foreignExceptionCount = exceptionCount;
- curr_bb->foreignExceptions =
+ curr_bb->foreignExceptions =
ckalloc(exceptionCount * sizeof(ExceptionRange));
memcpy(curr_bb->foreignExceptions,
envPtr->exceptArrayPtr + savedExceptArrayNext,
@@ -1920,7 +1954,6 @@ CreateMirrorJumpTable(
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
int isNew; /* Flag==1 if the key is not yet in the
* table. */
- Tcl_Obj* result; /* Error message */
int i;
if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
@@ -1956,17 +1989,15 @@ CreateMirrorJumpTable(
&isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj(
- "duplicate entry in jump table for \"", -1);
- Tcl_AppendObjToObj(result, objv[i]);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate entry in jump table for \"%s\"",
+ Tcl_GetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
}
}
- Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]);
+ Tcl_SetHashValue(hashEntry, objv[i+1]);
Tcl_IncrRefCount(objv[i+1]);
}
DEBUG_PRINT("}\n");
@@ -2087,17 +2118,14 @@ GetBooleanOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2143,17 +2171,14 @@ GetIntegerOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2199,17 +2224,14 @@ GetListIndexOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2254,21 +2276,19 @@ FindLocalVar(
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
- Tcl_Obj* varNameObj = Tcl_NewObj();
- /* Name of the variable */
+ /* INOUT: Pointer to the next token in the
+ * source code. */
+ Tcl_Obj* varNameObj; /* Name of the variable */
const char* varNameStr;
int varNameLen;
int localVar; /* Index of the variable in the LVT */
- Tcl_IncrRefCount(varNameObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
- Tcl_DecrRefCount(varNameObj);
return -1;
}
varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
+ Tcl_DecrRefCount(varNameObj);
return -1;
}
localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
@@ -2307,14 +2327,12 @@ CheckNamespaceQualifiers(
const char* name, /* Variable name to check */
int nameLen) /* Length of the variable */
{
- Tcl_Obj* result; /* Error message */
const char* p;
+
for (p = name; p+2 < name+nameLen; p++) {
if ((*p == ':') && (p[1] == ':')) {
- result = Tcl_NewStringObj("variable \"", -1);
- Tcl_AppendToObj(result, name, -1);
- Tcl_AppendToObj(result, "\" is not local", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable \"%s\" is not local", name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
return TCL_ERROR;
}
@@ -2485,7 +2503,6 @@ DefineLabel(
Tcl_HashEntry* entry; /* Label's entry in the symbol table */
int isNew; /* Flag == 1 iff the label was previously
* undefined */
- Tcl_Obj* result; /* Error message */
/* TODO - This can now be simplified! */
@@ -2501,14 +2518,11 @@ DefineLabel(
* This is a duplicate label.
*/
- if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) {
- result = Tcl_NewStringObj(
- "duplicate definition of label \"", -1);
- Tcl_AppendToObj(result, labelName, -1);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL",
- labelName, NULL);
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate definition of label \"%s\"", labelName));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
+ NULL);
}
return TCL_ERROR;
}
@@ -2545,7 +2559,7 @@ StartBasicBlock(
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
- BasicBlock* newBB; /* BasicBlock structure for the new block */
+ BasicBlock* newBB; /* BasicBlock structure for the new block */
BasicBlock* currBB = assemEnvPtr->curr_bb;
/*
@@ -2621,6 +2635,7 @@ AllocBB(
bb->minStackDepth = 0;
bb->maxStackDepth = 0;
bb->finalStackDepth = 0;
+ bb->catchDepth = 0;
bb->enclosingCatch = NULL;
bb->foreignExceptionBase = -1;
bb->foreignExceptionCount = 0;
@@ -2707,8 +2722,10 @@ FinishAssembly(
return TCL_ERROR;
}
- /* TODO - Check for unreachable code */
- /* Maybe not - unreachable code is Mostly Harmless. */
+ /*
+ * TODO - Check for unreachable code. Or maybe not; unreachable code is
+ * Mostly Harmless.
+ */
return TCL_OK;
}
@@ -2766,7 +2783,7 @@ CalculateJumpRelocations(
motion = 0;
for (bbPtr = assemEnvPtr->head_bb;
bbPtr != NULL;
- bbPtr=bbPtr->successor1) {
+ bbPtr = bbPtr->successor1) {
/*
* Advance the basic block start offset by however many bytes we
* have inserted in the code up to this point
@@ -2866,8 +2883,7 @@ CheckJumpTableLabels(
Tcl_GetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj),
- (valEntryPtr != NULL));
+ Tcl_GetString(symbolObj), (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
@@ -2890,6 +2906,7 @@ CheckJumpTableLabels(
*
*-----------------------------------------------------------------------------
*/
+
static void
ReportUndefinedLabel(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
@@ -2901,13 +2918,10 @@ ReportUndefinedLabel(
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
- Tcl_Obj* result; /* Error message */
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj("undefined label \"", -1);
- Tcl_AppendObjToObj(result, jumpTarget);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
Tcl_GetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
@@ -3052,8 +3066,7 @@ ResolveJumpTableTargets(
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
bbPtr, bbPtr->jumpOffset, auxDataIndex);
- realJumpTablePtr = (JumptableInfo*)
- envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
@@ -3161,7 +3174,6 @@ CheckNonThrowingBlock(
int bound; /* Bytecode offset following the last
* instruction of the block. */
unsigned char opcode; /* Current bytecode instruction */
- Tcl_Obj* retval; /* Error message */
/*
* Determine where in the code array the basic block ends.
@@ -3191,13 +3203,12 @@ CheckNonThrowingBlock(
*/
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- retval = Tcl_NewStringObj("\"", -1);
- Tcl_AppendToObj(retval, tclInstructionTable[opcode].name, -1);
- Tcl_AppendToObj(retval, "\" instruction may not appear in "
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" instruction may not appear in "
"a context where an exception has been "
- "caught and not disposed of.", -1);
+ "caught and not disposed of.",
+ tclInstructionTable[opcode].name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
- Tcl_SetObjResult(interp, retval);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
}
return TCL_ERROR;
@@ -3230,7 +3241,7 @@ BytecodeMightThrow(
*/
int min = 0;
- int max = sizeof(NonThrowingByteCodes)-1;
+ int max = sizeof(NonThrowingByteCodes) - 1;
int mid;
unsigned char c;
@@ -3371,7 +3382,11 @@ StackCheckBasicBlock(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"inconsistent stack depths on two execution paths", -1));
- /* TODO - add execution trace of both paths */
+
+ /*
+ * TODO - add execution trace of both paths
+ */
+
Tcl_SetErrorLine(interp, blockPtr->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
}
@@ -3504,8 +3519,6 @@ StackCheckExit(
int depth; /* Net stack effect */
int litIndex; /* Index in the literal pool of the empty
* string */
- Tcl_Obj* depthObj; /* Net stack effect for an error message */
- Tcl_Obj* resultObj; /* Error message from this procedure */
BasicBlock* curr_bb = assemEnvPtr->curr_bb;
/* Final basic block in the assembly */
@@ -3516,51 +3529,45 @@ StackCheckExit(
*/
if (curr_bb->flags & BB_VISITED) {
- /*
+ /*
* Exit with no operands; push an empty one.
*/
- depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
- if (depth == 0) {
- /*
+ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
+ if (depth == 0) {
+ /*
* Emit a 'push' of the empty literal.
*/
- litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+ litIndex = TclRegisterNewLiteral(envPtr, "", 0);
- /*
+ /*
* Assumes that 'push' is at slot 0 in TalInstructionTable.
*/
- BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
- ++depth;
- }
+ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+ ++depth;
+ }
- /*
+ /*
* Exit with unbalanced stack.
*/
- if (depth != 1) {
- if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- depthObj = Tcl_NewIntObj(depth);
- Tcl_IncrRefCount(depthObj);
- resultObj = Tcl_NewStringObj(
- "stack is unbalanced on exit from the code (depth=",
- -1);
- Tcl_AppendObjToObj(resultObj, depthObj);
- Tcl_DecrRefCount(depthObj);
- Tcl_AppendToObj(resultObj, ")", -1);
- Tcl_SetObjResult(interp, resultObj);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
- }
- return TCL_ERROR;
- }
-
- /*
+ if (depth != 1) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "stack is unbalanced on exit from the code (depth=%d)",
+ depth));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
* Record stack usage.
*/
- envPtr->currStackDepth += depth;
+ envPtr->currStackDepth += depth;
}
return TCL_OK;
@@ -3725,8 +3732,10 @@ ProcessCatchesInBasicBlock(
jumpEnclosing = enclosing;
jumpState = state;
- /* TODO: Make sure that the test cases include validating
- * that a natural loop can't include 'beginCatch' or 'endCatch' */
+ /*
+ * TODO: Make sure that the test cases include validating that a natural
+ * loop can't include 'beginCatch' or 'endCatch'
+ */
if (bbPtr->flags & BB_BEGINCATCH) {
/*
@@ -3870,8 +3879,8 @@ BuildExceptionRanges(
int catchDepth = 0; /* Current catch depth */
int maxCatchDepth = 0; /* Maximum catch depth in the program */
BasicBlock** catches; /* Stack of catches in progress */
- int* catchIndices; /* Indices of the exception ranges
- * of catches in progress */
+ int* catchIndices; /* Indices of the exception ranges of catches
+ * in progress */
int i;
/*
@@ -3920,11 +3929,18 @@ BuildExceptionRanges(
prevPtr = bbPtr;
}
+ /* Make sure that all catches are closed */
+
if (catchDepth != 0) {
Tcl_Panic("unclosed catch at end of code in "
"tclAssembly.c:BuildExceptionRanges, can't happen");
}
+ /* Free temp storage */
+
+ ckfree(catchIndices);
+ ckfree(catches);
+
return TCL_OK;
}
@@ -4120,7 +4136,7 @@ RestoreEmbeddedExceptionRanges(
* range as reinstalled */
ExceptionRange* range; /* Current foreign exception range */
unsigned char opcode; /* Current instruction's opcode */
- int catchIndex; /* Index of the exception range to which the
+ int catchIndex; /* Index of the exception range to which the
* current instruction refers */
int i;
@@ -4223,11 +4239,11 @@ AddBasicBlockRangeToErrorInfo(
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
lineNo = Tcl_NewIntObj(bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
- Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
- Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
}
@@ -4291,14 +4307,13 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
generated by cgit v0.12 at 2025-10-21 21:18:00 (GMT)