diff options
Diffstat (limited to 'generic/tclAssembly.c')
| -rw-r--r-- | generic/tclAssembly.c | 125 |
1 files changed, 124 insertions, 1 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index d6916fa..cac051f 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -32,6 +32,7 @@ static int FinishAssembly(AssembleEnv*); static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr); static void FreeAssembleEnv(AssembleEnv*); static int GetBooleanOperand(AssembleEnv*, Tcl_Token**, int*); +static int GetListIndexOperand(AssembleEnv*, Tcl_Token**, int*); static int GetIntegerOperand(AssembleEnv*, Tcl_Token**, int*); static int GetNextOperand(AssembleEnv*, Tcl_Token**, Tcl_Obj**); static AssembleEnv* NewAssembleEnv(CompileEnv*, int); @@ -173,11 +174,19 @@ TalInstDesc TalInstructionTable[] = { ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE , INST_LE , 2 , 1}, + {"lindexMulti", + ASSEM_LINDEX_MULTI, + INST_LIST_INDEX_MULTI, + INT_MIN,1}, + {"list", ASSEM_LIST, INST_LIST, INT_MIN,1}, {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX,2, 1}, + {"listIndexImm", + ASSEM_INDEX, INST_LIST_INDEX_IMM, + 1, 1}, {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, - 1, 1}, + 1, 1}, {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8 | INST_LOAD_SCALAR4), 0, 1}, @@ -191,6 +200,8 @@ TalInstDesc TalInstructionTable[] = { {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1}, {"lor", ASSEM_1BYTE , INST_LOR , 2 , 1}, + {"lsetFlat", + ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, {"lshift", ASSEM_1BYTE , INST_LSHIFT , 2 , 1}, @@ -225,6 +236,9 @@ TalInstDesc TalInstructionTable[] = { ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"sub", ASSEM_1BYTE , INST_SUB , 2 , 1}, + {"tryCvtToNumeric", + ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC, + 1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, {"unset", ASSEM_BOOL_LVT4, INST_UNSET_SCALAR, @@ -1117,6 +1131,60 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) } break; + case ASSEM_LINDEX_MULTI: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || CheckStrictlyPositive(interp, opnd) != TCL_OK) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + break; + + case ASSEM_LIST: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || CheckNonNegative(interp, opnd) != TCL_OK) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + break; + + case ASSEM_INDEX: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); + goto cleanup; + } + if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + break; + + case ASSEM_LSET_FLAT: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { + goto cleanup; + } + if (opnd < 2) { + if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("operand must be >=2", -1)); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL); + } + goto cleanup; + } + BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + break; + case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); @@ -1378,6 +1446,61 @@ GetIntegerOperand(AssembleEnv* assemEnvPtr, /* *----------------------------------------------------------------------------- * + * GetListIndexOperand -- + * + * Gets the value of an operand intended to serve as a list index. + * + * Results: + * Returns a standard Tcl result: TCL_OK if the parse is successful + * and TCL_ERROR (with an appropriate error message) if the parse fails. + * + * Side effects: + * Stores the list index at '*index'. Values between -1 and 0x7fffffff + * have their natural meaning; values between -2 and -0x80000000 + * represent 'end-2-N'. + * + *----------------------------------------------------------------------------- + */ + +static int +GetListIndexOperand( + AssembleEnv* assemEnvPtr, + /* Assembly environment */ + Tcl_Token** tokenPtrPtr, + /* Current token from the parser */ + int* result) + /* OUTPUT: Integer extracted from the token */ +{ + CompileEnv* envPtr = assemEnvPtr->envPtr; + /* Compilation environment */ + Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; + /* Tcl interpreter */ + Tcl_Token* tokenPtr = *tokenPtrPtr; + /* INOUT: Pointer to the next token + * in the source code */ + Tcl_Obj* intObj = Tcl_NewObj(); + /* Integer from the source code */ + int status; /* Tcl status return */ + + /* Extract the next token as a string */ + + Tcl_IncrRefCount(intObj); + if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { + Tcl_DecrRefCount(intObj); + return TCL_ERROR; + } + + /* Convert to an integer, advance to the next token and return */ + + status = TclGetIntForIndex(interp, intObj, -2, result); + Tcl_DecrRefCount(intObj); + *tokenPtrPtr = TokenAfter(tokenPtr); + return status; +} + +/* + *----------------------------------------------------------------------------- + * * FindLocalVar -- * * Gets the name of a local variable from the input stream and advances |