summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c125
-rw-r--r--generic/tclAssembly.h23
2 files changed, 140 insertions, 8 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
diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h
index 6ea9137..c950dd8 100644
--- a/generic/tclAssembly.h
+++ b/generic/tclAssembly.h
@@ -43,25 +43,34 @@ typedef struct BasicBlock {
typedef enum TalInstType {
- ASSEM_1BYTE, /* The instructions that are directly mapped to tclInstructionTable in tclCompile.c*/
+ ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */
ASSEM_BOOL, /* One Boolean operand */
ASSEM_BOOL_LVT4,/* One Boolean, one 4-byte LVT ref. */
- ASSEM_CONCAT1, /* One 1-byte unsigned-integer operand count (CONCAT1) */
+ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must be
+ * strictly positive, consumes N, produces 1 */
ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it
* in line with the assembly code! I love Tcl!) */
- ASSEM_INVOKE, /* Command invocation, 1- or 4-byte unsigned operand
- * count */
+ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */
+ ASSEM_INVOKE, /* 1- or 4-byte operand count, must be strictly positive,
+ * consumes N, produces 1. */
ASSEM_JUMP, /* Jump instructions */
ASSEM_LABEL, /* The assembly directive that defines a label */
+ ASSEM_LINDEX_MULTI,
+ /* 4-byte operand count, must be strictly positive,
+ * consumes N, produces 1 */
+ ASSEM_LIST, /* 4-byte operand count, must be nonnegative, consumses N,
+ * produces 1 */
+ ASSEM_LSET_FLAT,/* 4-byte operand count, must be >= 3, consumes N,
+ * produces 1 */
ASSEM_LVT, /* One operand that references a local variable */
ASSEM_LVT1, /* One 1-byte operand that references a local variable */
ASSEM_LVT1_SINT1,
/* One 1-byte operand that references a local variable,
* one signed-integer 1-byte operand */
ASSEM_LVT4, /* One 4-byte operand that references a local variable */
- ASSEM_OVER, /* OVER: consumes n+1 operands and produces n+2 */
- ASSEM_PUSH, /* These instructions will be looked up from talInstructionTable */
- ASSEM_REVERSE, /* REVERSE: consumes n operands and produces n */
+ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1, produces N+2 */
+ ASSEM_PUSH, /* one literal operand */
+ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand (INCR_STK_IMM) */
} TalInstType;
generated by cgit v0.12 at 2024-11-07 23:01:39 (GMT)