Attachment "range3.patch" to
ticket [1052584fff]
added by
antirez
2004-10-24 16:34:19.
? foo.ps
? unix/dltest.marker
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.104
diff -u -r1.104 tcl.decls
--- generic/tcl.decls 13 May 2004 12:59:20 -0000 1.104
+++ generic/tcl.decls 24 Oct 2004 09:31:18 -0000
@@ -1909,6 +1909,17 @@
declare 534 generic {
int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type)
}
+declare 535 generic {
+ Tcl_Obj * Tcl_NewArithSeriesObj(Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step)
+}
+declare 536 generic {
+ int Tcl_ArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index,
+ Tcl_WideInt *element)
+}
+declare 537 generic {
+ Tcl_WideInt Tcl_ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr)
+}
##############################################################################
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.132
diff -u -r1.132 tclBasic.c
--- generic/tclBasic.c 21 Oct 2004 17:07:31 -0000 1.132
+++ generic/tclBasic.c 24 Oct 2004 09:31:25 -0000
@@ -94,6 +94,7 @@
{"namespace", Tcl_NamespaceObjCmd, (CompileProc *) NULL, 1},
{"package", Tcl_PackageObjCmd, (CompileProc *) NULL, 1},
{"proc", Tcl_ProcObjCmd, (CompileProc *) NULL, 1},
+ {"range", Tcl_RangeObjCmd, (CompileProc *) NULL, 1},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, 1},
{"regsub", Tcl_RegsubObjCmd, (CompileProc *) NULL, 1},
{"rename", Tcl_RenameObjCmd, (CompileProc *) NULL, 1},
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.56
diff -u -r1.56 tclCmdAH.c
--- generic/tclCmdAH.c 21 Oct 2004 15:19:46 -0000 1.56
+++ generic/tclCmdAH.c 24 Oct 2004 09:31:29 -0000
@@ -1767,10 +1767,14 @@
goto done;
}
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
- if (result != TCL_OK) {
- goto done;
+ if (argObjv[2+i*2]->typePtr != &tclArithSeriesType) {
+ result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+ &argcList[i], &argvList[i]);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ } else {
+ argcList[i] = (int) Tcl_ArithSeriesObjLength(argObjv[2+i*2]);
}
j = argcList[i] / varcList[i];
@@ -1804,10 +1808,14 @@
if (result != TCL_OK) {
Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
}
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
- if (result != TCL_OK) {
- Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
+ if (argObjv[2+i*2]->typePtr != &tclArithSeriesType) {
+ result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+ &argcList[i], &argvList[i]);
+ if (result != TCL_OK) {
+ Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
+ }
+ } else {
+ argcList[i] = (int) Tcl_ArithSeriesObjLength(argObjv[2+i*2]);
}
for (v = 0; v < varcList[i]; v++) {
@@ -1816,7 +1824,14 @@
int isEmptyObj = 0;
if (k < argcList[i]) {
- valuePtr = argvList[i][k];
+ if (argObjv[2+i*2]->typePtr != &tclArithSeriesType) {
+ valuePtr = argvList[i][k];
+ } else {
+ ArithSeries *arithSeriesRepPtr =
+ argObjv[2+i*2]->internalRep.twoPtrValue.ptr1;
+ valuePtr = Tcl_NewWideIntObj(arithSeriesRepPtr->start+
+ (k*arithSeriesRepPtr->step));
+ }
} else {
valuePtr = Tcl_NewObj(); /* empty string */
isEmptyObj = 1;
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.66
diff -u -r1.66 tclCmdIL.c
--- generic/tclCmdIL.c 14 Oct 2004 17:20:11 -0000 1.66
+++ generic/tclCmdIL.c 24 Oct 2004 09:31:35 -0000
@@ -2344,6 +2344,31 @@
if (argPtr->typePtr != &tclListType
&& TclGetIntForIndex(NULL , argPtr, 0, &index) == TCL_OK) {
+
+ /* If the list is an arithmetic series return the
+ * computed element. */
+ if (listPtr->typePtr == &tclArithSeriesType) {
+ Tcl_Obj *widePtr;
+ Tcl_WideInt wideVal, asLen;
+
+ /* Parse the index */
+ asLen = Tcl_ArithSeriesObjLength(listPtr);
+ result = TclGetIntForIndex(interp, argPtr,
+ /*endValue*/ asLen-1, &index);
+ if (result != TCL_OK) return NULL;
+
+ /* Return the computed wideInt object */
+ if (Tcl_ArithSeriesObjIndex(listPtr, index, &wideVal) == TCL_OK)
+ {
+ widePtr = Tcl_NewWideIntObj(wideVal);
+ } else {
+ /* Index out of range case */
+ widePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(widePtr);
+ return widePtr;
+ }
+
/*
* argPtr designates a single index.
*/
@@ -2728,6 +2753,11 @@
return TCL_ERROR;
}
+ if (objv[1]->typePtr == &tclArithSeriesType) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewWideIntObj(Tcl_ArithSeriesObjLength(objv[1])));
+ return TCL_OK;
+ }
result = Tcl_ListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
@@ -3647,6 +3677,83 @@
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RangeObjCmd --
+ *
+ * This procedure returns a list where every element is
+ * part of an arithmetic sequence starting with the number START,
+ * incrementing the next elements of STEP, and including
+ * all the elements < END (or > END for negative steps).
+ * The command returns a specialized object able to represent
+ * this lists in constant space (the Arithmetic Sequence object type).
+ * See Tcl_ListObj.c for more information on this object.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RangeObjCmd( clientData, interp, objc, objv )
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
+{
+ Tcl_WideInt start = 0, end, step = 1;
+ Tcl_Obj *arithSeriesPtr;
+
+ /* Check parameter count */
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?start? end ?step?");
+ return TCL_ERROR;
+ }
+
+ /* Get the start, end, step parameters from arguments */
+ if (objc == 2) {
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &end) != TCL_OK)
+ return TCL_ERROR;
+ } else if (objc >= 3) {
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &start) != TCL_OK ||
+ Tcl_GetWideIntFromObj(interp, objv[2], &end) != TCL_OK)
+ return TCL_ERROR;
+ if (objc == 4 &&
+ Tcl_GetWideIntFromObj(interp, objv[3], &step) != TCL_OK)
+ return TCL_ERROR;
+ }
+
+ /* Create the arithmetic series object, checking if the
+ * parameters are invalid. */
+
+ arithSeriesPtr = Tcl_NewArithSeriesObj(start, end, step);
+ if (arithSeriesPtr == NULL) {
+ Tcl_AppendResult(interp,
+ "Invalid (infinite?) arithmetic sequence specified", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_IncrRefCount(arithSeriesPtr); /* we may use DecrRefCount to free it */
+ if (Tcl_ArithSeriesObjLength(arithSeriesPtr) > INT_MAX/sizeof(Tcl_Obj *)) {
+ Tcl_DecrRefCount(arithSeriesPtr);
+ Tcl_AppendResult(interp, "overflow of maximum list length", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Return the new object. */
+
+ Tcl_SetObjResult(interp, arithSeriesPtr);
+ Tcl_DecrRefCount(arithSeriesPtr);
+ return TCL_OK;
+}
+
/*
*----------------------------------------------------------------------
*
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.105
diff -u -r1.105 tclDecls.h
--- generic/tclDecls.h 7 Jun 2004 16:48:44 -0000 1.105
+++ generic/tclDecls.h 24 Oct 2004 09:31:49 -0000
@@ -3314,6 +3314,25 @@
EXTERN int Tcl_LimitGetGranularity _ANSI_ARGS_((
Tcl_Interp * interp, int type));
#endif
+#ifndef Tcl_NewArithSeriesObj_TCL_DECLARED
+#define Tcl_NewArithSeriesObj_TCL_DECLARED
+/* 535 */
+EXTERN Tcl_Obj * Tcl_NewArithSeriesObj _ANSI_ARGS_((Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step));
+#endif
+#ifndef Tcl_ArithSeriesObjIndex_TCL_DECLARED
+#define Tcl_ArithSeriesObjIndex_TCL_DECLARED
+/* 536 */
+EXTERN int Tcl_ArithSeriesObjIndex _ANSI_ARGS_((
+ Tcl_Obj * arithSeriesPtr, Tcl_WideInt index,
+ Tcl_WideInt * element));
+#endif
+#ifndef Tcl_ArithSeriesObjLength_TCL_DECLARED
+#define Tcl_ArithSeriesObjLength_TCL_DECLARED
+/* 537 */
+EXTERN Tcl_WideInt Tcl_ArithSeriesObjLength _ANSI_ARGS_((
+ Tcl_Obj * arithSeriesPtr));
+#endif
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -3890,6 +3909,9 @@
int (*tcl_LimitGetCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 532 */
void (*tcl_LimitGetTime) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Time * timeLimitPtr)); /* 533 */
int (*tcl_LimitGetGranularity) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 534 */
+ Tcl_Obj * (*tcl_NewArithSeriesObj) _ANSI_ARGS_((Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)); /* 535 */
+ int (*tcl_ArithSeriesObjIndex) _ANSI_ARGS_((Tcl_Obj * arithSeriesPtr, Tcl_WideInt index, Tcl_WideInt * element)); /* 536 */
+ Tcl_WideInt (*tcl_ArithSeriesObjLength) _ANSI_ARGS_((Tcl_Obj * arithSeriesPtr)); /* 537 */
} TclStubs;
#ifdef __cplusplus
@@ -6070,6 +6092,18 @@
#define Tcl_LimitGetGranularity \
(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
#endif
+#ifndef Tcl_NewArithSeriesObj
+#define Tcl_NewArithSeriesObj \
+ (tclStubsPtr->tcl_NewArithSeriesObj) /* 535 */
+#endif
+#ifndef Tcl_ArithSeriesObjIndex
+#define Tcl_ArithSeriesObjIndex \
+ (tclStubsPtr->tcl_ArithSeriesObjIndex) /* 536 */
+#endif
+#ifndef Tcl_ArithSeriesObjLength
+#define Tcl_ArithSeriesObjLength \
+ (tclStubsPtr->tcl_ArithSeriesObjLength) /* 537 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.160
diff -u -r1.160 tclExecute.c
--- generic/tclExecute.c 22 Oct 2004 14:01:00 -0000 1.160
+++ generic/tclExecute.c 24 Oct 2004 09:31:59 -0000
@@ -2610,13 +2610,18 @@
valuePtr = *tosPtr;
- result = Tcl_ListObjLength(interp, valuePtr, &length);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ if (valuePtr->typePtr == &tclArithSeriesType) {
+ objResultPtr = Tcl_NewWideIntObj(
+ Tcl_ArithSeriesObjLength(valuePtr));
+ } else {
+ result = Tcl_ListObjLength(interp, valuePtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ objResultPtr = Tcl_NewIntObj(length);
}
- objResultPtr = Tcl_NewIntObj(length);
TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
}
@@ -4562,6 +4567,7 @@
int numLists;
Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
List *listRepPtr;
+ ArithSeries *arithSeriesRepPtr;
Var *iterVarPtr, *listVarPtr;
int iterNum, listTmpIndex, listLen, numVars;
int varIndex, valIndex, continueLoop, j;
@@ -4596,7 +4602,12 @@
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
- result = Tcl_ListObjLength(interp, listPtr, &listLen);
+ if (listPtr->typePtr == &tclArithSeriesType) {
+ listLen = (int) Tcl_ArithSeriesObjLength(listPtr);
+ result = TCL_OK; /* Tcl_ArithSeriesLength can't fail */
+ } else {
+ result = Tcl_ListObjLength(interp, listPtr, &listLen);
+ }
if (result != TCL_OK) {
TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
@@ -4624,27 +4635,70 @@
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- listLen = listRepPtr->elemCount;
+ arithSeriesRepPtr = (ArithSeries *) listRepPtr;
+ if (listPtr->typePtr == &tclListType) {
+ listLen = listRepPtr->elemCount;
+ } else {
+ listLen = arithSeriesRepPtr->len;
+ }
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
- int setEmptyStr = 0;
- if (valIndex >= listLen) {
- setEmptyStr = 1;
- TclNewObj(valuePtr);
- } else {
- valuePtr = listRepPtr->elements[valIndex];
- }
-
+ int setEmptyStr = 0, inlineVarAccess = 0;
+
varIndex = varListPtr->varIndexes[j];
varPtr = &(compiledLocals[varIndex]);
part1 = varPtr->name;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL))
- && (varPtr->tracePtr == NULL)
- && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (!((varPtr->flags & VAR_IN_HASHTABLE) &&
+ (varPtr->hPtr == NULL))
+ && (varPtr->tracePtr == NULL)
+ && (TclIsVarScalar(varPtr) ||
+ TclIsVarUndefined(varPtr)))
+ {
+ inlineVarAccess = 1;
+ }
+
+ if (valIndex >= listLen) {
+ setEmptyStr = 1;
+ TclNewObj(valuePtr);
+ } else {
+ if(listPtr->typePtr == &tclListType) {
+ valuePtr = listRepPtr->elements[valIndex];
+ } else {
+ /* If possible we kill the reference
+ * in the var ASAP, in order to be sure
+ * that the arithSeries Wide object is not
+ * shared just becaues of it. */
+ if (inlineVarAccess) {
+ if (varPtr->value.objPtr ==
+ arithSeriesRepPtr->wideObjPtr)
+ {
+ Tcl_DecrRefCount(varPtr->value.objPtr);
+ varPtr->value.objPtr = NULL;
+ }
+ }
+ /* Try to reuse the same object for every
+ * interation. */
+ if (arithSeriesRepPtr->wideObjPtr->typePtr !=
+ &tclWideIntType ||
+ Tcl_IsShared(arithSeriesRepPtr->wideObjPtr))
+ {
+ Tcl_DecrRefCount(arithSeriesRepPtr->wideObjPtr);
+ arithSeriesRepPtr->wideObjPtr = Tcl_NewWideIntObj(0);
+ Tcl_IncrRefCount(arithSeriesRepPtr->wideObjPtr);
+ }
+ valuePtr = arithSeriesRepPtr->wideObjPtr;
+ valuePtr->internalRep.wideValue =
+ arithSeriesRepPtr->start+
+ (valIndex*arithSeriesRepPtr->step);
+ Tcl_InvalidateStringRep(valuePtr);
+ }
+ }
+
+ if (inlineVarAccess) {
value2Ptr = varPtr->value.objPtr;
if (valuePtr != value2Ptr) {
if (value2Ptr != NULL) {
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.186
diff -u -r1.186 tclInt.h
--- generic/tclInt.h 21 Oct 2004 17:07:31 -0000 1.186
+++ generic/tclInt.h 24 Oct 2004 09:32:05 -0000
@@ -1537,6 +1537,19 @@
} List;
/*
+ * The structure used for the AirthSeries internal representation.
+ * Note that the len can in theory be always computed by start,end,step
+ * but it's faster to cache it inside the internal representation.
+ */
+typedef struct ArithSeries {
+ Tcl_WideInt start;
+ Tcl_WideInt end;
+ Tcl_WideInt step;
+ Tcl_WideInt len;
+ Tcl_Obj *wideObjPtr; /* Used to speedup [foreach] reusing the same obj. */
+} ArithSeries;
+
+/*
*----------------------------------------------------------------
* Data structures related to the filesystem internals
*----------------------------------------------------------------
@@ -1642,6 +1655,7 @@
extern Tcl_ObjType tclEndOffsetType;
extern Tcl_ObjType tclIntType;
extern Tcl_ObjType tclListType;
+extern Tcl_ObjType tclArithSeriesType;
extern Tcl_ObjType tclDictType;
extern Tcl_ObjType tclProcBodyType;
extern Tcl_ObjType tclStringType;
@@ -2062,6 +2076,8 @@
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_PwdObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_RangeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ReadObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_RegexpObjCmd _ANSI_ARGS_((ClientData clientData,
Index: generic/tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.19
diff -u -r1.19 tclListObj.c
--- generic/tclListObj.c 29 Sep 2004 22:17:30 -0000 1.19
+++ generic/tclListObj.c 24 Oct 2004 09:32:09 -0000
@@ -1566,6 +1566,33 @@
List *listRepPtr;
/*
+ * Convertion from Arithmetic Series is a special case
+ * because it can be done an order of magnitude faster
+ * and may occur frequently.
+ */
+ if (objPtr->typePtr == &tclArithSeriesType) {
+ Tcl_WideInt wideLen = Tcl_ArithSeriesObjLength(objPtr), j;
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ objPtr->internalRep.twoPtrValue.ptr1;
+
+ elemPtrs = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*)*wideLen);
+ for (j = 0; j < wideLen; j++) {
+ elemPtrs[j] = Tcl_NewWideIntObj(
+ arithSeriesRepPtr->start+(j*arithSeriesRepPtr->step));
+ }
+ listRepPtr = (List *) ckalloc(sizeof(List));
+ listRepPtr->maxElemCount = wideLen;
+ listRepPtr->elemCount = wideLen;
+ listRepPtr->elements = elemPtrs;
+
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclListType;
+ return TCL_OK;
+ }
+
+ /*
* Get the string representation. Make it up-to-date if necessary.
*/
@@ -1733,3 +1760,372 @@
}
listPtr->length = dst - listPtr->bytes;
}
+
+/* -------------------------- ArithSeries object ---------------------------- */
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupArithSeriesInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeArithSeriesInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
+static int SetArithSeriesFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void UpdateStringOfArithSeries _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+/*
+ * The structure below defines the arithmetic series Tcl object type by
+ * means of procedures that can be invoked by generic object code.
+ *
+ * The arithmetic series object is a special case of Tcl list representing
+ * an interval of an arithmetic series in constant space.
+ *
+ * The arithmetic series is internally represented with three integers,
+ * *start*, *end*, and *step*, Where the length is calculated with
+ * the following algorithm:
+ *
+ * if RANGE == 0 THEN
+ * ERROR
+ * if RANGE > 0
+ * LEN is (((END-START)-1)/STEP) + 1
+ * else if RANGE < 0
+ * LEN is (((END-START)-1)/STEP) - 1
+ *
+ * And where the equivalent's list I-th element is calculated
+ * as:
+ *
+ * LIST[i] = START+(STEP*i)
+ *
+ * Zero elements ranges, like in the case of START=10 END=10 STEP=1
+ * are valid and will be equivalent to the empty list.
+ */
+
+Tcl_ObjType tclArithSeriesType = {
+ "arithseries", /* name */
+ FreeArithSeriesInternalRep, /* freeIntRepProc */
+ DupArithSeriesInternalRep, /* dupIntRepProc */
+ UpdateStringOfArithSeries, /* updateStringProc */
+ SetArithSeriesFromAny /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArithSeriesLen --
+ *
+ * Compute the length of the equivalent list where
+ * every element is generated starting from *start*,
+ * and adding *step* to generate every successive element
+ * that's < *end* for positive steps, or > *end* for negative
+ * steps.
+ *
+ * Results:
+ *
+ * The length of the list generated by the given range,
+ * that may be zero.
+ * The function returns -1 if the list is of length infiite.
+ *
+ * Side effects:
+ *
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static Tcl_WideInt
+ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
+{
+ Tcl_WideInt len;
+
+ if (step == 0) return -1;
+ else if (step > 0 && start > end) return -1;
+ else if (step < 0 && end > start) return -1;
+ len = ((step > 0) ? 1 : -1) + (((end-start)-1)/step);
+ return (len < 0) ? -1 : len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewArithSeriesObj --
+ *
+ * Creates a new ArithSeries object. The returned object has
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+Tcl_NewArithSeriesObj(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
+{
+ Tcl_WideInt len = ArithSeriesLen(start, end, step);
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeries *arithSeriesRepPtr;
+
+ if (len == -1) return NULL; /* Invalid range error */
+ TclNewObj(arithSeriesPtr);
+
+ arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries));
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = len;
+ arithSeriesRepPtr->wideObjPtr = Tcl_NewWideIntObj(0);
+ Tcl_IncrRefCount(arithSeriesRepPtr->wideObjPtr);
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (len > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ArithSeriesObjIndex --
+ *
+ * Returns the element with the specified index in the list
+ * represented by the specified Arithmentic Sequence object.
+ * If the index is out of range, TCL_ERROR is returned,
+ * otherwise TCL_OK is returned and the integer value of the
+ * element is stored in *element.
+ *
+ * Results:
+ *
+ * TCL_OK on succes, TCL_ERROR on index out of range.
+ *
+ * Side Effects:
+ *
+ * On success, the integer pointed by *element is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_WideInt *element)
+{
+ ArithSeries *arithSeriesRepPtr;
+
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ Tcl_Panic("Tcl_ArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = (ArithSeries*)
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ if (index < 0 || index >= arithSeriesRepPtr->len)
+ return TCL_ERROR;
+ /* List[i] = Start + (Step * i) */
+ *element = arithSeriesRepPtr->start+(index*arithSeriesRepPtr->step);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ArithSeriesObjLength
+ *
+ * Returns the length of the arithmentic series.
+ *
+ * Results:
+ *
+ * The length of the series as Tcl_WideInt.
+ *
+ * Side Effects:
+ *
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_WideInt Tcl_ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ return arithSeriesRepPtr->len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeArithSeriesInternalRep --
+ *
+ * Deallocate the storage associated with an arithseries object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees arithSeriesPtr's ArithSeries* internal representation and
+ * sets listPtr's internalRep.twoPtrValue.ptr1 to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_DecrRefCount(arithSeriesRepPtr->wideObjPtr);
+ ckfree((char *) arithSeriesRepPtr);
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupArithSeriesInternalRep --
+ *
+ * Initialize the internal representation of a arithseries Tcl_Obj to a
+ * copy of the internal representation of an existing arithseries object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * We set "copyPtr"s internal rep to a pointer to a
+ * newly allocated ArithSeries structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupArithSeriesInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ ArithSeries *srcArithSeriesRepPtr =
+ (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
+ ArithSeries *copyArithSeriesRepPtr;
+ Tcl_WideInt wideVal;
+
+ /*
+ * Allocate a new ArithSeries structure. */
+
+ copyArithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof(ArithSeries));
+ copyArithSeriesRepPtr->start = srcArithSeriesRepPtr->start;
+ copyArithSeriesRepPtr->end = srcArithSeriesRepPtr->end;
+ copyArithSeriesRepPtr->step = srcArithSeriesRepPtr->step;
+ copyArithSeriesRepPtr->len = srcArithSeriesRepPtr->len;
+ if (Tcl_GetWideIntFromObj(NULL, srcArithSeriesRepPtr->wideObjPtr,
+ &wideVal) != TCL_OK)
+ {
+ Tcl_Panic("Tcl_GetWideIntFromObj() failed against WideInt object.");
+ }
+ copyArithSeriesRepPtr->wideObjPtr = Tcl_NewWideIntObj(wideVal);
+ Tcl_IncrRefCount(copyArithSeriesRepPtr->wideObjPtr);
+
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyArithSeriesRepPtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ copyPtr->typePtr = &tclArithSeriesType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfArithSeries --
+ *
+ * Update the string representation for an arithseries object.
+ * Note: This procedure does not invalidate an existing old string rep
+ * so storage will be lost if this has not already been done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from
+ * the list-to-string conversion. This string will be empty if the
+ * list has no elements. The list internal representation
+ * should not be NULL and we assume it is not NULL.
+ *
+ * Notes:
+ * At the cost of overallocation it's possible to estimate
+ * the length of the string representation and make this procedure
+ * much faster. Because the programmer shouldn't expect the
+ * string conversion of a big arithmetic sequence to be fast
+ * this version takes more care of space than time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ char buffer[TCL_INTEGER_SPACE+2], *p;
+ Tcl_WideInt i;
+ Tcl_WideInt length = 0, ele;
+ int slen;
+
+ /*
+ * Pass 1: estimate space.
+ */
+ for (i = 0; i < arithSeriesRepPtr->len; i++) {
+ ele = arithSeriesRepPtr->start + (i*arithSeriesRepPtr->step);
+ /*
+ * Note that sprintf will generate a compiler warning under
+ * Mingw claiming %I64 is an unknown format specifier.
+ * Just ignore this warning. We can't use %L as the format
+ * specifier since that gets printed as a 32 bit value.
+ */
+ sprintf(buffer, "%" TCL_LL_MODIFIER "d", ele);
+ slen = strlen(buffer) + 1; /* + 1 is for the space or the nul-term */
+ length += slen;
+ }
+
+ /*
+ * Pass 2: generate the string repr.
+ */
+
+ p = arithSeriesPtr->bytes = ckalloc(length);
+ for (i = 0; i < arithSeriesRepPtr->len; i++) {
+ ele = arithSeriesRepPtr->start + (i*arithSeriesRepPtr->step);
+ sprintf(buffer, "%" TCL_LL_MODIFIER "d", ele);
+ slen = strlen(buffer);
+ strcpy(p, buffer);
+ p[slen] = ' ';
+ p += slen+1;
+ }
+ if (length > 0) arithSeriesPtr->bytes[length-1] = '\0';
+ arithSeriesPtr->length = length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetArithSeriesFromAny --
+ *
+ * The Arithmetic Series object is just an way to optimize
+ * Lists space complexity, so no one should try to convert
+ * a string to an Arithmetic Series object.
+ *
+ * This function is here just to populate the Type structure.
+ *
+ * Results:
+ *
+ * The result is always TCL_ERROR. But see Side Effects.
+ *
+ * Side effects:
+ *
+ * Tcl Panic if called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetArithSeriesFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_Panic("SetArithSeriesFromAny: should never be called");
+ return TCL_ERROR;
+}
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.105
diff -u -r1.105 tclStubInit.c
--- generic/tclStubInit.c 14 Oct 2004 15:06:03 -0000 1.105
+++ generic/tclStubInit.c 24 Oct 2004 09:32:11 -0000
@@ -932,6 +932,9 @@
Tcl_LimitGetCommands, /* 532 */
Tcl_LimitGetTime, /* 533 */
Tcl_LimitGetGranularity, /* 534 */
+ Tcl_NewArithSeriesObj, /* 535 */
+ Tcl_ArithSeriesObjIndex, /* 536 */
+ Tcl_ArithSeriesObjLength, /* 537 */
};
/* !END!: Do not edit above this line. */
