Attachment "msrange.patch" to
ticket [1052584fff]
added by
msofer
2004-10-24 20:50:11.
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 13:44:45 -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 13:44:46 -0000
@@ -1767,8 +1767,7 @@
goto done;
}
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
+ result = (int) Tcl_ListObjLength(interp, argObjv[2+i*2], &argcList[i] );
if (result != TCL_OK) {
goto done;
}
@@ -1804,10 +1803,12 @@
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);
+ }
}
for (v = 0; v < varcList[i]; v++) {
@@ -1816,7 +1817,11 @@
int isEmptyObj = 0;
if (k < argcList[i]) {
- valuePtr = argvList[i][k];
+ if (argObjv[2+i*2]->typePtr != &tclArithSeriesType) {
+ valuePtr = argvList[i][k];
+ } else {
+ Tcl_ListObjIndex(interp, argObjv[2+i*2], k, &valuePtr);
+ }
} else {
valuePtr = Tcl_NewObj(); /* empty string */
isEmptyObj = 1;
@@ -1833,7 +1838,6 @@
result = TCL_ERROR;
goto done;
}
-
}
}
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 13:44:48 -0000
@@ -2335,7 +2335,7 @@
int indexCount; /* Size of the array of list indices */
Tcl_Obj *oldListPtr; /* Temp location to preserve the list
* pointer when replacing it with a sublist */
-
+
/*
* Determine whether argPtr designates a list or a single index.
* We have to be careful about the order of the checks to avoid
@@ -2349,8 +2349,8 @@
*/
return TclLindexFlat(interp, listPtr, 1, &argPtr);
-
}
+
if (Tcl_ListObjGetElements(NULL, argPtr, &indexCount, &indices) != TCL_OK){
/*
* argPtr designates something that is neither an index nor a
@@ -2360,6 +2360,10 @@
return TclLindexFlat( interp, listPtr, 1, &argPtr );
}
+ if (indexCount == 1) {
+ return TclLindexFlat( interp, listPtr, 1, &argPtr );
+ }
+
/*
* Record the reference to the list that we are maintaining in
* the activation record.
@@ -2473,7 +2477,7 @@
* Tcl_LindexObjCmd whenever either is presented with objc==2 or
* objc>=4. It is also called from TclLindexList for the objc==3
* case once it is determined that objv[2] cannot be parsed as a
- * list.
+ * list, or when objv[2] has length 1.
*
*----------------------------------------------------------------------
*/
@@ -2499,6 +2503,31 @@
Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that
* its ref count can be decremented. */
+
+ if ((indexCount == 1) && (listPtr->typePtr == &tclArithSeriesType)) {
+ Tcl_Obj *resPtr;
+
+ Tcl_ListObjLength(interp, listPtr, &listLen);
+ result = TclGetIntForIndex(interp, indexArray[0],
+ /*endValue*/ listLen-1, &index);
+ if (result != TCL_OK) {
+ /*
+ * Index could not be parsed
+ */
+
+ Tcl_DecrRefCount(listPtr);
+ return NULL;
+ }
+ result = Tcl_ListObjIndex(interp, listPtr, index, &resPtr);
+ if (result!= TCL_OK) {
+ return NULL;
+ } else if (resPtr == NULL) {
+ TclNewObj(resPtr);
+ }
+ Tcl_IncrRefCount(resPtr);
+ return resPtr;
+ }
+
/*
* Record the reference to the 'listPtr' object that we are
* maintaining in the C activation record.
@@ -3646,7 +3675,6 @@
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
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 13:44:53 -0000
@@ -2659,6 +2659,7 @@
int listc, idx, opnd;
Tcl_Obj **listv;
Tcl_Obj *valuePtr;
+ ArithSeries *arithSeriesRepPtr = NULL;
/*
* Pop the list and get the index
@@ -2668,13 +2669,20 @@
/*
* Get the contents of the list, making sure that it
- * really is a list in the process.
+ * really is a list in the process. Special case for arithmetic
+ * series.
*/
- result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ if (valuePtr->typePtr == &tclArithSeriesType) {
+ arithSeriesRepPtr = (ArithSeries*)
+ valuePtr->internalRep.twoPtrValue.ptr1;
+ listc = arithSeriesRepPtr->len;
+ } else {
+ result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
}
/*
@@ -2687,7 +2695,17 @@
idx = opnd;
}
if (idx >= 0 && idx < listc) {
- objResultPtr = listv[idx];
+ if (arithSeriesRepPtr) {
+ if (arithSeriesRepPtr->flags & TCL_RANGE_IS_WIDE) {
+ objResultPtr = Tcl_NewWideIntObj(arithSeriesRepPtr->start.w+
+ (idx*arithSeriesRepPtr->step.w));
+ } else {
+ objResultPtr = Tcl_NewIntObj(arithSeriesRepPtr->start.i+
+ (idx*arithSeriesRepPtr->step.i));
+ }
+ } else {
+ objResultPtr = listv[idx];
+ }
} else {
TclNewObj(objResultPtr);
}
@@ -4562,6 +4580,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;
@@ -4612,7 +4631,7 @@
* If some var in some var list still has a remaining list
* element iterate one more time. Assign to var the next
* element from its value list. We already checked above
- * that each list temp holds a valid list object.
+ * that each list temp holds a valid list or range object.
*/
if (continueLoop) {
@@ -4624,27 +4643,65 @@
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 {
+ /*
+ * It is a rangeType Tcl_Obj!
+ *
+ * If the variable can be accessed inline and
+ * its value is unshared we modify it in
+ * place; otherwise we create a new Tcl_Obj.
+ */
+
+ valuePtr = varPtr->value.objPtr;
+ if (!inlineVarAccess || !valuePtr || Tcl_IsShared(valuePtr)) {
+ TclNewObj(valuePtr);
+ }
+
+ if (arithSeriesRepPtr->flags & TCL_RANGE_IS_WIDE) {
+ Tcl_SetWideIntObj(valuePtr,
+ arithSeriesRepPtr->start.w +
+ (valIndex*arithSeriesRepPtr->step.w));
+ } else {
+ Tcl_SetIntObj(valuePtr,
+ arithSeriesRepPtr->start.i +
+ (valIndex*arithSeriesRepPtr->step.i));
+ }
+ }
+ }
+
+ 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 13:44:55 -0000
@@ -1537,6 +1537,31 @@
} 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.
+ */
+
+#define TCL_RANGE_IS_WIDE 1
+typedef struct ArithSeries {
+ union {
+ Tcl_WideInt w;
+ long i;
+ } start;
+ union {
+ Tcl_WideInt w;
+ long i;
+ } end;
+ union {
+ Tcl_WideInt w;
+ long i;
+ } step;
+ int len;
+ int flags;
+ int refCount;
+} ArithSeries;
+
+/*
*----------------------------------------------------------------
* Data structures related to the filesystem internals
*----------------------------------------------------------------
@@ -1642,6 +1667,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 +2088,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 13:44:57 -0000
@@ -632,6 +632,26 @@
{
register List *listRepPtr;
+ /*
+ * If objPtr is of arithSeriesType, do not shimmer it.
+ */
+
+ if (listPtr->typePtr == &tclArithSeriesType) {
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ listPtr->internalRep.twoPtrValue.ptr1;
+
+ if ((index < 0) || (index >= arithSeriesRepPtr->len)) {
+ *objPtrPtr = NULL;
+ } else if (arithSeriesRepPtr->flags & TCL_RANGE_IS_WIDE) {
+ *objPtrPtr = Tcl_NewWideIntObj(arithSeriesRepPtr->start.w+
+ (index*arithSeriesRepPtr->step.w));
+ } else {
+ *objPtrPtr = Tcl_NewIntObj(arithSeriesRepPtr->start.i+
+ (index*arithSeriesRepPtr->step.i));
+ }
+ return TCL_OK;
+ }
+
if (listPtr->typePtr != &tclListType) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
@@ -645,7 +665,6 @@
} else {
*objPtrPtr = listRepPtr->elements[index];
}
-
return TCL_OK;
}
@@ -679,6 +698,17 @@
{
register List *listRepPtr;
+ /*
+ * If objPtr is of arithSeriesType, do not shimmer it.
+ */
+
+ if (listPtr->typePtr == &tclArithSeriesType) {
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ listPtr->internalRep.twoPtrValue.ptr1;
+ *intPtr = arithSeriesRepPtr->len;
+ return TCL_OK;
+ }
+
if (listPtr->typePtr != &tclListType) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
@@ -1566,9 +1596,47 @@
List *listRepPtr;
/*
+ * Conversion 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) {
+ int len;
+ Tcl_WideInt j;
+ ArithSeries *arithSeriesRepPtr = (ArithSeries*)
+ objPtr->internalRep.twoPtrValue.ptr1;
+
+ len = arithSeriesRepPtr->len;
+ elemPtrs = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*)*len);
+ if (arithSeriesRepPtr->flags & TCL_RANGE_IS_WIDE) {
+ for (j = 0; j < len; j++) {
+ elemPtrs[j] = Tcl_NewWideIntObj(
+ arithSeriesRepPtr->start.w+(j*arithSeriesRepPtr->step.w));
+ Tcl_IncrRefCount(elemPtrs[j]);
+ }
+ } else {
+ for (j = 0; j < len; j++) {
+ elemPtrs[j] = Tcl_NewIntObj(
+ arithSeriesRepPtr->start.i+(j*arithSeriesRepPtr->step.i));
+ Tcl_IncrRefCount(elemPtrs[j]);
+ }
+ }
+ listRepPtr = (List *) ckalloc(sizeof(List));
+ listRepPtr->maxElemCount = len;
+ listRepPtr->elemCount = len;
+ 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.
*/
-
+
string = Tcl_GetStringFromObj(objPtr, &length);
/*
@@ -1733,3 +1801,403 @@
}
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));
+static Tcl_Obj * NewWideArithSeriesObj _ANSI_ARGS_((Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step));
+static Tcl_Obj * NewArithSeriesObj _ANSI_ARGS_((long start,long end,
+ long step));
+
+
+/*
+ * 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 */
+};
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(arithSeriesPtr)
+ Tcl_Obj *arithSeriesPtr;
+{
+ ArithSeries *arithSeriesRepPtr =
+ (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
+ if (--arithSeriesRepPtr->refCount <= 0) {
+ 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 *arithSeriesRepPtr =
+ (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
+
+ arithSeriesRepPtr->refCount++;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arithSeriesRepPtr;
+ 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(objPtr)
+ Tcl_Obj *objPtr;
+{
+ /*
+ * Rely on the listType functions for now: first shimmer to
+ * list type, then compute the string rep.
+ */
+
+ SetListFromAny(NULL, objPtr);
+ TclGetString(objPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_New(Wide)ArithSeriesObj --
+ *
+ * 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.
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewWideArithSeriesObj(start, end, step)
+ Tcl_WideInt start, end, step;
+{
+ int len;
+ Tcl_WideInt wideLen;
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeries *arithSeriesRepPtr;
+
+ /*
+ * Compute the length of the arithSeries.
+ */
+
+ if ((step == 0)
+ || (step > 0 && start > end)
+ || (step < 0 && end > start)) {
+ return NULL; /* Invalid range error */
+ } else {
+ wideLen = ((step > 0) ? 1 : -1) + (((end-start)-1)/step);
+ len = (int) wideLen;
+ if ((wideLen < 0) || ((Tcl_WideInt) len != wideLen)) {
+ return NULL; /* List too long. */
+ }
+ }
+
+ TclNewObj(arithSeriesPtr);
+
+ arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries));
+ arithSeriesRepPtr->start.w = start;
+ arithSeriesRepPtr->end.w = end;
+ arithSeriesRepPtr->step.w = step;
+ arithSeriesRepPtr->len = len;
+ arithSeriesRepPtr->flags = TCL_RANGE_IS_WIDE;
+ arithSeriesRepPtr->refCount = 1;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (len > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+static Tcl_Obj *
+NewArithSeriesObj(start, end, step)
+ long start, end, step;
+{
+ int len;
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeries *arithSeriesRepPtr;
+
+ /*
+ * Compute the length of the arithSeries.
+ */
+
+ if ((step == 0) || (step > 0 && start > end) || (step < 0 && end > start)) {
+ return NULL; /* Invalid range error */
+ } else {
+ len = ((step > 0) ? 1 : -1) + (((end-start)-1)/step);
+ if (len < 0) {
+ return NULL; /* list too long. */
+ }
+ }
+
+ TclNewObj(arithSeriesPtr);
+
+ arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries));
+ arithSeriesRepPtr->start.i = start;
+ arithSeriesRepPtr->end.i = end;
+ arithSeriesRepPtr->step.i = step;
+ arithSeriesRepPtr->len = len;
+ arithSeriesRepPtr->flags = 0;
+ arithSeriesRepPtr->refCount = 1;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (len > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ int isWide = 0,tmp, len;
+
+ /* 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 while determining if
+ * we need a wide range or not.
+ */
+
+ if (Tcl_GetIntFromObj(interp, objv[1], &tmp) == TCL_OK) {
+ end = tmp;
+ } else if (Tcl_GetWideIntFromObj(interp, objv[1], &end) == TCL_OK) {
+ isWide = 1;
+ } else {
+ return TCL_ERROR;
+ }
+
+ if (objc >= 3) {
+ start = end;
+ if (Tcl_GetIntFromObj(interp, objv[2], &tmp) == TCL_OK) {
+ end = tmp;
+ } else if (Tcl_GetWideIntFromObj(interp, objv[2], &end) == TCL_OK) {
+ isWide = 1;
+ } else {
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &tmp) == TCL_OK) {
+ step = tmp;
+ } else if (Tcl_GetWideIntFromObj(interp, objv[3], &step) == TCL_OK) {
+ isWide = 1;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /* Create the arithmetic series object, checking if the
+ * parameters are invalid. */
+
+ if (isWide) {
+ arithSeriesPtr = NewWideArithSeriesObj(start, end, step);
+ } else {
+ arithSeriesPtr = NewArithSeriesObj((long) start, (long) end, (long) 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 */
+ Tcl_ListObjLength(interp, arithSeriesPtr, &len);
+ if (len > 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;
+}
+
