diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclCompile.c | 100 | ||||
| -rw-r--r-- | generic/tclCompile.h | 63 | ||||
| -rw-r--r-- | generic/tclExecute.c | 189 |
4 files changed, 166 insertions, 198 deletions
@@ -1,3 +1,15 @@ +2004-05-16 Miguel Sofer <msofer@users.sf.net> + + * generic/tclCompile.h: + * generic/tclCompile.c: + * generic/tclExecute.c: changed implementation of {expand}, last + chance while in alpha as ... + + ***POTENTIAL INCOMPATIBILITY*** + Scripts precompiled with ProComp under previous tcl8.5a versions + may malfunction due to changed instruction numbers for + INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD. + 2004-05-14 Kevin B. Kenny <kennykb@acm.org> * generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c918c5d..0f1e615 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.65 2004/05/12 17:43:54 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.66 2004/05/16 17:25:48 msofer Exp $ */ #include "tclInt.h" @@ -274,10 +274,20 @@ InstructionDesc tclInstructionTable[] = { * are on the stack. */ {"expon", 1, -1, 0, {OPERAND_NONE}}, /* Binary exponentiation operator: push (stknext ** stktop) */ - {"listverify", 1, 0, 0, {OPERAND_NONE}}, - /* Test that top of stack is a valid list; error if not */ - {"invokeExp", INT_MIN, INT_MIN, 2, {OPERAND_UINT4, OPERAND_ULIST1}}, - /* Invoke with expansion: <objc,objv> = expanded <op1,top op1> */ + /* + * NOTE: the stack effects of expandStkTop and invokeExpanded + * are wrong - but it cannot be done right at compile time, the stack + * effect is only known at run time. The value for invokeExpanded + * is estimated better at compile time. + * See the comments further down in this file, where INST_INVOKE_EXPANDED + * is emitted. + */ + {"expandStart", 1, 0, 0, {OPERAND_NONE}}, + /* Start of command with {expand}ed arguments */ + {"expandStkTop", 5, 0, 1, {OPERAND_INT4}}, + /* Expand the list at stacktop: push its elements on the stack */ + {"invokeExpanded", 1, 0, 0, {OPERAND_NONE}}, + /* Invoke the command marked by the last 'expandStart' */ {"listIndexImm", 5, 0, 1, {OPERAND_IDX4}}, /* List Index: push (lindex stktop op4) */ {"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, @@ -941,8 +951,6 @@ TclCompileScript(interp, script, numBytes, envPtr) gotParse = 1; if (parse.numWords > 0) { int expand = 0; - unsigned char delta = 1; - Tcl_DString deltaList; /* * If not the first command, pop the previous command's result @@ -995,7 +1003,7 @@ TclCompileScript(interp, script, numBytes, envPtr) wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { expand = 1; - Tcl_DStringInit(&deltaList); + TclEmitOpcode(INST_EXPAND_START, envPtr); break; } } @@ -1013,21 +1021,9 @@ TclCompileScript(interp, script, numBytes, envPtr) */ for (wordIdx = 0, tokenPtr = parse.tokenPtr; - wordIdx < parse.numWords; delta++, wordIdx++, + wordIdx < parse.numWords; wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { - if (expand && (delta == 255) - && (tokenPtr->type != TCL_TOKEN_EXPAND_WORD)) { - /* - * Push an empty list for expansion so our delta - * between expanded words doesn't overflow a byte - */ - objIndex = TclRegisterNewLiteral(envPtr, "", 0); - TclEmitPush(objIndex, envPtr); - Tcl_DStringAppend(&deltaList, (CONST char *)&delta, 1); - delta = 1; - } - if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { /* * If this is the first word and the command has a @@ -1138,35 +1134,8 @@ TclCompileScript(interp, script, numBytes, envPtr) } } if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - - if ((tokenPtr->numComponents == 1) - && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { - /* - * The value to be expanded is fully known - * now at compile time. We can check list - * validity, so we do not have to do so at - * runtime - */ - int length; - Tcl_Obj *testObj = Tcl_NewStringObj(tokenPtr[1].start, - tokenPtr[1].size); - if (TCL_OK != - Tcl_ListObjLength(NULL, testObj, &length)) { - /* - * Not a valid list, so emit instructions to - * test list validity (and fail) at runtime - */ - TclEmitOpcode(INST_LIST_VERIFY, envPtr); - } - } else { - /* - * Value to expand unknown until runtime, so - * include a runtime check for valid list - */ - TclEmitOpcode(INST_LIST_VERIFY, envPtr); - } - Tcl_DStringAppend(&deltaList, (char *)&delta, 1); - delta = 0; + TclEmitInstInt4(INST_EXPAND_STKTOP, + envPtr->currStackDepth, envPtr); } } @@ -1176,9 +1145,24 @@ TclCompileScript(interp, script, numBytes, envPtr) */ if (expand) { - TclEmitInstInt4(INST_INVOKE_EXP, wordIdx, envPtr); - TclEmitImmDeltaList1(&deltaList, envPtr); - Tcl_DStringFree(&deltaList); + /* + * The stack depth during argument expansion can only be + * managed at runtime, as the number of elements in the + * expanded lists is not known at compile time. + * We adjust here the stack depth estimate so that it is + * correct after the command with expanded arguments + * returns. + * The end effect of this command's invocation is that + * all the words of the command are popped from the stack, + * and the result is pushed: the stack top changes by + * (1-wordIdx). + * Note that the estimates are not correct while the + * command is being prepared and run, INST_EXPAND_STKTOP + * is not stack-neutral in general. + */ + + TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + TclAdjustStackDepth((1-wordIdx), envPtr); } else if (wordIdx > 0) { if (wordIdx <= 255) { TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); @@ -3415,16 +3399,6 @@ TclPrintInstruction(codePtr, pc) } break; - case OPERAND_ULIST1: - opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - fprintf(stdout, "{"); - while (opnd) { - fprintf(stdout, "%u ", opnd); - opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - } - fprintf(stdout, "0}"); - break; - case OPERAND_IDX4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opnd >= -1) { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 088218f..adfaeef 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -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: tclCompile.h,v 1.45 2004/05/14 19:15:35 msofer Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.46 2004/05/16 17:25:49 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -530,21 +530,22 @@ typedef struct ByteCode { /* TIP #157 - {expand}... language syntax support. */ -#define INST_LIST_VERIFY 100 -#define INST_INVOKE_EXP 101 +#define INST_EXPAND_START 100 +#define INST_EXPAND_STKTOP 101 +#define INST_INVOKE_EXPANDED 102 /* * TIP #57 - 'lassign' command. Code generation requires immediate * LINDEX and LRANGE operators. */ -#define INST_LIST_INDEX_IMM 102 -#define INST_LIST_RANGE_IMM 103 +#define INST_LIST_INDEX_IMM 103 +#define INST_LIST_RANGE_IMM 104 -#define INST_START_CMD 104 +#define INST_START_CMD 105 /* The last opcode */ -#define LAST_INST_OPCODE 104 +#define LAST_INST_OPCODE 105 /* * Table describing the Tcl bytecode instructions: their name (for @@ -563,7 +564,6 @@ typedef enum InstOperandType { OPERAND_INT4, /* Four byte signed integer. */ OPERAND_UINT1, /* One byte unsigned integer. */ OPERAND_UINT4, /* Four byte unsigned integer. */ - OPERAND_ULIST1, /* List of one byte unsigned integers. */ OPERAND_IDX4 /* Four byte signed index (actually an * integer, but displayed differently.) */ } InstOperandType; @@ -865,6 +865,21 @@ EXTERN int TclWordKnownAtCompileTime _ANSI_ARGS_(( TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0) /* + * Macro used to manually adjust the stack requirements; used + * in cases where the stack effect cannot be computed from + * the opcode and its operands, but is still known at + * compile time. + */ + +#define TclAdjustStackDepth(delta, envPtr) \ + if ((delta) < 0) {\ + if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\ + (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\ + }\ + }\ + (envPtr)->currStackDepth += (delta) + +/* * Macro used to update the stack requirements. * It is called by the macros TclEmitOpCode, TclEmitInst1 and * TclEmitInst4. @@ -877,16 +892,11 @@ EXTERN int TclWordKnownAtCompileTime _ANSI_ARGS_(( {\ int delta = tclInstructionTable[(op)].stackEffect;\ if (delta) {\ - if (delta < 0) {\ - if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\ - }\ - if (delta == INT_MIN) {\ - delta = 1 - (i);\ - }\ + if (delta == INT_MIN) {\ + delta = 1 - (i);\ }\ - (envPtr)->currStackDepth += delta;\ - }\ + TclAdjustStackDepth(delta, envPtr);\ + }\ } /* @@ -966,25 +976,6 @@ EXTERN int TclWordKnownAtCompileTime _ANSI_ARGS_(( TclUpdateStackReqs(op, i, envPtr) /* - * Macro to emit an immediate list of index deltas in the code stream. - * The ANSI C "prototypes" for this macro is: - * - * EXTERN void TclEmitImmList1 _ANSI_ARGS_((Tcl_Obj *listPtr, - * CompileEnv *envPtr)); - */ - -#define TclEmitImmDeltaList1(listPtr, envPtr) \ - { \ - int numBytes = Tcl_DStringLength(listPtr) + 1; \ - while (((envPtr)->codeNext + numBytes) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - memcpy((VOID *) (envPtr)->codeNext, \ - (VOID *)Tcl_DStringValue(listPtr), (size_t) numBytes); \ - (envPtr)->codeNext += numBytes; \ - } - -/* * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the * object's one or four byte array index into the CompileEnv's code * array. These support, respectively, a maximum of 256 (2**8) and 2**32 diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c7cb66e..6c29150 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.127 2004/05/14 19:15:35 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.128 2004/05/16 17:25:49 msofer Exp $ */ #include "tclInt.h" @@ -387,7 +387,8 @@ static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr)); static char * StringForResultCode _ANSI_ARGS_((int result)); static void ValidatePcAndStackTop _ANSI_ARGS_(( ByteCode *codePtr, unsigned char *pc, - int stackTop, int stackLowerBound)); + int stackTop, int stackLowerBound, + int checkStack)); #endif /* TCL_COMPILE_DEBUG */ static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); @@ -1100,9 +1101,7 @@ TclExecuteByteCode(interp, codePtr) Tcl_WideInt w; int isWide; register int cleanup; - int objc = 0; Tcl_Obj *objResultPtr; - Tcl_Obj **objv = NULL, **stackObjArray = NULL; char *part1, *part2; Var *varPtr, *arrayPtr; CallFrame *varFramePtr = iPtr->varFramePtr; @@ -1117,6 +1116,8 @@ TclExecuteByteCode(interp, codePtr) int codeNsEpoch = codePtr->nsEpoch; int codePrecompiled = (codePtr->flags & TCL_BYTECODE_PRECOMPILED); + Tcl_Obj *expandNestList = NULL; + /* * The execution uses a unified stack: first the catch stack, immediately * above it the execution stack. @@ -1223,8 +1224,12 @@ TclExecuteByteCode(interp, codePtr) cleanup0: #ifdef TCL_COMPILE_DEBUG + /* + * Skip the stack depth check if an expansion is in progress + */ + ValidatePcAndStackTop(codePtr, pc, (tosPtr - eePtr->stackPtr), - initStackTop); + initStackTop, /*checkStack*/ (expandNestList == NULL)); if (traceInstructions) { fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (tosPtr - eePtr->stackPtr)); TclPrintInstruction(codePtr, pc); @@ -1410,120 +1415,109 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_V(2, opnd, 1); } - case INST_LIST_VERIFY: + case INST_EXPAND_START: + /* + * Push an element to the expandNestList. This records + * the current tosPtr - i.e., the point in the stack + * where the expanded command starts. + * + * Use a Tcl_Obj as linked list element; slight mem waste, + * but faster allocation than ckalloc. This also abuses + * the Tcl_Obj structure, as we do not define a special + * tclObjType for it. It is not dangerous as the obj is + * never passed anywhere, so that all manipulations are + * performed here and in INST_INVOKE_EXPANDED (in case of + * an expansion error, also in INST_EXPAND_STKTOP). + */ + + TclNewObj(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr); + objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList; + expandNestList = objPtr; + NEXT_INST_F(1, 0, 0); + + case INST_EXPAND_STKTOP: { - int numElements = 0; - valuePtr = *tosPtr; + int objc; + Tcl_Obj **objv; + + /* + * Make sure that the element at stackTop is a list; if not, + * remove the element from the expand link list and leave. + */ + - result = Tcl_ListObjLength(interp, valuePtr, &numElements); + valuePtr = *tosPtr; + result = Tcl_ListObjGetElements(interp, valuePtr, &objc, &objv); if (result != TCL_OK) { TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), Tcl_GetObjResult(interp)); + objPtr = expandNestList; + expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; + TclDecrRefCount(objPtr); goto checkForCatch; } - NEXT_INST_F(1, 0, 0); - } - - case INST_INVOKE_EXP: - { - int numWords = TclGetUInt4AtPtr(pc+1); - int spaceAvailable = eePtr->endPtr - tosPtr; - unsigned char *deltaPtr, *deltaPtrStart = pc+5; - Tcl_Obj **wordv = tosPtr - (numWords - 1); - int objIdx, wordIdx, wordToExpand = -1; - - /* - * Compute number of objects needed to store the - * command after expansion is complete. - */ + tosPtr--; - opnd = objc = numWords; - for (deltaPtr = deltaPtrStart; *deltaPtr; deltaPtr++) { - int numElements; - wordToExpand += TclGetUInt1AtPtr(deltaPtr); - Tcl_ListObjLength(NULL, wordv[wordToExpand], &numElements); - objc += numElements - 1; + /* + * Make sure there is enough room in the stack to expand + * this list *and* process the rest of the command (at least + * up to the next argument expansion or command end). + * The operand is the current stack depth, as seen by the + * compiler. + */ + + length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr( pc+1 ); + while ((tosPtr + length) > eePtr->endPtr) { + DECACHE_STACK_INFO(); + GrowEvaluationStack(eePtr); + CACHE_STACK_INFO(); } - + /* - * We'll store the expanded command in the stack expansion - * space just above tosPtr, assuming there is room. Otherwise, - * allocate enough heap storage to store the expanded command. + * Expand the list at stacktop onto the stack; free the list. */ - objv = stackObjArray = tosPtr + 1; - if (objc > spaceAvailable) { - objv = (Tcl_Obj **) ckalloc((unsigned) - (objc * sizeof(Tcl_Obj *))); - } else { - tosPtr += objc; + for (i = 0; i < objc; i++) { + PUSH_OBJECT(objv[i]); } + TclDecrRefCount(valuePtr); + NEXT_INST_F(5, 0, 0); + } - objIdx = 0; - deltaPtr = deltaPtrStart; - wordToExpand = TclGetUInt1AtPtr(deltaPtr) - 1; - for (wordIdx = 0; wordIdx < numWords; wordIdx++) { - - /* - * Copy words (expanding some) from wordv to objv. - * Note that we do not increment refCounts. We - * rely on the references in wordv (on the execution - * stack) to be sufficient to keep the values around - * as long as we need them. - */ - - if (wordIdx == wordToExpand) { - int i, numElements; - Tcl_Obj **elements, *temp = wordv[wordIdx]; - - /* - * Make sure the list we expand is unshared. - * If it is not shared, then the stack holds the - * only reference to it, and there is no danger - * the list will shimmer to another type (and - * possibly free the elements of the list) before - * we are done with the command evaluation. - */ + case INST_INVOKE_EXPANDED: + objPtr = expandNestList; + expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; + opnd = tosPtr - eePtr->stackPtr + - (int) objPtr->internalRep.twoPtrValue.ptr1; + TclDecrRefCount(objPtr); + + if (opnd == 0) { + /* + * Nothing was expanded, return {}. + */ - if (Tcl_IsShared(temp)) { - Tcl_DecrRefCount(temp); - temp = Tcl_DuplicateObj(temp); - Tcl_IncrRefCount(temp); - wordv[wordIdx] = temp; - } - Tcl_ListObjGetElements(NULL, temp, &numElements, &elements); - for (i=0; i<numElements; i++) { - objv[objIdx++] = elements[i]; - } - ++deltaPtr; - if (*deltaPtr) { - wordToExpand += TclGetUInt1AtPtr(deltaPtr); - } else { - wordToExpand = -1; - } - } else { - objv[objIdx++] = wordv[wordIdx]; - } - } - pcAdjustment = (deltaPtr - pc) + 1; - goto doInvocation; + TclNewObj(objResultPtr); + NEXT_INST_F(1, 0, 1); } + pcAdjustment = 1; + goto doInvocation; + case INST_INVOKE_STK4: opnd = TclGetUInt4AtPtr(pc+1); - objc = opnd; - objv = stackObjArray = (tosPtr - (objc-1)); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: opnd = TclGetUInt1AtPtr(pc+1); - objc = opnd; - objv = stackObjArray = (tosPtr - (objc-1)); pcAdjustment = 2; doInvocation: { + int objc = opnd; + Tcl_Obj **objv = (tosPtr - (objc-1)); + /* * We keep the stack reference count as a (char *), as that * works nicely as a portable pointer-sized counter. @@ -1623,12 +1617,6 @@ TclExecuteByteCode(interp, codePtr) ckfree((VOID *) preservedStackRefCountPtr); } - if (objv != stackObjArray) { - ckfree((char *) objv); - } else if (*pc == INST_INVOKE_EXP) { - tosPtr -= objc; - } - if (result == TCL_OK) { /* * Push the call's object result and continue execution @@ -4756,7 +4744,7 @@ PrintByteCodeInfo(codePtr) #ifdef TCL_COMPILE_DEBUG static void -ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound) +ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack) register ByteCode *codePtr; /* The bytecode whose summary is printed * to stdout. */ unsigned char *pc; /* Points to first byte of a bytecode @@ -4765,6 +4753,8 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound) * stackLowerBound and stackUpperBound * (inclusive). */ int stackLowerBound; /* Smallest legal value for stackTop. */ + int checkStack; /* 0 if the stack depth check should be + * skipped. */ { int stackUpperBound = stackLowerBound + codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ @@ -4784,7 +4774,8 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound) (unsigned int) opCode, relativePc); Tcl_Panic("TclExecuteByteCode execution failure: bad opcode"); } - if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) { + if (checkStack && + ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) { int numChars; char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars); |