summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-03-10 14:52:13 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-03-10 14:52:13 (GMT)
commit5dcb1f9d84afc356cd64d639642cf059ef6c566c (patch)
tree737e0d284648cea10f59a6a1b78fcb3f194944ae /generic
parent62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f (diff)
parenta4400dbc29df9167ce93222e822d8f2868215f8a (diff)
downloadtcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.zip
tcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.tar.gz
tcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.tar.bz2
Merge to feature branch
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAlloc.c4
-rw-r--r--generic/tclCmdMZ.c3
-rw-r--r--generic/tclCompExpr.c6
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclEnv.c4
-rw-r--r--generic/tclEvent.c1
-rw-r--r--generic/tclIO.c5
-rw-r--r--generic/tclIOCmd.c141
-rw-r--r--generic/tclIORChan.c2
-rw-r--r--generic/tclIORTrans.c2
-rw-r--r--generic/tclLiteral.c3
-rw-r--r--generic/tclNotify.c1
-rw-r--r--generic/tclParse.c16
-rw-r--r--generic/tclStringObj.c209
-rw-r--r--generic/tclUtil.c1
-rw-r--r--generic/tclZlib.c48
16 files changed, 266 insertions, 186 deletions
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 51f99e7..6fff92b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -702,7 +702,7 @@ char *
TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
- return (char*) malloc(numBytes);
+ return (char *) malloc(numBytes);
}
/*
@@ -750,7 +750,7 @@ TclpRealloc(
char *oldPtr, /* Pointer to alloced block. */
unsigned int numBytes) /* New size of memory. */
{
- return (char*) realloc(oldPtr, numBytes);
+ return (char *) realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cf375b4e..26831c3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3923,6 +3923,7 @@ TclNRSwitchObjCmd(
INT2PTR(pc), (ClientData) pattern);
return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
}
+
static int
SwitchPostProc(
ClientData data[], /* Data passed from Tcl_NRAddCallback above */
@@ -4772,7 +4773,7 @@ TclListLines(
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
- int *clNext= (clLocPtr ? &clLocPtr->loc[0] : NULL);
+ int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 1d42b81..34deff7 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1333,13 +1333,12 @@ ParseExpr(
numBytes -= scanned;
} /* main parsing loop */
- error:
-
/*
* We only get here if there's been an error. Any errors that didn't get a
* suitable parsePtr->errorType, get recorded as syntax errors.
*/
+ error:
if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
parsePtr->errorType = TCL_PARSE_SYNTAX;
}
@@ -1349,7 +1348,7 @@ ParseExpr(
*/
if (nodes != NULL) {
- ckfree((char*) nodes);
+ ckfree((char *) nodes);
}
if (interp == NULL) {
@@ -1361,7 +1360,6 @@ ParseExpr(
Tcl_DecrRefCount(msg);
}
} else {
-
/*
* Construct the complete error message. Start with the simple error
* message, pulled from the interp result if necessary...
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 9dcafb4..4f04403 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1765,6 +1765,7 @@ TclCompileScript(
* unmodified. We care only if the we are in a context
* which already allows absolute counting.
*/
+
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
@@ -1813,7 +1814,6 @@ TclCompileScript(
&isnew);
Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
-
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
@@ -2661,7 +2661,7 @@ TclExpandCodeArray(
*/
size_t currBytes = envPtr->codeNext - envPtr->codeStart;
- size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
+ size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
if (envPtr->mallocedCodeArray) {
envPtr->codeStart = (unsigned char *)
@@ -2728,7 +2728,7 @@ EnterCmdStartData(
*/
size_t currElems = envPtr->cmdMapEnd;
- size_t newElems = 2*currElems;
+ size_t newElems = 2 * currElems;
size_t currBytes = currElems * sizeof(CmdLocation);
size_t newBytes = newElems * sizeof(CmdLocation);
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index bd710d6..4a52bea 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -649,8 +649,8 @@ ReplaceString(
env.cache = (char **) ckrealloc((char *) env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, (int) 0,
- (size_t) (growth-1) * sizeof(char*));
+ (void) memset(env.cache+env.cacheSize+1, 0,
+ (size_t) (growth-1) * sizeof(char *));
env.cacheSize += growth;
}
}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index b4b5299..ad20626 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -119,7 +119,6 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
-
/*
*----------------------------------------------------------------------
diff --git a/generic/tclIO.c b/generic/tclIO.c
index d0ebe21..7abbba4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3292,10 +3292,11 @@ CloseWrite(
* interpreter */
{
/* Notes: clear-channel-handlers - write side only ? or keep around, just
- * not called */
+ * not called. */
/* No close cllbacks are run - channel is still open (read side) */
- ChannelState *statePtr = chanPtr->state; /* State of real IO channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State of real IO channel. */
int flushcode;
int result = 0;
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index c889862..abbe002 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,8 +16,8 @@
*/
typedef struct AcceptCallback {
- char *script; /* Script to invoke. */
- Tcl_Interp *interp; /* Interpreter in which to run it. */
+ char *script; /* Script to invoke. */
+ Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
/*
@@ -117,12 +117,12 @@ Tcl_PutsObjCmd(
ThreadSpecificData *tsdPtr;
switch (objc) {
- case 2: /* [puts $x] */
+ case 2: /* [puts $x] */
string = objv[1];
newline = 1;
break;
- case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+ case 3: /* [puts -nonewline $x] or [puts $chan $x] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
} else {
@@ -132,7 +132,8 @@ Tcl_PutsObjCmd(
string = objv[2];
break;
- case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
+ case 4: /* [puts -nonewline $chan $x] or
+ * [puts $chan $x nonewline] */
newline = 0;
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
@@ -153,8 +154,8 @@ Tcl_PutsObjCmd(
#endif
}
/* Fall through */
- default:
- /* [puts] or [puts some bad number of arguments...] */
+ default: /* [puts] or
+ * [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
@@ -200,9 +201,8 @@ Tcl_PutsObjCmd(
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error writing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "error writing \"", TclGetString(chanObjPtr),
+ "\": ", Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -260,8 +260,8 @@ Tcl_FlushObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error flushing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
+ NULL);
}
return TCL_ERROR;
}
@@ -319,10 +319,10 @@ Tcl_GetsObjCmd(
Tcl_DecrRefCount(linePtr);
/*
- * TIP #219. Capture error messages put by the driver into the
- * bypass area and put them into the regular interpreter result.
- * Fall back to the regular message if nothing was found in the
- * bypass.
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area
+ * and put them into the regular interpreter result. Fall back to
+ * the regular message if nothing was found in the bypass.
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
@@ -341,7 +341,6 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
@@ -417,7 +416,7 @@ Tcl_ReadObjCmd(
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
- i++; /* Consumed channel name. */
+ i++; /* Consumed channel name. */
/*
* Compute how many bytes to read.
@@ -425,7 +424,8 @@ Tcl_ReadObjCmd(
toRead = -1;
if (i < objc) {
- if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) {
+ if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
+ || (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
@@ -462,8 +462,8 @@ Tcl_ReadObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
+ NULL);
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
@@ -550,10 +550,11 @@ Tcl_SeekObjCmd(
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
+
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error during seek on \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
+ NULL);
}
return TCL_ERROR;
}
@@ -644,6 +645,10 @@ Tcl_CloseObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
+ static const char *const dirOptions[] = {
+ "read", "write", NULL
+ };
+ static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
@@ -655,21 +660,17 @@ Tcl_CloseObjCmd(
}
if (objc == 3) {
- int optionIndex, dir;
- static const char *const dirOptions[] = {
- "read", "write", NULL
- };
- static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+ int index, dir;
/*
* Get direction requested to close, and check syntax.
*/
if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
- &optionIndex) != TCL_OK) {
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- dir = dirArray[optionIndex];
+ dir = dirArray[index];
/*
* Check direction against channel mode. It is an error if we try to
@@ -678,8 +679,7 @@ Tcl_CloseObjCmd(
*/
if (!(dir & Tcl_GetChannelMode(chan))) {
- Tcl_AppendResult(interp, "Half-close of ",
- dirOptions[optionIndex],
+ Tcl_AppendResult(interp, "Half-close of ", dirOptions[index],
"-side not possible, side not opened or already closed",
NULL);
return TCL_ERROR;
@@ -758,8 +758,7 @@ Tcl_FconfigureObjCmd(
int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "channelId ?-option value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
return TCL_ERROR;
}
@@ -870,14 +869,9 @@ Tcl_ExecObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- /*
- * This function generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
Tcl_Obj *resultPtr;
- const char **argv;
+ const char **argv; /* An array for the string arguments. Stored
+ * on the _Tcl_ stack. */
const char *string;
Tcl_Channel chan;
int argc, background, i, index, keepNewline, result, skip, length;
@@ -935,8 +929,7 @@ Tcl_ExecObjCmd(
*/
argc = objc - skip;
- argv = (const char **)
- TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+ argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
/*
* Copy the string conversions of each (post option) object into the
@@ -948,7 +941,7 @@ Tcl_ExecObjCmd(
}
argv[argc] = NULL;
chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
- (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
+ ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
/*
* Free the argv array.
@@ -1108,11 +1101,13 @@ Tcl_OpenObjCmd(
int code = TCL_ERROR;
int scanned = TclParseAllWhiteSpace(permString, -1);
- /* Support legacy octal numbers */
+ /*
+ * Support legacy octal numbers.
+ */
+
if ((permString[scanned] == '0')
&& (permString[scanned+1] >= '0')
&& (permString[scanned+1] <= '7')) {
-
Tcl_Obj *permObj;
TclNewLiteralStringObj(permObj, "0o");
@@ -1259,13 +1254,12 @@ RegisterTcpServerInterpCleanup(
Tcl_HashEntry *hPtr; /* Entry for this record. */
int isNew; /* Is the entry new? */
- hTblPtr = (Tcl_HashTable *)
- Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
- (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+ Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, hTblPtr);
}
@@ -1306,8 +1300,7 @@ UnregisterTcpServerInterpCleanupProc(
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
return;
}
@@ -1345,7 +1338,7 @@ AcceptCallbackProc(
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
@@ -1390,8 +1383,8 @@ AcceptCallbackProc(
Tcl_Release(script);
} else {
/*
- * The interpreter has been deleted, so there is no useful way to
- * utilize the client socket - just close it.
+ * The interpreter has been deleted, so there is no useful way to use
+ * the client socket - just close it.
*/
Tcl_Close(NULL, chan);
@@ -1424,7 +1417,7 @@ TcpServerCloseProc(
ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/* The actual data. */
if (acceptCallbackPtr->interp != NULL) {
@@ -1955,25 +1948,25 @@ TclInitChanCmd(
* function at the moment.
*/
static const EnsembleImplMap initMap[] = {
- {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL, 0},
- {"close", Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
- {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
- {"create", TclChanCreateObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"eof", Tcl_EofObjCmd, NULL, NULL, NULL, 0},
- {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
- {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
- {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
- {"names", TclChannelNamesCmd, NULL, NULL, NULL, 0},
- {"pending", ChanPendingObjCmd, NULL, NULL, NULL, 0}, /* TIP #287 */
- {"pop", TclChanPopObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"push", TclChanPushObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
- {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
- {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
- {"pipe", ChanPipeObjCmd, NULL, NULL, NULL, 0}, /* TIP #304 */
- {"tell", Tcl_TellObjCmd, NULL, NULL, NULL, 0},
- {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL, 0}, /* TIP #208 */
+ {"blocked", Tcl_FblockedObjCmd},
+ {"close", Tcl_CloseObjCmd},
+ {"copy", Tcl_FcopyObjCmd},
+ {"create", TclChanCreateObjCmd}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd},
+ {"event", Tcl_FileEventObjCmd},
+ {"flush", Tcl_FlushObjCmd},
+ {"gets", Tcl_GetsObjCmd},
+ {"names", TclChannelNamesCmd},
+ {"pending", ChanPendingObjCmd}, /* TIP #287 */
+ {"pop", TclChanPopObjCmd}, /* TIP #230 */
+ {"postevent", TclChanPostEventObjCmd}, /* TIP #219 */
+ {"push", TclChanPushObjCmd}, /* TIP #230 */
+ {"puts", Tcl_PutsObjCmd},
+ {"read", Tcl_ReadObjCmd},
+ {"seek", Tcl_SeekObjCmd},
+ {"pipe", ChanPipeObjCmd}, /* TIP #304 */
+ {"tell", Tcl_TellObjCmd},
+ {"truncate", ChanTruncateObjCmd}, /* TIP #208 */
{NULL, NULL, NULL, NULL, NULL, 0}
};
static const char *const extras[] = {
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 3751d6c..b3e3fde 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2381,7 +2381,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
- code = - EAGAIN;
+ code = -EAGAIN;
} else {
code = 0;
}
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index f888bde..ec3a266 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -440,7 +440,7 @@ static const char *msg_dstlost =
* information waiting in buffers (fileevent support).
*/
-#define FLUSH_DELAY (5)
+#define FLUSH_DELAY (5)
/*
* Helper functions encapsulating some of the thread forwarding to make the
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 5af63b2..0bf3be1 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -136,9 +136,8 @@ TclCleanupLiteralTable(
typePtr->freeIntRepProc(objPtr);
didOne = 1;
break;
- } else {
- entryPtr = nextPtr;
}
+ entryPtr = nextPtr;
}
} while (didOne);
}
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index b241838..7edb192 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -362,6 +362,7 @@ Tcl_QueueEvent(
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
QueueEvent(tsdPtr, evPtr, position);
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 705a141..ff7cdd6 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -479,11 +479,11 @@ Tcl_ParseCommand(
if ((code != TCL_OK) || nakedbs) {
/*
- * Some list element could not be parsed, or contained
- * naked backslashes. This means the literal string was
- * not in fact a valid nor canonical list. Defer the
- * handling of this to compile/eval time, where code is
- * already in place to report the "attempt to expand a
+ * Some list element could not be parsed, or contained
+ * naked backslashes. This means the literal string was
+ * not in fact a valid nor canonical list. Defer the
+ * handling of this to compile/eval time, where code is
+ * already in place to report the "attempt to expand a
* non-list" error or expand lists that require
* substitution.
*/
@@ -1103,7 +1103,7 @@ ParseTokens(
}
/*
- * This is a variable reference. Call Tcl_ParseVarName to do all
+ * This is a variable reference. Call Tcl_ParseVarName to do all
* the dirty work of parsing the name.
*/
@@ -1127,7 +1127,7 @@ ParseTokens(
}
/*
- * Command substitution. Call Tcl_ParseCommand recursively (and
+ * Command substitution. Call Tcl_ParseCommand recursively (and
* repeatedly) to parse the nested command(s), then throw away the
* parse information.
*/
@@ -1875,10 +1875,10 @@ Tcl_ParseQuotedString(
* None.
*
* Side effects:
-
* The Tcl_Parse struct '*parsePtr' is filled with parse results.
* The caller is expected to eventually call Tcl_FreeParse() to properly
* cleanup the value written there.
+ *
* If a parse error occurs, the Tcl_InterpState value '*statePtr' is
* filled with the state created by that error. When *statePtr is written
* to, the caller is expected to make the required calls to either
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 142cdd4..956a9f0 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -40,9 +40,10 @@
/*
* Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
* This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
+ * impact on performance. If things go well, this mechanism can go away when
* post-8.6 development begins.
*/
+
#define COMPAT 0
/*
@@ -141,7 +142,7 @@ typedef struct String {
((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
-
+
/*
* TCL STRING GROWTH ALGORITHM
*
@@ -186,11 +187,13 @@ GrowStringBuffer(
int needed,
int flag)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
*/
+
String *stringPtr = GET_STRING(objPtr);
char *ptr = NULL;
int attempt;
@@ -208,15 +211,20 @@ GrowStringBuffer(
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = INT_MAX - needed;
unsigned int extra = needed - objPtr->length + TCL_GROWTH_MIN_ALLOC;
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
ptr = attemptckrealloc(objPtr->bytes, (unsigned) attempt + 1);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
ptr = ckrealloc(objPtr->bytes, (unsigned) attempt + 1);
}
@@ -229,16 +237,21 @@ GrowUnicodeBuffer(
Tcl_Obj *objPtr,
int needed)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
*/
+
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
int attempt;
if (stringPtr->maxChars > 0) {
- /* Subsequent appends - apply the growth algorithm. */
+ /*
+ * Subsequent appends - apply the growth algorithm.
+ */
+
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
@@ -248,16 +261,21 @@ GrowUnicodeBuffer(
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
+ TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
ptr = stringRealloc(stringPtr, attempt);
}
@@ -473,7 +491,10 @@ Tcl_GetCharLength(
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
@@ -481,8 +502,8 @@ Tcl_GetCharLength(
#if COMPAT
if (numChars < objPtr->length) {
/*
- * Since we've just computed the number of chars, and not all
- * UTF chars are 1-byte long, go ahead and populate the unicode
+ * Since we've just computed the number of chars, and not all UTF
+ * chars are 1-byte long, go ahead and populate the unicode
* string.
*/
@@ -538,7 +559,10 @@ Tcl_GetUniChar(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
@@ -669,14 +693,20 @@ Tcl_GetRange(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
- /* Since we know the char length of the result, store it. */
+ /*
+ * Since we know the char length of the result, store it.
+ */
+
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
@@ -832,14 +862,17 @@ Tcl_SetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string
+ */
+
stringPtr->numChars = length;
stringPtr->unicode[length] = 0;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
}
@@ -879,9 +912,10 @@ Tcl_AttemptSetObjLength(
if (length < 0) {
/*
- * Setting to a negative length is nonsense. This is probably the
+ * Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
+
return 0;
}
if (Tcl_IsShared(objPtr)) {
@@ -902,6 +936,7 @@ Tcl_AttemptSetObjLength(
/*
* Need to enlarge the buffer.
*/
+
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
@@ -942,14 +977,17 @@ Tcl_AttemptSetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string.
+ */
+
stringPtr->unicode[length] = 0;
stringPtr->numChars = length;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
return 1;
@@ -1370,12 +1408,14 @@ AppendUnicodeToUnicodeRep(
stringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (unicode >= stringPtr->unicode
&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
offset = unicode - stringPtr->unicode;
@@ -1384,7 +1424,10 @@ AppendUnicodeToUnicodeRep(
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
- /* Relocate unicode if needed; see above. */
+ /*
+ * Relocate unicode if needed; see above.
+ */
+
if (offset >= 0) {
unicode = stringPtr->unicode + offset;
}
@@ -1436,7 +1479,10 @@ AppendUnicodeToUtfRep(
}
#if COMPAT
- /* Invalidate the unicode rep */
+ /*
+ * Invalidate the unicode rep.
+ */
+
stringPtr->hasUnicode = 0;
#endif
}
@@ -1448,7 +1494,7 @@ AppendUnicodeToUtfRep(
*
* This function converts the contents of "bytes" to Unicode and appends
* the Unicode to the Unicode rep of "objPtr". objPtr must already have a
- * valid Unicode rep. numBytes must be non-negative.
+ * valid Unicode rep. numBytes must be non-negative.
*
* Results:
* None.
@@ -1524,22 +1570,30 @@ AppendUtfToUtfRep(
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
- /* TODO: consider passing flag=1: no overalloc on first append.
- * This would make test stringObj-8.1 fail.*/
+ /*
+ * TODO: consider passing flag=1: no overalloc on first append. This
+ * would make test stringObj-8.1 fail.
+ */
+
GrowStringBuffer(objPtr, newLength, 0);
- /* Relocate bytes if needed; see above. */
+ /*
+ * Relocate bytes if needed; see above.
+ */
+
if (offset >= 0) {
bytes = objPtr->bytes + offset;
}
@@ -1587,6 +1641,7 @@ Tcl_AppendStringsToObjVA(
while (1) {
const char *bytes = va_arg(argList, char *);
+
if (bytes == NULL) {
break;
}
@@ -2070,8 +2125,7 @@ Tcl_AppendFormatToObj(
case 'b': {
Tcl_WideUInt bits = (Tcl_WideUInt) 0;
Tcl_WideInt numDigits = (Tcl_WideInt) 0;
- int length, numBits = 4, base = 16;
- int index = 0, shift = 0;
+ int length, numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
@@ -2355,6 +2409,7 @@ Tcl_Format(
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
+
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
@@ -2400,7 +2455,6 @@ AppendPrintfToObjVA(
}
do {
switch (*p) {
-
case '\0':
seekingConversion = 0;
break;
@@ -2453,11 +2507,11 @@ AppendPrintfToObjVA(
case -1:
case 0:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- (long int)va_arg(argList, int)));
+ (long) va_arg(argList, int)));
break;
case 1:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- va_arg(argList, long int)));
+ va_arg(argList, long)));
break;
}
break;
@@ -2471,7 +2525,7 @@ AppendPrintfToObjVA(
seekingConversion = 0;
break;
case '*':
- lastNum = (int)va_arg(argList, int);
+ lastNum = (int) va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
@@ -2573,8 +2627,8 @@ Tcl_ObjPrintf(
*
* Results:
* An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be
- * the argument with modifications done in place.
+ * supplied. When sharing rules permit, the returned value might be the
+ * argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -2602,7 +2656,10 @@ TclStringObjReverse(
return objPtr;
}
if (stringPtr->numChars == objPtr->length) {
- /* All one-byte chars. Reverse in objPtr->bytes. */
+ /*
+ * All one-byte chars. Reverse in objPtr->bytes.
+ */
+
if (Tcl_IsShared(objPtr)) {
resultPtr = Tcl_NewObj();
Tcl_SetObjLength(resultPtr, objPtr->length);
@@ -2613,11 +2670,16 @@ TclStringObjReverse(
}
return resultPtr;
}
- /* Unshared. Reverse objPtr->bytes in place. */
+
+ /*
+ * Unshared. Reverse objPtr->bytes in place.
+ */
+
dest = objPtr->bytes;
src = dest + objPtr->length - 1;
while (dest < src) {
char tmp = *src;
+
*src-- = *dest;
*dest++ = tmp;
}
@@ -2630,7 +2692,10 @@ TclStringObjReverse(
return objPtr;
}
- /* Reverse the Unicode rep. */
+ /*
+ * Reverse the Unicode rep.
+ */
+
if (Tcl_IsShared(objPtr)) {
Tcl_UniChar ch = 0;
@@ -2649,11 +2714,15 @@ TclStringObjReverse(
return resultPtr;
}
- /* Unshared. Reverse objPtr->bytes in place. */
+ /*
+ * Unshared. Reverse objPtr->bytes in place.
+ */
+
udest = stringPtr->unicode;
usrc = udest + stringPtr->numChars - 1;
while (udest < usrc) {
Tcl_UniChar tmp = *usrc;
+
*usrc-- = *udest;
*udest++ = tmp;
}
@@ -2686,6 +2755,7 @@ FillUnicodeRep(
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
+
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars);
}
@@ -2754,15 +2824,17 @@ DupStringInternalRep(
#if COMPAT==0
if (srcStringPtr->numChars == -1) {
/*
- * The String struct in the source value holds zero useful data.
- * Don't bother copying it. Don't even bother allocating space in
- * which to copy it. Just let the copy be untyped.
+ * The String struct in the source value holds zero useful data. Don't
+ * bother copying it. Don't even bother allocating space in which to
+ * copy it. Just let the copy be untyped.
*/
+
return;
}
if (srcStringPtr->hasUnicode) {
int copyMaxChars;
+
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
copyMaxChars = 2 * srcStringPtr->numChars;
} else {
@@ -2782,12 +2854,13 @@ DupStringInternalRep(
copyStringPtr->numChars = srcStringPtr->numChars;
/*
- * Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * Tricky point: the string value was copied by generic object management
+ * code, so it doesn't contain any extra bytes that might exist in the
+ * source object.
*/
+
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else
+#else /* COMPAT!=0 */
/*
* If the src obj is a string of 1-byte Utf chars, then copy the string
* rep of the source object and create an "empty" Unicode internal rep for
@@ -2796,7 +2869,10 @@ DupStringInternalRep(
*/
if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
- /* Copy the full allocation for the Unicode buffer. */
+ /*
+ * Copy the full allocation for the Unicode buffer.
+ */
+
copyStringPtr = stringAlloc(srcStringPtr->maxChars);
copyStringPtr->maxChars = srcStringPtr->maxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
@@ -2807,16 +2883,18 @@ DupStringInternalRep(
copyStringPtr = stringAlloc(0);
copyStringPtr->unicode[0] = 0;
copyStringPtr->maxChars = 0;
+
/*
* Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * management code, so it doesn't contain any extra bytes that might
+ * exist in the source object.
*/
+
copyStringPtr->allocated = copyPtr->length;
}
copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif
+#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
@@ -2848,7 +2926,7 @@ SetStringFromAny(
String *stringPtr = stringAlloc(0);
/*
- * Convert whatever we have into an untyped value. Just A String.
+ * Convert whatever we have into an untyped value. Just A String.
*/
(void) TclGetString(objPtr);
@@ -2892,6 +2970,7 @@ UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
String *stringPtr = GET_STRING(objPtr);
+
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
@@ -2906,10 +2985,12 @@ ExtendStringRepWithUnicode(
const Tcl_UniChar *unicode,
int numChars)
{
+ /*
+ * Pre-condition: this is the "string" Tcl_ObjType.
+ */
+
int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
-
- /* Pre-condition: this is the "string" Tcl_ObjType */
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
@@ -2925,7 +3006,10 @@ ExtendStringRepWithUnicode(
}
size = origLength = objPtr->length;
- /* Quick cheap check in case we have more than enough room. */
+ /*
+ * Quick cheap check in case we have more than enough room.
+ */
+
if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
@@ -2938,12 +3022,15 @@ ExtendStringRepWithUnicode(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- /* Grow space if needed */
+ /*
+ * Grow space if needed.
+ */
+
if (size > stringPtr->allocated) {
GrowStringBuffer(objPtr, size, 1);
}
- copyBytes:
+ copyBytes:
dst = objPtr->bytes + origLength;
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf((int) unicode[i], dst);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d77c276..c3c340b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1952,6 +1952,7 @@ Tcl_DStringResult(
* result of interp. */
{
Interp *iPtr = (Interp *) interp;
+
Tcl_ResetResult(interp);
if (dsPtr->string != dsPtr->staticSpace) {
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 7f17bc7..6dabd44 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -122,30 +122,30 @@ typedef struct {
* Prototypes for private procedures defined later in this file:
*/
-static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
-static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
-static Tcl_DriverCloseProc ZlibTransformClose;
-static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
-static Tcl_DriverGetOptionProc ZlibTransformGetOption;
-static Tcl_DriverHandlerProc ZlibTransformHandler;
-static Tcl_DriverInputProc ZlibTransformInput;
-static Tcl_DriverOutputProc ZlibTransformOutput;
-static Tcl_DriverSetOptionProc ZlibTransformSetOption;
-static Tcl_DriverWatchProc ZlibTransformWatch;
-static Tcl_ObjCmdProc ZlibCmd;
-static Tcl_ObjCmdProc ZlibStreamCmd;
-
-static void ConvertError(Tcl_Interp *interp, int code);
-static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
-static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
- GzipHeader *headerPtr, int *extraSizePtr);
-static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
- int mode, int format, int level,
- Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
-static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
-static void ZlibTransformTimerKill(ZlibChannelData *cd);
-static void ZlibTransformTimerRun(ClientData clientData);
-static void ZlibTransformTimerSetup(ZlibChannelData *cd);
+static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
+static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
+static Tcl_DriverCloseProc ZlibTransformClose;
+static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
+static Tcl_DriverGetOptionProc ZlibTransformGetOption;
+static Tcl_DriverHandlerProc ZlibTransformHandler;
+static Tcl_DriverInputProc ZlibTransformInput;
+static Tcl_DriverOutputProc ZlibTransformOutput;
+static Tcl_DriverSetOptionProc ZlibTransformSetOption;
+static Tcl_DriverWatchProc ZlibTransformWatch;
+static Tcl_ObjCmdProc ZlibCmd;
+static Tcl_ObjCmdProc ZlibStreamCmd;
+
+static void ConvertError(Tcl_Interp *interp, int code);
+static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
+static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
+ GzipHeader *headerPtr, int *extraSizePtr);
+static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
+ int mode, int format, int level,
+ Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
+static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
+static void ZlibTransformTimerKill(ZlibChannelData *cd);
+static void ZlibTransformTimerRun(ClientData clientData);
+static void ZlibTransformTimerSetup(ZlibChannelData *cd);
/*
* Type of zlib-based compressing and decompressing channels.