/* 

  * tclScan.c --

  *

  *	This file contains the implementation of the "scan" command.

  *

  * Copyright (c) 1998 by Scriptics Corporation.

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclScan.c,v 1.12.2.2 2005/10/23 22:01:30 msofer Exp $

  */

 #include "tclInt.h"

 /*

  * For strtoll() and strtoull() declarations on some platforms...

  */

 #include "tclPort.h"

 /*

  * Flag values used by Tcl_ScanObjCmd.

  */

 #define SCAN_NOSKIP	0x1		  /* Don't skip blanks. */

 #define SCAN_SUPPRESS	0x2		  /* Suppress assignment. */

 #define SCAN_UNSIGNED	0x4		  /* Read an unsigned value. */

 #define SCAN_WIDTH	0x8		  /* A width value was supplied. */

 #define SCAN_SIGNOK	0x10		  /* A +/- character is allowed. */

 #define SCAN_NODIGITS	0x20		  /* No digits have been scanned. */

 #define SCAN_NOZERO	0x40		  /* No zero digits have been scanned. */

 #define SCAN_XOK	0x80		  /* An 'x' is allowed. */

 #define SCAN_PTOK	0x100		  /* Decimal point is allowed. */

 #define SCAN_EXPOK	0x200		  /* An exponent is allowed. */

 #define SCAN_LONGER	0x400		  /* Asked for a wide value. */

 /*

  * The following structure contains the information associated with

  * a character set.

  */

 typedef struct CharSet {

     int exclude;		/* 1 if this is an exclusion set. */

     int nchars;

     Tcl_UniChar *chars;

     int nranges;

     struct Range {

 	Tcl_UniChar start;

 	Tcl_UniChar end;

     } *ranges;

 } CharSet;

 /*

  * Declarations for functions used only in this file.

  */

 static char *	BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));

 static int	CharInSet _ANSI_ARGS_((CharSet *cset, int ch));

 static void	ReleaseCharSet _ANSI_ARGS_((CharSet *cset));

 static int	ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,

 		    int numVars, int *totalVars));

 /*

  *----------------------------------------------------------------------

  *

  * BuildCharSet --

  *

  *	This function examines a character set format specification

  *	and builds a CharSet containing the individual characters and

  *	character ranges specified.

  *

  * Results:

  *	Returns the next format position.

  *

  * Side effects:

  *	Initializes the charset.

  *

  *----------------------------------------------------------------------

  */

 static char *

 BuildCharSet(cset, format)

     CharSet *cset;

     char *format;		/* Points to first char of set. */

 {

     Tcl_UniChar ch, start;

     int offset, nranges;

     char *end;

     memset(cset, 0, sizeof(CharSet));

     offset = Tcl_UtfToUniChar(format, &ch);

     if (ch == '^') {

 	cset->exclude = 1;

 	format += offset;

 	offset = Tcl_UtfToUniChar(format, &ch);

     }

     end = format + offset;

     /*

      * Find the close bracket so we can overallocate the set.

      */

     if (ch == ']') {

 	end += Tcl_UtfToUniChar(end, &ch);

     }

     nranges = 0;

     while (ch != ']') {

 	if (ch == '-') {

 	    nranges++;

 	}

 	end += Tcl_UtfToUniChar(end, &ch);

     }

     cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)

 	    * (end - format - 1));

     if (nranges > 0) {

 	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);

     } else {

 	cset->ranges = NULL;

     }

     /*

      * Now build the character set.

      */

     cset->nchars = cset->nranges = 0;

     format += Tcl_UtfToUniChar(format, &ch);

     start = ch;

     if (ch == ']' || ch == '-') {

 	cset->chars[cset->nchars++] = ch;

 	format += Tcl_UtfToUniChar(format, &ch);

     }

     while (ch != ']') {

 	if (*format == '-') {

 	    /*

 	     * This may be the first character of a range, so don't add

 	     * it yet.

 	     */

 	    start = ch;

 	} else if (ch == '-') {

 	    /*

 	     * Check to see if this is the last character in the set, in which

 	     * case it is not a range and we should add the previous character

 	     * as well as the dash.

 	     */

 	    if (*format == ']') {

 		cset->chars[cset->nchars++] = start;

 		cset->chars[cset->nchars++] = ch;

 	    } else {

 		format += Tcl_UtfToUniChar(format, &ch);

 		/*

 		 * Check to see if the range is in reverse order.

 		 */

 		if (start < ch) {

 		    cset->ranges[cset->nranges].start = start;

 		    cset->ranges[cset->nranges].end = ch;

 		} else {

 		    cset->ranges[cset->nranges].start = ch;

 		    cset->ranges[cset->nranges].end = start;

 		}		    

 		cset->nranges++;

 	    }

 	} else {

 	    cset->chars[cset->nchars++] = ch;

 	}

 	format += Tcl_UtfToUniChar(format, &ch);

     }

     return format;

 }

 /*

  *----------------------------------------------------------------------

  *

  * CharInSet --

  *

  *	Check to see if a character matches the given set.

  *

  * Results:

  *	Returns non-zero if the character matches the given set.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 CharInSet(cset, c)

     CharSet *cset;

     int c;			/* Character to test, passed as int because

 				 * of non-ANSI prototypes. */

 {

     Tcl_UniChar ch = (Tcl_UniChar) c;

     int i, match = 0;

     for (i = 0; i < cset->nchars; i++) {

 	if (cset->chars[i] == ch) {

 	    match = 1;

 	    break;

 	}

     }

     if (!match) {

 	for (i = 0; i < cset->nranges; i++) {

 	    if ((cset->ranges[i].start <= ch)

 		    && (ch <= cset->ranges[i].end)) {

 		match = 1;

 		break;

 	    }

 	}

     }

     return (cset->exclude ? !match : match);    

 }

 /*

  *----------------------------------------------------------------------

  *

  * ReleaseCharSet --

  *

  *	Free the storage associated with a character set.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static void

 ReleaseCharSet(cset)

     CharSet *cset;

 {

     ckfree((char *)cset->chars);

     if (cset->ranges) {

 	ckfree((char *)cset->ranges);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * ValidateFormat --

  *

  *	Parse the format string and verify that it is properly formed

  *	and that there are exactly enough variables on the command line.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	May place an error in the interpreter result.

  *

  *----------------------------------------------------------------------

  */

 static int

 ValidateFormat(interp, format, numVars, totalSubs)

     Tcl_Interp *interp;		/* Current interpreter. */

     char *format;		/* The format string. */

     int numVars;		/* The number of variables passed to the

 				 * scan command. */

     int *totalSubs;		/* The number of variables that will be

 				 * required. */

 {

 #define STATIC_LIST_SIZE 16

     int gotXpg, gotSequential, value, i, flags;

     char *end;

     Tcl_UniChar ch;

     int staticAssign[STATIC_LIST_SIZE];

     int *nassign = staticAssign;

     int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;

     char buf[TCL_UTF_MAX+1];

     /*

      * Initialize an array that records the number of times a variable

      * is assigned to by the format string.  We use this to detect if

      * a variable is multiply assigned or left unassigned.

      */

     if (numVars > nspace) {

 	nassign = (int*)ckalloc(sizeof(int) * numVars);

 	nspace = numVars;

     }

     for (i = 0; i < nspace; i++) {

 	nassign[i] = 0;

     }

     xpgSize = objIndex = gotXpg = gotSequential = 0;

     while (*format != '\0') {

 	format += Tcl_UtfToUniChar(format, &ch);

 	flags = 0;

 	if (ch != '%') {

 	    continue;

 	}

 	format += Tcl_UtfToUniChar(format, &ch);

 	if (ch == '%') {

 	    continue;

 	}

 	if (ch == '*') {

 	    flags |= SCAN_SUPPRESS;

 	    format += Tcl_UtfToUniChar(format, &ch);

 	    goto xpgCheckDone;

 	}

 	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

 	    /*

 	     * Check for an XPG3-style %n$ specification.  Note: there

 	     * must not be a mixture of XPG3 specs and non-XPG3 specs

 	     * in the same format string.

 	     */

 	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */

 	    if (*end != '$') {

 		goto notXpg;

 	    }

 	    format = end+1;

 	    format += Tcl_UtfToUniChar(format, &ch);

 	    gotXpg = 1;

 	    if (gotSequential) {

 		goto mixedXPG;

 	    }

 	    objIndex = value - 1;

 	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {

 		goto badIndex;

 	    } else if (numVars == 0) {

 		/*

 		 * In the case where no vars are specified, the user can

 		 * specify %9999$ legally, so we have to consider special

 		 * rules for growing the assign array.  'value' is

 		 * guaranteed to be > 0.

 		 */

 		xpgSize = (xpgSize > value) ? xpgSize : value;

 	    }

 	    goto xpgCheckDone;

 	}

 	notXpg:

 	gotSequential = 1;

 	if (gotXpg) {

 	    mixedXPG:

 	    Tcl_SetResult(interp,

 		    "cannot mix \"%\" and \"%n$\" conversion specifiers",

 		    TCL_STATIC);

 	    goto error;

 	}

 	xpgCheckDone:

 	/*

 	 * Parse any width specifier.

 	 */

 	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

 	    value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */

 	    flags |= SCAN_WIDTH;

 	    format += Tcl_UtfToUniChar(format, &ch);

 	}

 	/*

 	 * Handle any size specifier.

 	 */

 	switch (ch) {

 	case 'l':

 	case 'L':

 	    flags |= SCAN_LONGER;

 	case 'h':

 	    format += Tcl_UtfToUniChar(format, &ch);

 	}

 	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {

 	    goto badIndex;

 	}

 	/*

 	 * Handle the various field types.

 	 */

 	switch (ch) {

 	    case 'c':

                 if (flags & SCAN_WIDTH) {

 		    Tcl_SetResult(interp,

 			    "field width may not be specified in %c conversion",

 			    TCL_STATIC);

 		    goto error;

                 }

 		/*

 		 * Fall through!

 		 */

 	    case 'n':

 	    case 's':

 		if (flags & SCAN_LONGER) {

 		invalidLonger:

 		    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';

 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			   "'l' modifier may not be specified in %", buf,

 			   " conversion", NULL);

 		    goto error;

 		}

 		/*

 		 * Fall through!

 		 */

 	    case 'd':

 	    case 'e':

 	    case 'f':

 	    case 'g':

 	    case 'i':

 	    case 'o':

 	    case 'u':

 	    case 'x':

  		break;

 		/*

 		 * Bracket terms need special checking

 		 */

 	    case '[':

 		if (flags & SCAN_LONGER) {

 		    goto invalidLonger;

 		}

 		if (*format == '\0') {

 		    goto badSet;

 		}

 		format += Tcl_UtfToUniChar(format, &ch);

 		if (ch == '^') {

 		    if (*format == '\0') {

 			goto badSet;

 		    }

 		    format += Tcl_UtfToUniChar(format, &ch);

 		}

 		if (ch == ']') {

 		    if (*format == '\0') {

 			goto badSet;

 		    }

 		    format += Tcl_UtfToUniChar(format, &ch);

 		}

 		while (ch != ']') {

 		    if (*format == '\0') {

 			goto badSet;

 		    }

 		    format += Tcl_UtfToUniChar(format, &ch);

 		}

 		break;

 	    badSet:

 		Tcl_SetResult(interp, "unmatched [ in format string",

 			TCL_STATIC);

 		goto error;

 	    default:

 	    {

 		char buf[TCL_UTF_MAX+1];

 		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			"bad scan conversion character \"", buf, "\"", NULL);

 		goto error;

 	    }

 	}

 	if (!(flags & SCAN_SUPPRESS)) {

 	    if (objIndex >= nspace) {

 		/*

 		 * Expand the nassign buffer.  If we are using XPG specifiers,

 		 * make sure that we grow to a large enough size.  xpgSize is

 		 * guaranteed to be at least one larger than objIndex.

 		 */

 		value = nspace;

 		if (xpgSize) {

 		    nspace = xpgSize;

 		} else {

 		    nspace += STATIC_LIST_SIZE;

 		}

 		if (nassign == staticAssign) {

 		    nassign = (void *)ckalloc(nspace * sizeof(int));

 		    for (i = 0; i < STATIC_LIST_SIZE; ++i) {

 			nassign[i] = staticAssign[i];

 		    }

 		} else {

 		    nassign = (void *)ckrealloc((void *)nassign,

 			    nspace * sizeof(int));

 		}

 		for (i = value; i < nspace; i++) {

 		    nassign[i] = 0;

 		}

 	    }

 	    nassign[objIndex]++;

 	    objIndex++;

 	}

     }

     /*

      * Verify that all of the variable were assigned exactly once.

      */

     if (numVars == 0) {

 	if (xpgSize) {

 	    numVars = xpgSize;

 	} else {

 	    numVars = objIndex;

 	}

     }

     if (totalSubs) {

 	*totalSubs = numVars;

     }

     for (i = 0; i < numVars; i++) {

 	if (nassign[i] > 1) {

 	    Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);

 	    goto error;

 	} else if (!xpgSize && (nassign[i] == 0)) {

 	    /*

 	     * If the space is empty, and xpgSize is 0 (means XPG wasn't

 	     * used, and/or numVars != 0), then too many vars were given

 	     */

 	    Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);

 	    goto error;

 	}

     }

     if (nassign != staticAssign) {

 	ckfree((char *)nassign);

     }

     return TCL_OK;

     badIndex:

     if (gotXpg) {

 	Tcl_SetResult(interp, "\"%n$\" argument index out of range",

 		TCL_STATIC);

     } else {

 	Tcl_SetResult(interp, 

 		"different numbers of variable names and field specifiers",

 		TCL_STATIC);

     }

     error:

     if (nassign != staticAssign) {

 	ckfree((char *)nassign);

     }

     return TCL_ERROR;

 #undef STATIC_LIST_SIZE

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ScanObjCmd --

  *

  *	This procedure is invoked to process the "scan" Tcl command.

  *	See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	See the user documentation.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_ScanObjCmd(dummy, interp, objc, objv)

     ClientData dummy;    	/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     char *format;

     int numVars, nconversions, totalVars = -1;

     int objIndex, offset, i, result, code;

     long value;

     char *string, *end, *baseString;

     char op = 0;

     int base = 0;

     int underflow = 0;

     size_t width;

     long (*fn)() = NULL;

 #ifndef TCL_WIDE_INT_IS_LONG

     Tcl_WideInt (*lfn)() = NULL;

     Tcl_WideInt wideValue;

 #endif

     Tcl_UniChar ch, sch;

     Tcl_Obj **objs = NULL, *objPtr = NULL;

     int flags;

     char buf[513];			  /* Temporary buffer to hold scanned

 					   * number strings before they are

 					   * passed to strtoul. */

     if (objc < 3) {

         Tcl_WrongNumArgs(interp, 1, objv,

 		"string format ?varName varName ...?");

 	return TCL_ERROR;

     }

     format = Tcl_GetStringFromObj(objv[2], NULL);

     numVars = objc-3;

     /*

      * Check for errors in the format string.

      */

     if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {

 	return TCL_ERROR;

     }

     /*

      * Allocate space for the result objects.

      */

     if (totalVars > 0) {

 	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);

 	for (i = 0; i < totalVars; i++) {

 	    objs[i] = NULL;

 	}

     }

     string = Tcl_GetStringFromObj(objv[1], NULL);

     baseString = string;

     /*

      * Iterate over the format string filling in the result objects until

      * we reach the end of input, the end of the format string, or there

      * is a mismatch.

      */

     objIndex = 0;

     nconversions = 0;

     while (*format != '\0') {

 	format += Tcl_UtfToUniChar(format, &ch);

 	flags = 0;

 	/*

 	 * If we see whitespace in the format, skip whitespace in the string.

 	 */

 	if (Tcl_UniCharIsSpace(ch)) {

 	    offset = Tcl_UtfToUniChar(string, &sch);

 	    while (Tcl_UniCharIsSpace(sch)) {

 		if (*string == '\0') {

 		    goto done;

 		}

 		string += offset;

 		offset = Tcl_UtfToUniChar(string, &sch);

 	    }

 	    continue;

 	}

 	if (ch != '%') {

 	    literal:

 	    if (*string == '\0') {

 		underflow = 1;

 		goto done;

 	    }

 	    string += Tcl_UtfToUniChar(string, &sch);

 	    if (ch != sch) {

 		goto done;

 	    }

 	    continue;

 	}

 	format += Tcl_UtfToUniChar(format, &ch);

 	if (ch == '%') {

 	    goto literal;

 	}

 	/*

 	 * Check for assignment suppression ('*') or an XPG3-style

 	 * assignment ('%n$').

 	 */

 	if (ch == '*') {

 	    flags |= SCAN_SUPPRESS;

 	    format += Tcl_UtfToUniChar(format, &ch);

 	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

 	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */

 	    if (*end == '$') {

 		format = end+1;

 		format += Tcl_UtfToUniChar(format, &ch);

 		objIndex = (int) value - 1;

 	    }

 	}

 	/*

 	 * Parse any width specifier.

 	 */

 	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */

 	    width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */

 	    format += Tcl_UtfToUniChar(format, &ch);

 	} else {

 	    width = 0;

 	}

 	/*

 	 * Handle any size specifier.

 	 */

 	switch (ch) {

 	case 'l':

 	case 'L':

 	    flags |= SCAN_LONGER;

 	    /*

 	     * Fall through so we skip to the next character.

 	     */

 	case 'h':

 	    format += Tcl_UtfToUniChar(format, &ch);

 	}

 	/*

 	 * Handle the various field types.

 	 */

 	switch (ch) {

 	    case 'n':

 		if (!(flags & SCAN_SUPPRESS)) {

 		    objPtr = Tcl_NewIntObj(string - baseString);

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		nconversions++;

 		continue;

 	    case 'd':

 		op = 'i';

 		base = 10;

 		fn = (long (*)())strtol;

 #ifndef TCL_WIDE_INT_IS_LONG

 		lfn = (Tcl_WideInt (*)())strtoll;

 #endif

 		break;

 	    case 'i':

 		op = 'i';

 		base = 0;

 		fn = (long (*)())strtol;

 #ifndef TCL_WIDE_INT_IS_LONG

 		lfn = (Tcl_WideInt (*)())strtoll;

 #endif

 		break;

 	    case 'o':

 		op = 'i';

 		base = 8;

 		fn = (long (*)())strtoul;

 #ifndef TCL_WIDE_INT_IS_LONG

 		lfn = (Tcl_WideInt (*)())strtoull;

 #endif

 		break;

 	    case 'x':

 		op = 'i';

 		base = 16;

 		fn = (long (*)())strtoul;

 #ifndef TCL_WIDE_INT_IS_LONG

 		lfn = (Tcl_WideInt (*)())strtoull;

 #endif

 		break;

 	    case 'u':

 		op = 'i';

 		base = 10;

 		flags |= SCAN_UNSIGNED;

 		fn = (long (*)())strtoul;

 #ifndef TCL_WIDE_INT_IS_LONG

 		lfn = (Tcl_WideInt (*)())strtoull;

 #endif

 		break;

 	    case 'f':

 	    case 'e':

 	    case 'g':

 		op = 'f';

 		break;

 	    case 's':

 		op = 's';

 		break;

 	    case 'c':

 		op = 'c';

 		flags |= SCAN_NOSKIP;

 		break;

 	    case '[':

 		op = '[';

 		flags |= SCAN_NOSKIP;

 		break;

 	}

 	/*

 	 * At this point, we will need additional characters from the

 	 * string to proceed.

 	 */

 	if (*string == '\0') {

 	    underflow = 1;

 	    goto done;

 	}

 	/*

 	 * Skip any leading whitespace at the beginning of a field unless

 	 * the format suppresses this behavior.

 	 */

 	if (!(flags & SCAN_NOSKIP)) {

 	    while (*string != '\0') {

 		offset = Tcl_UtfToUniChar(string, &sch);

 		if (!Tcl_UniCharIsSpace(sch)) {

 		    break;

 		}

 		string += offset;

 	    }

 	    if (*string == '\0') {

 		underflow = 1;

 		goto done;

 	    }

 	}

 	/*

 	 * Perform the requested scanning operation.

 	 */

 	switch (op) {

 	    case 's':

 		/*

 		 * Scan a string up to width characters or whitespace.

 		 */

 		if (width == 0) {

 		    width = (size_t) ~0;

 		}

 		end = string;

 		while (*end != '\0') {

 		    offset = Tcl_UtfToUniChar(end, &sch);

 		    if (Tcl_UniCharIsSpace(sch)) {

 			break;

 		    }

 		    end += offset;

 		    if (--width == 0) {

 			break;

 		    }

 		}

 		if (!(flags & SCAN_SUPPRESS)) {

 		    objPtr = Tcl_NewStringObj(string, end-string);

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		string = end;

 		break;

 	    case '[': {

 		CharSet cset;

 		if (width == 0) {

 		    width = (size_t) ~0;

 		}

 		end = string;

 		format = BuildCharSet(&cset, format);

 		while (*end != '\0') {

 		    offset = Tcl_UtfToUniChar(end, &sch);

 		    if (!CharInSet(&cset, (int)sch)) {

 			break;

 		    }

 		    end += offset;

 		    if (--width == 0) {

 			break;

 		    }

 		}

 		ReleaseCharSet(&cset);

 		if (string == end) {

 		    /*

 		     * Nothing matched the range, stop processing

 		     */

 		    goto done;

 		}

 		if (!(flags & SCAN_SUPPRESS)) {

 		    objPtr = Tcl_NewStringObj(string, end-string);

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		string = end;

 		break;

 	    }

 	    case 'c':

 		/*

 		 * Scan a single Unicode character.

 		 */

 		string += Tcl_UtfToUniChar(string, &sch);

 		if (!(flags & SCAN_SUPPRESS)) {

 		    objPtr = Tcl_NewIntObj((int)sch);

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		break;

 	    case 'i':

 		/*

 		 * Scan an unsigned or signed integer.

 		 */

 		if ((width == 0) || (width > sizeof(buf) - 1)) {

 		    width = sizeof(buf) - 1;

 		}

 		flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;

 		for (end = buf; width > 0; width--) {

 		    switch (*string) {

 			/*

 			 * The 0 digit has special meaning at the beginning of

 			 * a number.  If we are unsure of the base, it

 			 * indicates that we are in base 8 or base 16 (if it is

 			 * followed by an 'x').

 			 *

 			 * 8.1 - 8.3.4 incorrectly handled 0x... base-16

 			 * cases for %x by not reading the 0x as the

 			 * auto-prelude for base-16. [Bug #495213]

 			 */

 			case '0':

 			    if (base == 0) {

 				base = 8;

 				flags |= SCAN_XOK;

 			    }

 			    if (base == 16) {

 				flags |= SCAN_XOK;

 			    }

 			    if (flags & SCAN_NOZERO) {

 				flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS

 					| SCAN_NOZERO);

 			    } else {

 				flags &= ~(SCAN_SIGNOK | SCAN_XOK

 					| SCAN_NODIGITS);

 			    }

 			    goto addToInt;

 			case '1': case '2': case '3': case '4':

 			case '5': case '6': case '7':

 			    if (base == 0) {

 				base = 10;

 			    }

 			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);

 			    goto addToInt;

 			case '8': case '9':

 			    if (base == 0) {

 				base = 10;

 			    }

 			    if (base <= 8) {

 				break;

 			    }

 			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);

 			    goto addToInt;

 			case 'A': case 'B': case 'C':

 			case 'D': case 'E': case 'F': 

 			case 'a': case 'b': case 'c':

 			case 'd': case 'e': case 'f':

 			    if (base <= 10) {

 				break;

 			    }

 			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);

 			    goto addToInt;

 			case '+': case '-':

 			    if (flags & SCAN_SIGNOK) {

 				flags &= ~SCAN_SIGNOK;

 				goto addToInt;

 			    }

 			    break;

 			case 'x': case 'X':

 			    if ((flags & SCAN_XOK) && (end == buf+1)) {

 				base = 16;

 				flags &= ~SCAN_XOK;

 				goto addToInt;

 			    }

 			    break;

 		    }

 		    /*

 		     * We got an illegal character so we are done accumulating.

 		     */

 		    break;

 		    addToInt:

 		    /*

 		     * Add the character to the temporary buffer.

 		     */

 		    *end++ = *string++;

 		    if (*string == '\0') {

 			break;

 		    }

 		}

 		/*

 		 * Check to see if we need to back up because we only got a

 		 * sign or a trailing x after a 0.

 		 */

 		if (flags & SCAN_NODIGITS) {

 		    if (*string == '\0') {

 			underflow = 1;

 		    }

 		    goto done;

 		} else if (end[-1] == 'x' || end[-1] == 'X') {

 		    end--;

 		    string--;

 		}

 		/*

 		 * Scan the value from the temporary buffer.  If we are

 		 * returning a large unsigned value, we have to convert it back

 		 * to a string since Tcl only supports signed values.

 		 */

 		if (!(flags & SCAN_SUPPRESS)) {

 		    *end = '\0';

 #ifndef TCL_WIDE_INT_IS_LONG

 		    if (flags & SCAN_LONGER) {

 			wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base);

 			if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {

 			    /* INTL: ISO digit */

 			    sprintf(buf, "%" TCL_LL_MODIFIER "u",

 				    (Tcl_WideUInt)wideValue);

 			    objPtr = Tcl_NewStringObj(buf, -1);

 			} else {

 			    objPtr = Tcl_NewWideIntObj(wideValue);

 			}

 		    } else {

 #endif /* !TCL_WIDE_INT_IS_LONG */

 			value = (long) (*fn)(buf, NULL, base);

 			if ((flags & SCAN_UNSIGNED) && (value < 0)) {

 			    sprintf(buf, "%lu", value); /* INTL: ISO digit */

 			    objPtr = Tcl_NewStringObj(buf, -1);

 			} else if ((flags & SCAN_LONGER)

 				|| (unsigned long) value > UINT_MAX) {

 			    objPtr = Tcl_NewLongObj(value);

 			} else {

 			    objPtr = Tcl_NewIntObj(value);

 			}

 #ifndef TCL_WIDE_INT_IS_LONG

 		    }

 #endif

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		break;

 	    case 'f':

 		/*

 		 * Scan a floating point number

 		 */

 		if ((width == 0) || (width > sizeof(buf) - 1)) {

 		    width = sizeof(buf) - 1;

 		}

 		flags &= ~SCAN_LONGER;

 		flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;

 		for (end = buf; width > 0; width--) {

 		    switch (*string) {

 			case '0': case '1': case '2': case '3':

 			case '4': case '5': case '6': case '7':

 			case '8': case '9':

 			    flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);

 			    goto addToFloat;

 			case '+': case '-':

 			    if (flags & SCAN_SIGNOK) {

 				flags &= ~SCAN_SIGNOK;

 				goto addToFloat;

 			    }

 			    break;

 			case '.':

 			    if (flags & SCAN_PTOK) {

 				flags &= ~(SCAN_SIGNOK | SCAN_PTOK);

 				goto addToFloat;

 			    }

 			    break;

 			case 'e': case 'E':

 			    /*

 			     * An exponent is not allowed until there has

 			     * been at least one digit.

 			     */

 			    if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))

 				    == SCAN_EXPOK) {

 				flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))

 				    | SCAN_SIGNOK | SCAN_NODIGITS;

 				goto addToFloat;

 			    }

 			    break;

 		    }

 		    /*

 		     * We got an illegal character so we are done accumulating.

 		     */

 		    break;

 		    addToFloat:

 		    /*

 		     * Add the character to the temporary buffer.

 		     */

 		    *end++ = *string++;

 		    if (*string == '\0') {

 			break;

 		    }

 		}

 		/*

 		 * Check to see if we need to back up because we saw a

 		 * trailing 'e' or sign.

 		 */

 		if (flags & SCAN_NODIGITS) {

 		    if (flags & SCAN_EXPOK) {

 			/*

 			 * There were no digits at all so scanning has

 			 * failed and we are done.

 			 */

 			if (*string == '\0') {

 			    underflow = 1;

 			}

 			goto done;

 		    }

 		    /*

 		     * We got a bad exponent ('e' and maybe a sign).

 		     */

 		    end--;

 		    string--;

 		    if (*end != 'e' && *end != 'E') {

 			end--;

 			string--;

 		    }

 		}

 		/*

 		 * Scan the value from the temporary buffer.

 		 */

 		if (!(flags & SCAN_SUPPRESS)) {

 		    double dvalue;

 		    *end = '\0';

 		    dvalue = strtod(buf, NULL);

 		    objPtr = Tcl_NewDoubleObj(dvalue);

 		    Tcl_IncrRefCount(objPtr);

 		    objs[objIndex++] = objPtr;

 		}

 		break;

 	}

 	nconversions++;

     }

     done:

     result = 0;

     code = TCL_OK;

     if (numVars) {

 	/*

 	 * In this case, variables were specified (classic scan)

 	 */

 	for (i = 0; i < totalVars; i++) {

 	    if (objs[i] != NULL) {

 		Tcl_Obj *tmpPtr;

 		result++;

 		tmpPtr = Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0);

 		Tcl_DecrRefCount(objs[i]);

 		if (tmpPtr == NULL) {

 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			    "couldn't set variable \"",

 			    Tcl_GetString(objv[i+3]), "\"", (char *) NULL);

 		    code = TCL_ERROR;

 		}

 	    }

 	}

     } else {

 	/*

 	 * Here no vars were specified, we want a list returned (inline scan)

 	 */

 	objPtr = Tcl_NewObj();

 	for (i = 0; i < totalVars; i++) {

 	    if (objs[i] != NULL) {

 		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);

 		Tcl_DecrRefCount(objs[i]);

 	    } else {

 		/*

 		 * More %-specifiers than matching chars, so we

 		 * just spit out empty strings for these

 		 */

 		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());

 	    }

 	}

     }

     if (objs != NULL) {

 	ckfree((char*) objs);

     }

     if (code == TCL_OK) {

 	if (underflow && (nconversions == 0)) {

 	    if (numVars) {

 		objPtr = Tcl_NewIntObj(-1);

 	    } else {

 		if (objPtr) {

 		    Tcl_SetListObj(objPtr, 0, NULL);

 		} else {

 		    objPtr = Tcl_NewObj();

 		}

 	    }

 	} else if (numVars) {

 	    objPtr = Tcl_NewIntObj(result);

 	}

 	Tcl_SetObjResult(interp, objPtr);

     }

     return code;

 }