Tcl Source Code

			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
		    }
		}
	    } else {
		/*

		 * In order to handle the special Tcl \xC0\x80 null encoding
		 * for utf-8, strcmp can't do a simple memcmp.
		 */

		if (TclCheckEmptyString(valuePtr) > 0) {
		    s1 = "";
		    s1len = 0;
		    switch (TclCheckEmptyString(value2Ptr)) {
			case -1:
			    s2 = TclGetStringFromObj(value2Ptr, &s2len);
			    break;
			case 0:
			    /* Synthesize a value for comparison */
			    s2 = "1";
			    s2len = 1;
			    break;
			case 1:
			    s2 = "";
			    s2len = 0;
		    }
		} else if (TclCheckEmptyString(value2Ptr) > 0) {
		    s2 = "";
		    s2len = 0;
		    switch (TclCheckEmptyString(valuePtr)) {
			case -1:
			    s1 = TclGetStringFromObj(valuePtr, &s1len);
			    break;
			case 0:
			    /* Synthesize a value for comparison */
			    s1 = "1";
			    s1len = 1;
			    break;
			case 1:
			    s1 = "";
			    s1len = 0;
		    }
		} else {
		    s1 = TclGetStringFromObj(valuePtr, &s1len);
		    s2 = TclGetStringFromObj(value2Ptr, &s2len);
		}

		if (checkEq) {
		    memCmpFn = memcmp;
		} else {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		}

	    }

	    if (checkEq && (s1len != s2len)) {
		match = 1;
	    }  else {
		/*
		 * The comparison function should compare up to the minimum
		 * byte length only.
		 */
		match = memCmpFn(s1, s2,
			(size_t) ((s1len < s2len) ? s1len : s2len));
		if (match == 0) {

    case INST_GT:
    case INST_LE:
    case INST_GE: {
	int iResult = 0, compare = 0;

	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/*
	    Try to determine, without triggering generation of a string
	    representation, whether one value is not a number.
	*/
	if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
	    goto stringCompare;
	}

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
		|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
	    /*
	     * At least one non-numeric argument - compare as strings.
	     */

 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

MODULE_SCOPE char	tclEmptyString;

enum CheckEmptyStringResult {
	TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
};

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world,
 * introduced by/for NRE.
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,

 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);

#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))

#define TclIsPureList(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:
 *

    if (TclIsPureByteArray(objPtr)) {
	int length;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	return length;
    }


    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}



/*
 *----------------------------------------------------------------------
 *
 * TclCheckEmptyString --
 *
 *	Determine whether the string value of an object is or would be the
 *	empty string, without generating a string representation.
 *
 * Results:
 *	Returns 1 if empty, 0 if not, and -1 if unknown.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString (
    Tcl_Obj *objPtr
) {
    int length = -1;

    if (objPtr->bytes == tclEmptyStringRep) {
	return TCL_EMPTYSTRING_YES;
    }

    if (TclIsPureList(objPtr)) {
	Tcl_ListObjLength(NULL, objPtr, &length);
	return length == 0;
    }

    if (TclIsPureDict(objPtr)) {
	Tcl_DictObjSize(NULL, objPtr, &length);
	return length == 0;
    }
    
    if (objPtr->bytes == NULL) {
	return TCL_EMPTYSTRING_UNKNOWN;
    }
    return objPtr->length == 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUniChar --
 *
 *	Get the index'th Unicode character from the String object. If index