/* 

  * tclUtil.c --

  *

  *	This file contains utility procedures that are used by many Tcl

  *	commands.

  *

  * Copyright (c) 1987-1993 The Regents of the University of California.

  * Copyright (c) 1994-1998 Sun Microsystems, Inc.

  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * 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.36.2.8 2007/05/10 18:23:58 dgp Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #if defined(__SYMBIAN32__) 

 #include "tclSymbianGlobals.h"

 #endif 

 /*

  * The following variable holds the full path name of the binary

  * from which this application was executed, or NULL if it isn't

  * know.  The value of the variable is set by the procedure

  * Tcl_FindExecutable.  The storage space is dynamically allocated.

  */

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 char *tclExecutableName = NULL;

 char *tclNativeExecutableName = NULL;

 #endif

 /*

  * The following values are used in the flags returned by Tcl_ScanElement

  * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also

  * defined in tcl.h;  make sure its value doesn't overlap with any of the

  * values below.

  *

  * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in

  *				braces (e.g. it contains unmatched braces,

  *				or ends in a backslash character, or user

  *				just doesn't want braces);  handle all

  *				special characters by adding backslashes.

  * USE_BRACES -			1 means the string contains a special

  *				character that can be handled simply by

  *				enclosing the entire argument in braces.

  * BRACES_UNMATCHED -		1 means that braces aren't properly matched

  *				in the argument.

  */

 #define USE_BRACES		2

 #define BRACES_UNMATCHED	4

 /*

  * The following values determine the precision used when converting

  * floating-point values to strings.  This information is linked to all

  * of the tcl_precision variables in all interpreters via the procedure

  * TclPrecTraceProc.

  */

 static char precisionString[10] = "12";

 				/* The string value of all the tcl_precision

 				 * variables. */

 static char precisionFormat[10] = "%.12g";

 				/* The format string actually used in calls

 				 * to sprintf. */

 TCL_DECLARE_MUTEX(precisionMutex)

 /*

  * Prototypes for procedures defined later in this file.

  */

 static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));

 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.

  */

 Tcl_ObjType tclEndOffsetType = {

     "end-offset",			/* name */

     (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */

     (Tcl_DupInternalRepProc*) NULL,     /* dupIntRepProc */

     UpdateStringOfEndOffset,		/* updateStringProc */

     SetEndOffsetFromAny    

 };

 /*

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

  *

  * TclFindElement --

  *

  *	Given a pointer into a Tcl list, locate the first (or next)

  *	element in the list.

  *

  * Results:

  *	The return value is normally TCL_OK, which means that the

  *	element was successfully located.  If TCL_ERROR is returned

  *	it means that list didn't have proper list structure;

  *	the interp's result contains a more detailed error message.

  *

  *	If TCL_OK is returned, then *elementPtr will be set to point to the

  *	first element of list, and *nextPtr will be set to point to the

  *	character just after any white space following the last character

  *	that's part of the element. If this is the last argument in the

  *	list, then *nextPtr will point just after the last character in the

  *	list (i.e., at the character at list+listLength). If sizePtr is

  *	non-NULL, *sizePtr is filled in with the number of characters in the

  *	element.  If the element is in braces, then *elementPtr will point

  *	to the character after the opening brace and *sizePtr will not

  *	include either of the braces. If there isn't an element in the list,

  *	*sizePtr will be zero, and both *elementPtr and *termPtr will point

  *	just after the last character in the list. Note: this procedure does

  *	NOT collapse backslash sequences.

  *

  * Side effects:

  *	None.

  *

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

  */

 int

 TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,

 	       bracePtr)

     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

 				 * If NULL, then no error message is left

 				 * after errors. */

     CONST char *list;		/* Points to the first byte of a string

 				 * containing a Tcl list with zero or more

 				 * elements (possibly in braces). */

     int listLength;		/* Number of bytes in the list's string. */

     CONST char **elementPtr;	/* Where to put address of first significant

 				 * character in first element of list. */

     CONST char **nextPtr;	/* Fill in with location of character just

 				 * after all white space following end of

 				 * argument (next arg or end of list). */

     int *sizePtr;		/* If non-zero, fill in with size of

 				 * element. */

     int *bracePtr;		/* If non-zero, fill in with non-zero/zero

 				 * to indicate that arg was/wasn't

 				 * in braces. */

 {

     CONST char *p = list;

     CONST char *elemStart;	/* Points to first byte of first element. */

     CONST char *limit;		/* Points just after list's last byte. */

     int openBraces = 0;		/* Brace nesting level during parse. */

     int inQuotes = 0;

     int size = 0;		/* lint. */

     int numChars;

     CONST char *p2;

     /*

      * Skim off leading white space and check for an opening brace or

      * quote. We treat embedded NULLs in the list as bytes belonging to

      * a list element.

      */

     limit = (list + listLength);

     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */

 	p++;

     }

     if (p == limit) {		/* no element found */

 	elemStart = limit;

 	goto done;

     }

     if (*p == '{') {

 	openBraces = 1;

 	p++;

     } else if (*p == '"') {

 	inQuotes = 1;

 	p++;

     }

     elemStart = p;

     if (bracePtr != 0) {

 	*bracePtr = openBraces;

     }

     /*

      * Find element's end (a space, close brace, or the end of the string).

      */

     while (p < limit) {

 	switch (*p) {

 	    /*

 	     * Open brace: don't treat specially unless the element is in

 	     * braces. In this case, keep a nesting count.

 	     */

 	    case '{':

 		if (openBraces != 0) {

 		    openBraces++;

 		}

 		break;

 	    /*

 	     * Close brace: if element is in braces, keep nesting count and

 	     * quit when the last close brace is seen.

 	     */

 	    case '}':

 		if (openBraces > 1) {

 		    openBraces--;

 		} else if (openBraces == 1) {

 		    size = (p - elemStart);

 		    p++;

 		    if ((p >= limit)

 			    || isspace(UCHAR(*p))) { /* INTL: ISO space. */

 			goto done;

 		    }

 		    /*

 		     * Garbage after the closing brace; return an error.

 		     */

 		    if (interp != NULL) {

 			char buf[100];

 			p2 = p;

 			while ((p2 < limit)

 				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */

 			        && (p2 < p+20)) {

 			    p2++;

 			}

 			sprintf(buf,

 				"list element in braces followed by \"%.*s\" instead of space",

 				(int) (p2-p), p);

 			Tcl_SetResult(interp, buf, TCL_VOLATILE);

 		    }

 		    return TCL_ERROR;

 		}

 		break;

 	    /*

 	     * Backslash:  skip over everything up to the end of the

 	     * backslash sequence.

 	     */

 	    case '\\': {

 		Tcl_UtfBackslash(p, &numChars, NULL);

 		p += (numChars - 1);

 		break;

 	    }

 	    /*

 	     * Space: ignore if element is in braces or quotes; otherwise

 	     * terminate element.

 	     */

 	    case ' ':

 	    case '\f':

 	    case '\n':

 	    case '\r':

 	    case '\t':

 	    case '\v':

 		if ((openBraces == 0) && !inQuotes) {

 		    size = (p - elemStart);

 		    goto done;

 		}

 		break;

 	    /*

 	     * Double-quote: if element is in quotes then terminate it.

 	     */

 	    case '"':

 		if (inQuotes) {

 		    size = (p - elemStart);

 		    p++;

 		    if ((p >= limit)

 			    || isspace(UCHAR(*p))) { /* INTL: ISO space */

 			goto done;

 		    }

 		    /*

 		     * Garbage after the closing quote; return an error.

 		     */

 		    if (interp != NULL) {

 			char buf[100];

 			p2 = p;

 			while ((p2 < limit)

 				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */

 				 && (p2 < p+20)) {

 			    p2++;

 			}

 			sprintf(buf,

 				"list element in quotes followed by \"%.*s\" %s",

 				(int) (p2-p), p, "instead of space");

 			Tcl_SetResult(interp, buf, TCL_VOLATILE);

 		    }

 		    return TCL_ERROR;

 		}

 		break;

 	}

 	p++;

     }

     /*

      * End of list: terminate element.

      */

     if (p == limit) {

 	if (openBraces != 0) {

 	    if (interp != NULL) {

 		Tcl_SetResult(interp, "unmatched open brace in list",

 			TCL_STATIC);

 	    }

 	    return TCL_ERROR;

 	} else if (inQuotes) {

 	    if (interp != NULL) {

 		Tcl_SetResult(interp, "unmatched open quote in list",

 			TCL_STATIC);

 	    }

 	    return TCL_ERROR;

 	}

 	size = (p - elemStart);

     }

     done:

     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */

 	p++;

     }

     *elementPtr = elemStart;

     *nextPtr = p;

     if (sizePtr != 0) {

 	*sizePtr = size;

     }

     return TCL_OK;

 }

 /*

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

  *

  * TclCopyAndCollapse --

  *

  *	Copy a string and eliminate any backslashes that aren't in braces.

  *

  * Results:

  *	Count characters get copied from src to	dst. Along the way, if

  *	backslash sequences are found outside braces, the backslashes are

  *	eliminated in the copy. After scanning count chars from source, a

  *	null character is placed at the end of dst.  Returns the number

  *	of characters that got copied.

  *

  * Side effects:

  *	None.

  *

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

  */

 int

 TclCopyAndCollapse(count, src, dst)

     int count;			/* Number of characters to copy from src. */

     CONST char *src;		/* Copy from here... */

     char *dst;			/* ... to here. */

 {

     register char c;

     int numRead;

     int newCount = 0;

     int backslashCount;

     for (c = *src;  count > 0;  src++, c = *src, count--) {

 	if (c == '\\') {

 	    backslashCount = Tcl_UtfBackslash(src, &numRead, dst);

 	    dst += backslashCount;

 	    newCount += backslashCount;

 	    src += numRead-1;

 	    count -= numRead-1;

 	} else {

 	    *dst = c;

 	    dst++;

 	    newCount++;

 	}

     }

     *dst = 0;

     return newCount;

 }

 /*

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

  *

  * Tcl_SplitList --

  *

  *	Splits a list up into its constituent fields.

  *

  * Results

  *	The return value is normally TCL_OK, which means that

  *	the list was successfully split up.  If TCL_ERROR is

  *	returned, it means that "list" didn't have proper list

  *	structure;  the interp's result will contain a more detailed

  *	error message.

  *

  *	*argvPtr will be filled in with the address of an array

  *	whose elements point to the elements of list, in order.

  *	*argcPtr will get filled in with the number of valid elements

  *	in the array.  A single block of memory is dynamically allocated

  *	to hold both the argv array and a copy of the list (with

  *	backslashes and braces removed in the standard way).

  *	The caller must eventually free this memory by calling free()

  *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified

  *	if the procedure returns normally.

  *

  * Side effects:

  *	Memory is allocated.

  *

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

  */

 EXPORT_C int

 Tcl_SplitList(interp, list, argcPtr, argvPtr)

     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

 				 * If NULL, no error message is left. */

     CONST char *list;		/* Pointer to string with list structure. */

     int *argcPtr;		/* Pointer to location to fill in with

 				 * the number of elements in the list. */

     CONST char ***argvPtr;	/* Pointer to place to store pointer to

 				 * array of pointers to list elements. */

 {

     CONST char **argv;

     CONST char *l;

     char *p;

     int length, size, i, result, elSize, brace;

     CONST char *element;

     /*

      * Figure out how much space to allocate.  There must be enough

      * space for both the array of pointers and also for a copy of

      * the list.  To estimate the number of pointers needed, count

      * the number of space characters in the list.

      */

     for (size = 2, l = list; *l != 0; l++) {

 	if (isspace(UCHAR(*l))) { /* INTL: ISO space. */

 	    size++;

 	    /* Consecutive space can only count as a single list delimiter */

 	    while (1) {

 		char next = *(l + 1);

 		if (next == '\0') {

 		    break;

 		}

 		++l;

 		if (isspace(UCHAR(next))) {

 		    continue;

 		}

 		break;

 	    }

 	}

     }

     length = l - list;

     argv = (CONST char **) ckalloc((unsigned)

 	    ((size * sizeof(char *)) + length + 1));

     for (i = 0, p = ((char *) argv) + size*sizeof(char *);

 	    *list != 0;  i++) {

 	CONST char *prevList = list;

 	result = TclFindElement(interp, list, length, &element,

 				&list, &elSize, &brace);

 	length -= (list - prevList);

 	if (result != TCL_OK) {

 	    ckfree((char *) argv);

 	    return result;

 	}

 	if (*element == 0) {

 	    break;

 	}

 	if (i >= size) {

 	    ckfree((char *) argv);

 	    if (interp != NULL) {

 		Tcl_SetResult(interp, "internal error in Tcl_SplitList",

 			TCL_STATIC);

 	    }

 	    return TCL_ERROR;

 	}

 	argv[i] = p;

 	if (brace) {

 	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);

 	    p += elSize;

 	    *p = 0;

 	    p++;

 	} else {

 	    TclCopyAndCollapse(elSize, element, p);

 	    p += elSize+1;

 	}

     }

     argv[i] = NULL;

     *argvPtr = argv;

     *argcPtr = i;

     return TCL_OK;

 }

 /*

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

  *

  * Tcl_ScanElement --

  *

  *	This procedure is a companion procedure to Tcl_ConvertElement.

  *	It scans a string to see what needs to be done to it (e.g. add

  *	backslashes or enclosing braces) to make the string into a

  *	valid Tcl list element.

  *

  * Results:

  *	The return value is an overestimate of the number of characters

  *	that will be needed by Tcl_ConvertElement to produce a valid

  *	list element from string.  The word at *flagPtr is filled in

  *	with a value needed by Tcl_ConvertElement when doing the actual

  *	conversion.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_ScanElement(string, flagPtr)

     register CONST char *string; /* String to convert to list element. */

     register int *flagPtr;	 /* Where to store information to guide

 				  * Tcl_ConvertCountedElement. */

 {

     return Tcl_ScanCountedElement(string, -1, flagPtr);

 }

 /*

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

  *

  * Tcl_ScanCountedElement --

  *

  *	This procedure is a companion procedure to

  *	Tcl_ConvertCountedElement.  It scans a string to see what

  *	needs to be done to it (e.g. add backslashes or enclosing

  *	braces) to make the string into a valid Tcl list element.

  *	If length is -1, then the string is scanned up to the first

  *	null byte.

  *

  * Results:

  *	The return value is an overestimate of the number of characters

  *	that will be needed by Tcl_ConvertCountedElement to produce a

  *	valid list element from string.  The word at *flagPtr is

  *	filled in with a value needed by Tcl_ConvertCountedElement

  *	when doing the actual conversion.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_ScanCountedElement(string, length, flagPtr)

     CONST char *string;		/* String to convert to Tcl list element. */

     int length;			/* Number of bytes in string, or -1. */

     int *flagPtr;		/* Where to store information to guide

 				 * Tcl_ConvertElement. */

 {

     int flags, nestingLevel;

     register CONST char *p, *lastChar;

     /*

      * This procedure and Tcl_ConvertElement together do two things:

      *

      * 1. They produce a proper list, one that will yield back the

      * argument strings when evaluated or when disassembled with

      * Tcl_SplitList.  This is the most important thing.

      * 

      * 2. They try to produce legible output, which means minimizing the

      * use of backslashes (using braces instead).  However, there are

      * some situations where backslashes must be used (e.g. an element

      * like "{abc": the leading brace will have to be backslashed.

      * For each element, one of three things must be done:

      *

      * (a) Use the element as-is (it doesn't contain any special

      * characters).  This is the most desirable option.

      *

      * (b) Enclose the element in braces, but leave the contents alone.

      * This happens if the element contains embedded space, or if it

      * contains characters with special interpretation ($, [, ;, or \),

      * or if it starts with a brace or double-quote, or if there are

      * no characters in the element.

      *

      * (c) Don't enclose the element in braces, but add backslashes to

      * prevent special interpretation of special characters.  This is a

      * last resort used when the argument would normally fall under case

      * (b) but contains unmatched braces.  It also occurs if the last

      * character of the argument is a backslash or if the element contains

      * a backslash followed by newline.

      *

      * The procedure figures out how many bytes will be needed to store

      * the result (actually, it overestimates). It also collects information

      * about the element in the form of a flags word.

      *

      * Note: list elements produced by this procedure and

      * Tcl_ConvertCountedElement must have the property that they can be

      * enclosing in curly braces to make sub-lists.  This means, for

      * example, that we must not leave unmatched curly braces in the

      * resulting list element.  This property is necessary in order for

      * procedures like Tcl_DStringStartSublist to work.

      */

     nestingLevel = 0;

     flags = 0;

     if (string == NULL) {

 	string = "";

     }

     if (length == -1) {

 	length = strlen(string);

     }

     lastChar = string + length;

     p = string;

     if ((p == lastChar) || (*p == '{') || (*p == '"')) {

 	flags |= USE_BRACES;

     }

     for ( ; p < lastChar; p++) {

 	switch (*p) {

 	    case '{':

 		nestingLevel++;

 		break;

 	    case '}':

 		nestingLevel--;

 		if (nestingLevel < 0) {

 		    flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;

 		}

 		break;

 	    case '[':

 	    case '$':

 	    case ';':

 	    case ' ':

 	    case '\f':

 	    case '\n':

 	    case '\r':

 	    case '\t':

 	    case '\v':

 		flags |= USE_BRACES;

 		break;

 	    case '\\':

 		if ((p+1 == lastChar) || (p[1] == '\n')) {

 		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;

 		} else {

 		    int size;

 		    Tcl_UtfBackslash(p, &size, NULL);

 		    p += size-1;

 		    flags |= USE_BRACES;

 		}

 		break;

 	}

     }

     if (nestingLevel != 0) {

 	flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;

     }

     *flagPtr = flags;

     /*

      * Allow enough space to backslash every character plus leave

      * two spaces for braces.

      */

     return 2*(p-string) + 2;

 }

 /*

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

  *

  * Tcl_ConvertElement --

  *

  *	This is a companion procedure to Tcl_ScanElement.  Given

  *	the information produced by Tcl_ScanElement, this procedure

  *	converts a string to a list element equal to that string.

  *

  * Results:

  *	Information is copied to *dst in the form of a list element

  *	identical to src (i.e. if Tcl_SplitList is applied to dst it

  *	will produce a string identical to src).  The return value is

  *	a count of the number of characters copied (not including the

  *	terminating NULL character).

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_ConvertElement(src, dst, flags)

     register CONST char *src;	/* Source information for list element. */

     register char *dst;		/* Place to put list-ified element. */

     register int flags;		/* Flags produced by Tcl_ScanElement. */

 {

     return Tcl_ConvertCountedElement(src, -1, dst, flags);

 }

 /*

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

  *

  * Tcl_ConvertCountedElement --

  *

  *	This is a companion procedure to Tcl_ScanCountedElement.  Given

  *	the information produced by Tcl_ScanCountedElement, this

  *	procedure converts a string to a list element equal to that

  *	string.

  *

  * Results:

  *	Information is copied to *dst in the form of a list element

  *	identical to src (i.e. if Tcl_SplitList is applied to dst it

  *	will produce a string identical to src).  The return value is

  *	a count of the number of characters copied (not including the

  *	terminating NULL character).

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_ConvertCountedElement(src, length, dst, flags)

     register CONST char *src;	/* Source information for list element. */

     int length;			/* Number of bytes in src, or -1. */

     char *dst;			/* Place to put list-ified element. */

     int flags;			/* Flags produced by Tcl_ScanElement. */

 {

     register char *p = dst;

     register CONST char *lastChar;

     /*

      * See the comment block at the beginning of the Tcl_ScanElement

      * code for details of how this works.

      */

     if (src && length == -1) {

 	length = strlen(src);

     }

     if ((src == NULL) || (length == 0)) {

 	p[0] = '{';

 	p[1] = '}';

 	p[2] = 0;

 	return 2;

     }

     lastChar = src + length;

     if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {

 	*p = '{';

 	p++;

 	for ( ; src != lastChar; src++, p++) {

 	    *p = *src;

 	}

 	*p = '}';

 	p++;

     } else {

 	if (*src == '{') {

 	    /*

 	     * Can't have a leading brace unless the whole element is

 	     * enclosed in braces.  Add a backslash before the brace.

 	     * Furthermore, this may destroy the balance between open

 	     * and close braces, so set BRACES_UNMATCHED.

 	     */

 	    p[0] = '\\';

 	    p[1] = '{';

 	    p += 2;

 	    src++;

 	    flags |= BRACES_UNMATCHED;

 	}

 	for (; src != lastChar; src++) {

 	    switch (*src) {

 		case ']':

 		case '[':

 		case '$':

 		case ';':

 		case ' ':

 		case '\\':

 		case '"':

 		    *p = '\\';

 		    p++;

 		    break;

 		case '{':

 		case '}':

 		    /*

 		     * It may not seem necessary to backslash braces, but

 		     * it is.  The reason for this is that the resulting

 		     * list element may actually be an element of a sub-list

 		     * enclosed in braces (e.g. if Tcl_DStringStartSublist

 		     * has been invoked), so there may be a brace mismatch

 		     * if the braces aren't backslashed.

 		     */

 		    if (flags & BRACES_UNMATCHED) {

 			*p = '\\';

 			p++;

 		    }

 		    break;

 		case '\f':

 		    *p = '\\';

 		    p++;

 		    *p = 'f';

 		    p++;

 		    continue;

 		case '\n':

 		    *p = '\\';

 		    p++;

 		    *p = 'n';

 		    p++;

 		    continue;

 		case '\r':

 		    *p = '\\';

 		    p++;

 		    *p = 'r';

 		    p++;

 		    continue;

 		case '\t':

 		    *p = '\\';

 		    p++;

 		    *p = 't';

 		    p++;

 		    continue;

 		case '\v':

 		    *p = '\\';

 		    p++;

 		    *p = 'v';

 		    p++;

 		    continue;

 	    }

 	    *p = *src;

 	    p++;

 	}

     }

     *p = '\0';

     return p-dst;

 }

 /*

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

  *

  * Tcl_Merge --

  *

  *	Given a collection of strings, merge them together into a

  *	single string that has proper Tcl list structured (i.e.

  *	Tcl_SplitList may be used to retrieve strings equal to the

  *	original elements, and Tcl_Eval will parse the string back

  *	into its original elements).

  *

  * Results:

  *	The return value is the address of a dynamically-allocated

  *	string containing the merged list.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C char *

 Tcl_Merge(argc, argv)

     int argc;			/* How many strings to merge. */

     CONST char * CONST *argv;	/* Array of string values. */

 {

 #   define LOCAL_SIZE 20

     int localFlags[LOCAL_SIZE], *flagPtr;

     int numChars;

     char *result;

     char *dst;

     int i;

     /*

      * Pass 1: estimate space, gather flags.

      */

     if (argc <= LOCAL_SIZE) {

 	flagPtr = localFlags;

     } else {

 	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));

     }

     numChars = 1;

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

 	numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;

     }

     /*

      * Pass two: copy into the result area.

      */

     result = (char *) ckalloc((unsigned) numChars);

     dst = result;

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

 	numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);

 	dst += numChars;

 	*dst = ' ';

 	dst++;

     }

     if (dst == result) {

 	*dst = 0;

     } else {

 	dst[-1] = 0;

     }

     if (flagPtr != localFlags) {

 	ckfree((char *) flagPtr);

     }

     return result;

 }

 /*

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

  *

  * Tcl_Backslash --

  *

  *	Figure out how to handle a backslash sequence.

  *

  * Results:

  *	The return value is the character that should be substituted

  *	in place of the backslash sequence that starts at src.  If

  *	readPtr isn't NULL then it is filled in with a count of the

  *	number of characters in the backslash sequence.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C char

 Tcl_Backslash(src, readPtr)

     CONST char *src;		/* Points to the backslash character of

 				 * a backslash sequence. */

     int *readPtr;		/* Fill in with number of characters read

 				 * from src, unless NULL. */

 {

     char buf[TCL_UTF_MAX];

     Tcl_UniChar ch;

     Tcl_UtfBackslash(src, readPtr, buf);

     TclUtfToUniChar(buf, &ch);

     return (char) ch;

 }

 /*

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

  *

  * Tcl_Concat --

  *

  *	Concatenate a set of strings into a single large string.

  *

  * Results:

  *	The return value is dynamically-allocated string containing

  *	a concatenation of all the strings in argv, with spaces between

  *	the original argv elements.

  *

  * Side effects:

  *	Memory is allocated for the result;  the caller is responsible

  *	for freeing the memory.

  *

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

  */

 EXPORT_C char *

 Tcl_Concat(argc, argv)

     int argc;			/* Number of strings to concatenate. */

     CONST char * CONST *argv;	/* Array of strings to concatenate. */

 {

     int totalSize, i;

     char *p;

     char *result;

     for (totalSize = 1, i = 0; i < argc; i++) {

 	totalSize += strlen(argv[i]) + 1;

     }

     result = (char *) ckalloc((unsigned) totalSize);

     if (argc == 0) {

 	*result = '\0';

 	return result;

     }

     for (p = result, i = 0; i < argc; i++) {

 	CONST char *element;

 	int length;

 	/*

 	 * Clip white space off the front and back of the string

 	 * to generate a neater result, and ignore any empty

 	 * elements.

 	 */

 	element = argv[i];

 	while (isspace(UCHAR(*element))) { /* INTL: ISO space. */

 	    element++;

 	}

 	for (length = strlen(element);

 		(length > 0)

 		&& (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */

 		&& ((length < 2) || (element[length-2] != '\\'));

 	        length--) {

 	    /* Null loop body. */

 	}

 	if (length == 0) {

 	    continue;

 	}

 	memcpy((VOID *) p, (VOID *) element, (size_t) length);

 	p += length;

 	*p = ' ';

 	p++;

     }

     if (p != result) {

 	p[-1] = 0;

     } else {

 	*p = 0;

     }

     return result;

 }

 /*

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

  *

  * Tcl_ConcatObj --

  *

  *	Concatenate the strings from a set of objects into a single string

  *	object with spaces between the original strings.

  *

  * Results:

  *	The return value is a new string object containing a concatenation

  *	of the strings in objv. Its ref count is zero.

  *

  * Side effects:

  *	A new object is created.

  *

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

  */

 EXPORT_C Tcl_Obj *

 Tcl_ConcatObj(objc, objv)

     int objc;			/* Number of objects to concatenate. */

     Tcl_Obj *CONST objv[];	/* Array of objects to concatenate. */

 {

     int allocSize, finalSize, length, elemLength, i;

     char *p;

     char *element;

     char *concatStr;

     Tcl_Obj *objPtr;

     /*

      * Check first to see if all the items are of list type.  If so,

      * we will concat them together as lists, and return a list object.

      * This is only valid when the lists have no current string

      * representation, since we don't know what the original type was.

      * An original string rep may have lost some whitespace info when

      * converted which could be important.

      */

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

 	objPtr = objv[i];

 	if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {

 	    break;

 	}

     }

     if (i == objc) {

 	Tcl_Obj **listv;

 	int listc;

 	objPtr = Tcl_NewListObj(0, NULL);

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

 	    /*

 	     * Tcl_ListObjAppendList could be used here, but this saves

 	     * us a bit of type checking (since we've already done it)

 	     * Use of INT_MAX tells us to always put the new stuff on

 	     * the end.  It will be set right in Tcl_ListObjReplace.

 	     */

 	    Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);

 	    Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);

 	}

 	return objPtr;

     }

     allocSize = 0;

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

 	objPtr = objv[i];

 	element = Tcl_GetStringFromObj(objPtr, &length);

 	if ((element != NULL) && (length > 0)) {

 	    allocSize += (length + 1);

 	}

     }

     if (allocSize == 0) {

 	allocSize = 1;		/* enough for the NULL byte at end */

     }

     /*

      * Allocate storage for the concatenated result. Note that allocSize

      * is one more than the total number of characters, and so includes

      * room for the terminating NULL byte.

      */

     concatStr = (char *) ckalloc((unsigned) allocSize);

     /*

      * Now concatenate the elements. Clip white space off the front and back

      * to generate a neater result, and ignore any empty elements. Also put

      * a null byte at the end.

      */

     finalSize = 0;

     if (objc == 0) {

 	*concatStr = '\0';

     } else {

 	p = concatStr;

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

 	    objPtr = objv[i];

 	    element = Tcl_GetStringFromObj(objPtr, &elemLength);

 	    while ((elemLength > 0) && (UCHAR(*element) < 127)

 		    && isspace(UCHAR(*element))) { /* INTL: ISO C space. */

 	         element++;

 		 elemLength--;

 	    }

 	    /*

 	     * Trim trailing white space.  But, be careful not to trim

 	     * a space character if it is preceded by a backslash: in

 	     * this case it could be significant.

 	     */

 	    while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127)

 		    && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO C space. */

 		    && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {

 		elemLength--;

 	    }

 	    if (elemLength == 0) {

 	         continue;	/* nothing left of this element */

 	    }

 	    memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);

 	    p += elemLength;

 	    *p = ' ';

 	    p++;

 	    finalSize += (elemLength + 1);

         }

         if (p != concatStr) {

 	    p[-1] = 0;

 	    finalSize -= 1;	/* we overwrote the final ' ' */

         } else {

 	    *p = 0;

         }

     }

     TclNewObj(objPtr);

     objPtr->bytes  = concatStr;

     objPtr->length = finalSize;

     return objPtr;

 }

 /*

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

  *

  * Tcl_StringMatch --

  *

  *	See if a particular string matches a particular pattern.

  *

  * Results:

  *	The return value is 1 if string matches pattern, and

  *	0 otherwise.  The matching operation permits the following

  *	special characters in the pattern: *?\[] (see the manual

  *	entry for details on what these mean).

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_StringMatch(string, pattern)

     CONST char *string;		/* String. */

     CONST char *pattern;	/* Pattern, which may contain special

 				 * characters. */

 {

     return Tcl_StringCaseMatch(string, pattern, 0);

 }

 /*

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

  *

  * Tcl_StringCaseMatch --

  *

  *	See if a particular string matches a particular pattern.

  *	Allows case insensitivity.

  *

  * Results:

  *	The return value is 1 if string matches pattern, and

  *	0 otherwise.  The matching operation permits the following

  *	special characters in the pattern: *?\[] (see the manual

  *	entry for details on what these mean).

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_StringCaseMatch(string, pattern, nocase)

     CONST char *string;		/* String. */

     CONST char *pattern;	/* Pattern, which may contain special

 				 * characters. */

     int nocase;			/* 0 for case sensitive, 1 for insensitive */

 {

     int p, charLen;

     CONST char *pstart = pattern;

     Tcl_UniChar ch1, ch2;

     while (1) {

 	p = *pattern;

 	/*

 	 * See if we're at the end of both the pattern and the string.  If

 	 * so, we succeeded.  If we're at the end of the pattern but not at

 	 * the end of the string, we failed.

 	 */

 	if (p == '\0') {

 	    return (*string == '\0');

 	}

 	if ((*string == '\0') && (p != '*')) {

 	    return 0;

 	}

 	/*

 	 * Check for a "*" as the next pattern character.  It matches

 	 * any substring.  We handle this by calling ourselves

 	 * recursively for each postfix of string, until either we

 	 * match or we reach the end of the string.

 	 */

 	if (p == '*') {

 	    /*

 	     * Skip all successive *'s in the pattern

 	     */

 	    while (*(++pattern) == '*') {}

 	    p = *pattern;

 	    if (p == '\0') {

 		return 1;

 	    }

 	    /*

 	     * This is a special case optimization for single-byte utf.

 	     */

 	    if (UCHAR(*pattern) < 0x80) {

 		ch2 = (Tcl_UniChar)

 		    (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));

 	    } else {

 		Tcl_UtfToUniChar(pattern, &ch2);

 		if (nocase) {

 		    ch2 = Tcl_UniCharToLower(ch2);

 		}

 	    }

 	    while (1) {

 		/*

 		 * Optimization for matching - cruise through the string

 		 * quickly if the next char in the pattern isn't a special

 		 * character

 		 */

 		if ((p != '[') && (p != '?') && (p != '\\')) {

 		    if (nocase) {

 			while (*string) {

 			    charLen = TclUtfToUniChar(string, &ch1);

 			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {

 				break;

 			    }

 			    string += charLen;

 			}

 		    } else {

 			/*

 			 * There's no point in trying to make this code

 			 * shorter, as the number of bytes you want to

 			 * compare each time is non-constant.

 			 */

 			while (*string) {

 			    charLen = TclUtfToUniChar(string, &ch1);

 			    if (ch2 == ch1) {

 				break;

 			    }

 			    string += charLen;

 			}

 		    }

 		}

 		if (Tcl_StringCaseMatch(string, pattern, nocase)) {

 		    return 1;

 		}

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

 		    return 0;

 		}

 		string += TclUtfToUniChar(string, &ch1);

 	    }

 	}

 	/*

 	 * Check for a "?" as the next pattern character.  It matches

 	 * any single character.

 	 */

 	if (p == '?') {

 	    pattern++;

 	    string += TclUtfToUniChar(string, &ch1);

 	    continue;

 	}

 	/*

 	 * Check for a "[" as the next pattern character.  It is followed

 	 * by a list of characters that are acceptable, or by a range

 	 * (two characters separated by "-").

 	 */

 	if (p == '[') {

 	    Tcl_UniChar startChar, endChar;

 	    pattern++;

 	    if (UCHAR(*string) < 0x80) {

 		ch1 = (Tcl_UniChar)

 		    (nocase ? tolower(UCHAR(*string)) : UCHAR(*string));

 		string++;

 	    } else {

 		string += Tcl_UtfToUniChar(string, &ch1);

 		if (nocase) {

 		    ch1 = Tcl_UniCharToLower(ch1);

 		}

 	    }

 	    while (1) {

 		if ((*pattern == ']') || (*pattern == '\0')) {

 		    return 0;

 		}

 		if (UCHAR(*pattern) < 0x80) {

 		    startChar = (Tcl_UniChar)

 			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));

 		    pattern++;

 		} else {

 		    pattern += Tcl_UtfToUniChar(pattern, &startChar);

 		    if (nocase) {

 			startChar = Tcl_UniCharToLower(startChar);

 		    }

 		}

 		if (*pattern == '-') {

 		    pattern++;

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

 			return 0;

 		    }

 		    if (UCHAR(*pattern) < 0x80) {

 			endChar = (Tcl_UniChar)

 			    (nocase ? tolower(UCHAR(*pattern))

 				    : UCHAR(*pattern));

 			pattern++;

 		    } else {

 			pattern += Tcl_UtfToUniChar(pattern, &endChar);

 			if (nocase) {

 			    endChar = Tcl_UniCharToLower(endChar);

 			}

 		    }

 		    if (((startChar <= ch1) && (ch1 <= endChar))

 			    || ((endChar <= ch1) && (ch1 <= startChar))) {

 			/*

 			 * Matches ranges of form [a-z] or [z-a].

 			 */

 			break;

 		    }

 		} else if (startChar == ch1) {

 		    break;

 		}

 	    }

 	    while (*pattern != ']') {

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

 		    pattern = Tcl_UtfPrev(pattern, pstart);

 		    break;

 		}

 		pattern++;

 	    }

 	    pattern++;

 	    continue;

 	}

 	/*

 	 * If the next pattern character is '\', just strip off the '\'

 	 * so we do exact matching on the character that follows.

 	 */

 	if (p == '\\') {

 	    pattern++;

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

 		return 0;

 	    }

 	}

 	/*

 	 * There's no special character.  Just make sure that the next

 	 * bytes of each string match.

 	 */

 	string  += TclUtfToUniChar(string, &ch1);

 	pattern += TclUtfToUniChar(pattern, &ch2);

 	if (nocase) {

 	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {

 		return 0;

 	    }

 	} else if (ch1 != ch2) {

 	    return 0;

 	}

     }

 }

 /*

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

  *

  * TclMatchIsTrivial --

  *

  *	Test whether a particular glob pattern is a trivial pattern.

  *	(i.e. where matching is the same as equality testing).

  *

  * Results:

  *	A boolean indicating whether the pattern is free of all of the

  *	glob special chars.

  *

  * Side effects:

  *	None.

  *

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

  */

 int

 TclMatchIsTrivial(pattern)

     CONST char *pattern;

 {

     CONST char *p = pattern;

     while (1) {

 	switch (*p++) {

 	case '\0':

 	    return 1;

 	case '*':

 	case '?':

 	case '[':

 	case '\\':

 	    return 0;

 	}

     }

 }

 /*

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

  *

  * Tcl_DStringInit --

  *

  *	Initializes a dynamic string, discarding any previous contents

  *	of the string (Tcl_DStringFree should have been called already

  *	if the dynamic string was previously in use).

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The dynamic string is initialized to be empty.

  *

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

  */

 EXPORT_C void

 Tcl_DStringInit(dsPtr)

     Tcl_DString *dsPtr;		/* Pointer to structure for dynamic string. */

 {

     dsPtr->string = dsPtr->staticSpace;

     dsPtr->length = 0;

     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;

     dsPtr->staticSpace[0] = '\0';

 }

 /*

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

  *

  * Tcl_DStringAppend --

  *

  *	Append more characters to the current value of a dynamic string.

  *

  * Results:

  *	The return value is a pointer to the dynamic string's new value.

  *

  * Side effects:

  *	Length bytes from string (or all of string if length is less

  *	than zero) are added to the current value of the string. Memory

  *	gets reallocated if needed to accomodate the string's new size.

  *

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

  */

 EXPORT_C char *

 Tcl_DStringAppend(dsPtr, string, length)

     Tcl_DString *dsPtr;		/* Structure describing dynamic string. */

     CONST char *string;		/* String to append.  If length is -1 then

 				 * this must be null-terminated. */

     int length;			/* Number of characters from string to

 				 * append.  If < 0, then append all of string,

 				 * up to null at end. */

 {

     int newSize;

     char *dst;

     CONST char *end;

     if (length < 0) {

 	length = strlen(string);

     }

     newSize = length + dsPtr->length;

     /*

      * Allocate a larger buffer for the string if the current one isn't

      * large enough. Allocate extra space in the new buffer so that there

      * will be room to grow before we have to allocate again.

      */

     if (newSize >= dsPtr->spaceAvl) {

 	dsPtr->spaceAvl = newSize * 2;

 	if (dsPtr->string == dsPtr->staticSpace) {

 	    char *newString;

 	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);

 	    memcpy((VOID *) newString, (VOID *) dsPtr->string,

 		    (size_t) dsPtr->length);

 	    dsPtr->string = newString;

 	} else {

 	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,

 		    (size_t) dsPtr->spaceAvl);

 	}

     }

     /*

      * Copy the new string into the buffer at the end of the old

      * one.

      */

     for (dst = dsPtr->string + dsPtr->length, end = string+length;

 	    string < end; string++, dst++) {

 	*dst = *string;

     }

     *dst = '\0';

     dsPtr->length += length;

     return dsPtr->string;

 }

 /*

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

  *

  * Tcl_DStringAppendElement --

  *

  *	Append a list element to the current value of a dynamic string.

  *

  * Results:

  *	The return value is a pointer to the dynamic string's new value.

  *

  * Side effects:

  *	String is reformatted as a list element and added to the current

  *	value of the string.  Memory gets reallocated if needed to

  *	accomodate the string's new size.

  *

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

  */

 EXPORT_C char *

 Tcl_DStringAppendElement(dsPtr, string)

     Tcl_DString *dsPtr;		/* Structure describing dynamic string. */

     CONST char *string;		/* String to append.  Must be

 				 * null-terminated. */

 {

     int newSize, flags, strSize;

     char *dst;

     strSize = ((string == NULL) ? 0 : strlen(string));

     newSize = Tcl_ScanCountedElement(string, strSize, &flags)

 	+ dsPtr->length + 1;

     /*

      * Allocate a larger buffer for the string if the current one isn't

      * large enough.  Allocate extra space in the new buffer so that there

      * will be room to grow before we have to allocate again.

      * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string

      * to a larger buffer, since there may be embedded NULLs in the

      * string in some cases.

      */

     if (newSize >= dsPtr->spaceAvl) {

 	dsPtr->spaceAvl = newSize * 2;

 	if (dsPtr->string == dsPtr->staticSpace) {

 	    char *newString;

 	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);

 	    memcpy((VOID *) newString, (VOID *) dsPtr->string,

 		    (size_t) dsPtr->length);

 	    dsPtr->string = newString;

 	} else {

 	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,

 		    (size_t) dsPtr->spaceAvl);

 	}

     }

     /*

      * Convert the new string to a list element and copy it into the

      * buffer at the end, with a space, if needed.

      */

     dst = dsPtr->string + dsPtr->length;

     if (TclNeedSpace(dsPtr->string, dst)) {

 	*dst = ' ';

 	dst++;

 	dsPtr->length++;

     }

     dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags);

     return dsPtr->string;

 }

 /*

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

  *

  * Tcl_DStringSetLength --

  *

  *	Change the length of a dynamic string.  This can cause the

  *	string to either grow or shrink, depending on the value of

  *	length.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The length of dsPtr is changed to length and a null byte is

  *	stored at that position in the string.  If length is larger

  *	than the space allocated for dsPtr, then a panic occurs.

  *

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

  */

 EXPORT_C void

 Tcl_DStringSetLength(dsPtr, length)

     Tcl_DString *dsPtr;		/* Structure describing dynamic string. */

     int length;			/* New length for dynamic string. */

 {

     int newsize;

     if (length < 0) {

 	length = 0;

     }

     if (length >= dsPtr->spaceAvl) {

 	/*

 	 * There are two interesting cases here.  In the first case, the user

 	 * may be trying to allocate a large buffer of a specific size.  It

 	 * would be wasteful to overallocate that buffer, so we just allocate

 	 * enough for the requested size plus the trailing null byte.  In the

 	 * second case, we are growing the buffer incrementally, so we need

 	 * behavior similar to Tcl_DStringAppend.  The requested length will

 	 * usually be a small delta above the current spaceAvl, so we'll end up

 	 * doubling the old size.  This won't grow the buffer quite as quickly,

 	 * but it should be close enough.

 	 */

 	newsize = dsPtr->spaceAvl * 2;

 	if (length < newsize) {

 	    dsPtr->spaceAvl = newsize;

 	} else {

 	    dsPtr->spaceAvl = length + 1;

 	}

 	if (dsPtr->string == dsPtr->staticSpace) {

 	    char *newString;

 	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);

 	    memcpy((VOID *) newString, (VOID *) dsPtr->string,

 		    (size_t) dsPtr->length);

 	    dsPtr->string = newString;

 	} else {

 	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,

 		    (size_t) dsPtr->spaceAvl);

 	}

     }

     dsPtr->length = length;

     dsPtr->string[length] = 0;

 }

 /*

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

  *

  * Tcl_DStringFree --

  *

  *	Frees up any memory allocated for the dynamic string and

  *	reinitializes the string to an empty state.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The previous contents of the dynamic string are lost, and

  *	the new value is an empty string.

  *

  *---------------------------------------------------------------------- */

 EXPORT_C void

 Tcl_DStringFree(dsPtr)

     Tcl_DString *dsPtr;		/* Structure describing dynamic string. */

 {

     if (dsPtr->string != dsPtr->staticSpace) {

 	ckfree(dsPtr->string);

     }

     dsPtr->string = dsPtr->staticSpace;

     dsPtr->length = 0;

     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;

     dsPtr->staticSpace[0] = '\0';

 }

 /*

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

  *

  * Tcl_DStringResult --

  *

  *	This procedure moves the value of a dynamic string into an

  *	interpreter as its string result. Afterwards, the dynamic string

  *	is reset to an empty string.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The string is "moved" to interp's result, and any existing

  *	string result for interp is freed. dsPtr is reinitialized to

  *	an empty string.

  *

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

  */

 EXPORT_C void

 Tcl_DStringResult(interp, dsPtr)

     Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */

     Tcl_DString *dsPtr;		/* Dynamic string that is to become the

 				 * result of interp. */

 {

     Tcl_ResetResult(interp);

     if (dsPtr->string != dsPtr->staticSpace) {

 	interp->result = dsPtr->string;

 	interp->freeProc = TCL_DYNAMIC;

     } else if (dsPtr->length < TCL_RESULT_SIZE) {

 	interp->result = ((Interp *) interp)->resultSpace;

 	strcpy(interp->result, dsPtr->string);

     } else {

 	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);

     }

     dsPtr->string = dsPtr->staticSpace;

     dsPtr->length = 0;

     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;

     dsPtr->staticSpace[0] = '\0';

 }

 /*

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

  *

  * Tcl_DStringGetResult --

  *

  *	This procedure moves an interpreter's result into a dynamic string.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The interpreter's string result is cleared, and the previous

  *	contents of dsPtr are freed.

  *

  *	If the string result is empty, the object result is moved to the

  *	string result, then the object result is reset.

  *

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

  */

 EXPORT_C void

 Tcl_DStringGetResult(interp, dsPtr)

     Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */

     Tcl_DString *dsPtr;		/* Dynamic string that is to become the

 				 * result of interp. */

 {

     Interp *iPtr = (Interp *) interp;

     if (dsPtr->string != dsPtr->staticSpace) {

 	ckfree(dsPtr->string);

     }

     /*

      * If the string result is empty, move the object result to the

      * string result, then reset the object result.

      */

     if (*(iPtr->result) == 0) {

 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),

 	        TCL_VOLATILE);

     }

     dsPtr->length = strlen(iPtr->result);

     if (iPtr->freeProc != NULL) {

 	if (iPtr->freeProc == TCL_DYNAMIC) {

 	    dsPtr->string = iPtr->result;

 	    dsPtr->spaceAvl = dsPtr->length+1;

 	} else {

 	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));

 	    strcpy(dsPtr->string, iPtr->result);

 	    (*iPtr->freeProc)(iPtr->result);

 	}

 	dsPtr->spaceAvl = dsPtr->length+1;

 	iPtr->freeProc = NULL;

     } else {

 	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {

 	    dsPtr->string = dsPtr->staticSpace;

 	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;

 	} else {

 	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));

 	    dsPtr->spaceAvl = dsPtr->length + 1;

 	}

 	strcpy(dsPtr->string, iPtr->result);

     }

     iPtr->result = iPtr->resultSpace;

     iPtr->resultSpace[0] = 0;

 }

 /*

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

  *

  * Tcl_DStringStartSublist --

  *

  *	This procedure adds the necessary information to a dynamic

  *	string (e.g. " {" to start a sublist.  Future element

  *	appends will be in the sublist rather than the main list.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Characters get added to the dynamic string.

  *

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

  */

 EXPORT_C void

 Tcl_DStringStartSublist(dsPtr)

     Tcl_DString *dsPtr;			/* Dynamic string. */

 {

     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {

 	Tcl_DStringAppend(dsPtr, " {", -1);

     } else {

 	Tcl_DStringAppend(dsPtr, "{", -1);

     }

 }

 /*

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

  *

  * Tcl_DStringEndSublist --

  *

  *	This procedure adds the necessary characters to a dynamic

  *	string to end a sublist (e.g. "}").  Future element appends

  *	will be in the enclosing (sub)list rather than the current

  *	sublist.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C void

 Tcl_DStringEndSublist(dsPtr)

     Tcl_DString *dsPtr;			/* Dynamic string. */

 {

     Tcl_DStringAppend(dsPtr, "}", -1);

 }

 /*

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

  *

  * Tcl_PrintDouble --

  *

  *	Given a floating-point value, this procedure converts it to

  *	an ASCII string using.

  *

  * Results:

  *	The ASCII equivalent of "value" is written at "dst".  It is

  *	written using the current precision, and it is guaranteed to

  *	contain a decimal point or exponent, so that it looks like

  *	a floating-point value and not an integer.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C void

 Tcl_PrintDouble(interp, value, dst)

     Tcl_Interp *interp;			/* Interpreter whose tcl_precision

 					 * variable used to be used to control

 					 * printing.  It's ignored now. */

     double value;			/* Value to print as string. */

     char *dst;				/* Where to store converted value;

 					 * must have at least TCL_DOUBLE_SPACE

 					 * characters. */

 {

     char *p, c;

     Tcl_UniChar ch;

     Tcl_MutexLock(&precisionMutex);

     sprintf(dst, precisionFormat, value);

     Tcl_MutexUnlock(&precisionMutex);

     /*

      * If the ASCII result looks like an integer, add ".0" so that it

      * doesn't look like an integer anymore.  This prevents floating-point

      * values from being converted to integers unintentionally.

      * Check for ASCII specifically to speed up the function.

      */

     for (p = dst; *p != 0; ) {

 	if (UCHAR(*p) < 0x80) {

 	    c = *p++;

 	} else {

 	    p += Tcl_UtfToUniChar(p, &ch);

 	    c = UCHAR(ch);

 	}

 	if ((c == '.') || isalpha(UCHAR(c))) {	/* INTL: ISO only. */

 	    return;

 	}

     }

     p[0] = '.';

     p[1] = '0';

     p[2] = 0;

 }

 /*

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

  *

  * TclPrecTraceProc --

  *

  *	This procedure is invoked whenever the variable "tcl_precision"

  *	is written.

  *

  * Results:

  *	Returns NULL if all went well, or an error message if the

  *	new value for the variable doesn't make sense.

  *

  * Side effects:

  *	If the new value doesn't make sense then this procedure

  *	undoes the effect of the variable modification.  Otherwise

  *	it modifies the format string that's used by Tcl_PrintDouble.

  *

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

  */

 	/* ARGSUSED */

 char *

 TclPrecTraceProc(clientData, interp, name1, name2, flags)

     ClientData clientData;	/* Not used. */

     Tcl_Interp *interp;		/* Interpreter containing variable. */

     CONST char *name1;		/* Name of variable. */

     CONST char *name2;		/* Second part of variable name. */

     int flags;			/* Information about what happened. */

 {

     CONST char *value;

     char *end;

     int prec;

     /*

      * If the variable is unset, then recreate the trace.

      */

     if (flags & TCL_TRACE_UNSETS) {

 	if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) {

 	    Tcl_TraceVar2(interp, name1, name2,

 		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES

 		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);

 	}

 	return (char *) NULL;

     }

     /*

      * When the variable is read, reset its value from our shared

      * value.  This is needed in case the variable was modified in

      * some other interpreter so that this interpreter's value is

      * out of date.

      */

     Tcl_MutexLock(&precisionMutex);

     if (flags & TCL_TRACE_READS) {

 	Tcl_SetVar2(interp, name1, name2, precisionString,

 		flags & TCL_GLOBAL_ONLY);

 	Tcl_MutexUnlock(&precisionMutex);

 	return (char *) NULL;

     }

     /*

      * The variable is being written.  Check the new value and disallow

      * it if it isn't reasonable or if this is a safe interpreter (we

      * don't want safe interpreters messing up the precision of other

      * interpreters).

      */

     if (Tcl_IsSafe(interp)) {

 	Tcl_SetVar2(interp, name1, name2, precisionString,

 		flags & TCL_GLOBAL_ONLY);

 	Tcl_MutexUnlock(&precisionMutex);

 	return "can't modify precision from a safe interpreter";

     }

     value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);

     if (value == NULL) {

 	value = "";

     }

     prec = strtoul(value, &end, 10);

     if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||

 	    (end == value) || (*end != 0)) {

 	Tcl_SetVar2(interp, name1, name2, precisionString,

 		flags & TCL_GLOBAL_ONLY);

 	Tcl_MutexUnlock(&precisionMutex);

 	return "improper value for precision";

     }

     TclFormatInt(precisionString, prec);

     sprintf(precisionFormat, "%%.%dg", prec);

     Tcl_MutexUnlock(&precisionMutex);

     return (char *) NULL;

 }

 /*

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

  *

  * TclNeedSpace --

  *

  *	This procedure checks to see whether it is appropriate to

  *	add a space before appending a new list element to an

  *	existing string.

  *

  * Results:

  *	The return value is 1 if a space is appropriate, 0 otherwise.

  *

  * Side effects:

  *	None.

  *

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

  */

 int

 TclNeedSpace(start, end)

     CONST char *start;		/* First character in string. */

     CONST char *end;		/* End of string (place where space will

 				 * be added, if appropriate). */

 {

     /*

      * A space is needed unless either

      * (a) we're at the start of the string, or

      */

     if (end == start) {

 	return 0;

     }

     /*

      * (b) we're at the start of a nested list-element, quoted with an

      *     open curly brace; we can be nested arbitrarily deep, so long

      *     as the first curly brace starts an element, so backtrack over

      *     open curly braces that are trailing characters of the string; and

      */

     end = Tcl_UtfPrev(end, start);

     while (*end == '{') {

 	if (end == start) {

 	    return 0;

 	}

 	end = Tcl_UtfPrev(end, start);

     }

     /*

      * (c) the trailing character of the string is already a list-element

      *     separator (according to TclFindElement); that is, one of these

      *     characters:

      *     	\u0009	\t	TAB

      *     	\u000A	\n	NEWLINE

      *     	\u000B	\v	VERTICAL TAB

      *     	\u000C	\f	FORM FEED

      *     	\u000D	\r	CARRIAGE RETURN

      *     	\u0020		SPACE

      *     with the condition that the penultimate character is not a

      *     backslash.

      */

     if (*end > 0x20) {

 	/*

 	 * Performance tweak.  All ASCII spaces are <= 0x20. So get

 	 * a quick answer for most characters before comparing against

 	 * all spaces in the switch below.

 	 *

 	 * NOTE: Remove this if other Unicode spaces ever get accepted

 	 * as list-element separators.

 	 */

 	return 1;

     }

     switch (*end) {

 	case ' ':

         case '\t':

         case '\n':

         case '\r':

         case '\v':

         case '\f':

 	    if ((end == start) || (end[-1] != '\\')) {

 		return 0;

 	    }

     }

     return 1;

 }

 /*

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

  *

  * TclFormatInt --

  *

  *	This procedure formats an integer into a sequence of decimal digit

  *	characters in a buffer. If the integer is negative, a minus sign is

  *	inserted at the start of the buffer. A null character is inserted at

  *	the end of the formatted characters. It is the caller's

  *	responsibility to ensure that enough storage is available. This

  *	procedure has the effect of sprintf(buffer, "%d", n) but is faster.

  *

  * Results:

  *	An integer representing the number of characters formatted, not

  *	including the terminating \0.

  *

  * Side effects:

  *	The formatted characters are written into the storage pointer to

  *	by the "buffer" argument.

  *

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

  */

 int

 TclFormatInt(buffer, n)

     char *buffer;		/* Points to the storage into which the

 				 * formatted characters are written. */

     long n;			/* The integer to format. */

 {

     long intVal;

     int i;

     int numFormatted, j;

     char *digits = "0123456789";

     /*

      * Check first whether "n" is zero.

      */

     if (n == 0) {

 	buffer[0] = '0';

 	buffer[1] = 0;

 	return 1;

     }

     /*

      * Check whether "n" is the maximum negative value. This is

      * -2^(m-1) for an m-bit word, and has no positive equivalent;

      * negating it produces the same value.

      */

     if (n == -n) {

 	sprintf(buffer, "%ld", n);

 	return strlen(buffer);

     }

     /*

      * Generate the characters of the result backwards in the buffer.

      */

     intVal = (n < 0? -n : n);

     i = 0;

     buffer[0] = '\0';

     do {

 	i++;

 	buffer[i] = digits[intVal % 10];

 	intVal = intVal/10;

     } while (intVal > 0);

     if (n < 0) {

 	i++;

 	buffer[i] = '-';

     }

     numFormatted = i;

     /*

      * Now reverse the characters.

      */

     for (j = 0;  j < i;  j++, i--) {

 	char tmp = buffer[i];

 	buffer[i] = buffer[j];

 	buffer[j] = tmp;

     }

     return numFormatted;

 }

 /*

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

  *

  * TclLooksLikeInt --

  *

  *	This procedure decides whether the leading characters of a

  *	string look like an integer or something else (such as a

  *	floating-point number or string).

  *

  * Results:

  *	The return value is 1 if the leading characters of p look

  *	like a valid Tcl integer.  If they look like a floating-point

  *	number (e.g. "e01" or "2.4"), or if they don't look like a

  *	number at all, then 0 is returned.

  *

  * Side effects:

  *	None.

  *

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

  */

 int

 TclLooksLikeInt(bytes, length)

     register CONST char *bytes;	/* Points to first byte of the string. */

     int length;			/* Number of bytes in the string. If < 0

 				 * bytes up to the first null byte are

 				 * considered (if they may appear in an 

 				 * integer). */

 {

     register CONST char *p;

     if ((bytes == NULL) && (length > 0)) {

 	Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);

     }

     if (length < 0) {

         length = (bytes? strlen(bytes) : 0);

     }

     p = bytes;

     while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */

 	length--; p++;

     }

     if (length == 0) {

         return 0;

     }

     if ((*p == '+') || (*p == '-')) {

         p++; length--;

     }

     return (0 != TclParseInteger(p, length));

 }

 /*

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

  *

  * TclGetIntForIndex --

  *

  *	This procedure returns an integer corresponding to the list index

  *	held in a Tcl object. The Tcl object's value is expected to be

  *	either an integer or a string of the form "end([+-]integer)?". 

  *

  * Results:

  *	The return value is normally TCL_OK, which means that the index was

  *	successfully stored into the location referenced by "indexPtr".  If

  *	the Tcl object referenced by "objPtr" has the value "end", the

  *	value stored is "endValue". If "objPtr"s values is not of the form

  *	"end([+-]integer)?" and

  *	can not be converted to an integer, TCL_ERROR is returned and, if

  *	"interp" is non-NULL, an error message is left in the interpreter's

  *	result object.

  *

  * Side effects:

  *	The object referenced by "objPtr" might be converted to an

  *	integer, wide integer, or end-based-index object.

  *

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

  */

 int

 TclGetIntForIndex(interp, objPtr, endValue, indexPtr)

     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

 				 * If NULL, then no error message is left

 				 * after errors. */

     Tcl_Obj *objPtr;		/* Points to an object containing either

 				 * "end" or an integer. */

     int endValue;		/* The value to be stored at "indexPtr" if

 				 * "objPtr" holds "end". */

     int *indexPtr;		/* Location filled in with an integer

 				 * representing an index. */

 {

     if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {

 	return TCL_OK;

     }

     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 {

 	/*

 	 * Report a parse error.

 	 */

 	if (interp != NULL) {

 	    char *bytes = Tcl_GetString(objPtr);

 	    /*

 	     * The result might not be empty; this resets it which

 	     * should be both a cheap operation, and of little problem

 	     * because this is an error-generation path anyway.

 	     */

 	    Tcl_ResetResult(interp);

 	    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;

 }

 /*

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

  *

  * UpdateStringOfEndOffset --

  *

  *	Update the string rep of a Tcl object holding an "end-offset"

  *	expression.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Stores a valid string in the object's string rep.

  *

  * This procedure does NOT free any earlier string rep.  If it is

  * called on an object that already has a valid string rep, it will

  * leak memory.

  *

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

  */

 static void

 UpdateStringOfEndOffset(objPtr)

     register Tcl_Obj* objPtr;

 {

     char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];

     register int len;

     strcpy(buffer, "end");

     len = sizeof("end") - 1;

     if (objPtr->internalRep.longValue != 0) {

 	buffer[len++] = '-';

 	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));

     }

     objPtr->bytes = ckalloc((unsigned) (len+1));

     strcpy(objPtr->bytes, buffer);

     objPtr->length = len;

 }

 /*

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

  *

  * 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(interp, objPtr)

      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 (interp != NULL) {

 	    Tcl_ResetResult(interp);

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 				   "bad index \"", bytes,

 				   "\": must be end?-integer?",

 				   (char*) NULL);

 	}

 	return TCL_ERROR;

     }

     /* Convert the string rep */

     if (length <= 3) {

 	offset = 0;

     } else if ((length > 4) && (bytes[3] == '-')) {

 	/*

 	 * This is our limited string expression evaluator.  Pass everything

 	 * after "end-" to Tcl_GetInt, then reverse for offset.

 	 */

 	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {

 	    return TCL_ERROR;

 	}

 	offset = -offset;

     } else {

 	/*

 	 * Conversion failed.  Report the error.

 	 */

 	if (interp != NULL) {

 	    Tcl_ResetResult(interp);

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 				   "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;

 }    

 /*

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

  *

  * TclCheckBadOctal --

  *

  *	This procedure checks for a bad octal value and appends a

  *	meaningful error to the interp's result.

  *

  * Results:

  *	1 if the argument was a bad octal, else 0.

  *

  * Side effects:

  *	The interpreter's result is modified.

  *

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

  */

 int

 TclCheckBadOctal(interp, value)

     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

 				 * If NULL, then no error message is left

 				 * after errors. */

     CONST char *value;		/* String to check. */

 {

     register CONST char *p = value;

     /*

      * A frequent mistake is invalid octal values due to an unwanted

      * leading zero. Try to generate a meaningful error message.

      */

     while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */

 	p++;

     }

     if (*p == '+' || *p == '-') {

 	p++;

     }

     if (*p == '0') {

 	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */

 	    p++;

 	}

 	while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */

 	    p++;

 	}

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

 	    /* Reached end of string */

 	    if (interp != NULL) {

 		/*

 		 * Don't reset the result here because we want this result

 		 * to be added to an existing error message as extra info.

 		 */

 		Tcl_AppendResult(interp, " (looks like invalid octal number)",

 			(char *) NULL);

 	    }

 	    return 1;

 	}

     }

     return 0;

 }

 /*

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

  *

  * Tcl_GetNameOfExecutable --

  *

  *	This procedure simply returns a pointer to the internal full

  *	path name of the executable file as computed by

  *	Tcl_FindExecutable.  This procedure call is the C API

  *	equivalent to the "info nameofexecutable" command.

  *

  * Results:

  *	A pointer to the internal string or NULL if the internal full

  *	path name has not been computed or unknown.

  *

  * Side effects:

  *	The object referenced by "objPtr" might be converted to an

  *	integer object.

  *

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

  */

 EXPORT_C CONST char *

 Tcl_GetNameOfExecutable()

 {

     return tclExecutableName;

 }

 /*

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

  *

  * TclpGetTime --

  *

  *	Deprecated synonym for Tcl_GetTime.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Stores current time in the buffer designated by "timePtr"

  *

  * This procedure is provided for the benefit of extensions written

  * before Tcl_GetTime was exported from the library.

  *

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

  */

 void

 TclpGetTime(timePtr)

     Tcl_Time* timePtr;

 {

     Tcl_GetTime(timePtr);

 }