summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-05-24 19:28:50 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-05-24 19:28:50 (GMT)
commit6f3bd38c61b5deddb1bcd376c798ca8aa12351a7 (patch)
tree38747b6eae9f73159f5fa06f28901d586c45505f
parentca66ff4b66c7c2c37cf104ead999ae2fc8c85747 (diff)
downloadtcl-6f3bd38c61b5deddb1bcd376c798ca8aa12351a7.zip
tcl-6f3bd38c61b5deddb1bcd376c798ca8aa12351a7.tar.gz
tcl-6f3bd38c61b5deddb1bcd376c798ca8aa12351a7.tar.bz2
Appears that the TclInitRewriteEnsemble() routine was created with an intent
to refactor, but never actually got used. Work on continuing that effort.
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclEnsemble.c19
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclNamesp.c1
-rw-r--r--generic/tclOOMethod.c1
-rw-r--r--generic/tclProc.c2
6 files changed, 29 insertions, 8 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e5d7406..b0c31cc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -723,9 +723,7 @@ Tcl_CreateInterp(void)
* Initialize the ensemble error message rewriting support.
*/
- iPtr->ensembleRewrite.sourceObjs = NULL;
- iPtr->ensembleRewrite.numRemovedObjs = 0;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
+ TclResetRewriteEnsemble(interp, 1);
/*
* TIP#143: Initialise the resource limit support.
@@ -4220,7 +4218,7 @@ EvalObjvCore(
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
- iPtr->ensembleRewrite.sourceObjs = NULL;
+ TclResetRewriteEnsemble(interp, 1);
if (flags & TCL_EVAL_GLOBAL) {
TEOV_SwitchVarFrame(interp);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 986a553..f108030 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1876,6 +1876,15 @@ NsEnsembleImplementationCmdNR(
* count both as inserted and removed arguments.
*/
+#if 1
+ if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
+ prefixObjc + ensemblePtr->numParameters, objv)) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+ NULL);
+ }
+
+#else
+
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs =
@@ -1890,6 +1899,7 @@ NsEnsembleImplementationCmdNR(
/* Position in objv of new front of insertion
* relative to old one. */
if (ni > 0) {
+//fprintf(stdout, "COVER\n"); fflush(stdout);
iPtr->ensembleRewrite.numRemovedObjs += ni;
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
} else {
@@ -1897,6 +1907,8 @@ NsEnsembleImplementationCmdNR(
}
}
+#endif
+
/*
* Hand off to the target command.
*/
@@ -2005,15 +2017,20 @@ TclInitRewriteEnsemble(
int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
if (isRootEnsemble) {
+//fprintf(stdout, "SET-SOURCE: '%s'\n", Tcl_GetString(objv[0])); fflush(stdout);
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
iPtr->ensembleRewrite.numInsertedObjs = numInserted;
} else {
int numIns = iPtr->ensembleRewrite.numInsertedObjs;
+//fprintf(stdout, "Pre-SOURCE: '%s'\n",
+//Tcl_GetString(iPtr->ensembleRewrite.sourceObjs[0])); fflush(stdout);
+
if (numIns < numRemoved) {
+//fprintf(stdout, "COVER2\n"); fflush(stdout);
iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
- iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
+ iPtr->ensembleRewrite.numInsertedObjs = numInserted;
} else {
iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d4077f5..80598c1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3172,9 +3172,11 @@ TEBCresume(
if (iPtr->flags & INTERP_DEBUG_FRAME) {
ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = opnd;
- iPtr->ensembleRewrite.numInsertedObjs = 1;
+
+ if (!TclInitRewriteEnsemble(interp, opnd, 1, objv)) {
+//fprintf(stdout, "INVOKE: '%s'\n", Tcl_GetString(objPtr)); fflush(stdout);
+ Tcl_Panic("INST_INVOKE_REPLACE is not ensemble root");
+ }
DECACHE_STACK_INFO();
pc += 6;
TEBC_YIELD();
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 58a86d9..bad408e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3362,6 +3362,7 @@ NRNamespaceEvalCmd(
- iPtr->ensembleRewrite.numInsertedObjs;
framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
}
+ TclResetRewriteEnsemble(interp, 1);
if (objc == 3) {
/*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 34fa108..b86a203 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -732,6 +732,7 @@ InvokeProcedureMethod(
* Now invoke the body of the method.
*/
+//fprintf(stdout, "eh? %p\n", ((Interp *)interp)->ensembleRewrite.sourceObjs); fflush(stdout);
TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
return TclNRInterpProcCore(interp, fdPtr->nameObj,
Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 172b860..1a3bdb7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1786,6 +1786,8 @@ TclNRInterpProcCore(
* Invoke the commands in the procedure's body.
*/
+ TclResetRewriteEnsemble(interp, 1);
+
procPtr->refCount++;
codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;