通讯编程

开发平台：

Visual C++

tclIO.c：源码内容

/*
* If we are in the middle of a background copy, use the saved flags.
*/
if (statePtr->csPtr) {
if (chanPtr == statePtr->csPtr->readPtr) {
flags = statePtr->csPtr->readFlags;
} else {
flags = statePtr->csPtr->writeFlags;
}
} else {
flags = statePtr->flags;
}
/*
* If the optionName is NULL it means that we want a list of all
* options and values.
*/
if (optionName == (char *) NULL) {
len = 0;
} else {
len = strlen(optionName);
}
if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
(strncmp(optionName, "-blocking", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-blocking");
}
Tcl_DStringAppendElement(dsPtr,
(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffering", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffering");
}
if (flags & CHANNEL_LINEBUFFERED) {
Tcl_DStringAppendElement(dsPtr, "line");
} else if (flags & CHANNEL_UNBUFFERED) {
Tcl_DStringAppendElement(dsPtr, "none");
} else {
Tcl_DStringAppendElement(dsPtr, "full");
}
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffersize", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffersize");
}
TclFormatInt(optionVal, statePtr->bufSize);
Tcl_DStringAppendElement(dsPtr, optionVal);
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) ||
((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-encoding", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-encoding");
}
if (statePtr->encoding == NULL) {
Tcl_DStringAppendElement(dsPtr, "binary");
} else {
Tcl_DStringAppendElement(dsPtr,
Tcl_GetEncodingName(statePtr->encoding));
}
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) ||
((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-eofchar", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eofchar");
}
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
if (statePtr->inEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
sprintf(buf, "%c", statePtr->inEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
if (flags & TCL_WRITABLE) {
if (statePtr->outEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
sprintf(buf, "%c", statePtr->outEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
/* Not readable or writable (server socket) */
Tcl_DStringAppendElement(dsPtr, "");
}
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringEndSublist(dsPtr);
}
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) ||
((len > 1) && (optionName[1] == 't') &&
(strncmp(optionName, "-translation", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-translation");
}
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
} else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
} else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
}
}
if (flags & TCL_WRITABLE) {
if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
} else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
} else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
}
}
if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
/* Not readable or writable (server socket) */
Tcl_DStringAppendElement(dsPtr, "auto");
}
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringEndSublist(dsPtr);
}
if (len > 0) {
return TCL_OK;
}
}
if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
/*
* let the driver specific handle additional options
* and result code and message.
*/
return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
interp, optionName, dsPtr);
} else {
/*
* no driver specific options case.
*/
if (len == 0) {
return TCL_OK;
}
return Tcl_BadChannelOption(interp, optionName, NULL);
}
}
/*
*---------------------------------------------------------------------------
*
* Tcl_SetChannelOption --
*
* Sets an option on a channel.
*
* Results:
* A standard Tcl result. On error, sets interp's result object
* if interp is not NULL.
*
* Side effects:
* May modify an option on a device.
*
*---------------------------------------------------------------------------
*/
int
Tcl_SetChannelOption(interp, chan, optionName, newValue)
Tcl_Interp *interp; /* For error reporting - can be NULL. */
Tcl_Channel chan; /* Channel on which to set mode. */
CONST char *optionName; /* Which option to set? */
CONST char *newValue; /* New value for option. */
{
Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
ChannelState *statePtr = chanPtr->state; /* state info for channel */
size_t len; /* Length of optionName string. */
int argc;
CONST char **argv;
/*
* If the channel is in the middle of a background copy, fail.
*/
if (statePtr->csPtr) {
if (interp) {
Tcl_AppendResult(interp,
"unable to set channel options: background copy in progress",
(char *) NULL);
}
return TCL_ERROR;
}
/*
* Disallow options on dead channels -- channels that have been closed but
* not yet been deallocated. Such channels can be found if the exit
* handler for channel cleanup has run but the channel is still
* registered in an interpreter.
*/
if (CheckForDeadChannel(NULL, statePtr)) {
return TCL_ERROR;
}
/*
* This operation should occur at the top of a channel stack.
*/
chanPtr = statePtr->topChanPtr;
len = strlen(optionName);
if ((len > 2) && (optionName[1] == 'b') &&
(strncmp(optionName, "-blocking", len) == 0)) {
int newMode;
if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
return TCL_ERROR;
}
if (newMode) {
newMode = TCL_MODE_BLOCKING;
} else {
newMode = TCL_MODE_NONBLOCKING;
}
return SetBlockMode(interp, chanPtr, newMode);
} else if ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffering", len) == 0)) {
len = strlen(newValue);
if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
statePtr->flags &=
(~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
} else if ((newValue[0] == 'l') &&
(strncmp(newValue, "line", len) == 0)) {
statePtr->flags &= (~(CHANNEL_UNBUFFERED));
statePtr->flags |= CHANNEL_LINEBUFFERED;
} else if ((newValue[0] == 'n') &&
(strncmp(newValue, "none", len) == 0)) {
statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
statePtr->flags |= CHANNEL_UNBUFFERED;
} else {
if (interp) {
Tcl_AppendResult(interp, "bad value for -buffering: ",
"must be one of full, line, or none",
(char *) NULL);
return TCL_ERROR;
}
}
return TCL_OK;
} else if ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffersize", len) == 0)) {
int newBufferSize;
if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_SetChannelBufferSize(chan, newBufferSize);
} else if ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-encoding", len) == 0)) {
Tcl_Encoding encoding;
if ((newValue[0] == '') || (strcmp(newValue, "binary") == 0)) {
encoding = NULL;
} else {
encoding = Tcl_GetEncoding(interp, newValue);
if (encoding == NULL) {
return TCL_ERROR;
}
}
/*
* When the channel has an escape sequence driven encoding such as
* iso2022, the terminated escape sequence must write to the buffer.
*/
if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
}
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = encoding;
statePtr->inputEncodingState = NULL;
statePtr->inputEncodingFlags = TCL_ENCODING_START;
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
UpdateInterest(chanPtr);
} else if ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-eofchar", len) == 0)) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 0) {
statePtr->inEofChar = 0;
statePtr->outEofChar = 0;
} else if (argc == 1) {
if (statePtr->flags & TCL_WRITABLE) {
statePtr->outEofChar = (int) argv[0][0];
}
if (statePtr->flags & TCL_READABLE) {
statePtr->inEofChar = (int) argv[0][0];
}
} else if (argc != 2) {
if (interp) {
Tcl_AppendResult(interp,
"bad value for -eofchar: should be a list of zero,",
" one, or two elements", (char *) NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
} else {
if (statePtr->flags & TCL_READABLE) {
statePtr->inEofChar = (int) argv[0][0];
}
if (statePtr->flags & TCL_WRITABLE) {
statePtr->outEofChar = (int) argv[1][0];
}
}
if (argv != NULL) {
ckfree((char *) argv);
}
/*
* [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing
* the character which signals eof can transform a current eof
* condition into a 'go ahead'. Ditto for blocked.
*/
statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED));
return TCL_OK;
} else if ((len > 1) && (optionName[1] == 't') &&
(strncmp(optionName, "-translation", len) == 0)) {
CONST char *readMode, *writeMode;
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 1) {
readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
writeMode = (statePtr->flags & 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;
} else {
if (interp) {
Tcl_AppendResult(interp,
"bad value for -translation: must be a one or two",
" element list", (char *) NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
}
if (readMode) {
TclEolTranslation translation;
if (*readMode == '') {
translation = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
translation = TCL_TRANSLATE_AUTO;
} else if (strcmp(readMode, "binary") == 0) {
translation = TCL_TRANSLATE_LF;
statePtr->inEofChar = 0;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = NULL;
} else if (strcmp(readMode, "lf") == 0) {
translation = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
translation = TCL_TRANSLATE_CR;
} else if (strcmp(readMode, "crlf") == 0) {
translation = TCL_TRANSLATE_CRLF;
} else if (strcmp(readMode, "platform") == 0) {
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", (char *) NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
}
/*
* Reset the EOL flags since we need to look at any buffered
* data to see if the new translation mode allows us to
* complete the line.
*/
if (translation != statePtr->inputTranslation) {
statePtr->inputTranslation = translation;
statePtr->flags &= ~(INPUT_SAW_CR);
statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
}
}
if (writeMode) {
if (*writeMode == '') {
/* Do nothing. */
} else if (strcmp(writeMode, "auto") == 0) {
/*
* This is a hack to get TCP sockets to produce output
* in CRLF mode if they are being set into AUTO mode.
* A better solution for achieving this effect will be
* coded later.
*/
if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
}
} else if (strcmp(writeMode, "binary") == 0) {
statePtr->outEofChar = 0;
statePtr->outputTranslation = TCL_TRANSLATE_LF;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = NULL;
} else if (strcmp(writeMode, "lf") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CR;
} else if (strcmp(writeMode, "crlf") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else if (strcmp(writeMode, "platform") == 0) {
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", (char *) NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
}
}
ckfree((char *) argv);
return TCL_OK;
} else if (chanPtr->typePtr->setOptionProc != NULL) {
return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
interp, optionName, newValue);
} else {
return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
}
/*
* If bufsize changes, need to get rid of old utility buffer.
*/
if (statePtr->saveInBufPtr != NULL) {
RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
statePtr->saveInBufPtr = NULL;
}
if (statePtr->inQueueHead != NULL) {
if ((statePtr->inQueueHead->nextPtr == NULL)
&& (statePtr->inQueueHead->nextAdded ==
statePtr->inQueueHead->nextRemoved)) {
RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
}
}
/*
* If encoding or bufsize changes, need to update output staging buffer.
*/
if (statePtr->outputStage != NULL) {
ckfree((char *) statePtr->outputStage);
statePtr->outputStage = NULL;
}
if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
statePtr->outputStage = (char *)
ckalloc((unsigned) (statePtr->bufSize + 2));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* CleanupChannelHandlers --
*
* Removes channel handlers that refer to the supplied interpreter,
* so that if the actual channel is not closed now, these handlers
* will not run on subsequent events on the channel. This would be
* erroneous, because the interpreter no longer has a reference to
* this channel.
*
* Results:
* None.
*
* Side effects:
* Removes channel handlers.
*
*----------------------------------------------------------------------
*/
static void
CleanupChannelHandlers(interp, chanPtr)
Tcl_Interp *interp;
Channel *chanPtr;
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/*
* Remove fileevent records on this channel that refer to the
* given interpreter.
*/
for (sPtr = statePtr->scriptRecordPtr,
prevPtr = (EventScriptRecord *) NULL;
sPtr != (EventScriptRecord *) NULL;
sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == (EventScriptRecord *) NULL) {
statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
TclChannelEventScriptInvoker, (ClientData) sPtr);
Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
}
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_NotifyChannel --
*
* This procedure is called by a channel driver when a driver
* detects an event on a channel. This procedure is responsible
* for actually handling the event by invoking any channel
* handler callbacks.
*
* Results:
* None.
*
* Side effects:
* Whatever the channel handler callback procedure does.
*
*----------------------------------------------------------------------
*/
void
Tcl_NotifyChannel(channel, mask)
Tcl_Channel channel; /* Channel that detected an event. */
int mask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which events were detected. */
{
Channel *chanPtr = (Channel *) channel;
ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelHandler *chPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
Channel* upChanPtr;
Tcl_ChannelType* upTypePtr;
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/* [SF Tcl Bug 943274]
* For a non-blocking channel without blockmodeproc we keep track
* of actual input coming from the OS so that we can do a credible
* imitation of non-blocking behaviour.
*/
if ((mask & TCL_READABLE) &&
(statePtr->flags & CHANNEL_NONBLOCKING) &&
(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
!(statePtr->flags & CHANNEL_TIMER_FEV)) {
statePtr->flags |= CHANNEL_HAS_MORE_DATA;
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
/*
* In contrast to the other API functions this procedure walks towards
* the top of a stack and not down from it.
*
* The channel calling this procedure is the one who generated the event,
* and thus does not take part in handling it. IOW, its HandlerProc is
* not called, instead we begin with the channel above it.
*
* This behaviour also allows the transformation channels to
* generate their own events and pass them upward.
*/
while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
Tcl_DriverHandlerProc* upHandlerProc;
upChanPtr = chanPtr->upChanPtr;
upTypePtr = upChanPtr->typePtr;
upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
if (upHandlerProc != NULL) {
mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
}
/* ELSE:
* Ignore transformations which are unable to handle the event
* coming from below. Assume that they don't change the mask and
* pass it on.
*/
chanPtr = upChanPtr;
}
channel = (Tcl_Channel) chanPtr;
/*
* Here we have either reached the top of the stack or the mask is
* empty. We break out of the procedure if it is the latter.
*/
if (!mask) {
return;
}
/*
* We are now above the topmost channel in a stack and have events
* left. Now call the channel handlers as usual.
*
* Preserve the channel struct in case the script closes it.
*/
Tcl_Preserve((ClientData) channel);
Tcl_Preserve((ClientData) statePtr);
/*
* If we are flushing in the background, be sure to call FlushChannel
* for writable events. Note that we have to discard the writable
* event so we don't call any write handlers before the flush is
* complete.
*/
if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
FlushChannel(NULL, chanPtr, 1);
mask &= ~TCL_WRITABLE;
}
/*
* Add this invocation to the list of recursive invocations of
* ChannelHandlerEventProc.
*/
nh.nextHandlerPtr = (ChannelHandler *) NULL;
nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
tsdPtr->nestedHandlerPtr = &nh;
for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
/*
* If this channel handler is interested in any of the events that
* have occurred on the channel, invoke its procedure.
*/
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
(*(chPtr->proc))(chPtr->clientData, mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
}
}
/*
* Update the notifier interest, since it may have changed after
* invoking event handlers. Skip that if the channel was deleted
* in the call to the channel handler.
*/
if (chanPtr->typePtr != NULL) {
UpdateInterest(chanPtr);
}
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
/*
*----------------------------------------------------------------------
*
* UpdateInterest --
*
* Arrange for the notifier to call us back at appropriate times
* based on the current state of the channel.
*
* Results:
* None.
*
* Side effects:
* May schedule a timer or driver handler.
*
*----------------------------------------------------------------------
*/
static void
UpdateInterest(chanPtr)
Channel *chanPtr; /* Channel to update. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
int mask = statePtr->interestMask;
/*
* 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) {
mask |= TCL_WRITABLE;
}
/*
* If there is data in the input queue, and we aren't waiting for more
* data, then we need to schedule a timer so we don't block in the
* notifier. Also, cancel the read interest so we don't get duplicate
* events.
*/
if (mask & TCL_READABLE) {
if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
&& (statePtr->inQueueHead->nextRemoved <
statePtr->inQueueHead->nextAdded)) {
mask &= ~TCL_READABLE;
/*
* Andreas Kupries, April 11, 2003
*
* Some operating systems (Solaris 2.6 and higher (but not
* Solaris 2.5, go figure)) generate READABLE and
* EXCEPTION events when select()'ing [*] on a plain file,
* even if EOF was not yet reached. This is a problem in
* the following situation:
*
* - An extension asks to get both READABLE and EXCEPTION
* events.
* - It reads data into a buffer smaller than the buffer
* used by Tcl itself.
* - It does not process all events in the event queue, but
* only only one, at least in some situations.
*
* In that case we can get into a situation where
*
* - Tcl drops READABLE here, because it has data in its own
* buffers waiting to be read by the extension.
* - A READABLE event is syntesized via timer.
* - The OS still reports the EXCEPTION condition on the file.
* - And the extension gets the EXCPTION event first, and
* handles this as EOF.
*
* End result ==> Premature end of reading from a file.
*
* The concrete example is 'Expect', and its [expect]
* command (and at the C-level, deep in the bowels of
* Expect, 'exp_get_next_event'. See marker 'SunOS' for
* commentary in that function too).
*
* [*] As the Tcl notifier does. See also for marker
* 'SunOS' in file 'exp_event.c' of Expect.
*
* Our solution here is to drop the interest in the
* EXCEPTION events too. This compiles on all platforms,
* and also passes the testsuite on all of them.
*/
mask &= ~TCL_EXCEPTION;
if (!statePtr->timer) {
statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
}
}
}
(chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
}
/*
*----------------------------------------------------------------------
*
* ChannelTimerProc --
*
* Timer handler scheduled by UpdateInterest to monitor the
* channel buffers until they are empty.
*
* Results:
* None.
*
* Side effects:
* May invoke channel handlers.
*
*----------------------------------------------------------------------
*/
static void
ChannelTimerProc(clientData)
ClientData clientData;
{
Channel *chanPtr = (Channel *) clientData;
ChannelState *statePtr = chanPtr->state; /* state info for channel */
if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
&& (statePtr->interestMask & TCL_READABLE)
&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
&& (statePtr->inQueueHead->nextRemoved <
statePtr->inQueueHead->nextAdded)) {
/*
* Restart the timer in case a channel handler reenters the
* event loop before UpdateInterest gets called by Tcl_NotifyChannel.
*/
statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/* Set the TIMER flag to notify the higher levels that the
* driver might have no data for us. We do this only if we are
* in non-blocking mode and the driver has no BlockModeProc
* because only then we really don't know if the driver will
* block or not. A similar test is done in "PeekAhead".
*/
if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
statePtr->flags |= CHANNEL_TIMER_FEV;
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
Tcl_Preserve((ClientData) statePtr);
Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
statePtr->flags &= ~CHANNEL_TIMER_FEV;
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
Tcl_Release((ClientData) statePtr);
} else {
statePtr->timer = NULL;
UpdateInterest(chanPtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateChannelHandler --
*
* Arrange for a given procedure to be invoked whenever the
* channel indicated by the chanPtr arg becomes readable or
* writable.
*
* Results:
* None.
*
* Side effects:
* From now on, whenever the I/O channel given by chanPtr becomes
* ready in the way indicated by mask, proc will be invoked.
* See the manual entry for details on the calling sequence
* to proc. If there is already an event handler for chan, proc
* and clientData, then the mask will be updated.
*
*----------------------------------------------------------------------
*/
void
Tcl_CreateChannelHandler(chan, mask, proc, clientData)
Tcl_Channel chan; /* The channel to create the handler for. */
int mask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION:
* indicates conditions under which
* proc should be called. Use 0 to
* disable a registered handler. */
Tcl_ChannelProc *proc; /* Procedure to call for each
* selected event. */
ClientData clientData; /* Arbitrary data to pass to proc. */
{
ChannelHandler *chPtr;
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state; /* state info for channel */
/*
* Check whether this channel handler is not already registered. If
* it is not, create a new record, else reuse existing record (smash
* current values).
*/
for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
(chPtr->clientData == clientData)) {
break;
}
}
if (chPtr == (ChannelHandler *) NULL) {
chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
chPtr->mask = 0;
chPtr->proc = proc;
chPtr->clientData = clientData;
chPtr->chanPtr = chanPtr;
chPtr->nextPtr = statePtr->chPtr;
statePtr->chPtr = chPtr;
}
/*
* The remainder of the initialization below is done regardless of
* whether or not this is a new record or a modification of an old
* one.
*/
chPtr->mask = mask;
/*
* Recompute the interest mask for the channel - this call may actually
* be disabling an existing handler.
*/
statePtr->interestMask = 0;
for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
statePtr->interestMask |= chPtr->mask;
}
UpdateInterest(statePtr->topChanPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteChannelHandler --
*
* Cancel a previously arranged callback arrangement for an IO
* channel.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered for this chan, proc and
* clientData , it is removed and the callback will no longer be called
* when the channel becomes ready for IO.
*
*----------------------------------------------------------------------
*/
void
Tcl_DeleteChannelHandler(chan, proc, clientData)
Tcl_Channel chan; /* The channel for which to remove the
* callback. */
Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */
ClientData clientData; /* The client data in the callback
* to delete. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelHandler *chPtr, *prevChPtr;
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state; /* state info for channel */
NextChannelHandler *nhPtr;
/*
* Find the entry and the previous one in the list.
*/
for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
&& (chPtr->proc == proc)) {
break;
}
prevChPtr = chPtr;
}
/*
* If not found, return without doing anything.
*/
if (chPtr == (ChannelHandler *) NULL) {
return;
}
/*
* If ChannelHandlerEventProc is about to process this handler, tell it to
* process the next one instead - we are going to delete *this* one.
*/
for (nhPtr = tsdPtr->nestedHandlerPtr;
nhPtr != (NextChannelHandler *) NULL;
nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr == chPtr) {
nhPtr->nextHandlerPtr = chPtr->nextPtr;
}
}
/*
* Splice it out of the list of channel handlers.
*/
if (prevChPtr == (ChannelHandler *) NULL) {
statePtr->chPtr = chPtr->nextPtr;
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
ckfree((char *) chPtr);
/*
* Recompute the interest list for the channel, so that infinite loops
* will not result if Tcl_DeleteChannelHandler is called inside an
* event.
*/
statePtr->interestMask = 0;
for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
statePtr->interestMask |= chPtr->mask;
}
UpdateInterest(statePtr->topChanPtr);
}
/*
*----------------------------------------------------------------------
*
* DeleteScriptRecord --
*
* Delete a script record for this combination of channel, interp
* and mask.
*
* Results:
* None.
*
* Side effects:
* Deletes a script record and cancels a channel event handler.
*
*----------------------------------------------------------------------
*/
static void
DeleteScriptRecord(interp, chanPtr, mask)
Tcl_Interp *interp; /* Interpreter in which script was to be
* executed. */
Channel *chanPtr; /* The channel for which to delete the
* script record (if any). */
int mask; /* Events in mask must exactly match mask
* of script to delete. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr;
for (esPtr = statePtr->scriptRecordPtr,
prevEsPtr = (EventScriptRecord *) NULL;
esPtr != (EventScriptRecord *) NULL;
prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
if (esPtr == statePtr->scriptRecordPtr) {
statePtr->scriptRecordPtr = esPtr->nextPtr;
} else {
prevEsPtr->nextPtr = esPtr->nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
break;
}
}
}
/*
*----------------------------------------------------------------------
*
* CreateScriptRecord --
*
* Creates a record to store a script to be executed when a specific
* event fires on a specific channel.
*
* Results:
* None.
*
* Side effects:
* Causes the script to be stored for later execution.
*
*----------------------------------------------------------------------
*/
static void
CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
Tcl_Interp *interp; /* Interpreter in which to execute
* the stored script. */
Channel *chanPtr; /* Channel for which script is to
* be stored. */
int mask; /* Set of events for which script
* will be invoked. */
Tcl_Obj *scriptPtr; /* Pointer to script object. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr;
for (esPtr = statePtr->scriptRecordPtr;
esPtr != (EventScriptRecord *) NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
Tcl_DecrRefCount(esPtr->scriptPtr);
esPtr->scriptPtr = (Tcl_Obj *) NULL;
break;
}
}
if (esPtr == (EventScriptRecord *) NULL) {
esPtr = (EventScriptRecord *) ckalloc((unsigned)
sizeof(EventScriptRecord));
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
TclChannelEventScriptInvoker, (ClientData) esPtr);
esPtr->nextPtr = statePtr->scriptRecordPtr;
statePtr->scriptRecordPtr = esPtr;
}
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
Tcl_IncrRefCount(scriptPtr);
esPtr->scriptPtr = scriptPtr;
}
/*
*----------------------------------------------------------------------
*
* TclChannelEventScriptInvoker --
*
* Invokes a script scheduled by "fileevent" for when the channel
* becomes ready for IO. This function is invoked by the channel
* handler which was created by the Tcl "fileevent" command.
*
* Results:
* None.
*
* Side effects:
* Whatever the script does.
*
*----------------------------------------------------------------------
*/
void
TclChannelEventScriptInvoker(clientData, mask)
ClientData clientData; /* The script+interp record. */
int mask; /* Not used. */
{
Tcl_Interp *interp; /* Interpreter in which to eval the script. */
Channel *chanPtr; /* The channel for which this handler is
* registered. */
EventScriptRecord *esPtr; /* The event script + interpreter to eval it
* in. */
int result; /* Result of call to eval script. */
esPtr = (EventScriptRecord *) clientData;
chanPtr = esPtr->chanPtr;
mask = esPtr->mask;
interp = esPtr->interp;
/*
* We must preserve the interpreter so we can report errors on it
* later. Note that we do not need to preserve the channel because
* that is done by Tcl_NotifyChannel before calling channel handlers.
*/
Tcl_Preserve((ClientData) interp);
result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
* On error, cause a background error and remove the channel handler
* and the script record.
*
* NOTE: Must delete channel handler before causing the background error
* because the background error may want to reinstall the handler.
*/
if (result != TCL_OK) {
if (chanPtr->typePtr != NULL) {
DeleteScriptRecord(interp, chanPtr, mask);
}
Tcl_BackgroundError(interp);
}
Tcl_Release((ClientData) interp);
}
/*
*----------------------------------------------------------------------
*
* Tcl_FileEventObjCmd --
*
* This procedure implements the "fileevent" Tcl command. See the
* user documentation for details on what it does. This command is
* based on the Tk command "fileevent" which in turn is based on work
* contributed by Mark Diekhans.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May create a channel handler for the specified channel.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_FileEventObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter in which the channel
* for which to create the handler
* is found. */
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
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;
int modeIndex; /* Index of mode argument. */
int mask;
static CONST char *modeOptions[] = {"readable", "writable", NULL};
static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
&modeIndex) != TCL_OK) {
return TCL_ERROR;
}
mask = maskArray[modeIndex];
chanName = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
if ((statePtr->flags & mask) == 0) {
Tcl_AppendResult(interp, "channel is not ",
(mask == TCL_READABLE) ? "readable" : "writable",
(char *) NULL);
return TCL_ERROR;
}
/*
* If we are supposed to return the script, do so.
*/
if (objc == 3) {
EventScriptRecord *esPtr;
for (esPtr = statePtr->scriptRecordPtr;
esPtr != (EventScriptRecord *) NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
Tcl_SetObjResult(interp, esPtr->scriptPtr);
break;
}
}
return TCL_OK;
}
/*
* If we are supposed to delete a stored script, do so.
*/
if (*(Tcl_GetString(objv[3])) == '') {
DeleteScriptRecord(interp, chanPtr, mask);
return TCL_OK;
}
/*
* Make the script record that will link between the event and the
* script to invoke. This also creates a channel event handler which
* will evaluate the script in the supplied interpreter.
*/
CreateScriptRecord(interp, chanPtr, mask, objv[3]);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclCopyChannel --
*
* This routine copies data from one channel to another, either
* synchronously or asynchronously. If a command script is
* supplied, the operation runs in the background. The script
* is invoked when the copy completes. Otherwise the function
* waits until the copy is completed before returning.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May schedule a background copy operation that causes both
* channels to be marked busy.
*
*----------------------------------------------------------------------
*/
int
TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
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. */
{
Channel *inPtr = (Channel *) inChan;
Channel *outPtr = (Channel *) outChan;
ChannelState *inStatePtr, *outStatePtr;
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
inStatePtr = inPtr->state;
outStatePtr = outPtr->state;
if (inStatePtr->csPtr) {
if (interp) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel "",
Tcl_GetChannelName(inChan), "" is busy", NULL);
}
return TCL_ERROR;
}
if (outStatePtr->csPtr) {
if (interp) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel "",
Tcl_GetChannelName(outChan), "" is busy", NULL);
}
return TCL_ERROR;
}
readFlags = inStatePtr->flags;
writeFlags = outStatePtr->flags;
/*
* Set up the blocking mode appropriately. Background copies need
* non-blocking channels. Foreground copies need blocking channels.
* If there is an error, restore the old blocking mode.
*/
if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
if (SetBlockMode(interp, inPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
!= TCL_OK) {
return TCL_ERROR;
}
}
if (inPtr != outPtr) {
if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
if (SetBlockMode(NULL, outPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
!= TCL_OK) {
if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, inPtr,
(readFlags & CHANNEL_NONBLOCKING)
? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
return TCL_ERROR;
}
}
}
}
/*
* Make sure the output side is unbuffered.
*/
outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
| CHANNEL_UNBUFFERED;
/*
* Allocate a new CopyState to maintain info about the current copy in
* progress. This structure will be deallocated when the copy is
* completed.
*/
csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
csPtr->bufSize = inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
csPtr->toRead = toRead;
csPtr->total = 0;
csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
}
csPtr->cmdPtr = cmdPtr;
inStatePtr->csPtr = csPtr;
outStatePtr->csPtr = csPtr;
/*
* Start copying data between the channels.
*/
return CopyData(csPtr, 0);
}
/*
*----------------------------------------------------------------------
*
* CopyData --
*
* This function implements the lowest level of the copying
* mechanism for TclCopyChannel.
*
* Results:
* Returns TCL_OK on success, else TCL_ERROR.
*
* Side effects:
* Moves data between channels, may create channel handlers.
*
*----------------------------------------------------------------------
*/
static int
CopyData(csPtr, mask)
CopyState *csPtr; /* State of copy operation. */
int mask; /* Current channel event flags. */
{
Tcl_Interp *interp;
Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
Tcl_Channel inChan, outChan;
ChannelState *inStatePtr, *outStatePtr;
int result = TCL_OK, size, total, sizeb;
char* buffer;
int inBinary, outBinary, sameEncoding; /* Encoding control */
int underflow; /* input underflow */
inChan = (Tcl_Channel) csPtr->readPtr;
outChan = (Tcl_Channel) csPtr->writePtr;
inStatePtr = csPtr->readPtr->state;
outStatePtr = csPtr->writePtr->state;
interp = csPtr->interp;
cmdPtr = csPtr->cmdPtr;
/*
* Copy the data the slow way, using the translation mechanism.
*
* Note: We have make sure that we use the topmost channel in a stack
* for the copying. The caller uses Tcl_GetChannel to access it, and
* thus gets the bottom of the stack.
*/
inBinary = (inStatePtr->encoding == NULL);
outBinary = (outStatePtr->encoding == NULL);
sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);
if (!(inBinary || sameEncoding)) {
bufObj = Tcl_NewObj ();
Tcl_IncrRefCount (bufObj);
}
while (csPtr->toRead != 0) {
/*
* Check for unreported background errors.
*/
if (inStatePtr->unreportedError != 0) {
Tcl_SetErrno(inStatePtr->unreportedError);
inStatePtr->unreportedError = 0;
goto readError;
}
if (outStatePtr->unreportedError != 0) {
Tcl_SetErrno(outStatePtr->unreportedError);
outStatePtr->unreportedError = 0;
goto writeError;
}
/*
* Read up to bufSize bytes.
*/
if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
sizeb = csPtr->bufSize;
} else {
sizeb = csPtr->toRead;
}
if (inBinary || sameEncoding) {
size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
}
underflow = (size >= 0) && (size < sizeb); /* input underflow */
if (size < 0) {
readError:
errObj = Tcl_NewObj();
Tcl_AppendStringsToObj(errObj, "error reading "",
Tcl_GetChannelName(inChan), "": ",
Tcl_PosixError(interp), (char *) NULL);
break;
} else if (underflow) {
/*
* We had an underflow on the read side. If we are at EOF,
* then the copying is done, otherwise set up a channel
* handler to detect when the channel becomes readable again.
*/
if ((size == 0) && Tcl_Eof(inChan)) {
break;
}
if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
if (mask & TCL_WRITABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc,
(ClientData) csPtr);
}
Tcl_CreateChannelHandler(inChan, TCL_READABLE,
CopyEventProc, (ClientData) csPtr);
}
if (size == 0) {
if (bufObj != (Tcl_Obj*) NULL) {
Tcl_DecrRefCount (bufObj);
bufObj = (Tcl_Obj*) NULL;
}
return TCL_OK;
}
}
/*
* Now write the buffer out.
*/
if (inBinary || sameEncoding) {
buffer = csPtr->buffer;
sizeb = size;
} else {
buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
}
if (outBinary || sameEncoding) {
sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
} else {
sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
}
if (inBinary || sameEncoding) {
/* Both read and write counted bytes */
size = sizeb;
} /* else : Read counted characters, write counted bytes, i.e. size != sizeb */
if (sizeb < 0) {
writeError:
errObj = Tcl_NewObj();
Tcl_AppendStringsToObj(errObj, "error writing "",
Tcl_GetChannelName(outChan), "": ",
Tcl_PosixError(interp), (char *) NULL);
break;
}
/*
* 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.
*/
if (csPtr->toRead != -1) {
csPtr->toRead -= size;
}
csPtr->total += size;
/*
* Break loop if EOF && (size>0)
*/
if (Tcl_Eof(inChan)) {
break;
}
/*
* Check to see if the write is happening in the background. If so,
* stop copying and wait for the channel to become writable again.
* After input underflow we already installed a readable handler
* therefore we don't need a writable handler.
*/
if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
Tcl_DeleteChannelHandler(inChan, CopyEventProc,
(ClientData) csPtr);
}
Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
CopyEventProc, (ClientData) csPtr);
}
if (bufObj != (Tcl_Obj*) NULL) {
Tcl_DecrRefCount (bufObj);
bufObj = (Tcl_Obj*) NULL;
}
return TCL_OK;
}
/*
* For background copies, we only do one buffer per invocation so
* we don't starve the rest of the system.
*/
if (cmdPtr) {
/*
* The first time we enter this code, there won't be a
* channel handler established yet, so do it here.
*/
if (mask == 0) {
Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
CopyEventProc, (ClientData) csPtr);
}
if (bufObj != (Tcl_Obj*) NULL) {
Tcl_DecrRefCount (bufObj);
bufObj = (Tcl_Obj*) NULL;
}
return TCL_OK;
}
} /* while */
if (bufObj != (Tcl_Obj*) NULL) {
Tcl_DecrRefCount (bufObj);
bufObj = (Tcl_Obj*) NULL;
}
/*
* Make the callback or return the number of bytes transferred.
* The local total is used because StopCopy frees csPtr.
*/
total = csPtr->total;
if (cmdPtr && interp) {
/*
* Get a private copy of the command so we can mutate it
* by adding arguments. Note that StopCopy frees our saved
* reference to the original command obj.
*/
cmdPtr = Tcl_DuplicateObj(cmdPtr);
Tcl_IncrRefCount(cmdPtr);
StopCopy(csPtr);
Tcl_Preserve((ClientData) interp);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
if (errObj) {
Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
}
if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
Tcl_BackgroundError(interp);
result = TCL_ERROR;
}
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) interp);
} else {
StopCopy(csPtr);
if (interp) {
if (errObj) {
Tcl_SetObjResult(interp, errObj);
result = TCL_ERROR;
} else {
Tcl_ResetResult(interp);
Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
}
}
}
return result;
}
/*
*----------------------------------------------------------------------
*
* DoRead --
*
* Reads a given number of bytes from a channel.
*
* No encoding conversions are applied to the bytes being read.
*
* Results:
* The number of characters read, or -1 on error. Use Tcl_GetErrno()
* to retrieve the error code for the error that occurred.
*
* Side effects:
* May cause input to be buffered.
*
*----------------------------------------------------------------------
*/
static int
DoRead(chanPtr, bufPtr, toRead)
Channel *chanPtr; /* The channel from which to read. */
char *bufPtr; /* Where to store input read. */
int toRead; /* Maximum number of bytes to read. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
int copied; /* How many characters were copied into
* the result string? */
int copiedNow; /* How many characters were copied from
* the current input buffer? */
int result; /* Of calling GetInput. */
/*
* If we have not encountered a sticky EOF, clear the EOF bit. Either
* way clear the BLOCKED bit. We want to discover these anew during
* each operation.
*/
if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
statePtr->flags &= ~CHANNEL_EOF;
}
statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
for (copied = 0; copied < toRead; copied += copiedNow) {
copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
toRead - copied);
if (copiedNow == 0) {
if (statePtr->flags & CHANNEL_EOF) {
goto done;
}
if (statePtr->flags & CHANNEL_BLOCKED) {
if (statePtr->flags & CHANNEL_NONBLOCKING) {
goto done;
}
statePtr->flags &= (~(CHANNEL_BLOCKED));
}
result = GetInput(chanPtr);
if (result != 0) {
if (result != EAGAIN) {
copied = -1;
}
goto done;
}
}
}
statePtr->flags &= (~(CHANNEL_BLOCKED));
done:
/*
* Update the notifier state so we don't block while there is still
* data in the buffers.
*/
UpdateInterest(chanPtr);
return copied;
}
/*
*----------------------------------------------------------------------
*
* CopyAndTranslateBuffer --
*
* Copy at most one buffer of input to the result space, doing
* eol translations according to mode in effect currently.
*
* Results:
* Number of bytes stored in the result buffer (as opposed to the
* number of bytes read from the channel). May return
* zero if no input is available to be translated.
*
* Side effects:
* Consumes buffered input. May deallocate one buffer.
*
*----------------------------------------------------------------------
*/
static int
CopyAndTranslateBuffer(statePtr, result, space)
ChannelState *statePtr; /* Channel state from which to read input. */
char *result; /* Where to store the copied input. */
int space; /* How many bytes are available in result
* to store the copied input? */
{
ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
int bytesInBuffer; /* How many bytes are available to be
* copied in the current input buffer? */
int copied; /* How many characters were already copied
* into the destination space? */
int i; /* Iterates over the copied input looking
* for the input eofChar. */
/*
* If there is no input at all, return zero. The invariant is that either
* there is no buffer in the queue, or if the first buffer is empty, it
* is also the last buffer (and thus there is no input in the queue).
* Note also that if the buffer is empty, we leave it in the queue.
*/
if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
return 0;
}
bufPtr = statePtr->inQueueHead;
bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
copied = 0;
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF: {
if (bytesInBuffer == 0) {
return 0;
}
/*
* Copy the current chunk into the result buffer.
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
memcpy((VOID *) result,
(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
(size_t) space);
bufPtr->nextRemoved += space;
copied = space;
break;
}
case TCL_TRANSLATE_CR: {
char *end;
if (bytesInBuffer == 0) {
return 0;
}
/*
* Copy the current chunk into the result buffer, then
* replace all r with n.
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
memcpy((VOID *) result,
(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
(size_t) space);
bufPtr->nextRemoved += space;
copied = space;
for (end = result + copied; result < end; result++) {
if (*result == 'r') {
*result = 'n';
}
}
break;
}
case TCL_TRANSLATE_CRLF: {
char *src, *end, *dst;
int curByte;
/*
* If there is a held-back "r" at EOF, produce it now.
*/
if (bytesInBuffer == 0) {
if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
(INPUT_SAW_CR | CHANNEL_EOF)) {
result[0] = 'r';
statePtr->flags &= ~INPUT_SAW_CR;
return 1;
}
return 0;
}
/*
* Copy the current chunk and replace "rn" with "n"
* (but not standalone "r"!).
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
memcpy((VOID *) result,
(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
(size_t) space);
bufPtr->nextRemoved += space;
copied = space;
end = result + copied;
dst = result;
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == 'n') {
statePtr->flags &= ~INPUT_SAW_CR;
} else if (statePtr->flags & INPUT_SAW_CR) {
statePtr->flags &= ~INPUT_SAW_CR;
*dst = 'r';
dst++;
}
if (curByte == 'r') {
statePtr->flags |= INPUT_SAW_CR;
} else {
*dst = (char) curByte;
dst++;
}
}
copied = dst - result;
break;
}
case TCL_TRANSLATE_AUTO: {
char *src, *end, *dst;
int curByte;
if (bytesInBuffer == 0) {
return 0;
}
/*
* Loop over the current buffer, converting "r" and "rn"
* to "n".
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
memcpy((VOID *) result,
(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
(size_t) space);
bufPtr->nextRemoved += space;
copied = space;
end = result + copied;
dst = result;
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == 'r') {
statePtr->flags |= INPUT_SAW_CR;
*dst = 'n';
dst++;
} else {
if ((curByte != 'n') ||
!(statePtr->flags & INPUT_SAW_CR)) {
*dst = (char) curByte;
dst++;
}
statePtr->flags &= ~INPUT_SAW_CR;
}
}
copied = dst - result;
break;
}
default: {
panic("unknown eol translation mode");
}
}
/*
* If an in-stream EOF character is set for this channel, check that
* the input we copied so far does not contain the EOF char. If it does,
* copy only up to and excluding that character.
*/
if (statePtr->inEofChar != 0) {
for (i = 0; i < copied; i++) {
if (result[i] == (char) statePtr->inEofChar) {
/*
* Set sticky EOF so that no further input is presented
* to the caller.
*/
statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
copied = i;
break;
}
}
}
/*
* If the current buffer is empty recycle it.
*/
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
statePtr->inQueueHead = bufPtr->nextPtr;
if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
statePtr->inQueueTail = (ChannelBuffer *) NULL;
}
RecycleBuffer(statePtr, bufPtr, 0);
}
/*
* Return the number of characters copied into the result buffer.
* This may be different from the number of bytes consumed, because
* of EOL translations.
*/
return copied;
}
/*
*----------------------------------------------------------------------
*
* CopyBuffer --
*
* Copy at most one buffer of input to the result space.
*
* Results:
* Number of bytes stored in the result buffer. May return
* zero if no input is available.
*
* Side effects:
* Consumes buffered input. May deallocate one buffer.
*
*----------------------------------------------------------------------
*/
static int
CopyBuffer(chanPtr, result, space)
Channel *chanPtr; /* Channel from which to read input. */
char *result; /* Where to store the copied input. */
int space; /* How many bytes are available in result
* to store the copied input? */
{
ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
int bytesInBuffer; /* How many bytes are available to be
* copied in the current input buffer? */
int copied; /* How many characters were already copied
* into the destination space? */
/*
* If there is no input at all, return zero. The invariant is that
* either there is no buffer in the queue, or if the first buffer
* is empty, it is also the last buffer (and thus there is no
* input in the queue). Note also that if the buffer is empty, we
* don't leave it in the queue, but recycle it.
*/
if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
return 0;
}
bufPtr = chanPtr->inQueueHead;
bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
copied = 0;
if (bytesInBuffer == 0) {
RecycleBuffer(chanPtr->state, bufPtr, 0);
chanPtr->inQueueHead = (ChannelBuffer*) NULL;
chanPtr->inQueueTail = (ChannelBuffer*) NULL;
return 0;
}
/*
* Copy the current chunk into the result buffer.
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
memcpy((VOID *) result,
(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
(size_t) space);
bufPtr->nextRemoved += space;
copied = space;
/*
* We don't care about in-stream EOF characters here as the data
* read here may still flow through one or more transformations,
* i.e. is not in its final state yet.
*/
/*
* If the current buffer is empty recycle it.
*/
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
chanPtr->inQueueHead = bufPtr->nextPtr;
if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
chanPtr->inQueueTail = (ChannelBuffer *) NULL;
}
RecycleBuffer(chanPtr->state, bufPtr, 0);
}
/*
* Return the number of characters copied into the result buffer.
*/
return copied;
}
/*
*----------------------------------------------------------------------
*
* DoWrite --
*
* Puts a sequence of characters into an output buffer, may queue the
* buffer for output if it gets full, and also remembers whether the
* current buffer is ready e.g. if it contains a newline and we are in
* line buffering mode.
*
* Results:
* The number of bytes written or -1 in case of error. If -1,
* Tcl_GetErrno will return the error code.
*
* Side effects:
* May buffer up output and may cause output to be produced on the
* channel.
*
*----------------------------------------------------------------------
*/
static int
DoWrite(chanPtr, src, srcLen)
Channel *chanPtr; /* The channel to buffer output for. */
CONST char *src; /* Data to write. */
int srcLen; /* Number of bytes to write. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *outBufPtr; /* Current output buffer. */
int foundNewline; /* Did we find a newline in output? */
char *dPtr;
CONST char *sPtr; /* Search variables for newline. */
int crsent; /* In CRLF eol translation mode,
* remember the fact that a CR was
* output to the channel without
* its following NL. */
int i; /* Loop index for newline search. */
int destCopied; /* How many bytes were used in this
* destination buffer to hold the
* output? */
int totalDestCopied; /* How many bytes total were
* copied to the channel buffer? */
int srcCopied; /* How many bytes were copied from
* the source string? */
char *destPtr; /* Where in line to copy to? */
/*
* If we are in network (or windows) translation mode, record the fact
* that we have not yet sent a CR to the channel.
*/
crsent = 0;
/*
* Loop filling buffers and flushing them until all output has been
* consumed.
*/
srcCopied = 0;
totalDestCopied = 0;
while (srcLen > 0) {
/*
* Make sure there is a current output buffer to accept output.
*/
if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
}
outBufPtr = statePtr->curOutPtr;
destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
if (destCopied > srcLen) {
destCopied = srcLen;
}
destPtr = outBufPtr->buf + outBufPtr->nextAdded;
switch (statePtr->outputTranslation) {
case TCL_TRANSLATE_LF:
srcCopied = destCopied;
memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
break;
case TCL_TRANSLATE_CR:
srcCopied = destCopied;
memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
if (*dPtr == 'n') {
*dPtr = 'r';
}
}
break;
case TCL_TRANSLATE_CRLF:
for (srcCopied = 0, dPtr = destPtr, sPtr = src;
dPtr < destPtr + destCopied;
dPtr++, sPtr++, srcCopied++) {
if (*sPtr == 'n') {
if (crsent) {
*dPtr = 'n';
crsent = 0;
} else {
*dPtr = 'r';
crsent = 1;
sPtr--, srcCopied--;
}
} else {
*dPtr = *sPtr;
}
}
break;
case TCL_TRANSLATE_AUTO:
panic("Tcl_Write: AUTO output translation mode not supported");
default:
panic("Tcl_Write: unknown output translation mode");
}
/*
* The current buffer is ready for output if it is full, or if it
* contains a newline and this channel is line-buffered, or if it
* contains any output and this channel is unbuffered.
*/
outBufPtr->nextAdded += destCopied;
if (!(statePtr->flags & BUFFER_READY)) {
if (outBufPtr->nextAdded == outBufPtr->bufLength) {
statePtr->flags |= BUFFER_READY;
} else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
for (sPtr = src, i = 0, foundNewline = 0;
(i < srcCopied) && (!foundNewline);
i++, sPtr++) {
if (*sPtr == 'n') {
foundNewline = 1;
break;
}
}
if (foundNewline) {
statePtr->flags |= BUFFER_READY;
}
} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
statePtr->flags |= BUFFER_READY;
}
}
totalDestCopied += srcCopied;
src += srcCopied;
srcLen -= srcCopied;
if (statePtr->flags & BUFFER_READY) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
}
} /* Closes "while" */
return totalDestCopied;
}
/*
*----------------------------------------------------------------------
*
* CopyEventProc --
*
* This routine is invoked as a channel event handler for
* the background copy operation. It is just a trivial wrapper
* around the CopyData routine.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
CopyEventProc(clientData, mask)
ClientData clientData;
int mask;
{
(void) CopyData((CopyState *)clientData, mask);
}
/*
*----------------------------------------------------------------------
*
* StopCopy --
*
* This routine halts a copy that is in progress.
*
* Results:
* None.
*
* Side effects:
* Removes any pending channel handlers and restores the blocking
* and buffering modes of the channels. The CopyState is freed.
*
*----------------------------------------------------------------------
*/
static void
StopCopy(csPtr)
CopyState *csPtr; /* State for bg copy to stop . */
{
ChannelState *inStatePtr, *outStatePtr;
int nonBlocking;
if (!csPtr) {
return;
}
inStatePtr = csPtr->readPtr->state;
outStatePtr = csPtr->writePtr->state;
/*
* Restore the old blocking mode and output buffering mode.
*/
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);
if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
}
outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
outStatePtr->flags |=
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
if (csPtr->cmdPtr) {
Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
(ClientData)csPtr);
if (csPtr->readPtr != csPtr->writePtr) {
Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
CopyEventProc, (ClientData)csPtr);
}
Tcl_DecrRefCount(csPtr->cmdPtr);
}
inStatePtr->csPtr = NULL;
outStatePtr->csPtr = NULL;
ckfree((char*) csPtr);
}
/*
*----------------------------------------------------------------------
*
* StackSetBlockMode --
*
* This function sets the blocking mode for a channel, iterating
* through each channel in a stack and updates the state flags.
*
* Results:
* 0 if OK, result code from failed blockModeProc otherwise.
*
* Side effects:
* Modifies the blocking mode of the channel and possibly generates
* an error.
*
*----------------------------------------------------------------------
*/
static int
StackSetBlockMode(chanPtr, mode)
Channel *chanPtr; /* Channel to modify. */
int mode; /* One of TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
/*
* Start at the top of the channel stack
*/
chanPtr = chanPtr->state->topChanPtr;
while (chanPtr != (Channel *) NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
result = (*blockModeProc) (chanPtr->instanceData, mode);
if (result != 0) {
Tcl_SetErrno(result);
return result;
}
}
chanPtr = chanPtr->downChanPtr;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* SetBlockMode --
*
* This function sets the blocking mode for a channel and updates
* the state flags.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Modifies the blocking mode of the channel and possibly generates
* an error.
*
*----------------------------------------------------------------------
*/
static int
SetBlockMode(interp, chanPtr, mode)
Tcl_Interp *interp; /* Interp for error reporting. */
Channel *chanPtr; /* Channel to modify. */
int mode; /* One of TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
ChannelState *statePtr = chanPtr->state; /* state info for channel */
int result = 0;
result = StackSetBlockMode(chanPtr, mode);
if (result != 0) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "error setting blocking mode: ",
Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
if (mode == TCL_MODE_BLOCKING) {
statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
} else {
statePtr->flags |= CHANNEL_NONBLOCKING;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetChannelNames --
*
* Return the names of all open channels in the interp.
*
* Results:
* TCL_OK or TCL_ERROR.
*
* Side effects:
* Interp result modified with list of channel names.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetChannelNames(interp)
Tcl_Interp *interp; /* Interp for error reporting. */
{
return Tcl_GetChannelNamesEx(interp, (char *) NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetChannelNamesEx --
*
* Return the names of open channels in the interp filtered
* filtered through a pattern. If pattern is NULL, it returns
* all the open channels.
*
* Results:
* TCL_OK or TCL_ERROR.
*
* Side effects:
* Interp result modified with list of channel names.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetChannelNamesEx(interp, pattern)
Tcl_Interp *interp; /* Interp for error reporting. */
CONST char *pattern; /* pattern to filter on. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelState *statePtr;
CONST char *name; /* name for channel */
Tcl_Obj *resultPtr; /* pointer to result object */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_HashSearch hSearch; /* Search variable. */
if (interp == (Tcl_Interp *) NULL) {
return TCL_OK;
}
/*
* Get the channel table that stores the channels registered
* for this interpreter.
*/
hTblPtr = GetChannelTable(interp);
resultPtr = Tcl_GetObjResult(interp);
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) 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) {
name = "stdout";
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
name = "stderr";
} else {
/*
* This is also stored in Tcl_GetHashKey(hTblPtr, hPtr),
* but it's simpler to just grab the name from the statePtr.
*/
name = statePtr->channelName;
}
if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
(Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(name, -1)) != TCL_OK)) {
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_IsChannelRegistered --
*
* Checks whether the channel is associated with the interp.
* See also Tcl_RegisterChannel and Tcl_UnregisterChannel.
*
* Results:
* 0 if the channel is not registered in the interpreter, 1 else.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_IsChannelRegistered (interp, chan)
Tcl_Interp* interp; /* The interp to query of the channel */
Tcl_Channel chan; /* The channel to check */
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of the real channel. */
/*
* Always check bottom-most channel in the stack. This is the one
* that gets registered.
*/
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == (Tcl_HashTable *) NULL) {
return 0;
}
hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
if (hPtr == (Tcl_HashEntry *) NULL) {
return 0;
}
if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
return 0;
}
return 1;
}
/*
*----------------------------------------------------------------------
*
* Tcl_IsChannelShared --
*
* Checks whether the channel is shared by multiple interpreters.
*
* Results:
* A boolean value (0 = Not shared, 1 = Shared).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_IsChannelShared (chan)
Tcl_Channel chan; /* The channel to query */
{
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
return ((statePtr->refCount > 1) ? 1 : 0);
}
/*
*----------------------------------------------------------------------
*
* Tcl_IsChannelExisting --
*
* Checks whether a channel of the given name exists in the
* (thread)-global list of all channels.
* See Tcl_GetChannelNamesEx for function exposed at the Tcl level.
*
* Results:
* A boolean value (0 = Does not exist, 1 = Does exist).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_IsChannelExisting(chanName)
CONST char* chanName; /* The name of the channel to look for. */
{
ChannelState *statePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
CONST char *name;
int chanNameLen;
chanNameLen = strlen(chanName);
for (statePtr = tsdPtr->firstCSPtr;
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
name = "stdin";
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
name = "stdout";
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
name = "stderr";
} else {
name = statePtr->channelName;
}
if ((*chanName == *name) &&
(memcmp(name, chanName, (size_t) chanNameLen) == 0)) {
return 1;
}
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelName --
*
* Return the name of the channel type.
*
* Results:
* A pointer the name of the channel type.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
CONST char *
Tcl_ChannelName(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->typeName;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelVersion --
*
* Return the of version of the channel type.
*
* Results:
* One of the TCL_CHANNEL_VERSION_* constants from tcl.h
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_ChannelTypeVersion
Tcl_ChannelVersion(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
return TCL_CHANNEL_VERSION_2;
} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
return TCL_CHANNEL_VERSION_3;
} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
return TCL_CHANNEL_VERSION_4;
} else {
/*
* In <v2 channel versions, the version field is occupied
* by the Tcl_DriverBlockModeProc
*/
return TCL_CHANNEL_VERSION_1;
}
}
/*
*----------------------------------------------------------------------
*
* HaveVersion --
*
* Return whether a channel type is (at least) of a given version.
*
* Results:
* True if the minimum version is exceeded by the version actually
* present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
HaveVersion(chanTypePtr, minimumVersion)
Tcl_ChannelType *chanTypePtr;
Tcl_ChannelTypeVersion minimumVersion;
{
Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
return ((int)actualVersion) >= ((int)minimumVersion);
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelBlockModeProc --
*
* Return the Tcl_DriverBlockModeProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------- */
Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
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);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelCloseProc --
*
* Return the Tcl_DriverCloseProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverCloseProc *
Tcl_ChannelCloseProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->closeProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelClose2Proc --
*
* Return the Tcl_DriverClose2Proc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverClose2Proc *
Tcl_ChannelClose2Proc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->close2Proc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelInputProc --
*
* Return the Tcl_DriverInputProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverInputProc *
Tcl_ChannelInputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->inputProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelOutputProc --
*
* Return the Tcl_DriverOutputProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverOutputProc *
Tcl_ChannelOutputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->outputProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelSeekProc --
*
* Return the Tcl_DriverSeekProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverSeekProc *
Tcl_ChannelSeekProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->seekProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelSetOptionProc --
*
* Return the Tcl_DriverSetOptionProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverSetOptionProc *
Tcl_ChannelSetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->setOptionProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelGetOptionProc --
*
* Return the Tcl_DriverGetOptionProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverGetOptionProc *
Tcl_ChannelGetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->getOptionProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelWatchProc --
*
* Return the Tcl_DriverWatchProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverWatchProc *
Tcl_ChannelWatchProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->watchProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelGetHandleProc --
*
* Return the Tcl_DriverGetHandleProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverGetHandleProc *
Tcl_ChannelGetHandleProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
return chanTypePtr->getHandleProc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelFlushProc --
*
* Return the Tcl_DriverFlushProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverFlushProc *
Tcl_ChannelFlushProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->flushProc;
} else {
return NULL;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelHandlerProc --
*
* Return the Tcl_DriverHandlerProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverHandlerProc *
Tcl_ChannelHandlerProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->handlerProc;
} else {
return NULL;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelWideSeekProc --
*
* Return the Tcl_DriverWideSeekProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverWideSeekProc *
Tcl_ChannelWideSeekProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
return chanTypePtr->wideSeekProc;
} else {
return NULL;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ChannelThreadActionProc --
*
* Return the Tcl_DriverThreadActionProc of the channel type.
*
* Results:
* A pointer to the proc.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_DriverThreadActionProc *
Tcl_ChannelThreadActionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
return chanTypePtr->threadActionProc;
} else {
return NULL;
}
}
#if 0
/* For future debugging work, a simple function to print the flags of
* a channel in semi-readable form.
*/
static int
DumpFlags (str, flags)
char* str;
int flags;
{
char buf [20];
int i = 0;
if (flags & TCL_READABLE) {buf[i] = 'r';} else {buf [i]='_';}; i++;
if (flags & TCL_WRITABLE) {buf[i] = 'w';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_NONBLOCKING) {buf[i] = 'n';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_LINEBUFFERED) {buf[i] = 'l';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_UNBUFFERED) {buf[i] = 'u';} else {buf [i]='_';}; i++;
if (flags & BUFFER_READY) {buf[i] = 'R';} else {buf [i]='_';}; i++;
if (flags & BG_FLUSH_SCHEDULED) {buf[i] = 'F';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_CLOSED) {buf[i] = 'c';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_EOF) {buf[i] = 'E';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_STICKY_EOF) {buf[i] = 'S';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_BLOCKED) {buf[i] = 'B';} else {buf [i]='_';}; i++;
if (flags & INPUT_SAW_CR) {buf[i] = '/';} else {buf [i]='_';}; i++;
if (flags & INPUT_NEED_NL) {buf[i] = '*';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_DEAD) {buf[i] = 'D';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_RAW_MODE) {buf[i] = 'R';} else {buf [i]='_';}; i++;
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
if (flags & CHANNEL_TIMER_FEV) {buf[i] = 'T';} else {buf [i]='_';}; i++;
if (flags & CHANNEL_HAS_MORE_DATA) {buf[i] = 'H';} else {buf [i]='_';}; i++;
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
if (flags & CHANNEL_INCLOSE) {buf[i] = 'x';} else {buf [i]='_';}; i++;
buf [i] ='';
fprintf (stderr,"%s: %sn", str, buf); fflush(stderr);
return 0;
}
#endif