Attachment "expand-list.patch" to
ticket [842446ffff]
added by
msofer
2003-11-20 05:41:12.
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.54
diff -u -r1.54 tclCompile.c
--- generic/tclCompile.c 19 Nov 2003 22:04:39 -0000 1.54
+++ generic/tclCompile.c 19 Nov 2003 22:38:09 -0000
@@ -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.54 2003/11/19 22:04:39 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.52 2003/11/14 20:44:44 dgp Exp $
*/
#include "tclInt.h"
@@ -273,10 +273,11 @@
/* 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> */
+ {"expand", 1, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Concatenate as lists the top op1 items and push result */
+ {"invokelist", 1, 0, 0, {OPERAND_NONE}},
+ /* Invoke the command contained in the list at stacktop, and
+ * push the result. */
{0}
};
@@ -848,8 +849,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 +901,6 @@
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
expand = 1;
- Tcl_DStringInit(&deltaList);
break;
}
}
@@ -914,34 +912,75 @@
EnterCmdStartData(envPtr, currCmdIndex,
(parse.commandStart - envPtr->source), startCodeOffset);
+ /*
+ * Handle separately the compilation of commands that include
+ * any expanding words .
+ */
+
+ if (expand) {
+ int listCount = 0;
+
+ /*
+ * Push an empty list first; the command will be built
+ * up by appending elements to it.
+ */
+
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+
+ for (wordIdx = 0, tokenPtr = parse.tokenPtr;
+ wordIdx < parse.numWords;
+ wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto log;
+ }
+ if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ TclEmitInstInt1(INST_EXPAND, listCount, envPtr);
+ listCount = 0;
+ } else {
+ listCount++;
+ if (listCount > 254) {
+ /* Append all items to the command now, and reset
+ * the counter. Note that we push an empty list
+ * to be expanded here.
+ */
+
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ TclEmitInstInt1(INST_EXPAND, listCount, envPtr);
+ listCount = 0;
+ }
+ }
+ }
+ if (listCount) {
+ /*
+ * Loose items at the end; push an empty list, then
+ * expand it to have them appended to the command.
+ */
+
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ TclEmitInstInt1(INST_EXPAND, listCount, envPtr);
+ }
+ TclEmitOpcode(INST_INVOKE_LIST, envPtr);
+ goto finishCommand;
+ }
+
/*
* Each iteration of the following loop compiles one word
* from the command.
*/
for (wordIdx = 0, tokenPtr = parse.tokenPtr;
- wordIdx < parse.numWords; delta++, 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;
- }
-
+ wordIdx < parse.numWords;
+ wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* If this is the first word and the command has a
* compile procedure, let it compile the command.
*/
- if ((wordIdx == 0) && !expand) {
+ if (wordIdx == 0) {
if (envPtr->procPtr != NULL) {
cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
} else {
@@ -1024,55 +1063,20 @@
goto log;
}
}
- 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;
- }
}
/*
* Emit an invoke instruction for the command. We skip this
* if a compile procedure was found for the command.
*/
-
- if (expand) {
- TclEmitInstInt4(INST_INVOKE_EXP, wordIdx, envPtr);
- TclEmitImmDeltaList1(&deltaList, envPtr);
- Tcl_DStringFree(&deltaList);
- } else if (wordIdx > 0) {
+
+ if (wordIdx > 0) {
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
}
- }
+ }
/*
* Update the compilation environment structure and record the
@@ -3218,13 +3222,13 @@
register InstructionDesc *instDesc = &tclInstructionTable[opCode];
unsigned char *codeStart = codePtr->codeStart;
unsigned int pcOffset = (pc - codeStart);
- int opnd, i, j, numBytes = 1;
+ int opnd, i, j;
fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
- opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+ opnd = TclGetInt1AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP1)
|| (opCode == INST_JUMP_TRUE1)
|| (opCode == INST_JUMP_FALSE1))) {
@@ -3234,7 +3238,7 @@
}
break;
case OPERAND_INT4:
- opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ opnd = TclGetInt4AtPtr(pc+1+i);
if ((i == 0) && ((opCode == INST_JUMP4)
|| (opCode == INST_JUMP_TRUE4)
|| (opCode == INST_JUMP_FALSE4))) {
@@ -3244,7 +3248,7 @@
}
break;
case OPERAND_UINT1:
- opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ opnd = TclGetUInt1AtPtr(pc+1+i);
if ((i == 0) && (opCode == INST_PUSH1)) {
fprintf(stdout, "%u # ", (unsigned int) opnd);
TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
@@ -3257,6 +3261,7 @@
if (opnd >= localCt) {
panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
(unsigned int) opnd, localCt);
+ return instDesc->numBytes;
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
@@ -3273,7 +3278,7 @@
}
break;
case OPERAND_UINT4:
- opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ opnd = TclGetUInt4AtPtr(pc+1+i);
if (opCode == INST_PUSH4) {
fprintf(stdout, "%u # ", opnd);
TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
@@ -3286,6 +3291,7 @@
if (opnd >= localCt) {
panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
(unsigned int) opnd, localCt);
+ return instDesc->numBytes;
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
@@ -3301,24 +3307,13 @@
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:
default:
break;
}
}
fprintf(stdout, "\n");
- return numBytes;
+ return instDesc->numBytes;
}
/*
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 19 Nov 2003 22:38:09 -0000
@@ -526,8 +526,8 @@
#define INST_EXPON 99 /* TIP#123 - exponentiation */
-#define INST_LIST_VERIFY 100
-#define INST_INVOKE_EXP 101
+#define INST_EXPAND 100
+#define INST_INVOKE_LIST 101
/* The last opcode */
#define LAST_INST_OPCODE 101
@@ -548,8 +548,7 @@
OPERAND_INT1, /* One byte signed integer. */
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_UINT4 /* Four byte unsigned integer. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -931,25 +930,6 @@
*(envPtr)->codeNext++ = \
(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
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 19 Nov 2003 22:38:09 -0000
@@ -1088,9 +1088,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;
@@ -1133,6 +1131,9 @@
#ifdef TCL_COMPILE_STATS
iPtr->stats.numExecutions++;
#endif
+ int objc = 0;
+ Tcl_Obj **objv;
+
/*
@@ -1335,121 +1336,131 @@
NEXT_INST_V(2, opnd, 1);
}
- case INST_LIST_VERIFY:
- {
- int numElements = 0;
- valuePtr = *tosPtr;
+ case INST_EXPAND:
+ /*
+ * On entering, the stack contains:
+ * (top) listPtr2
+ * elemPtr(opnd)
+ * elemPtr(opnd-1)
+ * ...
+ * listPtr1
+ *
+ * This instruction appends to list1 first the (opnd) elements,
+ * then the elements of list2
+ */
- result = Tcl_ListObjLength(interp, valuePtr, &numElements);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- NEXT_INST_F(1, 0, 0);
- }
+ objc = TclGetUInt1AtPtr(pc+1);
+ objv = tosPtr - objc;
+ objPtr = *(objv - 1); /* The list we are building */
+ valuePtr = *tosPtr;
+ length = 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;
+ /*
+ * Make sure the object to which we are appending is
+ * a list.
+ */
+ result = Tcl_ListObjLength(interp, objPtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+
+ if ((length == 0) && (objc == 0)) {
/*
- * Compute number of objects needed to store the
- * command after expansion is complete.
+ * Optimisation: when concatenating an empty list
+ * and *tosPtr; make sure the latter is a valid list
+ * and swap them on the stack.
*/
- opnd = objc = numWords;
- for (deltaPtr = deltaPtrStart; *deltaPtr; deltaPtr++) {
- int numElements;
- wordToExpand += TclGetUInt1AtPtr(deltaPtr);
- Tcl_ListObjLength(NULL, wordv[wordToExpand], &numElements);
- objc += numElements - 1;
+ *(tosPtr-1) = valuePtr;
+ *tosPtr = objPtr;
+ result = Tcl_ListObjLength(interp, valuePtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
}
+ NEXT_INST_F(2, 1, 0);
+ }
+
+ /*
+ * Make sure the object to which we are appending is
+ * unshared. Remark that if it is already a list we
+ * could save the expense of duplicating the string rep.
+ */
+
+ if (Tcl_IsShared(objPtr)) {
+ TclDecrRefCount(objPtr);
+ objPtr = Tcl_DuplicateObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ *(objv - 1) = objPtr;
+ }
+
+ /*
+ * Append objc elements.
+ */
+
+ if (objc) {
+ Tcl_ListObjReplace(interp, objPtr, length, 0, objc, objv);
+ }
+
+ /*
+ * Append elements of the list to be expanded (at top of stack).
+ */
+
+ result = Tcl_ListObjAppendList(interp, objPtr, valuePtr);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
- /*
- * 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.
- */
+ NEXT_INST_V(2, (objc+1), 0);
- objv = stackObjArray = tosPtr + 1;
- if (objc > spaceAvailable) {
- objv = (Tcl_Obj **) ckalloc((unsigned)
- (objc * sizeof(Tcl_Obj *)));
- } else {
- tosPtr += objc;
- }
+ case INST_INVOKE_LIST:
+ /*
+ * If the list at stackTop is empty, do not
+ * invoke and leave it as the result; otherwise,
+ * set the cleanup parameters and invoke the
+ * command contained in the list.
+ */
- 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.
- */
-
- 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;
+ result = Tcl_ListObjGetElements(interp, *tosPtr, &objc, &objv);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
}
-
+ if (!objc) {
+ NEXT_INST_F(1, 0, 0);
+ }
+ opnd = 1; /* The number of stack objs to free. */
+ pcAdjustment = 1;
+ goto doInvocation;
+
case INST_INVOKE_STK4:
- opnd = TclGetUInt4AtPtr(pc+1);
- objc = opnd;
- objv = stackObjArray = (tosPtr - (objc-1));
+ opnd = TclGetUInt4AtPtr(pc+1); /* The number of stack objs to free. */
+ objc = opnd; /* The number of arguments. */
+ objv = (tosPtr - (objc-1)); /* The array of argument objects. */
pcAdjustment = 5;
goto doInvocation;
case INST_INVOKE_STK1:
- opnd = TclGetUInt1AtPtr(pc+1);
- objc = opnd;
- objv = stackObjArray = (tosPtr - (objc-1));
+ opnd = TclGetUInt1AtPtr(pc+1); /* The number of stack objs to free. */
+ objc = opnd; /* The number of arguments. */
+ objv = (tosPtr - (objc-1)); /* The array of argument objects. */
pcAdjustment = 2;
doInvocation:
{
- /*
+ /*
+ * We have to insure that the memory currently containing
+ * the stack is preserved: it may contain the objv array,
+ * which must be kept live throughout trace and command
+ * invokations.
+ *
* We keep the stack reference count as a (char *), as that
* works nicely as a portable pointer-sized counter.
*/
@@ -1547,12 +1558,6 @@
if (*preservedStackRefCountPtr == (char *) 0) {
ckfree((VOID *) preservedStackRefCountPtr);
}
-
- if (objv != stackObjArray) {
- ckfree((char *) objv);
- } else if (*pc == INST_INVOKE_EXP) {
- tosPtr -= objc;
- }
if (result == TCL_OK) {
/*
Index: generic/tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.17
diff -u -r1.17 tclListObj.c
--- generic/tclListObj.c 1 Nov 2003 01:28:04 -0000 1.17
+++ generic/tclListObj.c 19 Nov 2003 22:38:09 -0000
@@ -499,7 +499,7 @@
listLen = listRepPtr->elemCount;
result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
- if (result != TCL_OK) {
+ if ((result != TCL_OK) || (objc == 0)) {
return result;
}
