Attachment "expand-inplace-commit.patch" to
ticket [842446ffff]
added by
msofer
2004-05-17 00:32:10.
? generic/tclExecute.c.HEAD
? generic/tclObj.c.ORIG
? generic/tclProc.c.ORIG
? unix/.log
? unix/.ofl
? unix/ERR
? unix/dltest.marker
? unix/tclsh-head
? unix/tclsh-noAsync
? unix/tclsh-noStart
? unix/tclsh-noStart1
? unix/x.log
? unix/x.ofl
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1997
diff -u -r1.1997 ChangeLog
--- ChangeLog 14 May 2004 21:43:28 -0000 1.1997
+++ ChangeLog 16 May 2004 17:24:13 -0000
@@ -1,3 +1,15 @@
+2004-05-16 Miguel Sofer <[email protected]>
+
+ * 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 <[email protected]>
* generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.65
diff -u -r1.65 tclCompile.c
--- generic/tclCompile.c 12 May 2004 17:43:54 -0000 1.65
+++ generic/tclCompile.c 16 May 2004 17:24:15 -0000
@@ -274,10 +274,20 @@
* 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 @@
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 @@
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 @@
*/
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 @@
}
}
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 @@
*/
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 @@
}
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) {
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.45
diff -u -r1.45 tclCompile.h
--- generic/tclCompile.h 14 May 2004 19:15:35 -0000 1.45
+++ generic/tclCompile.h 16 May 2004 17:24:16 -0000
@@ -530,21 +530,22 @@
/* 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 @@
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 @@
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 @@
{\
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 @@
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
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.127
diff -u -r1.127 tclExecute.c
--- generic/tclExecute.c 14 May 2004 19:15:35 -0000 1.127
+++ generic/tclExecute.c 16 May 2004 17:24:19 -0000
@@ -387,7 +387,8 @@
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 @@
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 @@
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 @@
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 @@
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;
- result = Tcl_ListObjLength(interp, valuePtr, &numElements);
+ /*
+ * Make sure that the element at stackTop is a list; if not,
+ * remove the element from the expand link list and leave.
+ */
+
+
+ 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;
+ tosPtr--;
- /*
- * Compute number of objects needed to store the
- * command after expansion is complete.
- */
+ /*
+ * 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.
+ */
- opnd = objc = numWords;
- for (deltaPtr = deltaPtrStart; *deltaPtr; deltaPtr++) {
- int numElements;
- wordToExpand += TclGetUInt1AtPtr(deltaPtr);
- Tcl_ListObjLength(NULL, wordv[wordToExpand], &numElements);
- objc += numElements - 1;
+ 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 @@
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 @@
#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 @@
* 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 @@
(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);
