summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c12
-rw-r--r--generic/tclCompile.h8
-rw-r--r--generic/tclExecute.c36
-rw-r--r--generic/tclNamesp.c8
-rw-r--r--generic/tclParse.c14
-rw-r--r--generic/tclParse.h17
-rw-r--r--generic/tclUtil.c3
-rw-r--r--unix/Makefile.in5
-rw-r--r--win/tclWinPort.h6
9 files changed, 88 insertions, 21 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 954b2b3..3f55b0a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3005,6 +3005,9 @@ CallCommandTraces(
* This function returns a Tcl_Obj with the full source string for the
* command. This insures that traces get a correct NUL-terminated command
* string.
+ * If parameter 'command' is (char*)-1 it returns a pointer to the command's
+ * source using TclGetSrcInfoForCmd. As parameter 'numChars' could be used
+ * an ENSEMBLE_PSEUDO_COMMAND to advise call of the ensemble command.
*
*----------------------------------------------------------------------
*/
@@ -3022,6 +3025,9 @@ GetCommandSource(
}
if (command == (char *) -1) {
command = TclGetSrcInfoForCmd(iPtr, &numChars);
+ if (!command) {
+ return Tcl_NewListObj(objc, objv);
+ }
}
return Tcl_NewStringObj(command, numChars);
}
@@ -3533,8 +3539,10 @@ TclEvalObjvInternal(
* for traces. NULL if the string
* representation of the command is unknown is
* to be generated from (objc,objv), -1 if it
- * is to be generated from bytecode
- * source. This is only needed the traces. */
+ * is to be generated from bytecode source,
+ * with length ENSEMBLE_PSEUDO_COMMAND it is
+ * to be determined from the ensemble context.
+ * This is only needed the traces. */
int length, /* Number of bytes in command; if -1, all
* characters up to the first null byte are
* used. */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c035a03..cc7ee3f 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -843,6 +843,14 @@ typedef struct {
int identity;
} i;
} TclOpCmdClientData;
+
+/*
+ * Special sentinel value for TclEvalObjvInternal's 'length' parameter to
+ * cause it to retrieve command information for an ensemble from the
+ * containing command (parameter 'command' is (char *)-1).
+ */
+
+#define ENSEMBLE_PSEUDO_COMMAND -2
/*
*----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index dc87d70..cf335db 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -7757,6 +7757,8 @@ IllegalExprOperandType(
* at pc, information about the closest enclosing command is returned. If
* no matching command is found, NULL is returned and *lengthPtr is
* unchanged.
+ * As input parameter '*lengthPtr' could be used an ENSEMBLE_PSEUDO_COMMAND
+ * to advise call of the ensemble command.
*
* Side effects:
* The CmdFrame at *cfPtr is updated.
@@ -7770,10 +7772,38 @@ TclGetSrcInfoForCmd(
int *lenPtr)
{
CmdFrame *cfPtr = iPtr->cmdFramePtr;
- ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+ const char *command;
+ ByteCode *codePtr;
+ int len;
+
+ if (!cfPtr)
+ return NULL;
+ codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+ if (!codePtr)
+ return NULL;
+ if (!cfPtr->data.tebc.pc)
+ return NULL;
+
+ command = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+ codePtr, &len);
+
+ /*
+ * [sebres]: If ensemble call (sentinel length == ENSEMBLE_PSEUDO_COMMAND),
+ * shift string ptr to subcommand (string range -> range).
+ */
+
+ if (command && len && (lenPtr && *lenPtr == ENSEMBLE_PSEUDO_COMMAND) && codePtr->objArrayPtr) {
+ Tcl_Obj *objPtr = codePtr->objArrayPtr[0];
+
+ if (len > objPtr->length) {
+ command += objPtr->length + 1;
+ len -= objPtr->length + 1;
+ }
+ }
- return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
- codePtr, lenPtr);
+ if (lenPtr != NULL)
+ *lenPtr = len;
+ return command;
}
void
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 5dbffc6..84be640 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -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
@@ -6229,10 +6230,13 @@ NsEnsembleImplementationCmd(
/*
* Hand off to the target command.
+ * [sebres] call from ensemble using ENSEMBLE_PSEUDO_COMMAND to
+ * retrive subcommand from main ensemble.
*/
- result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
- TCL_EVAL_INVOKE);
+ result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv,
+ /* call from TEBC, TclGetSrcInfoForCmd sentinel */(char *) -1,
+ ENSEMBLE_PSEUDO_COMMAND, TCL_EVAL_INVOKE);
/*
* Clean up.
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 96c2a10..681d4b2 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclParse.h"
/*
* The following table provides parsing information about each possible 8-bit
@@ -41,18 +42,7 @@
* TYPE_BRACE - Character is a curly brace (either left or right).
*/
-#define TYPE_NORMAL 0
-#define TYPE_SPACE 0x1
-#define TYPE_COMMAND_END 0x2
-#define TYPE_SUBS 0x4
-#define TYPE_QUOTE 0x8
-#define TYPE_CLOSE_PAREN 0x10
-#define TYPE_CLOSE_BRACK 0x20
-#define TYPE_BRACE 0x40
-
-#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-
-static const char charTypeTable[] = {
+const char charTypeTable[] = {
/*
* Negative character values, from -128 to -1:
*/
diff --git a/generic/tclParse.h b/generic/tclParse.h
new file mode 100644
index 0000000..be1ab15
--- /dev/null
+++ b/generic/tclParse.h
@@ -0,0 +1,17 @@
+/*
+ * Minimal set of shared macro definitions and declarations so that multiple
+ * source files can make use of the parsing table in tclParse.c
+ */
+
+#define TYPE_NORMAL 0
+#define TYPE_SPACE 0x1
+#define TYPE_COMMAND_END 0x2
+#define TYPE_SUBS 0x4
+#define TYPE_QUOTE 0x8
+#define TYPE_CLOSE_PAREN 0x10
+#define TYPE_CLOSE_BRACK 0x20
+#define TYPE_BRACE 0x40
+
+#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
+
+MODULE_SCOPE const char charTypeTable[];
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5119456..1bc6061 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -13,6 +13,7 @@
*/
#include "tclInt.h"
+#include "tclParse.h"
#include <float.h>
#include <math.h>
@@ -964,6 +965,7 @@ TclScanElement(
}
while (length) {
+ if (CHAR_TYPE(*p) != TYPE_NORMAL) {
switch (*p) {
case '{':
#if COMPAT
@@ -1040,6 +1042,7 @@ TclScanElement(
/* TODO: Panic on improper encoding? */
break;
}
+ }
length -= (length > 0);
p++;
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 382a41b..cc02bd3 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -928,6 +928,7 @@ COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
+PARSEHDR=$(GENERIC_DIR)/tclParse.h
regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1090,7 +1091,7 @@ tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
tclNotify.o: $(GENERIC_DIR)/tclNotify.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
-tclParse.o: $(GENERIC_DIR)/tclParse.c
+tclParse.o: $(GENERIC_DIR)/tclParse.c $(PARSEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
tclPanic.o: $(GENERIC_DIR)/tclPanic.c
@@ -1162,7 +1163,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
tclTrace.o: $(GENERIC_DIR)/tclTrace.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c
-tclUtil.o: $(GENERIC_DIR)/tclUtil.c
+tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 4855d12..d149495 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -29,6 +29,12 @@ typedef DWORD DWORD_PTR;
typedef DWORD_PTR * PDWORD_PTR;
#endif
+/* Compatibility to older visual studio / windows platform SDK */
+#if !defined(MAXULONG_PTR)
+typedef DWORD DWORD_PTR;
+typedef DWORD_PTR * PDWORD_PTR;
+#endif
+
/*
* Ask for the winsock function typedefs, also.
*/
generated by cgit v0.12 at 2025-06-02 16:13:29 (GMT)