Tcl Source Code

 *
 * Note: when building static but linking dynamically to MSVCRT we must still
 *       correctly decorate the C library imported function.  Use CRTIMPORT
 *       for this purpose.  _DLL is defined by the compiler when linking to
 *       MSVCRT.
 */

#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#   define HAVE_DECLSPEC 1
#   ifdef STATIC_BUILD
#       define DLLIMPORT
#       define DLLEXPORT
#       ifdef _DLL
#           define CRTIMPORT __declspec(dllimport)
#       else

static void
PrintSourceToObj(
    Tcl_Obj *appendObj,		/* The object to print the source to. */
    const char *stringPtr,	/* The string to print. */
    int maxChars)		/* Maximum number of chars to print. */
{
    register const char *p;
    register int i = 0;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", -1);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", -1);
    p = stringPtr;
    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {



	switch (*p) {
	case '"':
	    Tcl_AppendToObj(appendObj, "\\\"", -1);

	    continue;
	case '\f':
	    Tcl_AppendToObj(appendObj, "\\f", -1);

	    continue;
	case '\n':
	    Tcl_AppendToObj(appendObj, "\\n", -1);

	    continue;
	case '\r':
	    Tcl_AppendToObj(appendObj, "\\r", -1);

	    continue;
	case '\t':
	    Tcl_AppendToObj(appendObj, "\\t", -1);

	    continue;
	case '\v':
	    Tcl_AppendToObj(appendObj, "\\v", -1);

	    continue;
	default:

	    Tcl_AppendPrintfToObj(appendObj, "%c", *p);





	    continue;
	}
    }
    Tcl_AppendToObj(appendObj, "\"", -1);



}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
 *
 * RecordByteCodeStats --

 * The following are used to hold the default and current system encodings.
 * If NULL is passed to one of the conversion routines, the current setting of
 * the system encoding will be used to perform the conversion.
 */

static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;


/*
 * The following variable is used in the sparse matrix code for a
 * TableEncoding to represent a page in the table that has no entries.
 */

static unsigned short emptyPage[256];

    type.encodingName	= "identity";
    type.toUtfProc	= BinaryProc;
    type.fromUtfProc	= BinaryProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    type.encodingName	= "utf-8";
    type.toUtfProc	= UtfExtToUtfIntProc;
    type.fromUtfProc	= UtfIntToUtfExtProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;

{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&encodingMutex);
    encodingsInitialized = 0;
    FreeEncoding(systemEncoding);


    hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    while (hPtr != NULL) {
	/*
	 * Call FreeEncoding instead of doing it directly to handle refcounts
	 * like escape encodings use. [Bug 524674] Make sure to call
	 * Tcl_FirstHashEntry repeatedly so that all encodings are eventually

	trim1 = TclTrimLeft(string1, length, string2, length2);
	if (trim1 < length) {
	    trim2 = TclTrimRight(string1, length, string2, length2);
	} else {
	    trim2 = 0;
	}
    createTrimmedString:












	if (trim1 == 0 && trim2 == 0) {
	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",


		    O2S(valuePtr), O2S(value2Ptr)), valuePtr);



	    NEXT_INST_F(1, 1, 0);
	} else {
	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",

		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);



	    NEXT_INST_F(1, 2, 1);
	}
    }

    case INST_REGEXP:
	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
	valuePtr = OBJ_AT_TOS;		/* String */

 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(int length);
static void		ChannelTimerProc(ClientData clientData);
static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckFlush(Channel *chanPtr, ChannelBuffer *bufPtr,
			    int newlineFlag);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
			    Channel *chanPtr);
static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode);

static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
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 *srcPtr, int slen, int allowShortReads);
static int		DoWrite(Channel *chanPtr, const char *src, int srcLen);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
			    int appendFlag);
static int		DoWriteChars(Channel *chan, const char *src, int len);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);

static void		FreeBinaryEncoding(ClientData clientData);
static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
static int		GetInput(Channel *chanPtr);
static int		HaveVersion(const Tcl_ChannelType *typePtr,
			    Tcl_ChannelTypeVersion minimumVersion);
static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
			    GetsState *gsPtr);
static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft, int *offsetPtr);
static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft, int *offsetPtr, int *factorPtr);
static void		RecycleBuffer(ChannelState *statePtr,
			    ChannelBuffer *bufPtr, int mustDiscard);
