diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 125 | ||||
| -rw-r--r-- | generic/tclAssembly.h | 23 | ||||
| -rw-r--r-- | tests/assemble.test | 437 |
4 files changed, 514 insertions, 78 deletions
@@ -1,3 +1,10 @@ +2010-09-30 Kevin B, Kenny <kennykb@acm.org> + + [dogeen-assembler-branch] + + * tests/assemble.test: Added tryCvtToNumeric and several more list + * generic/tclAssemble.c: operations. + 2010-09-29 Kevin B. Kenny <kennykb@acm.org> [dogeen-assembler-branch] 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; diff --git a/tests/assemble.test b/tests/assemble.test index 03f329a..bff1a84 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -779,7 +779,24 @@ test assemble-7.38 {sub} { -result 25 } -test assemble-7.39 {uminus} { +test assemble-7.39 {tryCvtToNumeric} { + -body { + assemble { + push 42; tryCvtToNumeric + } + } + -result 42 +} +test assemble-7.43 {tryCvtToNumeric} { + -body { + assemble { + push NaN; tryCvtToNumeric + } + } + -returnCodes error + -result {domain error: argument not in valid range} +} +test assemble-7.41 {uminus} { -body { assemble { push 42; uminus @@ -788,7 +805,7 @@ test assemble-7.39 {uminus} { -result -42 } -test assemble-7.40 {uplus} { +test assemble-7.42 {uplus} { -body { assemble { push 42; uplus @@ -796,6 +813,15 @@ test assemble-7.40 {uplus} { } -result 42 } +test assemble-7.43 {uplus} { + -body { + assemble { + push NaN; uplus + } + } + -returnCodes error + -result {can't use non-numeric floating-point value as operand of "+"} +} # assemble-8 ASSEM_LVT and FindLocalVar @@ -1507,9 +1533,67 @@ test assemble-14.7 {incrArrayStkImm} { -cleanup {rename x {}} } -# assemble-15 - invokeStk +# assemble-15 - listIndexImm + +test assemble-15.1 {listIndexImm - wrong # args} { + -body { + assemble {listIndexImm} + } + -returnCodes error + -match glob + -result {wrong # args*} +} -test assemble-15.1 {invokeStk - wrong # args} { +test assemble-16.2 {listIndexImm - wrong # args} { + -body { + assemble {listIndexImm too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-16.3 {listIndexImm - bad substitution} { + -body { + list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode + } + -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} + -cleanup {unset result} +} + +test assemble-16.4 {listIndexImm - invalid index} { + -body { + assemble {listIndexImm rubbish} + } + -returnCodes error + -match glob + -result {bad index "rubbish"*} +} + +test assemble-16.5 {listIndexImm} { + -body { + assemble {push {a b c}; listIndexImm 2} + } + -result c +} + +test assemble-16.6 {listIndexImm} { + -body { + assemble {push {a b c}; listIndexImm end-1} + } + -result b +} + +test assemble-16.6 {listIndexImm} { + -body { + assemble {push {a b c}; listIndexImm end} + } + -result c +} + +# assemble-16 - invokeStk + +test assemble-16.1 {invokeStk - wrong # args} { -body { assemble {invokeStk} } @@ -1518,7 +1602,7 @@ test assemble-15.1 {invokeStk - wrong # args} { -result {wrong # args*} } -test assemble-15.2 {invokeStk - wrong # args} { +test assemble-16.2 {invokeStk - wrong # args} { -body { assemble {invokeStk too many} } @@ -1527,7 +1611,7 @@ test assemble-15.2 {invokeStk - wrong # args} { -result {wrong # args*} } -test assemble-15.3 {invokeStk - not a number} { +test assemble-16.3 {invokeStk - not a number} { -body { proc x {} { assemble {invokeStk rubbish} @@ -1539,7 +1623,7 @@ test assemble-15.3 {invokeStk - not a number} { -cleanup {rename x {}} } -test assemble-15.4 {invokeStk - no operands} { +test assemble-16.4 {invokeStk - no operands} { -body { proc x {} { assemble {invokeStk 0} @@ -1550,14 +1634,14 @@ test assemble-15.4 {invokeStk - no operands} { -cleanup {rename x {}; unset result} } -test assemble-15.5 {invokeStk1} { +test assemble-16.5 {invokeStk1} { -body { tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3} } -result {1 2} } -test assemble-15.6 {invokeStk4} { +test assemble-16.6 {invokeStk4} { -body { proc x {n} { set code {push concat} @@ -1576,9 +1660,9 @@ test assemble-15.6 {invokeStk4} { -cleanup {rename x {}} } -# assemble-16 -- jumps and labels +# assemble-17 -- jumps and labels -test assemble-16.1 {label, wrong # args} { +test assemble-17.1 {label, wrong # args} { -body { assemble {label} } @@ -1587,7 +1671,7 @@ test assemble-16.1 {label, wrong # args} { -result {wrong # args*} } -test assemble-16.2 {label, wrong # args} { +test assemble-17.2 {label, wrong # args} { -body { assemble {label too many} } @@ -1596,7 +1680,7 @@ test assemble-16.2 {label, wrong # args} { -result {wrong # args*} } -test assemble-16.3 {label, bad subst} { +test assemble-17.3 {label, bad subst} { -body { list [catch {assemble {label $foo}} result] $result $::errorCode } @@ -1604,7 +1688,7 @@ test assemble-16.3 {label, bad subst} { -cleanup {unset result} } -test assemble-16.4 {duplicate label} { +test assemble-17.4 {duplicate label} { -body { list [catch {assemble {label foo; label foo}} result] \ $result $::errorCode @@ -1612,7 +1696,7 @@ test assemble-16.4 {duplicate label} { -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}} } -test assemble-16.5 {jump, wrong # args} { +test assemble-17.5 {jump, wrong # args} { -body { assemble {jump} } @@ -1621,7 +1705,7 @@ test assemble-16.5 {jump, wrong # args} { -result {wrong # args*} } -test assemble-16.6 {jump, wrong # args} { +test assemble-17.6 {jump, wrong # args} { -body { assemble {jump too many} } @@ -1630,7 +1714,7 @@ test assemble-16.6 {jump, wrong # args} { -result {wrong # args*} } -test assemble-16.7 {jump, bad subst} { +test assemble-17.7 {jump, bad subst} { -body { list [catch {assemble {jump $foo}} result] $result $::errorCode } @@ -1638,7 +1722,7 @@ test assemble-16.7 {jump, bad subst} { -cleanup {unset result} } -test assemble-16.8 {jump - ahead and back} { +test assemble-17.8 {jump - ahead and back} { -body { assemble { jump three @@ -1671,7 +1755,7 @@ test assemble-16.8 {jump - ahead and back} { -result ceadbf } -test assemble-16.9 {jump - resolve a label multiple times} { +test assemble-17.9 {jump - resolve a label multiple times} { -body { proc x {} { set case 0 @@ -1739,7 +1823,7 @@ test assemble-16.9 {jump - resolve a label multiple times} { -cleanup {rename x {}} } -test assemble-16.10 {jump4} { +test assemble-17.10 {jump4} { -body { assemble "push x; jump one; label two; [string repeat {dup; pop;} 128] jump three; label one; jump two; label three" @@ -1747,7 +1831,7 @@ test assemble-16.10 {jump4} { -result x } -test assemble-16.11 {jumpTrue} { +test assemble-17.11 {jumpTrue} { -body { proc x {y} { assemble { @@ -1766,7 +1850,7 @@ test assemble-16.11 {jumpTrue} { -cleanup {rename x {}} } -test assemble-16.12 {jumpFalse} { +test assemble-17.12 {jumpFalse} { -body { proc x {y} { assemble { @@ -1785,14 +1869,14 @@ test assemble-16.12 {jumpFalse} { -cleanup {rename x {}} } -test assemble-16.13 {jump to undefined label} { +test assemble-17.13 {jump to undefined label} { -body { list [catch {assemble {jump nowhere}} result] $result $::errorCode } -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}} } -test assemble-16.14 {jump to undefined label, line number correct?} { +test assemble-17.14 {jump to undefined label, line number correct?} { -body { catch {assemble {#1 #2 @@ -1807,9 +1891,221 @@ test assemble-16.14 {jump to undefined label, line number correct?} { -result {*"assemble" body, line 4*} } -# assemble-17 - over +# assemble-18 - lindexMulti + +test assemble-18.1 {lindexMulti - wrong # args} { + -body { + assemble {lindexMulti} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-18.2 {lindexMulti - wrong # args} { + -body { + assemble {lindexMulti too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-18.3 {lindexMulti - bad subst} { + -body { + assemble {lindexMulti $foo} + } + -returnCodes error + -match glob + -result {assembly code may not contain substitutions} +} + +test assemble-18.4 {lindexMulti - not a number} { + -body { + proc x {} { + assemble {lindexMulti rubbish} + } + x + } + -returnCodes error + -result {expected integer but got "rubbish"} + -cleanup {rename x {}} +} + +test assemble-18.5 {lindexMulti - bad operand count} { + -body { + proc x {} { + assemble {lindexMulti 0} + } + list [catch x result] $result $::errorCode + } + -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} + -cleanup {rename x {}; unset result} +} + +test assemble-18.6 {lindexMulti} { + -body { + assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1} + } + -result {{a b c} {d e f} {g h j}} +} -test assemble-17.1 {over - wrong # args} { +test assemble-18.7 {lindexMulti} { + -body { + assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2} + } + -result {d e f} +} + +test assemble-18.8 {lindexMulti} { + -body { + assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3} + } + -result h +} + +# assemble-19 - list + +test assemble-19.1 {list - wrong # args} { + -body { + assemble {list} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-19.2 {list - wrong # args} { + -body { + assemble {list too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-19.3 {list - bad subst} { + -body { + assemble {list $foo} + } + -returnCodes error + -match glob + -result {assembly code may not contain substitutions} +} + +test assemble-19.4 {list - not a number} { + -body { + proc x {} { + assemble {list rubbish} + } + x + } + -returnCodes error + -result {expected integer but got "rubbish"} + -cleanup {rename x {}} +} + +test assemble-19.5 {list - negative operand count} { + -body { + proc x {} { + assemble {list -1} + } + list [catch x result] $result $::errorCode + } + -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}} + -cleanup {rename x {}; unset result} +} + +test assemble-19.6 {list - no args} { + -body { + assemble {list 0} + } + -result {} +} + +test assemble-19.7 {list - 1 arg} { + -body { + assemble {push hello; list 1} + } + -result hello +} + +test assemble-19.8 {list - 2 args} { + -body { + assemble {push hello; push world; list 2} + } + -result {hello world} +} + +# assemble-20 - lsetFlat + +test assemble-20.1 {lsetFlat - wrong # args} { + -body { + assemble {lsetFlat} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-20.2 {lsetFlat - wrong # args} { + -body { + assemble {lsetFlat too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-20.3 {lsetFlat - bad subst} { + -body { + assemble {lsetFlat $foo} + } + -returnCodes error + -match glob + -result {assembly code may not contain substitutions} +} + +test assemble-20.4 {lsetFlat - not a number} { + -body { + proc x {} { + assemble {lsetFlat rubbish} + } + x + } + -returnCodes error + -result {expected integer but got "rubbish"} + -cleanup {rename x {}} +} + +test assemble-20.5 {lsetFlat - negative operand count} { + -body { + proc x {} { + assemble {lsetFlat 1} + } + list [catch x result] $result $::errorCode + } + -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}} + -cleanup {rename x {}; unset result} +} + +test assemble-20.6 {lsetFlat} { + -body { + assemble {push b; push a; lsetFlat 2} + } + -result b +} + +test assemble-20.7 {lsetFlat} { + -body { + assemble {push 1; push d; push {a b c}; lsetFlat 3} + } + -result {a d c} +} + +# assemble-21 - over + +test assemble-21.1 {over - wrong # args} { -body { assemble {over} } @@ -1818,7 +2114,7 @@ test assemble-17.1 {over - wrong # args} { -result {wrong # args*} } -test assemble-17.2 {over - wrong # args} { +test assemble-21.2 {over - wrong # args} { -body { assemble {over too many} } @@ -1827,7 +2123,7 @@ test assemble-17.2 {over - wrong # args} { -result {wrong # args*} } -test assemble-17.3 {over - bad subst} { +test assemble-21.3 {over - bad subst} { -body { assemble {over $foo} } @@ -1836,7 +2132,7 @@ test assemble-17.3 {over - bad subst} { -result {assembly code may not contain substitutions} } -test assemble-17.4 {over - not a number} { +test assemble-21.4 {over - not a number} { -body { proc x {} { assemble {over rubbish} @@ -1848,7 +2144,7 @@ test assemble-17.4 {over - not a number} { -cleanup {rename x {}} } -test assemble-17.5 {over - negative operand count} { +test assemble-21.5 {over - negative operand count} { -body { proc x {} { assemble {over -1} @@ -1859,7 +2155,7 @@ test assemble-17.5 {over - negative operand count} { -cleanup {rename x {}; unset result} } -test assemble-17.6 {over} { +test assemble-21.6 {over} { -body { proc x {} { assemble { @@ -1881,7 +2177,7 @@ test assemble-17.6 {over} { -cleanup {rename x {}} } -test assemble-17.7 {over} { +test assemble-21.7 {over} { -body { proc x {} { assemble { @@ -1903,9 +2199,9 @@ test assemble-17.7 {over} { -cleanup {rename x {}} } -# assemble-18 - reverse +# assemble-22 - reverse -test assemble-18.1 {reverse - wrong # args} { +test assemble-22.1 {reverse - wrong # args} { -body { assemble {reverse} } @@ -1914,7 +2210,7 @@ test assemble-18.1 {reverse - wrong # args} { -result {wrong # args*} } -test assemble-18.2 {reverse - wrong # args} { +test assemble-22.2 {reverse - wrong # args} { -body { assemble {reverse too many} } @@ -1923,7 +2219,7 @@ test assemble-18.2 {reverse - wrong # args} { -result {wrong # args*} } -test assemble-18.3 {reverse - bad subst} { +test assemble-22.3 {reverse - bad subst} { -body { assemble {reverse $foo} } @@ -1932,7 +2228,7 @@ test assemble-18.3 {reverse - bad subst} { -result {assembly code may not contain substitutions} } -test assemble-18.4 {reverse - not a number} { +test assemble-22.4 {reverse - not a number} { -body { proc x {} { assemble {reverse rubbish} @@ -1944,7 +2240,7 @@ test assemble-18.4 {reverse - not a number} { -cleanup {rename x {}} } -test assemble-18.5 {reverse - negative operand count} { +test assemble-22.5 {reverse - negative operand count} { -body { proc x {} { assemble {reverse -1} @@ -1955,7 +2251,7 @@ test assemble-18.5 {reverse - negative operand count} { -cleanup {rename x {}; unset result} } -test assemble-18.6 {reverse - zero operand count} { +test assemble-22.6 {reverse - zero operand count} { -body { proc x {} { assemble {push 1; reverse 0} @@ -1966,7 +2262,7 @@ test assemble-18.6 {reverse - zero operand count} { -cleanup {rename x {}} } -test assemble-18.7 {reverse} { +test assemble-22.7 {reverse} { -body { proc x {} { assemble { @@ -1987,7 +2283,7 @@ test assemble-18.7 {reverse} { -cleanup {rename x {}} } -test assemble-18.8 {reverse} { +test assemble-22.8 {reverse} { -body { proc x {} { assemble { @@ -2008,9 +2304,9 @@ test assemble-18.8 {reverse} { -cleanup {rename x {}} } -# assemble-19 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk) +# assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk) -test assemble-19.1 {strmatch - wrong # args} { +test assemble-23.1 {strmatch - wrong # args} { -body { assemble {strmatch} } @@ -2019,7 +2315,7 @@ test assemble-19.1 {strmatch - wrong # args} { -result {wrong # args*} } -test assemble-19.2 {strmatch - wrong # args} { +test assemble-23.2 {strmatch - wrong # args} { -body { assemble {strmatch too many} } @@ -2028,7 +2324,7 @@ test assemble-19.2 {strmatch - wrong # args} { -result {wrong # args*} } -test assemble-19.3 {strmatch - bad subst} { +test assemble-23.3 {strmatch - bad subst} { -body { assemble {strmatch $foo} } @@ -2037,7 +2333,7 @@ test assemble-19.3 {strmatch - bad subst} { -result {assembly code may not contain substitutions} } -test assemble-18.4 {strmatch - not a boolean} { +test assemble-23.4 {strmatch - not a boolean} { -body { proc x {} { assemble {strmatch rubbish} @@ -2049,7 +2345,7 @@ test assemble-18.4 {strmatch - not a boolean} { -cleanup {rename x {}} } -test assemble-18.5 {strmatch} { +test assemble-23.5 {strmatch} { -body { proc x {a b} { list [assemble {load a; load b; strmatch 0}] \ @@ -2061,7 +2357,7 @@ test assemble-18.5 {strmatch} { -cleanup {rename x {}} } -test assemble-18.6 {unsetStk} { +test assemble-23.6 {unsetStk} { -body { proc x {} { set a {} @@ -2074,7 +2370,7 @@ test assemble-18.6 {unsetStk} { -cleanup {rename x {}} } -test assemble-18.7 {unsetStk} { +test assemble-23.7 {unsetStk} { -body { proc x {} { assemble {push a; unsetStk false} @@ -2085,7 +2381,7 @@ test assemble-18.7 {unsetStk} { -result 0 -cleanup {rename x {}} } -test assemble-18.8 {unsetStk} { +test assemble-23.8 {unsetStk} { -body { proc x {} { assemble {push a; unsetStk true} @@ -2098,7 +2394,7 @@ test assemble-18.8 {unsetStk} { -cleanup {rename x {}} } -test assemble-18.9 {unsetArrayStk} { +test assemble-23.9 {unsetArrayStk} { -body { proc x {} { set a(b) {} @@ -2111,7 +2407,7 @@ test assemble-18.9 {unsetArrayStk} { -cleanup {rename x {}} } -test assemble-18.10 {unsetArrayStk} { +test assemble-23.10 {unsetArrayStk} { -body { proc x {} { assemble {push a; push b; unsetArrayStk false} @@ -2122,7 +2418,7 @@ test assemble-18.10 {unsetArrayStk} { -result 0 -cleanup {rename x {}} } -test assemble-18.11 {unsetArrayStk} { +test assemble-23.11 {unsetArrayStk} { -body { proc x {} { assemble {push a; push b; unsetArrayStk true} @@ -2135,9 +2431,9 @@ test assemble-18.11 {unsetArrayStk} { -cleanup {rename x {}} } -# assemble-19 -- ASSEM_BOOL_LVT4 (unset; unsetArray) +# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray) -test assemble-19.1 {unset - wrong # args} { +test assemble-24.1 {unset - wrong # args} { -body { assemble {unset one} } @@ -2146,7 +2442,7 @@ test assemble-19.1 {unset - wrong # args} { -result {wrong # args*} } -test assemble-19.2 {unset - wrong # args} { +test assemble-24.2 {unset - wrong # args} { -body { assemble {unset too many args} } @@ -2155,7 +2451,7 @@ test assemble-19.2 {unset - wrong # args} { -result {wrong # args*} } -test assemble-19.3 {unset - bad subst -arg 1} { +test assemble-24.3 {unset - bad subst -arg 1} { -body { assemble {unset $foo bar} } @@ -2164,7 +2460,7 @@ test assemble-19.3 {unset - bad subst -arg 1} { -result {assembly code may not contain substitutions} } -test assemble-19.4 {unset - not a boolean} { +test assemble-24.4 {unset - not a boolean} { -body { proc x {} { assemble {unset rubbish trash} @@ -2176,7 +2472,7 @@ test assemble-19.4 {unset - not a boolean} { -cleanup {rename x {}} } -test assemble-19.5 {unset - bad subst - arg 2} { +test assemble-24.5 {unset - bad subst - arg 2} { -body { assemble {unset true $bar} } @@ -2184,7 +2480,7 @@ test assemble-19.5 {unset - bad subst - arg 2} { -result {assembly code may not contain substitutions} } -test assemble-19.6 {unset - nonlocal var} { +test assemble-24.6 {unset - nonlocal var} { -body { assemble {unset true ::foo::bar} } @@ -2192,7 +2488,7 @@ test assemble-19.6 {unset - nonlocal var} { -result {variable "::foo::bar" is not local} } -test assemble-19.7 {unset} { +test assemble-24.7 {unset} { -body { proc x {} { set a {} @@ -2205,7 +2501,7 @@ test assemble-19.7 {unset} { -cleanup {rename x {}} } -test assemble-19.8 {unset} { +test assemble-24.8 {unset} { -body { proc x {} { assemble {unset false a} @@ -2216,7 +2512,7 @@ test assemble-19.8 {unset} { -result 0 -cleanup {rename x {}} } -test assemble-19.9 {unset} { +test assemble-24.9 {unset} { -body { proc x {} { assemble {unset true a} @@ -2229,7 +2525,7 @@ test assemble-19.9 {unset} { -cleanup {rename x {}} } -test assemble-19.10 {unsetArray} { +test assemble-24.10 {unsetArray} { -body { proc x {} { set a(b) {} @@ -2242,7 +2538,7 @@ test assemble-19.10 {unsetArray} { -cleanup {rename x {}} } -test assemble-19.11 {unsetArray} { +test assemble-24.11 {unsetArray} { -body { proc x {} { assemble {push b; unsetArray false a} @@ -2253,7 +2549,8 @@ test assemble-19.11 {unsetArray} { -result 0 -cleanup {rename x {}} } -test assemble-19.12 {unsetArray} { + +test assemble-24.12 {unsetArray} { -body { proc x {} { assemble {push b; unsetArray true a} @@ -2266,7 +2563,7 @@ test assemble-19.12 {unsetArray} { -cleanup {rename x {}} } -test assemble-20.1 {unbalanced stack} { +test assemble-30.1 {unbalanced stack} { -body { list \ [catch { @@ -2288,7 +2585,7 @@ test assemble-20.1 {unbalanced stack} { -returnCodes ok } -test assemble-20.2 {unbalanced stack} {*}{ +test assemble-30.2 {unbalanced stack} {*}{ -body { list \ [catch { @@ -2310,7 +2607,7 @@ test assemble-20.2 {unbalanced stack} {*}{ -returnCodes ok } -test assemble-21.1 {Inconsistent stack usage} {*}{ +test assemble-31.1 {Inconsistent stack usage} {*}{ -body { proc x {y} { assemble { @@ -2333,7 +2630,7 @@ test assemble-21.1 {Inconsistent stack usage} {*}{ ("assemble" body, line 10)*} } -test assemble-22.1 {Ulam's 3n+1 problem, TAL implementation} { +test assemble-40.1 {Ulam's 3n+1 problem, TAL implementation} { -body { proc ulam {n} { assemble { |