diff options
Diffstat (limited to 'generic/tclAssembly.c')
| -rw-r--r-- | generic/tclAssembly.c | 219 |
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; |