static int		StackSetBlockMode(Channel *chanPtr, int mode);
static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
			    int mode);
static void		StopCopy(CopyState *csPtr);
static int		TranslateInputEOL(ChannelState *statePtr, char *dst,
			    const char *src, int *dstLenPtr, int *srcLenPtr);
static int		TranslateOutputEOL(ChannelState *statePtr, char *dst,
			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static int		WriteBytes(Channel *chanPtr, const char *src,
			    int srcLen);
static int		WriteChars(Channel *chanPtr, const char *src,
			    int srcLen);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int              WillRead(Channel *chanPtr);






/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * int BytesLeft(ChannelBuffer *bufPtr)

 * requested (consistent with Tcl_GetChannel).  The setFromAny and
 * updateString can be NULL as they should not be called.
 */

static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static int		SetChannelFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfChannel(Tcl_Obj *objPtr);
static void		FreeChannelIntRep(Tcl_Obj *objPtr);

static const Tcl_ObjType tclChannelType = {
    "channel",			/* name for this type */
    FreeChannelIntRep,		/* freeIntRepProc */
    DupChannelIntRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc UpdateStringOfChannel */
    NULL			/* setFromAnyProc SetChannelFromAny */
};

#define GET_CHANNELSTATE(objPtr) \
    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_CHANNELSTATE(objPtr, storePtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
#define GET_CHANNELINTERP(objPtr) \
    ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))

#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }

    if (srcLen < 0) {
	srcLen = strlen(src);
    }
    return DoWrite(chanPtr, src, srcLen);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WriteRaw --
 *

Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    int len)			/* Length of string in bytes, or < 0 for
				 * strlen(). */
{

    ChannelState *statePtr;	/* State info for channel */

    statePtr = ((Channel *) chan)->state;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }

    return DoWriteChars((Channel *) chan, src, len);
}

/*
 *---------------------------------------------------------------------------
 *
 * DoWriteChars --
 *
 *	Takes a sequence of UTF-8 characters and converts them for output
 *	using the channel's current encoding, 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.
 *	Compensates stacking, i.e. will redirect the data from the specified
 *	channel to the topmost channel in a stack.
 *
 * 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
DoWriteChars(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    int len)			/* Length of string in bytes, or < 0 for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    ChannelState *statePtr;	/* State info for channel */

    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    if (len < 0) {
	len = strlen(src);
    }
    if (statePtr->encoding == NULL) {



	/*
	 * Inefficient way to convert UTF-8 to byte-array, but the code
	 * parallels the way it is done for objects.
	 * Special case for 1-byte (used by eg [puts] for the \n) could
	 * be extended to more efficient translation of the src string.
	 */

	int result;

	if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	    result = WriteBytes(chanPtr, src, len);

	} else {
	    Tcl_Obj *objPtr = Tcl_NewStringObj(src, len);

	    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
	    result = WriteBytes(chanPtr, src, len);
	    TclDecrRefCount(objPtr);
	}
	return result;
    }
    return WriteChars(chanPtr, src, len);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteObj --
 *

    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * WriteBytes --
 *
 *	Write a sequence of bytes 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
WriteBytes(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* Bytes to write. */
    int srcLen)			/* Number of bytes to write. */
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    char *dst;
    int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;

    if (srcLen) {
        WillWrite(chanPtr);
    }

    total = 0;
    sawLF = 0;
    savedLF = 0;
    translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF);

    /*
     * Loop over all bytes in src, storing them in output buffer with proper
     * EOL translation.
     */

    while (srcLen + savedLF > 0) {
	bufPtr = statePtr->curOutPtr;
	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	    statePtr->curOutPtr = bufPtr;
	}
	dst = InsertPoint(bufPtr);
	dstMax = SpaceLeft(bufPtr);
	dstLen = dstMax;

	toWrite = dstLen;
	if (toWrite > srcLen) {
	    toWrite = srcLen;
	}

	if (translate) {
	    if (savedLF) {
		/*
		 * A '\n' was left over from last call to TranslateOutputEOL()
		 * and we need to store it in this buffer. If the channel is
		 * line-based, we will need to flush it.
		 */

		*dst++ = '\n';
		dstLen--;
		sawLF++;
	    }
	    if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
		sawLF++;
	    }
	    dstLen += savedLF;
	    savedLF = 0;
	    if (dstLen > dstMax) {
		savedLF = 1;
		dstLen = dstMax;
	    }
	} else {
	    memcpy(dst, src, toWrite);
	    dstLen = toWrite;
	}

	bufPtr->nextAdded += dstLen;
	if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
	    return -1;
	}
	total += dstLen;
	src += toWrite;
	srcLen -= toWrite;
	sawLF = 0;
    }
    return total;
}

