diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 323 | ||||
| -rw-r--r-- | tests/assemble.test | 77 |
3 files changed, 318 insertions, 90 deletions
@@ -1,3 +1,11 @@ +2010-12-15 Kevin B. Kenny <kennykb@acm.org> + + * tclAssembly.c: + * assemble.test: Reworked beginCatch/endCatch handling to + enforce the more severe (but more correct) restrictions on catch + handling that appeared in the discussion of [Bug 3098302] and in + tcl-core traffic beginning about 2010-10-29. + 2010-12-10 Jan Nijtmans <nijtmans@users.sf.net> * generic/tcl.h: [Bug 3129448]: Possible over-allocation on diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 1b12987..26372c6 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.17 2010/10/28 19:40:12 kennykb Exp $ + * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.18 2010/12/16 01:40:42 kennykb Exp $ */ /*- @@ -47,9 +47,6 @@ 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_DONECATCH, /* Block is nominally within a catch context - * but has passed a 'doneCatch' directive - * and wants exceptions to propagate. */ BBCS_CAUGHT, /* Block is within a catch context and * may be executed after an exception fires */ } BasicBlockCatchState; @@ -81,8 +78,7 @@ typedef struct BasicBlock { struct BasicBlock * successor1; /* BasicBlock structure of the following * block: NULL at the end of the bytecode - * sequence or if the block ends in an - * unconditional jump */ + * sequence. */ Tcl_Obj * jumpTarget; /* Jump target label if the jump target * is unresolved */ @@ -128,11 +124,7 @@ enum BasicBlockFlags { * marking it as the start of a 'catch' * sequence. The 'jumpTarget' is the exception * exit from the catch block. */ - BB_DONECATCH = (1 << 5), /* Block commences with a 'doneCatch' - * directive, indicating that the program - * is finished with the body of a catch block. - */ - BB_ENDCATCH = (1 << 6), /* Block ends with an 'endCatch' instruction, + BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction, * unwinding the catch from the exception * stack. */ }; @@ -156,9 +148,6 @@ typedef enum TalInstType { ASSEM_DICT_UNSET, /* specifies key count and LVT index, consumes N operands, * produces 1, N > 0 */ - ASSEM_DONECATCH,/* Directive indicating that the body of a catch block - * is complete. Generates no instructions, affects only - * the exception ranges. */ ASSEM_END_CATCH,/* End catch. No args. Exception range popped from stack * and stack pointer restored. */ ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it @@ -253,6 +242,9 @@ static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblind, int count); static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr); static int CalculateJumpRelocations(AssemblyEnv*, int*); static int CheckForUnclosedCatches(AssemblyEnv*); +static int CheckForThrowInWrongContext(AssemblyEnv*); +static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*); +static int BytecodeMightThrow(unsigned char); static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*); static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int); static int CheckNonNegative(Tcl_Interp*, int); @@ -333,6 +325,10 @@ static const Tcl_ObjType assembleCodeType = { #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ +/* + * Source instructions recognized in the Tcl Assembly Language (TAL) + */ + TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ @@ -363,7 +359,6 @@ TalInstDesc TalInstructionTable[] = { {"dictUnset", ASSEM_DICT_UNSET, INST_DICT_UNSET, INT_MIN,1}, {"div", ASSEM_1BYTE, INST_DIV, 2, 1}, - {"doneCatch", ASSEM_DONECATCH,0, 0, 0}, {"dup", ASSEM_1BYTE , INST_DUP , 1 , 2}, {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0}, {"eq", ASSEM_1BYTE , INST_EQ , 2 , 1}, @@ -466,6 +461,24 @@ TalInstDesc TalInstructionTable[] = { {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {NULL, 0, 0, 0, 0} }; + +/* + * List of instructions that cannot throw an exception under any circumstances. + * These instructions are the ones that are permissible after an exception + * is caught but before the corresponding exception range is popped from + * the stack. + * The instructions must be in ascending order by numeric operation code. + */ + +static 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_OVER, /* 95 */ + INST_PUSH_RETURN_OPTIONS, /* 108 */ + INST_REVERSE, /* 126 */ + INST_NOP /* 132 */ +}; /* *----------------------------------------------------------------------------- @@ -1290,11 +1303,6 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) TclEmitInt4(localVar, envPtr); break; - case ASSEM_DONECATCH: - StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); - assemEnvPtr->curr_bb->flags |= BB_DONECATCH; - break; - case ASSEM_END_CATCH: if (parsePtr->numWords != 1) { Tcl_WrongNumArgs(interp, 1, &instNameObj, ""); @@ -2572,6 +2580,15 @@ FinishAssembly(AssemblyEnv* assemEnvPtr) return TCL_ERROR; } + /* + * Make sure that no block accessible from a catch's error exit that hasn't + * popped the exception stack can throw an exception. + */ + + if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) { + return TCL_ERROR; + } + /* Compute stack balance throughout the program */ if (CheckStack(assemEnvPtr) != TCL_OK) { @@ -2959,6 +2976,168 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, /* *----------------------------------------------------------------------------- * + * CheckForThrowInWrongContext -- + * + * Verify that no beginCatch/endCatch sequence can throw an exception + * after an original exception is caught and before its exception + * context is removed from the stack. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * Stores an appropriate error message in the interpreter as needed. + * + *----------------------------------------------------------------------------- + */ + +static int +CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr) + /* Assembler environment */ +{ + BasicBlock* blockPtr; /* Current basic block */ + + /* + * Walk through the basic blocks in turn, checking all the ones + * that have caught an exception and not disposed of it properly. + */ + + for (blockPtr = assemEnvPtr->head_bb; + blockPtr != NULL; + blockPtr = blockPtr->successor1) { + + if (blockPtr->catchState == BBCS_CAUGHT) { + + /* Walk through the instructions in the basic block */ + + if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) { + return TCL_ERROR; + } + + } + } + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * CheckNonThrowingBlock -- + * + * Check that a basic block cannot throw an exception. + * + * Results: + * Returns TCL_ERROR if the block cannot be proven to be nonthrowing. + * + * Side effects: + * Stashes an error message in the interpreter result. + * + *----------------------------------------------------------------------------- + */ + +static int +CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr, + /* Assembler environment */ + BasicBlock* blockPtr) + /* Basic block where exceptions are + * not allowed */ +{ + CompileEnv* envPtr = assemEnvPtr->envPtr; + /* Compilation environment */ + Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; + /* Tcl interpreter */ + BasicBlock* nextPtr; /* Pointer to the succeeding basic block */ + int offset; /* Bytecode offset of the current instruction */ + 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 */ + + nextPtr = blockPtr->successor1; + if (nextPtr == NULL) { + bound = envPtr->codeNext - envPtr->codeStart; + } else { + bound = nextPtr->startOffset; + } + + /* Walk through the instructions of the block */ + + offset = blockPtr->startOffset; + while (offset < bound) { + + /* Determine whether an instruction is nonthrowing */ + + opcode = (envPtr->codeStart)[offset]; + + if (BytecodeMightThrow(opcode)) { + + /* Report an error for a throw in the wrong context */ + + 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 " + "a context where an exception has been " + "caught and not disposed of.", -1); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL); + Tcl_SetObjResult(interp, retval); + AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); + } + return TCL_ERROR; + } + offset += tclInstructionTable[opcode].numBytes; + } + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * BytecodeMightThrow -- + * + * Tests if a given bytecode instruction might throw an exception. + * + * Results: + * Returns 1 if the bytecode might throw an exception, 0 if the + * instruction is known never to throw. + * + *----------------------------------------------------------------------------- + */ + +static int +BytecodeMightThrow(unsigned char opcode) +{ + + /* Binary search on the non-throwing bytecode list */ + + int min = 0; + int max = sizeof(NonThrowingByteCodes)-1; + int mid; + unsigned char c; + while (max >= min) { + mid = (min + max) / 2; + c = NonThrowingByteCodes[mid]; + if (opcode < c) { + max = mid-1; + } else if (opcode > c) { + min = mid+1; + } else { + + /* Opcode is nonthrowing */ + + return 0; + } + } + + return 1; +} + +/* + *----------------------------------------------------------------------------- + * * CheckStack -- * * Audit stack usage in a block of assembly code. @@ -3084,13 +3263,15 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, * If the block is not already visited, set the 'predecessor' * link to indicate how control got to it. Set the initial stack * depth to the current stack depth in the flow of control. - * Calculate max and min stack depth, flag an error if the - * block underflows the stack, and update max stack depth in the - * assembly environment. */ blockPtr->flags |= BB_VISITED; blockPtr->predecessor = predecessor; blockPtr->initialStackDepth = initialStackDepth; + + /* + * Calculate minimum stack depth, and flag an error if the block + * underflows the stack. + */ if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, @@ -3101,6 +3282,29 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, } return TCL_ERROR; } + + /* + * Make sure that the block doesn't try to pop below the stack level + * of an enclosing catch. + */ + if (blockPtr->enclosingCatch != 0 + && initialStackDepth + blockPtr->minStackDepth + < (blockPtr->enclosingCatch->initialStackDepth + + blockPtr->enclosingCatch->finalStackDepth)) { + if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("code pops stack below level of" + " enclosing catch", -1)); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1); + AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); + Tcl_SetErrorLine(interp, blockPtr->startLine); + } + return TCL_ERROR; + } + + /* + * Update maximum stgack depth. + */ maxDepth = initialStackDepth + blockPtr->maxStackDepth; if (maxDepth > assemEnvPtr->maxDepth) { assemEnvPtr->maxDepth = maxDepth; @@ -3354,7 +3558,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, } else if (bbPtr->enclosingCatch != enclosing) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("execution reaches block in " + Tcl_NewStringObj("execution reaches an " + "instruction in " "inconsistent exception contexts", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); @@ -3390,31 +3595,6 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, /* TODO: Make sure that the test cases include validating * that a natural loop can't include 'beginCatch' or 'endCatch' */ - if (bbPtr->flags & BB_DONECATCH) { - /* - * If the block finishes a catch body, the block and its successors - * are outside the exception range. (The block may also end the - * catch or begin another one, so we need to check for those - * conditions as well.) - */ - if (enclosing == NULL) { - if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("doneCatch without a " - "corresponding beginCatch", - -1)); - Tcl_SetErrorLine(interp, bbPtr->startLine); - Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL); - } - return TCL_ERROR; - } - if (bbPtr->catchState < BB_DONECATCH) { - bbPtr->catchState = BBCS_DONECATCH; - fallThruState = BBCS_DONECATCH; - jumpState = BBCS_DONECATCH; - } - } - if (bbPtr->flags & BB_BEGINCATCH) { /* * If the block begins a catch, the state for the successor is @@ -3514,10 +3694,11 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr) if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("catch still active on " - "exit from block", -1)); + "exit from assembly " + "code", -1)); Tcl_SetErrorLine(interp, assemEnvPtr->curr_bb->enclosingCatch->startLine); - Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", -1); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL); } return TCL_ERROR; } @@ -3585,12 +3766,6 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr) for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) { - /*fprintf(stderr, "block %p line %d byte %#x enclosing %p state %d" - " depth %d\n", - bbPtr, bbPtr->startLine, bbPtr->startOffset, - bbPtr->enclosingCatch, bbPtr->catchState, bbPtr->catchDepth); - fflush(stderr); */ - UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches, catchIndices); LookForFreshCatches(bbPtr, catches); @@ -3602,10 +3777,6 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr) catchDepth = bbPtr->catchDepth; if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) { - /*fprintf(stderr, "beginCatch at %d (depth=%d) " - "is exception range %d\n", - bbPtr->startOffset, catchDepth-1, - catchIndices[catchDepth-1]); fflush(stderr); */ TclStoreInt4AtPtr(catchIndices[catchDepth-1], envPtr->codeStart + bbPtr->startOffset - 4); } @@ -3662,8 +3833,6 @@ UnstackExpiredCatches(CompileEnv* envPtr, while (catchDepth > bbPtr->catchDepth) { --catchDepth; - /* fprintf(stderr, "unstack exception range %d\n", - catchIndices[catchDepth]); fflush(stderr); */ range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; @@ -3682,9 +3851,7 @@ UnstackExpiredCatches(CompileEnv* envPtr, --catchDepth; if (catches[catchDepth] != NULL) { if (catches[catchDepth] != catch - || catchState >= BBCS_DONECATCH) { - /* fprintf(stderr, "unstack changed exception range %d\n", - catchIndices[catchDepth]); fflush(stderr); */ + || catchState >= BBCS_CAUGHT) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; @@ -3729,13 +3896,8 @@ LookForFreshCatches(BasicBlock* bbPtr, catchDepth = bbPtr->catchDepth; while (catchDepth > 0) { --catchDepth; - if (catches[catchDepth] != catch && catchState < BBCS_DONECATCH) { - /* fprintf(stderr, "new exception range needed for %s.\n", - Tcl_GetString(catch->jumpTarget)); */ + if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) { catches[catchDepth] = catch; - /* } else { - fprintf(stderr, "new exception range not needed for %s\n", - Tcl_GetString(catch->jumpTarget));*/ } catchState = catch->catchState; catch = catch->enclosingCatch; @@ -3788,9 +3950,6 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr, catch = catches[catchDepth]; catchIndices[catchDepth] = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); - /* fprintf(stderr, "stack exception range %d at depth %d for %s\n", - catchIndices[catchDepth], catchDepth, - Tcl_GetString(catch->jumpTarget)); fflush(stderr); */ range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; envPtr->maxExceptDepth = @@ -3845,23 +4004,14 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr) bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->foreignExceptionCount != 0) { - /* fprintf(stderr, "basic block %p has %d foreign exception ranges" - " starting at %d\n", - bbPtr, bbPtr->foreignExceptionCount, - bbPtr->foreignExceptionBase); fflush(stderr); */ - /* * Reinstall the embedded exceptions and track their * nesting level */ rangeBase = envPtr->exceptArrayNext; - /* fprintf(stderr, "next exception at %d\n", rangeBase); */ for (i = 0; i < bbPtr->foreignExceptionCount; ++i) { range = bbPtr->foreignExceptions + i; rangeIndex = TclCreateExceptRange(range->type, envPtr); - /* fprintf(stderr, "restore range %d -> %d\n", - i + bbPtr->foreignExceptionBase, - rangeIndex); fflush(stderr); */ range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth; memcpy(envPtr->exceptArrayPtr + rangeIndex, range, sizeof(ExceptionRange)); @@ -3879,16 +4029,11 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr) opcode = envPtr->codeStart[i]; if (opcode == INST_BEGIN_CATCH4) { catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1); - /* fprintf(stderr, "pc %d exception %d\n", - i, catchIndex); fflush(stderr); */ if (catchIndex >= bbPtr->foreignExceptionBase && catchIndex < (bbPtr->foreignExceptionBase + bbPtr->foreignExceptionCount)) { catchIndex -= bbPtr->foreignExceptionBase; catchIndex += rangeBase; - /* fprintf(stderr, - "alter catch at %d to refer to range %d\n", - i, catchIndex); fflush(stderr); */ TclStoreInt4AtPtr(catchIndex, envPtr->codeStart + i + 1); } diff --git a/tests/assemble.test b/tests/assemble.test index 7a05137..b9178ec 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: assemble.test,v 1.1.2.15 2010/10/28 19:40:13 kennykb Exp $ +# RCS: @(#) $Id: assemble.test,v 1.1.2.16 2010/12/16 01:40:42 kennykb Exp $ #----------------------------------------------------------------------------- # Commands covered: assemble @@ -3111,6 +3111,81 @@ test assemble-30.3 {embedded catches} { -cleanup {rename x {}} } +test assemble-30.4 {throw in wrong context} { + -body { + proc x {} { + list [catch { + assemble { + beginCatch @bad + push error + eval { list [catch {error whatever} result] $result } + invokeStk 2 + push 0 + reverse 2 + jump @done + + label @bad + load x + pushResult + + label @done + endCatch + list 2 + } + } result] $result $::errorCode [split $::errorInfo \n] + } + x + } + -match glob + -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} { in assembly code between lines 10 and 15}*}} + -cleanup {rename x {}} +} + +test assemble-30.5 {unclosed catch} { + -body { + proc x {} { + assemble { + beginCatch @error + push 0 + jump @done + label @error + push 1 + label @done + push "" + pop + } + } + list [catch {x} result] $result $::errorCode $::errorInfo + } + -match glob + -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code + ("assemble" body, line 2)*}} + -cleanup {rename x {}} +} + +test assemble-30.6 {inconsistent catch contexts} { + -body { + proc x {y} { + assemble { + load y + jumpTrue @inblock + beginCatch @error + label @inblock + push 0 + jump @done + label @error + push 1 + label @done + } + } + list [catch {x 2} result] $::errorCode $::errorInfo + } + -match glob + -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts + ("assemble" body, line 5)*}} + -cleanup {rename x {}} +} + # assemble-31 - Jump tables test assemble-31.1 {jumpTable, wrong # args} { |