Attachment "expand-inplace.patch" to
ticket [842446ffff]
added by
msofer
2003-11-20 05:42:12.
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.53
diff -u -r1.53 tclCompile.c
--- generic/tclCompile.c 17 Nov 2003 15:23:10 -0000 1.53
+++ generic/tclCompile.c 17 Nov 2003 22:47:50 -0000
@@ -273,10 +273,21 @@
/* return TCL_RETURN code. */
{"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' */
{0}
};
@@ -848,8 +859,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
@@ -902,7 +911,7 @@
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
expand = 1;
- Tcl_DStringInit(&deltaList);
+ TclEmitOpcode(INST_EXPAND_START, envPtr);
break;
}
}
@@ -920,21 +929,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
@@ -1025,35 +1022,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);
}
}
@@ -1063,9 +1033,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);
@@ -3300,16 +3285,6 @@
} else {
fprintf(stdout, "%u ", (unsigned int) opnd);
}
- 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_NONE:
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.39
diff -u -r1.39 tclCompile.h
--- generic/tclCompile.h 14 Nov 2003 20:44:44 -0000 1.39
+++ generic/tclCompile.h 17 Nov 2003 22:47:50 -0000
@@ -526,11 +526,13 @@
#define INST_EXPON 99 /* TIP#123 - exponentiation */
-#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
/* The last opcode */
-#define LAST_INST_OPCODE 101
+#define LAST_INST_OPCODE 102
/*
* Table describing the Tcl bytecode instructions: their name (for
@@ -549,7 +551,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. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -846,6 +847,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.
@@ -858,16 +874,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);\
+ }\
}
/*
@@ -932,25 +943,6 @@
(unsigned char) ((unsigned int) (i) );\
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
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.117
diff -u -r1.117 tclExecute.c
--- generic/tclExecute.c 16 Nov 2003 02:12:56 -0000 1.117
+++ generic/tclExecute.c 17 Nov 2003 22:47:50 -0000
@@ -388,7 +388,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));
@@ -1088,9 +1089,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;
@@ -1100,6 +1099,7 @@
#endif
int instructionCount = 0; /* Counter that is used to work out
* when to call Tcl_AsyncReady() */
+ Tcl_Obj *expandLinkList = NULL;
/*
* The execution uses a unified stack: first the catch stack, immediately
@@ -1202,8 +1202,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*/ (expandLinkList == NULL));
if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (tosPtr - eePtr->stackPtr));
TclPrintInstruction(codePtr, pc);
@@ -1335,120 +1339,106 @@
NEXT_INST_V(2, opnd, 1);
}
- case INST_LIST_VERIFY:
+ case INST_EXPAND_START:
+ /*
+ * Push an element to the expandLinkList.
+ * 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, in INST_EXPAND_STKTOP and in
+ * INST_INVOKE_EXPANDED.
+ */
+
+ TclNewObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandLinkList;
+ expandLinkList = 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 = expandLinkList;
+ expandLinkList = (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 = expandLinkList;
+ expandLinkList = (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.
@@ -1548,12 +1538,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
@@ -4536,7 +4520,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
@@ -4545,6 +4529,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. */
@@ -4564,7 +4550,8 @@
(unsigned int) opCode, relativePc);
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);