/*
 *----------------------------------------------------------------------
 *
 * WriteChars --
 *
 *	Convert UTF-8 bytes to the channel's external encoding and write the
 *	produced bytes 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
WriteChars(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 string to write. */
    int srcLen)			/* Length of UTF-8 string in bytes. */

{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    char *nextNewLine = NULL;
    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
    Tcl_Encoding encoding = statePtr->encoding;

    if (srcLen) {
        WillWrite(chanPtr);
    }

    /*
     * Write the terminated escape sequence even if srcLen is 0.

    return total;
}

/*
 *---------------------------------------------------------------------------
 *
 * TranslateOutputEOL --
 *
 *	Helper function for WriteBytes() and WriteChars(). Converts the '\n'
 *	characters in the source buffer into the appropriate EOL form
 *	specified by the output translation mode.
 *
 *	EOL translation stops either when the source buffer is empty or the
 *	output buffer is full.
 *
 *	When converting to CRLF mode and there is only 1 byte left in the
 *	output buffer, this routine stores the '\r' in the last byte and then
 *	stores the '\n' in the byte just past the end of the buffer. The
 *	caller is responsible for passing in a buffer that is large enough to
 *	hold the extra byte.
 *
 * Results:
 *	The return value is 1 if a '\n' was translated from the source buffer,
 *	or 0 otherwise -- this can be used by the caller to decide to flush a
 *	line-based channel even though the channel buffer is not full.
 *
 *	*dstLenPtr is filled with how many bytes of the output buffer were
 *	used. As mentioned above, this can be one more that the output
 *	buffer's specified length if a CRLF was stored.
 *
 *	*srcLenPtr is filled with how many bytes of the source buffer were
 *	consumed.
 *
 * Side effects:
 *	It may be obvious, but bears mentioning that when converting in CRLF
 *	mode (which requires two bytes of storage in the output buffer), the
 *	number of bytes consumed from the source buffer will be less than the
 *	number of bytes stored in the output buffer.
 *
 *---------------------------------------------------------------------------
 */

static int
TranslateOutputEOL(
    ChannelState *statePtr,	/* Channel being read, for translation and
				 * buffering modes. */
    char *dst,			/* Output buffer filled with UTF-8 chars by
				 * applying appropriate EOL translation to
				 * source characters. */
    const char *src,		/* Source UTF-8 characters. */
    int *dstLenPtr,		/* On entry, the maximum length of output
				 * buffer in bytes. On exit, the number of
				 * bytes actually used in output buffer. */
    int *srcLenPtr)		/* On entry, the length of source buffer. On
				 * exit, the number of bytes read from the
				 * source buffer. */
{
    char *dstEnd;
    int srcLen, newlineFound;

    newlineFound = 0;
    srcLen = *srcLenPtr;

    switch (statePtr->outputTranslation) {
    case TCL_TRANSLATE_LF:
	for (dstEnd = dst + srcLen; dst < dstEnd; ) {
	    if (*src == '\n') {
		newlineFound = 1;
	    }
	    *dst++ = *src++;
	}
	*dstLenPtr = srcLen;
	break;
    case TCL_TRANSLATE_CR:
	for (dstEnd = dst + srcLen; dst < dstEnd;) {
	    if (*src == '\n') {
		*dst++ = '\r';
		newlineFound = 1;
		src++;
	    } else {
		*dst++ = *src++;
	    }
	}
	*dstLenPtr = srcLen;
	break;
    case TCL_TRANSLATE_CRLF: {
	/*
	 * Since this causes the number of bytes to grow, we start off trying
	 * to put 'srcLen' bytes into the output buffer, but allow it to store
	 * more bytes, as long as there's still source bytes and room in the
	 * output buffer.
	 */

	char *dstStart, *dstMax;
	const char *srcStart;

	dstStart = dst;
	dstMax = dst + *dstLenPtr;

	srcStart = src;

	if (srcLen < *dstLenPtr) {
	    dstEnd = dst + srcLen;
	} else {
	    dstEnd = dst + *dstLenPtr;
	}
	while (dst < dstEnd) {
	    if (*src == '\n') {
		if (dstEnd < dstMax) {
		    dstEnd++;
		}
		*dst++ = '\r';
		newlineFound = 1;
	    }
	    *dst++ = *src++;
	}
	*srcLenPtr = src - srcStart;
	*dstLenPtr = dst - dstStart;
	break;
    }
    default:
	break;
    }
    return newlineFound;
}

/*
 *---------------------------------------------------------------------------
 *
 * CheckFlush --
 *
 *	Helper function for WriteBytes() and WriteChars(). If the channel
 *	buffer is ready to be flushed, flush it.
 *
 * Results:
 *	The return value is -1 if there was a problem flushing the channel
 *	buffer, or 0 otherwise.
 *
 * Side effects:
 *	The buffer will be recycled if it is flushed.
 *
 *---------------------------------------------------------------------------
 */

static int
CheckFlush(
    Channel *chanPtr,		/* Channel being read, for buffering mode. */
    ChannelBuffer *bufPtr,	/* Channel buffer to possibly flush. */
    int newlineFlag)		/* Non-zero if a the channel buffer contains a
				 * newline. */
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * The current buffer is ready for output:
     * 1. if it is full.
     * 2. if it contains a newline and this channel is line-buffered.
     * 3. if it contains any output and this channel is unbuffered.
     */

    if (!GotFlag(statePtr, BUFFER_READY)) {
	if (IsBufferFull(bufPtr)) {
	    SetFlag(statePtr, BUFFER_READY);
	} else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
	    if (newlineFlag != 0) {
		SetFlag(statePtr, BUFFER_READY);
	    }
	} else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
	    SetFlag(statePtr, BUFFER_READY);
	}
    }
    if (GotFlag(statePtr, BUFFER_READY)) {
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
    }
    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_Gets --
 *
 *	Reads a complete line of input from the channel into a Tcl_DString.
 *
 * Results:
 *	Length of line read (in characters) or -1 if error, EOF, or blocked.
 *	If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the

    /*
     * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
     * produce ByteArray objects.
     */

    if (encoding == NULL) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->binaryEncoding == NULL) {
	    tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
	    Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
	}
	encoding = tsdPtr->binaryEncoding;
	if (encoding == NULL) {
	    Tcl_Panic("attempted gets on binary channel where no iso8859-1 encoding available");
	}
    }

    /*
     * Object used by FilterInputBytes to keep track of how much data has been
     * consumed from the channel buffers.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}
















/*
 *---------------------------------------------------------------------------
 *
 * FilterInputBytes --
 *
 *	Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw

	    buffer = csPtr->buffer;
	    sizeb = size;
	} else {
	    buffer = TclGetStringFromObj(bufObj, &sizeb);
	}

	if (outBinary || sameEncoding) {
	    sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}

	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * bytes or characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
	 * must not overwrite it with 'sizeb', which is the number of written

    /*
     * 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(
    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 == NULL) {
	    statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
	}

	outBufPtr = statePtr->curOutPtr;

	destCopied = SpaceLeft(outBufPtr);
	if (destCopied > srcLen) {
	    destCopied = srcLen;
	}

	destPtr = InsertPoint(outBufPtr);
	switch (statePtr->outputTranslation) {
	case TCL_TRANSLATE_LF:
	    srcCopied = destCopied;
	    memcpy(destPtr, src, (size_t) destCopied);
	    break;
	case TCL_TRANSLATE_CR:
	    srcCopied = destCopied;
	    memcpy(destPtr, 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:
	    Tcl_Panic("Tcl_Write: AUTO output translation mode not supported");
	default:
	    Tcl_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 (!GotFlag(statePtr, BUFFER_READY)) {
	    if (IsBufferFull(outBufPtr)) {
		SetFlag(statePtr, BUFFER_READY);
	    } else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
		for (sPtr = src, i = 0, foundNewline = 0;
			(i < srcCopied) && (!foundNewline);
			i++, sPtr++) {
		    if (*sPtr == '\n') {
			foundNewline = 1;
			break;
		    }
		}
		if (foundNewline) {
		    SetFlag(statePtr, BUFFER_READY);
		}
	    } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
		SetFlag(statePtr, BUFFER_READY);
	    }
	}

	totalDestCopied += srcCopied;
	src += srcCopied;
	srcLen -= srcCopied;

	if (GotFlag(statePtr, 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

DupChannelIntRep(
    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
				 * an internal rep of type "Channel". */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr);
    Interp *interpPtr = GET_CHANNELINTERP(srcPtr);

    SET_CHANNELSTATE(copyPtr, statePtr);
    SET_CHANNELINTERP(copyPtr, interpPtr);
    Tcl_Preserve(statePtr);
    copyPtr->typePtr = &tclChannelType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetChannelFromAny --
 *

