summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclClock.c39
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclExecute.c10
-rw-r--r--generic/tclIO.c443
-rw-r--r--generic/tclIO.h1
-rw-r--r--generic/tclIOCmd.c32
-rw-r--r--generic/tclIOGT.c137
-rw-r--r--generic/tclIORChan.c297
-rw-r--r--generic/tclInt.h19
-rw-r--r--generic/tclIntPlatDecls.h8
-rw-r--r--generic/tclStubInit.c18
-rw-r--r--generic/tclThread.c8
-rw-r--r--generic/tclThreadAlloc.c27
-rw-r--r--generic/tclUtil.c2
14 files changed, 612 insertions, 441 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 5b95ae6..3ec94fb 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -548,19 +548,22 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr,
&(fields.dayOfMonth)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -639,21 +642,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.iso8601Year)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.iso8601Week)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.dayOfWeek)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6fd468c..70943e9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1345,7 +1345,7 @@ StringIndexCmd(
* Unicode string rep to get the index'th char.
*/
- if (objv[1]->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(objv[1])) {
const unsigned char *string =
Tcl_GetByteArrayFromObj(objv[1], &length);
@@ -2086,7 +2086,7 @@ StringRangeCmd(
* Unicode string rep to get the range.
*/
- if (objv[1]->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(objv[1])) {
string = Tcl_GetByteArrayFromObj(objv[1], &length);
length--;
} else {
@@ -2537,8 +2537,8 @@ StringEqualCmd(
return TCL_OK;
}
- if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
- objv[1]->typePtr == &tclByteArrayType) {
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
@@ -2684,8 +2684,8 @@ StringCmpCmd(
return TCL_OK;
}
- if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
- objv[1]->typePtr == &tclByteArrayType) {
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2e396e8..c4f9836 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4235,8 +4235,8 @@ TclExecuteByteCode(
*/
iResult = s1len = s2len = 0;
- } else if ((valuePtr->typePtr == &tclByteArrayType)
- && (value2Ptr->typePtr == &tclByteArrayType)) {
+ } else if (TclIsPureByteArray(valuePtr)
+ && TclIsPureByteArray(value2Ptr)) {
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
iResult = memcmp(s1, s2,
@@ -4354,7 +4354,7 @@ TclExecuteByteCode(
* use the Unicode string rep to get the index'th char.
*/
- if (valuePtr->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(valuePtr)) {
bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
} else {
/*
@@ -4370,7 +4370,7 @@ TclExecuteByteCode(
}
if ((index >= 0) && (index < length)) {
- if (valuePtr->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
(&bytes[index]), 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
@@ -4422,7 +4422,7 @@ TclExecuteByteCode(
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
match = TclUniCharMatch(ustring1, length1, ustring2, length2,
nocase);
- } else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+ } else if (TclIsPureByteArray(valuePtr) && !nocase) {
unsigned char *string1, *string2;
int length1, length2;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index a62f80e..41f555b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -164,6 +164,9 @@ typedef struct CloseCallback {
*/
static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
static void ChannelTimerProc(ClientData clientData);
static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
@@ -296,6 +299,7 @@ static int WillRead(Channel *chanPtr);
#define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag))
#define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag))
+#define GotFlag(statePtr, flag) ((statePtr)->flags & (flag))
/*
* Macro for testing whether a string (in optionName, length len) matches a
@@ -347,25 +351,24 @@ static Tcl_ObjType chanObjType = {
*
* ChanRead --
*
- * Read up to dstsize bytes using the inputProc of chanPtr, store
+ * Read up to dstSize bytes using the inputProc of chanPtr, store
* them at dst, and return the number of bytes stored.
*
* Results:
- * The return value of the driver inputProc,
- * - number of bytes stored at dst, or
+ * The return value of the driver inputProc,
+ * - number of bytes stored at dst, ot
* - -1 on error, with a Posix error code available to the
* caller by calling Tcl_GetErrno().
*
* Side effects:
- * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel
- * state are set as appropriate.
- * On EOF, the inputEncodingFlags are set to perform ending
- * operations on decoding.
+ * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
+ * set as appropriate.
+ * On EOF, the inputEncodingFlags are set to perform ending operations
+ * on decoding.
* TODO - Is this really the right place for that?
*
*---------------------------------------------------------------------------
*/
-
static int
ChanRead(
Channel *chanPtr,
@@ -376,7 +379,7 @@ ChanRead(
/*
* If the caller asked for zero bytes, we'd force the inputProc
- * to return zero bytes, and then misinterpret that as EOF
+ * to return zero bytes, and then misinterpret that as EOF.
*/
assert(dstSize > 0);
@@ -387,12 +390,14 @@ ChanRead(
bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
dst, dstSize, &result);
+ /* Stop any flag leakage through stacked channel levels */
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
if (bytesRead > 0) {
/*
- * If we get a short read, signal up that we may be BLOCKED. We should
- * avoid calling the driver because on some platforms we will block in
- * the low level reading code even though the channel is set into
- * nonblocking mode.
+ * If we get a short read, signal up that we may be BLOCKED.
+ * We should avoid calling the driver because on some
+ * platforms we will block in the low level reading code even
+ * though the channel is set into nonblocking mode.
*/
if (bytesRead < dstSize) {
@@ -401,7 +406,7 @@ ChanRead(
} else if (bytesRead == 0) {
SetFlag(chanPtr->state, CHANNEL_EOF);
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
- } else { /* bytesRead < 0 */
+ } else if (bytesRead < 0) {
if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
SetFlag(chanPtr->state, CHANNEL_BLOCKED);
result = EAGAIN;
@@ -511,7 +516,7 @@ TclFinalizeIOSubsystem(void)
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
- if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
+ if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
active = 1;
break;
}
@@ -608,6 +613,7 @@ Tcl_SetStdChannel(
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
switch (type) {
case TCL_STDIN:
tsdPtr->stdinInitialized = 1;
@@ -724,11 +730,9 @@ Tcl_CreateCloseHandler(
ClientData clientData) /* Arbitrary data to pass to the close
* callback. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
- statePtr = ((Channel *) chan)->state;
-
cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
@@ -764,10 +768,9 @@ Tcl_DeleteCloseHandler(
ClientData clientData) /* The callback data for the callback to
* remove. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr, *cbPrevPtr;
- statePtr = ((Channel *) chan)->state;
for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
@@ -921,7 +924,7 @@ DeleteChannelTable(
SetFlag(statePtr, CHANNEL_TAINTED);
statePtr->refCount--;
if (statePtr->refCount <= 0) {
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
@@ -1112,7 +1115,7 @@ Tcl_UnregisterChannel(
statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
- if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
Tcl_AppendResult(interp, "Illegal recursive call to close "
"through close-handler of channel", NULL);
@@ -1151,12 +1154,12 @@ Tcl_UnregisterChannel(
SetFlag(statePtr, BUFFER_READY);
}
Tcl_Preserve((ClientData)statePtr);
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
* We don't want to re-enter Tcl_Close().
*/
- if (!(statePtr->flags & CHANNEL_CLOSED)) {
+ if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
SetFlag(statePtr, CHANNEL_CLOSED);
Tcl_Release((ClientData)statePtr);
@@ -1365,7 +1368,7 @@ Tcl_GetChannel(
chanPtr = Tcl_GetHashValue(hPtr);
chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
}
return (Tcl_Channel) chanPtr;
@@ -1413,7 +1416,7 @@ TclGetChannelFromObj(
*channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
if (modePtr != NULL) {
- *modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
}
return TCL_OK;
@@ -1676,7 +1679,7 @@ Tcl_StackChannel(
* --+---+---+---+----+
*/
- if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
+ if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
Tcl_AppendResult(interp,
"reading and writing both disallowed for channel \"",
@@ -1693,15 +1696,16 @@ Tcl_StackChannel(
*/
if ((mask & TCL_WRITABLE) != 0) {
- CopyState *csPtrR;
- CopyState *csPtrW;
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtrR = statePtr->csPtrR;
statePtr->csPtrR = NULL;
-
- csPtrW = statePtr->csPtrW;
statePtr->csPtrW = NULL;
+ /*
+ * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+ * the stacking state of this channel during its operations.
+ */
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
@@ -1834,6 +1838,13 @@ Tcl_UnstackChannel(
* structure.
*/
+ /*
+ * TODO: Figure out how to handle the situation where the chan
+ * operations called below by this unstacking operation cause
+ * another unstacking recursively. In that case the downChanPtr
+ * value we're holding on to will not be the right thing.
+ */
+
Channel *downChanPtr = chanPtr->downChanPtr;
/*
@@ -1844,14 +1855,11 @@ Tcl_UnstackChannel(
* CheckForChannelErrors inside.
*/
- if (statePtr->flags & TCL_WRITABLE) {
- CopyState *csPtrR;
- CopyState *csPtrW;
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtrR = statePtr->csPtrR;
statePtr->csPtrR = NULL;
-
- csPtrW = statePtr->csPtrW;
statePtr->csPtrW = NULL;
if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
@@ -1888,16 +1896,14 @@ Tcl_UnstackChannel(
* 'DiscardInputQueued' on that.
*/
- if ((((statePtr->flags & TCL_READABLE) != 0)) &&
+ if (GotFlag(statePtr, TCL_READABLE) &&
((statePtr->inQueueHead != NULL) ||
(chanPtr->inQueueHead != NULL))) {
-
if ((statePtr->inQueueHead != NULL) &&
(chanPtr->inQueueHead != NULL)) {
statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
statePtr->inQueueHead = statePtr->inQueueTail;
-
} else if (chanPtr->inQueueHead != NULL) {
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -1954,7 +1960,7 @@ Tcl_UnstackChannel(
*/
Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
@@ -2157,7 +2163,7 @@ Tcl_GetChannelMode(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of actual channel. */
- return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
+ return GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE);
}
/*
@@ -2268,8 +2274,33 @@ AllocChannelBuffer(
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree((char *) bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -2300,9 +2331,12 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2313,7 +2347,7 @@ RecycleBuffer(
*/
if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2321,7 +2355,7 @@ RecycleBuffer(
* Only save buffers for the input queue if the channel is readable.
*/
- if (statePtr->flags & TCL_READABLE) {
+ if (GotFlag(statePtr, TCL_READABLE)) {
if (statePtr->inQueueHead == NULL) {
statePtr->inQueueHead = bufPtr;
statePtr->inQueueTail = bufPtr;
@@ -2337,7 +2371,7 @@ RecycleBuffer(
* Only save buffers for the output queue if the channel is writable.
*/
- if (statePtr->flags & TCL_WRITABLE) {
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
if (statePtr->curOutPtr == NULL) {
statePtr->curOutPtr = bufPtr;
goto keepBuffer;
@@ -2348,7 +2382,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
@@ -2410,7 +2444,7 @@ CheckForDeadChannel(
Tcl_Interp *interp, /* For error reporting (can be NULL) */
ChannelState *statePtr) /* The channel state to check. */
{
- if (statePtr->flags & CHANNEL_DEAD) {
+ if (GotFlag(statePtr, CHANNEL_DEAD)) {
Tcl_SetErrno(EINVAL);
if (interp) {
Tcl_AppendResult(interp,
@@ -2486,7 +2520,7 @@ FlushChannel(
if (((statePtr->curOutPtr != NULL) &&
IsBufferFull(statePtr->curOutPtr))
- || ((statePtr->flags & BUFFER_READY) &&
+ || (GotFlag(statePtr, BUFFER_READY) &&
(statePtr->outQueueHead == NULL))) {
ResetFlag(statePtr, BUFFER_READY);
statePtr->curOutPtr->nextPtr = NULL;
@@ -2505,8 +2539,7 @@ FlushChannel(
* is active, we just return without producing any output.
*/
- if ((!calledFromAsyncFlush) &&
- (statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
return 0;
}
@@ -2522,6 +2555,7 @@ FlushChannel(
* Produce the output on the channel.
*/
+ PreserveChannelBuffer(bufPtr);
toWrite = BytesLeft(bufPtr);
if (toWrite == 0) {
written = 0;
@@ -2543,6 +2577,7 @@ FlushChannel(
if (errorCode == EINTR) {
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
continue;
}
@@ -2559,11 +2594,12 @@ FlushChannel(
* it's a tty channel (dup'ed underneath)
*/
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
SetFlag(statePtr, BG_FLUSH_SCHEDULED);
UpdateInterest(chanPtr);
}
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
break;
}
@@ -2631,6 +2667,7 @@ FlushChannel(
*/
DiscardOutputQueued(statePtr);
+ ReleaseChannelBuffer(bufPtr);
continue;
} else {
wroteSome = 1;
@@ -2649,6 +2686,7 @@ FlushChannel(
}
RecycleBuffer(statePtr, bufPtr, 0);
}
+ ReleaseChannelBuffer(bufPtr);
} /* Closes "while (1)". */
/*
@@ -2658,7 +2696,7 @@ FlushChannel(
* data has been flushed at the system level.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
if (wroteSome) {
return errorCode;
} else if (statePtr->outQueueHead == NULL) {
@@ -2674,7 +2712,7 @@ FlushChannel(
* current output buffer.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
(statePtr->outQueueHead == NULL) &&
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
@@ -2733,7 +2771,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree((char *) statePtr->curOutPtr);
+ ReleaseChannelBuffer(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2750,7 +2788,7 @@ CloseChannel(
* device.
*/
- if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
int dummy;
char c = (char) statePtr->outEofChar;
@@ -3155,7 +3193,7 @@ Tcl_Close(
Tcl_Panic("called Tcl_Close on channel with refCount > 0");
}
- if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
Tcl_AppendResult(interp, "Illegal recursive call to close "
"through close-handler of channel", NULL);
@@ -3171,7 +3209,8 @@ Tcl_Close(
stickyError = 0;
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
if (WriteChars(chanPtr, "", 0) < 0) {
@@ -3261,7 +3300,17 @@ Tcl_Close(
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- flushcode = -1;
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
@@ -3608,6 +3657,12 @@ static void WillWrite(Channel *chanPtr)
static int WillRead(Channel *chanPtr)
{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ DiscardInputQueued(chanPtr->state, 0);
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
if ((chanPtr->state->curOutPtr != NULL)
@@ -3664,7 +3719,7 @@ Write(
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
- if ((statePtr->flags & CHANNEL_LINEBUFFERED)
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
|| (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
nextNewLine = memchr(src, '\n', srcLen);
}
@@ -3694,6 +3749,7 @@ Write(
bufPtr->nextAdded += saved;
saved = 0;
}
+ PreserveChannelBuffer(bufPtr);
dst = InsertPoint(bufPtr);
dstLen = SpaceLeft(bufPtr);
@@ -3707,6 +3763,7 @@ Write(
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
/* We're reading from invalid/incomplete UTF-8 */
+ ReleaseChannelBuffer(bufPtr);
if (total == 0) {
Tcl_SetErrno(EINVAL);
return -1;
@@ -3781,6 +3838,7 @@ Write(
if (IsBufferFull(bufPtr)) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ ReleaseChannelBuffer(bufPtr);
return -1;
}
flushed += statePtr->bufSize;
@@ -3788,9 +3846,10 @@ Write(
needNlFlush = 0;
}
}
+ ReleaseChannelBuffer(bufPtr);
}
- if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
- (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
SetFlag(statePtr, BUFFER_READY);
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
@@ -3902,6 +3961,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -4034,7 +4094,7 @@ Tcl_GetsObj(
case TCL_TRANSLATE_AUTO:
eol = dst;
skip = 1;
- if (statePtr->flags & INPUT_SAW_CR) {
+ if (GotFlag(statePtr, INPUT_SAW_CR)) {
ResetFlag(statePtr, INPUT_SAW_CR);
if ((eol < dstEnd) && (*eol == '\n')) {
/*
@@ -4102,7 +4162,7 @@ Tcl_GetsObj(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
eol = dstEnd;
if (eol == objPtr->bytes + oldLength) {
@@ -4130,6 +4190,17 @@ Tcl_GetsObj(
*/
gotEOL:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
+
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
@@ -4158,13 +4229,22 @@ Tcl_GetsObj(
*/
restore:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4193,7 +4273,17 @@ Tcl_GetsObj(
*/
done:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4239,6 +4329,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -4282,8 +4373,8 @@ TclGetsObjBinary(
* device. Side effect is to allocate another channel buffer.
*/
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
goto restore;
}
ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4292,6 +4383,9 @@ TclGetsObjBinary(
goto restore;
}
bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -4334,7 +4428,7 @@ TclGetsObjBinary(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
eol = dstEnd;
if ((dst == dstEnd) && (byteLen == oldLength)) {
@@ -4404,12 +4498,12 @@ TclGetsObjBinary(
restore:
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+ if (bufPtr) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4438,6 +4532,7 @@ TclGetsObjBinary(
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4548,8 +4643,8 @@ FilterInputBytes(
*/
read:
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
@@ -4563,6 +4658,11 @@ FilterInputBytes(
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
}
/*
@@ -4628,7 +4728,7 @@ FilterInputBytes(
* returning those UTF-8 characters because a EOL might be
* present in them.
*/
- } else if (statePtr->flags & CHANNEL_EOF) {
+ } else if (GotFlag(statePtr, CHANNEL_EOF)) {
/*
* There was a partial character followed by EOF on the
* device. Fall through, returning that nothing was found.
@@ -4650,7 +4750,7 @@ FilterInputBytes(
statePtr->inQueueTail = nextPtr;
}
extra = rawLen - gsPtr->rawRead;
- memcpy(nextPtr->buf + BUFFER_PADDING - extra,
+ memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
raw + gsPtr->rawRead, (size_t) extra);
nextPtr->nextRemoved -= extra;
bufPtr->nextAdded -= extra;
@@ -4717,7 +4817,7 @@ PeekAhead(
goto cleanup;
}
- if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc == NULL) {
/*
@@ -4909,15 +5009,16 @@ Tcl_ReadRaw(
* requests more bytes.
*/
+ Tcl_Preserve(chanPtr);
for (copied = 0; copied < bytesToRead; copied += copiedNow) {
copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
bytesToRead - copied);
if (copiedNow == 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
break;
}
ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4933,21 +5034,24 @@ Tcl_ReadRaw(
* happen.
*/
- nread = ChanRead(chanPtr, bufPtr+copied, bytesToRead-copied);
+ nread = ChanRead(chanPtr, bufPtr + copied,
+ bytesToRead - copied);
if (nread < 0) {
- if (statePtr->flags & CHANNEL_BLOCKED && copied > 0) {
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- break;
+ if (GotFlag(statePtr, CHANNEL_BLOCKED) && copied > 0) {
+/* TODO: comment out? */
+// ResetFlag(statePtr, CHANNEL_BLOCKED);
+ } else {
+ copied = -1;
}
- return -1;
+ } else {
+ copied += nread;
}
-
- copied += nread;
break;
}
}
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5044,7 +5148,7 @@ DoReadChars(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- int factor, copied, copiedNow;
+ int factor, copied, copiedNow, result;
Tcl_Encoding encoding;
int binaryMode;
#define UTF_EXPANSION_FACTOR 1024
@@ -5056,6 +5160,7 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
+ Tcl_Preserve(chanPtr);
binaryMode = (encoding == NULL)
&& (statePtr->inputTranslation == TCL_TRANSLATE_LF)
@@ -5106,21 +5211,26 @@ DoReadChars(
}
if (copiedNow < 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
break;
}
ResetFlag(statePtr, CHANNEL_BLOCKED);
}
- if (GetInput(chanPtr) != 0) {
- if (statePtr->flags & CHANNEL_BLOCKED) {
- break;
+ result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
+ if (result != 0) {
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ copied = -1;
}
- copied = -1;
- goto done;
+ break;
}
} else {
copied += copiedNow;
@@ -5128,15 +5238,31 @@ DoReadChars(
}
}
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ /*
+ * Failure to fill a channel buffer may have left channel reporting
+ * a "blocked" state, but so long as we fulfilled the request here,
+ * the caller does not consider us blocked.
+ */
+ if (toRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
+
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
/*
* Update the notifier state so we don't block while there is still data
* in the buffers.
*/
-
- done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5448,7 +5574,7 @@ ReadChars(
return 1;
}
- } else if (statePtr->flags & CHANNEL_EOF) {
+ } else if (GotFlag(statePtr, CHANNEL_EOF)) {
/*
* The bare \r is the only char and we will never read
@@ -5670,7 +5796,7 @@ TranslateInputEOL(
char *dst = dstStart;
int lesser;
- if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
+ if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) {
if (*src == '\n') { src++; srcLen--; }
ResetFlag(statePtr, INPUT_SAW_CR);
}
@@ -5891,7 +6017,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree((char *) statePtr->saveInBufPtr);
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -5907,9 +6033,8 @@ DiscardInputQueued(
* that is the top channel of a stack!
*
* Results:
- * The return value is 0 to indicate success, or -1 if an error
- * occurred while reading from the channel. Call Tcl_GetErrno()
- * to get the Posix error code.
+ * The return value is the Posix error code if an error occurred while
+ * reading from the file, or 0 otherwise.
*
* Side effects:
* Reads from the underlying device.
@@ -5922,6 +6047,7 @@ GetInput(
Channel *chanPtr) /* Channel to read input from. */
{
int toRead; /* How much to read? */
+ int result; /* Of calling driver. */
int nread; /* How much was read from channel? */
ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
ChannelState *statePtr = chanPtr->state;
@@ -5935,8 +6061,7 @@ GetInput(
*/
if (CheckForDeadChannel(NULL, statePtr)) {
- Tcl_SetErrno(EINVAL);
- return -1;
+ return EINVAL;
}
/*
@@ -5983,7 +6108,7 @@ GetInput(
if ((bufPtr != NULL)
&& (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
@@ -6009,16 +6134,22 @@ GetInput(
* platforms it is impossible to read from a device after EOF.
*/
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
return 0;
}
+ PreserveChannelBuffer(bufPtr);
nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead);
+
if (nread < 0) {
- return -1;
+ result = Tcl_GetErrno();
+ } else {
+ result = 0;
+ bufPtr->nextAdded += nread;
}
- bufPtr->nextAdded += nread;
- return 0;
+
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -6133,14 +6264,14 @@ Tcl_Seek(
*/
wasAsync = 0;
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
wasAsync = 1;
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
if (result != 0) {
return Tcl_LongAsWide(-1);
}
ResetFlag(statePtr, CHANNEL_NONBLOCKING);
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
}
}
@@ -6476,8 +6607,7 @@ CheckChannelErrors(
* order to drain data from stacked channels.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) &&
- ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -6486,7 +6616,7 @@ CheckChannelErrors(
* Fail if the channel is not opened for desired operation.
*/
- if ((statePtr->flags & direction) == 0) {
+ if (GotFlag(statePtr, direction) == 0) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -6499,7 +6629,7 @@ CheckChannelErrors(
* retrieving and transforming the data to copy.
*/
- if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
Tcl_SetErrno(EBUSY);
return -1;
}
@@ -6539,8 +6669,8 @@ Tcl_Eof(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
- ((statePtr->flags & CHANNEL_EOF) &&
+ return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
+ (GotFlag(statePtr, CHANNEL_EOF) &&
(Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
@@ -6567,7 +6697,7 @@ Tcl_InputBlocked(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+ return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
}
/*
@@ -7198,7 +7328,8 @@ Tcl_SetChannelOption(
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
@@ -7231,10 +7362,10 @@ Tcl_SetChannelOption(
ckfree((char *) argv);
return TCL_ERROR;
}
- if (statePtr->flags & TCL_READABLE) {
+ if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = inValue;
}
- if (statePtr->flags & TCL_WRITABLE) {
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
statePtr->outEofChar = outValue;
}
} else {
@@ -7268,11 +7399,11 @@ Tcl_SetChannelOption(
}
if (argc == 1) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
} else if (argc == 2) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -7522,7 +7653,7 @@ Tcl_NotifyChannel(
* don't call any write handlers before the flush is complete.
*/
- if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
FlushChannel(NULL, chanPtr, 1);
mask &= ~TCL_WRITABLE;
}
@@ -7592,12 +7723,17 @@ UpdateInterest(
/* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
mask |= TCL_WRITABLE;
}
@@ -7609,7 +7745,7 @@ UpdateInterest(
*/
if (mask & TCL_READABLE) {
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->inQueueHead != NULL)
&& IsBufferReady(statePtr->inQueueHead)) {
mask &= ~TCL_READABLE;
@@ -7688,7 +7824,7 @@ ChannelTimerProc(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->interestMask & TCL_READABLE)
&& (statePtr->inQueueHead != NULL)
&& IsBufferReady(statePtr->inQueueHead)) {
@@ -7699,7 +7835,7 @@ ChannelTimerProc(
statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
Tcl_Preserve(statePtr);
- Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
+ Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
Tcl_Release(statePtr);
} else {
statePtr->timer = NULL;
@@ -8112,7 +8248,7 @@ Tcl_FileEventObjCmd(
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
- if ((statePtr->flags & mask) == 0) {
+ if (GotFlag(statePtr, mask) == 0) {
Tcl_AppendResult(interp, "channel is not ",
(mask == TCL_READABLE) ? "readable" : "writable", NULL);
return TCL_ERROR;
@@ -8656,6 +8792,7 @@ DoRead(
ChannelState *statePtr = chanPtr->state;
char *p = dst;
+ Tcl_Preserve(chanPtr);
while (bytesToRead) {
/*
* Each pass through the loop is intended to process up to
@@ -8670,7 +8807,7 @@ DoRead(
* escape to the caller.
*/
- if (statePtr->flags & CHANNEL_EOF
+ if (GotFlag(statePtr, CHANNEL_EOF)
&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
break;
}
@@ -8682,12 +8819,13 @@ DoRead(
ResetFlag(statePtr, CHANNEL_BLOCKED);
moreData:
+
code = GetInput(chanPtr);
bufPtr = statePtr->inQueueHead;
assert (bufPtr != NULL);
- if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
/* Further reads cannot do any more */
break;
}
@@ -8695,6 +8833,7 @@ DoRead(
if (code) {
/* Read error */
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return -1;
}
@@ -8747,13 +8886,13 @@ DoRead(
if (bufPtr->nextPtr == NULL) {
/* There's no more buffered data.... */
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
/* ...and there never will be. */
*p++ = '\r';
bytesToRead--;
bufPtr->nextRemoved++;
- } else if (statePtr->flags & CHANNEL_BLOCKED) {
+ } else if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
/* ...and we cannot get more now. */
SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
@@ -8783,12 +8922,16 @@ DoRead(
RecycleBuffer(statePtr, bufPtr, 0);
}
- if (statePtr->flags & CHANNEL_NONBLOCKING
- && statePtr->flags & CHANNEL_BLOCKED) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)
+ && GotFlag(statePtr, CHANNEL_BLOCKED)) {
break;
}
}
+ if (bytesToRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
+ Tcl_Release(chanPtr);
return (int)(p - dst);
}
@@ -8999,12 +9142,15 @@ StackSetBlockMode(
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
+ ChannelState *statePtr = chanPtr->state;
/*
* Start at the top of the channel stack
+ * TODO: Examine what can go wrong when blockModeProc calls
+ * disturb the stacking state of the channel.
*/
- chanPtr = chanPtr->state->topChanPtr;
+ chanPtr = statePtr->topChanPtr;
while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
@@ -10153,8 +10299,9 @@ SetChannelFromAny(
* The channel is valid until any call to DetachChannel occurs.
* Ensure consistency checks are done.
*/
- statePtr = GET_CHANNELSTATE(objPtr);
- if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+
+ statePtr = GET_CHANNELSTATE(objPtr);
+ if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
Tcl_Release((ClientData) statePtr);
objPtr->typePtr = NULL;
@@ -10247,5 +10394,7 @@ DumpFlags(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 59754cf..b8fb5be 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
*/
typedef struct ChannelBuffer {
+ int refCount; /* Current uses count */
int nextAdded; /* The next position into which a character
* will be put in the buffer. */
int nextRemoved; /* Position of next byte to be removed from
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2958bc8..afd6272 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -177,6 +177,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -187,6 +188,7 @@ Tcl_PutsObjCmd(
goto error;
}
}
+ Tcl_Release(chan);
return TCL_OK;
/*
@@ -202,6 +204,7 @@ Tcl_PutsObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
@@ -248,6 +251,7 @@ Tcl_FlushObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
/*
* TIP #219.
@@ -261,8 +265,10 @@ Tcl_FlushObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -295,6 +301,7 @@ Tcl_GetsObjCmd(
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
+ int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -310,6 +317,7 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
@@ -329,21 +337,24 @@ Tcl_GetsObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ Tcl_Release(chan);
+ return code;
}
/*
@@ -447,6 +458,7 @@ Tcl_ReadObjCmd(
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ Tcl_Preserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
/*
@@ -462,6 +474,7 @@ Tcl_ReadObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -480,6 +493,7 @@ Tcl_ReadObjCmd(
}
}
Tcl_SetObjResult(interp, resultPtr);
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -539,6 +553,7 @@ Tcl_SeekObjCmd(
mode = modeArray[optionIndex];
}
+ Tcl_Preserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
/*
@@ -552,8 +567,10 @@ Tcl_SeekObjCmd(
TclGetString(objv[1]), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -584,6 +601,7 @@ Tcl_TellObjCmd(
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
+ int code;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -599,6 +617,7 @@ Tcl_TellObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
newLoc = Tcl_Tell(chan);
/*
@@ -607,7 +626,10 @@ Tcl_TellObjCmd(
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ Tcl_Release(chan);
+ if (code) {
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index eed21fb..c5372b1 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -210,7 +210,27 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
+ int refCount;
};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree((char *) dataPtr);
+}
/*
*----------------------------------------------------------------------
@@ -240,6 +260,7 @@ TclChannelTransform(
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State info for channel. */
int mode; /* Read/write mode of the channel. */
+ int objc;
TransformChannelData *dataPtr;
Tcl_DString ds;
@@ -247,6 +268,12 @@ TclChannelTransform(
return TCL_ERROR;
}
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ return TCL_ERROR;
+ }
+
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -261,6 +288,7 @@ TclChannelTransform(
dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
+ dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
@@ -270,7 +298,6 @@ TclChannelTransform(
}
Tcl_DStringFree(&ds);
- dataPtr->self = chan;
dataPtr->watchMask = 0;
dataPtr->mode = mode;
dataPtr->timer = NULL;
@@ -286,19 +313,20 @@ TclChannelTransform(
if (dataPtr->self == NULL) {
Tcl_AppendResult(interp, "\nfailed to stack channel \"",
Tcl_GetChannelName(chan), "\"", NULL);
- Tcl_DecrRefCount(dataPtr->command);
- ResultClear(&dataPtr->result);
- ckfree((char *) dataPtr);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ Tcl_Preserve(dataPtr->self);
/*
* At last initialize the transformation at the script level.
*/
+ PreserveData(dataPtr);
if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -307,9 +335,11 @@ TclChannelTransform(
ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -350,7 +380,10 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
- Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
/*
* Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +394,18 @@ ExecuteCallback(
*/
if (preserve == P_PRESERVE) {
- state = Tcl_SaveInterpState(dataPtr->interp, res);
+ state = Tcl_SaveInterpState(eval, res);
}
Tcl_IncrRefCount(command);
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewStringObj((char *) op, -1));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
/*
* Use a byte-array to prevent the misinterpretation of binary data coming
* through as UTF while at the tcl level.
*/
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewByteArrayObj(buf, bufLen));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
/*
* Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +415,14 @@ ExecuteCallback(
* current interpreter. Don't copy if in preservation mode.
*/
- res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
command = NULL;
- if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
&& (preserve == P_NO_PRESERVE)) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
return res;
}
@@ -411,20 +437,26 @@ ExecuteCallback(
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
resLen);
break;
case TRANSMIT_SELF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
break;
case TRANSMIT_IBUF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
ResultAdd(&dataPtr->result, resBuf, resLen);
break;
@@ -434,24 +466,16 @@ ExecuteCallback(
* Interpret result as integer number.
*/
- resObj = Tcl_GetObjResult(dataPtr->interp);
- TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
break;
}
- Tcl_ResetResult(dataPtr->interp);
- if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- return res;
-
- cleanup:
+ Tcl_ResetResult(eval);
if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- if (command != NULL) {
- Tcl_DecrRefCount(command);
+ (void) Tcl_RestoreInterpState(eval, state);
}
+ Tcl_Release(eval);
return res;
}
@@ -535,6 +559,7 @@ TransformCloseProc(
* system rely on (f.e. signaling the close to interested parties).
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +579,15 @@ TransformCloseProc(
ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
TRANSMIT_DONT, P_PRESERVE);
}
+ ReleaseData(dataPtr);
/*
* General cleanup.
*/
- ResultClear(&dataPtr->result);
- Tcl_DecrRefCount(dataPtr->command);
- ckfree((char *) dataPtr);
+ Tcl_Release(dataPtr->self);
+ dataPtr->self = NULL;
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -596,7 +622,7 @@ TransformInputProc(
* Should assert(dataPtr->mode & TCL_READABLE);
*/
- if (toRead == 0) {
+ if (toRead == 0 || dataPtr->self == NULL) {
/*
* Catch a no-op.
*/
@@ -606,6 +632,7 @@ TransformInputProc(
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
+ PreserveData(dataPtr);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
@@ -623,7 +650,7 @@ TransformInputProc(
* break out of the loop and return to the caller.
*/
- return gotBytes;
+ break;
}
/*
@@ -647,7 +674,7 @@ TransformInputProc(
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
}
/*
@@ -663,11 +690,12 @@ TransformInputProc(
*/
if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- return gotBytes;
+ break;
}
*errorCodePtr = Tcl_GetErrno();
- return -1;
+ gotBytes = -1;
+ break;
} else if (read == 0) {
/*
* Check wether we hit on EOF in the underlying channel or not. If
@@ -682,9 +710,9 @@ TransformInputProc(
if (!Tcl_Eof(downChan)) {
if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
- return -1;
+ gotBytes = -1;
}
- return gotBytes;
+ break;
}
if (dataPtr->readIsFlushed) {
@@ -692,7 +720,7 @@ TransformInputProc(
* Already flushed, nothing to do anymore.
*/
- return gotBytes;
+ break;
}
dataPtr->readIsFlushed = 1;
@@ -704,7 +732,7 @@ TransformInputProc(
* We had nothing to flush.
*/
- return gotBytes;
+ break;
}
continue; /* at: while (toRead > 0) */
@@ -718,9 +746,11 @@ TransformInputProc(
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ gotBytes = -1;
+ break;
}
} /* while toRead > 0 */
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -762,11 +792,13 @@ TransformOutputProc(
return 0;
}
+ PreserveData(dataPtr);
if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ toWrite = -1;
}
+ ReleaseData(dataPtr);
return toWrite;
}
@@ -819,6 +851,7 @@ TransformSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -830,6 +863,7 @@ TransformSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
errorCodePtr);
@@ -890,6 +924,7 @@ TransformWideSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -901,6 +936,7 @@ TransformWideSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
@@ -1055,6 +1091,9 @@ TransformWatchProc(
* unchanged.
*/
+ if (dataPtr->self == NULL) {
+ return;
+ }
downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_GetChannelType(downChan)->watchProc(
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index ca3ab4b..3107f9e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -91,31 +91,9 @@ typedef struct {
#ifdef TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj **argv; /* Preallocated array for calling the handler.
- * args[0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words. */
- int methods; /* Bitmask of supported methods */
-
- /*
- * NOTE (9): Should we have predefined shared literals for the method
- * names?
- */
+ Tcl_Obj *cmd; /* Callback command prefix */
+ Tcl_Obj *methods; /* Methods to append to command prefix */
+ Tcl_Obj *name; /* Name of the channel as created */
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
@@ -439,7 +417,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
- const char *method, Tcl_Obj *argOneObj,
+ MethodName method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
@@ -454,16 +432,14 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
* list-quoting to keep the words of the message together. See also [x].
*/
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
+static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
/*
@@ -568,10 +544,6 @@ TclChanCreateObjCmd(
rcId = NextHandle();
rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
- mode);
- rcPtr->chan = chan;
- chanPtr = (Channel *) chan;
/*
* Invoke 'initialize' and validate that the handler is present and ok.
@@ -585,7 +557,7 @@ TclChanCreateObjCmd(
modeObj = DecodeEventMask(mode);
/* assert modeObj.refCount == 1 */
- result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
@@ -674,7 +646,11 @@ TclChanCreateObjCmd(
* Everything is fine now.
*/
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ Tcl_Preserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
/*
@@ -737,12 +713,10 @@ TclChanCreateObjCmd(
return TCL_OK;
error:
- /*
- * Signal to ReflectClose to not call 'finalize'.
- */
-
- rcPtr->methods = 0;
- Tcl_Close(interp, chan);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree((char*) rcPtr);
return TCL_ERROR;
#undef MODE
@@ -1045,6 +1019,7 @@ ReflectClose(
Tcl_Obj *resObj; /* Result data for 'close' */
ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
Tcl_HashEntry* hPtr; /* Entry in the above map */
+ Tcl_ChannelType *tctPtr;
if (TclInThreadExit()) {
/*
@@ -1081,18 +1056,11 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
- return EOK;
- }
-
- /*
- * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
- *
- * A cleaned method mask here implies that the channel creation was
- * aborted, and "finalize" must not be called.
- */
-
- if (rcPtr->methods == 0) {
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1118,7 +1086,7 @@ ReflectClose(
}
} else {
#endif
- result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
if ((result != TCL_OK) && (interp != NULL)) {
Tcl_SetChannelErrorInterp(interp, resObj);
}
@@ -1156,6 +1124,11 @@ ReflectClose(
}
#endif
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
}
@@ -1193,18 +1166,6 @@ ReflectInput(
Tcl_Obj *resObj; /* Result data for 'read' */
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_READ))) {
- SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1242,7 +1203,7 @@ ReflectInput(
toReadObj = Tcl_NewIntObj(toRead);
Tcl_IncrRefCount(toReadObj);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
int code = ErrnoReturn (rcPtr, resObj);
if (code < 0) {
@@ -1308,18 +1269,6 @@ ReflectOutput(
int written;
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_WRITE))) {
- SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1353,11 +1302,12 @@ ReflectOutput(
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
Tcl_Preserve(rcPtr);
+ Tcl_Preserve(rcPtr->interp);
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
Tcl_IncrRefCount(bufObj);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1369,6 +1319,14 @@ ReflectOutput(
goto invalid;
}
+ if (Tcl_InterpDeleted(rcPtr->interp)) {
+ /*
+ * The interp was destroyed during InvokeTclMethod().
+ */
+
+ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+ goto invalid;
+ }
if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
goto invalid;
@@ -1398,6 +1356,7 @@ ReflectOutput(
stop:
Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr->interp);
Tcl_Release(rcPtr);
return written;
invalid:
@@ -1470,7 +1429,7 @@ ReflectSeekWide(
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1541,8 +1500,6 @@ ReflectWatch(
ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
/*
* We restrict the interest to what the channel can support. IOW there
* will never be write events for a channel which is not writable.
@@ -1585,7 +1542,7 @@ ReflectWatch(
maskObj = DecodeEventMask(mask);
/* assert maskObj.refCount == 1 */
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
@@ -1644,7 +1601,7 @@ ReflectBlock(
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
@@ -1718,7 +1675,7 @@ ReflectSetOption(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
- result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
}
@@ -1763,7 +1720,7 @@ ReflectGetOption(
Tcl_Obj *resObj; /* Result data for 'configure' */
int listc, result = TCL_OK;
Tcl_Obj **listv;
- const char *method;
+ MethodName method;
/*
* Are we in the correct thread?
@@ -1802,14 +1759,14 @@ ReflectGetOption(
* Retrieve all options.
*/
- method = "cgetall";
+ method = METH_CGETALL;
optionObj = NULL;
} else {
/*
* Retrieve the value of one option.
*/
- method = "cget";
+ method = METH_CGET;
optionObj = Tcl_NewStringObj(optionName, -1);
Tcl_IncrRefCount(optionObj);
}
@@ -2021,16 +1978,13 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
+ MethodName mn = METH_BLOCKING;
rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
/* rcPtr->chan: Assigned by caller. Dummy data here. */
- /* rcPtr->methods: Assigned by caller. Dummy data here. */
rcPtr->chan = NULL;
- rcPtr->methods = 0;
rcPtr->interp = interp;
#ifdef TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
@@ -2038,54 +1992,17 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /*
- * Method placeholder.
- */
-
/* ASSERT: cmdpfxObj is a Tcl List */
-
- Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
- /*
- * See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- */
-
- rcPtr->argc = listc + 2;
- rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
- /*
- * Duplicate object references.
- */
-
- for (i=0; i<listc ; i++) {
- Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
- Tcl_IncrRefCount(word);
- }
-
- i++; /* Skip placeholder for method */
-
- /*
- * [Bug 1667990]: See [x] in FreeReflectedChannel for release
- */
-
- rcPtr->argv[i] = handleObj;
- Tcl_IncrRefCount(handleObj);
-
- /*
- * The next two objects are kept empty, varying arguments.
- */
-
- /*
- * Initialization complete.
- */
-
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
+ rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+ while (mn <= METH_WRITE) {
+ Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+ Tcl_NewStringObj(methodNames[mn++], -1));
+ }
+ Tcl_IncrRefCount(rcPtr->methods);
+ rcPtr->name = handleObj;
+ Tcl_IncrRefCount(rcPtr->name);
return rcPtr;
}
@@ -2136,28 +2053,11 @@ FreeReflectedChannel(
ReflectedChannel *rcPtr)
{
Channel *chanPtr = (Channel *) rcPtr->chan;
- int i, n;
-
- if (chanPtr->typePtr != &tclRChannelType) {
- /*
- * Delete a cloned ChannelType structure.
- */
-
- ckfree((char*) chanPtr->typePtr);
- }
-
- n = rcPtr->argc - 2;
- for (i=0; i<n; i++) {
- Tcl_DecrRefCount(rcPtr->argv[i]);
- }
-
- /*
- * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
- */
-
- Tcl_DecrRefCount(rcPtr->argv[n+1]);
- ckfree((char*) rcPtr->argv);
+ Tcl_Release(chanPtr);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
ckfree((char*) rcPtr);
}
@@ -2188,16 +2088,16 @@ FreeReflectedChannel(
static int
InvokeTclMethod(
ReflectedChannel *rcPtr,
- const char *method,
+ MethodName method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
- int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
if (!rcPtr->interp) {
/*
@@ -2220,32 +2120,25 @@ InvokeTclMethod(
}
/*
- * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
- * TSD data as reflections can be created in many different threads.
- * NO: Caching of command resolutions means storage per channel.
- */
-
- /*
- * Insert method into the pre-allocated area, after the command prefix,
+ * Insert method into the callback command, after the command prefix,
* before the channel id.
*/
- methObj = Tcl_NewStringObj(method, -1);
- Tcl_IncrRefCount(methObj);
- rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+
+ Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
/*
* Append the additional argument containing method specific details
* behind the channel id. If specified.
*/
- cmdc = rcPtr->argc;
if (argOneObj) {
- rcPtr->argv[cmdc] = argOneObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
if (argTwoObj) {
- rcPtr->argv[cmdc] = argTwoObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
}
}
@@ -2254,9 +2147,10 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
/*
* We do not try to extract the result information if the caller has no
@@ -2282,7 +2176,6 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2296,25 +2189,17 @@ InvokeTclMethod(
result = TCL_ERROR;
}
Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
- "\n (chan handler subcommand \"%s\")", method));
+ "\n (chan handler subcommand \"%s\")",
+ methodNames[method]));
resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
/*
- * Cleanup of the dynamic parts of the command.
- *
- * The detail objects survived the Tcl_EvalObjv without change because of
- * the contract. Therefore there is no need to decrement the refcounts. Only
- * the internal method object has to be disposed of.
- */
-
- Tcl_DecrRefCount(methObj);
-
- /*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
@@ -2827,17 +2712,19 @@ ForwardProc(
* call upon for the driver.
*/
- case ForwardedClose:
+ case ForwardedClose: {
/*
* No parameters/results.
*/
- if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+ Tcl_ChannelType *tctPtr;
+
+ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
/*
- * Freeing is done here, in the origin thread, because the argv[]
+ * Freeing is done here, in the origin thread, callback command
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*
@@ -2856,15 +2743,21 @@ ForwardProc(
Tcl_GetChannelName (rcPtr->chan));
Tcl_DeleteHashEntry (hPtr);
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
break;
+ }
case ForwardedInput: {
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
int code = ErrnoReturn (rcPtr, resObj);
if (code < 0) {
@@ -2904,7 +2797,7 @@ ForwardProc(
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -2945,7 +2838,7 @@ ForwardProc(
Tcl_IncrRefCount(baseObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
paramPtr->seek.offset = -1;
} else {
@@ -2979,7 +2872,7 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
break;
@@ -2990,7 +2883,7 @@ ForwardProc(
Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3006,7 +2899,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+ if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3025,7 +2918,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
Tcl_DStringAppend(paramPtr->getOpt.value,
@@ -3042,7 +2935,7 @@ ForwardProc(
*/
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 74a2ded..b30650d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2552,6 +2552,7 @@ MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(mp_int *a);
@@ -3671,6 +3672,24 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
/*
*----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+ (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+
+/*
+ *----------------------------------------------------------------
* Macro used by the Tcl core to compare Unicode strings. On big-endian
* systems we can use the more efficient memcmp, but this would not be
* lexically correct on little-endian systems. The ANSI C "prototype" for
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 80dd2ad..fc20d09 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -847,9 +847,15 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(__WIN32__)
# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 99f3e4b..6499bc2 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,9 @@
#undef Tcl_CreateHashEntry
#undef TclpGetPid
#undef TclSockMinimumBuffers
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
#define TclUnusedStubEntry NULL
/*
@@ -104,7 +107,8 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
@@ -120,27 +124,31 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
TclWinNoBackslash(char *path)
{
char *p;
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 8384107..d6b5bcb 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -338,8 +338,9 @@ Tcl_ConditionFinalize(
*
* TclFinalizeThreadData --
*
- * This function cleans up the thread-local storage. This is called once
- * for each thread.
+ * This function cleans up the thread-local storage. Secondary, it cleans
+ * thread alloc cache.
+ * This is called once for each thread before thread exits.
*
* Results:
* None.
@@ -354,6 +355,9 @@ void
TclFinalizeThreadData(void)
{
TclpFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclFinalizeThreadAllocThread();
+#endif
}
/*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 2e74fa7..106e908 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -1012,6 +1012,33 @@ TclFinalizeThreadAlloc(void)
TclpFreeAllocCache(NULL);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ * This procedure is used to destroy single thread private resources used
+ * in this file.
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ if (cachePtr != NULL) {
+ TclpFreeAllocCache(cachePtr);
+ }
+}
+
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5f4cdae..8c6adfe 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2334,7 +2334,7 @@ TclStringMatchObj(
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
- } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+ } else if (TclIsPureByteArray(strObj) && !flags) {
unsigned char *data, *ptn;
data = Tcl_GetByteArrayFromObj(strObj, &length);
generated by cgit v0.12 at 2024-08-23 02:30:28 (GMT)