Tcl Source Code

			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static Command *	FindCommandFromToken(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
static void		PeepholeOptimize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS

static const Tcl_ObjType tclInstNameType = {
    "instname",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
};








/*
 *----------------------------------------------------------------------
 *
 * TclSetByteCodeFromAny --
 *
 *	Part of the bytecode Tcl object type implementation. Attempts to

    }
    return 1;
}

/*
 * ---------------------------------------------------------------------
 *
 * FindCommandFromToken --
 *
 *	A simple helper that looks up a command's compiler from its token.
 *
 * ---------------------------------------------------------------------
 */

static Command *
FindCommandFromToken(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Namespace *namespacePtr)
{
    Tcl_DString ds;
    Command *cmdPtr;






    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {

	return NULL;
    }

    /*
     * We copy the string before trying to find the command by name. We used
     * to modify the string in place, but this is not safe because the name
     * resolution handlers could have side effects that rely on the unmodified
     * string.
     */

    Tcl_DStringInit(&ds);
    TclDStringAppendToken(&ds, &tokenPtr[1]);
    cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds),
	    namespacePtr, /*flags*/ 0);
    if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
	    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
	cmdPtr = NULL;
    }
    Tcl_DStringFree(&ds);
    return cmdPtr;

				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    int lastTopLevelCmdIndex = -1;
				/* Index of most recent toplevel command in
				 * the command location table. Initialized to
				 * avoid compiler warning. */
    int startCodeOffset = -1;	/* Offset of first byte of current command's
				 * code. Init. to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
    const char *p, *next;
    Namespace *cmdNsPtr;
    Command *cmdPtr;
    Tcl_Token *tokenPtr;
    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine, *clNext;
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);
    isFirstCmd = 1;

    if (envPtr->procPtr != NULL) {
	cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
    } else {
	cmdNsPtr = NULL;	/* use current NS */
    }

    /*
     * Each iteration through the following loop compiles the next command
     * from the script.
     */

    p = script;
    bytesLeft = numBytes;

		}
	    }

	    /*
	     * If expansion was requested, check if the command declares that
	     * it knows how to compile it. Note that if expansion is requested
	     * for the first word, this check will fail as the token type will
	     * inhibit it. (That check is done inside FindCommandFromToken.)
	     * This is as it should be.
	     */

	    if (expand) {
		cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr,
			(Tcl_Namespace *) cmdNsPtr);
		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
		    expand = 0;
		}
	    }

	    envPtr->numCommands++;
	    currCmdIndex = envPtr->numCommands - 1;

	     * Each iteration of the following loop compiles one word from the
	     * command.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords; wordIdx++,
		    tokenPtr += tokenPtr->numComponents + 1) {




		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
		envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];

		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		    /*
		     * The word is not a simple string of characters.
		     */

		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);

		 * This is a simple string of literal characters (i.e. we know
		 * it absolutely and can use it directly). If this is the
		 * first word and the command has a compile procedure, let it
		 * compile the command.
		 */

		if ((wordIdx == 0) && !expand) {
		    cmdPtr = FindCommandFromToken(interp, tokenPtr,
			    (Tcl_Namespace *) cmdNsPtr);

		    if ((cmdPtr != NULL)
			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
			int code, savedNumCmds = envPtr->numCommands;
			unsigned savedCodeNext =
				envPtr->codeNext - envPtr->codeStart;
			int update = 0;
#ifdef TCL_COMPILE_DEBUG
			int startStackDepth = envPtr->currStackDepth;
#endif

			/*
			 * Mark the start of the command; the proper bytecode
			 * length will be updated later. There is no need to
			 * do this for the first bytecode in the compile env,
			 * as the check is done before calling
			 * TclNRExecuteByteCode(). Do emit an INST_START_CMD in
			 * special cases where the first bytecode is in a
			 * loop, to insure that the corresponding command is
			 * counted properly. Compilers for commands able to
			 * produce such a beast (currently 'while 1' only) set
			 * envPtr->atCmdStart to 0 in order to signal this
			 * case. [Bug 1752146]
			 *
			 * Note that the environment is initialised with
			 * atCmdStart=1 to avoid emitting ISC for the first
			 * command.
			 */

			if (envPtr->atCmdStart == 1) {
			    if (savedCodeNext != 0) {
				/*
				 * Increase the number of commands being
				 * started at the current point. Note that
				 * this depends on the exact layout of the
				 * INST_START_CMD's operands, so be careful!
				 */

				unsigned char *fixPtr = envPtr->codeNext - 4;

				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
					fixPtr);
			    }
			} else if (envPtr->atCmdStart == 0) {
			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
			    TclEmitInt4(1, envPtr);
			    update = 1;
			}

			code = cmdPtr->compileProc(interp, parsePtr, cmdPtr,
				envPtr);

			if (code == TCL_OK) {
			    /*
			     * Confirm that the command compiler generated a
			     * single value on the stack as its result. This
			     * is only done in debugging mode, as it *should*
			     * be correct and normal users have no reasonable
			     * way to fix it anyway.
			     */

			    /*
			     * Decrease the number of commands being started
			     * at the current point. Note that this depends on
			     * the exact layout of the INST_START_CMD's
			     * operands, so be careful!
			     */

			    unsigned char *fixPtr = envPtr->codeNext - 4;

			    TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)-1,
				    fixPtr);
			}

			/*
			 * Restore numCommands and codeNext to their correct
			 * values, removing any commands compiled before the
			 * failure to produce bytecode got reported. [Bugs
			 * 705406 and 735055]

		     * was found, push a CmdName object to reduce runtime
		     * lookups. Mark this as a command name literal to reduce
		     * shimmering. 
		     */

		    objIndex = TclRegisterNewCmdLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				TclFetchLiteral(envPtr, objIndex), cmdPtr);
		    }
		} else {
		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever