Tcl Source Code

    for (i=3 ; i<numWords ; i++,tokenPtr=TokenAfter(tokenPtr)) {
	PUSH_TOKEN(		tokenPtr, i);
    }

    /*
     * First operand is count of arguments.
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     *  TCL_LREPLACE4_SINGLE_INDEX - second index is not present
     *     indicating this is a pure insert
     */
    OP41(			LREPLACE, numWords - 1,
					TCL_LREPLACE4_SINGLE_INDEX);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLreplaceCmd --

    for (i=4; i<numWords; i++,tokenPtr=TokenAfter(tokenPtr)) {
	PUSH_TOKEN(		tokenPtr, i);
    }

    /*
     * First operand is count of arguments.
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     */
    OP41(			LREPLACE, numWords - 1,
					TCL_LREPLACE4_END_IS_LAST);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --

	/* String Less or equal:	push (stknext <= stktop) */
    TCL_INSTRUCTION_ENTRY(
	"strge",		-1),
	/* String Greater or equal:	push (stknext >= stktop) */
    TCL_INSTRUCTION_ENTRY2(
	"lreplace",	  6,	INT_MIN,  OPERAND_UINT4, OPERAND_LRPL1),
	/* Operands: number of arguments, flags
	 * flags: Combination of TCL_LREPLACE4_* flags
	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj
	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
	 * set in flags. */

    TCL_INSTRUCTION_ENTRY1(
	"constImm",	  5,	-1,	  OPERAND_LVT4),
	/* Create constant. Index into LVT is immediate, value is on stack.

    OPERAND_LIT1,		/* One byte unsigned index into table of
				 * literals. */
    OPERAND_LIT4,		/* Four byte unsigned index into table of
				 * literals. */
    OPERAND_SCLS1,		/* Index into tclStringClassTable. */
    OPERAND_UNSF1,		/* Flags for [unset] */
    OPERAND_CLK1,		/* Index into [clock] types. */
    OPERAND_LRPL1		/* Combination of TCL_LREPLACE4_* flags. */
} InstOperandType;

typedef struct InstructionDesc {
    const char *name;		/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
				 * instruction, used for stack requirements

    TCL_NO_ELEMENT = 2		/* Do not push the array element. */
};

/*
 * Flags bits used by lreplace4 instruction
 */
enum Lreplace4Flags {
    TCL_LREPLACE4_END_IS_LAST = 1,	/* "end" refers to last element */
    TCL_LREPLACE4_SINGLE_INDEX = 2	/* Second index absent (pure insert) */
};

/*
 * Helper functions for jump tables that call other internal API bits.
 */

static inline Tcl_Size

	case OPERAND_LRPL1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    switch (opnd) {
	    case 0:
		Tcl_AppendPrintfToObj(bufferObj, "0 ");
		break;
	    case TCL_LREPLACE4_END_IS_LAST:
		Tcl_AppendPrintfToObj(bufferObj, "endLast ");
		break;
	    case TCL_LREPLACE4_SINGLE_INDEX:
		Tcl_AppendPrintfToObj(bufferObj, "singleIdx ");
		break;
	    default:
		Tcl_AppendPrintfToObj(bufferObj, "endLast,singleIdx ");
		break;
	    }
	    break;

	numArgs = TclGetUInt4AtPtr(pc + 1);
	int flags = TclGetInt1AtPtr(pc + 5);

	/* Stack: ... listobj index1 ?index2? new1 ... newN */
	valuePtr = OBJ_AT_DEPTH(numArgs - 1);

	/* haveSecondIndex==0 => pure insert */
	int haveSecondIndex = (flags & TCL_LREPLACE4_SINGLE_INDEX) == 0;
	size_t numNewElems = numArgs - 2 - haveSecondIndex;

	/* end_indicator==1 => "end" is last element's index, 0=>index beyond */
	int endIndicator = (flags & TCL_LREPLACE4_END_IS_LAST) != 0;
	Tcl_Obj *fromIdxObj = OBJ_AT_DEPTH(numArgs - 2);
	Tcl_Obj *toIdxObj = haveSecondIndex ? OBJ_AT_DEPTH(numArgs - 3) : NULL;
	if (Tcl_ListObjLength(interp, valuePtr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}