Ensure that memory isn't leaked when an unknown instruction is encountered.

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;