Tcl Source Code

	Tcl_Obj *objPtr = Tcl_NewObj();
	char *bytes;
	int length, cmdLit;

	Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
	bytes = Tcl_GetStringFromObj(objPtr, &length);
	cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);

	TclEmitPush(cmdLit, envPtr);
	TclDecrRefCount(objPtr);
	if (localIndex >= 0) {
	    CompileWord(envPtr, varTokenPtr, interp, 1);
	} else {
	    TclEmitInstInt4(INST_REVERSE, 2,			envPtr);
	}

	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterNewLiteral(envPtr, bytes, length);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
		



		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);

		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
				objPtr->length);
			tableValue = TclFetchLiteral(envPtr, index);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

			    tableValue->typePtr = objPtr->typePtr;

		     * 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
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context
		     * which already allows absolute counting.
		     */

		    objIndex = TclRegisterNewLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);

		    if (envPtr->clNext) {
			TclContinuationsEnterDerived(
				TclFetchLiteral(envPtr, objIndex),
				tokenPtr[1].start - envPtr->source,
				eclPtr->loc[wlineat].next[wordIdx]);
		    }
		}
		TclEmitPush(objIndex, envPtr);
	    } /* for loop */

		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),

			    numCL, clPosition);
		}
		numCL = 0;
	    }

	    TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, envPtr);
	    numObjsToConcat++;

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

	TclEmitPush(literal, envPtr);
	numObjsToConcat++;
	if (numCL) {
	    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
		    numCL, clPosition);
	}
	numCL = 0;
    }

    /*
     * If necessary, concatenate the parts of the word.

    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);

	if (objPtr == fetched) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
	    Tcl_DecrRefCount(objPtr);
	} else {
	    codePtr->objArrayPtr[i] = fetched;
	}
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);

MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);

	    PushLiteral(envPtr, bytes, length);
	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterNewLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			TclFetchLiteral(envPtr, literal),
			tokPtr[1].start - envPtr->source,
			mapPtr->loc[eclIndex].next[i]);
	    }
	    TclEmitPush(literal, envPtr);
	} else {
	    if (envPtr->clNext) {
		SetLineInformation(i);

     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
    TclEmitPush(literal, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Push the words of the command.
     */

    if (globalPtrPtr) {
	*globalPtrPtr = globalPtr;
    }
    *newPtr = 1;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFetchLiteral --
 *
 *	Fetch from a CompileEnv the literal value identified by an index
 *	value, as returned by a prior call to TclRegisterLiteral().
 *
 * Results:
 *	The literal value, or NULL if the index is out of range.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclRegisterLiteral --
 *
 *	Find, or if necessary create, an object in a CompileEnv literal array