Tcl_Obj'ified the 'end-offset' syntax.

2 files changed, 142 insertions, 15 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 288bd55..a446aa6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.55.2.1 2001/05/31 23:45:44 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.55.2.2 2001/06/05 15:54:29 kennykb Exp $
  */
 
 #ifndef _TCLINT
@@ -1595,6 +1595,7 @@ extern Tcl_ObjType	tclStringType;
 extern Tcl_ObjType	tclArraySearchType;
 extern Tcl_ObjType	tclIndexType;
 extern Tcl_ObjType	tclNsNameType;
+extern Tcl_ObjType      tclEndOffsetType;
 
 /*
  * Variables denoting the hash key types defined in the core.
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 232835f..1ead88f 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- *  RCS: @(#) $Id: tclUtil.c,v 1.18.6.1 2001/06/05 01:10:47 kennykb Exp $
+ *  RCS: @(#) $Id: tclUtil.c,v 1.18.6.2 2001/06/05 15:54:29 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -62,6 +62,30 @@ static char precisionFormat[10] = "%.12g";
 				 * to sprintf. */
 TCL_DECLARE_MUTEX(precisionMutex)
 
+/*
+ * Prototypes for procedures defined later in this file.
+ */
+
+static int SetEndOffsetFromAny _ANSI_ARGS_(( Tcl_Interp* interp,
+					     Tcl_Obj* objPtr ));
+
+/*
+ * The following is the Tcl object type definition for an object
+ * that represents a list index in the form, "end-offset".  It is
+ * used as a performance optimization in TclGetIntForIndex.  The
+ * internal rep is an integer, so no memory management is required
+ * for it.  Ths string rep is never discarded, so UpdateStringProc
+ * is also unnecessary.
+ */
+
+Tcl_ObjType tclEndOffsetType = {
+    "end-offset",			/* name */
+    (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */
+    (Tcl_DupInternalRepProc*) NULL,     /* dupIntRepProc */
+    (Tcl_UpdateStringProc*) NULL,       /* updateStringProc */
+    SetEndOffsetFromAny    
+};
+
 
 /*
  *----------------------------------------------------------------------
@@ -2153,44 +2177,146 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
     char *bytes;
     int length, offset;
 
+    /* If the object is already an integer, use it. */
+
     if (objPtr->typePtr == &tclIntType) {
 	*indexPtr = (int)objPtr->internalRep.longValue;
 	return TCL_OK;
     }
 
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    if ( SetEndOffsetFromAny( NULL, objPtr ) == TCL_OK ) {
+
+	/*
+	 * If the object is already an offset from the end of the list, or
+	 * can be converted to one, use it.
+	 */
+
+	*indexPtr = endValue + objPtr->internalRep.longValue;
+
+    } else if ( Tcl_GetIntFromObj( NULL, objPtr, &offset ) == TCL_OK ) {
+
+	/*
+	 * If the object can be converted to an integer, use that.
+	 */
+
+	*indexPtr = offset;
+
+    } else {
+
+	/*
+	 * Report a parse error.
+	 */
 
+	if ((Interp *)interp != NULL) {
+	    bytes = Tcl_GetStringFromObj( objPtr, &length );
+	    Tcl_AppendStringsToObj( Tcl_GetObjResult(interp),
+				    "bad index \"", bytes,
+				    "\": must be integer or end?-integer?",
+				    (char *) NULL);
+	    if ( !strncmp ( bytes, "end-", 3 ) ) {
+		bytes += 3;
+	    }
+	    TclCheckBadOctal(interp, bytes);
+	}
+
+	return TCL_ERROR;
+    }
+	    
+    return TCL_OK;
+
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetEndOffsetFromAny --
+ *
+ *	Look for a string of the form "end-offset" and convert it
+ *	to an internal representation holding the offset.
+ *
+ * Results:
+ *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
+ *
+ * Side effects:
+ *	If interp is not NULL, stores an error message in the
+ *	interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetEndOffsetFromAny( Tcl_Interp* interp,
+				/* Tcl interpreter or NULL */
+		     Tcl_Obj* objPtr )
+				/* Pointer to the object to parse */
+{
+    int offset;			/* Offset in the "end-offset" expression */
+    Tcl_ObjType* oldTypePtr = objPtr->typePtr;
+				/* Old internal rep type of the object */
+    register char* bytes;	/* String rep of the object */
+    int length;			/* Length of the object's string rep */
+
+    /* If it's already the right type, we're fine. */
+
+    if ( objPtr->typePtr == &tclEndOffsetType ) {
+	return TCL_OK;
+    }
+
+    /* Check for a string rep of the right form. */
+
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
     if ((*bytes != 'e') || (strncmp(bytes, "end",
 	    (size_t)((length > 3) ? 3 : length)) != 0)) {
-	if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {
-	    goto intforindex_error;
+	if ( interp != NULL ) {
+	    Tcl_AppendStringsToObj( Tcl_GetObjResult( interp ),
+				    "bad index \"", bytes,
+				    "\": must be end?-integer?",
+				    (char*) NULL );
 	}
-	*indexPtr = offset;
-	return TCL_OK;
+	return TCL_ERROR;
     }
 
+    /* Convert the string rep */
+
     if (length <= 3) {
-	*indexPtr = endValue;
+	offset = 0;
     } else if (bytes[3] == '-') {
+
 	/*
 	 * This is our limited string expression evaluator
 	 */
 	if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	*indexPtr = endValue + offset;
+
     } else {
-	intforindex_error:
-	if ((Interp *)interp != NULL) {
+
+	/* Conversion failed.  Report the error. */
+
+
+	if ( interp != NULL ) {
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "bad index \"", bytes,
-		    "\": must be integer or end?-integer?", (char *) NULL);
-	    TclCheckBadOctal(interp, bytes);
+				   "bad index \"", bytes,
+				   "\": must be integer or end?-integer?",
+				   (char *) NULL);
 	}
 	return TCL_ERROR;
+
     }
+
+    /*
+     * The conversion succeeded. Free the old internal rep and set
+     * the new one.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = offset;
+    objPtr->typePtr = &tclEndOffsetType;
+
     return TCL_OK;
-}
+}    
 
 /*
  *----------------------------------------------------------------------