summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclEvent.c3
-rw-r--r--generic/tclExecute.c27
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclVar.c79
-rw-r--r--generic/tclZlib.c9
5 files changed, 27 insertions, 92 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 8305410..a16a3b1 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1043,6 +1043,9 @@ TclInitSubsystems(void)
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
#endif
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclpInitAllocCache();
+#endif
#ifdef TCL_MEM_DEBUG
TclInitDbCkalloc(); /* Process wide mutex init */
#endif
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d4077f5..823f619 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -35,14 +35,14 @@
#endif
/*
- * A mask (should be 2**n-1) that is used to work out when the bytecode engine
- * should call Tcl_AsyncReady() to see whether there is a signal that needs
- * handling.
+ * A counter that is used to work out when the bytecode engine should call
+ * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
+ * other expensive periodic operations.
*/
-#ifndef ASYNC_CHECK_COUNT_MASK
-# define ASYNC_CHECK_COUNT_MASK 63
-#endif /* !ASYNC_CHECK_COUNT_MASK */
+#ifndef ASYNC_CHECK_COUNT
+# define ASYNC_CHECK_COUNT 64
+#endif /* !ASYNC_CHECK_COUNT */
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -2115,8 +2115,14 @@ TEBCresume(
* sporadically: no special need for speed.
*/
- int instructionCount = 0; /* Counter that is used to work out when to
- * call Tcl_AsyncReady() */
+ unsigned interruptCounter = 1;
+ /* Counter that is used to work out when to
+ * call Tcl_AsyncReady(). This must be 1
+ * initially so that we call the async-check
+ * stanza early, otherwise there are command
+ * sequences that can make the interpreter
+ * busy-loop without an opportunity to
+ * recognise an interrupt. */
const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
int traceInstructions; /* Whether we are doing instruction-level
@@ -2314,10 +2320,11 @@ TEBCresume(
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
- * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+ * ASYNC_CHECK_COUNT instructions.
*/
- if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ if ((--interruptCounter) == 0) {
+ interruptCounter = ASYNC_CHECK_COUNT;
DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42c13dd..34430c8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4084,6 +4084,7 @@ MODULE_SCOPE void TclFreeAllocCache(void *);
MODULE_SCOPE void * TclpGetAllocCache(void);
MODULE_SCOPE void TclpSetAllocCache(void *);
MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex);
+MODULE_SCOPE void TclpInitAllocCache(void);
MODULE_SCOPE void TclpFreeAllocCache(void *);
/*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 3c1b01f..be035f7 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -206,9 +206,6 @@ static Tcl_UpdateStringProc PanicOnUpdateVarName;
static Tcl_FreeInternalRepProc FreeParsedVarName;
static Tcl_DupInternalRepProc DupParsedVarName;
-#if 0
-static Tcl_UpdateStringProc UpdateParsedVarName;
-#endif
static Tcl_UpdateStringProc PanicOnUpdateVarName;
static Tcl_SetFromAnyProc PanicOnSetVarName;
@@ -239,13 +236,7 @@ static const Tcl_ObjType localVarNameType = {
static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
- FreeParsedVarName, DupParsedVarName,
-#if 0
-UpdateParsedVarName,
-#else
-PanicOnUpdateVarName,
-#endif
- PanicOnSetVarName
+ FreeParsedVarName, DupParsedVarName, PanicOnUpdateVarName, PanicOnSetVarName
};
/*
@@ -544,9 +535,6 @@ TclObjLookupVarEx(
const char *errMsg = NULL;
CallFrame *varFramePtr = iPtr->varFramePtr;
const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
-#if 0
- char *newPart2 = NULL;
-#endif
*arrayPtrPtr = NULL;
if (typePtr == &localVarNameType) {
@@ -593,13 +581,7 @@ TclObjLookupVarEx(
}
return NULL;
}
-#if 0
- part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
- if (newPart2) {
- part2Ptr = Tcl_NewStringObj(newPart2, -1);
-#else
if ((part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2)) {
-#endif
if (createPart2) {
Tcl_IncrRefCount(part2Ptr);
}
@@ -643,15 +625,7 @@ TclObjLookupVarEx(
len2 = len1 - i - 2;
len1 = i;
-#if 0
- newPart2 = ckalloc(len2 + 1);
- memcpy(newPart2, part2, (unsigned) len2);
- *(newPart2+len2) = '\0';
- part2 = newPart2;
- part2Ptr = Tcl_NewStringObj(newPart2, -1);
-#else
part2Ptr = Tcl_NewStringObj(part2, len2);
-#endif
if (createPart2) {
Tcl_IncrRefCount(part2Ptr);
}
@@ -676,12 +650,8 @@ TclObjLookupVarEx(
Tcl_IncrRefCount(part1Ptr);
objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
-#if 0
- objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
-#else
Tcl_IncrRefCount(part2Ptr);
objPtr->internalRep.twoPtrValue.ptr2 = part2Ptr;
-#endif
typePtr = part1Ptr->typePtr;
part1 = TclGetString(part1Ptr);
@@ -706,11 +676,6 @@ TclObjLookupVarEx(
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
TclGetString(part1Ptr), NULL);
}
-#if 0
- if (newPart2) {
- Tcl_DecrRefCount(part2Ptr);
- }
-#endif
return NULL;
}
@@ -759,11 +724,6 @@ TclObjLookupVarEx(
*arrayPtrPtr = varPtr;
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
createPart1, createPart2, varPtr, -1);
-#if 0
- if (newPart2) {
- Tcl_DecrRefCount(part2Ptr);
- }
-#endif
}
return varPtr;
}
@@ -5645,43 +5605,6 @@ DupParsedVarName(
dupPtr->internalRep.twoPtrValue.ptr2 = elem;
dupPtr->typePtr = &tclParsedVarNameType;
}
-
-#if 0
-static void
-UpdateParsedVarName(
- Tcl_Obj *objPtr)
-{
- Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
- char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
- const char *part1;
- char *p;
- int len1, len2, totalLen;
-
- if (arrayPtr == NULL) {
- /*
- * This is a parsed scalar name: what is it doing here?
- */
-
- Tcl_Panic("scalar parsedVarName without a string rep");
- }
-
- part1 = TclGetStringFromObj(arrayPtr, &len1);
- len2 = strlen(part2);
-
- totalLen = len1 + len2 + 2;
- p = ckalloc(totalLen + 1);
- objPtr->bytes = p;
- objPtr->length = totalLen;
-
- memcpy(p, part1, (unsigned) len1);
- p += len1;
- *p++ = '(';
- memcpy(p, part2, (unsigned) len2);
- p += len2;
- *p++ = ')';
- *p = '\0';
-}
-#endif
/*
*----------------------------------------------------------------------
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 50d9a30..691d57a 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1194,11 +1194,12 @@ Tcl_ZlibStreamPut(
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
- while (e == Z_BUF_ERROR) {
+ while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
/*
- * Output buffer too small to hold the data being generated; so
- * put a new buffer into place after saving the old generated
- * data to the outData list.
+ * Output buffer too small to hold the data being generated or we
+ * are doing the end-of-stream flush (which can spit out masses of
+ * data). This means we need to put a new buffer into place after
+ * saving the old generated data to the outData list.
*/
obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
generated by cgit v0.12 at 2024-11-25 14:37:00 (GMT)