summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c219
1 files changed, 111 insertions, 108 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7868882..eca934f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1,5 +1,5 @@
/*
- * tclAssembly,c --
+ * tclAssembly.c --
*
* Assembler for Tcl bytecodes.
*
@@ -84,7 +84,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 */
@@ -193,7 +193,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) */
@@ -831,16 +831,20 @@ 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 {
+ 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);
}
/*
@@ -967,7 +971,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 */
@@ -1208,13 +1212,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 */
@@ -1241,7 +1244,7 @@ AssembleOneLine(
if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
&TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
TCL_EXACT, &tblIdx) != TCL_OK) {
- return TCL_ERROR;
+ goto cleanup;
}
/*
@@ -1310,8 +1313,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);
@@ -1349,8 +1355,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);
@@ -1363,8 +1372,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);
@@ -1558,7 +1570,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);
@@ -1569,8 +1582,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);
@@ -1581,8 +1594,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;
@@ -1596,7 +1609,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);
@@ -1658,8 +1672,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);
@@ -1673,9 +1690,7 @@ AssembleOneLine(
status = TCL_OK;
cleanup:
- if (instNameObj) {
- Tcl_DecrRefCount(instNameObj);
- }
+ Tcl_DecrRefCount(instNameObj);
if (operand1Obj) {
Tcl_DecrRefCount(operand1Obj);
}
@@ -1857,7 +1872,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,
@@ -1904,7 +1919,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) {
@@ -1940,17 +1954,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");
@@ -2229,8 +2241,8 @@ FindLocalVar(
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
+ /* INOUT: Pointer to the next token in the
+ * source code. */
Tcl_Obj* varNameObj; /* Name of the variable */
const char* varNameStr;
int varNameLen;
@@ -2282,6 +2294,7 @@ CheckNamespaceQualifiers(
{
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);
@@ -2458,7 +2471,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! */
@@ -2474,14 +2486,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;
}
@@ -2518,7 +2527,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;
/*
@@ -2680,8 +2689,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;
}
@@ -2739,7 +2750,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
@@ -2839,8 +2850,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;
@@ -2863,6 +2873,7 @@ CheckJumpTableLabels(
*
*-----------------------------------------------------------------------------
*/
+
static void
ReportUndefinedLabel(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
@@ -2874,13 +2885,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);
@@ -3025,8 +3033,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 = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
@@ -3134,7 +3141,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.
@@ -3164,13 +3170,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;
@@ -3203,7 +3208,7 @@ BytecodeMightThrow(
*/
int min = 0;
- int max = sizeof(NonThrowingByteCodes)-1;
+ int max = sizeof(NonThrowingByteCodes) - 1;
int mid;
unsigned char c;
@@ -3344,7 +3349,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);
}
@@ -3477,8 +3486,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 */
@@ -3489,51 +3496,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;
@@ -3698,8 +3699,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) {
/*
@@ -3843,8 +3846,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;
/*
@@ -4093,7 +4096,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;