2006-08-29  Joe Mistachkin  <joe@mistachkin.com>

	* unix/tclUnixInit.c: Fixed the issue (typo) that was causing
	* unix/tclUnixThrd.c (TclpThreadGetStackSize): stack.test to
	fail on FreeBSD (and possibly other Unix platforms).

2006-08-29  Colin McCormack  <coldstore@users.sourceforge.net>

	* generic/tclIOUtil.c:     Added test for NULL return 
	* generic/tclPathObj.c: from Tcl_FSGetNormalizedPath
	* unix/tclUnixFile.c:     which was causing segv's per
	* win/tclWinFCmd.c:    Bug 1548263
	* /win/tclWinFile.c:

2006-08-28  Kevin Kenny  <kennykb@acm.org>

	* library/tzdata/America/Havana:      Regenerated from Olson's
	* library/tzdata/America/Tegucigalpa: tzdata2006k.
	* library/tzdata/Asia/Gaza:
	

'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: package.n,v 1.6.4.3 2005/12/02 18:42:05 dgp Exp $
'\" 
.so man.macros
.TH package n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
package \- Facilities for package loading and version control

.CE
.PP
To test to see if the Snack package is available and load if it is
(often useful for optional enhancements to programs where the loss of
the functionality is not critical) do this:
.CS
if {[catch {\fBpackage require\fR Snack}]} {
   # We have the package, configure the app to use it

} else {
   # Set up a dummy interface to work around the absence
}
.CE

.SH "SEE ALSO"
msgcat(n), packagens(n), pkgMkIndex(n)

.SH KEYWORDS
package, version

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  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: tclBasic.c,v 1.82.2.44 2006/08/29 16:19:26 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"

    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;		/* set after namespaces initialized */
    iPtr->emptyObjPtr = Tcl_NewObj();	/* another empty object */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->resultSpace[0] = 0;


    iPtr->globalNsPtr = NULL;		/* force creation of global ns below */
    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
	    (ClientData) NULL, NULL);
    if (iPtr->globalNsPtr == NULL) {
	Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
    }

/*
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 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: tclCompExpr.c,v 1.14.2.13 2006/08/29 16:19:27 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Boolean variable that controls whether expression compilation tracing is
 * enabled.
 */

#ifdef TCL_COMPILE_DEBUG
static int traceExprComp = 0;
#endif /* TCL_COMPILE_DEBUG */

/*
 * The ExprInfo structure describes the state of compiling an expression.  A
 * pointer to an ExprInfo record is passed among the routines in this module.
 */

typedef struct ExprInfo {
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Parse *parsePtr;	/* Structure filled with information about the
				 * parsed expression. */
    CONST char *expr;		/* The expression that was originally passed
				 * to TclCompileExpr. */
    CONST char *lastChar;	/* Points just after last byte of expr. */
    int hasOperators;		/* Set 1 if the expr has operators; 0 if expr
				 * is only a primary. If 1 after compiling an
				 * expr, a tryCvtToNumeric instruction is
				 * emitted to convert the primary to a number
				 * if possible. */
} ExprInfo;

/*
 * Definitions of numeric codes representing each expression operator.  The
 * order of these must match the entries in the operatorTable below.  Also the
 * codes for the relational operators (OP_LESS, OP_GREATER, OP_LE, OP_GE,
 * OP_EQ, and OP_NE) must be consecutive and in that order.  Note that OP_PLUS
 * and OP_MINUS represent both unary and binary operators.
 */

static Tcl_HashTable opHashTable;

/*
 * Declarations for local procedures to this file:
 */

static int		CompileCondExpr(
			    Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
			    CompileEnv *envPtr, Tcl_Token **endPtrPtr);
static int		CompileLandOrLorExpr(
			    Tcl_Token *exprTokenPtr, int opIndex,
			    ExprInfo *infoPtr, CompileEnv *envPtr,
			    Tcl_Token **endPtrPtr);
static int		CompileMathFuncCall(Tcl_Token *exprTokenPtr,
			    CONST char *funcName, ExprInfo *infoPtr,
			    CompileEnv *envPtr, Tcl_Token **endPtrPtr);

static int		CompileSubExpr(Tcl_Token *exprTokenPtr,
			    ExprInfo *infoPtr, CompileEnv *envPtr);
static void		LogSyntaxError(ExprInfo *infoPtr);

/*
 * Macro used to debug the execution of the expression compiler.
 */

#ifdef TCL_COMPILE_DEBUG
#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \

    Tcl_Interp *interp,		/* Used for error reporting. */
    CONST char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    ExprInfo info;
    Tcl_Parse parse;
    Tcl_HashEntry *hPtr;
    int new, i, code;

    /*
     * If this is the first time we've been called, initialize the table of
     * expression operators.
     */

    if (numBytes < 0) {
	numBytes = (script? strlen(script) : 0);
    }
    if (!opTableInitialized) {
	Tcl_MutexLock(&opMutex);
	if (!opTableInitialized) {

	    Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
	    for (i = 0;  operatorTable[i].name != NULL;  i++) {

		hPtr = Tcl_CreateHashEntry(&opHashTable,
			operatorTable[i].name, &new);
		if (new) {
		    Tcl_SetHashValue(hPtr, (ClientData) i);
		}
	    }
	    opTableInitialized = 1;
	}
	Tcl_MutexUnlock(&opMutex);
    }

    /*
     * Initialize the structure containing information abvout this expression
     * compilation.
     */

    info.interp = interp;
    info.parsePtr = &parse;
    info.expr = script;
    info.lastChar = (script + numBytes);
    info.hasOperators = 0;

    /*
     * Parse the expression then compile it.
     */

    code = TclParseExpr(interp, script, numBytes,
	    /* useInternalTokens */ 1, &parse);
    if (code != TCL_OK) {
	goto done;
    }

    code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
    if (code != TCL_OK) {
	goto done;
    }

    if (!info.hasOperators) {
	/*
	 * Attempt to convert the primary's object to an int or double.  This
	 * is done in order to support Tcl's policy of interpreting operands
	 * if at all possible as first integers, else floating-point numbers.
	 */

	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }

    done:
    Tcl_FreeParse(&parse);

    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeCompilation --
 *

 * CompileSubExpr --
 *
 *	Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
 *	subexpression, this procedure emits instructions to evaluate the
 *	subexpression at runtime.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the subexpression.
 *
 *----------------------------------------------------------------------
 */

