Tcl Source Code

Artifact [6dc85657d1]
Login

Artifact 6dc85657d1394522568dba244ee6265fcd7f3e6e:

Attachment "traceEnsembleOverhead2.patch" to ticket [3485833fff] added by sebres 2012-02-10 23:02:44.
Index: tclBasic.c
===================================================================
--- tclBasic.c	(revision 84)
+++ tclBasic.c	(working copy)
@@ -3020,8 +3020,11 @@
     if (!command) {
 	return Tcl_NewListObj(objc, objv);
     }
-    if (command == (char *) -1) {
+    if (command == (char *) -1 || command == (char *) -2) {
 	command = TclGetSrcInfoForCmd(iPtr, &numChars);
+	if (!command) {
+	    return Tcl_NewListObj(objc, objv);
+	}
     }
     return Tcl_NewStringObj(command, numChars);
 }
Index: tclExecute.c
===================================================================
--- tclExecute.c	(revision 84)
+++ tclExecute.c	(working copy)
@@ -7799,8 +7799,23 @@
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
-    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
-	    codePtr, lenPtr);
+    int len;
+
+    const char * command = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+	    codePtr, &len);
+
+    // [sebres] if ensemble call - shift string ptr to subcommand (string range -> range) :
+    if (command && (lenPtr && *lenPtr == -2) && codePtr->objArrayPtr) {
+	Tcl_Obj * objPtr = codePtr->objArrayPtr[0];
+	if (len > objPtr->length) {
+	    command += objPtr->length + 1;
+	    len -= objPtr->length + 1;
+	}
+    }
+
+    if (lenPtr != NULL)
+	*lenPtr = len;
+    return command;
 }
 
 void
Index: tclNamesp.c
===================================================================
--- tclNamesp.c	(revision 84)
+++ tclNamesp.c	(working copy)
@@ -25,6 +25,7 @@
  */
 
 #include "tclInt.h"
+#include "tclCompile.h"
 
 /*
  * Thread-local storage used to avoid having a global lock on data that is not
@@ -6253,9 +6254,10 @@
 
 	/*
 	 * Hand off to the target command.
+	 * [sebres] call from ensemble -- -2 (to retrive subcommand from main ensemble)
 	 */
 
-	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
+	result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv, (char *)-2, -2,
 		TCL_EVAL_INVOKE);
 
 	/*