summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-08-30 08:30:00 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-08-30 08:30:00 (GMT)
commitbbf5dede141290a90faaa2bbf2e8abba59d33c04 (patch)
treef87da8347e09b16d012c4371d03ae0d45c7549f8 /generic
parent2cfb3e19d01d75ab35c7cfeff3ec37c23dd34a4f (diff)
parent7bb34adfdb3692426a742497b53ccc8ae43b4892 (diff)
downloadtcl-bbf5dede141290a90faaa2bbf2e8abba59d33c04.zip
tcl-bbf5dede141290a90faaa2bbf2e8abba59d33c04.tar.gz
tcl-bbf5dede141290a90faaa2bbf2e8abba59d33c04.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclCmdMZ.c54
-rw-r--r--generic/tclCompCmdsSZ.c72
-rw-r--r--generic/tclIO.c40
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclOO.c1
-rw-r--r--generic/tclOO.h2
-rw-r--r--generic/tclOOCall.c97
-rw-r--r--generic/tclThreadAlloc.c16
-rw-r--r--generic/tclZlib.c2
10 files changed, 231 insertions, 60 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index e557290..7531242 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -56,10 +56,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 1
+#define TCL_RELEASE_SERIAL 2
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6.1"
+#define TCL_PATCH_LEVEL "8.6.2"
/*
*----------------------------------------------------------------------------
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 0f7f20a..841002f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2838,6 +2838,59 @@ StringCmpCmd(
/*
*----------------------------------------------------------------------
*
+ * StringCatCmd --
+ *
+ * This procedure is invoked to process the "string cat" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringCatCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i;
+ Tcl_Obj *objResultPtr;
+
+ if (objc < 2) {
+ /*
+ * If there are no args, the result is an empty object.
+ * Just leave the preset empty interp result.
+ */
+ return TCL_OK;
+ }
+ if (objc == 2) {
+ /*
+ * Other trivial case, single arg, just return it.
+ */
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+ objResultPtr = objv[1];
+ if (Tcl_IsShared(objResultPtr)) {
+ objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ }
+ for(i = 2;i < objc;i++) {
+ Tcl_AppendObjToObj(objResultPtr, objv[i]);
+ }
+ Tcl_SetObjResult(interp, objResultPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* StringBytesCmd --
*
* This procedure is invoked to process the "string bytelength" Tcl
@@ -3330,6 +3383,7 @@ TclInitStringCmd(
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ece363b..c03ddcf 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -273,6 +273,78 @@ TclCompileSetCmd(
*/
int
+TclCompileStringCatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ int i, numWords = parsePtr->numWords, numArgs;
+ Tcl_Token *wordTokenPtr;
+ Tcl_Obj *obj, *folded;
+ DefineLineInformation; /* TIP #280 */
+
+ /* Trivial case, no arg */
+
+ if (numWords<2) {
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
+ contiguous constants along the way */
+
+ numArgs = 0;
+ folded = NULL;
+ wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i = 1; i < numWords; i++) {
+ obj = Tcl_NewObj();
+ if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
+ if (folded) {
+ Tcl_AppendObjToObj(folded, obj);
+ Tcl_DecrRefCount(obj);
+ } else {
+ folded = obj;
+ }
+ } else {
+ Tcl_DecrRefCount(obj);
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ CompileWord(envPtr, wordTokenPtr, interp, i);
+ numArgs ++;
+ if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
+ TclEmitInstInt1(INST_STR_CONCAT1, 254, envPtr);
+ numArgs -= 253; /* concat pushes 1 obj, the result */
+ }
+ }
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ if (numArgs > 1) {
+ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+int
TclCompileStringCmpCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c142917..eaa0aeb 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8115,7 +8115,7 @@ Tcl_NotifyChannel(
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
- chPtr->proc(chPtr->clientData, mask);
+ chPtr->proc(chPtr->clientData, chPtr->mask & mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -9048,7 +9048,8 @@ MBWrite(
ChannelState *outStatePtr = csPtr->writePtr->state;
ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
ChannelBuffer *tail = NULL;
- int code, inBytes = 0;
+ int code;
+ Tcl_WideInt inBytes = 0;
/* Count up number of bytes waiting in the input queue */
while (bufPtr) {
@@ -9063,7 +9064,14 @@ MBWrite(
if (bufPtr) {
/* Split the overflowing buffer in two */
- int extra = inBytes - csPtr->toRead;
+ int extra = (int) (inBytes - csPtr->toRead);
+ /* Note that going with int for extra assumes that inBytes is not too
+ * much over toRead to require a wide itself. If that gets violated
+ * then the calculations involving extra must be made wide too.
+ *
+ * Noted with Win32/MSVC debug build treating the warning (possible of
+ * data in int64 to int conversion) as error.
+ */
bufPtr = AllocChannelBuffer(extra);
@@ -9505,34 +9513,22 @@ DoRead(
break;
}
- /* If there is no full buffer, attempt to create and/or fill one. */
-
- while (!IsBufferFull(bufPtr)) {
- int code;
+ /*
+ * If there is not enough data in the buffers to possibly
+ * complete the read, then go get more.
+ */
+ if (bufPtr == NULL || BytesLeft(bufPtr) < bytesToRead) {
moreData:
- code = GetInput(chanPtr);
- bufPtr = statePtr->inQueueHead;
-
- assert (bufPtr != NULL);
-
- if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
- /* Further reads cannot do any more */
- break;
- }
-
- if (code) {
+ if (GetInput(chanPtr)) {
/* Read error */
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return -1;
}
-
- assert (IsBufferFull(bufPtr));
+ bufPtr = statePtr->inQueueHead;
}
- assert (bufPtr != NULL);
-
bytesRead = BytesLeft(bufPtr);
bytesWritten = bytesToRead;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1bb2103..6bf1ef9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3646,6 +3646,9 @@ MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringCatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 02e00c9..ace47fe 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -394,6 +394,7 @@ InitFoundation(
fPtr->classCls->flags |= ROOT_CLASS;
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
AddRef(fPtr->objectCls->thisPtr);
AddRef(fPtr->objectCls);
diff --git a/generic/tclOO.h b/generic/tclOO.h
index a6e8a22..24d3e6f 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.0.1"
+#define TCLOO_VERSION "1.0.2"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 897f635..2a81091 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -38,6 +38,12 @@ struct ChainBuilder {
#define DEFINITE_PUBLIC 0x200000
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
+#define BUILDING_MIXINS 0x400000
+#define TRAVERSED_MIXIN 0x800000
+#define OBJECT_MIXIN 0x1000000
+#define MIXIN_CONSISTENT(flags) \
+ (((flags) & OBJECT_MIXIN) || \
+ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
/*
* Function declarations for things defined in this file.
@@ -45,13 +51,13 @@ struct ChainBuilder {
static void AddClassFiltersToCallContext(Object *const oPtr,
Class *clsPtr, struct ChainBuilder *const cbPtr,
- Tcl_HashTable *const doneFilters);
+ Tcl_HashTable *const doneFilters, int flags);
static void AddClassMethodNames(Class *clsPtr, const int flags,
Tcl_HashTable *const namesPtr);
static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
- Class *const filterDecl);
+ Class *const filterDecl, int flags);
static inline void AddSimpleChainToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
@@ -434,7 +440,7 @@ TclOOGetSortedMethodList(
AddClassMethodNames(oPtr->selfCls, flags, &names);
FOREACH(mixinPtr, oPtr->mixins) {
- AddClassMethodNames(mixinPtr, flags, &names);
+ AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names);
}
/*
@@ -598,7 +604,7 @@ AddClassMethodNames(
/* TODO: Beware of infinite loops! */
FOREACH(mixinPtr, clsPtr->mixins) {
- AddClassMethodNames(mixinPtr, flags, namesPtr);
+ AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
}
}
@@ -695,13 +701,13 @@ AddSimpleChainToCallContext(
FOREACH(mixinPtr, oPtr->mixins) {
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
if (hPtr != NULL) {
AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
- doneFilters, filterDecl);
+ doneFilters, filterDecl, flags);
}
}
}
@@ -732,9 +738,15 @@ AddMethodToCallChain(
* processed. If NULL, not processing filters.
* Note that this function does not update
* this hashtable. */
- Class *const filterDecl) /* The class that declared the filter. If
+ Class *const filterDecl, /* The class that declared the filter. If
* NULL, either the filter was declared by the
* object or this isn't a filter. */
+ int flags) /* Used to check if we're mixin-consistent
+ * only. Mixin-consistent means that either
+ * we're looking to add things from a mixin
+ * and we have passed a mixin, or we're not
+ * looking to add things from a mixin and have
+ * not passed a mixin. */
{
register CallChain *callPtr = cbPtr->callChainPtr;
int i;
@@ -743,9 +755,11 @@ AddMethodToCallChain(
* Return if this is just an entry used to record whether this is a public
* method. If so, there's nothing real to call and so nothing to add to
* the call chain.
+ *
+ * This is also where we enforce mixin-consistency.
*/
- if (mPtr == NULL || mPtr->typePtr == NULL) {
+ if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
return;
}
@@ -1001,6 +1015,8 @@ TclOOGetCallContext(
if (flags & FORCE_UNKNOWN) {
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1024,21 +1040,32 @@ TclOOGetCallContext(
doFilters = 1;
Tcl_InitObjHashTable(&doneFilters);
FOREACH(mixinPtr, oPtr->mixins) {
- AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
+ TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
+ OBJECT_MIXIN);
}
FOREACH(filterObj, oPtr->filters) {
+ AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
+ BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
NULL);
}
- AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
+ AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+ BUILDING_MIXINS);
+ AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+ 0);
Tcl_DeleteHashTable(&doneFilters);
}
count = cb.filterLength = callPtr->numChain;
/*
- * Add the actual method implementations.
+ * Add the actual method implementations. We have to do this twice to
+ * handle class mixins right.
*/
+ AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
+ flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1058,6 +1085,8 @@ TclOOGetCallContext(
return NULL;
}
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1201,7 +1230,9 @@ TclOOGetStereotypeCallChain(
*/
Tcl_InitObjHashTable(&doneFilters);
- AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters);
+ AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
+ BUILDING_MIXINS);
+ AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
Tcl_DeleteHashTable(&doneFilters);
count = cb.filterLength = callPtr->numChain;
@@ -1209,6 +1240,8 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
+ AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
+ flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1219,6 +1252,8 @@ TclOOGetStereotypeCallChain(
if (count == callPtr->numChain) {
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
+ NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
@@ -1259,12 +1294,15 @@ AddClassFiltersToCallContext(
Class *clsPtr, /* Class to get the filters from. */
struct ChainBuilder *const cbPtr,
/* Context to fill with call chain entries. */
- Tcl_HashTable *const doneFilters)
+ Tcl_HashTable *const doneFilters,
/* Where to record what filters have been
* processed. Keys are objects, values are
* ignored. */
+ int flags) /* Whether we've gone along a mixin link
+ * yet. */
{
- int i;
+ int i, clearedFlags =
+ flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
Class *superPtr, *mixinPtr;
Tcl_Obj *filterObj;
@@ -1279,7 +1317,8 @@ AddClassFiltersToCallContext(
*/
FOREACH(mixinPtr, clsPtr->mixins) {
- AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
+ AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
+ flags|TRAVERSED_MIXIN);
}
/*
@@ -1288,13 +1327,18 @@ AddClassFiltersToCallContext(
* override how filters work to extend their behaviour.
*/
- FOREACH(filterObj, clsPtr->filters) {
- int isNew;
+ if (MIXIN_CONSISTENT(flags)) {
+ FOREACH(filterObj, clsPtr->filters) {
+ int isNew;
- (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
- if (isNew) {
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
- 0, clsPtr);
+ (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
+ &isNew);
+ if (isNew) {
+ AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
+ AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ doneFilters, clearedFlags, clsPtr);
+ }
}
}
@@ -1308,7 +1352,8 @@ AddClassFiltersToCallContext(
goto tailRecurse;
default:
FOREACH(superPtr, clsPtr->superclasses) {
- AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
+ AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
+ flags);
}
case 0:
return;
@@ -1355,16 +1400,16 @@ AddSimpleClassChainToCallContext(
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (flags & CONSTRUCTOR) {
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
- filterDecl);
+ filterDecl, flags);
} else if (flags & DESTRUCTOR) {
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
- filterDecl);
+ filterDecl, flags);
} else {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodNameObj);
@@ -1383,7 +1428,7 @@ AddSimpleClassChainToCallContext(
flags |= DEFINITE_PROTECTED;
}
}
- AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
}
}
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index ddf888a..5cb8027 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -287,7 +287,7 @@ TclFreeAllocCache(
*nextPtrPtr = cachePtr->nextPtr;
cachePtr->nextPtr = NULL;
Tcl_MutexUnlock(listLockPtr);
- free(cachePtr);
+ TclpSysFree(cachePtr);
}
/*
@@ -332,7 +332,7 @@ TclpAlloc(
/*
* Increment the requested size to include room for the Block structure.
- * Call malloc() directly if the required amount is greater than the
+ * Call TclpSysAlloc() directly if the required amount is greater than the
* largest block, otherwise pop the smallest block large enough,
* allocating more blocks if necessary.
*/
@@ -344,7 +344,7 @@ TclpAlloc(
#endif
if (size > MAXALLOC) {
bucket = NBUCKETS;
- blockPtr = malloc(size);
+ blockPtr = TclpSysAlloc(size, 0);
if (blockPtr != NULL) {
cachePtr->totalAssigned += reqSize;
}
@@ -407,7 +407,7 @@ TclpFree(
bucket = blockPtr->sourceBucket;
if (bucket == NBUCKETS) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
- free(blockPtr);
+ TclpSysFree(blockPtr);
return;
}
@@ -472,7 +472,7 @@ TclpRealloc(
/*
* If the block is not a system block and fits in place, simply return the
* existing pointer. Otherwise, if the block is a system block and the new
- * size would also require a system block, call realloc() directly.
+ * size would also require a system block, call TclpSysRealloc() directly.
*/
blockPtr = Ptr2Block(ptr);
@@ -495,7 +495,7 @@ TclpRealloc(
} else if (size > MAXALLOC) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
cachePtr->totalAssigned += reqSize;
- blockPtr = realloc(blockPtr, size);
+ blockPtr = TclpSysRealloc(blockPtr, size);
if (blockPtr == NULL) {
return NULL;
}
@@ -567,7 +567,7 @@ TclThreadAllocObj(void)
Tcl_Obj *newObjsPtr;
cachePtr->numObjects = numMove = NOBJALLOC;
- newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
+ newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
if (newObjsPtr == NULL) {
Tcl_Panic("alloc: could not allocate %d new objects", numMove);
}
@@ -964,7 +964,7 @@ GetBlocks(
if (blockPtr == NULL) {
size = MAXALLOC;
- blockPtr = malloc(size);
+ blockPtr = TclpSysAlloc(size, 0);
if (blockPtr == NULL) {
return 0;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 06e18fe..956e3f9 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -26,7 +26,7 @@
* interface, even if that is mostly true).
*/
-#define TCL_ZLIB_VERSION "2.0"
+#define TCL_ZLIB_VERSION "2.0.1"
/*
* Magic flags used with wbits fields to indicate that we're handling the gzip