summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-10-20 18:11:35 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-10-20 18:11:35 (GMT)
commit39e314ad912cdbd29ba3e01673b1097b40118f8b (patch)
tree8d2cc46c815847369fee10486b2370ab7340257f
parentacfb2a50369dae9afcf444519e5d3875812d5a3b (diff)
downloadtcl-39e314ad912cdbd29ba3e01673b1097b40118f8b.zip
tcl-39e314ad912cdbd29ba3e01673b1097b40118f8b.tar.gz
tcl-39e314ad912cdbd29ba3e01673b1097b40118f8b.tar.bz2
And the last bits that need fixing; the code is still less efficient than desired but should now not crash.dkf_loop_exception_range_work
-rw-r--r--generic/tclAssembly.c35
-rw-r--r--generic/tclCompCmds.c4
-rw-r--r--generic/tclCompCmdsGR.c6
-rw-r--r--generic/tclCompCmdsSZ.c12
4 files changed, 45 insertions, 12 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 08da075..fc51457 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -246,6 +246,8 @@ static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
int opnd, int count);
static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
int param, int count);
+static void BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int param, int count);
static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
int count);
static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
@@ -679,10 +681,13 @@ BBEmitInstInt4(
/*
*-----------------------------------------------------------------------------
*
- * BBEmitInst1or4 --
+ * BBEmitInst1or4, BBEmitInvoke1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand
+ * operand. The Invoke variant generates wrapping stack-balance
+ * management if necessary (which is not normally required in assembled
+ * code, as loop exception ranges, expansions, breaks and continues can't
+ * be issued currently).
*
*-----------------------------------------------------------------------------
*/
@@ -714,6 +719,29 @@ BBEmitInst1or4(
TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
+
+static void
+BBEmitInvoke1or4(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int param, /* Variable-length parameter */
+ int count) /* Arity if variadic */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ int op = TalInstructionTable[tblIdx].tclInstCode;
+
+ if (param <= 0xff) {
+ op >>= 8;
+ } else {
+ op &= 0xff;
+ }
+ TclEmitInvoke(envPtr, op, param);
+ TclUpdateAtCmdStart(op, envPtr);
+ BBUpdateStackReqs(bbPtr, tblIdx, count);
+}
/*
*-----------------------------------------------------------------------------
@@ -1450,8 +1478,7 @@ AssembleOneLine(
goto cleanup;
}
- // FIXME - use TclEmitInvoke
- BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
+ BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
break;
case ASSEM_JUMP:
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c55635a..9c43bfe 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1675,7 +1675,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -2033,7 +2033,7 @@ TclCompileDictWithCmd(
} else {
TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
}
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
/*
* Prepare for the start of the next command.
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index fbd370b..d00327d 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2381,6 +2381,10 @@ TclCompileReturnCmd(
* Scan through the return options. If any are unknown at compile time,
* there is no value in bytecompiling. Save the option values known in an
* objv array for merging into a return options dictionary.
+ *
+ * TODO: There is potential for improvement if all option keys are known
+ * at compile time and all option values relating to '-code' and '-level'
+ * are known at compile time.
*/
for (objc = 0; objc < numOptionWords; objc++) {
@@ -2388,7 +2392,7 @@ TclCompileReturnCmd(
Tcl_IncrRefCount(objv[objc]);
if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
/*
- * Non-literal, so punt to run-time.
+ * Non-literal, so punt to run-time assembly of the dictionary.
*/
for (; objc>=0 ; objc--) {
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index a5ec731..754238f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -99,6 +99,8 @@ const AuxDataType tclJumptableInfoType = {
if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
+#define INVOKE(name) \
+ TclEmitInvoke(envPtr,INST_##name)
/*
*----------------------------------------------------------------------
@@ -873,7 +875,7 @@ TclSubstCompile(
OP( END_CATCH);
OP( RETURN_CODE_BRANCH);
- /* ERROR -> reraise it */
+ /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
OP( RETURN_STK);
OP( NOP);
@@ -2396,7 +2398,7 @@ IssueTryClausesInstructions(
TclAdjustStackDepth(-1, envPtr);
FIXJUMP1( dontChangeOptions);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
}
JUMP4( JUMP, addrsToFix[i]);
@@ -2415,7 +2417,7 @@ IssueTryClausesInstructions(
OP( POP);
LOAD( optionsVar);
LOAD( resultVar);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
/*
* Fix all the jumps from taken clauses to here (which is the end of the
@@ -2724,7 +2726,7 @@ IssueTryClausesFinallyInstructions(
FIXJUMP1( finalOK);
LOAD( optionsVar);
LOAD( resultVar);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}
@@ -2783,7 +2785,7 @@ IssueTryFinallyInstructions(
OP1( JUMP1, 7);
FIXJUMP1( jumpOK);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}