Version 1 of Bytecoded K

Updated 2003-11-14 16:59:09

Eric Boudaillier: For a bytecode experimentation, I decided to generate bytecode for the K operator, or, more precisely, the idiom [K $x [set x ""]]]. Here is the result, with the help of the anatomy of a bytecoded command and the set compile command TclCompileSetCmd().

 int
 TclCompileClearCmd(interp, parsePtr, envPtr)
    Tcl_Interp *interp;                /* Used for error reporting. */
    Tcl_Parse *parsePtr;        /* Points to a parse structure for the

• command created by Tcl_ParseCommand. */

    CompileEnv *envPtr;                /* Holds resulting instructions. */
 {
    Tcl_Token *varTokenPtr;
    int isScalar, simpleVarName, localIndex, numWords;
    int code = TCL_OK;

    numWords = parsePtr->numWords;
    if (numWords != 2) {
        Tcl_ResetResult(interp);
        Tcl_AppendToObj(Tcl_GetObjResult(interp),
                "wrong # args: should be \"clear varName\"", -1);
        return TCL_ERROR;
    }

    /*

• Get the variable name token and push the name.

     */
    varTokenPtr = parsePtr->tokenPtr
            + (parsePtr->tokenPtr->numComponents + 1);

    code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
            &localIndex, &simpleVarName, &isScalar);
    if (code != TCL_OK) {
        goto done;
    }

    /*

• Emit instructions to get the variable.

     */
    if (simpleVarName) {
        if (isScalar) {
            if (localIndex >= 0) {
                if (localIndex <= 255) {
                    TclEmitInstInt1(
                            INST_LOAD_SCALAR1,
                            localIndex, envPtr);
                } else {
                    TclEmitInstInt4(
                            INST_LOAD_SCALAR4,
                            localIndex, envPtr);
                }
            } else {
                TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
            }
        } else {
            if (localIndex >= 0) {
                if (localIndex <= 255) {
                    TclEmitInstInt1(
                            INST_LOAD_ARRAY1,
                            localIndex, envPtr);
                } else {
                    TclEmitInstInt4(
                            INST_LOAD_ARRAY4,
                            localIndex, envPtr);
                }
            } else {
                TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
            }
        }
    } else {
        TclEmitOpcode(INST_LOAD_STK, envPtr);
    }

    /*

• Emit instructions to set the variable to empty string.

     */
    code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
            &localIndex, &simpleVarName, &isScalar);
    if (code != TCL_OK) {
        goto done;
    }

    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);

    if (simpleVarName) {
        if (isScalar) {
            if (localIndex >= 0) {
                if (localIndex <= 255) {
                    TclEmitInstInt1(
                            INST_STORE_SCALAR1,
                            localIndex, envPtr);
                } else {
                    TclEmitInstInt4(
                            INST_STORE_SCALAR4,
                            localIndex, envPtr);
                }
            } else {
                TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
            }
        } else {
            if (localIndex >= 0) {
                if (localIndex <= 255) {
                    TclEmitInstInt1(
                            INST_STORE_ARRAY1,
                            localIndex, envPtr);
                } else {
                    TclEmitInstInt4(
                            INST_STORE_ARRAY4,
                            localIndex, envPtr);
                }
            } else {
                TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
            }
        }
    } else {
        TclEmitOpcode(INST_STORE_STK, envPtr);
    }

    /*

• Pop the empty string, leaving the initial variable value.

     */
    TclEmitOpcode(INST_POP, envPtr);

 done:
    return code;
 }

And a little test, to show benefits of the bytecode, with four version of lreverse: the classic, one with the K operator, one with non bytecoded clear, and the last with bytecoded clear:

 classic: 26629 microseconds per iteration
 K:       11130 microseconds per iteration
 clear:    9933 microseconds per iteration
 clearc:   6841 microseconds per iteration

--

AJD This functionality of K $x [set x ""] could be added as a new option on an existing Tcl command. To my mind [unset best fits the bill. A new flag could be added without breaking backwards compatability, say "-K" or "-value", or something better :-). AIUI, unset is not currently byte compiled, so this would need to be added to get the speedup of "clearc" detailed above.