Attachment "tclCmdIL.c#1.114-patch" to
ticket [1366484fff]
added by
afredd
2007-04-26 23:07:36.
--- tclCmdIL.c-orig 2007-04-25 10:03:55.342816900 +0100
+++ tclCmdIL.c 2007-04-26 09:10:54.115302100 +0100
@@ -23,25 +23,72 @@
#include "tclRegexp.h"
/*
- * During execution of the "lsort" command, structures of the following type
- * are used to arrange the objects being sorted into a collection of linked
- * lists.
+ * A union containing the possible types stored in a SortElement's cache.
+ * NB. we do not store a double in the cache as this increases
+ * sizeof(SortElement) by 4 bytes and sizeof(SortElementUnique) by 8 bytes
+ * on LP32 machines, and the resultant increase in memory usage will slow
+ * down non [lsort -real]'s (the common usage), with only a small benefit
+ * to [lsort -real]'s.
+ */
+
+typedef union SortElementCache {
+ long integer; /* Used if lsort is -integer */
+ char *string; /* Used if lsort is -ascii, -nocase,
+ * or -dictionary */
+ Tcl_Obj *tclObj; /* Used if lsort is -command, or -real
+ */
+
+} SortElementCache;
+
+/*
+ * During execution of the "lsort" command, structures of the following
+ * type are used to arrange the objects being sorted into a collection
+ * of linked lists. Note that the merge sort algorithm used does not
+ * make use of the size of the structure (a fact we make use of!) but
+ * simply follows each SortElements nextPtr to traverse the list.
*/
typedef struct SortElement {
- Tcl_Obj *objPtr; /* Object being sorted. */
- int count; /* Number of same elements in list. */
- struct SortElement *nextPtr;/* Next element in the list, or NULL for end
- * of list. */
+ struct SortElement *nextPtr; /* Next element in the list, or
+ * NULL for end of list. */
+ Tcl_Obj *objPtr; /* Object being sorted. */
+ SortElementCache cache; /* A cache storing the item
+ * that will be compared */
} SortElement;
/*
- * These function pointer types are used with the "lsearch" and "lsort"
- * commands to facilitate the "-nocase" option.
+ * In the case of an "lsort -unique", we need to store the fact that
+ * an individual element is or is not unique. We use this larger
+ * form of a SortElement structure to do this. The member named 'unique'
+ * is not included in the general SortElement structure because the larger
+ * the SortElement structure, the more likely we are to generate cache
+ * misses during the merge sort process and thus run slower.
+ * Note the leading members of this struct must match those of a
+ * SortElement to take advantage of C struct equivalence so that
+ * we can safely cast a (SortElementUnique*) to a (SortElement*).
+ */
+
+typedef struct SortElementUnique {
+ struct SortElement *nextPtr; /* Next element in the list, or
+ * NULL for end of list. */
+ Tcl_Obj *objPtr; /* Object being sorted. */
+ SortElementCache cache; /* A cache storing the item
+ * that will be compared */
+ int unique; /* Nonzero if this element does
+ * not compare the same as another.
+ */
+} SortElementUnique;
+
+/*
+ * These function pointer types are used by the "lsearch" and "lsort"
+ * commands to compare list elements.
*/
+struct SortInfo; /* forward declaration */
+
+typedef int (*SortCompareFn_t) (SortElement *, SortElement *,
+ struct SortInfo *);
typedef int (*SortStrCmpFn_t) (const char *, const char *);
-typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
/*
* The "lsort" command needs to pass certain information down to the function
@@ -52,13 +99,19 @@
typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
- int sortMode; /* The sort mode. One of SORTMODE_* values
- * defined below. */
- SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
- * ASCII mode). */
+ int isUnique; /* Nonzero means sort is -unique. */
+ int nonUniqueCount; /* The number of elements that compare the
+ * same during a "lsort -unique". */
+ int compareCmdObjc; /* The number of arguments used by the
+ * lsort -command procedure call. */
+ SortCompareFn_t sortCompareFn;
+ /* The function used to compare elements
+ * within the list during a sort. */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
* SORTMODE_COMMAND. Pre-initialized to hold
* base of command. */
+ Tcl_Interp *interp; /* The interpreter in which the sort is being
+ * done. */
int *indexv; /* If the -index option was specified, this
* holds the indexes contained in the list
* supplied as an argument to that option.
@@ -66,12 +119,12 @@
* singleIndex field when only one
* supplied. */
int indexc; /* Number of indexes in indexv array. */
- int singleIndex; /* Static space for common index case. */
- Tcl_Interp *interp; /* The interpreter in which the sort is being
- * done. */
int resultCode; /* Completion code for the lsort command. If
* an error occurs during the sort this is
* changed from TCL_OK to TCL_ERROR. */
+ int singleIndex; /* Static space for common index case. */
+ int sortMode; /* The sort mode. One of SORTMODE_* values
+ * defined below */
} SortInfo;
/*
@@ -149,10 +202,21 @@
static SortElement * MergeSort(SortElement *headPt, SortInfo *infoPtr);
static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
SortInfo *infoPtr);
-static int SortCompare(Tcl_Obj *firstPtr, Tcl_Obj *second,
- SortInfo *infoPtr);
static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
SortInfo *infoPtr);
+static int SortCompareInteger(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+static int SortCompareReal(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+static int SortCompareCommand(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+static int SortCompareAscii(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+static int SortCompareNoCase(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+static int SortCompareDictionary(SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2, SortInfo *infoPtr);
+
/*
*----------------------------------------------------------------------
@@ -2988,7 +3052,7 @@
}
if (first < 0) {
- first = 0;
+ first = 0;
}
/*
@@ -3004,7 +3068,7 @@
return TCL_ERROR;
}
if (last >= listLen) {
- last = (listLen - 1);
+ last = (listLen - 1);
}
if (first <= last) {
numToDelete = (last - first + 1);
@@ -3145,7 +3209,7 @@
{
char *bytes, *patternBytes;
int i, match, mode, index, result, listc, length, elemLen;
- int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+ int dataType, lower, upper, patInt, objInt, offset;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
@@ -3175,7 +3239,6 @@
mode = GLOB;
dataType = ASCII;
- isIncreasing = 1;
allMatches = 0;
inlineReturn = 0;
returnSubindices = 0;
@@ -3185,8 +3248,8 @@
offset = 0;
noCase = 0;
sortInfo.compareCmdPtr = NULL;
- sortInfo.isIncreasing = 0;
- sortInfo.sortMode = 0;
+ sortInfo.isIncreasing = 1;
+ sortInfo.sortMode = SORTMODE_ASCII;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
sortInfo.indexv = NULL;
@@ -3216,7 +3279,7 @@
dataType = ASCII;
break;
case LSEARCH_DECREASING: /* -decreasing */
- isIncreasing = 0;
+ sortInfo.isIncreasing = 0;
break;
case LSEARCH_DICTIONARY: /* -dictionary */
dataType = DICTIONARY;
@@ -3228,7 +3291,7 @@
mode = GLOB;
break;
case LSEARCH_INCREASING: /* -increasing */
- isIncreasing = 1;
+ sortInfo.isIncreasing = 1;
break;
case LSEARCH_INLINE: /* -inline */
inlineReturn = 1;
@@ -3566,13 +3629,13 @@
index = i;
upper = i;
} else if (match > 0) {
- if (isIncreasing) {
+ if (sortInfo.isIncreasing) {
lower = i;
} else {
upper = i;
}
} else {
- if (isIncreasing) {
+ if (sortInfo.isIncreasing) {
upper = i;
} else {
lower = i;
@@ -3867,9 +3930,11 @@
int objc, /* Number of arguments. */
Tcl_Obj *CONST objv[]) /* Argument values. */
{
- int i, index, unique, indices, length;
+ int i, index, noCase, indices, length;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj;
- SortElement *elementArray, *elementPtr;
+ char *elementArrayBuf, *elementArrayBufPtr;
+ register SortElement *elementPtr;
+ size_t sizeof_SortElement;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
static CONST char *switches[] = {
@@ -3892,15 +3957,18 @@
*/
sortInfo.isIncreasing = 1;
+ sortInfo.isUnique = 0;
sortInfo.sortMode = SORTMODE_ASCII;
- sortInfo.strCmpFn = strcmp;
+ sortInfo.compareCmdObjc = 0;
+ sortInfo.compareCmdPtr = NULL;
sortInfo.indexv = NULL;
sortInfo.indexc = 0;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
+ sortInfo.nonUniqueCount = 0;
cmdPtr = NULL;
- unique = 0;
indices = 0;
+ noCase = 0;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
@@ -3935,7 +4003,7 @@
break;
case LSORT_INDEX: {
int j;
- Tcl_Obj **indices;
+ Tcl_Obj **indicesList;
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
@@ -3951,7 +4019,7 @@
*/
if (Tcl_ListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
- &indices) != TCL_OK) {
+ &indicesList) != TCL_OK) {
return TCL_ERROR;
}
switch (sortInfo.indexc) {
@@ -3964,6 +4032,7 @@
default:
sortInfo.indexv = (int *)
ckalloc(sizeof(int) * sortInfo.indexc);
+ break;
}
/*
@@ -3972,8 +4041,8 @@
* syntactic check here.
*/
- for (j=0 ; j<sortInfo.indexc ; j++) {
- if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
+ for (j = 0; j < sortInfo.indexc; ++j) {
+ if (TclGetIntForIndex(interp, indicesList[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
@@ -3990,111 +4059,240 @@
sortInfo.sortMode = SORTMODE_INTEGER;
break;
case LSORT_NOCASE:
- sortInfo.strCmpFn = strcasecmp;
+ noCase = 1;
break;
case LSORT_REAL:
sortInfo.sortMode = SORTMODE_REAL;
break;
case LSORT_UNIQUE:
- unique = 1;
+ sortInfo.isUnique = 1;
break;
case LSORT_INDICES:
indices = 1;
break;
}
}
+
listObj = objv[objc-1];
- if (sortInfo.sortMode == SORTMODE_COMMAND) {
- Tcl_Obj *newCommandPtr, *newObjPtr;
+ switch (sortInfo.sortMode) {
+ case SORTMODE_ASCII:
+ if (noCase) {
+ sortInfo.sortCompareFn = SortCompareNoCase;
+ } else {
+ sortInfo.sortCompareFn = SortCompareAscii;
+ }
+ break;
+ case SORTMODE_DICTIONARY:
+ sortInfo.sortCompareFn = SortCompareDictionary;
+ break;
+ case SORTMODE_INTEGER:
+ sortInfo.sortCompareFn = SortCompareInteger;
+ break;
+ case SORTMODE_REAL:
+ sortInfo.sortCompareFn = SortCompareReal;
+ break;
+ case SORTMODE_COMMAND: {
+ Tcl_Obj *newCommandPtr, *newObjPtr;
- /*
- * When sorting using a command, we are reentrant and therefore might
- * have the representation of the list being sorted shimmered out from
- * underneath our feet. Take a copy (cheap) to prevent this. [Bug
- * 1675116]
- */
+ /*
+ * When sorting using a command, we are reentrant and therefore
+ * might have the representation of the list being sorted
+ * shimmered out from underneath our feet. Take a copy (cheap) to
+ * prevent this. [Bug 1675116]
+ */
- listObj = TclListObjCopy(interp,listObj);
- if (listObj == NULL) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ listObj = TclListObjCopy(interp, listObj);
+ if (listObj == NULL) {
+ if (sortInfo.indexc > 1) {
+ ckfree((char *) sortInfo.indexv);
+ }
+ return TCL_ERROR;
}
- return TCL_ERROR;
- }
- /*
- * The existing command is a list. We want to flatten it, append two
- * dummy arguments on the end, and replace these arguments later.
- */
+ /*
+ * The existing command is a list. We want to flatten it, append
+ * two dummy arguments on the end, and replace these arguments
+ * later.
+ */
- newCommandPtr = Tcl_DuplicateObj(cmdPtr);
- TclNewObj(newObjPtr);
- Tcl_IncrRefCount(newCommandPtr);
- if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
- != TCL_OK) {
- Tcl_DecrRefCount(newCommandPtr);
- Tcl_IncrRefCount(newObjPtr);
- Tcl_DecrRefCount(newObjPtr);
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+ newObjPtr = Tcl_NewObj();
+
+ Tcl_IncrRefCount(newCommandPtr);
+ if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
+ != TCL_OK) {
+ Tcl_DecrRefCount(newCommandPtr);
+ Tcl_IncrRefCount(newObjPtr);
+ Tcl_DecrRefCount(newObjPtr);
+ if (sortInfo.indexc > 1) {
+ ckfree((char *) sortInfo.indexv);
+ }
+ return TCL_ERROR;
}
- return TCL_ERROR;
+ Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
+ Tcl_ListObjLength(interp, newCommandPtr, &sortInfo.compareCmdObjc);
+ sortInfo.compareCmdPtr = newCommandPtr;
+ sortInfo.sortCompareFn = SortCompareCommand;
+ break;
}
- Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
- sortInfo.compareCmdPtr = newCommandPtr;
}
-
+
sortInfo.resultCode = Tcl_ListObjGetElements(interp, listObj,
&length, &listObjPtrs);
if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
}
- elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
- for (i=0; i < length; i++){
- elementArray[i].objPtr = listObjPtrs[i];
- elementArray[i].count = 0;
- elementArray[i].nextPtr = &elementArray[i+1];
- }
- elementArray[length-1].nextPtr = NULL;
- elementPtr = MergeSort(elementArray, &sortInfo);
- if (sortInfo.resultCode == TCL_OK) {
- resultPtr = Tcl_NewObj();
- if (unique) {
- if (indices) {
- for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
- if (elementPtr->count == 0) {
- Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewIntObj(elementPtr - &elementArray[0]));
- }
- }
- } else {
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) {
- if (elementPtr->count == 0) {
- Tcl_ListObjAppendElement(NULL, resultPtr,
- elementPtr->objPtr);
- }
+
+ /*
+ * The documentation for lsort notes that [lsort -integer str] should
+ * _not_ give an "expected integer" error. See [Bug #219202].
+ */
+
+ if (length == 1) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(1, listObjPtrs));
+ goto done;
+ }
+
+ /*
+ * If the sort is -unique then the sort is performed on a set of
+ * SortElementUnique structures; otherwise we use the smaller SortElement.
+ * Note the common case of sorting without -unique specified has improved
+ * performance due to using a smaller elementArrayBuf: there is less
+ * memory to allocate and there will be fewer cache misses while
+ * traversing it. Note that the MergeSort algorithm does not make use of
+ * the size of a SortElement - it simply uses the nextPtr member to
+ * 'reorder' the sequence of the elements. That is, we can pass a
+ * SortElement pointer about and if sortInfo.isUnique is true then we
+ * know it is really a SortElementUnique and can access its 'unique'
+ * member. We only need to do some simple pointer forging using
+ * sizeof_SortElement to correctly populate the elementArray with the
+ * appropriate form of the sorting element.
+ */
+
+ if (sortInfo.isUnique) {
+ sizeof_SortElement = sizeof(SortElementUnique);
+ } else {
+ sizeof_SortElement = sizeof(SortElement);
+ }
+
+ /*
+ * Allocate space for the elements to be sorted and initialise them.
+ * The string/integer/Tcl_Obj that is used in the sort comparison
+ * is cached to avoid having to do it repeatedly during the main loop.
+ */
+
+ elementArrayBuf = (char *) ckalloc(length * sizeof_SortElement);
+
+ for (i = 0, elementArrayBufPtr = elementArrayBuf; i < length;
+ ++i, elementArrayBufPtr += sizeof_SortElement) {
+ Tcl_Obj *objPtr = listObjPtrs[i];
+ elementPtr = (SortElement *) elementArrayBufPtr;
+ elementPtr->nextPtr = (SortElement *)
+ (elementArrayBufPtr + sizeof_SortElement);
+ elementPtr->objPtr = objPtr;
+
+ if (sortInfo.isUnique) {
+ ((SortElementUnique *) elementPtr)->unique = 1;
+ }
+
+ if (sortInfo.indexc != 0) {
+ objPtr = SelectObjFromSublist(objPtr, &sortInfo);
+ if (sortInfo.resultCode != TCL_OK) {
+ goto cleanup;
+ }
+ }
+
+ switch (sortInfo.sortMode) {
+ case SORTMODE_ASCII:
+ case SORTMODE_DICTIONARY:
+ elementPtr->cache.string = TclGetString(objPtr);
+ break;
+ case SORTMODE_INTEGER: {
+ long l;
+ if (Tcl_GetLongFromObj(interp, objPtr, &l) != TCL_OK) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto cleanup;
}
+ elementPtr->cache.integer = l;
+ break;
}
- } else if (indices) {
- for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewIntObj(elementPtr - &elementArray[0]));
+ case SORTMODE_REAL:
+ case SORTMODE_COMMAND:
+ elementPtr->cache.tclObj = objPtr;
+ break;
+ }
+ }
+
+ /*
+ * Set the final SortElement's nextPtr to be NULL.
+ */
+
+ elementPtr->nextPtr = NULL;
+
+ /*
+ * Perform the sort.
+ */
+
+ elementPtr = MergeSort((SortElement *) elementArrayBuf, &sortInfo);
+
+ if (sortInfo.resultCode != TCL_OK) {
+ goto cleanup;
+ }
+
+ /*
+ * The sort was successful, now create the result object.
+ */
+
+ resultPtr = Tcl_NewListObj((length - sortInfo.nonUniqueCount), NULL);
+
+/*
+ * ELEM_INDEX - a helper macro that retrieves the index within the original
+ * to-be-sorted list of a given pointer into the SortElement list.
+ * It's prototype is:
+ *
+ * MODULE_SCOPE int ELEM_INDEX(sortElement *elementPtr);
+ */
+
+#define ELEM_INDEX(elementPtr) \
+ (int) ((((char *) elementPtr) - elementArrayBuf) / sizeof_SortElement)
+
+ if (sortInfo.isUnique) {
+ if (indices) {
+ for (; elementPtr; elementPtr = elementPtr->nextPtr) {
+ if (((SortElementUnique *) elementPtr)->unique) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(ELEM_INDEX(elementPtr)));
+ }
}
} else {
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) {
- Tcl_ListObjAppendElement(NULL, resultPtr, elementPtr->objPtr);
+ for (; elementPtr; elementPtr = elementPtr->nextPtr) {
+ if (((SortElementUnique *) elementPtr)->unique) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ elementPtr->objPtr);
+ }
}
}
- Tcl_SetObjResult(interp, resultPtr);
+ } else if (indices) {
+ for (; elementPtr; elementPtr = elementPtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(ELEM_INDEX(elementPtr)));
+ }
+ } else {
+ for (; elementPtr; elementPtr = elementPtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultPtr, elementPtr->objPtr);
+ }
}
- ckfree((char *) elementArray);
+
+ Tcl_SetObjResult(interp, resultPtr);
+
+ cleanup:
+ ckfree(elementArrayBuf);
done:
if (sortInfo.sortMode == SORTMODE_COMMAND) {
Tcl_DecrRefCount(sortInfo.compareCmdPtr);
Tcl_DecrRefCount(listObj);
- sortInfo.compareCmdPtr = NULL;
}
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
@@ -4135,14 +4333,14 @@
SortElement *elementPtr;
int i;
- for (i=0 ; i<NUM_LISTS ; i++) {
+ for (i = 0; i < NUM_LISTS; ++i) {
subList[i] = NULL;
}
while (headPtr != NULL) {
elementPtr = headPtr;
headPtr = headPtr->nextPtr;
- elementPtr->nextPtr = 0;
- for (i=0 ; i<NUM_LISTS && subList[i]!=NULL ; i++) {
+ elementPtr->nextPtr = NULL;
+ for (i = 0; i < NUM_LISTS && subList[i] != NULL; ++i) {
elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
subList[i] = NULL;
}
@@ -4152,7 +4350,7 @@
subList[i] = elementPtr;
}
elementPtr = NULL;
- for (i=0 ; i<NUM_LISTS ; i++) {
+ for (i = 0; i < NUM_LISTS; ++i) {
elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
}
return elementPtr;
@@ -4183,7 +4381,8 @@
* operator. */
{
SortElement *headPtr, *tailPtr;
- int cmp;
+ SortCompareFn_t sortCompare;
+ int cmp, isIncreasing, isUnique;
if (leftPtr == NULL) {
return rightPtr;
@@ -4191,27 +4390,43 @@
if (rightPtr == NULL) {
return leftPtr;
}
- cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ isIncreasing = infoPtr->isIncreasing;
+ isUnique = infoPtr->isUnique;
+ sortCompare = infoPtr->sortCompareFn;
+
+ cmp = sortCompare(leftPtr, rightPtr, infoPtr);
+ if (!isIncreasing) {
+ cmp = -cmp;
+ }
if (cmp > 0) {
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
- if (cmp == 0) {
- leftPtr->count++;
+ if (isUnique && cmp == 0) {
+ if (((SortElementUnique *) leftPtr)->unique) {
+ ((SortElementUnique *) leftPtr)->unique = 0;
+ ++infoPtr->nonUniqueCount;
+ }
}
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
}
headPtr = tailPtr;
while ((leftPtr != NULL) && (rightPtr != NULL)) {
- cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ cmp = sortCompare(leftPtr, rightPtr, infoPtr);
+ if (!isIncreasing) {
+ cmp = -cmp;
+ }
if (cmp > 0) {
tailPtr->nextPtr = rightPtr;
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
- if (cmp == 0) {
- leftPtr->count++;
+ if (isUnique && cmp == 0) {
+ if (((SortElementUnique *) leftPtr)->unique) {
+ ((SortElementUnique *) leftPtr)->unique = 0;
+ ++infoPtr->nonUniqueCount;
+ }
}
tailPtr->nextPtr = leftPtr;
tailPtr = leftPtr;
@@ -4229,129 +4444,181 @@
/*
*----------------------------------------------------------------------
*
- * SortCompare --
+ * The sort comparison functions --
*
- * This procedure is invoked by MergeLists to determine the proper
- * ordering between two elements.
+ * These functions are invoked by MergeLists to determine the proper
+ * ordering between two elements. The one used during the sort is
+ * dependent on the options passed to "lsort". Specifically:
+ *
+ * -ascii SortCompareAscii
+ * -integer SortCompareInteger
+ * -real SortCompareReal
+ * -nocase SortCompareNoCase
+ * -command SortCompareCommand
+ * -dictionary SortCompareDictionary
*
* Results:
* A negative results means the the first element comes before the
* second, and a positive results means that the second element should
- * come first. A result of zero means the two elements are equal and it
- * doesn't matter which comes first.
+ * come first. A result of zero either means the two elements are equal
+ * and it doesn't matter which comes first, or that an error has
+ * occurred and infoPtr->resultCode is set to TCL_ERROR.
*
* Side effects:
- * None, unless a user-defined comparison command does something weird.
+ * None, except for SortCompareCommand in which a user-defined
+ * comparison command might do something weird.
*
*----------------------------------------------------------------------
*/
static int
-SortCompare(
- Tcl_Obj *objPtr1, Tcl_Obj *objPtr2,
- /* Values to be compared. */
- SortInfo *infoPtr) /* Information passed from the top-level
- * "lsort" command. */
+SortCompareAscii(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
+{
+ char *a, *b;
+
+ a = sortElemPtr1->cache.string;
+ b = sortElemPtr2->cache.string;
+ return strcmp(a, b);
+}
+
+static int
+SortCompareInteger(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
+{
+ long a, b;
+
+ a = sortElemPtr1->cache.integer;
+ b = sortElemPtr2->cache.integer;
+ if (a > b) {
+ return 1;
+ } else if (b > a) {
+ return -1;
+ }
+ return 0;
+}
+
+static int
+SortCompareReal(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
{
- int order;
+ Tcl_Obj *aPtr, *bPtr;
+ double a, b;
- order = 0;
if (infoPtr->resultCode != TCL_OK) {
/*
- * Once an error has occurred, skip any future comparisons so as to
- * preserve the error message in sortInterp->result.
+ * Once an error has occurred, skip any future comparisons so
+ * as to preserve the error message in sortInterp->result.
*/
-
- return order;
+ return 0;
}
+ aPtr = sortElemPtr1->cache.tclObj;
+ bPtr = sortElemPtr2->cache.tclObj;
- objPtr1 = SelectObjFromSublist(objPtr1, infoPtr);
- if (infoPtr->resultCode != TCL_OK) {
- return order;
+ if ((Tcl_GetDoubleFromObj(infoPtr->interp, aPtr, &a) != TCL_OK) ||
+ (Tcl_GetDoubleFromObj(infoPtr->interp, bPtr, &b) != TCL_OK)) {
+ infoPtr->resultCode = TCL_ERROR;
+ return 0;
}
- objPtr2 = SelectObjFromSublist(objPtr2, infoPtr);
- if (infoPtr->resultCode != TCL_OK) {
- return order;
+ if (a > b) {
+ return 1;
+ } else if (b > a) {
+ return -1;
}
+ return 0;
+}
+
+static int
+SortCompareNoCase(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
+{
+ char *a, *b;
+
+ a = sortElemPtr1->cache.string;
+ b = sortElemPtr2->cache.string;
+#if 1
+ return strcasecmp(a, b);
+#else
+ /* [Patch #1236896] */
+ return TclUtfCasecmp(a, b);
+#endif
+}
+
+static int
+SortCompareCommand(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
+{
+ int order, objc;
+ Tcl_Obj **objv, *paramObjv[2];
- if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = infoPtr->strCmpFn(TclGetString(objPtr1),
- TclGetString(objPtr2));
- } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
- order = DictionaryCompare(
- TclGetString(objPtr1), TclGetString(objPtr2));
- } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
- long a, b;
-
- if ((Tcl_GetLongFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
- || (Tcl_GetLongFromObj(infoPtr->interp, objPtr2, &b)
- != TCL_OK)) {
- infoPtr->resultCode = TCL_ERROR;
- return order;
- }
- if (a > b) {
- order = 1;
- } else if (b > a) {
- order = -1;
- }
- } else if (infoPtr->sortMode == SORTMODE_REAL) {
- double a, b;
-
- if (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK ||
- Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b) != TCL_OK){
- infoPtr->resultCode = TCL_ERROR;
- return order;
- }
- if (a > b) {
- order = 1;
- } else if (b > a) {
- order = -1;
- }
- } else {
- Tcl_Obj **objv, *paramObjv[2];
- int objc;
-
- paramObjv[0] = objPtr1;
- paramObjv[1] = objPtr2;
-
+ if (infoPtr->resultCode != TCL_OK) {
/*
- * We made space in the command list for the two things to compare.
- * Replace them and evaluate the result.
+ * Once an error has occurred, skip any future comparisons so
+ * as to preserve the error message in sortInterp->result.
*/
+ return 0;
+ }
- Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
- Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
- 2, 2, paramObjv);
- Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
- &objc, &objv);
+ paramObjv[0] = sortElemPtr1->cache.tclObj;
+ paramObjv[1] = sortElemPtr2->cache.tclObj;
- infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
+ /*
+ * We made space in the command list for the two things to compare.
+ * Replace them and evaluate the result.
+ */
- if (infoPtr->resultCode != TCL_OK) {
- Tcl_AddErrorInfo(infoPtr->interp,
- "\n (-compare command)");
- return order;
- }
+ objc = infoPtr->compareCmdObjc;
+ Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
+ 2, 2, paramObjv);
+ Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+ &objc, &objv);
- /*
- * Parse the result of the command.
- */
+ infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
- if (Tcl_GetIntFromObj(infoPtr->interp,
- Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
- Tcl_ResetResult(infoPtr->interp);
- Tcl_AppendResult(infoPtr->interp,
- "-compare command returned non-integer result", NULL);
- infoPtr->resultCode = TCL_ERROR;
- return order;
- }
+ if (infoPtr->resultCode != TCL_OK) {
+ Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)");
+ return 0;
}
- if (!infoPtr->isIncreasing) {
- order = -order;
+
+ /*
+ * Parse the result of the command.
+ */
+
+ order = 0;
+ if (Tcl_GetIntFromObj(infoPtr->interp,
+ Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
+ Tcl_ResetResult(infoPtr->interp);
+ Tcl_AppendResult(infoPtr->interp,
+ "-compare command returned non-integer result", NULL);
+ infoPtr->resultCode = TCL_ERROR;
+ return 0;
}
return order;
}
+static int
+SortCompareDictionary(
+ SortElement *sortElemPtr1,
+ SortElement *sortElemPtr2,
+ SortInfo *infoPtr)
+{
+ char *a, *b;
+
+ a = sortElemPtr1->cache.string;
+ b = sortElemPtr2->cache.string;
+ return DictionaryCompare(a, b);
+}
+
/*
*----------------------------------------------------------------------
*
