summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.fossil-settings/binary-glob3
-rw-r--r--.fossil-settings/crnl-glob0
-rw-r--r--.fossil-settings/ignore-glob15
-rw-r--r--.project11
-rw-r--r--.settings/org.eclipse.core.resources.prefs2
-rw-r--r--.settings/org.eclipse.core.runtime.prefs2
-rw-r--r--generic/tclCompCmds.c3
-rw-r--r--generic/tclCompExpr.c13
-rw-r--r--generic/tclCompile.c31
-rw-r--r--generic/tclCompile.h5
-rw-r--r--generic/tclEnsemble.c6
-rw-r--r--generic/tclLiteral.c43
12 files changed, 97 insertions, 37 deletions
diff --git a/.fossil-settings/binary-glob b/.fossil-settings/binary-glob
new file mode 100644
index 0000000..ca85874
--- /dev/null
+++ b/.fossil-settings/binary-glob
@@ -0,0 +1,3 @@
+*.bmp
+*.gif
+*.png
diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/.fossil-settings/crnl-glob
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
new file mode 100644
index 0000000..a101893
--- /dev/null
+++ b/.fossil-settings/ignore-glob
@@ -0,0 +1,15 @@
+*.a
+*.dll
+*.exe
+*.o
+*.obj
+*.so
+*/Makefile
+*/config.cache
+*/config.log
+*/config.status
+*/tclConfig.sh
+*/tclsh*
+*/tcltest*
+unix/dltest.marker
+win/tcl.hpj
diff --git a/.project b/.project
new file mode 100644
index 0000000..358cc74
--- /dev/null
+++ b/.project
@@ -0,0 +1,11 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+ <name>tcl8.6</name>
+ <comment></comment>
+ <projects>
+ </projects>
+ <buildSpec>
+ </buildSpec>
+ <natures>
+ </natures>
+</projectDescription>
diff --git a/.settings/org.eclipse.core.resources.prefs b/.settings/org.eclipse.core.resources.prefs
new file mode 100644
index 0000000..99f26c0
--- /dev/null
+++ b/.settings/org.eclipse.core.resources.prefs
@@ -0,0 +1,2 @@
+eclipse.preferences.version=1
+encoding/<project>=UTF-8
diff --git a/.settings/org.eclipse.core.runtime.prefs b/.settings/org.eclipse.core.runtime.prefs
new file mode 100644
index 0000000..5a0ad22
--- /dev/null
+++ b/.settings/org.eclipse.core.runtime.prefs
@@ -0,0 +1,2 @@
+eclipse.preferences.version=1
+line.separator=\n
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 4751455..40348fa 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -349,8 +349,7 @@ TclCompileArraySetCmd(
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
bytes = Tcl_GetStringFromObj(objPtr, &length);
cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
- TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr,
- cmdPtr);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
TclEmitPush(cmdLit, envPtr);
TclDecrRefCount(objPtr);
if (localIndex >= 0) {
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 346f446..3597abe 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2445,14 +2445,11 @@ CompileExprTree(
Tcl_Obj *literal = *litObjv;
if (optimize) {
- int length, index;
+ int length;
const char *bytes = TclGetStringFromObj(literal, &length);
- LiteralEntry *lePtr;
- Tcl_Obj *objPtr;
-
- index = TclRegisterNewLiteral(envPtr, bytes, length);
- lePtr = envPtr->literalArrayPtr + index;
- objPtr = lePtr->objPtr;
+ int index = TclRegisterNewLiteral(envPtr, bytes, length);
+ Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
+
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2511,7 +2508,7 @@ CompileExprTree(
index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
objPtr->length);
- tableValue = envPtr->literalArrayPtr[index].objPtr;
+ tableValue = TclFetchLiteral(envPtr, index);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index cf165f6..5427759 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -557,6 +557,7 @@ static int GetCmdLocEncodingSize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
+static void RegisterAuxDataType(const AuxDataType *typePtr);
static int SetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static int FormatInstruction(ByteCode *codePtr,
@@ -1895,8 +1896,7 @@ TclCompileScript(
tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
- envPtr->literalArrayPtr[objIndex].objPtr,
- cmdPtr);
+ TclFetchLiteral(envPtr, objIndex), cmdPtr);
}
} else {
/*
@@ -1913,7 +1913,7 @@ TclCompileScript(
if (envPtr->clNext) {
TclContinuationsEnterDerived(
- envPtr->literalArrayPtr[objIndex].objPtr,
+ TclFetchLiteral(envPtr, objIndex),
tokenPtr[1].start - envPtr->source,
eclPtr->loc[wlineat].next[wordIdx]);
}
@@ -2222,9 +2222,8 @@ TclCompileTokens(
Tcl_DStringFree(&textBuffer);
if (numCL) {
- TclContinuationsEnter(
- envPtr->literalArrayPtr[literal].objPtr, numCL,
- clPosition);
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
+ numCL, clPosition);
}
numCL = 0;
}
@@ -2270,7 +2269,7 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
if (numCL) {
- TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
numCL, clPosition);
}
numCL = 0;
@@ -2578,7 +2577,9 @@ TclInitByteCodeObj(
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; i++) {
- if (objPtr == envPtr->literalArrayPtr[i].objPtr) {
+ Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
+
+ if (objPtr == fetched) {
/*
* Prevent circular reference where the bytecode intrep of
* a value contains a literal which is that same value.
@@ -2597,7 +2598,7 @@ TclInitByteCodeObj(
Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
Tcl_DecrRefCount(objPtr);
} else {
- codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+ codePtr->objArrayPtr[i] = fetched;
}
}
@@ -3573,7 +3574,7 @@ TclGetInstructionTable(void)
/*
*--------------------------------------------------------------
*
- * TclRegisterAuxDataType --
+ * RegisterAuxDataType --
*
* This procedure is called to register a new AuxData type in the table
* of all AuxData types supported by Tcl.
@@ -3589,8 +3590,8 @@ TclGetInstructionTable(void)
*--------------------------------------------------------------
*/
-void
-TclRegisterAuxDataType(
+static void
+RegisterAuxDataType(
const AuxDataType *typePtr) /* Information about object type; storage must
* be statically allocated (must live forever;
* will not be deallocated). */
@@ -3694,9 +3695,9 @@ TclInitAuxDataTypeTable(void)
* There are only two AuxData type at this time, so register them here.
*/
- TclRegisterAuxDataType(&tclForeachInfoType);
- TclRegisterAuxDataType(&tclJumptableInfoType);
- TclRegisterAuxDataType(&tclDictUpdateInfoType);
+ RegisterAuxDataType(&tclForeachInfoType);
+ RegisterAuxDataType(&tclJumptableInfoType);
+ RegisterAuxDataType(&tclDictUpdateInfoType);
}
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4d8ed65..79497d2 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -954,11 +954,10 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
ByteCode *codePtr);
+MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
int create, CompileEnv *envPtr);
-MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
JumpFixup *jumpFixupPtr, int jumpDist,
int distThreshold);
@@ -967,7 +966,6 @@ MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitAuxDataTypeTable(void);
MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
CompileEnv *envPtr);
-MODULE_SCOPE void TclInitCompilation(void);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
int numBytes, const CmdFrame *invoker, int word);
@@ -987,7 +985,6 @@ MODULE_SCOPE void TclPrintObject(FILE *outFile,
Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void TclPrintSource(FILE *outFile,
const char *string, int maxChars);
-MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index bf9dac2..813e056 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3167,7 +3167,7 @@ CompileToInvokedCommand(
if (envPtr->clNext) {
TclContinuationsEnterDerived(
- envPtr->literalArrayPtr[literal].objPtr,
+ TclFetchLiteral(envPtr, literal),
tokPtr[1].start - envPtr->source,
mapPtr->loc[eclIndex].next[i]);
}
@@ -3190,7 +3190,7 @@ CompileToInvokedCommand(
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
bytes = Tcl_GetStringFromObj(objPtr, &length);
cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
- TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, cmdPtr);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
TclEmitPush(cmdLit, envPtr);
TclDecrRefCount(objPtr);
@@ -3239,7 +3239,7 @@ CompileBasicNArgCommand(
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
bytes = Tcl_GetStringFromObj(objPtr, &length);
literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
- TclSetCmdNameObj(interp, envPtr->literalArrayPtr[literal].objPtr, cmdPtr);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
TclEmitPush(literal, envPtr);
TclDecrRefCount(objPtr);
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 2cba18d..e2ee9b4 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -32,6 +32,10 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr,
Tcl_Obj *objPtr, int localHash);
static void ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned HashString(const char *string, int length);
+#ifdef TCL_COMPILE_DEBUG
+static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+#endif
static void RebuildLiteralTable(LiteralTable *tablePtr);
/*
@@ -239,7 +243,7 @@ TclCreateLiteral(
}
#ifdef TCL_COMPILE_DEBUG
- if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
+ if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
"TclRegisterLiteral", (length>60? 60 : length), bytes);
}
@@ -301,6 +305,33 @@ TclCreateLiteral(
/*
*----------------------------------------------------------------------
*
+ * TclFetchLiteral --
+ *
+ * Fetch from a CompileEnv the literal value identified by an index
+ * value, as returned by a prior call to TclRegisterLiteral().
+ *
+ * Results:
+ * The literal value, or NULL if the index is out of range.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFetchLiteral(
+ CompileEnv *envPtr, /* Points to the CompileEnv from which to
+ * fetch the registered literal value. */
+ unsigned int index) /* Index of the desired literal, as returned
+ * by prior call to TclRegisterLiteral() */
+{
+ if (index >= envPtr->literalArrayNext) {
+ return NULL;
+ }
+ return envPtr->literalArrayPtr[index].objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclRegisterLiteral --
*
* Find, or if necessary create, an object in a CompileEnv literal array
@@ -414,10 +445,11 @@ TclRegisterLiteral(
return objIndex;
}
+#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
- * TclLookupLiteralEntry --
+ * LookupLiteralEntry --
*
* Finds the LiteralEntry that corresponds to a literal Tcl object
* holding a literal.
@@ -431,8 +463,8 @@ TclRegisterLiteral(
*----------------------------------------------------------------------
*/
-LiteralEntry *
-TclLookupLiteralEntry(
+static LiteralEntry *
+LookupLiteralEntry(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
@@ -456,6 +488,7 @@ TclLookupLiteralEntry(
return NULL;
}
+#endif
/*
*----------------------------------------------------------------------
*
@@ -1096,7 +1129,7 @@ TclVerifyLocalLiteralTable(
"TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes, localPtr->refCount);
}
- if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
+ if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" is not global",
generated by cgit v0.12 at 2024-11-21 16:17:23 (GMT)