static int
SetChannelFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    ChannelState *statePtr;
    Interp *interpPtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    if (objPtr->typePtr == &tclChannelType) {
	/*
	 * The channel is valid until any call to DetachChannel occurs.
	 * Ensure consistency checks are done.
	 */

	statePtr = GET_CHANNELSTATE(objPtr);
	interpPtr = GET_CHANNELINTERP(objPtr);
	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
	    ResetFlag(statePtr, CHANNEL_TAINTED);
	    Tcl_Release(statePtr);
	    UpdateStringOfChannel(objPtr);
	    objPtr->typePtr = NULL;
	} else if (interpPtr != (Interp*) interp) {
	    Tcl_Release(statePtr);
	    UpdateStringOfChannel(objPtr);
	    objPtr->typePtr = NULL;
	}
    }
    if (objPtr->typePtr != &tclChannelType) {
	Tcl_Channel chan;

	/*
	 * We need a valid string with which to check for a valid channel, but
	 * make sure not to free internal rep until validated. [Bug 1847044]
	 */

	if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) {
	    objPtr->typePtr->updateStringProc(objPtr);
	}

	chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
	if (chan == NULL) {
	    return TCL_ERROR;
	}

	TclFreeIntRep(objPtr);
	statePtr = ((Channel *) chan)->state;
	Tcl_Preserve(statePtr);
	SET_CHANNELSTATE(objPtr, statePtr);
	SET_CHANNELINTERP(objPtr, interp);
	objPtr->typePtr = &tclChannelType;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfChannel --
 *
 *	Update the string representation for an object whose internal
 *	representation is "Channel".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string may be set by converting its Unicode represention
 *	to UTF format.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfChannel(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    if (objPtr->bytes == NULL) {
	ChannelState *statePtr = GET_CHANNELSTATE(objPtr);
	const char *name = statePtr->channelName;

	if (name) {
	    size_t len = strlen(name);

	    objPtr->bytes = ckalloc(len + 1);
	    objPtr->length = len;
	    memcpy(objPtr->bytes, name, len);
	} else {
	    objPtr->bytes = tclEmptyStringRep;
	    objPtr->length = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FreeChannelIntRep --
 *
 *	Release statePtr storage.

 */

MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;



/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;

    Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
#endif

    unameOK = 0;
#ifdef __CYGWIN__
	unameOK = 1;
    if (!osInfoInitialized) {
      HANDLE handle = LoadLibraryW(L"NTDLL");

      int(*getversion)(void *) = (int(*)(void *))GetProcAddress(handle, "RtlGetVersion");
      osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
      if (!getversion || getversion(&osInfo)) {
        GetVersionExW(&osInfo);
      }
      if (handle) {
        FreeLibrary(handle);
      }
      osInfoInitialized = 1;
    }

    GetSystemInfo(&sysInfo);

    if (osInfo.dwPlatformId < NUMPLATFORMS) {
	Tcl_SetVar2(interp, "tcl_platform", "os",
		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);

    TCHAR szUserName[UNLEN+1];
    DWORD cchUserNameLen = UNLEN;

    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
      HANDLE handle = LoadLibraryW(L"NTDLL");

      int(*getversion)(void *) = (int(*)(void *))GetProcAddress(handle, "RtlGetVersion");
      osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
      if (!getversion || getversion(&osInfo)) {
        GetVersionExW(&osInfo);
      }
      if (handle) {
        FreeLibrary(handle);
      }
      osInfoInitialized = 1;
    }
    GetSystemInfo(&sys.info);

    /*
     * Define the tcl_platform array.
     */