static int
CompileSubExpr(

    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token to
				 * compile. */
    ExprInfo *infoPtr,		/* Describes the compilation state for the
				 * expression being compiled. */


    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Interp *interp = infoPtr->interp;
    Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */
    Tcl_Token *afterSubexprPtr;
    OperatorDesc *opDescPtr;
    Tcl_HashEntry *hPtr;
    CONST char *operator;
    Tcl_DString opBuf;
    int objIndex, opIndex, length, code;
    char buffer[TCL_UTF_MAX];

    if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
	Tcl_Panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR",
		exprTokenPtr->type);
    }
    code = TCL_OK;

    /*
     * Switch on the type of the first token after the subexpression token.
     * After processing it, advance tokenPtr to point just after the
     * subexpression's last token.
     */

    tokenPtr = exprTokenPtr+1;
    TRACE(exprTokenPtr->start, exprTokenPtr->size,
	    tokenPtr->start, tokenPtr->size);
    switch (tokenPtr->type) {
    case TCL_TOKEN_WORD:
	TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr);
	tokenPtr += (tokenPtr->numComponents + 1);
	break;

    case TCL_TOKEN_TEXT:
	if (tokenPtr->size > 0) {
	    objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
		    tokenPtr->size);
	} else {
	    objIndex = TclRegisterNewLiteral(envPtr, "", 0);
	}
	TclEmitPush(objIndex, envPtr);
	tokenPtr += 1;
	break;
 
    case TCL_TOKEN_BS:

	length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer);
	if (length > 0) {
	    objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
	} else {
	    objIndex = TclRegisterNewLiteral(envPtr, "", 0);
	}
	TclEmitPush(objIndex, envPtr);
	tokenPtr += 1;
	break;

    case TCL_TOKEN_COMMAND:
	TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr);
	tokenPtr += 1;
	break;

    case TCL_TOKEN_SCRIPT_SUBST: {
	Tcl_Token *lastTokenPtr = tokenPtr + (tokenPtr->numComponents);
	TclCompileScriptTokens(interp, tokenPtr+1, lastTokenPtr, envPtr);
	tokenPtr += (tokenPtr->numComponents + 1);
	break;
    }

    case TCL_TOKEN_VARIABLE:
	TclCompileTokens(interp, tokenPtr, 1, envPtr);
	tokenPtr += (tokenPtr->numComponents + 1);
	break;

    case TCL_TOKEN_SUB_EXPR:
	code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	if (code != TCL_OK) {
	    goto done;
	}
	tokenPtr += (tokenPtr->numComponents + 1);
	break;

    case TCL_TOKEN_OPERATOR:
	/*
	 * Look up the operator.  If the operator isn't found, treat it as a
	 * math function.
	 */






	Tcl_DStringInit(&opBuf);
	operator = Tcl_DStringAppend(&opBuf, tokenPtr->start, tokenPtr->size);
	hPtr = Tcl_FindHashEntry(&opHashTable, operator);
	if (hPtr == NULL) {
	    code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr,
		    &endPtr);
	    Tcl_DStringFree(&opBuf);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr = endPtr;
	    break;
	}
	Tcl_DStringFree(&opBuf);
	opIndex = (int) Tcl_GetHashValue(hPtr);
	opDescPtr = &(operatorTable[opIndex]);

	/*
	 * If the operator is "normal", compile it using information from the
	 * operator table.
	 */

	if (opDescPtr->numOperands > 0) {
	    tokenPtr++;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);

	    if (opDescPtr->numOperands == 2) {
		code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
		if (code != TCL_OK) {
		    goto done;
		}
		tokenPtr += (tokenPtr->numComponents + 1);
	    }
	    TclEmitOpcode(opDescPtr->instruction, envPtr);
	    infoPtr->hasOperators = 1;
	    break;
	}
	    
	/*
	 * The operator requires special treatment, and is either * "+" or "-",
	 * or one of "&&", "||" or "?".
	 */

	switch (opIndex) {
        case OP_PLUS:
        case OP_MINUS:


	    tokenPtr++;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);

	    /*
	     * Check whether the "+" or "-" is unary.
	     */

	    afterSubexprPtr = exprTokenPtr + exprTokenPtr->numComponents+1;
	    if (tokenPtr == afterSubexprPtr) {
		TclEmitOpcode(((opIndex==OP_PLUS)?  INST_UPLUS : INST_UMINUS),
			envPtr);
		break;
	    }

	    /*
	     * The "+" or "-" is binary.
	     */

	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	    TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), envPtr);

	    break;


        case OP_LAND:
        case OP_LOR:
	    code = CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr,
		    &endPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr = endPtr;
	    break;

        case OP_QUESTY:
	    code = CompileCondExpr(exprTokenPtr, infoPtr, envPtr, &endPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr = endPtr;
	    break;

	default:
	    Tcl_Panic("CompileSubExpr: unexpected operator %d requiring special treatment",
		    opIndex);
	} /* end switch on operator requiring special treatment */
	infoPtr->hasOperators = 1;
	break;

    default:
	Tcl_Panic("CompileSubExpr: unexpected token type %d",
		tokenPtr->type);
    }

    /*
     * Verify that the subexpression token had the required number of
     * subtokens: that we've advanced tokenPtr just beyond the subexpression's
     * last token. For example, a "*" subexpression must contain the tokens
     * for exactly two operands.
     */

    if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
	LogSyntaxError(infoPtr);
	code = TCL_ERROR;

    }

  done:
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileLandOrLorExpr --
 *
 *	This procedure compiles a Tcl logical and ("&&") or logical or ("||")
 *	subexpression.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileLandOrLorExpr(

    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the "&&" or "||" operator. */
    int opIndex,		/* A code describing the expression operator:
				 * either OP_LAND or OP_LOR. */
    ExprInfo *infoPtr,		/* Describes the compilation state for the
				 * expression being compiled. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    Tcl_Token **endPtrPtr)	/* If successful, a pointer to the token just
				 * after the last token in the subexpression
				 * is stored here. */
{
    JumpFixup shortCircuitFixup;/* Used to fix up the short circuit jump after
				 * the first subexpression. */
    JumpFixup shortCircuitFixup2;
				/* Used to fix up the second jump to the
				 * short-circuit target. */
    JumpFixup endFixup;		/* Used to fix up jump to the end. */
    Tcl_Token *tokenPtr;
    int code;
    int savedStackDepth = envPtr->currStackDepth;


    /*
     * Emit code for the first operand.
     */

    tokenPtr = exprTokenPtr+2;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit the short-circuit jump.
     */

    TclEmitForwardJump(envPtr,
	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
	    &shortCircuitFixup);

    /*
     * Emit code for the second operand.
     */

    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * The result is the boolean value of the second operand. We code this in
     * a somewhat contorted manner to be able to reuse the shortCircuit value
     * and save one INST_JUMP.
     */

    if (opIndex == OP_LAND) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
    } else {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
    }

    TclFixupForwardJumpToHere(envPtr, &endFixup, 127);
    *endPtrPtr = tokenPtr;

  done:
    envPtr->currStackDepth = savedStackDepth + 1;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileCondExpr --
 *
 *	This procedure compiles a Tcl conditional expression:
 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileCondExpr(

    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the "?" operator. */
    ExprInfo *infoPtr,		/* Describes the compilation state for the
				 * expression being compiled. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    Tcl_Token **endPtrPtr)	/* If successful, a pointer to the token just
				 * after the last token in the subexpression
				 * is stored here. */
{
    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
				/* Used to update or replace one-byte jumps
				 * around the then and else expressions when
				 * their target PCs are determined. */
    Tcl_Token *tokenPtr;
    int elseCodeOffset, dist, code;

    int savedStackDepth = envPtr->currStackDepth;

    /*
     * Emit code for the test.
     */

    tokenPtr = exprTokenPtr+2;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit the jump to the "else" expression if the test was false.
     */

    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);

    /*
     * Compile the "then" expression. Note that if a subexpression is only a
     * primary, we need to try to convert it to numeric. We do this to support
     * Tcl's policy of interpreting operands if at all possible as first
     * integers, else floating-point numbers.
     */

    infoPtr->hasOperators = 0;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);
    if (!infoPtr->hasOperators) {
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }

    /*
     * Emit an unconditional jump around the "else" condExpr.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpAroundElseFixup);

    /*
     * Compile the "else" expression.
     */

    envPtr->currStackDepth = savedStackDepth;
    elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
    infoPtr->hasOperators = 0;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);
    if (!infoPtr->hasOperators) {
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }

    /*
     * Fix up the second jump around the "else" expression.
     */

    dist = (envPtr->codeNext - envPtr->codeStart)
	    - jumpAroundElseFixup.codeOffset;

    /*
     * Fix up the first jump to the "else" expression if the test was false.
     */

    dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
    TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
    *endPtrPtr = tokenPtr;

  done:
    envPtr->currStackDepth = savedStackDepth + 1;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMathFuncCall --
 *
 *	This procedure compiles a call on a math function in an expression:
 *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the math function at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileMathFuncCall(

    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the math function call. */
    CONST char *funcName,	/* Name of the math function. */
    ExprInfo *infoPtr,		/* Describes the compilation state for the
				 * expression being compiled. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    Tcl_Token **endPtrPtr)	/* If successful, a pointer to the token just
				 * after the last token in the subexpression
				 * is stored here. */
{
    Tcl_DString cmdName;
    int objIndex;
    Tcl_Token *tokenPtr, *afterSubexprPtr;
    int argCount;
    int code = TCL_OK;

    /*
     * Prepend "tcl::mathfunc::" to the function name, to produce the name of
     * a command that evaluates the function.  Push that command name on the
     * stack, in a literal registered to the namespace so that resolution can
     * be cached.
     */

     * Compile any arguments for the function.
     */

    argCount = 1;
    tokenPtr = exprTokenPtr+2;
    afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
    while (tokenPtr != afterSubexprPtr) {

	++argCount;
	code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	if (code != TCL_OK) {
	    return code;
	}
	tokenPtr += (tokenPtr->numComponents + 1);
    }

    /* Invoke the function */

    if (argCount < 255) {
	TclEmitInstInt1(INST_INVOKE_STK1, argCount, envPtr);
    } else {
	TclEmitInstInt4(INST_INVOKE_STK4, argCount, envPtr);
    }

    *endPtrPtr = afterSubexprPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LogSyntaxError --
 *
 *	This procedure is invoked after an error occurs when compiling an
 *	expression. It sets the interpreter result to an error message
 *	describing the error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the interpreter result to an error message describing the
 *	expression that was being compiled when the error occurred.
 *
 *----------------------------------------------------------------------
 */

static void
LogSyntaxError(
    ExprInfo *infoPtr)		/* Describes the compilation state for the
				 * expression being compiled. */
{
    Tcl_Obj *result =
	    Tcl_NewStringObj("syntax error in expression \"", -1);

    TclAppendLimitedToObj(result, infoPtr->expr,
	    (int)(infoPtr->lastChar - infoPtr->expr), 60, "");
    Tcl_AppendToObj(result, "\"", -1);
    Tcl_SetObjResult(infoPtr->interp, result);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 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: tclFileName.c,v 1.41.2.18 2006/04/28 16:09:09 dgp Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclFileSystem.h" /* For TclGetPathType() */

/*

     * error messsages.
     */

    savedResultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(savedResultObj);
    Tcl_ResetResult(interp);
    TclNewObj(filenamesObj);


    /*
     * Now we do the actual globbing, adding filenames as we go to buffer in
     * filenamesObj
     */

    if (*tail == '\0' && pathPrefix != NULL) {

	/*
	 * We do the recursion ourselves. This makes implementing
	 * Tcl_FSMatchInDirectory for each filesystem much easier.
	 */

	*p = '\0';
	TclNewObj(subdirsPtr);

	result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
		pattern, &dirOnly);
	*p = save;
	if (result == TCL_OK) {
	    int subdirc, i;
	    Tcl_Obj **subdirv;

/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API at the
 *	script level. Contributed by Andreas Kupries.
 *
 * Copyright (c) 2000 Ajuba Solutions
 * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * CVS: $Id: tclIOGT.c,v 1.7.4.7 2006/04/28 16:09:11 dgp Exp $
 */

#include "tclInt.h"
#include "tclIO.h"

/*
 * Forward declarations of internal procedures. First the driver procedures of

     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occured and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_GlobalEvalObj(dataPtr->interp, command);
    Tcl_DecrRefCount(command);
    command = NULL;

    if ((res != TCL_OK) && (interp != NULL) &&
	    (dataPtr->interp != interp) && !preserve) {
        Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
	return res;

/*
 * tclParseExpr.c --
 *
 *	This file contains functions that parse Tcl expressions. They do so in
 *	a general-purpose fashion that can be used for many different
 *	purposes, including compilation, direct execution, code analysis, etc.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclParseExpr.c,v 1.17.4.17 2006/08/29 16:19:30 dgp Exp $
 */

#define OLD_EXPR_PARSER 0
#if OLD_EXPR_PARSER

#include "tclInt.h"

/*
 * Boolean variable that controls whether expression parse tracing is enabled.
 */

#ifdef TCL_COMPILE_DEBUG
static int traceParseExpr = 0;
#endif /* TCL_COMPILE_DEBUG */

/*
 * The ParseInfo structure holds state while parsing an expression. A pointer
 * to an ParseInfo record is passed among the routines in this module.
 */

typedef struct ParseInfo {
    Tcl_Parse *parsePtr;	/* Points to structure to fill in with
				 * information about the expression. */
    int lexeme;			/* Type of last lexeme scanned in expr.  See
				 * below for definitions. Corresponds to size
				 * characters beginning at start. */
    CONST char *start;		/* First character in lexeme. */
    int size;			/* Number of bytes in lexeme. */
    CONST char *next;		/* Position of the next character to be
				 * scanned in the expression string. */
    CONST char *prevEnd;	/* Points to the character just after the last
				 * one in the previous lexeme. Used to compute
				 * size of subexpression tokens. */
    CONST char *originalExpr;	/* Points to the start of the expression
				 * originally passed to Tcl_ParseExpr. */
    CONST char *lastChar;	/* Points just after last byte of expr. */
    int useInternalTokens;	/* Boolean indicating whether internal
				 * token types are acceptable */
} ParseInfo;

/*
 * Definitions of the different lexemes that appear in expressions. The order
 * of these must match the corresponding entries in the operatorStrings array
 * below.
 *
 * Basic lexemes:
 */

#define LITERAL		0
#define FUNC_NAME	1
#define OPEN_BRACKET	2
#define OPEN_BRACE	3
#define OPEN_PAREN	4
#define CLOSE_PAREN	5
#define DOLLAR		6
#define QUOTE		7
#define COMMA		8
#define END		9
#define UNKNOWN		10
#define UNKNOWN_CHAR	11

/*
 * Binary numeric operators:
 */

#define MULT		12
#define DIVIDE		13
#define MOD		14
#define PLUS		15
#define MINUS		16
#define LEFT_SHIFT	17
#define RIGHT_SHIFT	18
#define LESS		19
#define GREATER		20
#define LEQ		21
#define GEQ		22
#define EQUAL		23
#define NEQ		24
#define BIT_AND		25
#define BIT_XOR		26
#define BIT_OR		27
#define AND		28
#define OR		29
#define QUESTY		30
#define COLON		31

/*
 * Unary operators. Unary minus and plus are represented by the (binary)
 * lexemes MINUS and PLUS.
 */

#define NOT		32
#define BIT_NOT		33

/*
 * Binary string operators:
 */

#define STREQ		34
#define STRNEQ		35

/*
 * Exponentiation operator:
 */

#define EXPON		36

/*
 * List containment operators
 */

#define IN_LIST		37
#define NOT_IN_LIST	38

/*
 * Mapping from lexemes to strings; used for debugging messages. These entries
 * must match the order and number of the lexeme definitions above.
 */

static char *lexemeStrings[] = {
    "LITERAL", "FUNCNAME",
    "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
    "*", "/", "%", "+", "-",
    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
    "&", "^", "|", "&&", "||", "?", ":",
    "!", "~", "eq", "ne", "**", "in", "ni"
};

/*
 * Declarations for local functions to this file:
 */

static int		GetLexeme(ParseInfo *infoPtr);
static void		LogSyntaxError(ParseInfo *infoPtr,
			    CONST char *extraInfo);
static int		ParseAddExpr(ParseInfo *infoPtr);
static int		ParseBitAndExpr(ParseInfo *infoPtr);
static int		ParseBitOrExpr(ParseInfo *infoPtr);
static int		ParseBitXorExpr(ParseInfo *infoPtr);
static int		ParseCondExpr(ParseInfo *infoPtr);
static int		ParseEqualityExpr(ParseInfo *infoPtr);
static int		ParseLandExpr(ParseInfo *infoPtr);
static int		ParseLorExpr(ParseInfo *infoPtr);
static int		ParseMultiplyExpr(ParseInfo *infoPtr);
static int		ParsePrimaryExpr(ParseInfo *infoPtr);
static int		ParseRelationalExpr(ParseInfo *infoPtr);
static int		ParseShiftExpr(ParseInfo *infoPtr);
static int		ParseExponentialExpr(ParseInfo *infoPtr);
static int		ParseUnaryExpr(ParseInfo *infoPtr);
static void		PrependSubExprTokens(CONST char *op, int opBytes,
			    CONST char *src, int srcBytes, int firstIndex,
			    ParseInfo *infoPtr);

/*
 * Macro used to debug the execution of the recursive descent parser used to
 * parse expressions.
 */

#ifdef TCL_COMPILE_DEBUG
#define HERE(production, level) \
    if (traceParseExpr) { \
	fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
		(level), " ", (production), \
		lexemeStrings[infoPtr->lexeme], infoPtr->next); \
    }
#else
#define HERE(production, level)
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseExpr --
 *
 *	Given a string, this function parses the first Tcl expression in the
 *	string and returns information about the structure of the expression.
 *	This function is the top-level interface to the the expression parsing
 *	module. No more than numBytes bytes will be scanned.
 *
 *	Note that this parser is a LL(1) parser; the operator precedence rules
 *	are completely hard coded in the recursive structure of the parser
 *	itself.
 *
 * Results:
 *	The return value is TCL_OK if the command was parsed successfully and
 *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
 *	error message is left in its result. On a successful return, parsePtr
 *	is filled in with information about the expression that was parsed.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the expression, then additional space is malloc-ed. If the
 *	function returns TCL_OK then the caller must eventually invoke
 *	Tcl_FreeParse to release any additional space that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    CONST char *start,		/* Start of source string to parse. */
    int numBytes,		/* Number of bytes in string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code = TclParseExpr(interp, start, numBytes, 0, parsePtr);
    if (code == TCL_ERROR) {
	Tcl_FreeParse(parsePtr);
    }
    return code;
}

int
TclParseExpr(interp, start, numBytes, useInternalTokens, parsePtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    CONST char *start;		/* The source string to parse. */
    int numBytes;		/* Number of bytes in string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int useInternalTokens;	/* Boolean indicating whether internal
				 * token types are acceptable */
    Tcl_Parse *parsePtr;	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is
				 * ignored. */
{
    ParseInfo info;
    int code;

    if (numBytes < 0) {
	numBytes = (start? strlen(start) : 0);
    }
#ifdef TCL_COMPILE_DEBUG
    if (traceParseExpr) {
	fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
		numBytes, start);
    }
#endif /* TCL_COMPILE_DEBUG */

    TclParseInit(interp, start, numBytes, parsePtr);

    /*
     * Initialize the ParseInfo structure that holds state while parsing the
     * expression.
     */

    info.parsePtr = parsePtr;
    info.lexeme = UNKNOWN;
    info.start = NULL;
    info.size = 0;
    info.next = start;
    info.prevEnd = start;
    info.originalExpr = start;
    info.lastChar = (start + numBytes); /* just after last char of expr */
    info.useInternalTokens = useInternalTokens;

    /*
     * Get the first lexeme then parse the expression.
     */

    code = GetLexeme(&info);
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    code = ParseCondExpr(&info);
    /*
    if (useInternalTokens && (code == TCL_ERROR)
	    && (parsePtr->tokenPtr[parsePtr->numTokens - 1].type
	    == TCL_TOKEN_ERROR)) {
	return TCL_OK;
    }
    */
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    if (info.lexeme != END) {
	LogSyntaxError(&info, "extra tokens at end of expression");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseCondExpr --
 *
 *	This function parses a Tcl conditional expression:
 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
 *
 *	Note that this is the topmost recursive-descent parsing routine used
 *	by Tcl_ParseExpr to parse expressions. This avoids an extra function
 *	call since such a function would only return the result of calling
 *	ParseCondExpr. Other recursive-descent functions that need to parse
 *	complete expressions also call ParseCondExpr.
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseCondExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
    int firstIndex, numToMove, code;
    CONST char *srcStart;

    HERE("condExpr", 1);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseLorExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    if (infoPtr->lexeme == QUESTY) {
	/*
	 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
	 * conditional expression, and a TCL_TOKEN_OPERATOR token for the "?"
	 * operator. Note that these two tokens must be inserted before the
	 * LOR operand tokens generated above.
	 */

	TclGrowParseTokenArray(parsePtr,2);
	firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
	tokenPtr = (firstTokenPtr + 2);
	numToMove = (parsePtr->numTokens - firstIndex);
	memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
		(size_t) (numToMove * sizeof(Tcl_Token)));
	parsePtr->numTokens += 2;

	tokenPtr = firstTokenPtr;
	tokenPtr->type = TCL_TOKEN_SUB_EXPR;
	tokenPtr->start = srcStart;

	tokenPtr++;
	tokenPtr->type = TCL_TOKEN_OPERATOR;
	tokenPtr->start = infoPtr->start;
	tokenPtr->size = 1;
	tokenPtr->numComponents = 0;

	/*
	 * Skip over the '?'.
	 */

	code = GetLexeme(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Parse the "then" expression.
	 */

	code = ParseCondExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	if (infoPtr->lexeme != COLON) {
	    LogSyntaxError(infoPtr, "missing colon from ternary conditional");
	    return TCL_ERROR;
	}
	code = GetLexeme(infoPtr); /* skip over the ':' */
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Parse the "else" expression.
	 */

	code = ParseCondExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Now set the size-related fields in the '?' subexpression token.
	 */

	condTokenPtr = &parsePtr->tokenPtr[firstIndex];
	condTokenPtr->size = (infoPtr->prevEnd - srcStart);
	condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLorExpr --
 *
 *	This function parses a Tcl logical or expression:
 *	lorExpr ::= landExpr {'||' landExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseLorExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("lorExpr", 2);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseLandExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    while (infoPtr->lexeme == OR) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '||' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseLandExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the LOR subexpression and the '||' operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLandExpr --
 *
 *	This function parses a Tcl logical and expression:
 *	landExpr ::= bitOrExpr {'&&' bitOrExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseLandExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("landExpr", 3);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseBitOrExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    while (infoPtr->lexeme == AND) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '&&' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseBitOrExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the LAND subexpression and the '&&' operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitOrExpr --
 *
 *	This function parses a Tcl bitwise or expression:
 *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitOrExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitOrExpr", 4);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseBitXorExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    while (infoPtr->lexeme == BIT_OR) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '|' */
	if (code != TCL_OK) {
	    return code;
	}

	code = ParseBitXorExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the BITOR subexpression and the '|' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitXorExpr --
 *
 *	This function parses a Tcl bitwise exclusive or expression:
 *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitXorExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitXorExpr", 5);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseBitAndExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    while (infoPtr->lexeme == BIT_XOR) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '^' */
	if (code != TCL_OK) {
	    return code;
	}

	code = ParseBitAndExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the XOR subexpression and the '^' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseBitAndExpr --
 *
 *	This function parses a Tcl bitwise and expression:
 *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseBitAndExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, code;
    CONST char *srcStart, *operator;

    HERE("bitAndExpr", 6);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseEqualityExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    while (infoPtr->lexeme == BIT_AND) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the '&' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseEqualityExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the BITAND subexpression and '&' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseEqualityExpr --
 *
 *	This function parses a Tcl equality (inequality) expression:
 *	equalityExpr ::= relationalExpr
 *		{('==' | '!=' | 'ne' | 'eq') relationalExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseEqualityExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("equalityExpr", 7);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseRelationalExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while (lexeme == EQUAL || lexeme == NEQ || lexeme == NOT_IN_LIST ||
	    lexeme == IN_LIST || lexeme == STREQ || lexeme == STRNEQ) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseRelationalExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
	 * operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseRelationalExpr --
 *
 *	This function parses a Tcl relational expression:
 *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseRelationalExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, operatorSize, code;
    CONST char *srcStart, *operator;

    HERE("relationalExpr", 8);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseShiftExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
	    || (lexeme == GEQ)) {
	operator = infoPtr->start;
	if ((lexeme == LEQ) || (lexeme == GEQ)) {
	    operatorSize = 2;
	} else {
	    operatorSize = 1;
	}
	code = GetLexeme(infoPtr); /* skip over the operator */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseShiftExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and the operator.
	 */

	PrependSubExprTokens(operator, operatorSize, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseShiftExpr --
 *
 *	This function parses a Tcl shift expression:
 *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseShiftExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("shiftExpr", 9);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseAddExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr);	/* skip over << or >> */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseAddExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '<<' or '>>' operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseAddExpr --
 *
 *	This function parses a Tcl addition expression:
 *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseAddExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("addExpr", 10);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseMultiplyExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == PLUS) || (lexeme == MINUS)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over + or - */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseMultiplyExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and '+' or '-' operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseMultiplyExpr --
 *
 *	This function parses a Tcl multiply expression:
 *	multiplyExpr ::= exponentialExpr {('*' | '/' | '%') exponentialExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseMultiplyExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("multiplyExpr", 11);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseExponentialExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr);	/* skip over * or / or % */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseExponentialExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and * or / or % operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseExponentialExpr --
 *
 *	This function parses a Tcl exponential expression:
 *	exponentialExpr ::= unaryExpr {'**' unaryExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseExponentialExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("exponentiateExpr", 12);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    code = ParseUnaryExpr(infoPtr);
    if (code != TCL_OK) {
	return code;
    }

    lexeme = infoPtr->lexeme;
    while (lexeme == EXPON) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr);	/* skip over ** */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseUnaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and ** operator.
	 */

	PrependSubExprTokens(operator, 2, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
	lexeme = infoPtr->lexeme;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseUnaryExpr --
 *
 *	This function parses a Tcl unary expression:
 *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseUnaryExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    int firstIndex, lexeme, code;
    CONST char *srcStart, *operator;

    HERE("unaryExpr", 13);
    srcStart = infoPtr->start;
    firstIndex = parsePtr->numTokens;

    lexeme = infoPtr->lexeme;
    if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
	    || (lexeme == NOT)) {
	operator = infoPtr->start;
	code = GetLexeme(infoPtr); /* skip over the unary operator */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseUnaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Generate tokens for the subexpression and the operator.
	 */

	PrependSubExprTokens(operator, 1, srcStart,
		(infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
    } else {			/* must be a primaryExpr */
	code = ParsePrimaryExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParsePrimaryExpr --
 *
 *	This function parses a Tcl primary expression:
 *	primaryExpr ::= literal | varReference | quotedString |
 *		'[' command ']' | mathFuncCall | '(' condExpr ')'
 *
 * Results:
 *	The return value is TCL_OK on a successful parse and TCL_ERROR on
 *	failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static int
ParsePrimaryExpr(
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Interp *interp = parsePtr->interp;
    Tcl_Token *tokenPtr, *exprTokenPtr;
    Tcl_Parse nested;
    CONST char *dollarPtr, *stringStart, *termPtr, *src;
    int lexeme, exprIndex, firstIndex, numToMove, code;

    /*
     * We simply recurse on parenthesized subexpressions.
     */

    HERE("primaryExpr", 14);
    lexeme = infoPtr->lexeme;
    if (lexeme == OPEN_PAREN) {
	code = GetLexeme(infoPtr); /* skip over the '(' */
	if (code != TCL_OK) {
	    return code;
	}
	code = ParseCondExpr(infoPtr);
	if (code != TCL_OK) {
	    return code;
	}
	if (infoPtr->lexeme != CLOSE_PAREN) {
	    LogSyntaxError(infoPtr, "looking for close parenthesis");
	    return TCL_ERROR;
	}
	code = GetLexeme(infoPtr); /* skip over the ')' */
	if (code != TCL_OK) {
	    return code;
	}
	return TCL_OK;
    }

    /*
     * Start a TCL_TOKEN_SUB_EXPR token for the primary.
     */

    TclGrowParseTokenArray(parsePtr,1);
    exprIndex = parsePtr->numTokens;
    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
    exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
    exprTokenPtr->start = infoPtr->start;
    parsePtr->numTokens++;

    /*
     * Process the primary then finish setting the fields of the
     * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now stored
     * in "exprTokenPtr" in the code below since the token array might be
     * reallocated.
     */

    firstIndex = parsePtr->numTokens;
    switch (lexeme) {
    case LITERAL:
	/*
	 * Int or double number.
	 */
	
    tokenizeLiteral:
	TclGrowParseTokenArray(parsePtr,1);
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_TEXT;
	tokenPtr->start = infoPtr->start;
	tokenPtr->size = infoPtr->size;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = infoPtr->size;
	exprTokenPtr->numComponents = 1;
	break;

    case DOLLAR:
	/*
	 * $var variable reference.
	 */

	dollarPtr = (infoPtr->next - 1);
	code = Tcl_ParseVarName(interp, dollarPtr,
		(infoPtr->lastChar - dollarPtr), parsePtr, 1);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
	exprTokenPtr->numComponents =
		(parsePtr->tokenPtr[firstIndex].numComponents + 1);
	break;

    case QUOTE:
	/*
	 * '"' string '"'
	 */

	stringStart = infoPtr->next;
	code = Tcl_ParseQuotedString(interp, infoPtr->start,
		(infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = termPtr;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (termPtr - exprTokenPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

	/*
	 * If parsing the quoted string resulted in more than one token,
	 * insert a TCL_TOKEN_WORD token before them. This indicates that the
	 * quoted string represents a concatenation of multiple tokens.
	 */

	if (exprTokenPtr->numComponents > 1) {
	    TclGrowParseTokenArray(parsePtr,1);
	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
	    numToMove = (parsePtr->numTokens - firstIndex);
	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
		    (size_t) (numToMove * sizeof(Tcl_Token)));
	    parsePtr->numTokens++;

	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	    exprTokenPtr->numComponents++;

	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = exprTokenPtr->start;
	    tokenPtr->size = exprTokenPtr->size;
	    tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
	}
	break;

    case OPEN_BRACKET:
	/*
	 * '[' command {command} ']'
	 */

	/*
	 * Call TclParseScript, or Tcl_ParseCommand repeatedly, to parse
	 * the nested command(s).  If internal tokens are acceptable, keep
	 * all the parsing info; otherwise, throw it away.
	 */
	
	src = infoPtr->next;
	if (infoPtr->useInternalTokens) {
	    CONST char *term;
	    Tcl_Token *lastTokenPtr;
	    Tcl_Token *appendTokens = TclParseScript(src,
		    (int) (parsePtr->end - src), PARSE_NESTED,
		    &lastTokenPtr, &term);
	    int numTokens = 1 + (int) (lastTokenPtr - appendTokens);

	    TclGrowParseTokenArray(parsePtr,numTokens+1);
	    tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	    tokenPtr->type = TCL_TOKEN_SCRIPT_SUBST;
	    tokenPtr->size = term - src + 2;
	    tokenPtr->numComponents = numTokens;

	    memcpy(tokenPtr+1, appendTokens,
		    (size_t) (numTokens * sizeof(Tcl_Token)));
	    parsePtr->numTokens += (numTokens + 1);
	    lastTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens - 1;
	    ckfree((char *) appendTokens);

	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	    exprTokenPtr->size = (src - tokenPtr->start);
	    exprTokenPtr->numComponents = 1 + numTokens;

	    if (lastTokenPtr->type == TCL_TOKEN_ERROR) {
		parsePtr->errorType = lastTokenPtr->numComponents;
		parsePtr->term = term;
		parsePtr->incomplete = 1;
		infoPtr->next = parsePtr->end;
		if (interp != NULL) {
		    TclSubstTokens(interp, lastTokenPtr, 1, NULL, 0);
		}
		return TCL_ERROR;
	    } else {
		infoPtr->next = term + 1;
	    }
	    break;
	}

	TclGrowParseTokenArray(parsePtr,1);
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_COMMAND;
	tokenPtr->start = infoPtr->start;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;

	while (1) {
	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
		    &nested) != TCL_OK) {
		parsePtr->term = nested.term;
		parsePtr->errorType = nested.errorType;
		parsePtr->incomplete = nested.incomplete;
		return TCL_ERROR;
	    }
	    src = (nested.commandStart + nested.commandSize);

	    /*
	     * This is equivalent to Tcl_FreeParse(&nested), but presumably
	     * inlined here for sake of runtime optimization
	     */

	    if (nested.tokenPtr != nested.staticTokens) {
		ckfree((char *) nested.tokenPtr);
	    }

	    /*
	     * Check for the closing ']' that ends the command substitution.
	     * It must have been the last character of the parsed command.
	     */

	    if ((nested.term < parsePtr->end) && (*nested.term == ']')
		    && !nested.incomplete) {
		break;
	    }
	    if (src == parsePtr->end) {
		if (parsePtr->interp != NULL) {
		    Tcl_SetResult(interp, "missing close-bracket",
			    TCL_STATIC);
		}
		parsePtr->term = tokenPtr->start;
		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
		parsePtr->incomplete = 1;
		return TCL_ERROR;
	    }
	}
	tokenPtr->size = (src - tokenPtr->start);
	infoPtr->next = src;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (src - tokenPtr->start);
	exprTokenPtr->numComponents = 1;
	break;

    case OPEN_BRACE:
	/*
	 * '{' string '}'
	 */

	code = Tcl_ParseBraces(interp, infoPtr->start,
		(infoPtr->lastChar - infoPtr->start), parsePtr, 1, &termPtr);
	if (code != TCL_OK) {
	    return code;
	}
	infoPtr->next = termPtr;

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (termPtr - infoPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

	/*
	 * If parsing the braced string resulted in more than one token,
	 * insert a TCL_TOKEN_WORD token before them. This indicates that the
	 * braced string represents a concatenation of multiple tokens.
	 */

	if (exprTokenPtr->numComponents > 1) {
	    TclGrowParseTokenArray(parsePtr,1);
	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
	    numToMove = (parsePtr->numTokens - firstIndex);
	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
		    (size_t) (numToMove * sizeof(Tcl_Token)));
	    parsePtr->numTokens++;

	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	    exprTokenPtr->numComponents++;

	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = exprTokenPtr->start;
	    tokenPtr->size = exprTokenPtr->size;
	    tokenPtr->numComponents = exprTokenPtr->numComponents-1;
	}
	break;

    case STREQ:
    case STRNEQ:
    case IN_LIST:
    case NOT_IN_LIST:
    case FUNC_NAME: {
	/*
	 * math_func '(' expr {',' expr} ')'
	 */
	ParseInfo savedInfo = *infoPtr;

	code = GetLexeme(infoPtr);	/* skip over function name */
	if (code != TCL_OK) {
	    return code;
	}
	if (infoPtr->lexeme != OPEN_PAREN) {

	    int code;
	    Tcl_Obj *errMsg, *objPtr =
		    Tcl_NewStringObj(savedInfo.start, savedInfo.size);

	    /*
	     * Check for boolean literals (true, false, yes, no, on, off).
	     */

	    Tcl_IncrRefCount(objPtr);
	    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
	    Tcl_DecrRefCount(objPtr);
	    if (code == TCL_OK) {
		*infoPtr = savedInfo;
		goto tokenizeLiteral;
	    }

	    /*
	     * Either there's a math function without a (, or a variable name
	     * without a '$'.
	     */

	    errMsg = Tcl_NewStringObj( "syntax error in expression \"", -1 );
	    TclAppendLimitedToObj(errMsg, infoPtr->originalExpr,
		    (int) (infoPtr->lastChar - infoPtr->originalExpr),
		    63, NULL);
	    Tcl_AppendToObj(errMsg, "\": the word \"", -1);
	    Tcl_AppendToObj(errMsg, savedInfo.start, savedInfo.size);
	    Tcl_AppendToObj(errMsg,
		    "\" requires a preceding $ if it's a variable ", -1);
	    Tcl_AppendToObj(errMsg,
		    "or function arguments if it's a function", -1);
	    Tcl_SetObjResult(infoPtr->parsePtr->interp, errMsg);
	    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
	    infoPtr->parsePtr->term = infoPtr->start;
	    return TCL_ERROR;

	}

	TclGrowParseTokenArray(parsePtr,1);
	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
	tokenPtr->type = TCL_TOKEN_OPERATOR;
	tokenPtr->start = savedInfo.start;
	tokenPtr->size = savedInfo.size;
	tokenPtr->numComponents = 0;
	parsePtr->numTokens++;

	code = GetLexeme(infoPtr);	/* skip over '(' */
	if (code != TCL_OK) {
	    return code;
	}

	while (infoPtr->lexeme != CLOSE_PAREN) {
	    code = ParseCondExpr(infoPtr);
	    if (code != TCL_OK) {
		return code;
	    }

	    if (infoPtr->lexeme == COMMA) {
		code = GetLexeme(infoPtr); /* skip over , */
		if (code != TCL_OK) {
		    return code;
		}
	    } else if (infoPtr->lexeme != CLOSE_PAREN) {
		LogSyntaxError(infoPtr,
			"missing close parenthesis at end of function call");
		return TCL_ERROR;
	    }
	}

	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
	exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
	break;
    }

    case COMMA:
	LogSyntaxError(infoPtr,
		"commas can only separate function arguments");
	return TCL_ERROR;
    case END:
	LogSyntaxError(infoPtr, "premature end of expression");
	return TCL_ERROR;
    case UNKNOWN:
	LogSyntaxError(infoPtr,
		"single equality character not legal in expressions");
	return TCL_ERROR;
    case UNKNOWN_CHAR:
	LogSyntaxError(infoPtr, "character not legal in expressions");
	return TCL_ERROR;
    case QUESTY:
	LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
	return TCL_ERROR;
    case COLON:
	LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
	return TCL_ERROR;
    case CLOSE_PAREN:
	LogSyntaxError(infoPtr, "unexpected close parenthesis");
	return TCL_ERROR;

    default:
	{
	    char buf[64];

	    sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
	    LogSyntaxError(infoPtr, buf);
	    return TCL_ERROR;
	}
    }

    /*
     * Advance to the next lexeme before returning.
     */

    code = GetLexeme(infoPtr);
    if (code != TCL_OK) {
	return code;
    }
    parsePtr->term = infoPtr->next;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetLexeme --
 *
 *	Lexical scanner for Tcl expressions: scans a single operator or other
 *	syntactic element from an expression string.
 *
 * Results:
 *	TCL_OK is returned unless an error occurred. In that case a standard
 *	Tcl error code is returned and, if infoPtr->parsePtr->interp is
 *	non-NULL, the interpreter's result is set to hold an error message.
 *	TCL_ERROR is returned if an integer overflow, or a floating-point
 *	overflow or underflow occurred while reading in a number. If the
 *	lexical analysis is successful, infoPtr->lexeme refers to the next
 *	symbol in the expression string, and infoPtr->next is advanced past
 *	the lexeme. Also, if the lexeme is a LITERAL or FUNC_NAME, then
 *	infoPtr->start is set to the first character of the lexeme; otherwise
 *	it is set NULL.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold all the information
 *	about the subexpression, then additional space is malloc-ed..
 *
 *----------------------------------------------------------------------
 */

static int
GetLexeme(
    ParseInfo *infoPtr)		/* Holds state needed to parse the expr,
				 * including the resulting lexeme. */
{
    register CONST char *src;	/* Points to current source char. */
    char c;
    int offset, length, numBytes;
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_UniChar ch;

    /*
     * Record where the previous lexeme ended. Since we always read one lexeme
     * ahead during parsing, this helps us know the source length of
     * subexpression tokens.
     */

    infoPtr->prevEnd = infoPtr->next;

    /*
     * Scan over leading white space at the start of a lexeme.
     */

    src = infoPtr->next;
    numBytes = parsePtr->end - src;

    length = TclParseAllWhiteSpace(src, numBytes);
    src += length;
    numBytes -= length;

    parsePtr->term = src;
    if (numBytes == 0) {
	infoPtr->lexeme = END;
	infoPtr->next = src;
	return TCL_OK;
    }

    /*
     * Try to parse the lexeme first as an integer or floating-point number.
     * Don't check for a number if the first character c is "+" or "-". If we
     * did, we might treat a binary operator as unary by mistake, which would
     * eventually cause a syntax error.
     */

    c = *src;
    if ((c != '+') && (c != '-')) {
	CONST char *end = infoPtr->lastChar;
	CONST char* end2;
	int code = TclParseNumber(NULL, NULL, NULL, src, (int)(end-src),
		&end2, TCL_PARSE_NO_WHITESPACE);

	if (code == TCL_OK) {
	    length = end2-src;
	    if (length > 0) {
		infoPtr->lexeme = LITERAL;
		infoPtr->start = src;
		infoPtr->size = length;
		infoPtr->next = (src + length);
		parsePtr->term = infoPtr->next;
		return TCL_OK;
	    }
	}
    }

    /*
     * Not an integer or double literal. Initialize the lexeme's fields
     * assuming the common case of a single character lexeme.
     */

    infoPtr->start = src;
    infoPtr->size = 1;
    infoPtr->next = src+1;
    parsePtr->term = infoPtr->next;

    switch (*src) {
    case '[':
	infoPtr->lexeme = OPEN_BRACKET;
	return TCL_OK;

    case '{':
	infoPtr->lexeme = OPEN_BRACE;
	return TCL_OK;

    case '(':
	infoPtr->lexeme = OPEN_PAREN;
	return TCL_OK;

    case ')':
	infoPtr->lexeme = CLOSE_PAREN;
	return TCL_OK;

    case '$':
	infoPtr->lexeme = DOLLAR;
	return TCL_OK;

    case '\"':
	infoPtr->lexeme = QUOTE;
	return TCL_OK;

    case ',':
	infoPtr->lexeme = COMMA;
	return TCL_OK;

    case '*':
	infoPtr->lexeme = MULT;
	if ((infoPtr->lastChar - src)>1  &&  src[1]=='*') {
	    infoPtr->lexeme = EXPON;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	}
	return TCL_OK;

    case '/':
	infoPtr->lexeme = DIVIDE;
	return TCL_OK;

    case '%':
	infoPtr->lexeme = MOD;
	return TCL_OK;

    case '+':
	infoPtr->lexeme = PLUS;
	return TCL_OK;

    case '-':
	infoPtr->lexeme = MINUS;
	return TCL_OK;

    case '?':
	infoPtr->lexeme = QUESTY;
	return TCL_OK;

    case ':':
	infoPtr->lexeme = COLON;
	return TCL_OK;

    case '<':
	infoPtr->lexeme = LESS;
	if ((infoPtr->lastChar - src) > 1) {
	    switch (src[1]) {
	    case '<':
		infoPtr->lexeme = LEFT_SHIFT;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		break;
	    case '=':
		infoPtr->lexeme = LEQ;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		break;
	    }
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '>':
	infoPtr->lexeme = GREATER;
	if ((infoPtr->lastChar - src) > 1) {
	    switch (src[1]) {
	    case '>':
		infoPtr->lexeme = RIGHT_SHIFT;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		break;
	    case '=':
		infoPtr->lexeme = GEQ;
		infoPtr->size = 2;
		infoPtr->next = src+2;
		break;
	    }
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '=':
	infoPtr->lexeme = UNKNOWN;
	if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
	    infoPtr->lexeme = EQUAL;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '!':
	infoPtr->lexeme = NOT;
	if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
	    infoPtr->lexeme = NEQ;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '&':
	infoPtr->lexeme = BIT_AND;
	if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
	    infoPtr->lexeme = AND;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '^':
	infoPtr->lexeme = BIT_XOR;
	return TCL_OK;

    case '|':
	infoPtr->lexeme = BIT_OR;
	if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
	    infoPtr->lexeme = OR;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	}
	parsePtr->term = infoPtr->next;
	return TCL_OK;

    case '~':
	infoPtr->lexeme = BIT_NOT;
	return TCL_OK;

    case 'e':
	if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = STREQ;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else {
	    goto checkFuncName;
	}

    case 'n':
	if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = STRNEQ;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else if ((src[1] == 'i') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = NOT_IN_LIST;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else {
	    goto checkFuncName;
	}

    case 'i':
	if ((src[1] == 'n') && ((infoPtr->lastChar - src) > 1) &&
		(infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
	    infoPtr->lexeme = IN_LIST;
	    infoPtr->size = 2;
	    infoPtr->next = src+2;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	} else {
	    goto checkFuncName;
	}

    default:
    checkFuncName:
	length = (infoPtr->lastChar - src);
	if (Tcl_UtfCharComplete(src, length)) {
	    offset = Tcl_UtfToUniChar(src, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, src, (size_t) length);
	    utfBytes[length] = '\0';
	    offset = Tcl_UtfToUniChar(utfBytes, &ch);
	}
	c = UCHAR(ch);
	if (isalpha(UCHAR(c))) {			/* INTL: ISO only. */
	    infoPtr->lexeme = FUNC_NAME;
	    while (isalnum(UCHAR(c)) || (c == '_')) {	/* INTL: ISO only. */
		src += offset;
		length -= offset;
		if (Tcl_UtfCharComplete(src, length)) {
		    offset = Tcl_UtfToUniChar(src, &ch);
		} else {
		    char utfBytes[TCL_UTF_MAX];

		    memcpy(utfBytes, src, (size_t) length);
		    utfBytes[length] = '\0';
		    offset = Tcl_UtfToUniChar(utfBytes, &ch);
		}
		c = UCHAR(ch);
	    }
	    infoPtr->size = (src - infoPtr->start);
	    infoPtr->next = src;
	    parsePtr->term = infoPtr->next;
	    return TCL_OK;
	}
	infoPtr->lexeme = UNKNOWN_CHAR;
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PrependSubExprTokens --
 *
 *	This function is called after the operands of an subexpression have
 *	been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
 *	the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
 *	These two tokens are inserted before the operand tokens.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is insufficient space in parsePtr to hold the new tokens,
 *	additional space is malloc-ed.
 *
 *----------------------------------------------------------------------
 */

static void
PrependSubExprTokens(
    CONST char *op,		/* Points to first byte of the operator in the
				 * source script. */
    int opBytes,		/* Number of bytes in the operator. */
    CONST char *src,		/* Points to first byte of the subexpression
				 * in the source script. */
    int srcBytes,		/* Number of bytes in subexpression's
				 * source. */
    int firstIndex,		/* Index of first token already emitted for
				 * operator's first (or only) operand. */
    ParseInfo *infoPtr)		/* Holds the parse state for the expression
				 * being parsed. */
{
    Tcl_Parse *parsePtr = infoPtr->parsePtr;
    Tcl_Token *tokenPtr, *firstTokenPtr;
    int numToMove;

    TclGrowParseTokenArray(parsePtr,2);
    firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
    tokenPtr = (firstTokenPtr + 2);
    numToMove = (parsePtr->numTokens - firstIndex);
    memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
	    (size_t) (numToMove * sizeof(Tcl_Token)));
    parsePtr->numTokens += 2;

    tokenPtr = firstTokenPtr;
    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
    tokenPtr->start = src;
    tokenPtr->size = srcBytes;
    tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);

    tokenPtr++;
    tokenPtr->type = TCL_TOKEN_OPERATOR;
    tokenPtr->start = op;
    tokenPtr->size = opBytes;
    tokenPtr->numComponents = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * LogSyntaxError --
 *
 *	This function is invoked after an error occurs when parsing an
 *	expression. It sets the interpreter result to an error message
 *	describing the error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the interpreter result to an error message describing the
 *	expression that was being parsed when the error occurred, and why the
 *	parser considers that to be a syntax error at all.
 *
 *----------------------------------------------------------------------
 */

static void
LogSyntaxError(
    ParseInfo *infoPtr,		/* Holds the parse state for the expression
				 * being parsed. */
    CONST char *extraInfo)	/* String to provide extra information about
				 * the syntax error. */
{
    Tcl_Obj *result =
	    Tcl_NewStringObj("syntax error in expression \"", -1);

    TclAppendLimitedToObj(result, infoPtr->originalExpr,
	    (int)(infoPtr->lastChar - infoPtr->originalExpr), 63, NULL);
    Tcl_AppendStringsToObj(result, "\": ", extraInfo, NULL);
    Tcl_SetObjResult(infoPtr->parsePtr->interp, result);
    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
    infoPtr->parsePtr->term = infoPtr->start;
}
#else


#include "tclInt.h"

/*
 * The ExprNode structure represents one node of the parse tree produced
 * as an interim structure by the expression parser.
 */

#define NUM_STATIC_NODES 64
    ExprNode staticNodes[NUM_STATIC_NODES];
    ExprNode *lastOrphanPtr, *nodes = staticNodes;
    int nodesAvailable = NUM_STATIC_NODES;
    int nodesUsed = 0;
    Tcl_Parse scratch;		/* Parsing scratch space */
    Tcl_Obj *msg = NULL, *post = NULL;
    unsigned char precedence;
    CONST char *end, *mark = "_@_";
    int scanned = 0, code = TCL_OK, insertMark = 0;

    CONST int limit = 25;
    static unsigned char prec[80] = {
	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
	0,  15,	15, 5,	16, 16,	16, 13,	13, 11,	10, 9,	6,  6,	14, 14,
	13, 13, 12, 12,	8,  7,	12, 12,	17, 12,	12, 3,	1,  0,	0,  0,
	0,  18,	18, 18,	2,  4,	18, 18,	0,  0,	0,  0,	0,  0,	0,  0,
    };

		}
	    }
	}

	/* Add node to parse tree based on category */

	switch (NODE_TYPE & nodePtr->lexeme) {
	case LEAF:


	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
		CONST char *operand =
			scratch.tokenPtr[lastNodePtr->token].start;

		msg = Tcl_NewObj();
		TclObjPrintf(NULL, msg, "missing operator at %s", mark);

	    nodePtr->left = -1;
	    nodePtr->right = -1;
	    nodePtr->parent = -1;
	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;


	case UNARY:
	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
		msg = Tcl_NewObj();
		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;

	    scratch.numTokens++;

	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;

	case BINARY: {
	    ExprNode *otherPtr;


	    if ((nodePtr->lexeme == CLOSE_PAREN)
		    && (lastNodePtr->lexeme == OPEN_PAREN)) {
		if (lastNodePtr[-1].lexeme == FUNCTION) {
		    /* Normally, "()" is a syntax error, but as a special
		     * case accept it as an argument list for a function */
		    scanned = 0;

		TclObjPrintf(NULL, msg, "empty subexpression at %s", mark);
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
	    }

	    precedence = prec[nodePtr->lexeme];

	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
		if (prec[lastNodePtr->lexeme] > precedence) {
		    if (lastNodePtr->lexeme == OPEN_PAREN) {
			msg = Tcl_NewStringObj("unbalanced open paren", -1);
		    } else if (lastNodePtr->lexeme == COMMA) {
			msg = Tcl_NewObj();

		    insertMark = 1;
		}
		code = TCL_ERROR;
		continue;
	    }

	    while (1) {

		otherPtr = lastOrphanPtr;

		while (otherPtr->left >= 0) {



		    otherPtr = nodes + otherPtr->left;
		}
		otherPtr--;

		if (prec[otherPtr->lexeme] < precedence) {
		    break;
		}

			-1);
		code = TCL_ERROR;
		continue;
	    }

	    /* Link orphan as left operand of new node */
	    nodePtr->right = -1;
	    nodePtr->parent = -1;

	    TclGrowParseTokenArray(&scratch,1);
	    nodePtr->token = scratch.numTokens;
	    tokenPtr = scratch.tokenPtr + nodePtr->token;
	    tokenPtr->type = TCL_TOKEN_OPERATOR;
	    tokenPtr->start = start;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = 0;
	    scratch.numTokens++;

	    nodePtr->left = lastOrphanPtr - nodes;

	    lastOrphanPtr->parent = nodePtr - nodes;
	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;
	}
	}

	    utfBytes[numBytes] = '\0';
	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
	}
    }
    *lexemePtr = BAREWORD;
    return (end-start);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclPkg.c --
 *
 *	This file implements package and version control for Tcl via the
 *	"package" command and a few C APIs.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclPkg.c,v 1.9.4.5 2005/12/02 18:42:08 dgp Exp $
 */

#include "tclInt.h"

/*
 * Each invocation of the "package ifneeded" command creates a structure of
 * the following type, which is used to load the package into the interpreter

	     */
	    CONST char *versionToProvide = bestPtr->version;
	    script = bestPtr->script;
	    
	    pkgPtr->clientData = (ClientData) versionToProvide;
	    Tcl_Preserve((ClientData) script);
	    Tcl_Preserve((ClientData) versionToProvide);
	    code = Tcl_GlobalEval(interp, script);
	    Tcl_Release((ClientData) script);

	    pkgPtr = FindPackage(interp, name);
	    if (code == TCL_OK) {
		Tcl_ResetResult(interp);
		if (pkgPtr->version == NULL) {
		    code = TCL_ERROR;

	    Tcl_DStringAppendElement(&command, name);
	    Tcl_DStringAppend(&command, " ", 1);
	    Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
		    -1);
	    if (exact) {
		Tcl_DStringAppend(&command, " -exact", 7);
	    }
	    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command));

	    Tcl_DStringFree(&command);

	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "bad return code: ",
			Tcl_GetString(codePtr), NULL);

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 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: expr-old.test,v 1.17.2.13 2006/08/29 16:19:34 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint testexprlong   [llength [info commands testexprlong]]

test expr-old-37.24 {Tcl_ExprDouble handles overflows that look like int} \
    ieeeFloatingPoint&&testexprdouble {
	testexprdouble 17976931348623165[string repeat 0 292]
    } {This is a result: Inf}
test expr-old-37.25 {Tcl_ExprDouble and NaN} \
    {ieeeFloatingPoint testexprdouble} {
	list [catch {testexprdouble 0.0/0.0} result] $result
    } {1 {floating point value is Not a Number}}
    
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
	    [catch {testexprstring "1+"} msg] $msg
} -match glob -result {5 10.2 1 *}
test expr-old-38.2 {Tcl_ExprString} testexprstring {
    # This one is "magical"

# Commands covered: expr
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 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: expr.test,v 1.18.2.21 2006/08/29 16:19:34 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint testmathfunctions [expr {

test expr-39.24 {Tcl_ExprDoubleObj handles overflows that look like int} \
    testexprdoubleobj&&ieeeFloatingPoint {
	testexprdoubleobj 17976931348623165[string repeat 0 292]
    } {This is a result: Inf}
test expr-39.25 {Tcl_ExprDoubleObj and NaN} \
    {testexprdoubleobj ieeeFloatingPoint} {
	list [catch {testexprdoubleobj 0.0/0.0} result] $result
    } {1 {floating point value is Not a Number}}

test expr-40.1 {large octal shift} {
    expr 0100000000000000000000000000000000
} [expr 0x1000000000000000000000000]
test expr-40.2 {large octal shift} {
    expr 0100000000000000000000000000000001
} [expr 0x1000000000000000000000001]

# This file contains a collection of tests for generic/tclMain.c.
#
# RCS: @(#) $Id: main.test,v 1.13.4.6 2006/06/06 17:10:15 dgp Exp $

if {[catch {package require tcltest 2.0.2}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
    return
}

namespace eval ::tcl::test::main {

		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}
	} rc]
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocsetrcfile $rc >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
	removeFile rc
    } -result "application-specific initialization failed:\
	\nIn script\nExit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-4.5 {
        Tcl_Main: Bug 1481986
    } -constraints {
        exec Tcltest
    } -setup {
        set rc [makeFile {

#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.127.2.25 2006/04/28 16:10:42 dgp Exp $

VERSION 		= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
MINOR_VERSION		= @TCL_MINOR_VERSION@
PATCH_LEVEL		= @TCL_PATCH_LEVEL@

#----------------------------------------------------------------

# This target can be used to run tclsh inside ddd
ddd: tclsh
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	$(DDD) -command=gdb.run ./tclsh
	rm gdb.run



valgrind: tclsh tcltest
	@LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	valgrind --num-callers=8 --leak-resolution=high -v --leak-check=yes --show-reachable=yes $(VALGRINDARGS) ./tcltest $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)






# The following target outputs the name of the top-level source directory
# for Tcl (it is used by Tk's configure script, for example).  The
# .NO_PARALLEL line is needed to avoid problems under Sun's "pmake".
# Note: this target is now obsolete (use the autoconf variable
# TCL_SRC_DIR from tclConfig.sh instead).

/*
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command pipes and
 *	TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinChan.c,v 1.30.4.12 2006/04/28 16:10:50 dgp Exp $
 */

#include "tclWinInt.h"
#include "tclIO.h"

/*
 * State flags used in the info structures below.

			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileSetupProc(ClientData clientData, int flags);
static void		FileWatchProc(ClientData instanceData, int mask);
static void		FileThreadActionProc(ClientData instanceData,
			    int action);
static int		FileTruncateProc(ClientData instanceData,
			    Tcl_WideInt length);


/*
 * This structure describes the channel type structure for file based IO.
 */

static Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */

    Tcl_Obj *pathPtr,		/* Name of file to open. */
    int mode,			/* POSIX mode. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    Tcl_Channel channel = 0;
    int channelPermissions = 0;
    DWORD accessMode = 0, createMode, shareMode, flags, consoleParams, type;
    CONST TCHAR *nativeName;
    HANDLE handle;
    char channelName[16 + TCL_INTEGER_SPACE];
    TclFile readFile = NULL, writeFile = NULL;

    nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
    if (nativeName == NULL) {

	if (interp != (Tcl_Interp *) NULL) {
	    Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		    "\": ", Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }

    type = GetFileType(handle);

    /*
     * If the file is a character device, we need to try to figure out whether
     * it is a serial port, a console, or something else. We test for the
     * console case first because this is more common.
     */

    if (type == FILE_TYPE_CHAR) {
	if (GetConsoleMode(handle, &consoleParams)) {
	    type = FILE_TYPE_CONSOLE;
	} else {
	    DCB dcb;

	    dcb.DCBlength = sizeof(DCB);
	    if (GetCommState(handle, &dcb)) {
		type = FILE_TYPE_SERIAL;
	    }
	}
    }

    channel = NULL;

    switch (type) {
    case FILE_TYPE_SERIAL:
	/*
	 * Reopen channel for OVERLAPPED operation. Normally this shouldn't
	 * fail, because the channel exists.
	 */

	handle = TclWinSerialReopen(handle, nativeName, accessMode);

#ifdef HAVE_NO_SEH
    EXCEPTION_REGISTRATION registration;
#endif
    char channelName[16 + TCL_INTEGER_SPACE];
    Tcl_Channel channel = NULL;
    HANDLE handle = (HANDLE) rawHandle;
    HANDLE dupedHandle;
    DWORD consoleParams, type;
    TclFile readFile = NULL, writeFile = NULL;
    BOOL result;

    if (mode == 0) {
	return NULL;
    }

    /*
     * GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles.
     */

    type = GetFileType(handle);

    /*
     * If the file is a character device, we need to try to figure out whether
     * it is a serial port, a console, or something else. We test for the
     * console case first because this is more common.
     */

    if (type == FILE_TYPE_CHAR) {
	if (GetConsoleMode(handle, &consoleParams)) {
	    type = FILE_TYPE_CONSOLE;
	} else {
	    DCB dcb;

	    dcb.DCBlength = sizeof(DCB);
	    if (GetCommState(handle, &dcb)) {
		type = FILE_TYPE_SERIAL;
	    }
	}
    }

    switch (type) {
    case FILE_TYPE_SERIAL:
	channel = TclWinOpenSerialChannel(handle, channelName, mode);
	break;
    case FILE_TYPE_CONSOLE:
	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
	break;
    case FILE_TYPE_PIPE:

	 */

	if (!removed) {
	    Tcl_Panic("file info ptr not on thread channel list");
	}
    }
}
















































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */