summaryrefslogtreecommitdiffstats
path: root/generic/tclIO.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIO.c')
-rw-r--r--generic/tclIO.c1577
1 files changed, 1130 insertions, 447 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 564df27..aad576a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -35,15 +35,15 @@ typedef struct ChannelHandler {
/*
* This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
+ * the current invocation of Tcl_NotifyChannel. There is a potential
* problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
* problem, structures of the type below indicate the next handler to be
* processed for any (recursively nested) dispatches in progress. The
* nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
+ * The nestedHandlerPtr field is used to chain together all recursive
+ * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
+ * nested invocations of Tcl_NotifyChannel and compare the handler being
* deleted against the NEXT handler to be invoked in that invocation; when it
* finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
* field of the structure to the next handler.
@@ -54,21 +54,10 @@ typedef struct NextChannelHandler {
* this invocation. */
struct NextChannelHandler *nestedHandlerPtr;
/* Next nested invocation of
- * ChannelHandlerEventProc. */
+ * Tcl_NotifyChannel. */
} NextChannelHandler;
/*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
- */
-
-typedef struct ChannelHandlerEvent {
- Tcl_Event header; /* Standard header for all events. */
- Channel *chanPtr; /* The channel that is ready. */
- int readyMask; /* Events that have occurred. */
-} ChannelHandlerEvent;
-
-/*
* The following structure is used by Tcl_GetsObj() to encapsulates the
* state for a "gets" operation.
*/
@@ -109,7 +98,7 @@ typedef struct CopyState {
struct Channel *writePtr; /* Pointer to output channel. */
int readFlags; /* Original read channel flags. */
int writeFlags; /* Original write channel flags. */
- int toRead; /* Number of bytes to copy, or -1. */
+ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */
Tcl_WideInt total; /* Total bytes transferred (written). */
Tcl_Interp *interp; /* Interp that started the copy. */
Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
@@ -130,7 +119,7 @@ typedef struct CopyState {
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
- * ChannelHandlerEventProc invocations. */
+ * Tcl_NotifyChannel invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
@@ -178,8 +167,19 @@ static void CleanupChannelHandlers(Tcl_Interp *interp,
Channel *chanPtr);
static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
int errorCode);
+static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
+ int errorCode, int flags);
+static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void CommonGetsCleanup(Channel *chanPtr);
static int CopyData(CopyState *csPtr, int mask);
+static int MoveBytes(CopyState *csPtr);
+
+static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
+static void MBError(CopyState *csPtr, int mask, int errorCode);
+static int MBRead(CopyState *csPtr);
+static int MBWrite(CopyState *csPtr);
+static void MBEvent(ClientData clientData, int mask);
+
static void CopyEventProc(ClientData clientData, int mask);
static void CreateScriptRecord(Tcl_Interp *interp,
Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -191,7 +191,8 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
-static int DoRead(Channel *chanPtr, char *dst, int bytesToRead);
+static int DoRead(Channel *chanPtr, char *dst, int bytesToRead,
+ int allowShortReads);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
static int FilterInputBytes(Channel *chanPtr,
@@ -225,7 +226,7 @@ static int Write(Channel *chanPtr, const char *src,
static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
static void SpliceChannel(Tcl_Channel chan);
static void CutChannel(Tcl_Channel chan);
-static int WillRead(Channel *chanPtr);
+static int WillRead(Channel *chanPtr);
#define WriteChars(chanPtr, src, srcLen) \
Write(chanPtr, src, srcLen, chanPtr->state->encoding)
@@ -276,21 +277,21 @@ static int WillRead(Channel *chanPtr);
* --------------------------------------------------------------------------
*/
-#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
+#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
-#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
+#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
-#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
+#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
-#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
+#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
-#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
-#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
+#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
-#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
+#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
-#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
+#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
/*
* For working with channel state flag bits.
@@ -319,10 +320,11 @@ static int WillRead(Channel *chanPtr);
*/
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static int SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetChannelFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
static void FreeChannelIntRep(Tcl_Obj *objPtr);
-static Tcl_ObjType chanObjType = {
+static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelIntRep, /* freeIntRepProc */
DupChannelIntRep, /* dupIntRepProc */
@@ -339,7 +341,7 @@ static Tcl_ObjType chanObjType = {
#define SET_CHANNELINTERP(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
-#define BUSY_STATE(st,fl) \
+#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -348,6 +350,39 @@ static Tcl_ObjType chanObjType = {
/*
*---------------------------------------------------------------------------
*
+ * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite --
+ *
+ * Simplify the access to selected channel driver "methods" that are used
+ * in multiple places in a stereotypical fashion. These are just thin
+ * wrappers around the driver functions.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static inline int
+ChanClose(
+ Channel *chanPtr,
+ Tcl_Interp *interp)
+{
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
+ } else {
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
+ }
+}
+
+static inline int
+ChanCloseHalf(
+ Channel *chanPtr,
+ Tcl_Interp *interp,
+ int flags)
+{
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* ChanRead --
*
* Read up to dstSize bytes using the inputProc of chanPtr, store
@@ -455,6 +490,37 @@ ChanSeek(
Tcl_WideAsLong(offset), mode, errnoPtr));
}
+static inline void
+ChanThreadAction(
+ Channel *chanPtr,
+ int action)
+{
+ Tcl_DriverThreadActionProc *threadActionProc =
+ Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+
+ if (threadActionProc != NULL) {
+ threadActionProc(chanPtr->instanceData, action);
+ }
+}
+
+static inline void
+ChanWatch(
+ Channel *chanPtr,
+ int mask)
+{
+ chanPtr->typePtr->watchProc(chanPtr->instanceData, mask);
+}
+
+static inline int
+ChanWrite(
+ Channel *chanPtr,
+ const char *src,
+ int srcLen,
+ int *errnoPtr)
+{
+ return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen,
+ errnoPtr);
+}
/*
*---------------------------------------------------------------------------
@@ -510,6 +576,19 @@ TclFinalizeIOSubsystem(void)
Channel *chanPtr = NULL; /* Iterates over open channels. */
ChannelState *statePtr; /* State of channel stack */
int active = 1; /* Flag == 1 while there's still work to do */
+ int doflushnb;
+
+ /* Fetch the pre-TIP#398 compatibility flag */
+ {
+ const char *s;
+ Tcl_DString ds;
+
+ s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
+ doflushnb = ((s != NULL) && strcmp(s, "0"));
+ if (s != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+ }
/*
* Walk all channel state structures known to this thread and close
@@ -528,26 +607,38 @@ TclFinalizeIOSubsystem(void)
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
- if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
+ if (GotFlag(statePtr, CHANNEL_DEAD)) {
+ continue;
+ }
+ if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
+ || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
active = 1;
break;
}
}
/*
- * We've found a live channel. Close it.
+ * We've found a live (or bg-closing) channel. Close it.
*/
if (active) {
- /*
- * Set the channel back into blocking mode to ensure that we wait
- * for all data to flush out.
- */
TclChannelPreserve((Tcl_Channel)chanPtr);
+ /*
+ * TIP #398: by default, we no longer set the channel back into
+ * blocking mode. To restore the old blocking behavior, the
+ * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
+ * and not be "0".
+ */
+ if (doflushnb) {
+ /* Set the channel back into blocking mode to ensure that we wait
+ * for all data to flush out.
+ */
- (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
+ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
+ "-blocking", "on");
+ }
if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
(chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
@@ -580,12 +671,7 @@ TclFinalizeIOSubsystem(void)
* device for this channel.
*/
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
- } else {
- (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- NULL, 0);
- }
+ (void) ChanClose(chanPtr, NULL);
/*
* Finally, we clean up the fields in the channel data
@@ -748,7 +834,7 @@ Tcl_CreateCloseHandler(
ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
- cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
+ cbPtr = ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
@@ -794,11 +880,10 @@ Tcl_DeleteCloseHandler(
} else {
cbPrevPtr->nextPtr = cbPtr->nextPtr;
}
- ckfree((char *) cbPtr);
+ ckfree(cbPtr);
break;
- } else {
- cbPrevPtr = cbPtr;
}
+ cbPrevPtr = cbPtr;
}
}
@@ -830,7 +915,7 @@ GetChannelTable(
hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ hTblPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, "tclIO",
(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
@@ -919,10 +1004,10 @@ DeleteChannelTable(
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -937,8 +1022,7 @@ DeleteChannelTable(
Tcl_DeleteHashEntry(hPtr);
SetFlag(statePtr, CHANNEL_TAINTED);
- statePtr->refCount--;
- if (statePtr->refCount <= 0) {
+ if (statePtr->refCount-- <= 1) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
@@ -946,7 +1030,7 @@ DeleteChannelTable(
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
+ ckfree(hTblPtr);
}
/*
@@ -1132,8 +1216,9 @@ Tcl_UnregisterChannel(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -1159,7 +1244,7 @@ Tcl_UnregisterChannel(
*/
if (statePtr->refCount <= 0) {
- Tcl_Preserve((ClientData)statePtr);
+ Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
* We don't want to re-enter Tcl_Close().
@@ -1168,13 +1253,13 @@ Tcl_UnregisterChannel(
if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
SetFlag(statePtr, CHANNEL_CLOSED);
- Tcl_Release((ClientData)statePtr);
+ Tcl_Release(statePtr);
return TCL_ERROR;
}
}
}
SetFlag(statePtr, CHANNEL_CLOSED);
- Tcl_Release((ClientData)statePtr);
+ Tcl_Release(statePtr);
}
return TCL_OK;
}
@@ -1359,8 +1444,8 @@ Tcl_GetChannel(
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "can not find channel named \"", chanName,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find channel named \"%s\"", chanName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
return NULL;
}
@@ -1374,7 +1459,7 @@ Tcl_GetChannel(
chanPtr = Tcl_GetHashValue(hPtr);
chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
+ *modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
}
return (Tcl_Channel) chanPtr;
@@ -1419,10 +1504,10 @@ TclGetChannelFromObj(
}
statePtr = GET_CHANNELSTATE(objPtr);
- *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
+ *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
+ *modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
}
return TCL_OK;
@@ -1446,7 +1531,7 @@ TclGetChannelFromObj(
Tcl_Channel
Tcl_CreateChannel(
- Tcl_ChannelType *typePtr, /* The channel type record. */
+ const Tcl_ChannelType *typePtr, /* The channel type record. */
const char *chanName, /* Name of channel to record. */
ClientData instanceData, /* Instance specific data. */
int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if
@@ -1456,6 +1541,7 @@ Tcl_CreateChannel(
ChannelState *statePtr; /* The stack-level independent state info for
* the channel. */
const char *name;
+ char *tmp;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
@@ -1468,15 +1554,31 @@ Tcl_CreateChannel(
* as well.
*/
- assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
+ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
+ assert(typePtr->typeName != NULL);
+ if (NULL == typePtr->closeProc) {
+ Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
+ }
+ if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
+ Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
+ }
+ if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) {
+ Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
+ }
+ if (NULL == typePtr->watchProc) {
+ Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
+ }
+ if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
+ Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
+ }
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
* assignments to 0/NULL below.
*/
- chanPtr = (Channel *) ckalloc(sizeof(Channel));
- statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
+ chanPtr = ckalloc(sizeof(Channel));
+ statePtr = ckalloc(sizeof(ChannelState));
chanPtr->state = statePtr;
chanPtr->instanceData = instanceData;
@@ -1488,14 +1590,20 @@ Tcl_CreateChannel(
*/
if (chanName != NULL) {
- char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
+ unsigned len = strlen(chanName) + 1;
- statePtr->channelName = tmp;
+ /*
+ * Make sure we allocate at least 7 bytes, so it fits for "stdout"
+ * later.
+ */
+
+ tmp = ckalloc((len < 7) ? 7 : len);
strcpy(tmp, chanName);
} else {
- Tcl_Panic("Tcl_CreateChannel: NULL channel name");
+ tmp = ckalloc(7);
+ tmp[0] = '\0';
}
-
+ statePtr->channelName = tmp;
statePtr->flags = mask;
/*
@@ -1594,14 +1702,17 @@ Tcl_CreateChannel(
*/
if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
+ strcpy(tmp, "stdin");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stdoutChannel == NULL) &&
(tsdPtr->stdoutInitialized == 1)) {
+ strcpy(tmp, "stdout");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stderrChannel == NULL) &&
(tsdPtr->stderrInitialized == 1)) {
+ strcpy(tmp, "stderr");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
}
@@ -1638,7 +1749,8 @@ Tcl_CreateChannel(
Tcl_Channel
Tcl_StackChannel(
Tcl_Interp *interp, /* The interpreter we are working in */
- Tcl_ChannelType *typePtr, /* The channel type record for the new
+ const Tcl_ChannelType *typePtr,
+ /* The channel type record for the new
* channel. */
ClientData instanceData, /* Instance specific data for the new
* channel. */
@@ -1649,7 +1761,6 @@ Tcl_StackChannel(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Channel *chanPtr, *prevChanPtr;
ChannelState *statePtr;
- Tcl_DriverThreadActionProc *threadActionProc;
/*
* Find the given channel (prevChan) in the list of all channels. If we do
@@ -1667,8 +1778,9 @@ Tcl_StackChannel(
if (statePtr == NULL) {
if (interp) {
- Tcl_AppendResult(interp, "couldn't find state for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find state for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1686,11 +1798,11 @@ Tcl_StackChannel(
* --+---+---+---+----+
*/
- if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
+ if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
- Tcl_AppendResult(interp,
- "reading and writing both disallowed for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "reading and writing both disallowed for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1717,8 +1829,9 @@ Tcl_StackChannel(
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
if (interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1759,7 +1872,7 @@ Tcl_StackChannel(
statePtr->inQueueTail = NULL;
}
- chanPtr = (Channel *) ckalloc(sizeof(Channel));
+ chanPtr = ckalloc(sizeof(Channel));
/*
* Save some of the current state into the new structure, reinitialize the
@@ -1796,10 +1909,7 @@ Tcl_StackChannel(
* time, mangling it.
*/
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT);
- }
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
return (Tcl_Channel) chanPtr;
}
@@ -1824,7 +1934,7 @@ TclChannelRelease(
return;
}
if (chanPtr->typePtr == NULL) {
- ckfree((char *)chanPtr);
+ ckfree(chanPtr);
}
}
@@ -1833,7 +1943,7 @@ ChannelFree(
Channel *chanPtr)
{
if (chanPtr->refCount == 0) {
- ckfree((char *)chanPtr);
+ ckfree(chanPtr);
return;
}
chanPtr->typePtr = NULL;
@@ -1865,7 +1975,6 @@ Tcl_UnstackChannel(
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state;
int result = 0;
- Tcl_DriverThreadActionProc *threadActionProc;
/*
* This operation should occur at the top of a channel stack.
@@ -1876,9 +1985,9 @@ Tcl_UnstackChannel(
if (chanPtr->downChanPtr != NULL) {
/*
* Instead of manipulating the per-thread / per-interp list/hashtable
- * of registered channels we wind down the state of the transformation,
- * and then restore the state of underlying channel into the old
- * structure.
+ * of registered channels we wind down the state of the
+ * transformation, and then restore the state of underlying channel
+ * into the old structure.
*/
/*
@@ -1918,9 +2027,9 @@ Tcl_UnstackChannel(
*/
if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr)));
}
return TCL_ERROR;
}
@@ -1970,11 +2079,7 @@ Tcl_UnstackChannel(
* the state which are still active.
*/
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc)(chanPtr->instanceData,
- TCL_CHANNEL_THREAD_REMOVE);
- }
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
statePtr->topChanPtr = downChanPtr;
downChanPtr->upChanPtr = NULL;
@@ -1988,14 +2093,7 @@ Tcl_UnstackChannel(
* Close and free the channel driver state.
*/
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
- interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- interp, 0);
- }
-
+ result = ChanClose(chanPtr, interp);
ChannelFree(chanPtr);
UpdateInterest(statePtr->topChanPtr);
@@ -2166,7 +2264,7 @@ Tcl_GetChannelThread(
*----------------------------------------------------------------------
*/
-Tcl_ChannelType *
+const Tcl_ChannelType *
Tcl_GetChannelType(
Tcl_Channel chan) /* The channel to return type for. */
{
@@ -2201,7 +2299,7 @@ Tcl_GetChannelMode(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of actual channel. */
- return GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE);
+ return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
}
/*
@@ -2225,9 +2323,9 @@ const char *
Tcl_GetChannelName(
Tcl_Channel chan) /* The channel for which to return the name. */
{
- ChannelState *statePtr; /* State of actual channel. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of actual channel. */
- statePtr = ((Channel *) chan)->state;
return statePtr->channelName;
}
@@ -2260,15 +2358,13 @@ Tcl_GetChannelHandle(
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
if (!chanPtr->typePtr->getHandleProc) {
- Tcl_Obj* err;
- TclNewLiteralStringObj(err, "channel \"");
- Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
- Tcl_AppendToObj(err, "\" does not support OS handles", -1);
- Tcl_SetChannelError (chan,err);
+ Tcl_SetChannelError(chan, Tcl_ObjPrintf(
+ "channel \"%s\" does not support OS handles",
+ Tcl_GetChannelName(chan)));
return TCL_ERROR;
}
- result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
- direction, &handle);
+ result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
+ &handle);
if (handlePtr) {
*handlePtr = handle;
}
@@ -2307,7 +2403,7 @@ AllocChannelBuffer(
int n;
n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
- bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
+ bufPtr = ckalloc(n);
bufPtr->nextAdded = BUFFER_PADDING;
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
@@ -2320,6 +2416,9 @@ static void
PreserveChannelBuffer(
ChannelBuffer *bufPtr)
{
+ if (bufPtr->refCount == 0) {
+ Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
+ }
bufPtr->refCount++;
}
@@ -2330,7 +2429,7 @@ ReleaseChannelBuffer(
if (--bufPtr->refCount) {
return;
}
- ckfree((char *) bufPtr);
+ ckfree(bufPtr);
}
static int
@@ -2487,15 +2586,16 @@ CheckForDeadChannel(
Tcl_Interp *interp, /* For error reporting (can be NULL) */
ChannelState *statePtr) /* The channel state to check. */
{
- if (GotFlag(statePtr, CHANNEL_DEAD)) {
- Tcl_SetErrno(EINVAL);
- if (interp) {
- Tcl_AppendResult(interp,
- "unable to access channel: invalid channel", NULL);
- }
- return 1;
+ if (!GotFlag(statePtr, CHANNEL_DEAD)) {
+ return 0;
}
- return 0;
+
+ Tcl_SetErrno(EINVAL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to access channel: invalid channel", -1));
+ }
+ return 1;
}
/*
@@ -2503,9 +2603,9 @@ CheckForDeadChannel(
*
* FlushChannel --
*
- * This function flushes as much of the queued output as is possible
- * now. If calledFromAsyncFlush is nonzero, it is being called in an
- * event handler to flush channel output asynchronously.
+ * This function flushes as much of the queued output as is possible now.
+ * If calledFromAsyncFlush is nonzero, it is being called in an event
+ * handler to flush channel output asynchronously.
*
* Results:
* 0 if successful, else the error code that was returned by the channel
@@ -2556,7 +2656,7 @@ FlushChannel(
* the post-condition that on a successful return to caller we've
* left space in the current output buffer for more writing (the flush
* call was to make new room).
- * If the channel is blocking, then yes, so we guarantee that
+ * If the channel is blocking, then yes, so we guarantee that
* blocking flushes actually flush all pending data.
* Otherwise, no. Keep the current output buffer where it is so more
* can be written to it, possibly filling it, to promote more efficient
@@ -2601,8 +2701,8 @@ FlushChannel(
*/
PreserveChannelBuffer(bufPtr);
- written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
- RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode);
+ written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr),
+ &errorCode);
/*
* If the write failed completely attempt to start the asynchronous
@@ -2634,7 +2734,7 @@ FlushChannel(
* it's a tty channel (dup'ed underneath)
*/
- if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
SetFlag(statePtr, BG_FLUSH_SCHEDULED);
UpdateInterest(chanPtr);
}
@@ -2685,14 +2785,8 @@ FlushChannel(
Tcl_SetErrno(errorCode);
if (interp != NULL && !TclChanCaughtErrorBypass(interp,
(Tcl_Channel) chanPtr)) {
- /*
- * Casting away const here is safe because the
- * TCL_VOLATILE flag guarantees const treatment of the
- * Posix error string.
- */
-
- Tcl_SetResult(interp, (char *) Tcl_PosixError(interp),
- TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
/*
@@ -2743,14 +2837,26 @@ FlushChannel(
goto done;
} else if (statePtr->outQueueHead == NULL) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
- statePtr->interestMask);
+ ChanWatch(chanPtr, statePtr->interestMask);
} else {
- /* TODO: If code reaches this point, it means a writable
- * event is being handled on the channel, but the channel
- * could not in fact be written to. This ought not happen,
- * but Unix pipes appear to act this way (see io-53.4).
- * Also can imagine broken reflected channels. */
+
+ /*
+ * When we are calledFromAsyncFlush, that means a writable
+ * state on the channel triggered the call, so we should be
+ * able to write something. Either we did write something
+ * and wroteSome should be set, or there was nothing left to
+ * write in this call, and we've completed the BG flush.
+ * These are the two cases above. If we get here, that means
+ * there is some kind failure in the writable event machinery.
+ *
+ * The tls extension indeed suffers from flaws in its channel
+ * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca.
+ * Until that patch is broadly distributed, disable the
+ * assertion checking here, so that programs using Tcl and
+ * tls can be debugged.
+
+ assert(!calledFromAsyncFlush);
+ */
}
}
@@ -2765,7 +2871,23 @@ FlushChannel(
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
errorCode = CloseChannel(interp, chanPtr, errorCode);
+ goto done;
+ }
+
+ /*
+ * If the write-side of the channel is flagged as closed, delete it when
+ * the output queue is empty and there is no output in the current output
+ * buffer.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
+ (statePtr->outQueueHead == NULL) &&
+ ((statePtr->curOutPtr == NULL) ||
+ IsBufferEmpty(statePtr->curOutPtr))) {
+ errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ goto done;
}
+
done:
TclChannelRelease((Tcl_Channel)chanPtr);
return errorCode;
@@ -2842,7 +2964,7 @@ CloseChannel(
int dummy;
char c = (char) statePtr->outEofChar;
- (chanPtr->typePtr->outputProc)(chanPtr->instanceData, &c, 1, &dummy);
+ (void) ChanWrite(chanPtr, &c, 1, &dummy);
}
/*
@@ -2853,7 +2975,7 @@ CloseChannel(
if (statePtr->chanMsg != NULL) {
if (interp != NULL) {
- Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
}
TclDecrRefCount(statePtr->chanMsg);
statePtr->chanMsg = NULL;
@@ -2870,12 +2992,7 @@ CloseChannel(
* This may leave a TIP #219 error message in the interp.
*/
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- interp, 0);
- }
+ result = ChanClose(chanPtr, interp);
/*
* Some resources can be cleared only if the bottom channel in a stack is
@@ -2884,7 +3001,7 @@ CloseChannel(
if (chanPtr == statePtr->bottomChanPtr) {
if (statePtr->channelName != NULL) {
- ckfree((char *) statePtr->channelName);
+ ckfree(statePtr->channelName);
statePtr->channelName = NULL;
}
@@ -2910,7 +3027,7 @@ CloseChannel(
statePtr->chanMsg = NULL;
}
if (interp) {
- Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+ Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
}
}
if (errorCode == 0) {
@@ -2993,7 +3110,6 @@ CutChannel(
* the list on close. */
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of the channel stack. */
- Tcl_DriverThreadActionProc *threadActionProc;
/*
* Remove this channel from of the list of all channels (in the current
@@ -3020,11 +3136,7 @@ CutChannel(
* TIP #218, Channel Thread Actions
*/
- threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
- if (threadActionProc != NULL) {
- (*threadActionProc)(Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_REMOVE);
- }
+ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE);
}
void
@@ -3039,7 +3151,6 @@ Tcl_CutChannel(
* the list on close. */
ChannelState *statePtr = chanPtr->state;
/* State of the channel stack. */
- Tcl_DriverThreadActionProc *threadActionProc;
/*
* Remove this channel from of the list of all channels (in the current
@@ -3067,13 +3178,8 @@ Tcl_CutChannel(
* For all transformations and the base channel.
*/
- while (chanPtr) {
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc)(chanPtr->instanceData,
- TCL_CHANNEL_THREAD_REMOVE);
- }
- chanPtr= chanPtr->upChanPtr;
+ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
}
}
@@ -3110,7 +3216,6 @@ SpliceChannel(
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelState *statePtr = ((Channel *) chan)->state;
- Tcl_DriverThreadActionProc *threadActionProc;
if (statePtr->nextCSPtr != NULL) {
Tcl_Panic("SpliceChannel: trying to add channel used in different list");
@@ -3131,11 +3236,7 @@ SpliceChannel(
* TIP #218, Channel Thread Actions
*/
- threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
- if (threadActionProc != NULL) {
- (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_INSERT);
- }
+ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);
}
void
@@ -3146,7 +3247,6 @@ Tcl_SpliceChannel(
Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelState *statePtr = chanPtr->state;
- Tcl_DriverThreadActionProc *threadActionProc;
if (statePtr->nextCSPtr != NULL) {
Tcl_Panic("SpliceChannel: trying to add channel used in different list");
@@ -3168,13 +3268,8 @@ Tcl_SpliceChannel(
* For all transformations and the base channel.
*/
- while (chanPtr) {
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc)(chanPtr->instanceData,
- TCL_CHANNEL_THREAD_INSERT);
- }
- chanPtr= chanPtr->upChanPtr;
+ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
}
}
@@ -3243,8 +3338,9 @@ Tcl_Close(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -3280,7 +3376,7 @@ Tcl_Close(
if (statePtr->chanMsg != NULL) {
if (interp != NULL) {
- Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
}
TclDecrRefCount(statePtr->chanMsg);
statePtr->chanMsg = NULL;
@@ -3296,8 +3392,8 @@ Tcl_Close(
while (statePtr->closeCbPtr != NULL) {
cbPtr = statePtr->closeCbPtr;
statePtr->closeCbPtr = cbPtr->nextPtr;
- (cbPtr->proc)(cbPtr->clientData);
- ckfree((char *) cbPtr);
+ cbPtr->proc(cbPtr->clientData);
+ ckfree(cbPtr);
}
ResetFlag(statePtr, CHANNEL_INCLOSE);
@@ -3308,7 +3404,7 @@ Tcl_Close(
*/
if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
TCL_CLOSE_READ);
} else {
result = 0;
@@ -3368,6 +3464,341 @@ Tcl_Close(
/*
*----------------------------------------------------------------------
*
+ * Tcl_CloseEx --
+ *
+ * Closes one side of a channel, read or write.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes one direction of the channel.
+ *
+ * NOTE:
+ * Tcl_CloseEx closes the specified direction of the channel as far as
+ * the user is concerned. The channel keeps existing however. You cannot
+ * calls this function to close the last possible direction of the
+ * channel. Use Tcl_Close for that.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_CloseEx(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Tcl_Channel chan, /* The channel being closed. May still be used
+ * by some interpreter. */
+ int flags) /* Flags telling us which side to close. */
+{
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
+
+ if (chan == NULL) {
+ return TCL_OK;
+ }
+
+ /* TODO: assert flags validity ? */
+
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+
+ /*
+ * Does the channel support half-close anyway? Error if not.
+ */
+
+ if (!chanPtr->typePtr->close2Proc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "half-close of channels not supported by %ss",
+ chanPtr->typePtr->typeName));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Is the channel unstacked ? If not we fail.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "half-close not applicable to stack of transformations", -1));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check direction against channel mode. It is an error if we try to close
+ * a direction not supported by the channel (already closed, or never
+ * opened for that direction).
+ */
+
+ if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
+ const char *msg;
+
+ if (flags & TCL_CLOSE_READ) {
+ msg = "read";
+ } else {
+ msg = "write";
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened or"
+ " already closed", msg));
+ return TCL_ERROR;
+ }
+
+ /*
+ * A user may try to call half-close from within a channel close
+ * handler. That won't do.
+ */
+
+ if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
+ }
+ return TCL_ERROR;
+ }
+
+ if (flags & TCL_CLOSE_READ) {
+ /*
+ * Call the finalization code directly. There are no events to handle,
+ * there cannot be for the read-side.
+ */
+
+ return CloseChannelPart(interp, chanPtr, 0, flags);
+ } else if (flags & TCL_CLOSE_WRITE) {
+ Tcl_Preserve(statePtr);
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ /*
+ * We don't want to re-enter CloseWrite().
+ */
+
+ if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) {
+ if (CloseWrite(interp, chanPtr) != TCL_OK) {
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ return TCL_ERROR;
+ }
+ }
+ }
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseWrite --
+ *
+ * Closes the write side a channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes the write side of the channel.
+ *
+ * NOTE:
+ * CloseWrite removes the channel as far as the user is concerned.
+ * However, the ooutput data structures may continue to exist for a while
+ * longer if it has a background flush scheduled. The device itself is
+ * eventually closed and the channel structures modified, in
+ * CloseChannelPart, below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseWrite(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel *chanPtr) /* The channel whose write side is being
+ * closed. May still be used by some
+ * interpreter */
+{
+ /* Notes: clear-channel-handlers - write side only ? or keep around, just
+ * not called. */
+ /* No close cllbacks are run - channel is still open (read side) */
+
+ ChannelState *statePtr = chanPtr->state;
+ /* State of real IO channel. */
+ int flushcode;
+ int result = 0;
+
+ /*
+ * The call to FlushChannel will flush any queued output and invoke the
+ * close function of the channel driver, or it will set up the channel to
+ * be flushed and closed asynchronously.
+ */
+
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+
+ flushcode = FlushChannel(interp, chanPtr, 0);
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result.
+ *
+ * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags
+ * FlushChannel() has called CloseChannelPart(). While we can still access
+ * "chan" (no structures were freed), the only place which may still
+ * contain a message is the interpreter itself, and "CloseChannelPart" made
+ * sure to lift any channel message it generated into it. Hence the NULL
+ * argument in the call below.
+ */
+
+ if (TclChanCaughtErrorBypass(interp, NULL)) {
+ result = EINVAL;
+ }
+
+ if ((flushcode != 0) || (result != 0)) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseChannelPart --
+ *
+ * Utility procedure to close a channel partially and free associated
+ * resources. If the channel was stacked it will never be run (The higher
+ * level forbid this). If the channel was not stacked, then we will free
+ * all the bits of the chosen side (read, or write) for the TOP channel.
+ *
+ * Results:
+ * Error code from an unreported error or the driver close2 operation.
+ *
+ * Side effects:
+ * May free memory, may change the value of errno.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseChannelPart(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel *chanPtr, /* The channel being closed. May still be used
+ * by some interpreter. */
+ int errorCode, /* Status of operation so far. */
+ int flags) /* Flags telling us which side to close. */
+{
+ ChannelState *statePtr; /* State of real IO channel. */
+ int result; /* Of calling the close2proc. */
+
+ statePtr = chanPtr->state;
+
+ if (flags & TCL_CLOSE_READ) {
+ /*
+ * No more input can be consumed so discard any leftover input.
+ */
+
+ DiscardInputQueued(statePtr, 1);
+ } else if (flags & TCL_CLOSE_WRITE) {
+ /*
+ * The caller guarantees that there are no more buffers queued for
+ * output.
+ */
+
+ if (statePtr->outQueueHead != NULL) {
+ Tcl_Panic("ClosechanHalf, closed write-side of channel: "
+ "queued output left");
+ }
+
+ /*
+ * If the EOF character is set in the channel, append that to the
+ * output device.
+ */
+
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
+ int dummy;
+ char c = (char) statePtr->outEofChar;
+
+ (void) ChanWrite(chanPtr, &c, 1, &dummy);
+ }
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move a leftover error message in the channel bypass into the
+ * interpreter bypass. Just clear it if there is no interpreter.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ if (interp != NULL) {
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
+ }
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ }
+
+ /*
+ * Finally do what is asked of us. Close and free the channel driver state
+ * for the chosen side of the channel. This may leave a TIP #219 error
+ * message in the interp.
+ */
+
+ result = ChanCloseHalf(chanPtr, interp, flags);
+
+ /*
+ * If we are being called synchronously, report either any latent error on
+ * the channel or the current error.
+ */
+
+ if (statePtr->unreportedError != 0) {
+ errorCode = statePtr->unreportedError;
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move an error message found in the unreported area into the regular
+ * bypass (interp). This kills any message in the channel bypass area.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ if (interp) {
+ Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
+ }
+ }
+ if (errorCode == 0) {
+ errorCode = result;
+ if (errorCode != 0) {
+ Tcl_SetErrno(errorCode);
+ }
+ }
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result. See also the bottom of
+ * CloseWrite().
+ */
+
+ if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
+ result = EINVAL;
+ }
+
+ if (result != 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Remove the closed side from the channel mode/flags.
+ */
+
+ ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ClearChannelHandlers --
*
* Removes all channel handlers and event scripts from the channel,
@@ -3427,7 +3858,7 @@ Tcl_ClearChannelHandlers(
for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
chNext = chPtr->nextPtr;
- ckfree((char *) chPtr);
+ ckfree(chPtr);
}
statePtr->chPtr = NULL;
@@ -3454,7 +3885,7 @@ Tcl_ClearChannelHandlers(
for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
TclDecrRefCount(ePtr->scriptPtr);
- ckfree((char *) ePtr);
+ ckfree(ePtr);
}
statePtr->scriptRecordPtr = NULL;
}
@@ -3562,9 +3993,7 @@ Tcl_WriteRaw(
* The code was stolen from 'FlushChannel'.
*/
- written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- src, srcLen, &errorCode);
-
+ written = ChanWrite(chanPtr, src, srcLen, &errorCode);
if (written < 0) {
Tcl_SetErrno(errorCode);
}
@@ -3675,7 +4104,7 @@ Tcl_WriteObj(
Channel *chanPtr;
ChannelState *statePtr; /* State info for channel */
- char *src;
+ const char *src;
int srcLen;
statePtr = ((Channel *) chan)->state;
@@ -3693,19 +4122,24 @@ Tcl_WriteObj(
}
}
-static void WillWrite(Channel *chanPtr)
+static void
+WillWrite(
+ Channel *chanPtr)
{
int inputBuffered;
- if ((chanPtr->typePtr->seekProc != NULL)
- && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)) {
+ if ((chanPtr->typePtr->seekProc != NULL) &&
+ ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
int ignore;
+
DiscardInputQueued(chanPtr->state, 0);
- ChanSeek(chanPtr, - inputBuffered, SEEK_CUR, &ignore);
+ ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
}
}
-static int WillRead(Channel *chanPtr)
+static int
+WillRead(
+ Channel *chanPtr)
{
if (chanPtr->typePtr == NULL) {
/* Prevent read attempts on a closed channel */
@@ -3714,7 +4148,7 @@ static int WillRead(Channel *chanPtr)
return -1;
}
if ((chanPtr->typePtr->seekProc != NULL)
- && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+ && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
/*
* CAVEAT - The assumption here is that FlushChannel() will
@@ -3789,7 +4223,7 @@ Write(
if (nextNewLine) {
srcLimit = nextNewLine - src;
}
-
+
/* Get space to write into */
bufPtr = statePtr->curOutPtr;
if (bufPtr == NULL) {
@@ -3817,7 +4251,7 @@ Write(
/* See chan-io-1.[89]. Tcl Bug 506297. */
statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
-
+
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
/* We're reading from invalid/incomplete UTF-8 */
ReleaseChannelBuffer(bufPtr);
@@ -3857,7 +4291,7 @@ Write(
Tcl_Panic("unknown output translation requested");
break;
}
-
+
result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
statePtr->outputEncodingFlags,
&statePtr->outputEncodingState, dst,
@@ -3954,14 +4388,12 @@ Tcl_Gets(
* for managing the storage. */
{
Tcl_Obj *objPtr;
- int charsStored, length;
- char *string;
+ int charsStored;
TclNewObj(objPtr);
charsStored = Tcl_GetsObj(chan, objPtr);
if (charsStored > 0) {
- string = TclGetStringFromObj(objPtr, &length);
- Tcl_DStringAppend(lineRead, string, length);
+ TclDStringAppendObj(lineRead, objPtr);
}
TclDecrRefCount(objPtr);
return charsStored;
@@ -4183,14 +4615,14 @@ Tcl_GetsObj(
* Skip the raw bytes that make up the '\n'.
*/
- char tmp[1 + TCL_UTF_MAX];
+ char tmp[TCL_UTF_MAX];
int rawRead;
bufPtr = gs.bufPtr;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
- gs.rawRead, statePtr->inputEncodingFlags,
- &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
- NULL);
+ gs.rawRead, statePtr->inputEncodingFlags
+ | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
+ TCL_UTF_MAX, &rawRead, NULL, NULL);
bufPtr->nextRemoved += rawRead;
gs.rawRead -= rawRead;
gs.bytesWrote--;
@@ -4291,8 +4723,9 @@ Tcl_GetsObj(
}
statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst,
+ eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
&gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -4446,7 +4879,11 @@ TclGetsObjBinary(
skip = 0;
eof = NULL;
inEofChar = statePtr->inEofChar;
- /* Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR */
+
+ /*
+ * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR.
+ */
+
eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4820,9 +5257,9 @@ FilterInputBytes(
}
gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
- &gsPtr->charsWrote);
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
+ &gsPtr->bytesWrote, &gsPtr->charsWrote);
/*
* Make sure that if we go through 'gets', that we reset the
@@ -5020,7 +5457,7 @@ CommonGetsCleanup(
extra = SpaceLeft(bufPtr);
if (extra > 0) {
memcpy(InsertPoint(bufPtr),
- nextPtr->buf + BUFFER_PADDING - extra,
+ nextPtr->buf + (BUFFER_PADDING - extra),
(size_t) extra);
bufPtr->nextAdded += extra;
nextPtr->nextRemoved = BUFFER_PADDING;
@@ -5072,7 +5509,7 @@ Tcl_Read(
return -1;
}
- return DoRead(chanPtr, dst, bytesToRead);
+ return DoRead(chanPtr, dst, bytesToRead, 0);
}
/*
@@ -5284,7 +5721,7 @@ DoReadChars(
int factor = UTF_EXPANSION_FACTOR;
binaryMode = (encoding == NULL)
- && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
+ && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
&& (statePtr->inEofChar == '\0');
if (appendFlag == 0) {
@@ -5339,7 +5776,7 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
TclChannelPreserve((Tcl_Channel)chanPtr);
- /* Must clear the BLOCKED flag here since we check before reading */
+ /* Must clear the BLOCKED|EOF flags here since we check before reading */
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
@@ -5360,9 +5797,8 @@ DoReadChars(
bufPtr = statePtr->inQueueHead;
if (IsBufferEmpty(bufPtr)) {
- ChannelBuffer *nextPtr;
+ ChannelBuffer *nextPtr = bufPtr->nextPtr;
- nextPtr = bufPtr->nextPtr;
RecycleBuffer(statePtr, bufPtr, 0);
statePtr->inQueueHead = nextPtr;
if (nextPtr == NULL) {
@@ -5538,7 +5974,7 @@ ReadChars(
int savedIEFlags = statePtr->inputEncodingFlags;
int savedFlags = statePtr->flags;
char *dst, *src = RemovePoint(bufPtr);
- int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+ int numBytes, srcLen = BytesLeft(bufPtr);
/*
* One src byte can yield at most one character. So when the
@@ -5548,23 +5984,23 @@ ReadChars(
* for sizing receiving buffers.
*/
- int toRead = ((unsigned) charsToRead > (unsigned) srcLen) ? srcLen : charsToRead;
+ int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
/*
* 'factor' is how much we guess that the bytes in the source buffer will
* expand when converted to UTF-8 chars. This guess comes from analyzing
* how many characters were produced by the previous pass.
*/
-
+
int factor = *factorPtr;
- int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
+ int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) TclGetStringFromObj(objPtr, &numBytes);
- Tcl_AppendToObj(objPtr, NULL, dstNeeded);
+ Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
unsigned int size;
dst = TclGetStringStorage(objPtr, &size) + numBytes;
- dstNeeded = size - numBytes;
+ dstLimit = size - numBytes;
} else {
dst = TclGetString(objPtr) + numBytes;
}
@@ -5585,9 +6021,14 @@ ReadChars(
* a consistent set of results. This takes the shape of a loop.
*/
- dstLimit = dstNeeded + 1;
while (1) {
int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
+ int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;
+
+ if (charsToRead > 0) {
+ flags |= TCL_ENCODING_CHAR_LIMIT;
+ numChars = charsToRead;
+ }
/*
* Perform the encoding transformation. Read no more than
@@ -5608,7 +6049,7 @@ ReadChars(
|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
+ flags, &statePtr->inputEncodingState,
dst, dstLimit, &srcRead, &dstDecoded, &numChars);
/*
@@ -5672,7 +6113,7 @@ ReadChars(
* time.
*/
- dstLimit = dstRead + TCL_UTF_MAX;
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -5698,7 +6139,7 @@ ReadChars(
* up back here in this call.
*/
- dstLimit = dstRead + TCL_UTF_MAX;
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -5715,10 +6156,10 @@ ReadChars(
*/
if (code != TCL_OK) {
- char buffer[TCL_UTF_MAX + 2];
+ char buffer[TCL_UTF_MAX + 1];
int read, decoded, count;
- /*
+ /*
* Didn't get everything the buffer could offer
*/
@@ -5731,8 +6172,9 @@ ReadChars(
(statePtr->inputEncodingFlags & TCL_ENCODING_END));
Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
+ (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
+ &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
+ &read, &decoded, &count);
if (count == 2) {
if (buffer[1] == '\n') {
@@ -5744,14 +6186,13 @@ ReadChars(
bufPtr->nextRemoved += srcRead;
}
- dst[1] = '\0';
statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
Tcl_SetObjLength(objPtr, numBytes + 1);
return 1;
}
- } else if (GotFlag(statePtr, CHANNEL_EOF)) {
+ } else if (statePtr->flags & CHANNEL_EOF) {
/*
* The bare \r is the only char and we will never read
@@ -5774,7 +6215,7 @@ ReadChars(
/* FALL THROUGH - get more data (dstWrote == 0) */
}
- /*
+ /*
* The translation transformation can only reduce the number
* of chars when it converts \r\n into \n. The reduction in
* the number of chars is the difference in bytes read and written.
@@ -5784,14 +6225,16 @@ ReadChars(
if (charsToRead > 0 && numChars > charsToRead) {
- /*
+ /*
+ * TODO: This cannot happen anymore.
+ *
* We read more chars than allowed. Reset limits to
* prevent that and try again. Don't forget the extra
* padding of TCL_UTF_MAX bytes demanded by the
* Tcl_ExternalToUtf() call!
*/
- dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst;
+ dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -5805,7 +6248,7 @@ ReadChars(
assert (numChars == 0);
- /*
+ /*
* There is one situation where this is the correct final
* result. If the src buffer contains only a single \n
* byte, and we are in TCL_TRANSLATE_AUTO mode, and
@@ -5815,9 +6258,8 @@ ReadChars(
* empty string.
*/
- if (dst[0] == '\n') {
+ if (dstRead == 1 && dst[0] == '\n') {
assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
- assert(dstRead == 1);
goto consume;
}
@@ -5899,7 +6341,7 @@ ReadChars(
*---------------------------------------------------------------------------
*/
-static void
+static void
TranslateInputEOL(
ChannelState *statePtr, /* Channel being read, for EOL translation and
* EOF character. */
@@ -6009,7 +6451,7 @@ TranslateInputEOL(
char *dst = dstStart;
int lesser;
- if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) {
+ if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
if (*src == '\n') { src++; srcLen--; }
ResetFlag(statePtr, INPUT_SAW_CR);
}
@@ -6105,7 +6547,7 @@ Tcl_Ungets(
/*
* Clear the EOF flags, and clear the BLOCKED bit.
*/
-
+
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
@@ -6262,7 +6704,7 @@ GetInput(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- /*
+ /*
* Verify that all callers know better than to call us when
* it's recorded that the next char waiting to be read is the
* eofchar.
@@ -6484,8 +6926,8 @@ Tcl_Seek(
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
- statePtr->flags &=
- ~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR);
+ ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
+ INPUT_SAW_CR);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
/*
@@ -6521,23 +6963,10 @@ Tcl_Seek(
} else {
/*
* Now seek to the new position in the channel as requested by the
- * caller. Note that we prefer the wideSeekProc if that is available
- * and non-NULL...
+ * caller.
*/
- if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
- chanPtr->typePtr->wideSeekProc != NULL) {
- curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
- offset, mode, &result);
- } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
- offset > Tcl_LongAsWide(LONG_MAX)) {
- result = EOVERFLOW;
- curPos = Tcl_LongAsWide(-1);
- } else {
- curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
- chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
- &result));
- }
+ curPos = ChanSeek(chanPtr, offset, mode, &result);
if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(result);
}
@@ -6632,25 +7061,13 @@ Tcl_Tell(
inputBuffered = Tcl_InputBuffered(chan);
outputBuffered = Tcl_OutputBuffered(chan);
- if ((inputBuffered != 0) && (outputBuffered != 0)) {
- /*Tcl_SetErrno(EFAULT);*/
- /*return Tcl_LongAsWide(-1);*/
- }
-
/*
* Get the current position in the device and compute the position where
* the next character will be read or written. Note that we prefer the
* wideSeekProc if that is available and non-NULL...
*/
- if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
- chanPtr->typePtr->wideSeekProc != NULL) {
- curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
- Tcl_LongAsWide(0), SEEK_CUR, &result);
- } else {
- curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
- chanPtr->instanceData, 0, SEEK_CUR, &result));
- }
+ curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(result);
return Tcl_LongAsWide(-1);
@@ -6689,19 +7106,18 @@ Tcl_SeekOld(
{
Tcl_WideInt wOffset, wResult;
- wOffset = Tcl_LongAsWide((long)offset);
+ wOffset = Tcl_LongAsWide((long) offset);
wResult = Tcl_Seek(chan, wOffset, mode);
- return (int)Tcl_WideAsLong(wResult);
+ return (int) Tcl_WideAsLong(wResult);
}
int
Tcl_TellOld(
Tcl_Channel chan) /* The channel to return pos for. */
{
- Tcl_WideInt wResult;
+ Tcl_WideInt wResult = Tcl_Tell(chan);
- wResult = Tcl_Tell(chan);
- return (int)Tcl_WideAsLong(wResult);
+ return (int) Tcl_WideAsLong(wResult);
}
/*
@@ -6742,7 +7158,7 @@ Tcl_TruncateChannel(
return TCL_ERROR;
}
- if (!(chanPtr->state->flags & TCL_WRITABLE)) {
+ if (!GotFlag(chanPtr->state, TCL_WRITABLE)) {
/*
* We require that the file was opened of writing. Do that check now
* so that we only flush if we think we're going to succeed.
@@ -6839,7 +7255,7 @@ CheckChannelErrors(
* Fail if the channel is not opened for desired operation.
*/
- if (GotFlag(statePtr, direction) == 0) {
+ if ((statePtr->flags & direction) == 0) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -7066,9 +7482,9 @@ Tcl_SetChannelBufferSize(
*/
if (sz < 1) {
- sz = 1;
+ sz = 1;
} else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
- sz = MAX_CHANNEL_BUFFER_SIZE;
+ sz = MAX_CHANNEL_BUFFER_SIZE;
}
statePtr = ((Channel *) chan)->state;
@@ -7165,11 +7581,12 @@ Tcl_BadChannelOption(
const char **argv;
int argc, i;
Tcl_DString ds;
+ Tcl_Obj *errObj;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, genericopt, -1);
if (optionList && (*optionList)) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
Tcl_DStringAppend(&ds, optionList, -1);
}
if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
@@ -7177,15 +7594,16 @@ Tcl_BadChannelOption(
Tcl_Panic("malformed option list in channel driver");
}
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad option \"", optionName,
- "\": should be one of ", NULL);
+ errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
+ optionName);
argc--;
for (i = 0; i < argc; i++) {
- Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
+ Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
}
- Tcl_AppendResult(interp, "or -", argv[i], NULL);
+ Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
+ Tcl_SetObjResult(interp, errObj);
Tcl_DStringFree(&ds);
- ckfree((char *) argv);
+ ckfree(argv);
}
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
@@ -7247,9 +7665,9 @@ Tcl_GetChannelOption(
*/
if (statePtr->csPtrR) {
- flags = statePtr->csPtrR->readFlags;
+ flags = statePtr->csPtrR->readFlags;
} else if (statePtr->csPtrW) {
- flags = statePtr->csPtrW->writeFlags;
+ flags = statePtr->csPtrW->writeFlags;
} else {
flags = statePtr->flags;
}
@@ -7409,8 +7827,8 @@ Tcl_GetChannelOption(
* and message.
*/
- return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
- interp, optionName, dsPtr);
+ return chanPtr->typePtr->getOptionProc(chanPtr->instanceData, interp,
+ optionName, dsPtr);
} else {
/*
* No driver specific options case.
@@ -7461,8 +7879,9 @@ Tcl_SetChannelOption(
if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
- Tcl_AppendResult(interp, "unable to set channel options: "
- "background copy in progress", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to set channel options: background copy in"
+ " progress", -1));
}
return TCL_ERROR;
}
@@ -7501,8 +7920,7 @@ Tcl_SetChannelOption(
} else if (HaveOpt(7, "-buffering")) {
len = strlen(newValue);
if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
- statePtr->flags &=
- ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED);
+ ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED);
} else if ((newValue[0] == 'l') &&
(strncmp(newValue, "line", len) == 0)) {
ResetFlag(statePtr, CHANNEL_UNBUFFERED);
@@ -7511,12 +7929,11 @@ Tcl_SetChannelOption(
(strncmp(newValue, "none", len) == 0)) {
ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
SetFlag(statePtr, CHANNEL_UNBUFFERED);
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "bad value for -buffering: "
- "must be one of full, line, or none", NULL);
- return TCL_ERROR;
- }
+ } else if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -buffering: must be one of"
+ " full, line, or none", -1));
+ return TCL_ERROR;
}
return TCL_OK;
} else if (HaveOpt(7, "-buffersize")) {
@@ -7570,12 +7987,14 @@ Tcl_SetChannelOption(
int outIndex = (argc - 1);
int inValue = (int) argv[0][0];
int outValue = (int) argv[outIndex][0];
+
if (inValue & 0x80 || outValue & 0x80) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -eofchar: ",
- "must be non-NUL ASCII character", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -eofchar: must be non-NUL ASCII"
+ " character", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (GotFlag(statePtr, TCL_READABLE)) {
@@ -7586,15 +8005,15 @@ Tcl_SetChannelOption(
}
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: should be a list of zero,"
- " one, or two elements", NULL);
+ " one, or two elements", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (argv != NULL) {
- ckfree((char *) argv);
+ ckfree(argv);
}
/*
@@ -7606,10 +8025,8 @@ Tcl_SetChannelOption(
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
- statePtr->flags &=
- ~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED);
+ ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-
return TCL_OK;
} else if (HaveOpt(1, "-translation")) {
const char *readMode, *writeMode;
@@ -7626,16 +8043,17 @@ Tcl_SetChannelOption(
writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -translation: must be a one or two"
- " element list", NULL);
+ " element list", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (readMode) {
TclEolTranslation translation;
+
if (*readMode == '\0') {
translation = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
@@ -7655,12 +8073,11 @@ Tcl_SetChannelOption(
translation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -7706,20 +8123,19 @@ Tcl_SetChannelOption(
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_OK;
} else if (chanPtr->typePtr->setOptionProc != NULL) {
- return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
- interp, optionName, newValue);
+ return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
+ optionName, newValue);
} else {
return Tcl_BadChannelOption(interp, optionName, NULL);
}
@@ -7774,7 +8190,7 @@ CleanupChannelHandlers(
TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -7827,14 +8243,14 @@ Tcl_NotifyChannel(
* their own events and pass them upward.
*/
- while (mask && (chanPtr->upChanPtr != (NULL))) {
+ while (mask && (chanPtr->upChanPtr != NULL)) {
Tcl_DriverHandlerProc *upHandlerProc;
upChanPtr = chanPtr->upChanPtr;
upTypePtr = upChanPtr->typePtr;
upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
if (upHandlerProc != NULL) {
- mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
+ mask = upHandlerProc(upChanPtr->instanceData, mask);
}
/*
@@ -7881,7 +8297,7 @@ Tcl_NotifyChannel(
/*
* Add this invocation to the list of recursive invocations of
- * ChannelHandlerEventProc.
+ * Tcl_NotifyChannel.
*/
nh.nextHandlerPtr = NULL;
@@ -7896,7 +8312,7 @@ Tcl_NotifyChannel(
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
- (*(chPtr->proc))(chPtr->clientData, chPtr->mask & mask);
+ chPtr->proc(chPtr->clientData, chPtr->mask & mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -8012,12 +8428,12 @@ UpdateInterest(
mask &= ~TCL_EXCEPTION;
if (!statePtr->timer) {
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc, chanPtr);
}
}
}
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
+ ChanWatch(chanPtr, mask);
}
/*
@@ -8054,7 +8470,8 @@ ChannelTimerProc(
* before UpdateInterest gets called by Tcl_NotifyChannel.
*/
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc,chanPtr);
Tcl_Preserve(statePtr);
Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
Tcl_Release(statePtr);
@@ -8115,7 +8532,7 @@ Tcl_CreateChannelHandler(
}
}
if (chPtr == NULL) {
- chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler));
+ chPtr = ckalloc(sizeof(ChannelHandler));
chPtr->mask = 0;
chPtr->proc = proc;
chPtr->clientData = clientData;
@@ -8199,7 +8616,7 @@ Tcl_DeleteChannelHandler(
}
/*
- * If ChannelHandlerEventProc is about to process this handler, tell it to
+ * If Tcl_NotifyChannel is about to process this handler, tell it to
* process the next one instead - we are going to delete *this* one.
*/
@@ -8219,7 +8636,7 @@ Tcl_DeleteChannelHandler(
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
- ckfree((char *) chPtr);
+ ckfree(chPtr);
/*
* Recompute the interest list for the channel, so that infinite loops
@@ -8270,6 +8687,7 @@ DeleteScriptRecord(
if (esPtr == statePtr->scriptRecordPtr) {
statePtr->scriptRecordPtr = esPtr->nextPtr;
} else {
+ CLANG_ASSERT(prevEsPtr);
prevEsPtr->nextPtr = esPtr->nextPtr;
}
@@ -8277,7 +8695,7 @@ DeleteScriptRecord(
TclChannelEventScriptInvoker, esPtr);
TclDecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
break;
}
@@ -8326,12 +8744,12 @@ CreateScriptRecord(
makeCH = (esPtr == NULL);
if (makeCH) {
- esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord));
+ esPtr = ckalloc(sizeof(EventScriptRecord));
}
/*
* Initialize the structure before calling Tcl_CreateChannelHandler,
- * because a reflected channel caling 'chan postevent' aka
+ * because a reflected channel calling 'chan postevent' aka
* 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
* 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
* see uninitialized memory and crash. See [Bug 2918110].
@@ -8409,7 +8827,7 @@ TclChannelEventScriptInvoker(
if (chanPtr->typePtr != NULL) {
DeleteScriptRecord(interp, chanPtr, mask);
}
- TclBackgroundException(interp, result);
+ Tcl_BackgroundException(interp, result);
}
TclChannelRelease((Tcl_Channel)chanPtr);
Tcl_Release(interp);
@@ -8446,11 +8864,11 @@ Tcl_FileEventObjCmd(
Channel *chanPtr; /* The channel to create the handler for. */
ChannelState *statePtr; /* State info for channel */
Tcl_Channel chan; /* The opaque type for the channel. */
- char *chanName;
+ const char *chanName;
int modeIndex; /* Index of mode argument. */
int mask;
- static const char *modeOptions[] = {"readable", "writable", NULL};
- static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+ static const char *const modeOptions[] = {"readable", "writable", NULL};
+ static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
@@ -8469,9 +8887,9 @@ Tcl_FileEventObjCmd(
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
- if (GotFlag(statePtr, mask) == 0) {
- Tcl_AppendResult(interp, "channel is not ",
- (mask == TCL_READABLE) ? "readable" : "writable", NULL);
+ if ((statePtr->flags & mask) == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
+ (mask == TCL_READABLE) ? "readable" : "writable"));
return TCL_ERROR;
}
@@ -8481,6 +8899,7 @@ Tcl_FileEventObjCmd(
if (objc == 3) {
EventScriptRecord *esPtr;
+
for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
@@ -8560,34 +8979,47 @@ ZeroTransferTimerProc(
*/
int
-TclCopyChannel(
+TclCopyChannelOld(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Channel inChan, /* Channel to read from. */
Tcl_Channel outChan, /* Channel to write to. */
int toRead, /* Amount of data to copy, or -1 for all. */
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
{
+ return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
+ cmdPtr);
+}
+
+int
+TclCopyChannel(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Channel inChan, /* Channel to read from. */
+ Tcl_Channel outChan, /* Channel to write to. */
+ Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */
+ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
+{
Channel *inPtr = (Channel *) inChan;
Channel *outPtr = (Channel *) outChan;
ChannelState *inStatePtr, *outStatePtr;
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+ int moveBytes;
inStatePtr = inPtr->state;
outStatePtr = outPtr->state;
- if (BUSY_STATE(inStatePtr,TCL_READABLE)) {
+ if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(inChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
}
return TCL_ERROR;
}
- if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
+ if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(outChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
}
return TCL_ERROR;
}
@@ -8620,8 +9052,19 @@ TclCopyChannel(
* Make sure the output side is unbuffered.
*/
- outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
- | CHANNEL_UNBUFFERED;
+ outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED)
+ | CHANNEL_UNBUFFERED;
+
+ /*
+ * Test for conditions where we know we can just move bytes from input
+ * channel to output channel with no transformation or even examination
+ * of the bytes themselves.
+ */
+
+ moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */
+ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+ && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+ && inStatePtr->encoding == outStatePtr->encoding;
/*
* Allocate a new CopyState to maintain info about the current copy in
@@ -8629,14 +9072,14 @@ TclCopyChannel(
* completed.
*/
- csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
- csPtr->bufSize = inStatePtr->bufSize;
+ csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+ csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
csPtr->toRead = toRead;
- csPtr->total = 0;
+ csPtr->total = (Tcl_WideInt) 0;
csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
@@ -8646,6 +9089,10 @@ TclCopyChannel(
inStatePtr->csPtrR = csPtr;
outStatePtr->csPtrW = csPtr;
+ if (moveBytes) {
+ return MoveBytes(csPtr);
+ }
+
/*
* Special handling of -size 0 async transfers, so that the -command is
* still called asynchronously.
@@ -8680,6 +9127,236 @@ TclCopyChannel(
*----------------------------------------------------------------------
*/
+static void
+MBCallback(
+ CopyState *csPtr,
+ Tcl_Obj *errObj)
+{
+ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
+ Tcl_WideInt total = csPtr->total;
+ Tcl_Interp *interp = csPtr->interp;
+ int code;
+
+ Tcl_IncrRefCount(cmdPtr);
+ StopCopy(csPtr);
+
+ /* TODO: What if cmdPtr is not a list?! */
+
+ Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
+ if (errObj) {
+ Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
+ }
+
+ Tcl_Preserve(interp);
+ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_Release(interp);
+ TclDecrRefCount(cmdPtr);
+}
+
+static void
+MBError(
+ CopyState *csPtr,
+ int mask,
+ int errorCode)
+{
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ Tcl_Obj *errObj;
+
+ Tcl_SetErrno(errorCode);
+
+ errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
+ (mask & TCL_READABLE) ? "read" : "writ",
+ Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
+ Tcl_PosixError(csPtr->interp));
+
+ if (csPtr->cmdPtr) {
+ MBCallback(csPtr, errObj);
+ } else {
+ Tcl_SetObjResult(csPtr->interp, errObj);
+ StopCopy(csPtr);
+ }
+}
+
+static void
+MBEvent(
+ ClientData clientData,
+ int mask)
+{
+ CopyState *csPtr = (CopyState *) clientData;
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+
+ if (mask & TCL_WRITABLE) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
+ switch (MBWrite(csPtr)) {
+ case TCL_OK:
+ MBCallback(csPtr, NULL);
+ break;
+ case TCL_CONTINUE:
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ break;
+ }
+ } else if (mask & TCL_READABLE) {
+ if (TCL_OK == MBRead(csPtr)) {
+ /* When at least one full buffer is present, stop reading. */
+ if (IsBufferFull(inStatePtr->inQueueHead)
+ || !Tcl_InputBlocked(inChan)) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ }
+
+ /* Successful read -- set up to write the bytes we read */
+ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
+ }
+ }
+}
+
+static int
+MBRead(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ int code;
+
+ if (bufPtr && BytesLeft(bufPtr) > 0) {
+ return TCL_OK;
+ }
+
+ code = GetInput(inStatePtr->topChanPtr);
+ if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
+ return TCL_OK;
+ } else {
+ MBError(csPtr, TCL_READABLE, code);
+ return TCL_ERROR;
+ }
+}
+
+static int
+MBWrite(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ ChannelBuffer *tail = NULL;
+ int code;
+ Tcl_WideInt inBytes = 0;
+
+ /* Count up number of bytes waiting in the input queue */
+ while (bufPtr) {
+ inBytes += BytesLeft(bufPtr);
+ tail = bufPtr;
+ if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+ /* Queue has enough bytes to complete the copy */
+ break;
+ }
+ bufPtr = bufPtr->nextPtr;
+ }
+
+ if (bufPtr) {
+ /* Split the overflowing buffer in two */
+ int extra = (int) (inBytes - csPtr->toRead);
+ /* Note that going with int for extra assumes that inBytes is not too
+ * much over toRead to require a wide itself. If that gets violated
+ * then the calculations involving extra must be made wide too.
+ *
+ * Noted with Win32/MSVC debug build treating the warning (possible of
+ * data in int64 to int conversion) as error.
+ */
+
+ bufPtr = AllocChannelBuffer(extra);
+
+ tail->nextAdded -= extra;
+ memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+ bufPtr->nextAdded += extra;
+ bufPtr->nextPtr = tail->nextPtr;
+ tail->nextPtr = NULL;
+ inBytes = csPtr->toRead;
+ }
+
+ /* Update the byte counts */
+ if (csPtr->toRead != -1) {
+ csPtr->toRead -= inBytes;
+ }
+ csPtr->total += inBytes;
+
+ /* Move buffers from input to output channels */
+ if (outStatePtr->outQueueTail) {
+ outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+ } else {
+ outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+ }
+ outStatePtr->outQueueTail = tail;
+ inStatePtr->inQueueHead = bufPtr;
+ if (inStatePtr->inQueueTail == tail) {
+ inStatePtr->inQueueTail = bufPtr;
+ }
+ if (bufPtr == NULL) {
+ inStatePtr->inQueueTail = NULL;
+ }
+
+ code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (code) {
+ MBError(csPtr, TCL_WRITABLE, code);
+ return TCL_ERROR;
+ }
+ if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
+ return TCL_OK;
+ }
+ return TCL_CONTINUE;
+}
+
+static int
+MoveBytes(
+ CopyState *csPtr) /* State of copy operation. */
+{
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
+ int errorCode;
+
+ if (bufPtr && BytesLeft(bufPtr)) {
+ /* If we start with unflushed bytes in the destination
+ * channel, flush them out of the way first. */
+
+ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (errorCode != 0) {
+ MBError(csPtr, TCL_WRITABLE, errorCode);
+ return TCL_ERROR;
+ }
+ }
+
+ if (csPtr->cmdPtr) {
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ return TCL_OK;
+ }
+
+ while (1) {
+ int code;
+
+ if (TCL_ERROR == MBRead(csPtr)) {
+ return TCL_ERROR;
+ }
+ code = MBWrite(csPtr);
+ if (code == TCL_OK) {
+ Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+ StopCopy(csPtr);
+ return TCL_OK;
+ }
+ if (code == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /* code == TCL_CONTINUE --> continue the loop */
+ }
+ return TCL_OK; /* Silence compiler warnings */
+}
+
static int
CopyData(
CopyState *csPtr, /* State of copy operation. */
@@ -8691,7 +9368,7 @@ CopyData(
ChannelState *inStatePtr, *outStatePtr;
int result = TCL_OK, size, sizeb;
Tcl_WideInt total;
- char *buffer;
+ const char *buffer;
int inBinary, outBinary, sameEncoding;
/* Encoding control */
int underflow; /* Input underflow */
@@ -8720,7 +9397,7 @@ CopyData(
Tcl_IncrRefCount(bufObj);
}
- while (csPtr->toRead != 0) {
+ while (csPtr->toRead != (Tcl_WideInt) 0) {
/*
* Check for unreported background errors.
*/
@@ -8744,24 +9421,26 @@ CopyData(
* underflow instead to prime the readable fileevent.
*/
- size = 0;
+ size = 0;
underflow = 1;
} else {
/*
* Read up to bufSize bytes.
*/
- if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
+ if ((csPtr->toRead == (Tcl_WideInt) -1)
+ || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
sizeb = csPtr->bufSize;
} else {
- sizeb = csPtr->toRead;
+ sizeb = (int) csPtr->toRead;
}
if (inBinary || sameEncoding) {
- size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
+ !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
- 0 /* No append */);
+ 0 /* No append */);
}
underflow = (size >= 0) && (size < sizeb); /* Input underflow */
}
@@ -8794,8 +9473,8 @@ CopyData(
if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
break;
}
- if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
- !(mask & TCL_READABLE)) {
+ if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
+ !(mask & TCL_READABLE)) {
if (mask & TCL_WRITABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
@@ -8803,6 +9482,10 @@ CopyData(
csPtr);
}
if (size == 0) {
+ if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
+ /* We allowed a short read. Keep trying. */
+ continue;
+ }
if (bufObj != NULL) {
TclDecrRefCount(bufObj);
bufObj = NULL;
@@ -8860,7 +9543,7 @@ CopyData(
}
/*
- * (UP) Update the current byte count. Do it now so the count is valid
+ * Update the current byte count. Do it now so the count is valid
* before a return or break takes us out of the loop. The invariant at
* the top of the loop should be that csPtr->toRead holds the number
* of bytes left to copy.
@@ -8886,7 +9569,7 @@ CopyData(
* therefore we don't need a writable handler.
*/
- if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
@@ -8937,6 +9620,7 @@ CopyData(
total = csPtr->total;
if (cmdPtr && interp) {
int code;
+
/*
* Get a private copy of the command so we can mutate it by adding
* arguments. Note that StopCopy frees our saved reference to the
@@ -8954,7 +9638,7 @@ CopyData(
}
code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
- TclBackgroundException(interp, code);
+ Tcl_BackgroundException(interp, code);
result = TCL_ERROR;
}
TclDecrRefCount(cmdPtr);
@@ -8980,10 +9664,9 @@ CopyData(
* DoRead --
*
* Stores up to "bytesToRead" bytes in memory pointed to by "dst".
- * These bytes come from reading the channel "chanPtr" and
- * performing the configured translations.
- *
- * No encoding conversions are applied to the bytes being read.
+ * These bytes come from reading the channel "chanPtr" and
+ * performing the configured translations. No encoding conversions
+ * are applied to the bytes being read.
*
* Results:
* The number of bytes actually stored (<= bytesToRead),
@@ -9007,8 +9690,9 @@ CopyData(
static int
DoRead(
Channel *chanPtr, /* The channel from which to read. */
- char *dst, /* Where to store input read. */
- int bytesToRead) /* Maximum number of bytes to read. */
+ char *dst, /* Where to store input read. */
+ int bytesToRead, /* Maximum number of bytes to read. */
+ int allowShortReads) /* Allow half-blocking (pipes,sockets) */
{
ChannelState *statePtr = chanPtr->state;
char *p = dst;
@@ -9050,7 +9734,7 @@ DoRead(
TclChannelPreserve((Tcl_Channel)chanPtr);
while (bytesToRead) {
/*
- * Each pass through the loop is intended to process up to
+ * Each pass through the loop is intended to process up to
* one channel buffer.
*/
@@ -9058,13 +9742,13 @@ DoRead(
ChannelBuffer *bufPtr = statePtr->inQueueHead;
/*
- * Don't read more data if we have what we need.
+ * Don't read more data if we have what we need.
*/
while (!bufPtr || /* We got no buffer! OR */
(!IsBufferFull(bufPtr) && /* Our buffer has room AND */
(BytesLeft(bufPtr) < bytesToRead) ) ) {
- /* Not enough bytes in it
+ /* Not enough bytes in it
* yet to fill the dst */
int code;
@@ -9134,13 +9818,13 @@ DoRead(
if (bufPtr->nextPtr == NULL) {
/* There's no more buffered data.... */
- if (GotFlag(statePtr, CHANNEL_EOF)) {
+ if (statePtr->flags & CHANNEL_EOF) {
/* ...and there never will be. */
*p++ = '\r';
bytesToRead--;
bufPtr->nextRemoved++;
- } else if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ } else if (statePtr->flags & CHANNEL_BLOCKED) {
/* ...and we cannot get more now. */
SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
@@ -9171,8 +9855,8 @@ DoRead(
bufPtr = statePtr->inQueueHead;
}
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
- == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
+ && GotFlag(statePtr, CHANNEL_BLOCKED)) {
break;
}
@@ -9222,7 +9906,7 @@ CopyEventProc(
ClientData clientData,
int mask)
{
- (void) CopyData((CopyState *) clientData, mask);
+ (void) CopyData(clientData, mask);
}
/*
@@ -9247,12 +9931,16 @@ StopCopy(
CopyState *csPtr) /* State for bg copy to stop . */
{
ChannelState *inStatePtr, *outStatePtr;
+ Tcl_Channel inChan, outChan;
+
int nonBlocking;
if (!csPtr) {
return;
}
+ inChan = (Tcl_Channel) csPtr->readPtr;
+ outChan = (Tcl_Channel) csPtr->writePtr;
inStatePtr = csPtr->readPtr->state;
outStatePtr = csPtr->writePtr->state;
@@ -9260,34 +9948,34 @@ StopCopy(
* Restore the old blocking mode and output buffering mode.
*/
- nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
+ nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING;
if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->readPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
if (csPtr->readPtr != csPtr->writePtr) {
- nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
+ nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING;
if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
}
- outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+ ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
outStatePtr->flags |=
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
if (csPtr->cmdPtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
- csPtr);
- if (csPtr->readPtr != csPtr->writePtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
- CopyEventProc, csPtr);
+ Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+ if (inChan != outChan) {
+ Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
TclDecrRefCount(csPtr->cmdPtr);
}
inStatePtr->csPtrR = NULL;
outStatePtr->csPtrW = NULL;
- ckfree((char *) csPtr);
+ ckfree(csPtr);
}
/*
@@ -9328,7 +10016,7 @@ StackSetBlockMode(
while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
- result = (*blockModeProc) (chanPtr->instanceData, mode);
+ result = blockModeProc(chanPtr->instanceData, mode);
if (result != 0) {
Tcl_SetErrno(result);
return result;
@@ -9383,8 +10071,9 @@ SetBlockMode(
*/
if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
- Tcl_AppendResult(interp, "error setting blocking mode: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error setting blocking mode: %s",
+ Tcl_PosixError(interp)));
}
} else {
/*
@@ -9481,10 +10170,11 @@ Tcl_GetChannelNamesEx(
}
goto done;
}
+
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
-
statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
+
if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
name = "stdin";
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
@@ -9630,11 +10320,8 @@ Tcl_IsChannelExisting(
name = statePtr->channelName;
}
- /* Bug 2333466. Include \0 in the compare to prevent partial matching
- * on prefixes.
- */
if ((*chanName == *name) &&
- (memcmp(name, chanName, (size_t) chanNameLen+1) == 0)) {
+ (memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
return 1;
}
}
@@ -9753,13 +10440,13 @@ Tcl_ChannelBlockModeProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->blockModeProc;
- } else {
- /*
- * The v1 structure had the blockModeProc in a different place.
- */
-
- return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
}
+
+ /*
+ * The v1 structure had the blockModeProc in a different place.
+ */
+
+ return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
}
/*
@@ -10001,9 +10688,8 @@ Tcl_ChannelFlushProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->flushProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -10029,9 +10715,8 @@ Tcl_ChannelHandlerProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->handlerProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -10057,9 +10742,8 @@ Tcl_ChannelWideSeekProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
return chanTypePtr->wideSeekProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -10086,9 +10770,8 @@ Tcl_ChannelThreadActionProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
return chanTypePtr->threadActionProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -10205,7 +10888,7 @@ FixLevelCode(
res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
if (res != TCL_OK) {
- Tcl_Panic("Tcl_SetChannelError(Interp): Bad syntax of message");
+ Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
}
explicitResult = (1 == (lc % 2));
@@ -10265,7 +10948,7 @@ FixLevelCode(
lcn += 2;
}
- lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *));
+ lvn = ckalloc(lcn * sizeof(Tcl_Obj *));
/*
* New level/code information is spliced into the first occurence of
@@ -10318,7 +11001,7 @@ FixLevelCode(
msg = Tcl_NewListObj(j, lvn);
- ckfree((char *) lvn);
+ ckfree(lvn);
return msg;
}
@@ -10402,9 +11085,8 @@ Tcl_ChannelTruncateProc(
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
return chanTypePtr->truncateProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -10436,7 +11118,7 @@ DupChannelIntRep(
SET_CHANNELSTATE(copyPtr, statePtr);
SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
- Tcl_Preserve((ClientData) statePtr);
+ Tcl_Preserve(statePtr);
copyPtr->typePtr = srcPtr->typePtr;
}
@@ -10477,10 +11159,10 @@ SetChannelFromAny(
statePtr = GET_CHANNELSTATE(objPtr);
if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
- Tcl_Release((ClientData) statePtr);
+ Tcl_Release(statePtr);
objPtr->typePtr = NULL;
} else if (interp != GET_CHANNELINTERP(objPtr)) {
- Tcl_Release((ClientData) statePtr);
+ Tcl_Release(statePtr);
objPtr->typePtr = NULL;
}
}
@@ -10492,8 +11174,8 @@ SetChannelFromAny(
}
TclFreeIntRep(objPtr);
- statePtr = ((Channel *)chan)->state;
- Tcl_Preserve((ClientData) statePtr);
+ statePtr = ((Channel *) chan)->state;
+ Tcl_Preserve(statePtr);
SET_CHANNELSTATE(objPtr, statePtr);
SET_CHANNELINTERP(objPtr, interp);
objPtr->typePtr = &chanObjType;
@@ -10521,7 +11203,8 @@ static void
FreeChannelIntRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr));
+ Tcl_Release(GET_CHANNELSTATE(objPtr));
+ objPtr->typePtr = NULL;
}
#if 0
@@ -10538,7 +11221,7 @@ DumpFlags(
char buf[20];
int i = 0;
-#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
+#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
ChanFlag('r', TCL_READABLE);
ChanFlag('w', TCL_WRITABLE);