Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclIO.c@bde4ae8d615e (annotated)

sl@0	1	/*
sl@0	2	* tclIO.c --
sl@0	3	*
sl@0	4	* This file provides the generic portions (those that are the same on
sl@0	5	* all platforms and for all channel types) of Tcl's IO facilities.
sl@0	6	*
sl@0	7	* Copyright (c) 1998-2000 Ajuba Solutions
sl@0	8	* Copyright (c) 1995-1997 Sun Microsystems, Inc.
sl@0	9	* Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
sl@0	10	*
sl@0	11	* See the file "license.terms" for information on usage and redistribution
sl@0	12	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	13	*
sl@0	14	* RCS: @(#) $Id: tclIO.c,v 1.61.2.23 2007/05/24 19:31:55 dgp Exp $
sl@0	15	*/
sl@0	16
sl@0	17	#include "tclInt.h"
sl@0	18	#include "tclPort.h"
sl@0	19	#include "tclIO.h"
sl@0	20	#include <assert.h>
sl@0	21	#if defined(__SYMBIAN32__) && defined(__WINSCW__)
sl@0	22	#include "tclSymbianGlobals.h"
sl@0	23	#define dataKey getdataKey(3)
sl@0	24	#endif
sl@0	25
sl@0	26	#ifndef TCL_INHERIT_STD_CHANNELS
sl@0	27	#define TCL_INHERIT_STD_CHANNELS 1
sl@0	28	#endif
sl@0	29
sl@0	30
sl@0	31	/*
sl@0	32	* All static variables used in this file are collected into a single
sl@0	33	* instance of the following structure. For multi-threaded implementations,
sl@0	34	* there is one instance of this structure for each thread.
sl@0	35	*
sl@0	36	* Notice that different structures with the same name appear in other
sl@0	37	* files. The structure defined below is used in this file only.
sl@0	38	*/
sl@0	39
sl@0	40	typedef struct ThreadSpecificData {
sl@0	41
sl@0	42	/*
sl@0	43	* This variable holds the list of nested ChannelHandlerEventProc
sl@0	44	* invocations.
sl@0	45	*/
sl@0	46	NextChannelHandler *nestedHandlerPtr;
sl@0	47
sl@0	48	/*
sl@0	49	* List of all channels currently open, indexed by ChannelState,
sl@0	50	* as only one ChannelState exists per set of stacked channels.
sl@0	51	*/
sl@0	52	ChannelState *firstCSPtr;
sl@0	53	#ifdef oldcode
sl@0	54	/*
sl@0	55	* Has a channel exit handler been created yet?
sl@0	56	*/
sl@0	57	int channelExitHandlerCreated;
sl@0	58
sl@0	59	/*
sl@0	60	* Has the channel event source been created and registered with the
sl@0	61	* notifier?
sl@0	62	*/
sl@0	63	int channelEventSourceCreated;
sl@0	64	#endif
sl@0	65	/*
sl@0	66	* Static variables to hold channels for stdin, stdout and stderr.
sl@0	67	*/
sl@0	68	Tcl_Channel stdinChannel;
sl@0	69	int stdinInitialized;
sl@0	70	Tcl_Channel stdoutChannel;
sl@0	71	int stdoutInitialized;
sl@0	72	Tcl_Channel stderrChannel;
sl@0	73	int stderrInitialized;
sl@0	74
sl@0	75	} ThreadSpecificData;
sl@0	76
sl@0	77	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	78	static Tcl_ThreadDataKey dataKey;
sl@0	79	#endif
sl@0	80
sl@0	81	/*
sl@0	82	* Static functions in this file:
sl@0	83	*/
sl@0	84
sl@0	85	static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
sl@0	86	static void ChannelTimerProc _ANSI_ARGS_((
sl@0	87	ClientData clientData));
sl@0	88	static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
sl@0	89	int direction));
sl@0	90	static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
sl@0	91	ChannelBuffer *bufPtr, int newlineFlag));
sl@0	92	static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	93	ChannelState *statePtr));
sl@0	94	static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
sl@0	95	Tcl_Channel chan));
sl@0	96	static void CleanupChannelHandlers _ANSI_ARGS_((
sl@0	97	Tcl_Interp interp, Channel chanPtr));
sl@0	98	static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	99	Channel *chanPtr, int errorCode));
sl@0	100	static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
sl@0	101	Tcl_Encoding encoding));
sl@0	102	static int CopyAndTranslateBuffer _ANSI_ARGS_((
sl@0	103	ChannelState statePtr, char result,
sl@0	104	int space));
sl@0	105	static int CopyBuffer _ANSI_ARGS_((
sl@0	106	Channel chanPtr, char result, int space));
sl@0	107	static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
sl@0	108	static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
sl@0	109	int mask));
sl@0	110	static void CreateScriptRecord _ANSI_ARGS_((
sl@0	111	Tcl_Interp interp, Channel chanPtr,
sl@0	112	int mask, Tcl_Obj *scriptPtr));
sl@0	113	static void DeleteChannelTable _ANSI_ARGS_((
sl@0	114	ClientData clientData, Tcl_Interp *interp));
sl@0	115	static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	116	Channel *chanPtr, int mask));
sl@0	117	static int DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	118	Tcl_Channel chan));
sl@0	119	static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
sl@0	120	int discardSavedBuffers));
sl@0	121	static void DiscardOutputQueued _ANSI_ARGS_((
sl@0	122	ChannelState *chanPtr));
sl@0	123	static int DoRead _ANSI_ARGS_((Channel chanPtr, char srcPtr,
sl@0	124	int slen));
sl@0	125	static int DoWrite _ANSI_ARGS_((Channel chanPtr, CONST char src,
sl@0	126	int srcLen));
sl@0	127	static int DoReadChars _ANSI_ARGS_ ((Channel* chan,
sl@0	128	Tcl_Obj* objPtr, int toRead, int appendFlag));
sl@0	129	static int DoWriteChars _ANSI_ARGS_ ((Channel* chan,
sl@0	130	CONST char* src, int len));
sl@0	131	static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
sl@0	132	GetsState *statePtr));
sl@0	133	static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	134	Channel *chanPtr, int calledFromAsyncFlush));
sl@0	135	static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
sl@0	136	static int GetInput _ANSI_ARGS_((Channel *chanPtr));
sl@0	137	static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
sl@0	138	Tcl_ChannelTypeVersion minimumVersion));
sl@0	139	static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
sl@0	140	char *dstEndPtr, GetsState gsPtr));
sl@0	141	static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
sl@0	142	Tcl_Obj *objPtr, int charsLeft,
sl@0	143	int *offsetPtr));
sl@0	144	static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
sl@0	145	Tcl_Obj *objPtr, int charsLeft,
sl@0	146	int offsetPtr, int factorPtr));
sl@0	147	static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
sl@0	148	ChannelBuffer *bufPtr, int mustDiscard));
sl@0	149	static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
sl@0	150	int mode));
sl@0	151	static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	152	Channel *chanPtr, int mode));
sl@0	153	static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
sl@0	154	static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
sl@0	155	char dst, CONST char src,
sl@0	156	int dstLenPtr, int srcLenPtr));
sl@0	157	static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
sl@0	158	char dst, CONST char src,
sl@0	159	int dstLenPtr, int srcLenPtr));
sl@0	160	static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
sl@0	161	static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
sl@0	162	CONST char *src, int srcLen));
sl@0	163	static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
sl@0	164	CONST char *src, int srcLen));
sl@0	165
sl@0	166
sl@0	167	/*
sl@0	168	*---------------------------------------------------------------------------
sl@0	169	*
sl@0	170	* TclInitIOSubsystem --
sl@0	171	*
sl@0	172	* Initialize all resources used by this subsystem on a per-process
sl@0	173	* basis.
sl@0	174	*
sl@0	175	* Results:
sl@0	176	* None.
sl@0	177	*
sl@0	178	* Side effects:
sl@0	179	* Depends on the memory subsystems.
sl@0	180	*
sl@0	181	*---------------------------------------------------------------------------
sl@0	182	*/
sl@0	183
sl@0	184	void
sl@0	185	TclInitIOSubsystem()
sl@0	186	{
sl@0	187	/*
sl@0	188	* By fetching thread local storage we take care of
sl@0	189	* allocating it for each thread.
sl@0	190	*/
sl@0	191	(void) TCL_TSD_INIT(&dataKey);
sl@0	192	}
sl@0	193
sl@0	194	/*
sl@0	195	*-------------------------------------------------------------------------
sl@0	196	*
sl@0	197	* TclFinalizeIOSubsystem --
sl@0	198	*
sl@0	199	* Releases all resources used by this subsystem on a per-thread
sl@0	200	* basis. Closes all extant channels that have not already been
sl@0	201	* closed because they were not owned by any interp.
sl@0	202	*
sl@0	203	* Results:
sl@0	204	* None.
sl@0	205	*
sl@0	206	* Side effects:
sl@0	207	* Depends on encoding and memory subsystems.
sl@0	208	*
sl@0	209	*-------------------------------------------------------------------------
sl@0	210	*/
sl@0	211
sl@0	212	/* ARGSUSED */
sl@0	213	void
sl@0	214	TclFinalizeIOSubsystem(void)
sl@0	215	{
sl@0	216	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	217	Channel chanPtr = NULL; / Iterates over open channels. */
sl@0	218	ChannelState statePtr; / State of channel stack */
sl@0	219	int active = 1; /* Flag == 1 while there's still work to do */
sl@0	220
sl@0	221	/*
sl@0	222	* Walk all channel state structures known to this thread and
sl@0	223	* close corresponding channels.
sl@0	224	*/
sl@0	225
sl@0	226	while (active) {
sl@0	227
sl@0	228	/*
sl@0	229	* Iterate through the open channel list, and find the first
sl@0	230	* channel that isn't dead. We start from the head of the list
sl@0	231	* each time, because the close action on one channel can close
sl@0	232	* others.
sl@0	233	*/
sl@0	234
sl@0	235	active = 0;
sl@0	236	for (statePtr = tsdPtr->firstCSPtr;
sl@0	237	statePtr != NULL;
sl@0	238	statePtr = statePtr->nextCSPtr) {
sl@0	239	chanPtr = statePtr->topChanPtr;
sl@0	240	if (!(statePtr->flags & CHANNEL_DEAD)) {
sl@0	241	active = 1;
sl@0	242	break;
sl@0	243	}
sl@0	244	}
sl@0	245
sl@0	246	/*
sl@0	247	* We've found a live channel. Close it.
sl@0	248	*/
sl@0	249
sl@0	250	if (active) {
sl@0	251
sl@0	252	/*
sl@0	253	* Set the channel back into blocking mode to ensure that we
sl@0	254	* wait for all data to flush out.
sl@0	255	*/
sl@0	256
sl@0	257	(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
sl@0	258	"-blocking", "on");
sl@0	259
sl@0	260	if ((chanPtr == (Channel *) tsdPtr->stdinChannel) \|\|
sl@0	261	(chanPtr == (Channel *) tsdPtr->stdoutChannel) \|\|
sl@0	262	(chanPtr == (Channel *) tsdPtr->stderrChannel)) {
sl@0	263	/*
sl@0	264	* Decrement the refcount which was earlier artificially
sl@0	265	* bumped up to keep the channel from being closed.
sl@0	266	*/
sl@0	267
sl@0	268	statePtr->refCount--;
sl@0	269	}
sl@0	270
sl@0	271	if (statePtr->refCount <= 0) {
sl@0	272	/*
sl@0	273	* Close it only if the refcount indicates that the channel
sl@0	274	* is not referenced from any interpreter. If it is, that
sl@0	275	* interpreter will close the channel when it gets destroyed.
sl@0	276	*/
sl@0	277
sl@0	278	(void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
sl@0	279	} else {
sl@0	280	/*
sl@0	281	* The refcount is greater than zero, so flush the channel.
sl@0	282	*/
sl@0	283
sl@0	284	Tcl_Flush((Tcl_Channel) chanPtr);
sl@0	285
sl@0	286	/*
sl@0	287	* Call the device driver to actually close the underlying
sl@0	288	* device for this channel.
sl@0	289	*/
sl@0	290
sl@0	291	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
sl@0	292	(chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
sl@0	293	} else {
sl@0	294	(chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
sl@0	295	NULL, 0);
sl@0	296	}
sl@0	297
sl@0	298	/*
sl@0	299	* Finally, we clean up the fields in the channel data
sl@0	300	* structure since all of them have been deleted already.
sl@0	301	* We mark the channel with CHANNEL_DEAD to prevent any
sl@0	302	* further IO operations
sl@0	303	* on it.
sl@0	304	*/
sl@0	305
sl@0	306	chanPtr->instanceData = NULL;
sl@0	307	statePtr->flags \|= CHANNEL_DEAD;
sl@0	308	}
sl@0	309	}
sl@0	310	}
sl@0	311
sl@0	312	TclpFinalizeSockets();
sl@0	313	TclpFinalizePipes();
sl@0	314	}
sl@0	315
sl@0	316
sl@0	317	/*
sl@0	318	*----------------------------------------------------------------------
sl@0	319	*
sl@0	320	* Tcl_SetStdChannel --
sl@0	321	*
sl@0	322	* This function is used to change the channels that are used
sl@0	323	* for stdin/stdout/stderr in new interpreters.
sl@0	324	*
sl@0	325	* Results:
sl@0	326	* None
sl@0	327	*
sl@0	328	* Side effects:
sl@0	329	* None.
sl@0	330	*
sl@0	331	*----------------------------------------------------------------------
sl@0	332	*/
sl@0	333
sl@0	334	EXPORT_C void
sl@0	335	Tcl_SetStdChannel(channel, type)
sl@0	336	Tcl_Channel channel;
sl@0	337	int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
sl@0	338	{
sl@0	339	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	340	switch (type) {
sl@0	341	case TCL_STDIN:
sl@0	342	tsdPtr->stdinInitialized = 1;
sl@0	343	tsdPtr->stdinChannel = channel;
sl@0	344	break;
sl@0	345	case TCL_STDOUT:
sl@0	346	tsdPtr->stdoutInitialized = 1;
sl@0	347	tsdPtr->stdoutChannel = channel;
sl@0	348	break;
sl@0	349	case TCL_STDERR:
sl@0	350	tsdPtr->stderrInitialized = 1;
sl@0	351	tsdPtr->stderrChannel = channel;
sl@0	352	break;
sl@0	353	}
sl@0	354	}
sl@0	355
sl@0	356	/*
sl@0	357	*----------------------------------------------------------------------
sl@0	358	*
sl@0	359	* Tcl_GetStdChannel --
sl@0	360	*
sl@0	361	* Returns the specified standard channel.
sl@0	362	*
sl@0	363	* Results:
sl@0	364	* Returns the specified standard channel, or NULL.
sl@0	365	*
sl@0	366	* Side effects:
sl@0	367	* May cause the creation of a standard channel and the underlying
sl@0	368	* file.
sl@0	369	*
sl@0	370	*----------------------------------------------------------------------
sl@0	371	*/
sl@0	372	EXPORT_C Tcl_Channel
sl@0	373	Tcl_GetStdChannel(type)
sl@0	374	int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
sl@0	375	{
sl@0	376	Tcl_Channel channel = NULL;
sl@0	377	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	378
sl@0	379	/*
sl@0	380	* If the channels were not created yet, create them now and
sl@0	381	* store them in the static variables.
sl@0	382	*/
sl@0	383
sl@0	384	switch (type) {
sl@0	385	case TCL_STDIN:
sl@0	386	if (!tsdPtr->stdinInitialized) {
sl@0	387	tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
sl@0	388	tsdPtr->stdinInitialized = 1;
sl@0	389
sl@0	390	/*
sl@0	391	* Artificially bump the refcount to ensure that the channel
sl@0	392	* is only closed on exit.
sl@0	393	*
sl@0	394	* NOTE: Must only do this if stdinChannel is not NULL. It
sl@0	395	* can be NULL in situations where Tcl is unable to connect
sl@0	396	* to the standard input.
sl@0	397	*/
sl@0	398
sl@0	399	if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
sl@0	400	(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
sl@0	401	tsdPtr->stdinChannel);
sl@0	402	}
sl@0	403	}
sl@0	404	channel = tsdPtr->stdinChannel;
sl@0	405	break;
sl@0	406	case TCL_STDOUT:
sl@0	407	if (!tsdPtr->stdoutInitialized) {
sl@0	408	tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
sl@0	409	tsdPtr->stdoutInitialized = 1;
sl@0	410	if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
sl@0	411	(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
sl@0	412	tsdPtr->stdoutChannel);
sl@0	413	}
sl@0	414	}
sl@0	415	channel = tsdPtr->stdoutChannel;
sl@0	416	break;
sl@0	417	case TCL_STDERR:
sl@0	418	if (!tsdPtr->stderrInitialized) {
sl@0	419	tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
sl@0	420	tsdPtr->stderrInitialized = 1;
sl@0	421	if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
sl@0	422	(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
sl@0	423	tsdPtr->stderrChannel);
sl@0	424	}
sl@0	425	}
sl@0	426	channel = tsdPtr->stderrChannel;
sl@0	427	break;
sl@0	428	}
sl@0	429	return channel;
sl@0	430	}
sl@0	431
sl@0	432
sl@0	433	/*
sl@0	434	*----------------------------------------------------------------------
sl@0	435	*
sl@0	436	* Tcl_CreateCloseHandler
sl@0	437	*
sl@0	438	* Creates a close callback which will be called when the channel is
sl@0	439	* closed.
sl@0	440	*
sl@0	441	* Results:
sl@0	442	* None.
sl@0	443	*
sl@0	444	* Side effects:
sl@0	445	* Causes the callback to be called in the future when the channel
sl@0	446	* will be closed.
sl@0	447	*
sl@0	448	*----------------------------------------------------------------------
sl@0	449	*/
sl@0	450
sl@0	451	EXPORT_C void
sl@0	452	Tcl_CreateCloseHandler(chan, proc, clientData)
sl@0	453	Tcl_Channel chan; /* The channel for which to create the
sl@0	454	* close callback. */
sl@0	455	Tcl_CloseProc proc; / The callback routine to call when the
sl@0	456	* channel will be closed. */
sl@0	457	ClientData clientData; /* Arbitrary data to pass to the
sl@0	458	* close callback. */
sl@0	459	{
sl@0	460	ChannelState *statePtr;
sl@0	461	CloseCallback *cbPtr;
sl@0	462
sl@0	463	statePtr = ((Channel *) chan)->state;
sl@0	464
sl@0	465	cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
sl@0	466	cbPtr->proc = proc;
sl@0	467	cbPtr->clientData = clientData;
sl@0	468
sl@0	469	cbPtr->nextPtr = statePtr->closeCbPtr;
sl@0	470	statePtr->closeCbPtr = cbPtr;
sl@0	471	}
sl@0	472
sl@0	473	/*
sl@0	474	*----------------------------------------------------------------------
sl@0	475	*
sl@0	476	* Tcl_DeleteCloseHandler --
sl@0	477	*
sl@0	478	* Removes a callback that would have been called on closing
sl@0	479	* the channel. If there is no matching callback then this
sl@0	480	* function has no effect.
sl@0	481	*
sl@0	482	* Results:
sl@0	483	* None.
sl@0	484	*
sl@0	485	* Side effects:
sl@0	486	* The callback will not be called in the future when the channel
sl@0	487	* is eventually closed.
sl@0	488	*
sl@0	489	*----------------------------------------------------------------------
sl@0	490	*/
sl@0	491
sl@0	492	EXPORT_C void
sl@0	493	Tcl_DeleteCloseHandler(chan, proc, clientData)
sl@0	494	Tcl_Channel chan; /* The channel for which to cancel the
sl@0	495	* close callback. */
sl@0	496	Tcl_CloseProc proc; / The procedure for the callback to
sl@0	497	* remove. */
sl@0	498	ClientData clientData; /* The callback data for the callback
sl@0	499	* to remove. */
sl@0	500	{
sl@0	501	ChannelState *statePtr;
sl@0	502	CloseCallback cbPtr, cbPrevPtr;
sl@0	503
sl@0	504	statePtr = ((Channel *) chan)->state;
sl@0	505	for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
sl@0	506	cbPtr != (CloseCallback *) NULL;
sl@0	507	cbPtr = cbPtr->nextPtr) {
sl@0	508	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
sl@0	509	if (cbPrevPtr == (CloseCallback *) NULL) {
sl@0	510	statePtr->closeCbPtr = cbPtr->nextPtr;
sl@0	511	}
sl@0	512	ckfree((char *) cbPtr);
sl@0	513	break;
sl@0	514	} else {
sl@0	515	cbPrevPtr = cbPtr;
sl@0	516	}
sl@0	517	}
sl@0	518	}
sl@0	519
sl@0	520	/*
sl@0	521	*----------------------------------------------------------------------
sl@0	522	*
sl@0	523	* GetChannelTable --
sl@0	524	*
sl@0	525	* Gets and potentially initializes the channel table for an
sl@0	526	* interpreter. If it is initializing the table it also inserts
sl@0	527	* channels for stdin, stdout and stderr if the interpreter is
sl@0	528	* trusted.
sl@0	529	*
sl@0	530	* Results:
sl@0	531	* A pointer to the hash table created, for use by the caller.
sl@0	532	*
sl@0	533	* Side effects:
sl@0	534	* Initializes the channel table for an interpreter. May create
sl@0	535	* channels for stdin, stdout and stderr.
sl@0	536	*
sl@0	537	*----------------------------------------------------------------------
sl@0	538	*/
sl@0	539
sl@0	540	static Tcl_HashTable *
sl@0	541	GetChannelTable(interp)
sl@0	542	Tcl_Interp *interp;
sl@0	543	{
sl@0	544	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	545	Tcl_Channel stdinChan, stdoutChan, stderrChan;
sl@0	546
sl@0	547	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
sl@0	548	if (hTblPtr == (Tcl_HashTable *) NULL) {
sl@0	549	hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
sl@0	550	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
sl@0	551
sl@0	552	(void) Tcl_SetAssocData(interp, "tclIO",
sl@0	553	(Tcl_InterpDeleteProc *) DeleteChannelTable,
sl@0	554	(ClientData) hTblPtr);
sl@0	555
sl@0	556	/*
sl@0	557	* If the interpreter is trusted (not "safe"), insert channels
sl@0	558	* for stdin, stdout and stderr (possibly creating them in the
sl@0	559	* process).
sl@0	560	*/
sl@0	561
sl@0	562	if (Tcl_IsSafe(interp) == 0) {
sl@0	563	stdinChan = Tcl_GetStdChannel(TCL_STDIN);
sl@0	564	if (stdinChan != NULL) {
sl@0	565	Tcl_RegisterChannel(interp, stdinChan);
sl@0	566	}
sl@0	567	stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
sl@0	568	if (stdoutChan != NULL) {
sl@0	569	Tcl_RegisterChannel(interp, stdoutChan);
sl@0	570	}
sl@0	571	stderrChan = Tcl_GetStdChannel(TCL_STDERR);
sl@0	572	if (stderrChan != NULL) {
sl@0	573	Tcl_RegisterChannel(interp, stderrChan);
sl@0	574	}
sl@0	575	}
sl@0	576
sl@0	577	}
sl@0	578	return hTblPtr;
sl@0	579	}
sl@0	580
sl@0	581	/*
sl@0	582	*----------------------------------------------------------------------
sl@0	583	*
sl@0	584	* DeleteChannelTable --
sl@0	585	*
sl@0	586	* Deletes the channel table for an interpreter, closing any open
sl@0	587	* channels whose refcount reaches zero. This procedure is invoked
sl@0	588	* when an interpreter is deleted, via the AssocData cleanup
sl@0	589	* mechanism.
sl@0	590	*
sl@0	591	* Results:
sl@0	592	* None.
sl@0	593	*
sl@0	594	* Side effects:
sl@0	595	* Deletes the hash table of channels. May close channels. May flush
sl@0	596	* output on closed channels. Removes any channeEvent handlers that were
sl@0	597	* registered in this interpreter.
sl@0	598	*
sl@0	599	*----------------------------------------------------------------------
sl@0	600	*/
sl@0	601
sl@0	602	static void
sl@0	603	DeleteChannelTable(clientData, interp)
sl@0	604	ClientData clientData; /* The per-interpreter data structure. */
sl@0	605	Tcl_Interp interp; / The interpreter being deleted. */
sl@0	606	{
sl@0	607	Tcl_HashTable hTblPtr; / The hash table. */
sl@0	608	Tcl_HashSearch hSearch; /* Search variable. */
sl@0	609	Tcl_HashEntry hPtr; / Search variable. */
sl@0	610	Channel chanPtr; / Channel being deleted. */
sl@0	611	ChannelState statePtr; / State of Channel being deleted. */
sl@0	612	EventScriptRecord sPtr, prevPtr, *nextPtr;
sl@0	613	/* Variables to loop over all channel events
sl@0	614	* registered, to delete the ones that refer
sl@0	615	* to the interpreter being deleted. */
sl@0	616
sl@0	617	/*
sl@0	618	* Delete all the registered channels - this will close channels whose
sl@0	619	* refcount reaches zero.
sl@0	620	*/
sl@0	621
sl@0	622	hTblPtr = (Tcl_HashTable *) clientData;
sl@0	623	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
sl@0	624	hPtr != (Tcl_HashEntry *) NULL;
sl@0	625	hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
sl@0	626
sl@0	627	chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
sl@0	628	statePtr = chanPtr->state;
sl@0	629
sl@0	630	/*
sl@0	631	* Remove any fileevents registered in this interpreter.
sl@0	632	*/
sl@0	633
sl@0	634	for (sPtr = statePtr->scriptRecordPtr,
sl@0	635	prevPtr = (EventScriptRecord *) NULL;
sl@0	636	sPtr != (EventScriptRecord *) NULL;
sl@0	637	sPtr = nextPtr) {
sl@0	638	nextPtr = sPtr->nextPtr;
sl@0	639	if (sPtr->interp == interp) {
sl@0	640	if (prevPtr == (EventScriptRecord *) NULL) {
sl@0	641	statePtr->scriptRecordPtr = nextPtr;
sl@0	642	} else {
sl@0	643	prevPtr->nextPtr = nextPtr;
sl@0	644	}
sl@0	645
sl@0	646	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
sl@0	647	TclChannelEventScriptInvoker, (ClientData) sPtr);
sl@0	648
sl@0	649	Tcl_DecrRefCount(sPtr->scriptPtr);
sl@0	650	ckfree((char *) sPtr);
sl@0	651	} else {
sl@0	652	prevPtr = sPtr;
sl@0	653	}
sl@0	654	}
sl@0	655
sl@0	656	/*
sl@0	657	* Cannot call Tcl_UnregisterChannel because that procedure calls
sl@0	658	* Tcl_GetAssocData to get the channel table, which might already
sl@0	659	* be inaccessible from the interpreter structure. Instead, we
sl@0	660	* emulate the behavior of Tcl_UnregisterChannel directly here.
sl@0	661	*/
sl@0	662
sl@0	663	Tcl_DeleteHashEntry(hPtr);
sl@0	664	statePtr->refCount--;
sl@0	665	if (statePtr->refCount <= 0) {
sl@0	666	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
sl@0	667	(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
sl@0	668	}
sl@0	669	}
sl@0	670	}
sl@0	671	Tcl_DeleteHashTable(hTblPtr);
sl@0	672	ckfree((char *) hTblPtr);
sl@0	673	}
sl@0	674
sl@0	675	/*
sl@0	676	*----------------------------------------------------------------------
sl@0	677	*
sl@0	678	* CheckForStdChannelsBeingClosed --
sl@0	679	*
sl@0	680	* Perform special handling for standard channels being closed. When
sl@0	681	* given a standard channel, if the refcount is now 1, it means that
sl@0	682	* the last reference to the standard channel is being explicitly
sl@0	683	* closed. Now bump the refcount artificially down to 0, to ensure the
sl@0	684	* normal handling of channels being closed will occur. Also reset the
sl@0	685	* static pointer to the channel to NULL, to avoid dangling references.
sl@0	686	*
sl@0	687	* Results:
sl@0	688	* None.
sl@0	689	*
sl@0	690	* Side effects:
sl@0	691	* Manipulates the refcount on standard channels. May smash the global
sl@0	692	* static pointer to a standard channel.
sl@0	693	*
sl@0	694	*----------------------------------------------------------------------
sl@0	695	*/
sl@0	696
sl@0	697	static void
sl@0	698	CheckForStdChannelsBeingClosed(chan)
sl@0	699	Tcl_Channel chan;
sl@0	700	{
sl@0	701	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	702	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	703
sl@0	704	if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
sl@0	705	if (statePtr->refCount < 2) {
sl@0	706	statePtr->refCount = 0;
sl@0	707	tsdPtr->stdinChannel = NULL;
sl@0	708	return;
sl@0	709	}
sl@0	710	} else if ((chan == tsdPtr->stdoutChannel)
sl@0	711	&& (tsdPtr->stdoutInitialized)) {
sl@0	712	if (statePtr->refCount < 2) {
sl@0	713	statePtr->refCount = 0;
sl@0	714	tsdPtr->stdoutChannel = NULL;
sl@0	715	return;
sl@0	716	}
sl@0	717	} else if ((chan == tsdPtr->stderrChannel)
sl@0	718	&& (tsdPtr->stderrInitialized)) {
sl@0	719	if (statePtr->refCount < 2) {
sl@0	720	statePtr->refCount = 0;
sl@0	721	tsdPtr->stderrChannel = NULL;
sl@0	722	return;
sl@0	723	}
sl@0	724	}
sl@0	725	}
sl@0	726
sl@0	727	/*
sl@0	728	*----------------------------------------------------------------------
sl@0	729	*
sl@0	730	* Tcl_IsStandardChannel --
sl@0	731	*
sl@0	732	* Test if the given channel is a standard channel. No attempt
sl@0	733	* is made to check if the channel or the standard channels
sl@0	734	* are initialized or otherwise valid.
sl@0	735	*
sl@0	736	* Results:
sl@0	737	* Returns 1 if true, 0 if false.
sl@0	738	*
sl@0	739	* Side effects:
sl@0	740	* None.
sl@0	741	*
sl@0	742	*----------------------------------------------------------------------
sl@0	743	*/
sl@0	744	EXPORT_C int
sl@0	745	Tcl_IsStandardChannel(chan)
sl@0	746	Tcl_Channel chan; /* Channel to check. */
sl@0	747	{
sl@0	748	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	749
sl@0	750	if ((chan == tsdPtr->stdinChannel)
sl@0	751	\|\| (chan == tsdPtr->stdoutChannel)
sl@0	752	\|\| (chan == tsdPtr->stderrChannel)) {
sl@0	753	return 1;
sl@0	754	} else {
sl@0	755	return 0;
sl@0	756	}
sl@0	757	}
sl@0	758
sl@0	759	/*
sl@0	760	*----------------------------------------------------------------------
sl@0	761	*
sl@0	762	* Tcl_RegisterChannel --
sl@0	763	*
sl@0	764	* Adds an already-open channel to the channel table of an interpreter.
sl@0	765	* If the interpreter passed as argument is NULL, it only increments
sl@0	766	* the channel refCount.
sl@0	767	*
sl@0	768	* Results:
sl@0	769	* None.
sl@0	770	*
sl@0	771	* Side effects:
sl@0	772	* May increment the reference count of a channel.
sl@0	773	*
sl@0	774	*----------------------------------------------------------------------
sl@0	775	*/
sl@0	776
sl@0	777	EXPORT_C void
sl@0	778	Tcl_RegisterChannel(interp, chan)
sl@0	779	Tcl_Interp interp; / Interpreter in which to add the channel. */
sl@0	780	Tcl_Channel chan; /* The channel to add to this interpreter
sl@0	781	* channel table. */
sl@0	782	{
sl@0	783	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	784	Tcl_HashEntry hPtr; / Search variable. */
sl@0	785	int new; /* Is the hash entry new or does it exist? */
sl@0	786	Channel chanPtr; / The actual channel. */
sl@0	787	ChannelState statePtr; / State of the actual channel. */
sl@0	788
sl@0	789	/*
sl@0	790	* Always (un)register bottom-most channel in the stack. This makes
sl@0	791	* management of the channel list easier because no manipulation is
sl@0	792	* necessary during (un)stack operation.
sl@0	793	*/
sl@0	794	chanPtr = ((Channel *) chan)->state->bottomChanPtr;
sl@0	795	statePtr = chanPtr->state;
sl@0	796
sl@0	797	if (statePtr->channelName == (CONST char *) NULL) {
sl@0	798	panic("Tcl_RegisterChannel: channel without name");
sl@0	799	}
sl@0	800	if (interp != (Tcl_Interp *) NULL) {
sl@0	801	hTblPtr = GetChannelTable(interp);
sl@0	802	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
sl@0	803	if (new == 0) {
sl@0	804	if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
sl@0	805	return;
sl@0	806	}
sl@0	807
sl@0	808	panic("Tcl_RegisterChannel: duplicate channel names");
sl@0	809	}
sl@0	810	Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
sl@0	811	}
sl@0	812
sl@0	813	statePtr->refCount++;
sl@0	814	}
sl@0	815
sl@0	816	/*
sl@0	817	*----------------------------------------------------------------------
sl@0	818	*
sl@0	819	* Tcl_UnregisterChannel --
sl@0	820	*
sl@0	821	* Deletes the hash entry for a channel associated with an interpreter.
sl@0	822	* If the interpreter given as argument is NULL, it only decrements the
sl@0	823	* reference count. (This all happens in the Tcl_DetachChannel helper
sl@0	824	* function).
sl@0	825	*
sl@0	826	* Finally, if the reference count of the channel drops to zero,
sl@0	827	* it is deleted.
sl@0	828	*
sl@0	829	* Results:
sl@0	830	* A standard Tcl result.
sl@0	831	*
sl@0	832	* Side effects:
sl@0	833	* Calls Tcl_DetachChannel which deletes the hash entry for a channel
sl@0	834	* associated with an interpreter.
sl@0	835	*
sl@0	836	* May delete the channel, which can have a variety of consequences,
sl@0	837	* especially if we are forced to close the channel.
sl@0	838	*
sl@0	839	*----------------------------------------------------------------------
sl@0	840	*/
sl@0	841
sl@0	842	EXPORT_C int
sl@0	843	Tcl_UnregisterChannel(interp, chan)
sl@0	844	Tcl_Interp interp; / Interpreter in which channel is defined. */
sl@0	845	Tcl_Channel chan; /* Channel to delete. */
sl@0	846	{
sl@0	847	ChannelState statePtr; / State of the real channel. */
sl@0	848
sl@0	849	statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
sl@0	850
sl@0	851	if (statePtr->flags & CHANNEL_INCLOSE) {
sl@0	852	if (interp != (Tcl_Interp*) NULL) {
sl@0	853	Tcl_AppendResult(interp,
sl@0	854	"Illegal recursive call to close through close-handler of channel",
sl@0	855	(char *) NULL);
sl@0	856	}
sl@0	857	return TCL_ERROR;
sl@0	858	}
sl@0	859
sl@0	860	if (DetachChannel(interp, chan) != TCL_OK) {
sl@0	861	return TCL_OK;
sl@0	862	}
sl@0	863
sl@0	864	statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
sl@0	865
sl@0	866	/*
sl@0	867	* Perform special handling for standard channels being closed. If the
sl@0	868	* refCount is now 1 it means that the last reference to the standard
sl@0	869	* channel is being explicitly closed, so bump the refCount down
sl@0	870	* artificially to 0. This will ensure that the channel is actually
sl@0	871	* closed, below. Also set the static pointer to NULL for the channel.
sl@0	872	*/
sl@0	873
sl@0	874	CheckForStdChannelsBeingClosed(chan);
sl@0	875
sl@0	876	/*
sl@0	877	* If the refCount reached zero, close the actual channel.
sl@0	878	*/
sl@0	879
sl@0	880	if (statePtr->refCount <= 0) {
sl@0	881
sl@0	882	/*
sl@0	883	* Ensure that if there is another buffer, it gets flushed
sl@0	884	* whether or not we are doing a background flush.
sl@0	885	*/
sl@0	886
sl@0	887	if ((statePtr->curOutPtr != NULL) &&
sl@0	888	(statePtr->curOutPtr->nextAdded >
sl@0	889	statePtr->curOutPtr->nextRemoved)) {
sl@0	890	statePtr->flags \|= BUFFER_READY;
sl@0	891	}
sl@0	892	Tcl_Preserve((ClientData)statePtr);
sl@0	893	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
sl@0	894	/* We don't want to re-enter Tcl_Close */
sl@0	895	if (!(statePtr->flags & CHANNEL_CLOSED)) {
sl@0	896	if (Tcl_Close(interp, chan) != TCL_OK) {
sl@0	897	statePtr->flags \|= CHANNEL_CLOSED;
sl@0	898	Tcl_Release((ClientData)statePtr);
sl@0	899	return TCL_ERROR;
sl@0	900	}
sl@0	901	}
sl@0	902	}
sl@0	903	statePtr->flags \|= CHANNEL_CLOSED;
sl@0	904	Tcl_Release((ClientData)statePtr);
sl@0	905	}
sl@0	906	return TCL_OK;
sl@0	907	}
sl@0	908
sl@0	909	/*
sl@0	910	*----------------------------------------------------------------------
sl@0	911	*
sl@0	912	* Tcl_DetachChannel --
sl@0	913	*
sl@0	914	* Deletes the hash entry for a channel associated with an interpreter.
sl@0	915	* If the interpreter given as argument is NULL, it only decrements the
sl@0	916	* reference count. Even if the ref count drops to zero, the
sl@0	917	* channel is NOT closed or cleaned up. This allows a channel to
sl@0	918	* be detached from an interpreter and left in the same state it
sl@0	919	* was in when it was originally returned by 'Tcl_OpenFileChannel',
sl@0	920	* for example.
sl@0	921	*
sl@0	922	* This function cannot be used on the standard channels, and
sl@0	923	* will return TCL_ERROR if that is attempted.
sl@0	924	*
sl@0	925	* This function should only be necessary for special purposes
sl@0	926	* in which you need to generate a pristine channel from one
sl@0	927	* that has already been used. All ordinary purposes will almost
sl@0	928	* always want to use Tcl_UnregisterChannel instead.
sl@0	929	*
sl@0	930	* Provided the channel is not attached to any other interpreter,
sl@0	931	* it can then be closed with Tcl_Close, rather than with
sl@0	932	* Tcl_UnregisterChannel.
sl@0	933	*
sl@0	934	* Results:
sl@0	935	* A standard Tcl result. If the channel is not currently registered
sl@0	936	* with the given interpreter, TCL_ERROR is returned, otherwise
sl@0	937	* TCL_OK. However no error messages are left in the interp's result.
sl@0	938	*
sl@0	939	* Side effects:
sl@0	940	* Deletes the hash entry for a channel associated with an
sl@0	941	* interpreter.
sl@0	942	*
sl@0	943	*----------------------------------------------------------------------
sl@0	944	*/
sl@0	945
sl@0	946	EXPORT_C int
sl@0	947	Tcl_DetachChannel(interp, chan)
sl@0	948	Tcl_Interp interp; / Interpreter in which channel is defined. */
sl@0	949	Tcl_Channel chan; /* Channel to delete. */
sl@0	950	{
sl@0	951	if (Tcl_IsStandardChannel(chan)) {
sl@0	952	return TCL_ERROR;
sl@0	953	}
sl@0	954
sl@0	955	return DetachChannel(interp, chan);
sl@0	956	}
sl@0	957
sl@0	958	/*
sl@0	959	*----------------------------------------------------------------------
sl@0	960	*
sl@0	961	* DetachChannel --
sl@0	962	*
sl@0	963	* Deletes the hash entry for a channel associated with an interpreter.
sl@0	964	* If the interpreter given as argument is NULL, it only decrements the
sl@0	965	* reference count. Even if the ref count drops to zero, the
sl@0	966	* channel is NOT closed or cleaned up. This allows a channel to
sl@0	967	* be detached from an interpreter and left in the same state it
sl@0	968	* was in when it was originally returned by 'Tcl_OpenFileChannel',
sl@0	969	* for example.
sl@0	970	*
sl@0	971	* Results:
sl@0	972	* A standard Tcl result. If the channel is not currently registered
sl@0	973	* with the given interpreter, TCL_ERROR is returned, otherwise
sl@0	974	* TCL_OK. However no error messages are left in the interp's result.
sl@0	975	*
sl@0	976	* Side effects:
sl@0	977	* Deletes the hash entry for a channel associated with an
sl@0	978	* interpreter.
sl@0	979	*
sl@0	980	*----------------------------------------------------------------------
sl@0	981	*/
sl@0	982
sl@0	983	static int
sl@0	984	DetachChannel(interp, chan)
sl@0	985	Tcl_Interp interp; / Interpreter in which channel is defined. */
sl@0	986	Tcl_Channel chan; /* Channel to delete. */
sl@0	987	{
sl@0	988	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	989	Tcl_HashEntry hPtr; / Search variable. */
sl@0	990	Channel chanPtr; / The real IO channel. */
sl@0	991	ChannelState statePtr; / State of the real channel. */
sl@0	992
sl@0	993	/*
sl@0	994	* Always (un)register bottom-most channel in the stack. This makes
sl@0	995	* management of the channel list easier because no manipulation is
sl@0	996	* necessary during (un)stack operation.
sl@0	997	*/
sl@0	998	chanPtr = ((Channel *) chan)->state->bottomChanPtr;
sl@0	999	statePtr = chanPtr->state;
sl@0	1000
sl@0	1001	if (interp != (Tcl_Interp *) NULL) {
sl@0	1002	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
sl@0	1003	if (hTblPtr == (Tcl_HashTable *) NULL) {
sl@0	1004	return TCL_ERROR;
sl@0	1005	}
sl@0	1006	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
sl@0	1007	if (hPtr == (Tcl_HashEntry *) NULL) {
sl@0	1008	return TCL_ERROR;
sl@0	1009	}
sl@0	1010	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
sl@0	1011	return TCL_ERROR;
sl@0	1012	}
sl@0	1013	Tcl_DeleteHashEntry(hPtr);
sl@0	1014
sl@0	1015	/*
sl@0	1016	* Remove channel handlers that refer to this interpreter, so that they
sl@0	1017	* will not be present if the actual close is delayed and more events
sl@0	1018	* happen on the channel. This may occur if the channel is shared
sl@0	1019	* between several interpreters, or if the channel has async
sl@0	1020	* flushing active.
sl@0	1021	*/
sl@0	1022
sl@0	1023	CleanupChannelHandlers(interp, chanPtr);
sl@0	1024	}
sl@0	1025
sl@0	1026	statePtr->refCount--;
sl@0	1027
sl@0	1028	return TCL_OK;
sl@0	1029	}
sl@0	1030
sl@0	1031
sl@0	1032	/*
sl@0	1033	*---------------------------------------------------------------------------
sl@0	1034	*
sl@0	1035	* Tcl_GetChannel --
sl@0	1036	*
sl@0	1037	* Finds an existing Tcl_Channel structure by name in a given
sl@0	1038	* interpreter. This function is public because it is used by
sl@0	1039	* channel-type-specific functions.
sl@0	1040	*
sl@0	1041	* Results:
sl@0	1042	* A Tcl_Channel or NULL on failure. If failed, interp's result
sl@0	1043	* object contains an error message. *modePtr is filled with the
sl@0	1044	* modes in which the channel was opened.
sl@0	1045	*
sl@0	1046	* Side effects:
sl@0	1047	* None.
sl@0	1048	*
sl@0	1049	*---------------------------------------------------------------------------
sl@0	1050	*/
sl@0	1051
sl@0	1052	EXPORT_C Tcl_Channel
sl@0	1053	Tcl_GetChannel(interp, chanName, modePtr)
sl@0	1054	Tcl_Interp interp; / Interpreter in which to find or create
sl@0	1055	* the channel. */
sl@0	1056	CONST char chanName; / The name of the channel. */
sl@0	1057	int modePtr; / Where to store the mode in which the
sl@0	1058	* channel was opened? Will contain an ORed
sl@0	1059	* combination of TCL_READABLE and
sl@0	1060	* TCL_WRITABLE, if non-NULL. */
sl@0	1061	{
sl@0	1062	Channel chanPtr; / The actual channel. */
sl@0	1063	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	1064	Tcl_HashEntry hPtr; / Search variable. */
sl@0	1065	CONST char name; / Translated name. */
sl@0	1066
sl@0	1067	/*
sl@0	1068	* Substitute "stdin", etc. Note that even though we immediately
sl@0	1069	* find the channel using Tcl_GetStdChannel, we still need to look
sl@0	1070	* it up in the specified interpreter to ensure that it is present
sl@0	1071	* in the channel table. Otherwise, safe interpreters would always
sl@0	1072	* have access to the standard channels.
sl@0	1073	*/
sl@0	1074
sl@0	1075	name = chanName;
sl@0	1076	if ((chanName[0] == 's') && (chanName[1] == 't')) {
sl@0	1077	chanPtr = NULL;
sl@0	1078	if (strcmp(chanName, "stdin") == 0) {
sl@0	1079	chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
sl@0	1080	} else if (strcmp(chanName, "stdout") == 0) {
sl@0	1081	chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
sl@0	1082	} else if (strcmp(chanName, "stderr") == 0) {
sl@0	1083	chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
sl@0	1084	}
sl@0	1085	if (chanPtr != NULL) {
sl@0	1086	name = chanPtr->state->channelName;
sl@0	1087	}
sl@0	1088	}
sl@0	1089
sl@0	1090	hTblPtr = GetChannelTable(interp);
sl@0	1091	hPtr = Tcl_FindHashEntry(hTblPtr, name);
sl@0	1092	if (hPtr == (Tcl_HashEntry *) NULL) {
sl@0	1093	Tcl_AppendResult(interp, "can not find channel named \"",
sl@0	1094	chanName, "\"", (char *) NULL);
sl@0	1095	return NULL;
sl@0	1096	}
sl@0	1097
sl@0	1098	/*
sl@0	1099	* Always return bottom-most channel in the stack. This one lives
sl@0	1100	* the longest - other channels may go away unnoticed.
sl@0	1101	* The other APIs compensate where necessary to retrieve the
sl@0	1102	* topmost channel again.
sl@0	1103	*/
sl@0	1104	chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
sl@0	1105	chanPtr = chanPtr->state->bottomChanPtr;
sl@0	1106	if (modePtr != NULL) {
sl@0	1107	*modePtr = (chanPtr->state->flags & (TCL_READABLE\|TCL_WRITABLE));
sl@0	1108	}
sl@0	1109
sl@0	1110	return (Tcl_Channel) chanPtr;
sl@0	1111	}
sl@0	1112
sl@0	1113	/*
sl@0	1114	*----------------------------------------------------------------------
sl@0	1115	*
sl@0	1116	* Tcl_CreateChannel --
sl@0	1117	*
sl@0	1118	* Creates a new entry in the hash table for a Tcl_Channel
sl@0	1119	* record.
sl@0	1120	*
sl@0	1121	* Results:
sl@0	1122	* Returns the new Tcl_Channel.
sl@0	1123	*
sl@0	1124	* Side effects:
sl@0	1125	* Creates a new Tcl_Channel instance and inserts it into the
sl@0	1126	* hash table.
sl@0	1127	*
sl@0	1128	*----------------------------------------------------------------------
sl@0	1129	*/
sl@0	1130
sl@0	1131	EXPORT_C Tcl_Channel
sl@0	1132	Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
sl@0	1133	Tcl_ChannelType typePtr; / The channel type record. */
sl@0	1134	CONST char chanName; / Name of channel to record. */
sl@0	1135	ClientData instanceData; /* Instance specific data. */
sl@0	1136	int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
sl@0	1137	* if the channel is readable, writable. */
sl@0	1138	{
sl@0	1139	Channel chanPtr; / The channel structure newly created. */
sl@0	1140	ChannelState statePtr; / The stack-level independent state info
sl@0	1141	* for the channel. */
sl@0	1142	CONST char *name;
sl@0	1143	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	1144
sl@0	1145	/*
sl@0	1146	* With the change of the Tcl_ChannelType structure to use a version in
sl@0	1147	* 8.3.2+, we have to make sure that our assumption that the structure
sl@0	1148	* remains a binary compatible size is true.
sl@0	1149	*
sl@0	1150	* If this assertion fails on some system, then it can be removed
sl@0	1151	* only if the user recompiles code with older channel drivers in
sl@0	1152	* the new system as well.
sl@0	1153	*/
sl@0	1154
sl@0	1155	assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
sl@0	1156
sl@0	1157	/*
sl@0	1158	* JH: We could subsequently memset these to 0 to avoid the
sl@0	1159	* numerous assignments to 0/NULL below.
sl@0	1160	*/
sl@0	1161	chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
sl@0	1162	statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
sl@0	1163	chanPtr->state = statePtr;
sl@0	1164
sl@0	1165	chanPtr->instanceData = instanceData;
sl@0	1166	chanPtr->typePtr = typePtr;
sl@0	1167
sl@0	1168	/*
sl@0	1169	* Set all the bits that are part of the stack-independent state
sl@0	1170	* information for the channel.
sl@0	1171	*/
sl@0	1172
sl@0	1173	if (chanName != (char *) NULL) {
sl@0	1174	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
sl@0	1175	statePtr->channelName = tmp;
sl@0	1176	strcpy(tmp, chanName);
sl@0	1177	} else {
sl@0	1178	panic("Tcl_CreateChannel: NULL channel name");
sl@0	1179	}
sl@0	1180
sl@0	1181	statePtr->flags = mask;
sl@0	1182
sl@0	1183	/*
sl@0	1184	* Set the channel to system default encoding.
sl@0	1185	*/
sl@0	1186
sl@0	1187	statePtr->encoding = NULL;
sl@0	1188	name = Tcl_GetEncodingName(NULL);
sl@0	1189	if (strcmp(name, "binary") != 0) {
sl@0	1190	statePtr->encoding = Tcl_GetEncoding(NULL, name);
sl@0	1191	}
sl@0	1192	statePtr->inputEncodingState = NULL;
sl@0	1193	statePtr->inputEncodingFlags = TCL_ENCODING_START;
sl@0	1194	statePtr->outputEncodingState = NULL;
sl@0	1195	statePtr->outputEncodingFlags = TCL_ENCODING_START;
sl@0	1196
sl@0	1197	/*
sl@0	1198	* Set the channel up initially in AUTO input translation mode to
sl@0	1199	* accept "\n", "\r" and "\r\n". Output translation mode is set to
sl@0	1200	* a platform specific default value. The eofChar is set to 0 for both
sl@0	1201	* input and output, so that Tcl does not look for an in-file EOF
sl@0	1202	* indicator (e.g. ^Z) and does not append an EOF indicator to files.
sl@0	1203	*/
sl@0	1204
sl@0	1205	statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
sl@0	1206	statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
sl@0	1207	statePtr->inEofChar = 0;
sl@0	1208	statePtr->outEofChar = 0;
sl@0	1209
sl@0	1210	statePtr->unreportedError = 0;
sl@0	1211	statePtr->refCount = 0;
sl@0	1212	statePtr->closeCbPtr = (CloseCallback *) NULL;
sl@0	1213	statePtr->curOutPtr = (ChannelBuffer *) NULL;
sl@0	1214	statePtr->outQueueHead = (ChannelBuffer *) NULL;
sl@0	1215	statePtr->outQueueTail = (ChannelBuffer *) NULL;
sl@0	1216	statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
sl@0	1217	statePtr->inQueueHead = (ChannelBuffer *) NULL;
sl@0	1218	statePtr->inQueueTail = (ChannelBuffer *) NULL;
sl@0	1219	statePtr->chPtr = (ChannelHandler *) NULL;
sl@0	1220	statePtr->interestMask = 0;
sl@0	1221	statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
sl@0	1222	statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
sl@0	1223	statePtr->timer = NULL;
sl@0	1224	statePtr->csPtr = NULL;
sl@0	1225
sl@0	1226	statePtr->outputStage = NULL;
sl@0	1227	if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
sl@0	1228	statePtr->outputStage = (char *)
sl@0	1229	ckalloc((unsigned) (statePtr->bufSize + 2));
sl@0	1230	}
sl@0	1231
sl@0	1232	/*
sl@0	1233	* As we are creating the channel, it is obviously the top for now
sl@0	1234	*/
sl@0	1235	statePtr->topChanPtr = chanPtr;
sl@0	1236	statePtr->bottomChanPtr = chanPtr;
sl@0	1237	chanPtr->downChanPtr = (Channel *) NULL;
sl@0	1238	chanPtr->upChanPtr = (Channel *) NULL;
sl@0	1239	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	1240	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	1241
sl@0	1242	/*
sl@0	1243	* Link the channel into the list of all channels; create an on-exit
sl@0	1244	* handler if there is not one already, to close off all the channels
sl@0	1245	* in the list on exit.
sl@0	1246	*
sl@0	1247	* JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
sl@0	1248	*
sl@0	1249	* TIP #218.
sl@0	1250	* AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
sl@0	1251	* We need Tcl_SpliceChannel, for the threadAction calls.
sl@0	1252	* There is no real reason to duplicate all of this.
sl@0	1253	* NOTE: All drivers using thread actions now have to perform their TSD
sl@0	1254	* manipulation only in their thread action proc. Doing it when
sl@0	1255	* creating their instance structures will collide with the thread
sl@0	1256	* action activity and lead to damaged lists.
sl@0	1257	*/
sl@0	1258
sl@0	1259	statePtr->nextCSPtr = (ChannelState *) NULL;
sl@0	1260	Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
sl@0	1261
sl@0	1262	/*
sl@0	1263	* Install this channel in the first empty standard channel slot, if
sl@0	1264	* the channel was previously closed explicitly.
sl@0	1265	*/
sl@0	1266	#if TCL_INHERIT_STD_CHANNELS
sl@0	1267	if ((tsdPtr->stdinChannel == NULL) &&
sl@0	1268	(tsdPtr->stdinInitialized == 1)) {
sl@0	1269	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
sl@0	1270	Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
sl@0	1271	} else if ((tsdPtr->stdoutChannel == NULL) &&
sl@0	1272	(tsdPtr->stdoutInitialized == 1)) {
sl@0	1273	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
sl@0	1274	Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
sl@0	1275	} else if ((tsdPtr->stderrChannel == NULL) &&
sl@0	1276	(tsdPtr->stderrInitialized == 1)) {
sl@0	1277	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
sl@0	1278	Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
sl@0	1279	}
sl@0	1280	#endif
sl@0	1281	return (Tcl_Channel) chanPtr;
sl@0	1282	}
sl@0	1283
sl@0	1284	/*
sl@0	1285	*----------------------------------------------------------------------
sl@0	1286	*
sl@0	1287	* Tcl_StackChannel --
sl@0	1288	*
sl@0	1289	* Replaces an entry in the hash table for a Tcl_Channel
sl@0	1290	* record. The replacement is a new channel with same name,
sl@0	1291	* it supercedes the replaced channel. Input and output of
sl@0	1292	* the superceded channel is now going through the newly
sl@0	1293	* created channel and allows the arbitrary filtering/manipulation
sl@0	1294	* of the dataflow.
sl@0	1295	*
sl@0	1296	* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
sl@0	1297	* "Trf-Patch for filtering channels"
sl@0	1298	*
sl@0	1299	* Results:
sl@0	1300	* Returns the new Tcl_Channel, which actually contains the
sl@0	1301	* saved information about prevChan.
sl@0	1302	*
sl@0	1303	* Side effects:
sl@0	1304	* A new channel structure is allocated and linked below
sl@0	1305	* the existing channel. The channel operations and client
sl@0	1306	* data of the existing channel are copied down to the newly
sl@0	1307	* created channel, and the current channel has its operations
sl@0	1308	* replaced by the new typePtr.
sl@0	1309	*
sl@0	1310	*----------------------------------------------------------------------
sl@0	1311	*/
sl@0	1312
sl@0	1313	EXPORT_C Tcl_Channel
sl@0	1314	Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
sl@0	1315	Tcl_Interp interp; / The interpreter we are working in */
sl@0	1316	Tcl_ChannelType typePtr; / The channel type record for the new
sl@0	1317	* channel. */
sl@0	1318	ClientData instanceData; /* Instance specific data for the new
sl@0	1319	* channel. */
sl@0	1320	int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
sl@0	1321	* if the channel is readable, writable. */
sl@0	1322	Tcl_Channel prevChan; /* The channel structure to replace */
sl@0	1323	{
sl@0	1324	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	1325	Channel chanPtr, prevChanPtr;
sl@0	1326	ChannelState *statePtr;
sl@0	1327
sl@0	1328	/*
sl@0	1329	* Find the given channel in the list of all channels.
sl@0	1330	* If we don't find it, then it was never registered correctly.
sl@0	1331	*
sl@0	1332	* This operation should occur at the top of a channel stack.
sl@0	1333	*/
sl@0	1334
sl@0	1335	statePtr = (ChannelState *) tsdPtr->firstCSPtr;
sl@0	1336	prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
sl@0	1337
sl@0	1338	while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
sl@0	1339	statePtr = statePtr->nextCSPtr;
sl@0	1340	}
sl@0	1341
sl@0	1342	if (statePtr == NULL) {
sl@0	1343	if (interp) {
sl@0	1344	Tcl_AppendResult(interp, "couldn't find state for channel \"",
sl@0	1345	Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
sl@0	1346	}
sl@0	1347	return (Tcl_Channel) NULL;
sl@0	1348	}
sl@0	1349
sl@0	1350	/*
sl@0	1351	* Here we check if the given "mask" matches the "flags"
sl@0	1352	* of the already existing channel.
sl@0	1353	*
sl@0	1354	* \| - \| R \| W \| RW \|
sl@0	1355	* --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
sl@0	1356	* - \| \| \| \| \|
sl@0	1357	* R \| \| + \| \| + \| The superceding channel is allowed to
sl@0	1358	* W \| \| \| + \| + \| restrict the capabilities of the
sl@0	1359	* RW\| \| + \| + \| + \| superceded one !
sl@0	1360	* --+---+---+---+----+
sl@0	1361	*/
sl@0	1362
sl@0	1363	if ((mask & (statePtr->flags & (TCL_READABLE \| TCL_WRITABLE))) == 0) {
sl@0	1364	if (interp) {
sl@0	1365	Tcl_AppendResult(interp,
sl@0	1366	"reading and writing both disallowed for channel \"",
sl@0	1367	Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
sl@0	1368	}
sl@0	1369	return (Tcl_Channel) NULL;
sl@0	1370	}
sl@0	1371
sl@0	1372	/*
sl@0	1373	* Flush the buffers. This ensures that any data still in them
sl@0	1374	* at this time is not handled by the new transformation. Restrict
sl@0	1375	* this to writable channels. Take care to hide a possible bg-copy
sl@0	1376	* in progress from Tcl_Flush and the CheckForChannelErrors inside.
sl@0	1377	*/
sl@0	1378
sl@0	1379	if ((mask & TCL_WRITABLE) != 0) {
sl@0	1380	CopyState *csPtr;
sl@0	1381
sl@0	1382	csPtr = statePtr->csPtr;
sl@0	1383	statePtr->csPtr = (CopyState*) NULL;
sl@0	1384
sl@0	1385	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
sl@0	1386	statePtr->csPtr = csPtr;
sl@0	1387	if (interp) {
sl@0	1388	Tcl_AppendResult(interp, "could not flush channel \"",
sl@0	1389	Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
sl@0	1390	}
sl@0	1391	return (Tcl_Channel) NULL;
sl@0	1392	}
sl@0	1393
sl@0	1394	statePtr->csPtr = csPtr;
sl@0	1395	}
sl@0	1396	/*
sl@0	1397	* Discard any input in the buffers. They are not yet read by the
sl@0	1398	* user of the channel, so they have to go through the new
sl@0	1399	* transformation before reading. As the buffers contain the
sl@0	1400	* untransformed form their contents are not only useless but actually
sl@0	1401	* distorts our view of the system.
sl@0	1402	*
sl@0	1403	* To preserve the information without having to read them again and
sl@0	1404	* to avoid problems with the location in the channel (seeking might
sl@0	1405	* be impossible) we move the buffers from the common state structure
sl@0	1406	* into the channel itself. We use the buffers in the channel below
sl@0	1407	* the new transformation to hold the data. In the future this allows
sl@0	1408	* us to write transformations which pre-read data and push the unused
sl@0	1409	* part back when they are going away.
sl@0	1410	*/
sl@0	1411
sl@0	1412	if (((mask & TCL_READABLE) != 0) &&
sl@0	1413	(statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
sl@0	1414	/*
sl@0	1415	* Remark: It is possible that the channel buffers contain data from
sl@0	1416	* some earlier push-backs.
sl@0	1417	*/
sl@0	1418
sl@0	1419	statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
sl@0	1420	prevChanPtr->inQueueHead = statePtr->inQueueHead;
sl@0	1421
sl@0	1422	if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
sl@0	1423	prevChanPtr->inQueueTail = statePtr->inQueueTail;
sl@0	1424	}
sl@0	1425
sl@0	1426	statePtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	1427	statePtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	1428	}
sl@0	1429
sl@0	1430	chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
sl@0	1431
sl@0	1432	/*
sl@0	1433	* Save some of the current state into the new structure,
sl@0	1434	* reinitialize the parts which will stay with the transformation.
sl@0	1435	*
sl@0	1436	* Remarks:
sl@0	1437	*/
sl@0	1438
sl@0	1439	chanPtr->state = statePtr;
sl@0	1440	chanPtr->instanceData = instanceData;
sl@0	1441	chanPtr->typePtr = typePtr;
sl@0	1442	chanPtr->downChanPtr = prevChanPtr;
sl@0	1443	chanPtr->upChanPtr = (Channel *) NULL;
sl@0	1444	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	1445	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	1446
sl@0	1447	/*
sl@0	1448	* Place new block at the head of a possibly existing list of previously
sl@0	1449	* stacked channels.
sl@0	1450	*/
sl@0	1451
sl@0	1452	prevChanPtr->upChanPtr = chanPtr;
sl@0	1453	statePtr->topChanPtr = chanPtr;
sl@0	1454
sl@0	1455	return (Tcl_Channel) chanPtr;
sl@0	1456	}
sl@0	1457
sl@0	1458	/*
sl@0	1459	*----------------------------------------------------------------------
sl@0	1460	*
sl@0	1461	* Tcl_UnstackChannel --
sl@0	1462	*
sl@0	1463	* Unstacks an entry in the hash table for a Tcl_Channel
sl@0	1464	* record. This is the reverse to 'Tcl_StackChannel'.
sl@0	1465	*
sl@0	1466	* Results:
sl@0	1467	* A standard Tcl result.
sl@0	1468	*
sl@0	1469	* Side effects:
sl@0	1470	* If TCL_ERROR is returned, the posix error code will be set
sl@0	1471	* with Tcl_SetErrno.
sl@0	1472	*
sl@0	1473	*----------------------------------------------------------------------
sl@0	1474	*/
sl@0	1475
sl@0	1476	EXPORT_C int
sl@0	1477	Tcl_UnstackChannel (interp, chan)
sl@0	1478	Tcl_Interp interp; / The interpreter we are working in */
sl@0	1479	Tcl_Channel chan; /* The channel to unstack */
sl@0	1480	{
sl@0	1481	Channel chanPtr = (Channel ) chan;
sl@0	1482	ChannelState *statePtr = chanPtr->state;
sl@0	1483	int result = 0;
sl@0	1484
sl@0	1485	/*
sl@0	1486	* This operation should occur at the top of a channel stack.
sl@0	1487	*/
sl@0	1488
sl@0	1489	chanPtr = statePtr->topChanPtr;
sl@0	1490
sl@0	1491	if (chanPtr->downChanPtr != (Channel *) NULL) {
sl@0	1492	/*
sl@0	1493	* Instead of manipulating the per-thread / per-interp list/hashtable
sl@0	1494	* of registered channels we wind down the state of the transformation,
sl@0	1495	* and then restore the state of underlying channel into the old
sl@0	1496	* structure.
sl@0	1497	*/
sl@0	1498	Channel *downChanPtr = chanPtr->downChanPtr;
sl@0	1499
sl@0	1500	/*
sl@0	1501	* Flush the buffers. This ensures that any data still in them
sl@0	1502	* at this time _is_ handled by the transformation we are unstacking
sl@0	1503	* right now. Restrict this to writable channels. Take care to hide
sl@0	1504	* a possible bg-copy in progress from Tcl_Flush and the
sl@0	1505	* CheckForChannelErrors inside.
sl@0	1506	*/
sl@0	1507
sl@0	1508	if (statePtr->flags & TCL_WRITABLE) {
sl@0	1509	CopyState* csPtr;
sl@0	1510
sl@0	1511	csPtr = statePtr->csPtr;
sl@0	1512	statePtr->csPtr = (CopyState*) NULL;
sl@0	1513
sl@0	1514	if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
sl@0	1515	statePtr->csPtr = csPtr;
sl@0	1516	if (interp) {
sl@0	1517	Tcl_AppendResult(interp, "could not flush channel \"",
sl@0	1518	Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
sl@0	1519	(char *) NULL);
sl@0	1520	}
sl@0	1521	return TCL_ERROR;
sl@0	1522	}
sl@0	1523
sl@0	1524	statePtr->csPtr = csPtr;
sl@0	1525	}
sl@0	1526
sl@0	1527	/*
sl@0	1528	* Anything in the input queue and the push-back buffers of
sl@0	1529	* the transformation going away is transformed data, but not
sl@0	1530	* yet read. As unstacking means that the caller does not want
sl@0	1531	* to see transformed data any more we have to discard these
sl@0	1532	* bytes. To avoid writing an analogue to 'DiscardInputQueued'
sl@0	1533	* we move the information in the push back buffers to the
sl@0	1534	* input queue and then call 'DiscardInputQueued' on that.
sl@0	1535	*/
sl@0	1536
sl@0	1537	if (((statePtr->flags & TCL_READABLE) != 0) &&
sl@0	1538	((statePtr->inQueueHead != (ChannelBuffer*) NULL) \|\|
sl@0	1539	(chanPtr->inQueueHead != (ChannelBuffer*) NULL))) {
sl@0	1540
sl@0	1541	if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
sl@0	1542	(chanPtr->inQueueHead != (ChannelBuffer*) NULL)) {
sl@0	1543	statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
sl@0	1544	statePtr->inQueueTail = chanPtr->inQueueTail;
sl@0	1545	statePtr->inQueueHead = statePtr->inQueueTail;
sl@0	1546
sl@0	1547	} else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
sl@0	1548	statePtr->inQueueHead = chanPtr->inQueueHead;
sl@0	1549	statePtr->inQueueTail = chanPtr->inQueueTail;
sl@0	1550	}
sl@0	1551
sl@0	1552	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	1553	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	1554
sl@0	1555	DiscardInputQueued (statePtr, 0);
sl@0	1556	}
sl@0	1557
sl@0	1558	statePtr->topChanPtr = downChanPtr;
sl@0	1559	downChanPtr->upChanPtr = (Channel *) NULL;
sl@0	1560
sl@0	1561	/*
sl@0	1562	* Leave this link intact for closeproc
sl@0	1563	* chanPtr->downChanPtr = (Channel *) NULL;
sl@0	1564	*/
sl@0	1565
sl@0	1566	/*
sl@0	1567	* Close and free the channel driver state.
sl@0	1568	*/
sl@0	1569
sl@0	1570	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
sl@0	1571	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
sl@0	1572	interp);
sl@0	1573	} else {
sl@0	1574	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
sl@0	1575	interp, 0);
sl@0	1576	}
sl@0	1577
sl@0	1578	chanPtr->typePtr = NULL;
sl@0	1579	/*
sl@0	1580	* AK: Tcl_NotifyChannel may hold a reference to this block of memory
sl@0	1581	*/
sl@0	1582	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
sl@0	1583	UpdateInterest(downChanPtr);
sl@0	1584
sl@0	1585	if (result != 0) {
sl@0	1586	Tcl_SetErrno(result);
sl@0	1587	return TCL_ERROR;
sl@0	1588	}
sl@0	1589	} else {
sl@0	1590	/*
sl@0	1591	* This channel does not cover another one.
sl@0	1592	* Simply do a close, if necessary.
sl@0	1593	*/
sl@0	1594
sl@0	1595	if (statePtr->refCount <= 0) {
sl@0	1596	if (Tcl_Close(interp, chan) != TCL_OK) {
sl@0	1597	return TCL_ERROR;
sl@0	1598	}
sl@0	1599	}
sl@0	1600	}
sl@0	1601
sl@0	1602	return TCL_OK;
sl@0	1603	}
sl@0	1604
sl@0	1605	/*
sl@0	1606	*----------------------------------------------------------------------
sl@0	1607	*
sl@0	1608	* Tcl_GetStackedChannel --
sl@0	1609	*
sl@0	1610	* Determines whether the specified channel is stacked upon another.
sl@0	1611	*
sl@0	1612	* Results:
sl@0	1613	* NULL if the channel is not stacked upon another one, or a reference
sl@0	1614	* to the channel it is stacked upon. This reference can be used in
sl@0	1615	* queries, but modification is not allowed.
sl@0	1616	*
sl@0	1617	* Side effects:
sl@0	1618	* None.
sl@0	1619	*
sl@0	1620	*----------------------------------------------------------------------
sl@0	1621	*/
sl@0	1622
sl@0	1623	EXPORT_C Tcl_Channel
sl@0	1624	Tcl_GetStackedChannel(chan)
sl@0	1625	Tcl_Channel chan;
sl@0	1626	{
sl@0	1627	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	1628
sl@0	1629	return (Tcl_Channel) chanPtr->downChanPtr;
sl@0	1630	}
sl@0	1631
sl@0	1632	/*
sl@0	1633	*----------------------------------------------------------------------
sl@0	1634	*
sl@0	1635	* Tcl_GetTopChannel --
sl@0	1636	*
sl@0	1637	* Returns the top channel of a channel stack.
sl@0	1638	*
sl@0	1639	* Results:
sl@0	1640	* NULL if the channel is not stacked upon another one, or a reference
sl@0	1641	* to the channel it is stacked upon. This reference can be used in
sl@0	1642	* queries, but modification is not allowed.
sl@0	1643	*
sl@0	1644	* Side effects:
sl@0	1645	* None.
sl@0	1646	*
sl@0	1647	*----------------------------------------------------------------------
sl@0	1648	*/
sl@0	1649
sl@0	1650	EXPORT_C Tcl_Channel
sl@0	1651	Tcl_GetTopChannel(chan)
sl@0	1652	Tcl_Channel chan;
sl@0	1653	{
sl@0	1654	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	1655
sl@0	1656	return (Tcl_Channel) chanPtr->state->topChanPtr;
sl@0	1657	}
sl@0	1658
sl@0	1659	/*
sl@0	1660	*----------------------------------------------------------------------
sl@0	1661	*
sl@0	1662	* Tcl_GetChannelInstanceData --
sl@0	1663	*
sl@0	1664	* Returns the client data associated with a channel.
sl@0	1665	*
sl@0	1666	* Results:
sl@0	1667	* The client data.
sl@0	1668	*
sl@0	1669	* Side effects:
sl@0	1670	* None.
sl@0	1671	*
sl@0	1672	*----------------------------------------------------------------------
sl@0	1673	*/
sl@0	1674
sl@0	1675	EXPORT_C ClientData
sl@0	1676	Tcl_GetChannelInstanceData(chan)
sl@0	1677	Tcl_Channel chan; /* Channel for which to return client data. */
sl@0	1678	{
sl@0	1679	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	1680
sl@0	1681	return chanPtr->instanceData;
sl@0	1682	}
sl@0	1683
sl@0	1684	/*
sl@0	1685	*----------------------------------------------------------------------
sl@0	1686	*
sl@0	1687	* Tcl_GetChannelThread --
sl@0	1688	*
sl@0	1689	* Given a channel structure, returns the thread managing it.
sl@0	1690	* TIP #10
sl@0	1691	*
sl@0	1692	* Results:
sl@0	1693	* Returns the id of the thread managing the channel.
sl@0	1694	*
sl@0	1695	* Side effects:
sl@0	1696	* None.
sl@0	1697	*
sl@0	1698	*----------------------------------------------------------------------
sl@0	1699	*/
sl@0	1700
sl@0	1701	EXPORT_C Tcl_ThreadId
sl@0	1702	Tcl_GetChannelThread(chan)
sl@0	1703	Tcl_Channel chan; /* The channel to return managing thread for. */
sl@0	1704	{
sl@0	1705	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	1706
sl@0	1707	return chanPtr->state->managingThread;
sl@0	1708	}
sl@0	1709
sl@0	1710	/*
sl@0	1711	*----------------------------------------------------------------------
sl@0	1712	*
sl@0	1713	* Tcl_GetChannelType --
sl@0	1714	*
sl@0	1715	* Given a channel structure, returns the channel type structure.
sl@0	1716	*
sl@0	1717	* Results:
sl@0	1718	* Returns a pointer to the channel type structure.
sl@0	1719	*
sl@0	1720	* Side effects:
sl@0	1721	* None.
sl@0	1722	*
sl@0	1723	*----------------------------------------------------------------------
sl@0	1724	*/
sl@0	1725
sl@0	1726	EXPORT_C Tcl_ChannelType *
sl@0	1727	Tcl_GetChannelType(chan)
sl@0	1728	Tcl_Channel chan; /* The channel to return type for. */
sl@0	1729	{
sl@0	1730	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	1731
sl@0	1732	return chanPtr->typePtr;
sl@0	1733	}
sl@0	1734
sl@0	1735	/*
sl@0	1736	*----------------------------------------------------------------------
sl@0	1737	*
sl@0	1738	* Tcl_GetChannelMode --
sl@0	1739	*
sl@0	1740	* Computes a mask indicating whether the channel is open for
sl@0	1741	* reading and writing.
sl@0	1742	*
sl@0	1743	* Results:
sl@0	1744	* An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
sl@0	1745	*
sl@0	1746	* Side effects:
sl@0	1747	* None.
sl@0	1748	*
sl@0	1749	*----------------------------------------------------------------------
sl@0	1750	*/
sl@0	1751
sl@0	1752	EXPORT_C int
sl@0	1753	Tcl_GetChannelMode(chan)
sl@0	1754	Tcl_Channel chan; /* The channel for which the mode is
sl@0	1755	* being computed. */
sl@0	1756	{
sl@0	1757	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	1758	/* State of actual channel. */
sl@0	1759
sl@0	1760	return (statePtr->flags & (TCL_READABLE \| TCL_WRITABLE));
sl@0	1761	}
sl@0	1762
sl@0	1763	/*
sl@0	1764	*----------------------------------------------------------------------
sl@0	1765	*
sl@0	1766	* Tcl_GetChannelName --
sl@0	1767	*
sl@0	1768	* Returns the string identifying the channel name.
sl@0	1769	*
sl@0	1770	* Results:
sl@0	1771	* The string containing the channel name. This memory is
sl@0	1772	* owned by the generic layer and should not be modified by
sl@0	1773	* the caller.
sl@0	1774	*
sl@0	1775	* Side effects:
sl@0	1776	* None.
sl@0	1777	*
sl@0	1778	*----------------------------------------------------------------------
sl@0	1779	*/
sl@0	1780
sl@0	1781	EXPORT_C CONST char *
sl@0	1782	Tcl_GetChannelName(chan)
sl@0	1783	Tcl_Channel chan; /* The channel for which to return the name. */
sl@0	1784	{
sl@0	1785	ChannelState statePtr; / State of actual channel. */
sl@0	1786
sl@0	1787	statePtr = ((Channel *) chan)->state;
sl@0	1788	return statePtr->channelName;
sl@0	1789	}
sl@0	1790
sl@0	1791	/*
sl@0	1792	*----------------------------------------------------------------------
sl@0	1793	*
sl@0	1794	* Tcl_GetChannelHandle --
sl@0	1795	*
sl@0	1796	* Returns an OS handle associated with a channel.
sl@0	1797	*
sl@0	1798	* Results:
sl@0	1799	* Returns TCL_OK and places the handle in handlePtr, or returns
sl@0	1800	* TCL_ERROR on failure.
sl@0	1801	*
sl@0	1802	* Side effects:
sl@0	1803	* None.
sl@0	1804	*
sl@0	1805	*----------------------------------------------------------------------
sl@0	1806	*/
sl@0	1807
sl@0	1808	EXPORT_C int
sl@0	1809	Tcl_GetChannelHandle(chan, direction, handlePtr)
sl@0	1810	Tcl_Channel chan; /* The channel to get file from. */
sl@0	1811	int direction; /* TCL_WRITABLE or TCL_READABLE. */
sl@0	1812	ClientData handlePtr; / Where to store handle */
sl@0	1813	{
sl@0	1814	Channel chanPtr; / The actual channel. */
sl@0	1815	ClientData handle;
sl@0	1816	int result;
sl@0	1817
sl@0	1818	chanPtr = ((Channel *) chan)->state->bottomChanPtr;
sl@0	1819	result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
sl@0	1820	direction, &handle);
sl@0	1821	if (handlePtr) {
sl@0	1822	*handlePtr = handle;
sl@0	1823	}
sl@0	1824	return result;
sl@0	1825	}
sl@0	1826
sl@0	1827	/*
sl@0	1828	*---------------------------------------------------------------------------
sl@0	1829	*
sl@0	1830	* AllocChannelBuffer --
sl@0	1831	*
sl@0	1832	* A channel buffer has BUFFER_PADDING bytes extra at beginning to
sl@0	1833	* hold any bytes of a native-encoding character that got split by
sl@0	1834	* the end of the previous buffer and need to be moved to the
sl@0	1835	* beginning of the next buffer to make a contiguous string so it
sl@0	1836	* can be converted to UTF-8.
sl@0	1837	*
sl@0	1838	* A channel buffer has BUFFER_PADDING bytes extra at the end to
sl@0	1839	* hold any bytes of a native-encoding character (generated from a
sl@0	1840	* UTF-8 character) that overflow past the end of the buffer and
sl@0	1841	* need to be moved to the next buffer.
sl@0	1842	*
sl@0	1843	* Results:
sl@0	1844	* A newly allocated channel buffer.
sl@0	1845	*
sl@0	1846	* Side effects:
sl@0	1847	* None.
sl@0	1848	*
sl@0	1849	*---------------------------------------------------------------------------
sl@0	1850	*/
sl@0	1851
sl@0	1852	static ChannelBuffer *
sl@0	1853	AllocChannelBuffer(length)
sl@0	1854	int length; /* Desired length of channel buffer. */
sl@0	1855	{
sl@0	1856	ChannelBuffer *bufPtr;
sl@0	1857	int n;
sl@0	1858
sl@0	1859	n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
sl@0	1860	bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
sl@0	1861	bufPtr->nextAdded = BUFFER_PADDING;
sl@0	1862	bufPtr->nextRemoved = BUFFER_PADDING;
sl@0	1863	bufPtr->bufLength = length + BUFFER_PADDING;
sl@0	1864	bufPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	1865	return bufPtr;
sl@0	1866	}
sl@0	1867
sl@0	1868	/*
sl@0	1869	*----------------------------------------------------------------------
sl@0	1870	*
sl@0	1871	* RecycleBuffer --
sl@0	1872	*
sl@0	1873	* Helper function to recycle input and output buffers. Ensures
sl@0	1874	* that two input buffers are saved (one in the input queue and
sl@0	1875	* another in the saveInBufPtr field) and that curOutPtr is set
sl@0	1876	* to a buffer. Only if these conditions are met is the buffer
sl@0	1877	* freed to the OS.
sl@0	1878	*
sl@0	1879	* Results:
sl@0	1880	* None.
sl@0	1881	*
sl@0	1882	* Side effects:
sl@0	1883	* May free a buffer to the OS.
sl@0	1884	*
sl@0	1885	*----------------------------------------------------------------------
sl@0	1886	*/
sl@0	1887
sl@0	1888	static void
sl@0	1889	RecycleBuffer(statePtr, bufPtr, mustDiscard)
sl@0	1890	ChannelState statePtr; / ChannelState in which to recycle buffers. */
sl@0	1891	ChannelBuffer bufPtr; / The buffer to recycle. */
sl@0	1892	int mustDiscard; /* If nonzero, free the buffer to the
sl@0	1893	* OS, always. */
sl@0	1894	{
sl@0	1895	/*
sl@0	1896	* Do we have to free the buffer to the OS?
sl@0	1897	*/
sl@0	1898
sl@0	1899	if (mustDiscard) {
sl@0	1900	ckfree((char *) bufPtr);
sl@0	1901	return;
sl@0	1902	}
sl@0	1903
sl@0	1904	/*
sl@0	1905	* Only save buffers which are at least as big as the requested
sl@0	1906	* buffersize for the channel. This is to honor dynamic changes
sl@0	1907	* of the buffersize made by the user.
sl@0	1908	*/
sl@0	1909
sl@0	1910	if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
sl@0	1911	ckfree((char *) bufPtr);
sl@0	1912	return;
sl@0	1913	}
sl@0	1914
sl@0	1915	/*
sl@0	1916	* Only save buffers for the input queue if the channel is readable.
sl@0	1917	*/
sl@0	1918
sl@0	1919	if (statePtr->flags & TCL_READABLE) {
sl@0	1920	if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	1921	statePtr->inQueueHead = bufPtr;
sl@0	1922	statePtr->inQueueTail = bufPtr;
sl@0	1923	goto keepit;
sl@0	1924	}
sl@0	1925	if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
sl@0	1926	statePtr->saveInBufPtr = bufPtr;
sl@0	1927	goto keepit;
sl@0	1928	}
sl@0	1929	}
sl@0	1930
sl@0	1931	/*
sl@0	1932	* Only save buffers for the output queue if the channel is writable.
sl@0	1933	*/
sl@0	1934
sl@0	1935	if (statePtr->flags & TCL_WRITABLE) {
sl@0	1936	if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
sl@0	1937	statePtr->curOutPtr = bufPtr;
sl@0	1938	goto keepit;
sl@0	1939	}
sl@0	1940	}
sl@0	1941
sl@0	1942	/*
sl@0	1943	* If we reached this code we return the buffer to the OS.
sl@0	1944	*/
sl@0	1945
sl@0	1946	ckfree((char *) bufPtr);
sl@0	1947	return;
sl@0	1948
sl@0	1949	keepit:
sl@0	1950	bufPtr->nextRemoved = BUFFER_PADDING;
sl@0	1951	bufPtr->nextAdded = BUFFER_PADDING;
sl@0	1952	bufPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	1953	}
sl@0	1954
sl@0	1955	/*
sl@0	1956	*----------------------------------------------------------------------
sl@0	1957	*
sl@0	1958	* DiscardOutputQueued --
sl@0	1959	*
sl@0	1960	* Discards all output queued in the output queue of a channel.
sl@0	1961	*
sl@0	1962	* Results:
sl@0	1963	* None.
sl@0	1964	*
sl@0	1965	* Side effects:
sl@0	1966	* Recycles buffers.
sl@0	1967	*
sl@0	1968	*----------------------------------------------------------------------
sl@0	1969	*/
sl@0	1970
sl@0	1971	static void
sl@0	1972	DiscardOutputQueued(statePtr)
sl@0	1973	ChannelState statePtr; / ChannelState for which to discard output. */
sl@0	1974	{
sl@0	1975	ChannelBuffer *bufPtr;
sl@0	1976
sl@0	1977	while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
sl@0	1978	bufPtr = statePtr->outQueueHead;
sl@0	1979	statePtr->outQueueHead = bufPtr->nextPtr;
sl@0	1980	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	1981	}
sl@0	1982	statePtr->outQueueHead = (ChannelBuffer *) NULL;
sl@0	1983	statePtr->outQueueTail = (ChannelBuffer *) NULL;
sl@0	1984	}
sl@0	1985
sl@0	1986	/*
sl@0	1987	*----------------------------------------------------------------------
sl@0	1988	*
sl@0	1989	* CheckForDeadChannel --
sl@0	1990	*
sl@0	1991	* This function checks is a given channel is Dead.
sl@0	1992	* (A channel that has been closed but not yet deallocated.)
sl@0	1993	*
sl@0	1994	* Results:
sl@0	1995	* True (1) if channel is Dead, False (0) if channel is Ok
sl@0	1996	*
sl@0	1997	* Side effects:
sl@0	1998	* None
sl@0	1999	*
sl@0	2000	*----------------------------------------------------------------------
sl@0	2001	*/
sl@0	2002
sl@0	2003	static int
sl@0	2004	CheckForDeadChannel(interp, statePtr)
sl@0	2005	Tcl_Interp interp; / For error reporting (can be NULL) */
sl@0	2006	ChannelState statePtr; / The channel state to check. */
sl@0	2007	{
sl@0	2008	if (statePtr->flags & CHANNEL_DEAD) {
sl@0	2009	Tcl_SetErrno(EINVAL);
sl@0	2010	if (interp) {
sl@0	2011	Tcl_AppendResult(interp,
sl@0	2012	"unable to access channel: invalid channel",
sl@0	2013	(char *) NULL);
sl@0	2014	}
sl@0	2015	return 1;
sl@0	2016	}
sl@0	2017	return 0;
sl@0	2018	}
sl@0	2019
sl@0	2020	/*
sl@0	2021	*----------------------------------------------------------------------
sl@0	2022	*
sl@0	2023	* FlushChannel --
sl@0	2024	*
sl@0	2025	* This function flushes as much of the queued output as is possible
sl@0	2026	* now. If calledFromAsyncFlush is nonzero, it is being called in an
sl@0	2027	* event handler to flush channel output asynchronously.
sl@0	2028	*
sl@0	2029	* Results:
sl@0	2030	* 0 if successful, else the error code that was returned by the
sl@0	2031	* channel type operation.
sl@0	2032	*
sl@0	2033	* Side effects:
sl@0	2034	* May produce output on a channel. May block indefinitely if the
sl@0	2035	* channel is synchronous. May schedule an async flush on the channel.
sl@0	2036	* May recycle memory for buffers in the output queue.
sl@0	2037	*
sl@0	2038	*----------------------------------------------------------------------
sl@0	2039	*/
sl@0	2040
sl@0	2041	static int
sl@0	2042	FlushChannel(interp, chanPtr, calledFromAsyncFlush)
sl@0	2043	Tcl_Interp interp; / For error reporting during close. */
sl@0	2044	Channel chanPtr; / The channel to flush on. */
sl@0	2045	int calledFromAsyncFlush; /* If nonzero then we are being
sl@0	2046	* called from an asynchronous
sl@0	2047	* flush callback. */
sl@0	2048	{
sl@0	2049	ChannelState *statePtr = chanPtr->state;
sl@0	2050	/* State of the channel stack. */
sl@0	2051	ChannelBuffer bufPtr; / Iterates over buffered output
sl@0	2052	* queue. */
sl@0	2053	int toWrite; /* Amount of output data in current
sl@0	2054	* buffer available to be written. */
sl@0	2055	int written; /* Amount of output data actually
sl@0	2056	* written in current round. */
sl@0	2057	int errorCode = 0; /* Stores POSIX error codes from
sl@0	2058	* channel driver operations. */
sl@0	2059	int wroteSome = 0; /* Set to one if any data was
sl@0	2060	* written to the driver. */
sl@0	2061
sl@0	2062	/*
sl@0	2063	* Prevent writing on a dead channel -- a channel that has been closed
sl@0	2064	* but not yet deallocated. This can occur if the exit handler for the
sl@0	2065	* channel deallocation runs before all channels are deregistered in
sl@0	2066	* all interpreters.
sl@0	2067	*/
sl@0	2068
sl@0	2069	if (CheckForDeadChannel(interp, statePtr)) return -1;
sl@0	2070
sl@0	2071	/*
sl@0	2072	* Loop over the queued buffers and attempt to flush as
sl@0	2073	* much as possible of the queued output to the channel.
sl@0	2074	*/
sl@0	2075
sl@0	2076	while (1) {
sl@0	2077
sl@0	2078	/*
sl@0	2079	* If the queue is empty and there is a ready current buffer, OR if
sl@0	2080	* the current buffer is full, then move the current buffer to the
sl@0	2081	* queue.
sl@0	2082	*/
sl@0	2083
sl@0	2084	if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
sl@0	2085	(statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
sl@0	2086	\|\| ((statePtr->flags & BUFFER_READY) &&
sl@0	2087	(statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
sl@0	2088	statePtr->flags &= (~(BUFFER_READY));
sl@0	2089	statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	2090	if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
sl@0	2091	statePtr->outQueueHead = statePtr->curOutPtr;
sl@0	2092	} else {
sl@0	2093	statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
sl@0	2094	}
sl@0	2095	statePtr->outQueueTail = statePtr->curOutPtr;
sl@0	2096	statePtr->curOutPtr = (ChannelBuffer *) NULL;
sl@0	2097	}
sl@0	2098	bufPtr = statePtr->outQueueHead;
sl@0	2099
sl@0	2100	/*
sl@0	2101	* If we are not being called from an async flush and an async
sl@0	2102	* flush is active, we just return without producing any output.
sl@0	2103	*/
sl@0	2104
sl@0	2105	if ((!calledFromAsyncFlush) &&
sl@0	2106	(statePtr->flags & BG_FLUSH_SCHEDULED)) {
sl@0	2107	return 0;
sl@0	2108	}
sl@0	2109
sl@0	2110	/*
sl@0	2111	* If the output queue is still empty, break out of the while loop.
sl@0	2112	*/
sl@0	2113
sl@0	2114	if (bufPtr == (ChannelBuffer *) NULL) {
sl@0	2115	break; /* Out of the "while (1)". */
sl@0	2116	}
sl@0	2117
sl@0	2118	/*
sl@0	2119	* Produce the output on the channel.
sl@0	2120	*/
sl@0	2121
sl@0	2122	toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
sl@0	2123	written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
sl@0	2124	bufPtr->buf + bufPtr->nextRemoved, toWrite,
sl@0	2125	&errorCode);
sl@0	2126
sl@0	2127	/*
sl@0	2128	* If the write failed completely attempt to start the asynchronous
sl@0	2129	* flush mechanism and break out of this loop - do not attempt to
sl@0	2130	* write any more output at this time.
sl@0	2131	*/
sl@0	2132
sl@0	2133	if (written < 0) {
sl@0	2134
sl@0	2135	/*
sl@0	2136	* If the last attempt to write was interrupted, simply retry.
sl@0	2137	*/
sl@0	2138
sl@0	2139	if (errorCode == EINTR) {
sl@0	2140	errorCode = 0;
sl@0	2141	continue;
sl@0	2142	}
sl@0	2143
sl@0	2144	/*
sl@0	2145	* If the channel is non-blocking and we would have blocked,
sl@0	2146	* start a background flushing handler and break out of the loop.
sl@0	2147	*/
sl@0	2148
sl@0	2149	if ((errorCode == EWOULDBLOCK) \|\| (errorCode == EAGAIN)) {
sl@0	2150	/*
sl@0	2151	* This used to check for CHANNEL_NONBLOCKING, and panic
sl@0	2152	* if the channel was blocking. However, it appears
sl@0	2153	* that setting stdin to -blocking 0 has some effect on
sl@0	2154	* the stdout when it's a tty channel (dup'ed underneath)
sl@0	2155	*/
sl@0	2156	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
sl@0	2157	statePtr->flags \|= BG_FLUSH_SCHEDULED;
sl@0	2158	UpdateInterest(chanPtr);
sl@0	2159	}
sl@0	2160	errorCode = 0;
sl@0	2161	break;
sl@0	2162	}
sl@0	2163
sl@0	2164	/*
sl@0	2165	* Decide whether to report the error upwards or defer it.
sl@0	2166	*/
sl@0	2167
sl@0	2168	if (calledFromAsyncFlush) {
sl@0	2169	if (statePtr->unreportedError == 0) {
sl@0	2170	statePtr->unreportedError = errorCode;
sl@0	2171	}
sl@0	2172	} else {
sl@0	2173	Tcl_SetErrno(errorCode);
sl@0	2174	if (interp != NULL) {
sl@0	2175
sl@0	2176	/*
sl@0	2177	* Casting away CONST here is safe because the
sl@0	2178	* TCL_VOLATILE flag guarantees CONST treatment
sl@0	2179	* of the Posix error string.
sl@0	2180	*/
sl@0	2181
sl@0	2182	Tcl_SetResult(interp,
sl@0	2183	(char *) Tcl_PosixError(interp), TCL_VOLATILE);
sl@0	2184	}
sl@0	2185	}
sl@0	2186
sl@0	2187	/*
sl@0	2188	* When we get an error we throw away all the output
sl@0	2189	* currently queued.
sl@0	2190	*/
sl@0	2191
sl@0	2192	DiscardOutputQueued(statePtr);
sl@0	2193	continue;
sl@0	2194	} else {
sl@0	2195	wroteSome = 1;
sl@0	2196	}
sl@0	2197
sl@0	2198	bufPtr->nextRemoved += written;
sl@0	2199
sl@0	2200	/*
sl@0	2201	* If this buffer is now empty, recycle it.
sl@0	2202	*/
sl@0	2203
sl@0	2204	if (bufPtr->nextRemoved == bufPtr->nextAdded) {
sl@0	2205	statePtr->outQueueHead = bufPtr->nextPtr;
sl@0	2206	if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
sl@0	2207	statePtr->outQueueTail = (ChannelBuffer *) NULL;
sl@0	2208	}
sl@0	2209	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	2210	}
sl@0	2211	} /* Closes "while (1)". */
sl@0	2212
sl@0	2213	/*
sl@0	2214	* If we wrote some data while flushing in the background, we are done.
sl@0	2215	* We can't finish the background flush until we run out of data and
sl@0	2216	* the channel becomes writable again. This ensures that all of the
sl@0	2217	* pending data has been flushed at the system level.
sl@0	2218	*/
sl@0	2219
sl@0	2220	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
sl@0	2221	if (wroteSome) {
sl@0	2222	return errorCode;
sl@0	2223	} else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
sl@0	2224	statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
sl@0	2225	(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
sl@0	2226	statePtr->interestMask);
sl@0	2227	}
sl@0	2228	}
sl@0	2229
sl@0	2230	/*
sl@0	2231	* If the channel is flagged as closed, delete it when the refCount
sl@0	2232	* drops to zero, the output queue is empty and there is no output
sl@0	2233	* in the current output buffer.
sl@0	2234	*/
sl@0	2235
sl@0	2236	if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
sl@0	2237	(statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
sl@0	2238	((statePtr->curOutPtr == (ChannelBuffer *) NULL) \|\|
sl@0	2239	(statePtr->curOutPtr->nextAdded ==
sl@0	2240	statePtr->curOutPtr->nextRemoved))) {
sl@0	2241	return CloseChannel(interp, chanPtr, errorCode);
sl@0	2242	}
sl@0	2243	return errorCode;
sl@0	2244	}
sl@0	2245
sl@0	2246	/*
sl@0	2247	*----------------------------------------------------------------------
sl@0	2248	*
sl@0	2249	* CloseChannel --
sl@0	2250	*
sl@0	2251	* Utility procedure to close a channel and free associated resources.
sl@0	2252	*
sl@0	2253	* If the channel was stacked, then the it will copy the necessary
sl@0	2254	* elements of the NEXT channel into the TOP channel, in essence
sl@0	2255	* unstacking the channel. The NEXT channel will then be freed.
sl@0	2256	*
sl@0	2257	* If the channel was not stacked, then we will free all the bits
sl@0	2258	* for the TOP channel, including the data structure itself.
sl@0	2259	*
sl@0	2260	* Results:
sl@0	2261	* 1 if the channel was stacked, 0 otherwise.
sl@0	2262	*
sl@0	2263	* Side effects:
sl@0	2264	* May close the actual channel; may free memory.
sl@0	2265	* May change the value of errno.
sl@0	2266	*
sl@0	2267	*----------------------------------------------------------------------
sl@0	2268	*/
sl@0	2269
sl@0	2270	static int
sl@0	2271	CloseChannel(interp, chanPtr, errorCode)
sl@0	2272	Tcl_Interp interp; / For error reporting. */
sl@0	2273	Channel chanPtr; / The channel to close. */
sl@0	2274	int errorCode; /* Status of operation so far. */
sl@0	2275	{
sl@0	2276	int result = 0; /* Of calling driver close
sl@0	2277	* operation. */
sl@0	2278	ChannelState statePtr; / state of the channel stack. */
sl@0	2279	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2280
sl@0	2281	if (chanPtr == NULL) {
sl@0	2282	return result;
sl@0	2283	}
sl@0	2284	statePtr = chanPtr->state;
sl@0	2285
sl@0	2286	/*
sl@0	2287	* No more input can be consumed so discard any leftover input.
sl@0	2288	*/
sl@0	2289
sl@0	2290	DiscardInputQueued(statePtr, 1);
sl@0	2291
sl@0	2292	/*
sl@0	2293	* Discard a leftover buffer in the current output buffer field.
sl@0	2294	*/
sl@0	2295
sl@0	2296	if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
sl@0	2297	ckfree((char *) statePtr->curOutPtr);
sl@0	2298	statePtr->curOutPtr = (ChannelBuffer *) NULL;
sl@0	2299	}
sl@0	2300
sl@0	2301	/*
sl@0	2302	* The caller guarantees that there are no more buffers
sl@0	2303	* queued for output.
sl@0	2304	*/
sl@0	2305
sl@0	2306	if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
sl@0	2307	panic("TclFlush, closed channel: queued output left");
sl@0	2308	}
sl@0	2309
sl@0	2310	/*
sl@0	2311	* If the EOF character is set in the channel, append that to the
sl@0	2312	* output device.
sl@0	2313	*/
sl@0	2314
sl@0	2315	if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
sl@0	2316	int dummy;
sl@0	2317	char c;
sl@0	2318
sl@0	2319	c = (char) statePtr->outEofChar;
sl@0	2320	(chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
sl@0	2321	}
sl@0	2322
sl@0	2323	/*
sl@0	2324	* Remove this channel from of the list of all channels.
sl@0	2325	*/
sl@0	2326	Tcl_CutChannel((Tcl_Channel) chanPtr);
sl@0	2327
sl@0	2328	/*
sl@0	2329	* Close and free the channel driver state.
sl@0	2330	*/
sl@0	2331
sl@0	2332	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
sl@0	2333	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
sl@0	2334	} else {
sl@0	2335	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
sl@0	2336	0);
sl@0	2337	}
sl@0	2338
sl@0	2339	/*
sl@0	2340	* Some resources can be cleared only if the bottom channel
sl@0	2341	* in a stack is closed. All the other channels in the stack
sl@0	2342	* are not allowed to remove.
sl@0	2343	*/
sl@0	2344
sl@0	2345	if (chanPtr == statePtr->bottomChanPtr) {
sl@0	2346	if (statePtr->channelName != (char *) NULL) {
sl@0	2347	ckfree((char *) statePtr->channelName);
sl@0	2348	statePtr->channelName = NULL;
sl@0	2349	}
sl@0	2350
sl@0	2351	Tcl_FreeEncoding(statePtr->encoding);
sl@0	2352	if (statePtr->outputStage != NULL) {
sl@0	2353	ckfree((char *) statePtr->outputStage);
sl@0	2354	statePtr->outputStage = (char *) NULL;
sl@0	2355	}
sl@0	2356	}
sl@0	2357
sl@0	2358	/*
sl@0	2359	* If we are being called synchronously, report either
sl@0	2360	* any latent error on the channel or the current error.
sl@0	2361	*/
sl@0	2362
sl@0	2363	if (statePtr->unreportedError != 0) {
sl@0	2364	errorCode = statePtr->unreportedError;
sl@0	2365	}
sl@0	2366	if (errorCode == 0) {
sl@0	2367	errorCode = result;
sl@0	2368	if (errorCode != 0) {
sl@0	2369	Tcl_SetErrno(errorCode);
sl@0	2370	}
sl@0	2371	}
sl@0	2372
sl@0	2373	/*
sl@0	2374	* Cancel any outstanding timer.
sl@0	2375	*/
sl@0	2376
sl@0	2377	Tcl_DeleteTimerHandler(statePtr->timer);
sl@0	2378
sl@0	2379	/*
sl@0	2380	* Mark the channel as deleted by clearing the type structure.
sl@0	2381	*/
sl@0	2382
sl@0	2383	if (chanPtr->downChanPtr != (Channel *) NULL) {
sl@0	2384	Channel *downChanPtr = chanPtr->downChanPtr;
sl@0	2385
sl@0	2386	statePtr->nextCSPtr = tsdPtr->firstCSPtr;
sl@0	2387	tsdPtr->firstCSPtr = statePtr;
sl@0	2388
sl@0	2389	statePtr->topChanPtr = downChanPtr;
sl@0	2390	downChanPtr->upChanPtr = (Channel *) NULL;
sl@0	2391	chanPtr->typePtr = NULL;
sl@0	2392
sl@0	2393	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
sl@0	2394	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
sl@0	2395	}
sl@0	2396
sl@0	2397	/*
sl@0	2398	* There is only the TOP Channel, so we free the remaining
sl@0	2399	* pointers we have and then ourselves. Since this is the
sl@0	2400	* last of the channels in the stack, make sure to free the
sl@0	2401	* ChannelState structure associated with it. We use
sl@0	2402	* Tcl_EventuallyFree to allow for any last
sl@0	2403	*/
sl@0	2404	chanPtr->typePtr = NULL;
sl@0	2405
sl@0	2406	Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
sl@0	2407	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
sl@0	2408
sl@0	2409	return errorCode;
sl@0	2410	}
sl@0	2411
sl@0	2412	/*
sl@0	2413	*----------------------------------------------------------------------
sl@0	2414	*
sl@0	2415	* Tcl_CutChannel --
sl@0	2416	*
sl@0	2417	* Removes a channel from the (thread-)global list of all channels
sl@0	2418	* (in that thread). This is actually the statePtr for the stack
sl@0	2419	* of channel.
sl@0	2420	*
sl@0	2421	* Results:
sl@0	2422	* Nothing.
sl@0	2423	*
sl@0	2424	* Side effects:
sl@0	2425	* Resets the field 'nextCSPtr' of the specified channel state to NULL.
sl@0	2426	*
sl@0	2427	* NOTE:
sl@0	2428	* The channel to cut out of the list must not be referenced
sl@0	2429	* in any interpreter. This is something this procedure cannot
sl@0	2430	* check (despite the refcount) because the caller usually wants
sl@0	2431	* fiddle with the channel (like transfering it to a different
sl@0	2432	* thread) and thus keeps the refcount artifically high to prevent
sl@0	2433	* its destruction.
sl@0	2434	*
sl@0	2435	*----------------------------------------------------------------------
sl@0	2436	*/
sl@0	2437
sl@0	2438	EXPORT_C void
sl@0	2439	Tcl_CutChannel(chan)
sl@0	2440	Tcl_Channel chan; /* The channel being removed. Must
sl@0	2441	* not be referenced in any
sl@0	2442	* interpreter. */
sl@0	2443	{
sl@0	2444	ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2445	ChannelState prevCSPtr; / Preceding channel state in list of
sl@0	2446	* all states - used to splice a
sl@0	2447	* channel out of the list on close. */
sl@0	2448	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	2449	/* state of the channel stack. */
sl@0	2450	Tcl_DriverThreadActionProc *threadActionProc;
sl@0	2451
sl@0	2452	/*
sl@0	2453	* Remove this channel from of the list of all channels
sl@0	2454	* (in the current thread).
sl@0	2455	*/
sl@0	2456
sl@0	2457	if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
sl@0	2458	tsdPtr->firstCSPtr = statePtr->nextCSPtr;
sl@0	2459	} else {
sl@0	2460	for (prevCSPtr = tsdPtr->firstCSPtr;
sl@0	2461	prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
sl@0	2462	prevCSPtr = prevCSPtr->nextCSPtr) {
sl@0	2463	/* Empty loop body. */
sl@0	2464	}
sl@0	2465	if (prevCSPtr == (ChannelState *) NULL) {
sl@0	2466	panic("FlushChannel: damaged channel list");
sl@0	2467	}
sl@0	2468	prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
sl@0	2469	}
sl@0	2470
sl@0	2471	statePtr->nextCSPtr = (ChannelState *) NULL;
sl@0	2472
sl@0	2473	/* TIP #218, Channel Thread Actions */
sl@0	2474	threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
sl@0	2475	if (threadActionProc != NULL) {
sl@0	2476	(*threadActionProc) (Tcl_GetChannelInstanceData(chan),
sl@0	2477	TCL_CHANNEL_THREAD_REMOVE);
sl@0	2478	}
sl@0	2479	}
sl@0	2480
sl@0	2481	/*
sl@0	2482	*----------------------------------------------------------------------
sl@0	2483	*
sl@0	2484	* Tcl_SpliceChannel --
sl@0	2485	*
sl@0	2486	* Adds a channel to the (thread-)global list of all channels
sl@0	2487	* (in that thread). Expects that the field 'nextChanPtr' in
sl@0	2488	* the channel is set to NULL.
sl@0	2489	*
sl@0	2490	* Results:
sl@0	2491	* Nothing.
sl@0	2492	*
sl@0	2493	* Side effects:
sl@0	2494	* Nothing.
sl@0	2495	*
sl@0	2496	* NOTE:
sl@0	2497	* The channel to splice into the list must not be referenced in any
sl@0	2498	* interpreter. This is something this procedure cannot check
sl@0	2499	* (despite the refcount) because the caller usually wants figgle
sl@0	2500	* with the channel (like transfering it to a different thread)
sl@0	2501	* and thus keeps the refcount artifically high to prevent its
sl@0	2502	* destruction.
sl@0	2503	*
sl@0	2504	*----------------------------------------------------------------------
sl@0	2505	*/
sl@0	2506
sl@0	2507	EXPORT_C void
sl@0	2508	Tcl_SpliceChannel(chan)
sl@0	2509	Tcl_Channel chan; /* The channel being added. Must
sl@0	2510	* not be referenced in any
sl@0	2511	* interpreter. */
sl@0	2512	{
sl@0	2513	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2514	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	2515	Tcl_DriverThreadActionProc *threadActionProc;
sl@0	2516
sl@0	2517	if (statePtr->nextCSPtr != (ChannelState *) NULL) {
sl@0	2518	panic("Tcl_SpliceChannel: trying to add channel used in different list");
sl@0	2519	}
sl@0	2520
sl@0	2521	statePtr->nextCSPtr = tsdPtr->firstCSPtr;
sl@0	2522	tsdPtr->firstCSPtr = statePtr;
sl@0	2523
sl@0	2524	/*
sl@0	2525	* TIP #10. Mark the current thread as the new one managing this
sl@0	2526	* channel. Note: 'Tcl_GetCurrentThread' returns sensible
sl@0	2527	* values even for a non-threaded core.
sl@0	2528	*/
sl@0	2529
sl@0	2530	statePtr->managingThread = Tcl_GetCurrentThread ();
sl@0	2531
sl@0	2532	/* TIP #218, Channel Thread Actions */
sl@0	2533	threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
sl@0	2534	if (threadActionProc != NULL) {
sl@0	2535	(*threadActionProc) (Tcl_GetChannelInstanceData(chan),
sl@0	2536	TCL_CHANNEL_THREAD_INSERT);
sl@0	2537	}
sl@0	2538	}
sl@0	2539
sl@0	2540	/*
sl@0	2541	*----------------------------------------------------------------------
sl@0	2542	*
sl@0	2543	* Tcl_Close --
sl@0	2544	*
sl@0	2545	* Closes a channel.
sl@0	2546	*
sl@0	2547	* Results:
sl@0	2548	* A standard Tcl result.
sl@0	2549	*
sl@0	2550	* Side effects:
sl@0	2551	* Closes the channel if this is the last reference.
sl@0	2552	*
sl@0	2553	* NOTE:
sl@0	2554	* Tcl_Close removes the channel as far as the user is concerned.
sl@0	2555	* However, it may continue to exist for a while longer if it has
sl@0	2556	* a background flush scheduled. The device itself is eventually
sl@0	2557	* closed and the channel record removed, in CloseChannel, above.
sl@0	2558	*
sl@0	2559	*----------------------------------------------------------------------
sl@0	2560	*/
sl@0	2561
sl@0	2562	/* ARGSUSED */
sl@0	2563	EXPORT_C int
sl@0	2564	Tcl_Close(interp, chan)
sl@0	2565	Tcl_Interp interp; / Interpreter for errors. */
sl@0	2566	Tcl_Channel chan; /* The channel being closed. Must
sl@0	2567	* not be referenced in any
sl@0	2568	* interpreter. */
sl@0	2569	{
sl@0	2570	CloseCallback cbPtr; / Iterate over close callbacks
sl@0	2571	* for this channel. */
sl@0	2572	Channel chanPtr; / The real IO channel. */
sl@0	2573	ChannelState statePtr; / State of real IO channel. */
sl@0	2574	int result; /* Of calling FlushChannel. */
sl@0	2575
sl@0	2576	if (chan == (Tcl_Channel) NULL) {
sl@0	2577	return TCL_OK;
sl@0	2578	}
sl@0	2579
sl@0	2580	/*
sl@0	2581	* Perform special handling for standard channels being closed. If the
sl@0	2582	* refCount is now 1 it means that the last reference to the standard
sl@0	2583	* channel is being explicitly closed, so bump the refCount down
sl@0	2584	* artificially to 0. This will ensure that the channel is actually
sl@0	2585	* closed, below. Also set the static pointer to NULL for the channel.
sl@0	2586	*/
sl@0	2587
sl@0	2588	CheckForStdChannelsBeingClosed(chan);
sl@0	2589
sl@0	2590	/*
sl@0	2591	* This operation should occur at the top of a channel stack.
sl@0	2592	*/
sl@0	2593
sl@0	2594	chanPtr = (Channel *) chan;
sl@0	2595	statePtr = chanPtr->state;
sl@0	2596	chanPtr = statePtr->topChanPtr;
sl@0	2597
sl@0	2598	if (statePtr->refCount > 0) {
sl@0	2599	panic("called Tcl_Close on channel with refCount > 0");
sl@0	2600	}
sl@0	2601
sl@0	2602	if (statePtr->flags & CHANNEL_INCLOSE) {
sl@0	2603	if (interp) {
sl@0	2604	Tcl_AppendResult(interp,
sl@0	2605	"Illegal recursive call to close through close-handler of channel",
sl@0	2606	(char *) NULL);
sl@0	2607	}
sl@0	2608	return TCL_ERROR;
sl@0	2609	}
sl@0	2610	statePtr->flags \|= CHANNEL_INCLOSE;
sl@0	2611
sl@0	2612	/*
sl@0	2613	* When the channel has an escape sequence driven encoding such as
sl@0	2614	* iso2022, the terminated escape sequence must write to the buffer.
sl@0	2615	*/
sl@0	2616	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
sl@0	2617	&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
sl@0	2618	statePtr->outputEncodingFlags \|= TCL_ENCODING_END;
sl@0	2619	WriteChars(chanPtr, "", 0);
sl@0	2620	}
sl@0	2621
sl@0	2622	Tcl_ClearChannelHandlers(chan);
sl@0	2623
sl@0	2624	/*
sl@0	2625	* Invoke the registered close callbacks and delete their records.
sl@0	2626	*/
sl@0	2627
sl@0	2628	while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
sl@0	2629	cbPtr = statePtr->closeCbPtr;
sl@0	2630	statePtr->closeCbPtr = cbPtr->nextPtr;
sl@0	2631	(cbPtr->proc) (cbPtr->clientData);
sl@0	2632	ckfree((char *) cbPtr);
sl@0	2633	}
sl@0	2634
sl@0	2635	statePtr->flags &= ~CHANNEL_INCLOSE;
sl@0	2636
sl@0	2637	/*
sl@0	2638	* Ensure that the last output buffer will be flushed.
sl@0	2639	*/
sl@0	2640
sl@0	2641	if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
sl@0	2642	(statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
sl@0	2643	statePtr->flags \|= BUFFER_READY;
sl@0	2644	}
sl@0	2645
sl@0	2646	/*
sl@0	2647	* If this channel supports it, close the read side, since we don't need it
sl@0	2648	* anymore and this will help avoid deadlocks on some channel types.
sl@0	2649	*/
sl@0	2650
sl@0	2651	if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
sl@0	2652	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
sl@0	2653	TCL_CLOSE_READ);
sl@0	2654	} else {
sl@0	2655	result = 0;
sl@0	2656	}
sl@0	2657
sl@0	2658	/*
sl@0	2659	* The call to FlushChannel will flush any queued output and invoke
sl@0	2660	* the close function of the channel driver, or it will set up the
sl@0	2661	* channel to be flushed and closed asynchronously.
sl@0	2662	*/
sl@0	2663
sl@0	2664	statePtr->flags \|= CHANNEL_CLOSED;
sl@0	2665	if ((FlushChannel(interp, chanPtr, 0) != 0) \|\| (result != 0)) {
sl@0	2666	return TCL_ERROR;
sl@0	2667	}
sl@0	2668	return TCL_OK;
sl@0	2669	}
sl@0	2670
sl@0	2671	/*
sl@0	2672	*----------------------------------------------------------------------
sl@0	2673	*
sl@0	2674	* Tcl_ClearChannelHandlers --
sl@0	2675	*
sl@0	2676	* Removes all channel handlers and event scripts from the channel,
sl@0	2677	* cancels all background copies involving the channel and any interest
sl@0	2678	* in events.
sl@0	2679	*
sl@0	2680	* Results:
sl@0	2681	* None.
sl@0	2682	*
sl@0	2683	* Side effects:
sl@0	2684	* See above. Deallocates memory.
sl@0	2685	*
sl@0	2686	*----------------------------------------------------------------------
sl@0	2687	*/
sl@0	2688
sl@0	2689	EXPORT_C void
sl@0	2690	Tcl_ClearChannelHandlers (channel)
sl@0	2691	Tcl_Channel channel;
sl@0	2692	{
sl@0	2693	ChannelHandler chPtr, chNext; /* Iterate over channel handlers. */
sl@0	2694	EventScriptRecord ePtr, eNextPtr; /* Iterate over eventscript records. */
sl@0	2695	Channel chanPtr; / The real IO channel. */
sl@0	2696	ChannelState statePtr; / State of real IO channel. */
sl@0	2697	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2698	NextChannelHandler *nhPtr;
sl@0	2699
sl@0	2700	/*
sl@0	2701	* This operation should occur at the top of a channel stack.
sl@0	2702	*/
sl@0	2703
sl@0	2704	chanPtr = (Channel *) channel;
sl@0	2705	statePtr = chanPtr->state;
sl@0	2706	chanPtr = statePtr->topChanPtr;
sl@0	2707
sl@0	2708	/*
sl@0	2709	* Cancel any outstanding timer.
sl@0	2710	*/
sl@0	2711
sl@0	2712	Tcl_DeleteTimerHandler(statePtr->timer);
sl@0	2713
sl@0	2714	/*
sl@0	2715	* Remove any references to channel handlers for this channel that
sl@0	2716	* may be about to be invoked.
sl@0	2717	*/
sl@0	2718
sl@0	2719	for (nhPtr = tsdPtr->nestedHandlerPtr;
sl@0	2720	nhPtr != (NextChannelHandler *) NULL;
sl@0	2721	nhPtr = nhPtr->nestedHandlerPtr) {
sl@0	2722	if (nhPtr->nextHandlerPtr &&
sl@0	2723	(nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
sl@0	2724	nhPtr->nextHandlerPtr = NULL;
sl@0	2725	}
sl@0	2726	}
sl@0	2727
sl@0	2728	/*
sl@0	2729	* Remove all the channel handler records attached to the channel
sl@0	2730	* itself.
sl@0	2731	*/
sl@0	2732
sl@0	2733	for (chPtr = statePtr->chPtr;
sl@0	2734	chPtr != (ChannelHandler *) NULL;
sl@0	2735	chPtr = chNext) {
sl@0	2736	chNext = chPtr->nextPtr;
sl@0	2737	ckfree((char *) chPtr);
sl@0	2738	}
sl@0	2739	statePtr->chPtr = (ChannelHandler *) NULL;
sl@0	2740
sl@0	2741	/*
sl@0	2742	* Cancel any pending copy operation.
sl@0	2743	*/
sl@0	2744
sl@0	2745	StopCopy(statePtr->csPtr);
sl@0	2746
sl@0	2747	/*
sl@0	2748	* Must set the interest mask now to 0, otherwise infinite loops
sl@0	2749	* will occur if Tcl_DoOneEvent is called before the channel is
sl@0	2750	* finally deleted in FlushChannel. This can happen if the channel
sl@0	2751	* has a background flush active.
sl@0	2752	*/
sl@0	2753
sl@0	2754	statePtr->interestMask = 0;
sl@0	2755
sl@0	2756	/*
sl@0	2757	* Remove any EventScript records for this channel.
sl@0	2758	*/
sl@0	2759
sl@0	2760	for (ePtr = statePtr->scriptRecordPtr;
sl@0	2761	ePtr != (EventScriptRecord *) NULL;
sl@0	2762	ePtr = eNextPtr) {
sl@0	2763	eNextPtr = ePtr->nextPtr;
sl@0	2764	Tcl_DecrRefCount(ePtr->scriptPtr);
sl@0	2765	ckfree((char *) ePtr);
sl@0	2766	}
sl@0	2767	statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
sl@0	2768	}
sl@0	2769
sl@0	2770	/*
sl@0	2771	*----------------------------------------------------------------------
sl@0	2772	*
sl@0	2773	* Tcl_Write --
sl@0	2774	*
sl@0	2775	* Puts a sequence of bytes into an output buffer, may queue the
sl@0	2776	* buffer for output if it gets full, and also remembers whether the
sl@0	2777	* current buffer is ready e.g. if it contains a newline and we are in
sl@0	2778	* line buffering mode. Compensates stacking, i.e. will redirect the
sl@0	2779	* data from the specified channel to the topmost channel in a stack.
sl@0	2780	*
sl@0	2781	* No encoding conversions are applied to the bytes being read.
sl@0	2782	*
sl@0	2783	* Results:
sl@0	2784	* The number of bytes written or -1 in case of error. If -1,
sl@0	2785	* Tcl_GetErrno will return the error code.
sl@0	2786	*
sl@0	2787	* Side effects:
sl@0	2788	* May buffer up output and may cause output to be produced on the
sl@0	2789	* channel.
sl@0	2790	*
sl@0	2791	*----------------------------------------------------------------------
sl@0	2792	*/
sl@0	2793
sl@0	2794	EXPORT_C int
sl@0	2795	Tcl_Write(chan, src, srcLen)
sl@0	2796	Tcl_Channel chan; /* The channel to buffer output for. */
sl@0	2797	CONST char src; / Data to queue in output buffer. */
sl@0	2798	int srcLen; /* Length of data in bytes, or < 0 for
sl@0	2799	* strlen(). */
sl@0	2800	{
sl@0	2801	/*
sl@0	2802	* Always use the topmost channel of the stack
sl@0	2803	*/
sl@0	2804	Channel *chanPtr;
sl@0	2805	ChannelState statePtr; / state info for channel */
sl@0	2806
sl@0	2807	statePtr = ((Channel *) chan)->state;
sl@0	2808	chanPtr = statePtr->topChanPtr;
sl@0	2809
sl@0	2810	if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
sl@0	2811	return -1;
sl@0	2812	}
sl@0	2813
sl@0	2814	if (srcLen < 0) {
sl@0	2815	srcLen = strlen(src);
sl@0	2816	}
sl@0	2817	return DoWrite(chanPtr, src, srcLen);
sl@0	2818	}
sl@0	2819
sl@0	2820	/*
sl@0	2821	*----------------------------------------------------------------------
sl@0	2822	*
sl@0	2823	* Tcl_WriteRaw --
sl@0	2824	*
sl@0	2825	* Puts a sequence of bytes into an output buffer, may queue the
sl@0	2826	* buffer for output if it gets full, and also remembers whether the
sl@0	2827	* current buffer is ready e.g. if it contains a newline and we are in
sl@0	2828	* line buffering mode. Writes directly to the driver of the channel,
sl@0	2829	* does not compensate for stacking.
sl@0	2830	*
sl@0	2831	* No encoding conversions are applied to the bytes being read.
sl@0	2832	*
sl@0	2833	* Results:
sl@0	2834	* The number of bytes written or -1 in case of error. If -1,
sl@0	2835	* Tcl_GetErrno will return the error code.
sl@0	2836	*
sl@0	2837	* Side effects:
sl@0	2838	* May buffer up output and may cause output to be produced on the
sl@0	2839	* channel.
sl@0	2840	*
sl@0	2841	*----------------------------------------------------------------------
sl@0	2842	*/
sl@0	2843
sl@0	2844	EXPORT_C int
sl@0	2845	Tcl_WriteRaw(chan, src, srcLen)
sl@0	2846	Tcl_Channel chan; /* The channel to buffer output for. */
sl@0	2847	CONST char src; / Data to queue in output buffer. */
sl@0	2848	int srcLen; /* Length of data in bytes, or < 0 for
sl@0	2849	* strlen(). */
sl@0	2850	{
sl@0	2851	Channel chanPtr = ((Channel ) chan);
sl@0	2852	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	2853	int errorCode, written;
sl@0	2854
sl@0	2855	if (CheckChannelErrors(statePtr, TCL_WRITABLE \| CHANNEL_RAW_MODE) != 0) {
sl@0	2856	return -1;
sl@0	2857	}
sl@0	2858
sl@0	2859	if (srcLen < 0) {
sl@0	2860	srcLen = strlen(src);
sl@0	2861	}
sl@0	2862
sl@0	2863	/*
sl@0	2864	* Go immediately to the driver, do all the error handling by ourselves.
sl@0	2865	* The code was stolen from 'FlushChannel'.
sl@0	2866	*/
sl@0	2867
sl@0	2868	written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
sl@0	2869	src, srcLen, &errorCode);
sl@0	2870
sl@0	2871	if (written < 0) {
sl@0	2872	Tcl_SetErrno(errorCode);
sl@0	2873	}
sl@0	2874
sl@0	2875	return written;
sl@0	2876	}
sl@0	2877
sl@0	2878	/*
sl@0	2879	*---------------------------------------------------------------------------
sl@0	2880	*
sl@0	2881	* Tcl_WriteChars --
sl@0	2882	*
sl@0	2883	* Takes a sequence of UTF-8 characters and converts them for output
sl@0	2884	* using the channel's current encoding, may queue the buffer for
sl@0	2885	* output if it gets full, and also remembers whether the current
sl@0	2886	* buffer is ready e.g. if it contains a newline and we are in
sl@0	2887	* line buffering mode. Compensates stacking, i.e. will redirect the
sl@0	2888	* data from the specified channel to the topmost channel in a stack.
sl@0	2889	*
sl@0	2890	* Results:
sl@0	2891	* The number of bytes written or -1 in case of error. If -1,
sl@0	2892	* Tcl_GetErrno will return the error code.
sl@0	2893	*
sl@0	2894	* Side effects:
sl@0	2895	* May buffer up output and may cause output to be produced on the
sl@0	2896	* channel.
sl@0	2897	*
sl@0	2898	*----------------------------------------------------------------------
sl@0	2899	*/
sl@0	2900
sl@0	2901	EXPORT_C int
sl@0	2902	Tcl_WriteChars(chan, src, len)
sl@0	2903	Tcl_Channel chan; /* The channel to buffer output for. */
sl@0	2904	CONST char src; / UTF-8 characters to queue in output buffer. */
sl@0	2905	int len; /* Length of string in bytes, or < 0 for
sl@0	2906	* strlen(). */
sl@0	2907	{
sl@0	2908	ChannelState statePtr; / state info for channel */
sl@0	2909
sl@0	2910	statePtr = ((Channel *) chan)->state;
sl@0	2911
sl@0	2912	if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
sl@0	2913	return -1;
sl@0	2914	}
sl@0	2915
sl@0	2916	return DoWriteChars ((Channel*) chan, src, len);
sl@0	2917	}
sl@0	2918
sl@0	2919	/*
sl@0	2920	*---------------------------------------------------------------------------
sl@0	2921	*
sl@0	2922	* DoWriteChars --
sl@0	2923	*
sl@0	2924	* Takes a sequence of UTF-8 characters and converts them for output
sl@0	2925	* using the channel's current encoding, may queue the buffer for
sl@0	2926	* output if it gets full, and also remembers whether the current
sl@0	2927	* buffer is ready e.g. if it contains a newline and we are in
sl@0	2928	* line buffering mode. Compensates stacking, i.e. will redirect the
sl@0	2929	* data from the specified channel to the topmost channel in a stack.
sl@0	2930	*
sl@0	2931	* Results:
sl@0	2932	* The number of bytes written or -1 in case of error. If -1,
sl@0	2933	* Tcl_GetErrno will return the error code.
sl@0	2934	*
sl@0	2935	* Side effects:
sl@0	2936	* May buffer up output and may cause output to be produced on the
sl@0	2937	* channel.
sl@0	2938	*
sl@0	2939	*----------------------------------------------------------------------
sl@0	2940	*/
sl@0	2941
sl@0	2942	static int
sl@0	2943	DoWriteChars(chanPtr, src, len)
sl@0	2944	Channel* chanPtr; /* The channel to buffer output for. */
sl@0	2945	CONST char src; / UTF-8 characters to queue in output buffer. */
sl@0	2946	int len; /* Length of string in bytes, or < 0 for
sl@0	2947	* strlen(). */
sl@0	2948	{
sl@0	2949	/*
sl@0	2950	* Always use the topmost channel of the stack
sl@0	2951	*/
sl@0	2952	ChannelState statePtr; / state info for channel */
sl@0	2953
sl@0	2954	statePtr = chanPtr->state;
sl@0	2955	chanPtr = statePtr->topChanPtr;
sl@0	2956
sl@0	2957	if (len < 0) {
sl@0	2958	len = strlen(src);
sl@0	2959	}
sl@0	2960	if (statePtr->encoding == NULL) {
sl@0	2961	/*
sl@0	2962	* Inefficient way to convert UTF-8 to byte-array, but the
sl@0	2963	* code parallels the way it is done for objects.
sl@0	2964	*/
sl@0	2965
sl@0	2966	Tcl_Obj *objPtr;
sl@0	2967	int result;
sl@0	2968
sl@0	2969	objPtr = Tcl_NewStringObj(src, len);
sl@0	2970	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
sl@0	2971	result = WriteBytes(chanPtr, src, len);
sl@0	2972	Tcl_DecrRefCount(objPtr);
sl@0	2973	return result;
sl@0	2974	}
sl@0	2975	return WriteChars(chanPtr, src, len);
sl@0	2976	}
sl@0	2977
sl@0	2978	/*
sl@0	2979	*---------------------------------------------------------------------------
sl@0	2980	*
sl@0	2981	* Tcl_WriteObj --
sl@0	2982	*
sl@0	2983	* Takes the Tcl object and queues its contents for output. If the
sl@0	2984	* encoding of the channel is NULL, takes the byte-array representation
sl@0	2985	* of the object and queues those bytes for output. Otherwise, takes
sl@0	2986	* the characters in the UTF-8 (string) representation of the object
sl@0	2987	* and converts them for output using the channel's current encoding.
sl@0	2988	* May flush internal buffers to output if one becomes full or is ready
sl@0	2989	* for some other reason, e.g. if it contains a newline and the channel
sl@0	2990	* is in line buffering mode.
sl@0	2991	*
sl@0	2992	* Results:
sl@0	2993	* The number of bytes written or -1 in case of error. If -1,
sl@0	2994	* Tcl_GetErrno() will return the error code.
sl@0	2995	*
sl@0	2996	* Side effects:
sl@0	2997	* May buffer up output and may cause output to be produced on the
sl@0	2998	* channel.
sl@0	2999	*
sl@0	3000	*----------------------------------------------------------------------
sl@0	3001	*/
sl@0	3002
sl@0	3003	EXPORT_C int
sl@0	3004	Tcl_WriteObj(chan, objPtr)
sl@0	3005	Tcl_Channel chan; /* The channel to buffer output for. */
sl@0	3006	Tcl_Obj objPtr; / The object to write. */
sl@0	3007	{
sl@0	3008	/*
sl@0	3009	* Always use the topmost channel of the stack
sl@0	3010	*/
sl@0	3011	Channel *chanPtr;
sl@0	3012	ChannelState statePtr; / state info for channel */
sl@0	3013	char *src;
sl@0	3014	int srcLen;
sl@0	3015
sl@0	3016	statePtr = ((Channel *) chan)->state;
sl@0	3017	chanPtr = statePtr->topChanPtr;
sl@0	3018
sl@0	3019	if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
sl@0	3020	return -1;
sl@0	3021	}
sl@0	3022	if (statePtr->encoding == NULL) {
sl@0	3023	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
sl@0	3024	return WriteBytes(chanPtr, src, srcLen);
sl@0	3025	} else {
sl@0	3026	src = Tcl_GetStringFromObj(objPtr, &srcLen);
sl@0	3027	return WriteChars(chanPtr, src, srcLen);
sl@0	3028	}
sl@0	3029	}
sl@0	3030
sl@0	3031	/*
sl@0	3032	*----------------------------------------------------------------------
sl@0	3033	*
sl@0	3034	* WriteBytes --
sl@0	3035	*
sl@0	3036	* Write a sequence of bytes into an output buffer, may queue the
sl@0	3037	* buffer for output if it gets full, and also remembers whether the
sl@0	3038	* current buffer is ready e.g. if it contains a newline and we are in
sl@0	3039	* line buffering mode.
sl@0	3040	*
sl@0	3041	* Results:
sl@0	3042	* The number of bytes written or -1 in case of error. If -1,
sl@0	3043	* Tcl_GetErrno will return the error code.
sl@0	3044	*
sl@0	3045	* Side effects:
sl@0	3046	* May buffer up output and may cause output to be produced on the
sl@0	3047	* channel.
sl@0	3048	*
sl@0	3049	*----------------------------------------------------------------------
sl@0	3050	*/
sl@0	3051
sl@0	3052	static int
sl@0	3053	WriteBytes(chanPtr, src, srcLen)
sl@0	3054	Channel chanPtr; / The channel to buffer output for. */
sl@0	3055	CONST char src; / Bytes to write. */
sl@0	3056	int srcLen; /* Number of bytes to write. */
sl@0	3057	{
sl@0	3058	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	3059	ChannelBuffer *bufPtr;
sl@0	3060	char *dst;
sl@0	3061	int dstMax, sawLF, savedLF, total, dstLen, toWrite;
sl@0	3062
sl@0	3063	total = 0;
sl@0	3064	sawLF = 0;
sl@0	3065	savedLF = 0;
sl@0	3066
sl@0	3067	/*
sl@0	3068	* Loop over all bytes in src, storing them in output buffer with
sl@0	3069	* proper EOL translation.
sl@0	3070	*/
sl@0	3071
sl@0	3072	while (srcLen + savedLF > 0) {
sl@0	3073	bufPtr = statePtr->curOutPtr;
sl@0	3074	if (bufPtr == NULL) {
sl@0	3075	bufPtr = AllocChannelBuffer(statePtr->bufSize);
sl@0	3076	statePtr->curOutPtr = bufPtr;
sl@0	3077	}
sl@0	3078	dst = bufPtr->buf + bufPtr->nextAdded;
sl@0	3079	dstMax = bufPtr->bufLength - bufPtr->nextAdded;
sl@0	3080	dstLen = dstMax;
sl@0	3081
sl@0	3082	toWrite = dstLen;
sl@0	3083	if (toWrite > srcLen) {
sl@0	3084	toWrite = srcLen;
sl@0	3085	}
sl@0	3086
sl@0	3087	if (savedLF) {
sl@0	3088	/*
sl@0	3089	* A '\n' was left over from last call to TranslateOutputEOL()
sl@0	3090	* and we need to store it in this buffer. If the channel is
sl@0	3091	* line-based, we will need to flush it.
sl@0	3092	*/
sl@0	3093
sl@0	3094	*dst++ = '\n';
sl@0	3095	dstLen--;
sl@0	3096	sawLF++;
sl@0	3097	}
sl@0	3098	sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
sl@0	3099	dstLen += savedLF;
sl@0	3100	savedLF = 0;
sl@0	3101
sl@0	3102	if (dstLen > dstMax) {
sl@0	3103	savedLF = 1;
sl@0	3104	dstLen = dstMax;
sl@0	3105	}
sl@0	3106	bufPtr->nextAdded += dstLen;
sl@0	3107	if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
sl@0	3108	return -1;
sl@0	3109	}
sl@0	3110	total += dstLen;
sl@0	3111	src += toWrite;
sl@0	3112	srcLen -= toWrite;
sl@0	3113	sawLF = 0;
sl@0	3114	}
sl@0	3115	return total;
sl@0	3116	}
sl@0	3117
sl@0	3118	/*
sl@0	3119	*----------------------------------------------------------------------
sl@0	3120	*
sl@0	3121	* WriteChars --
sl@0	3122	*
sl@0	3123	* Convert UTF-8 bytes to the channel's external encoding and
sl@0	3124	* write the produced bytes into an output buffer, may queue the
sl@0	3125	* buffer for output if it gets full, and also remembers whether the
sl@0	3126	* current buffer is ready e.g. if it contains a newline and we are in
sl@0	3127	* line buffering mode.
sl@0	3128	*
sl@0	3129	* Results:
sl@0	3130	* The number of bytes written or -1 in case of error. If -1,
sl@0	3131	* Tcl_GetErrno will return the error code.
sl@0	3132	*
sl@0	3133	* Side effects:
sl@0	3134	* May buffer up output and may cause output to be produced on the
sl@0	3135	* channel.
sl@0	3136	*
sl@0	3137	*----------------------------------------------------------------------
sl@0	3138	*/
sl@0	3139
sl@0	3140	static int
sl@0	3141	WriteChars(chanPtr, src, srcLen)
sl@0	3142	Channel chanPtr; / The channel to buffer output for. */
sl@0	3143	CONST char src; / UTF-8 string to write. */
sl@0	3144	int srcLen; /* Length of UTF-8 string in bytes. */
sl@0	3145	{
sl@0	3146	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	3147	ChannelBuffer *bufPtr;
sl@0	3148	char dst, stage;
sl@0	3149	int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
sl@0	3150	int stageLen, toWrite, stageRead, endEncoding, result;
sl@0	3151	int consumedSomething;
sl@0	3152	Tcl_Encoding encoding;
sl@0	3153	char safe[BUFFER_PADDING];
sl@0	3154
sl@0	3155	total = 0;
sl@0	3156	sawLF = 0;
sl@0	3157	savedLF = 0;
sl@0	3158	saved = 0;
sl@0	3159	encoding = statePtr->encoding;
sl@0	3160
sl@0	3161	/*
sl@0	3162	* Write the terminated escape sequence even if srcLen is 0.
sl@0	3163	*/
sl@0	3164
sl@0	3165	endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
sl@0	3166
sl@0	3167	/*
sl@0	3168	* Loop over all UTF-8 characters in src, storing them in staging buffer
sl@0	3169	* with proper EOL translation.
sl@0	3170	*/
sl@0	3171
sl@0	3172	consumedSomething = 1;
sl@0	3173	while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
sl@0	3174	consumedSomething = 0;
sl@0	3175	stage = statePtr->outputStage;
sl@0	3176	stageMax = statePtr->bufSize;
sl@0	3177	stageLen = stageMax;
sl@0	3178
sl@0	3179	toWrite = stageLen;
sl@0	3180	if (toWrite > srcLen) {
sl@0	3181	toWrite = srcLen;
sl@0	3182	}
sl@0	3183
sl@0	3184	if (savedLF) {
sl@0	3185	/*
sl@0	3186	* A '\n' was left over from last call to TranslateOutputEOL()
sl@0	3187	* and we need to store it in the staging buffer. If the
sl@0	3188	* channel is line-based, we will need to flush the output
sl@0	3189	* buffer (after translating the staging buffer).
sl@0	3190	*/
sl@0	3191
sl@0	3192	*stage++ = '\n';
sl@0	3193	stageLen--;
sl@0	3194	sawLF++;
sl@0	3195	}
sl@0	3196	sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite);
sl@0	3197
sl@0	3198	stage -= savedLF;
sl@0	3199	stageLen += savedLF;
sl@0	3200	savedLF = 0;
sl@0	3201
sl@0	3202	if (stageLen > stageMax) {
sl@0	3203	savedLF = 1;
sl@0	3204	stageLen = stageMax;
sl@0	3205	}
sl@0	3206	src += toWrite;
sl@0	3207	srcLen -= toWrite;
sl@0	3208
sl@0	3209	/*
sl@0	3210	* Loop over all UTF-8 characters in staging buffer, converting them
sl@0	3211	* to external encoding, storing them in output buffer.
sl@0	3212	*/
sl@0	3213
sl@0	3214	while (stageLen + saved + endEncoding > 0) {
sl@0	3215	bufPtr = statePtr->curOutPtr;
sl@0	3216	if (bufPtr == NULL) {
sl@0	3217	bufPtr = AllocChannelBuffer(statePtr->bufSize);
sl@0	3218	statePtr->curOutPtr = bufPtr;
sl@0	3219	}
sl@0	3220	dst = bufPtr->buf + bufPtr->nextAdded;
sl@0	3221	dstLen = bufPtr->bufLength - bufPtr->nextAdded;
sl@0	3222
sl@0	3223	if (saved != 0) {
sl@0	3224	/*
sl@0	3225	* Here's some translated bytes left over from the last
sl@0	3226	* buffer that we need to stick at the beginning of this
sl@0	3227	* buffer.
sl@0	3228	*/
sl@0	3229
sl@0	3230	memcpy((VOID ) dst, (VOID ) safe, (size_t) saved);
sl@0	3231	bufPtr->nextAdded += saved;
sl@0	3232	dst += saved;
sl@0	3233	dstLen -= saved;
sl@0	3234	saved = 0;
sl@0	3235	}
sl@0	3236
sl@0	3237	result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
sl@0	3238	statePtr->outputEncodingFlags,
sl@0	3239	&statePtr->outputEncodingState, dst,
sl@0	3240	dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
sl@0	3241
sl@0	3242	/* Fix for SF #506297, reported by Martin Forssen
sl@0	3243	* <ruric@users.sourceforge.net>.
sl@0	3244	*
sl@0	3245	* The encoding chosen in the script exposing the bug writes out
sl@0	3246	* three intro characters when TCL_ENCODING_START is set, but does
sl@0	3247	* not consume any input as TCL_ENCODING_END is cleared. As some
sl@0	3248	* output was generated the enclosing loop calls UtfToExternal
sl@0	3249	* again, again with START set. Three more characters in the out
sl@0	3250	* and still no use of input ... To break this infinite loop we
sl@0	3251	* remove TCL_ENCODING_START from the set of flags after the first
sl@0	3252	* call (no condition is required, the later calls remove an unset
sl@0	3253	* flag, which is a no-op). This causes the subsequent calls to
sl@0	3254	* UtfToExternal to consume and convert the actual input.
sl@0	3255	*/
sl@0	3256
sl@0	3257	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
sl@0	3258	/*
sl@0	3259	* The following code must be executed only when result is not 0.
sl@0	3260	*/
sl@0	3261	if (result && ((stageRead + dstWrote) == 0)) {
sl@0	3262	/*
sl@0	3263	* We have an incomplete UTF-8 character at the end of the
sl@0	3264	* staging buffer. It will get moved to the beginning of the
sl@0	3265	* staging buffer followed by more bytes from src.
sl@0	3266	*/
sl@0	3267
sl@0	3268	src -= stageLen;
sl@0	3269	srcLen += stageLen;
sl@0	3270	stageLen = 0;
sl@0	3271	savedLF = 0;
sl@0	3272	break;
sl@0	3273	}
sl@0	3274	bufPtr->nextAdded += dstWrote;
sl@0	3275	if (bufPtr->nextAdded > bufPtr->bufLength) {
sl@0	3276	/*
sl@0	3277	* When translating from UTF-8 to external encoding, we
sl@0	3278	* allowed the translation to produce a character that
sl@0	3279	* crossed the end of the output buffer, so that we would
sl@0	3280	* get a completely full buffer before flushing it. The
sl@0	3281	* extra bytes will be moved to the beginning of the next
sl@0	3282	* buffer.
sl@0	3283	*/
sl@0	3284
sl@0	3285	saved = bufPtr->nextAdded - bufPtr->bufLength;
sl@0	3286	memcpy((VOID ) safe, (VOID ) (dst + dstLen), (size_t) saved);
sl@0	3287	bufPtr->nextAdded = bufPtr->bufLength;
sl@0	3288	}
sl@0	3289	if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
sl@0	3290	return -1;
sl@0	3291	}
sl@0	3292
sl@0	3293	total += dstWrote;
sl@0	3294	stage += stageRead;
sl@0	3295	stageLen -= stageRead;
sl@0	3296	sawLF = 0;
sl@0	3297
sl@0	3298	consumedSomething = 1;
sl@0	3299
sl@0	3300	/*
sl@0	3301	* If all translated characters are written to the buffer,
sl@0	3302	* endEncoding is set to 0 because the escape sequence may be
sl@0	3303	* output.
sl@0	3304	*/
sl@0	3305
sl@0	3306	if ((stageLen + saved == 0) && (result == 0)) {
sl@0	3307	endEncoding = 0;
sl@0	3308	}
sl@0	3309	}
sl@0	3310	}
sl@0	3311
sl@0	3312	/* If nothing was written and it happened because there was no progress
sl@0	3313	* in the UTF conversion, we throw an error.
sl@0	3314	*/
sl@0	3315
sl@0	3316	if (!consumedSomething && (total == 0)) {
sl@0	3317	Tcl_SetErrno (EINVAL);
sl@0	3318	return -1;
sl@0	3319	}
sl@0	3320	return total;
sl@0	3321	}
sl@0	3322
sl@0	3323	/*
sl@0	3324	*---------------------------------------------------------------------------
sl@0	3325	*
sl@0	3326	* TranslateOutputEOL --
sl@0	3327	*
sl@0	3328	* Helper function for WriteBytes() and WriteChars(). Converts the
sl@0	3329	* '\n' characters in the source buffer into the appropriate EOL
sl@0	3330	* form specified by the output translation mode.
sl@0	3331	*
sl@0	3332	* EOL translation stops either when the source buffer is empty
sl@0	3333	* or the output buffer is full.
sl@0	3334	*
sl@0	3335	* When converting to CRLF mode and there is only 1 byte left in
sl@0	3336	* the output buffer, this routine stores the '\r' in the last
sl@0	3337	* byte and then stores the '\n' in the byte just past the end of the
sl@0	3338	* buffer. The caller is responsible for passing in a buffer that
sl@0	3339	* is large enough to hold the extra byte.
sl@0	3340	*
sl@0	3341	* Results:
sl@0	3342	* The return value is 1 if a '\n' was translated from the source
sl@0	3343	* buffer, or 0 otherwise -- this can be used by the caller to
sl@0	3344	* decide to flush a line-based channel even though the channel
sl@0	3345	* buffer is not full.
sl@0	3346	*
sl@0	3347	* *dstLenPtr is filled with how many bytes of the output buffer
sl@0	3348	* were used. As mentioned above, this can be one more that
sl@0	3349	* the output buffer's specified length if a CRLF was stored.
sl@0	3350	*
sl@0	3351	* *srcLenPtr is filled with how many bytes of the source buffer
sl@0	3352	* were consumed.
sl@0	3353	*
sl@0	3354	* Side effects:
sl@0	3355	* It may be obvious, but bears mentioning that when converting
sl@0	3356	* in CRLF mode (which requires two bytes of storage in the output
sl@0	3357	* buffer), the number of bytes consumed from the source buffer
sl@0	3358	* will be less than the number of bytes stored in the output buffer.
sl@0	3359	*
sl@0	3360	*---------------------------------------------------------------------------
sl@0	3361	*/
sl@0	3362
sl@0	3363	static int
sl@0	3364	TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
sl@0	3365	ChannelState statePtr; / Channel being read, for translation and
sl@0	3366	* buffering modes. */
sl@0	3367	char dst; / Output buffer filled with UTF-8 chars by
sl@0	3368	* applying appropriate EOL translation to
sl@0	3369	* source characters. */
sl@0	3370	CONST char src; / Source UTF-8 characters. */
sl@0	3371	int dstLenPtr; / On entry, the maximum length of output
sl@0	3372	* buffer in bytes. On exit, the number of
sl@0	3373	* bytes actually used in output buffer. */
sl@0	3374	int srcLenPtr; / On entry, the length of source buffer.
sl@0	3375	* On exit, the number of bytes read from
sl@0	3376	* the source buffer. */
sl@0	3377	{
sl@0	3378	char *dstEnd;
sl@0	3379	int srcLen, newlineFound;
sl@0	3380
sl@0	3381	newlineFound = 0;
sl@0	3382	srcLen = *srcLenPtr;
sl@0	3383
sl@0	3384	switch (statePtr->outputTranslation) {
sl@0	3385	case TCL_TRANSLATE_LF: {
sl@0	3386	for (dstEnd = dst + srcLen; dst < dstEnd; ) {
sl@0	3387	if (*src == '\n') {
sl@0	3388	newlineFound = 1;
sl@0	3389	}
sl@0	3390	dst++ = src++;
sl@0	3391	}
sl@0	3392	*dstLenPtr = srcLen;
sl@0	3393	break;
sl@0	3394	}
sl@0	3395	case TCL_TRANSLATE_CR: {
sl@0	3396	for (dstEnd = dst + srcLen; dst < dstEnd;) {
sl@0	3397	if (*src == '\n') {
sl@0	3398	*dst++ = '\r';
sl@0	3399	newlineFound = 1;
sl@0	3400	src++;
sl@0	3401	} else {
sl@0	3402	dst++ = src++;
sl@0	3403	}
sl@0	3404	}
sl@0	3405	*dstLenPtr = srcLen;
sl@0	3406	break;
sl@0	3407	}
sl@0	3408	case TCL_TRANSLATE_CRLF: {
sl@0	3409	/*
sl@0	3410	* Since this causes the number of bytes to grow, we
sl@0	3411	* start off trying to put 'srcLen' bytes into the
sl@0	3412	* output buffer, but allow it to store more bytes, as
sl@0	3413	* long as there's still source bytes and room in the
sl@0	3414	* output buffer.
sl@0	3415	*/
sl@0	3416
sl@0	3417	char dstStart, dstMax;
sl@0	3418	CONST char *srcStart;
sl@0	3419
sl@0	3420	dstStart = dst;
sl@0	3421	dstMax = dst + *dstLenPtr;
sl@0	3422
sl@0	3423	srcStart = src;
sl@0	3424
sl@0	3425	if (srcLen < *dstLenPtr) {
sl@0	3426	dstEnd = dst + srcLen;
sl@0	3427	} else {
sl@0	3428	dstEnd = dst + *dstLenPtr;
sl@0	3429	}
sl@0	3430	while (dst < dstEnd) {
sl@0	3431	if (*src == '\n') {
sl@0	3432	if (dstEnd < dstMax) {
sl@0	3433	dstEnd++;
sl@0	3434	}
sl@0	3435	*dst++ = '\r';
sl@0	3436	newlineFound = 1;
sl@0	3437	}
sl@0	3438	dst++ = src++;
sl@0	3439	}
sl@0	3440	*srcLenPtr = src - srcStart;
sl@0	3441	*dstLenPtr = dst - dstStart;
sl@0	3442	break;
sl@0	3443	}
sl@0	3444	default: {
sl@0	3445	break;
sl@0	3446	}
sl@0	3447	}
sl@0	3448	return newlineFound;
sl@0	3449	}
sl@0	3450
sl@0	3451	/*
sl@0	3452	*---------------------------------------------------------------------------
sl@0	3453	*
sl@0	3454	* CheckFlush --
sl@0	3455	*
sl@0	3456	* Helper function for WriteBytes() and WriteChars(). If the
sl@0	3457	* channel buffer is ready to be flushed, flush it.
sl@0	3458	*
sl@0	3459	* Results:
sl@0	3460	* The return value is -1 if there was a problem flushing the
sl@0	3461	* channel buffer, or 0 otherwise.
sl@0	3462	*
sl@0	3463	* Side effects:
sl@0	3464	* The buffer will be recycled if it is flushed.
sl@0	3465	*
sl@0	3466	*---------------------------------------------------------------------------
sl@0	3467	*/
sl@0	3468
sl@0	3469	static int
sl@0	3470	CheckFlush(chanPtr, bufPtr, newlineFlag)
sl@0	3471	Channel chanPtr; / Channel being read, for buffering mode. */
sl@0	3472	ChannelBuffer bufPtr; / Channel buffer to possibly flush. */
sl@0	3473	int newlineFlag; /* Non-zero if a the channel buffer
sl@0	3474	* contains a newline. */
sl@0	3475	{
sl@0	3476	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	3477	/*
sl@0	3478	* The current buffer is ready for output:
sl@0	3479	* 1. if it is full.
sl@0	3480	* 2. if it contains a newline and this channel is line-buffered.
sl@0	3481	* 3. if it contains any output and this channel is unbuffered.
sl@0	3482	*/
sl@0	3483
sl@0	3484	if ((statePtr->flags & BUFFER_READY) == 0) {
sl@0	3485	if (bufPtr->nextAdded == bufPtr->bufLength) {
sl@0	3486	statePtr->flags \|= BUFFER_READY;
sl@0	3487	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
sl@0	3488	if (newlineFlag != 0) {
sl@0	3489	statePtr->flags \|= BUFFER_READY;
sl@0	3490	}
sl@0	3491	} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
sl@0	3492	statePtr->flags \|= BUFFER_READY;
sl@0	3493	}
sl@0	3494	}
sl@0	3495	if (statePtr->flags & BUFFER_READY) {
sl@0	3496	if (FlushChannel(NULL, chanPtr, 0) != 0) {
sl@0	3497	return -1;
sl@0	3498	}
sl@0	3499	}
sl@0	3500	return 0;
sl@0	3501	}
sl@0	3502
sl@0	3503	/*
sl@0	3504	*---------------------------------------------------------------------------
sl@0	3505	*
sl@0	3506	* Tcl_Gets --
sl@0	3507	*
sl@0	3508	* Reads a complete line of input from the channel into a Tcl_DString.
sl@0	3509	*
sl@0	3510	* Results:
sl@0	3511	* Length of line read (in characters) or -1 if error, EOF, or blocked.
sl@0	3512	* If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
sl@0	3513	* error or condition that occurred.
sl@0	3514	*
sl@0	3515	* Side effects:
sl@0	3516	* May flush output on the channel. May cause input to be consumed
sl@0	3517	* from the channel.
sl@0	3518	*
sl@0	3519	*---------------------------------------------------------------------------
sl@0	3520	*/
sl@0	3521
sl@0	3522	EXPORT_C int
sl@0	3523	Tcl_Gets(chan, lineRead)
sl@0	3524	Tcl_Channel chan; /* Channel from which to read. */
sl@0	3525	Tcl_DString lineRead; / The line read will be appended to this
sl@0	3526	* DString as UTF-8 characters. The caller
sl@0	3527	* must have initialized it and is responsible
sl@0	3528	* for managing the storage. */
sl@0	3529	{
sl@0	3530	Tcl_Obj *objPtr;
sl@0	3531	int charsStored, length;
sl@0	3532	char *string;
sl@0	3533
sl@0	3534	objPtr = Tcl_NewObj();
sl@0	3535	charsStored = Tcl_GetsObj(chan, objPtr);
sl@0	3536	if (charsStored > 0) {
sl@0	3537	string = Tcl_GetStringFromObj(objPtr, &length);
sl@0	3538	Tcl_DStringAppend(lineRead, string, length);
sl@0	3539	}
sl@0	3540	Tcl_DecrRefCount(objPtr);
sl@0	3541	return charsStored;
sl@0	3542	}
sl@0	3543
sl@0	3544	/*
sl@0	3545	*---------------------------------------------------------------------------
sl@0	3546	*
sl@0	3547	* Tcl_GetsObj --
sl@0	3548	*
sl@0	3549	* Accumulate input from the input channel until end-of-line or
sl@0	3550	* end-of-file has been seen. Bytes read from the input channel
sl@0	3551	* are converted to UTF-8 using the encoding specified by the
sl@0	3552	* channel.
sl@0	3553	*
sl@0	3554	* Results:
sl@0	3555	* Number of characters accumulated in the object or -1 if error,
sl@0	3556	* blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the
sl@0	3557	* POSIX error code for the error or condition that occurred.
sl@0	3558	*
sl@0	3559	* Side effects:
sl@0	3560	* Consumes input from the channel.
sl@0	3561	*
sl@0	3562	* On reading EOF, leave channel pointing at EOF char.
sl@0	3563	* On reading EOL, leave channel pointing after EOL, but don't
sl@0	3564	* return EOL in dst buffer.
sl@0	3565	*
sl@0	3566	*---------------------------------------------------------------------------
sl@0	3567	*/
sl@0	3568
sl@0	3569	EXPORT_C int
sl@0	3570	Tcl_GetsObj(chan, objPtr)
sl@0	3571	Tcl_Channel chan; /* Channel from which to read. */
sl@0	3572	Tcl_Obj objPtr; / The line read will be appended to this
sl@0	3573	* object as UTF-8 characters. */
sl@0	3574	{
sl@0	3575	GetsState gs;
sl@0	3576	Channel chanPtr = (Channel ) chan;
sl@0	3577	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	3578	ChannelBuffer *bufPtr;
sl@0	3579	int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
sl@0	3580	Tcl_Encoding encoding;
sl@0	3581	char dst, dstEnd, eol, eof;
sl@0	3582	Tcl_EncodingState oldState;
sl@0	3583
sl@0	3584	/*
sl@0	3585	* This operation should occur at the top of a channel stack.
sl@0	3586	*/
sl@0	3587
sl@0	3588	chanPtr = statePtr->topChanPtr;
sl@0	3589
sl@0	3590	if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
sl@0	3591	copiedTotal = -1;
sl@0	3592	goto done;
sl@0	3593	}
sl@0	3594
sl@0	3595	bufPtr = statePtr->inQueueHead;
sl@0	3596	encoding = statePtr->encoding;
sl@0	3597
sl@0	3598	/*
sl@0	3599	* Preserved so we can restore the channel's state in case we don't
sl@0	3600	* find a newline in the available input.
sl@0	3601	*/
sl@0	3602
sl@0	3603	Tcl_GetStringFromObj(objPtr, &oldLength);
sl@0	3604	oldFlags = statePtr->inputEncodingFlags;
sl@0	3605	oldState = statePtr->inputEncodingState;
sl@0	3606	oldRemoved = BUFFER_PADDING;
sl@0	3607	if (bufPtr != NULL) {
sl@0	3608	oldRemoved = bufPtr->nextRemoved;
sl@0	3609	}
sl@0	3610
sl@0	3611	/*
sl@0	3612	* If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
sl@0	3613	* produce ByteArray objects. To avoid circularity problems,
sl@0	3614	* "iso8859-1" is builtin to Tcl.
sl@0	3615	*/
sl@0	3616
sl@0	3617	if (encoding == NULL) {
sl@0	3618	encoding = Tcl_GetEncoding(NULL, "iso8859-1");
sl@0	3619	}
sl@0	3620
sl@0	3621	/*
sl@0	3622	* Object used by FilterInputBytes to keep track of how much data has
sl@0	3623	* been consumed from the channel buffers.
sl@0	3624	*/
sl@0	3625
sl@0	3626	gs.objPtr = objPtr;
sl@0	3627	gs.dstPtr = &dst;
sl@0	3628	gs.encoding = encoding;
sl@0	3629	gs.bufPtr = bufPtr;
sl@0	3630	gs.state = oldState;
sl@0	3631	gs.rawRead = 0;
sl@0	3632	gs.bytesWrote = 0;
sl@0	3633	gs.charsWrote = 0;
sl@0	3634	gs.totalChars = 0;
sl@0	3635
sl@0	3636	dst = objPtr->bytes + oldLength;
sl@0	3637	dstEnd = dst;
sl@0	3638
sl@0	3639	skip = 0;
sl@0	3640	eof = NULL;
sl@0	3641	inEofChar = statePtr->inEofChar;
sl@0	3642
sl@0	3643	while (1) {
sl@0	3644	if (dst >= dstEnd) {
sl@0	3645	if (FilterInputBytes(chanPtr, &gs) != 0) {
sl@0	3646	goto restore;
sl@0	3647	}
sl@0	3648	dstEnd = dst + gs.bytesWrote;
sl@0	3649	}
sl@0	3650
sl@0	3651	/*
sl@0	3652	* Remember if EOF char is seen, then look for EOL anyhow, because
sl@0	3653	* the EOL might be before the EOF char.
sl@0	3654	*/
sl@0	3655
sl@0	3656	if (inEofChar != '\0') {
sl@0	3657	for (eol = dst; eol < dstEnd; eol++) {
sl@0	3658	if (*eol == inEofChar) {
sl@0	3659	dstEnd = eol;
sl@0	3660	eof = eol;
sl@0	3661	break;
sl@0	3662	}
sl@0	3663	}
sl@0	3664	}
sl@0	3665
sl@0	3666	/*
sl@0	3667	* On EOL, leave current file position pointing after the EOL, but
sl@0	3668	* don't store the EOL in the output string.
sl@0	3669	*/
sl@0	3670
sl@0	3671	switch (statePtr->inputTranslation) {
sl@0	3672	case TCL_TRANSLATE_LF: {
sl@0	3673	for (eol = dst; eol < dstEnd; eol++) {
sl@0	3674	if (*eol == '\n') {
sl@0	3675	skip = 1;
sl@0	3676	goto goteol;
sl@0	3677	}
sl@0	3678	}
sl@0	3679	break;
sl@0	3680	}
sl@0	3681	case TCL_TRANSLATE_CR: {
sl@0	3682	for (eol = dst; eol < dstEnd; eol++) {
sl@0	3683	if (*eol == '\r') {
sl@0	3684	skip = 1;
sl@0	3685	goto goteol;
sl@0	3686	}
sl@0	3687	}
sl@0	3688	break;
sl@0	3689	}
sl@0	3690	case TCL_TRANSLATE_CRLF: {
sl@0	3691	for (eol = dst; eol < dstEnd; eol++) {
sl@0	3692	if (*eol == '\r') {
sl@0	3693	eol++;
sl@0	3694	if (eol >= dstEnd) {
sl@0	3695	int offset;
sl@0	3696
sl@0	3697	offset = eol - objPtr->bytes;
sl@0	3698	dst = dstEnd;
sl@0	3699	if (FilterInputBytes(chanPtr, &gs) != 0) {
sl@0	3700	goto restore;
sl@0	3701	}
sl@0	3702	dstEnd = dst + gs.bytesWrote;
sl@0	3703	eol = objPtr->bytes + offset;
sl@0	3704	if (eol >= dstEnd) {
sl@0	3705	skip = 0;
sl@0	3706	goto goteol;
sl@0	3707	}
sl@0	3708	}
sl@0	3709	if (*eol == '\n') {
sl@0	3710	eol--;
sl@0	3711	skip = 2;
sl@0	3712	goto goteol;
sl@0	3713	}
sl@0	3714	}
sl@0	3715	}
sl@0	3716	break;
sl@0	3717	}
sl@0	3718	case TCL_TRANSLATE_AUTO: {
sl@0	3719	eol = dst;
sl@0	3720	skip = 1;
sl@0	3721	if (statePtr->flags & INPUT_SAW_CR) {
sl@0	3722	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	3723	if (*eol == '\n') {
sl@0	3724	/*
sl@0	3725	* Skip the raw bytes that make up the '\n'.
sl@0	3726	*/
sl@0	3727
sl@0	3728	char tmp[1 + TCL_UTF_MAX];
sl@0	3729	int rawRead;
sl@0	3730
sl@0	3731	bufPtr = gs.bufPtr;
sl@0	3732	Tcl_ExternalToUtf(NULL, gs.encoding,
sl@0	3733	bufPtr->buf + bufPtr->nextRemoved,
sl@0	3734	gs.rawRead, statePtr->inputEncodingFlags,
sl@0	3735	&gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
sl@0	3736	NULL, NULL);
sl@0	3737	bufPtr->nextRemoved += rawRead;
sl@0	3738	gs.rawRead -= rawRead;
sl@0	3739	gs.bytesWrote--;
sl@0	3740	gs.charsWrote--;
sl@0	3741	memmove(dst, dst + 1, (size_t) (dstEnd - dst));
sl@0	3742	dstEnd--;
sl@0	3743	}
sl@0	3744	}
sl@0	3745	for (eol = dst; eol < dstEnd; eol++) {
sl@0	3746	if (*eol == '\r') {
sl@0	3747	eol++;
sl@0	3748	if (eol == dstEnd) {
sl@0	3749	/*
sl@0	3750	* If buffer ended on \r, peek ahead to see if a
sl@0	3751	* \n is available.
sl@0	3752	*/
sl@0	3753
sl@0	3754	int offset;
sl@0	3755
sl@0	3756	offset = eol - objPtr->bytes;
sl@0	3757	dst = dstEnd;
sl@0	3758	PeekAhead(chanPtr, &dstEnd, &gs);
sl@0	3759	eol = objPtr->bytes + offset;
sl@0	3760	if (eol >= dstEnd) {
sl@0	3761	eol--;
sl@0	3762	statePtr->flags \|= INPUT_SAW_CR;
sl@0	3763	goto goteol;
sl@0	3764	}
sl@0	3765	}
sl@0	3766	if (*eol == '\n') {
sl@0	3767	skip++;
sl@0	3768	}
sl@0	3769	eol--;
sl@0	3770	goto goteol;
sl@0	3771	} else if (*eol == '\n') {
sl@0	3772	goto goteol;
sl@0	3773	}
sl@0	3774	}
sl@0	3775	}
sl@0	3776	}
sl@0	3777	if (eof != NULL) {
sl@0	3778	/*
sl@0	3779	* EOF character was seen. On EOF, leave current file position
sl@0	3780	* pointing at the EOF character, but don't store the EOF
sl@0	3781	* character in the output string.
sl@0	3782	*/
sl@0	3783
sl@0	3784	dstEnd = eof;
sl@0	3785	statePtr->flags \|= (CHANNEL_EOF \| CHANNEL_STICKY_EOF);
sl@0	3786	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	3787	}
sl@0	3788	if (statePtr->flags & CHANNEL_EOF) {
sl@0	3789	skip = 0;
sl@0	3790	eol = dstEnd;
sl@0	3791	if (eol == objPtr->bytes + oldLength) {
sl@0	3792	/*
sl@0	3793	* If we didn't append any bytes before encountering EOF,
sl@0	3794	* caller needs to see -1.
sl@0	3795	*/
sl@0	3796
sl@0	3797	Tcl_SetObjLength(objPtr, oldLength);
sl@0	3798	CommonGetsCleanup(chanPtr, encoding);
sl@0	3799	copiedTotal = -1;
sl@0	3800	goto done;
sl@0	3801	}
sl@0	3802	goto goteol;
sl@0	3803	}
sl@0	3804	dst = dstEnd;
sl@0	3805	}
sl@0	3806
sl@0	3807	/*
sl@0	3808	* Found EOL or EOF, but the output buffer may now contain too many
sl@0	3809	* UTF-8 characters. We need to know how many raw bytes correspond to
sl@0	3810	* the number of UTF-8 characters we want, plus how many raw bytes
sl@0	3811	* correspond to the character(s) making up EOL (if any), so we can
sl@0	3812	* remove the correct number of bytes from the channel buffer.
sl@0	3813	*/
sl@0	3814
sl@0	3815	goteol:
sl@0	3816	bufPtr = gs.bufPtr;
sl@0	3817	statePtr->inputEncodingState = gs.state;
sl@0	3818	Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
sl@0	3819	gs.rawRead, statePtr->inputEncodingFlags,
sl@0	3820	&statePtr->inputEncodingState, dst,
sl@0	3821	eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
sl@0	3822	&gs.charsWrote);
sl@0	3823	bufPtr->nextRemoved += gs.rawRead;
sl@0	3824
sl@0	3825	/*
sl@0	3826	* Recycle all the emptied buffers.
sl@0	3827	*/
sl@0	3828
sl@0	3829	Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
sl@0	3830	CommonGetsCleanup(chanPtr, encoding);
sl@0	3831	statePtr->flags &= ~CHANNEL_BLOCKED;
sl@0	3832	copiedTotal = gs.totalChars + gs.charsWrote - skip;
sl@0	3833	goto done;
sl@0	3834
sl@0	3835	/*
sl@0	3836	* Couldn't get a complete line. This only happens if we get a error
sl@0	3837	* reading from the channel or we are non-blocking and there wasn't
sl@0	3838	* an EOL or EOF in the data available.
sl@0	3839	*/
sl@0	3840
sl@0	3841	restore:
sl@0	3842	bufPtr = statePtr->inQueueHead;
sl@0	3843	bufPtr->nextRemoved = oldRemoved;
sl@0	3844
sl@0	3845	for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
sl@0	3846	bufPtr->nextRemoved = BUFFER_PADDING;
sl@0	3847	}
sl@0	3848	CommonGetsCleanup(chanPtr, encoding);
sl@0	3849
sl@0	3850	statePtr->inputEncodingState = oldState;
sl@0	3851	statePtr->inputEncodingFlags = oldFlags;
sl@0	3852	Tcl_SetObjLength(objPtr, oldLength);
sl@0	3853
sl@0	3854	/*
sl@0	3855	* We didn't get a complete line so we need to indicate to UpdateInterest
sl@0	3856	* that the gets blocked. It will wait for more data instead of firing
sl@0	3857	* a timer, avoiding a busy wait. This is where we are assuming that the
sl@0	3858	* next operation is a gets. No more file events will be delivered on
sl@0	3859	* this channel until new data arrives or some operation is performed
sl@0	3860	* on the channel (e.g. gets, read, fconfigure) that changes the blocking
sl@0	3861	* state. Note that this means a file event will not be delivered even
sl@0	3862	* though a read would be able to consume the buffered data.
sl@0	3863	*/
sl@0	3864
sl@0	3865	statePtr->flags \|= CHANNEL_NEED_MORE_DATA;
sl@0	3866	copiedTotal = -1;
sl@0	3867
sl@0	3868	done:
sl@0	3869	/*
sl@0	3870	* Update the notifier state so we don't block while there is still
sl@0	3871	* data in the buffers.
sl@0	3872	*/
sl@0	3873
sl@0	3874	UpdateInterest(chanPtr);
sl@0	3875	return copiedTotal;
sl@0	3876	}
sl@0	3877
sl@0	3878	/*
sl@0	3879	*---------------------------------------------------------------------------
sl@0	3880	*
sl@0	3881	* FilterInputBytes --
sl@0	3882	*
sl@0	3883	* Helper function for Tcl_GetsObj. Produces UTF-8 characters from
sl@0	3884	* raw bytes read from the channel.
sl@0	3885	*
sl@0	3886	* Consumes available bytes from channel buffers. When channel
sl@0	3887	* buffers are exhausted, reads more bytes from channel device into
sl@0	3888	* a new channel buffer. It is the caller's responsibility to
sl@0	3889	* free the channel buffers that have been exhausted.
sl@0	3890	*
sl@0	3891	* Results:
sl@0	3892	* The return value is -1 if there was an error reading from the
sl@0	3893	* channel, 0 otherwise.
sl@0	3894	*
sl@0	3895	* Side effects:
sl@0	3896	* Status object keeps track of how much data from channel buffers
sl@0	3897	* has been consumed and where UTF-8 bytes should be stored.
sl@0	3898	*
sl@0	3899	*---------------------------------------------------------------------------
sl@0	3900	*/
sl@0	3901
sl@0	3902	static int
sl@0	3903	FilterInputBytes(chanPtr, gsPtr)
sl@0	3904	Channel chanPtr; / Channel to read. */
sl@0	3905	GetsState gsPtr; / Current state of gets operation. */
sl@0	3906	{
sl@0	3907	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	3908	ChannelBuffer *bufPtr;
sl@0	3909	char raw, rawStart, *rawEnd;
sl@0	3910	char *dst;
sl@0	3911	int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
sl@0	3912	Tcl_Obj *objPtr;
sl@0	3913	#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert
sl@0	3914	* at a time. Since we don't know a priori
sl@0	3915	* how many bytes of storage this many source
sl@0	3916	* bytes will use, we actually need at least
sl@0	3917	* ENCODING_LINESIZE * TCL_MAX_UTF bytes of
sl@0	3918	* room. */
sl@0	3919
sl@0	3920	objPtr = gsPtr->objPtr;
sl@0	3921
sl@0	3922	/*
sl@0	3923	* Subtract the number of bytes that were removed from channel buffer
sl@0	3924	* during last call.
sl@0	3925	*/
sl@0	3926
sl@0	3927	bufPtr = gsPtr->bufPtr;
sl@0	3928	if (bufPtr != NULL) {
sl@0	3929	bufPtr->nextRemoved += gsPtr->rawRead;
sl@0	3930	if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
sl@0	3931	bufPtr = bufPtr->nextPtr;
sl@0	3932	}
sl@0	3933	}
sl@0	3934	gsPtr->totalChars += gsPtr->charsWrote;
sl@0	3935
sl@0	3936	if ((bufPtr == NULL) \|\| (bufPtr->nextAdded == BUFFER_PADDING)) {
sl@0	3937	/*
sl@0	3938	* All channel buffers were exhausted and the caller still hasn't
sl@0	3939	* seen EOL. Need to read more bytes from the channel device.
sl@0	3940	* Side effect is to allocate another channel buffer.
sl@0	3941	*/
sl@0	3942
sl@0	3943	read:
sl@0	3944	if (statePtr->flags & CHANNEL_BLOCKED) {
sl@0	3945	if (statePtr->flags & CHANNEL_NONBLOCKING) {
sl@0	3946	gsPtr->charsWrote = 0;
sl@0	3947	gsPtr->rawRead = 0;
sl@0	3948	return -1;
sl@0	3949	}
sl@0	3950	statePtr->flags &= ~CHANNEL_BLOCKED;
sl@0	3951	}
sl@0	3952	if (GetInput(chanPtr) != 0) {
sl@0	3953	gsPtr->charsWrote = 0;
sl@0	3954	gsPtr->rawRead = 0;
sl@0	3955	return -1;
sl@0	3956	}
sl@0	3957	bufPtr = statePtr->inQueueTail;
sl@0	3958	gsPtr->bufPtr = bufPtr;
sl@0	3959	}
sl@0	3960
sl@0	3961	/*
sl@0	3962	* Convert some of the bytes from the channel buffer to UTF-8. Space in
sl@0	3963	* objPtr's string rep is used to hold the UTF-8 characters. Grow the
sl@0	3964	* string rep if we need more space.
sl@0	3965	*/
sl@0	3966
sl@0	3967	rawStart = bufPtr->buf + bufPtr->nextRemoved;
sl@0	3968	raw = rawStart;
sl@0	3969	rawEnd = bufPtr->buf + bufPtr->nextAdded;
sl@0	3970	rawLen = rawEnd - rawStart;
sl@0	3971
sl@0	3972	dst = *gsPtr->dstPtr;
sl@0	3973	offset = dst - objPtr->bytes;
sl@0	3974	toRead = ENCODING_LINESIZE;
sl@0	3975	if (toRead > rawLen) {
sl@0	3976	toRead = rawLen;
sl@0	3977	}
sl@0	3978	dstNeeded = toRead * TCL_UTF_MAX + 1;
sl@0	3979	spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
sl@0	3980	if (dstNeeded > spaceLeft) {
sl@0	3981	length = offset * 2;
sl@0	3982	if (offset < dstNeeded) {
sl@0	3983	length = offset + dstNeeded;
sl@0	3984	}
sl@0	3985	length += TCL_UTF_MAX + 1;
sl@0	3986	Tcl_SetObjLength(objPtr, length);
sl@0	3987	spaceLeft = length - offset;
sl@0	3988	dst = objPtr->bytes + offset;
sl@0	3989	*gsPtr->dstPtr = dst;
sl@0	3990	}
sl@0	3991	gsPtr->state = statePtr->inputEncodingState;
sl@0	3992	result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
sl@0	3993	statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
sl@0	3994	dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
sl@0	3995	&gsPtr->charsWrote);
sl@0	3996
sl@0	3997	/*
sl@0	3998	* Make sure that if we go through 'gets', that we reset the
sl@0	3999	* TCL_ENCODING_START flag still. [Bug #523988]
sl@0	4000	*/
sl@0	4001	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
sl@0	4002
sl@0	4003	if (result == TCL_CONVERT_MULTIBYTE) {
sl@0	4004	/*
sl@0	4005	* The last few bytes in this channel buffer were the start of a
sl@0	4006	* multibyte sequence. If this buffer was full, then move them to
sl@0	4007	* the next buffer so the bytes will be contiguous.
sl@0	4008	*/
sl@0	4009
sl@0	4010	ChannelBuffer *nextPtr;
sl@0	4011	int extra;
sl@0	4012
sl@0	4013	nextPtr = bufPtr->nextPtr;
sl@0	4014	if (bufPtr->nextAdded < bufPtr->bufLength) {
sl@0	4015	if (gsPtr->rawRead > 0) {
sl@0	4016	/*
sl@0	4017	* Some raw bytes were converted to UTF-8. Fall through,
sl@0	4018	* returning those UTF-8 characters because a EOL might be
sl@0	4019	* present in them.
sl@0	4020	*/
sl@0	4021	} else if (statePtr->flags & CHANNEL_EOF) {
sl@0	4022	/*
sl@0	4023	* There was a partial character followed by EOF on the
sl@0	4024	* device. Fall through, returning that nothing was found.
sl@0	4025	*/
sl@0	4026
sl@0	4027	bufPtr->nextRemoved = bufPtr->nextAdded;
sl@0	4028	} else {
sl@0	4029	/*
sl@0	4030	* There are no more cached raw bytes left. See if we can
sl@0	4031	* get some more.
sl@0	4032	*/
sl@0	4033
sl@0	4034	goto read;
sl@0	4035	}
sl@0	4036	} else {
sl@0	4037	if (nextPtr == NULL) {
sl@0	4038	nextPtr = AllocChannelBuffer(statePtr->bufSize);
sl@0	4039	bufPtr->nextPtr = nextPtr;
sl@0	4040	statePtr->inQueueTail = nextPtr;
sl@0	4041	}
sl@0	4042	extra = rawLen - gsPtr->rawRead;
sl@0	4043	memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
sl@0	4044	(VOID *) (raw + gsPtr->rawRead), (size_t) extra);
sl@0	4045	nextPtr->nextRemoved -= extra;
sl@0	4046	bufPtr->nextAdded -= extra;
sl@0	4047	}
sl@0	4048	}
sl@0	4049
sl@0	4050	gsPtr->bufPtr = bufPtr;
sl@0	4051	return 0;
sl@0	4052	}
sl@0	4053
sl@0	4054	/*
sl@0	4055	*---------------------------------------------------------------------------
sl@0	4056	*
sl@0	4057	* PeekAhead --
sl@0	4058	*
sl@0	4059	* Helper function used by Tcl_GetsObj(). Called when we've seen a
sl@0	4060	* \r at the end of the UTF-8 string and want to look ahead one
sl@0	4061	* character to see if it is a \n.
sl@0	4062	*
sl@0	4063	* Results:
sl@0	4064	* *gsPtr->dstPtr is filled with a pointer to the start of the range of
sl@0	4065	* UTF-8 characters that were found by peeking and *dstEndPtr is filled
sl@0	4066	* with a pointer to the bytes just after the end of the range.
sl@0	4067	*
sl@0	4068	* Side effects:
sl@0	4069	* If no more raw bytes were available in one of the channel buffers,
sl@0	4070	* tries to perform a non-blocking read to get more bytes from the
sl@0	4071	* channel device.
sl@0	4072	*
sl@0	4073	*---------------------------------------------------------------------------
sl@0	4074	*/
sl@0	4075
sl@0	4076	static void
sl@0	4077	PeekAhead(chanPtr, dstEndPtr, gsPtr)
sl@0	4078	Channel chanPtr; / The channel to read. */
sl@0	4079	char *dstEndPtr; / Filled with pointer to end of new range
sl@0	4080	* of UTF-8 characters. */
sl@0	4081	GetsState gsPtr; / Current state of gets operation. */
sl@0	4082	{
sl@0	4083	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	4084	ChannelBuffer *bufPtr;
sl@0	4085	Tcl_DriverBlockModeProc *blockModeProc;
sl@0	4086	int bytesLeft;
sl@0	4087
sl@0	4088	bufPtr = gsPtr->bufPtr;
sl@0	4089
sl@0	4090	/*
sl@0	4091	* If there's any more raw input that's still buffered, we'll peek into
sl@0	4092	* that. Otherwise, only get more data from the channel driver if it
sl@0	4093	* looks like there might actually be more data. The assumption is that
sl@0	4094	* if the channel buffer is filled right up to the end, then there
sl@0	4095	* might be more data to read.
sl@0	4096	*/
sl@0	4097
sl@0	4098	blockModeProc = NULL;
sl@0	4099	if (bufPtr->nextPtr == NULL) {
sl@0	4100	bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
sl@0	4101	if (bytesLeft == 0) {
sl@0	4102	if (bufPtr->nextAdded < bufPtr->bufLength) {
sl@0	4103	/*
sl@0	4104	* Don't peek ahead if last read was short read.
sl@0	4105	*/
sl@0	4106
sl@0	4107	goto cleanup;
sl@0	4108	}
sl@0	4109	if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
sl@0	4110	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
sl@0	4111	if (blockModeProc == NULL) {
sl@0	4112	/*
sl@0	4113	* Don't peek ahead if cannot set non-blocking mode.
sl@0	4114	*/
sl@0	4115
sl@0	4116	goto cleanup;
sl@0	4117	}
sl@0	4118	StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
sl@0	4119	}
sl@0	4120	}
sl@0	4121	}
sl@0	4122	if (FilterInputBytes(chanPtr, gsPtr) == 0) {
sl@0	4123	dstEndPtr = gsPtr->dstPtr + gsPtr->bytesWrote;
sl@0	4124	}
sl@0	4125	if (blockModeProc != NULL) {
sl@0	4126	StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
sl@0	4127	}
sl@0	4128	return;
sl@0	4129
sl@0	4130	cleanup:
sl@0	4131	bufPtr->nextRemoved += gsPtr->rawRead;
sl@0	4132	gsPtr->rawRead = 0;
sl@0	4133	gsPtr->totalChars += gsPtr->charsWrote;
sl@0	4134	gsPtr->bytesWrote = 0;
sl@0	4135	gsPtr->charsWrote = 0;
sl@0	4136	}
sl@0	4137
sl@0	4138	/*
sl@0	4139	*---------------------------------------------------------------------------
sl@0	4140	*
sl@0	4141	* CommonGetsCleanup --
sl@0	4142	*
sl@0	4143	* Helper function for Tcl_GetsObj() to restore the channel after
sl@0	4144	* a "gets" operation.
sl@0	4145	*
sl@0	4146	* Results:
sl@0	4147	* None.
sl@0	4148	*
sl@0	4149	* Side effects:
sl@0	4150	* Encoding may be freed.
sl@0	4151	*
sl@0	4152	*---------------------------------------------------------------------------
sl@0	4153	*/
sl@0	4154
sl@0	4155	static void
sl@0	4156	CommonGetsCleanup(chanPtr, encoding)
sl@0	4157	Channel *chanPtr;
sl@0	4158	Tcl_Encoding encoding;
sl@0	4159	{
sl@0	4160	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	4161	ChannelBuffer bufPtr, nextPtr;
sl@0	4162
sl@0	4163	bufPtr = statePtr->inQueueHead;
sl@0	4164	for ( ; bufPtr != NULL; bufPtr = nextPtr) {
sl@0	4165	nextPtr = bufPtr->nextPtr;
sl@0	4166	if (bufPtr->nextRemoved < bufPtr->nextAdded) {
sl@0	4167	break;
sl@0	4168	}
sl@0	4169	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	4170	}
sl@0	4171	statePtr->inQueueHead = bufPtr;
sl@0	4172	if (bufPtr == NULL) {
sl@0	4173	statePtr->inQueueTail = NULL;
sl@0	4174	} else {
sl@0	4175	/*
sl@0	4176	* If any multi-byte characters were split across channel buffer
sl@0	4177	* boundaries, the split-up bytes were moved to the next channel
sl@0	4178	* buffer by FilterInputBytes(). Move the bytes back to their
sl@0	4179	* original buffer because the caller could change the channel's
sl@0	4180	* encoding which could change the interpretation of whether those
sl@0	4181	* bytes really made up multi-byte characters after all.
sl@0	4182	*/
sl@0	4183
sl@0	4184	nextPtr = bufPtr->nextPtr;
sl@0	4185	for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
sl@0	4186	int extra;
sl@0	4187
sl@0	4188	extra = bufPtr->bufLength - bufPtr->nextAdded;
sl@0	4189	if (extra > 0) {
sl@0	4190	memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
sl@0	4191	(VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
sl@0	4192	(size_t) extra);
sl@0	4193	bufPtr->nextAdded += extra;
sl@0	4194	nextPtr->nextRemoved = BUFFER_PADDING;
sl@0	4195	}
sl@0	4196	bufPtr = nextPtr;
sl@0	4197	}
sl@0	4198	}
sl@0	4199	if (statePtr->encoding == NULL) {
sl@0	4200	Tcl_FreeEncoding(encoding);
sl@0	4201	}
sl@0	4202	}
sl@0	4203
sl@0	4204	/*
sl@0	4205	*----------------------------------------------------------------------
sl@0	4206	*
sl@0	4207	* Tcl_Read --
sl@0	4208	*
sl@0	4209	* Reads a given number of bytes from a channel. EOL and EOF
sl@0	4210	* translation is done on the bytes being read, so the the number
sl@0	4211	* of bytes consumed from the channel may not be equal to the
sl@0	4212	* number of bytes stored in the destination buffer.
sl@0	4213	*
sl@0	4214	* No encoding conversions are applied to the bytes being read.
sl@0	4215	*
sl@0	4216	* Results:
sl@0	4217	* The number of bytes read, or -1 on error. Use Tcl_GetErrno()
sl@0	4218	* to retrieve the error code for the error that occurred.
sl@0	4219	*
sl@0	4220	* Side effects:
sl@0	4221	* May cause input to be buffered.
sl@0	4222	*
sl@0	4223	*----------------------------------------------------------------------
sl@0	4224	*/
sl@0	4225
sl@0	4226	EXPORT_C int
sl@0	4227	Tcl_Read(chan, dst, bytesToRead)
sl@0	4228	Tcl_Channel chan; /* The channel from which to read. */
sl@0	4229	char dst; / Where to store input read. */
sl@0	4230	int bytesToRead; /* Maximum number of bytes to read. */
sl@0	4231	{
sl@0	4232	Channel chanPtr = (Channel ) chan;
sl@0	4233	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	4234
sl@0	4235	/*
sl@0	4236	* This operation should occur at the top of a channel stack.
sl@0	4237	*/
sl@0	4238
sl@0	4239	chanPtr = statePtr->topChanPtr;
sl@0	4240
sl@0	4241	if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
sl@0	4242	return -1;
sl@0	4243	}
sl@0	4244
sl@0	4245	return DoRead(chanPtr, dst, bytesToRead);
sl@0	4246	}
sl@0	4247
sl@0	4248	/*
sl@0	4249	*----------------------------------------------------------------------
sl@0	4250	*
sl@0	4251	* Tcl_ReadRaw --
sl@0	4252	*
sl@0	4253	* Reads a given number of bytes from a channel. EOL and EOF
sl@0	4254	* translation is done on the bytes being read, so the the number
sl@0	4255	* of bytes consumed from the channel may not be equal to the
sl@0	4256	* number of bytes stored in the destination buffer.
sl@0	4257	*
sl@0	4258	* No encoding conversions are applied to the bytes being read.
sl@0	4259	*
sl@0	4260	* Results:
sl@0	4261	* The number of bytes read, or -1 on error. Use Tcl_GetErrno()
sl@0	4262	* to retrieve the error code for the error that occurred.
sl@0	4263	*
sl@0	4264	* Side effects:
sl@0	4265	* May cause input to be buffered.
sl@0	4266	*
sl@0	4267	*----------------------------------------------------------------------
sl@0	4268	*/
sl@0	4269
sl@0	4270	EXPORT_C int
sl@0	4271	Tcl_ReadRaw(chan, bufPtr, bytesToRead)
sl@0	4272	Tcl_Channel chan; /* The channel from which to read. */
sl@0	4273	char bufPtr; / Where to store input read. */
sl@0	4274	int bytesToRead; /* Maximum number of bytes to read. */
sl@0	4275	{
sl@0	4276	Channel chanPtr = (Channel ) chan;
sl@0	4277	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	4278	int nread, result;
sl@0	4279	int copied, copiedNow;
sl@0	4280
sl@0	4281	/*
sl@0	4282	* The check below does too much because it will reject a call to this
sl@0	4283	* function with a channel which is part of an 'fcopy'. But we have to
sl@0	4284	* allow this here or else the chaining in the transformation drivers
sl@0	4285	* will fail with 'file busy' error instead of retrieving and
sl@0	4286	* transforming the data to copy.
sl@0	4287	*
sl@0	4288	* We let the check procedure now believe that there is no fcopy in
sl@0	4289	* progress. A better solution than this might be an additional flag
sl@0	4290	* argument to switch off specific checks.
sl@0	4291	*/
sl@0	4292
sl@0	4293	if (CheckChannelErrors(statePtr, TCL_READABLE \| CHANNEL_RAW_MODE) != 0) {
sl@0	4294	return -1;
sl@0	4295	}
sl@0	4296
sl@0	4297	/*
sl@0	4298	* Check for information in the push-back buffers. If there is
sl@0	4299	* some, use it. Go to the driver only if there is none (anymore)
sl@0	4300	* and the caller requests more bytes.
sl@0	4301	*/
sl@0	4302
sl@0	4303	for (copied = 0; copied < bytesToRead; copied += copiedNow) {
sl@0	4304	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
sl@0	4305	bytesToRead - copied);
sl@0	4306	if (copiedNow == 0) {
sl@0	4307	if (statePtr->flags & CHANNEL_EOF) {
sl@0	4308	goto done;
sl@0	4309	}
sl@0	4310	if (statePtr->flags & CHANNEL_BLOCKED) {
sl@0	4311	if (statePtr->flags & CHANNEL_NONBLOCKING) {
sl@0	4312	goto done;
sl@0	4313	}
sl@0	4314	statePtr->flags &= (~(CHANNEL_BLOCKED));
sl@0	4315	}
sl@0	4316
sl@0	4317	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	4318	/* [SF Tcl Bug 943274]. Better emulation of non-blocking
sl@0	4319	* channels for channels without BlockModeProc, by keeping
sl@0	4320	* track of true fileevents generated by the OS == Data
sl@0	4321	* waiting and reading if and only if we are sure to have
sl@0	4322	* data.
sl@0	4323	*/
sl@0	4324
sl@0	4325	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
sl@0	4326	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
sl@0	4327	!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
sl@0	4328
sl@0	4329	/* We bypass the driver, it would block, as no data is available */
sl@0	4330	nread = -1;
sl@0	4331	result = EWOULDBLOCK;
sl@0	4332	} else {
sl@0	4333	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	4334	/*
sl@0	4335	* Now go to the driver to get as much as is possible to
sl@0	4336	* fill the remaining request. Do all the error handling
sl@0	4337	* by ourselves. The code was stolen from 'GetInput' and
sl@0	4338	* slightly adapted (different return value here).
sl@0	4339	*
sl@0	4340	* The case of 'bytesToRead == 0' at this point cannot happen.
sl@0	4341	*/
sl@0	4342
sl@0	4343	nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
sl@0	4344	bufPtr + copied, bytesToRead - copied, &result);
sl@0	4345	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	4346	}
sl@0	4347	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	4348	if (nread > 0) {
sl@0	4349	/*
sl@0	4350	* If we get a short read, signal up that we may be
sl@0	4351	* BLOCKED. We should avoid calling the driver because
sl@0	4352	* on some platforms we will block in the low level
sl@0	4353	* reading code even though the channel is set into
sl@0	4354	* nonblocking mode.
sl@0	4355	*/
sl@0	4356
sl@0	4357	if (nread < (bytesToRead - copied)) {
sl@0	4358	statePtr->flags \|= CHANNEL_BLOCKED;
sl@0	4359	}
sl@0	4360
sl@0	4361	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	4362	if (nread <= (bytesToRead - copied)) {
sl@0	4363	/* [SF Tcl Bug 943274] We have read the available
sl@0	4364	* data, clear flag */
sl@0	4365	statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
sl@0	4366	}
sl@0	4367	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	4368	} else if (nread == 0) {
sl@0	4369	statePtr->flags \|= CHANNEL_EOF;
sl@0	4370	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	4371	} else if (nread < 0) {
sl@0	4372	if ((result == EWOULDBLOCK) \|\| (result == EAGAIN)) {
sl@0	4373	if (copied > 0) {
sl@0	4374	/*
sl@0	4375	* Information that was copied earlier has precedence
sl@0	4376	* over EAGAIN/WOULDBLOCK handling.
sl@0	4377	*/
sl@0	4378	return copied;
sl@0	4379	}
sl@0	4380
sl@0	4381	statePtr->flags \|= CHANNEL_BLOCKED;
sl@0	4382	result = EAGAIN;
sl@0	4383	}
sl@0	4384
sl@0	4385	Tcl_SetErrno(result);
sl@0	4386	return -1;
sl@0	4387	}
sl@0	4388
sl@0	4389	return copied + nread;
sl@0	4390	}
sl@0	4391	}
sl@0	4392
sl@0	4393	done:
sl@0	4394	return copied;
sl@0	4395	}
sl@0	4396
sl@0	4397	/*
sl@0	4398	*---------------------------------------------------------------------------
sl@0	4399	*
sl@0	4400	* Tcl_ReadChars --
sl@0	4401	*
sl@0	4402	* Reads from the channel until the requested number of characters
sl@0	4403	* have been seen, EOF is seen, or the channel would block. EOL
sl@0	4404	* and EOF translation is done. If reading binary data, the raw
sl@0	4405	* bytes are wrapped in a Tcl byte array object. Otherwise, the raw
sl@0	4406	* bytes are converted to UTF-8 using the channel's current encoding
sl@0	4407	* and stored in a Tcl string object.
sl@0	4408	*
sl@0	4409	* Results:
sl@0	4410	* The number of characters read, or -1 on error. Use Tcl_GetErrno()
sl@0	4411	* to retrieve the error code for the error that occurred.
sl@0	4412	*
sl@0	4413	* Side effects:
sl@0	4414	* May cause input to be buffered.
sl@0	4415	*
sl@0	4416	*---------------------------------------------------------------------------
sl@0	4417	*/
sl@0	4418
sl@0	4419	EXPORT_C int
sl@0	4420	Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
sl@0	4421	Tcl_Channel chan; /* The channel to read. */
sl@0	4422	Tcl_Obj objPtr; / Input data is stored in this object. */
sl@0	4423	int toRead; /* Maximum number of characters to store,
sl@0	4424	* or -1 to read all available data (up to EOF
sl@0	4425	* or when channel blocks). */
sl@0	4426	int appendFlag; /* If non-zero, data read from the channel
sl@0	4427	* will be appended to the object. Otherwise,
sl@0	4428	* the data will replace the existing contents
sl@0	4429	* of the object. */
sl@0	4430
sl@0	4431	{
sl@0	4432	Channel* chanPtr = (Channel *) chan;
sl@0	4433	ChannelState* statePtr = chanPtr->state; /* state info for channel */
sl@0	4434
sl@0	4435	/*
sl@0	4436	* This operation should occur at the top of a channel stack.
sl@0	4437	*/
sl@0	4438
sl@0	4439	chanPtr = statePtr->topChanPtr;
sl@0	4440
sl@0	4441	if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
sl@0	4442	/*
sl@0	4443	* Update the notifier state so we don't block while there is still
sl@0	4444	* data in the buffers.
sl@0	4445	*/
sl@0	4446	UpdateInterest(chanPtr);
sl@0	4447	return -1;
sl@0	4448	}
sl@0	4449
sl@0	4450	return DoReadChars (chanPtr, objPtr, toRead, appendFlag);
sl@0	4451	}
sl@0	4452	/*
sl@0	4453	*---------------------------------------------------------------------------
sl@0	4454	*
sl@0	4455	* DoReadChars --
sl@0	4456	*
sl@0	4457	* Reads from the channel until the requested number of characters
sl@0	4458	* have been seen, EOF is seen, or the channel would block. EOL
sl@0	4459	* and EOF translation is done. If reading binary data, the raw
sl@0	4460	* bytes are wrapped in a Tcl byte array object. Otherwise, the raw
sl@0	4461	* bytes are converted to UTF-8 using the channel's current encoding
sl@0	4462	* and stored in a Tcl string object.
sl@0	4463	*
sl@0	4464	* Results:
sl@0	4465	* The number of characters read, or -1 on error. Use Tcl_GetErrno()
sl@0	4466	* to retrieve the error code for the error that occurred.
sl@0	4467	*
sl@0	4468	* Side effects:
sl@0	4469	* May cause input to be buffered.
sl@0	4470	*
sl@0	4471	*---------------------------------------------------------------------------
sl@0	4472	*/
sl@0	4473
sl@0	4474	static int
sl@0	4475	DoReadChars(chanPtr, objPtr, toRead, appendFlag)
sl@0	4476	Channel* chanPtr; /* The channel to read. */
sl@0	4477	Tcl_Obj objPtr; / Input data is stored in this object. */
sl@0	4478	int toRead; /* Maximum number of characters to store,
sl@0	4479	* or -1 to read all available data (up to EOF
sl@0	4480	* or when channel blocks). */
sl@0	4481	int appendFlag; /* If non-zero, data read from the channel
sl@0	4482	* will be appended to the object. Otherwise,
sl@0	4483	* the data will replace the existing contents
sl@0	4484	* of the object. */
sl@0	4485
sl@0	4486	{
sl@0	4487	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	4488	ChannelBuffer *bufPtr;
sl@0	4489	int offset, factor, copied, copiedNow, result;
sl@0	4490	Tcl_Encoding encoding;
sl@0	4491	#define UTF_EXPANSION_FACTOR 1024
sl@0	4492
sl@0	4493	/*
sl@0	4494	* This operation should occur at the top of a channel stack.
sl@0	4495	*/
sl@0	4496
sl@0	4497	chanPtr = statePtr->topChanPtr;
sl@0	4498	encoding = statePtr->encoding;
sl@0	4499	factor = UTF_EXPANSION_FACTOR;
sl@0	4500
sl@0	4501	if (appendFlag == 0) {
sl@0	4502	if (encoding == NULL) {
sl@0	4503	Tcl_SetByteArrayLength(objPtr, 0);
sl@0	4504	} else {
sl@0	4505	Tcl_SetObjLength(objPtr, 0);
sl@0	4506	/*
sl@0	4507	* We're going to access objPtr->bytes directly, so
sl@0	4508	* we must ensure that this is actually a string
sl@0	4509	* object (otherwise it might have been pure Unicode).
sl@0	4510	*/
sl@0	4511	Tcl_GetString(objPtr);
sl@0	4512	}
sl@0	4513	offset = 0;
sl@0	4514	} else {
sl@0	4515	if (encoding == NULL) {
sl@0	4516	Tcl_GetByteArrayFromObj(objPtr, &offset);
sl@0	4517	} else {
sl@0	4518	Tcl_GetStringFromObj(objPtr, &offset);
sl@0	4519	}
sl@0	4520	}
sl@0	4521
sl@0	4522	for (copied = 0; (unsigned) toRead > 0; ) {
sl@0	4523	copiedNow = -1;
sl@0	4524	if (statePtr->inQueueHead != NULL) {
sl@0	4525	if (encoding == NULL) {
sl@0	4526	copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
sl@0	4527	} else {
sl@0	4528	copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
sl@0	4529	&factor);
sl@0	4530	}
sl@0	4531
sl@0	4532	/*
sl@0	4533	* If the current buffer is empty recycle it.
sl@0	4534	*/
sl@0	4535
sl@0	4536	bufPtr = statePtr->inQueueHead;
sl@0	4537	if (bufPtr->nextRemoved == bufPtr->nextAdded) {
sl@0	4538	ChannelBuffer *nextPtr;
sl@0	4539
sl@0	4540	nextPtr = bufPtr->nextPtr;
sl@0	4541	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	4542	statePtr->inQueueHead = nextPtr;
sl@0	4543	if (nextPtr == NULL) {
sl@0	4544	statePtr->inQueueTail = NULL;
sl@0	4545	}
sl@0	4546	}
sl@0	4547	}
sl@0	4548	if (copiedNow < 0) {
sl@0	4549	if (statePtr->flags & CHANNEL_EOF) {
sl@0	4550	break;
sl@0	4551	}
sl@0	4552	if (statePtr->flags & CHANNEL_BLOCKED) {
sl@0	4553	if (statePtr->flags & CHANNEL_NONBLOCKING) {
sl@0	4554	break;
sl@0	4555	}
sl@0	4556	statePtr->flags &= ~CHANNEL_BLOCKED;
sl@0	4557	}
sl@0	4558	result = GetInput(chanPtr);
sl@0	4559	if (result != 0) {
sl@0	4560	if (result == EAGAIN) {
sl@0	4561	break;
sl@0	4562	}
sl@0	4563	copied = -1;
sl@0	4564	goto done;
sl@0	4565	}
sl@0	4566	} else {
sl@0	4567	copied += copiedNow;
sl@0	4568	toRead -= copiedNow;
sl@0	4569	}
sl@0	4570	}
sl@0	4571	statePtr->flags &= ~CHANNEL_BLOCKED;
sl@0	4572	if (encoding == NULL) {
sl@0	4573	Tcl_SetByteArrayLength(objPtr, offset);
sl@0	4574	} else {
sl@0	4575	Tcl_SetObjLength(objPtr, offset);
sl@0	4576	}
sl@0	4577
sl@0	4578	done:
sl@0	4579	/*
sl@0	4580	* Update the notifier state so we don't block while there is still
sl@0	4581	* data in the buffers.
sl@0	4582	*/
sl@0	4583
sl@0	4584	UpdateInterest(chanPtr);
sl@0	4585	return copied;
sl@0	4586	}
sl@0	4587	/*
sl@0	4588	*---------------------------------------------------------------------------
sl@0	4589	*
sl@0	4590	* ReadBytes --
sl@0	4591	*
sl@0	4592	* Reads from the channel until the requested number of bytes have
sl@0	4593	* been seen, EOF is seen, or the channel would block. Bytes from
sl@0	4594	* the channel are stored in objPtr as a ByteArray object. EOL
sl@0	4595	* and EOF translation are done.
sl@0	4596	*
sl@0	4597	* 'bytesToRead' can safely be a very large number because
sl@0	4598	* space is only allocated to hold data read from the channel
sl@0	4599	* as needed.
sl@0	4600	*
sl@0	4601	* Results:
sl@0	4602	* The return value is the number of bytes appended to the object
sl@0	4603	* and *offsetPtr is filled with the total number of bytes in the
sl@0	4604	* object (greater than the return value if there were already bytes
sl@0	4605	* in the object).
sl@0	4606	*
sl@0	4607	* Side effects:
sl@0	4608	* None.
sl@0	4609	*
sl@0	4610	*---------------------------------------------------------------------------
sl@0	4611	*/
sl@0	4612
sl@0	4613	static int
sl@0	4614	ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
sl@0	4615	ChannelState statePtr; / State of the channel to read. */
sl@0	4616	Tcl_Obj objPtr; / Input data is appended to this ByteArray
sl@0	4617	* object. Its length is how much space
sl@0	4618	* has been allocated to hold data, not how
sl@0	4619	* many bytes of data have been stored in the
sl@0	4620	* object. */
sl@0	4621	int bytesToRead; /* Maximum number of bytes to store,
sl@0	4622	* or < 0 to get all available bytes.
sl@0	4623	* Bytes are obtained from the first
sl@0	4624	* buffer in the queue -- even if this number
sl@0	4625	* is larger than the number of bytes
sl@0	4626	* available in the first buffer, only the
sl@0	4627	* bytes from the first buffer are
sl@0	4628	* returned. */
sl@0	4629	int offsetPtr; / On input, contains how many bytes of
sl@0	4630	* objPtr have been used to hold data. On
sl@0	4631	* output, filled with how many bytes are now
sl@0	4632	* being used. */
sl@0	4633	{
sl@0	4634	int toRead, srcLen, offset, length, srcRead, dstWrote;
sl@0	4635	ChannelBuffer *bufPtr;
sl@0	4636	char src, dst;
sl@0	4637
sl@0	4638	offset = *offsetPtr;
sl@0	4639
sl@0	4640	bufPtr = statePtr->inQueueHead;
sl@0	4641	src = bufPtr->buf + bufPtr->nextRemoved;
sl@0	4642	srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
sl@0	4643
sl@0	4644	toRead = bytesToRead;
sl@0	4645	if ((unsigned) toRead > (unsigned) srcLen) {
sl@0	4646	toRead = srcLen;
sl@0	4647	}
sl@0	4648
sl@0	4649	dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
sl@0	4650	if (toRead > length - offset - 1) {
sl@0	4651	/*
sl@0	4652	* Double the existing size of the object or make enough room to
sl@0	4653	* hold all the characters we may get from the source buffer,
sl@0	4654	* whichever is larger.
sl@0	4655	*/
sl@0	4656
sl@0	4657	length = offset * 2;
sl@0	4658	if (offset < toRead) {
sl@0	4659	length = offset + toRead + 1;
sl@0	4660	}
sl@0	4661	dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
sl@0	4662	}
sl@0	4663	dst += offset;
sl@0	4664
sl@0	4665	if (statePtr->flags & INPUT_NEED_NL) {
sl@0	4666	statePtr->flags &= ~INPUT_NEED_NL;
sl@0	4667	if ((srcLen == 0) \|\| (*src != '\n')) {
sl@0	4668	*dst = '\r';
sl@0	4669	*offsetPtr += 1;
sl@0	4670	return 1;
sl@0	4671	}
sl@0	4672	*dst++ = '\n';
sl@0	4673	src++;
sl@0	4674	srcLen--;
sl@0	4675	toRead--;
sl@0	4676	}
sl@0	4677
sl@0	4678	srcRead = srcLen;
sl@0	4679	dstWrote = toRead;
sl@0	4680	if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
sl@0	4681	if (dstWrote == 0) {
sl@0	4682	return -1;
sl@0	4683	}
sl@0	4684	}
sl@0	4685	bufPtr->nextRemoved += srcRead;
sl@0	4686	*offsetPtr += dstWrote;
sl@0	4687	return dstWrote;
sl@0	4688	}
sl@0	4689
sl@0	4690	/*
sl@0	4691	*---------------------------------------------------------------------------
sl@0	4692	*
sl@0	4693	* ReadChars --
sl@0	4694	*
sl@0	4695	* Reads from the channel until the requested number of UTF-8
sl@0	4696	* characters have been seen, EOF is seen, or the channel would
sl@0	4697	* block. Raw bytes from the channel are converted to UTF-8
sl@0	4698	* and stored in objPtr. EOL and EOF translation is done.
sl@0	4699	*
sl@0	4700	* 'charsToRead' can safely be a very large number because
sl@0	4701	* space is only allocated to hold data read from the channel
sl@0	4702	* as needed.
sl@0	4703	*
sl@0	4704	* Results:
sl@0	4705	* The return value is the number of characters appended to
sl@0	4706	* the object, *offsetPtr is filled with the number of bytes that
sl@0	4707	* were appended, and *factorPtr is filled with the expansion
sl@0	4708	* factor used to guess how many bytes of UTF-8 to allocate to
sl@0	4709	* hold N source bytes.
sl@0	4710	*
sl@0	4711	* Side effects:
sl@0	4712	* None.
sl@0	4713	*
sl@0	4714	*---------------------------------------------------------------------------
sl@0	4715	*/
sl@0	4716
sl@0	4717	static int
sl@0	4718	ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
sl@0	4719	ChannelState statePtr; / State of channel to read. */
sl@0	4720	Tcl_Obj objPtr; / Input data is appended to this object.
sl@0	4721	* objPtr->length is how much space has been
sl@0	4722	* allocated to hold data, not how many bytes
sl@0	4723	* of data have been stored in the object. */
sl@0	4724	int charsToRead; /* Maximum number of characters to store,
sl@0	4725	* or -1 to get all available characters.
sl@0	4726	* Characters are obtained from the first
sl@0	4727	* buffer in the queue -- even if this number
sl@0	4728	* is larger than the number of characters
sl@0	4729	* available in the first buffer, only the
sl@0	4730	* characters from the first buffer are
sl@0	4731	* returned. */
sl@0	4732	int offsetPtr; / On input, contains how many bytes of
sl@0	4733	* objPtr have been used to hold data. On
sl@0	4734	* output, filled with how many bytes are now
sl@0	4735	* being used. */
sl@0	4736	int factorPtr; / On input, contains a guess of how many
sl@0	4737	* bytes need to be allocated to hold the
sl@0	4738	* result of converting N source bytes to
sl@0	4739	* UTF-8. On output, contains another guess
sl@0	4740	* based on the data seen so far. */
sl@0	4741	{
sl@0	4742	int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
sl@0	4743	int srcRead, dstWrote, numChars, dstRead;
sl@0	4744	ChannelBuffer *bufPtr;
sl@0	4745	char src, dst;
sl@0	4746	Tcl_EncodingState oldState;
sl@0	4747	int encEndFlagSuppressed = 0;
sl@0	4748
sl@0	4749	factor = *factorPtr;
sl@0	4750	offset = *offsetPtr;
sl@0	4751
sl@0	4752	bufPtr = statePtr->inQueueHead;
sl@0	4753	src = bufPtr->buf + bufPtr->nextRemoved;
sl@0	4754	srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
sl@0	4755
sl@0	4756	toRead = charsToRead;
sl@0	4757	if ((unsigned)toRead > (unsigned)srcLen) {
sl@0	4758	toRead = srcLen;
sl@0	4759	}
sl@0	4760
sl@0	4761	/*
sl@0	4762	* 'factor' is how much we guess that the bytes in the source buffer
sl@0	4763	* will expand when converted to UTF-8 chars. This guess comes from
sl@0	4764	* analyzing how many characters were produced by the previous
sl@0	4765	* pass.
sl@0	4766	*/
sl@0	4767
sl@0	4768	dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
sl@0	4769	spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
sl@0	4770
sl@0	4771	if (dstNeeded > spaceLeft) {
sl@0	4772	/*
sl@0	4773	* Double the existing size of the object or make enough room to
sl@0	4774	* hold all the characters we want from the source buffer,
sl@0	4775	* whichever is larger.
sl@0	4776	*/
sl@0	4777
sl@0	4778	length = offset * 2;
sl@0	4779	if (offset < dstNeeded) {
sl@0	4780	length = offset + dstNeeded;
sl@0	4781	}
sl@0	4782	spaceLeft = length - offset;
sl@0	4783	length += TCL_UTF_MAX + 1;
sl@0	4784	Tcl_SetObjLength(objPtr, length);
sl@0	4785	}
sl@0	4786	if (toRead == srcLen) {
sl@0	4787	/*
sl@0	4788	* Want to convert the whole buffer in one pass. If we have
sl@0	4789	* enough space, convert it using all available space in object
sl@0	4790	* rather than using the factor.
sl@0	4791	*/
sl@0	4792
sl@0	4793	dstNeeded = spaceLeft;
sl@0	4794	}
sl@0	4795	dst = objPtr->bytes + offset;
sl@0	4796
sl@0	4797	/*
sl@0	4798	* SF Tcl Bug 1462248
sl@0	4799	* The cause of the crash reported in the referenced bug is this:
sl@0	4800	*
sl@0	4801	* - ReadChars, called with a single buffer, with a incomplete
sl@0	4802	* multi-byte character at the end (only the first byte of it).
sl@0	4803	* - Encoding translation fails, asks for more data
sl@0	4804	* - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
sl@0	4805	* - ReadChar is called again, converts the first buffer, but due
sl@0	4806	* to TEE it does not check for incomplete multi-byte data, and the
sl@0	4807	* character just after the end of the first buffer is a valid
sl@0	4808	* completion of the multi-byte header in the actual buffer. The
sl@0	4809	* conversion reads more characters from the buffer then present.
sl@0	4810	* This causes nextRemoved to overshoot nextAdded and the next
sl@0	4811	* reads compute a negative srcLen, cause further translations to
sl@0	4812	* fail, causing copying of data into the next buffer using bad
sl@0	4813	* arguments, causing the mecpy for to eventually fail.
sl@0	4814	*
sl@0	4815	* In the end it is a memory access bug spiraling out of control
sl@0	4816	* if the conditions are _just so_. And ultimate cause is that TEE
sl@0	4817	* is given to a conversion where it should not. TEE signals that
sl@0	4818	* this is the last buffer. Except in our case it is not.
sl@0	4819	*
sl@0	4820	* My solution is to suppress TEE if the first buffer is not the
sl@0	4821	* last. We will eventually need it given that EOF has been
sl@0	4822	* reached, but not right now. This is what the new flag
sl@0	4823	* "endEncSuppressFlag" is for.
sl@0	4824	*
sl@0	4825	* The bug in 'Tcl_Utf2UtfProc' where it read from memory behind
sl@0	4826	* the actual buffer has been fixed as well, and fixes the problem
sl@0	4827	* with the crash too, but this would still allow the generic
sl@0	4828	* layer to accidentially break a multi-byte sequence if the
sl@0	4829	* conditions are just right, because again the ExternalToUtf
sl@0	4830	* would be successful where it should not.
sl@0	4831	*/
sl@0	4832
sl@0	4833	if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
sl@0	4834	(bufPtr->nextPtr != NULL)) {
sl@0	4835
sl@0	4836	/* TEE is set for a buffer which is not the last. Squash it
sl@0	4837	* for now, and restore it later, before yielding control to
sl@0	4838	* our caller.
sl@0	4839	*/
sl@0	4840
sl@0	4841	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
sl@0	4842	encEndFlagSuppressed = 1;
sl@0	4843	}
sl@0	4844
sl@0	4845	oldState = statePtr->inputEncodingState;
sl@0	4846	if (statePtr->flags & INPUT_NEED_NL) {
sl@0	4847	/*
sl@0	4848	* We want a '\n' because the last character we saw was '\r'.
sl@0	4849	*/
sl@0	4850
sl@0	4851	statePtr->flags &= ~INPUT_NEED_NL;
sl@0	4852	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
sl@0	4853	statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
sl@0	4854	dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
sl@0	4855	if ((dstWrote > 0) && (*dst == '\n')) {
sl@0	4856	/*
sl@0	4857	* The next char was a '\n'. Consume it and produce a '\n'.
sl@0	4858	*/
sl@0	4859
sl@0	4860	bufPtr->nextRemoved += srcRead;
sl@0	4861	} else {
sl@0	4862	/*
sl@0	4863	* The next char was not a '\n'. Produce a '\r'.
sl@0	4864	*/
sl@0	4865
sl@0	4866	*dst = '\r';
sl@0	4867	}
sl@0	4868	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
sl@0	4869	*offsetPtr += 1;
sl@0	4870
sl@0	4871	if (encEndFlagSuppressed) {
sl@0	4872	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	4873	}
sl@0	4874	return 1;
sl@0	4875	}
sl@0	4876
sl@0	4877	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
sl@0	4878	statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
sl@0	4879	dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
sl@0	4880
sl@0	4881	if (encEndFlagSuppressed) {
sl@0	4882	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	4883	}
sl@0	4884
sl@0	4885	if (srcRead == 0) {
sl@0	4886	/*
sl@0	4887	* Not enough bytes in src buffer to make a complete char. Copy
sl@0	4888	* the bytes to the next buffer to make a new contiguous string,
sl@0	4889	* then tell the caller to fill the buffer with more bytes.
sl@0	4890	*/
sl@0	4891
sl@0	4892	ChannelBuffer *nextPtr;
sl@0	4893
sl@0	4894	nextPtr = bufPtr->nextPtr;
sl@0	4895	if (nextPtr == NULL) {
sl@0	4896	if (srcLen > 0) {
sl@0	4897	/*
sl@0	4898	* There isn't enough data in the buffers to complete the next
sl@0	4899	* character, so we need to wait for more data before the next
sl@0	4900	* file event can be delivered.
sl@0	4901	*
sl@0	4902	* SF #478856.
sl@0	4903	*
sl@0	4904	* The exception to this is if the input buffer was
sl@0	4905	* completely empty before we tried to convert its
sl@0	4906	* contents. Nothing in, nothing out, and no incomplete
sl@0	4907	* character data. The conversion before the current one
sl@0	4908	* was complete.
sl@0	4909	*/
sl@0	4910
sl@0	4911	statePtr->flags \|= CHANNEL_NEED_MORE_DATA;
sl@0	4912	}
sl@0	4913	return -1;
sl@0	4914	}
sl@0	4915
sl@0	4916	/* Space is made at the beginning of the buffer to copy the
sl@0	4917	* previous unused bytes there. Check first if the buffer we
sl@0	4918	* are using actually has enough space at its beginning for
sl@0	4919	* the data we are copying. Because if not we will write over the
sl@0	4920	* buffer management information, especially the 'nextPtr'.
sl@0	4921	*
sl@0	4922	* Note that the BUFFER_PADDING (See AllocChannelBuffer) is
sl@0	4923	* used to prevent exactly this situation. I.e. it should
sl@0	4924	* never happen. Therefore it is ok to panic should it happen
sl@0	4925	* despite the precautions.
sl@0	4926	*/
sl@0	4927
sl@0	4928	if (nextPtr->nextRemoved - srcLen < 0) {
sl@0	4929	Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough");
sl@0	4930	}
sl@0	4931
sl@0	4932	nextPtr->nextRemoved -= srcLen;
sl@0	4933	memcpy((VOID ) (nextPtr->buf + nextPtr->nextRemoved), (VOID ) src,
sl@0	4934	(size_t) srcLen);
sl@0	4935	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	4936	statePtr->inQueueHead = nextPtr;
sl@0	4937	return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
sl@0	4938	}
sl@0	4939
sl@0	4940	dstRead = dstWrote;
sl@0	4941	if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
sl@0	4942	/*
sl@0	4943	* Hit EOF char. How many bytes of src correspond to where the
sl@0	4944	* EOF was located in dst? Run the conversion again with an
sl@0	4945	* output buffer just big enough to hold the data so we can
sl@0	4946	* get the correct value for srcRead.
sl@0	4947	*/
sl@0	4948
sl@0	4949	if (dstWrote == 0) {
sl@0	4950	return -1;
sl@0	4951	}
sl@0	4952	statePtr->inputEncodingState = oldState;
sl@0	4953	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
sl@0	4954	statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
sl@0	4955	dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
sl@0	4956	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
sl@0	4957	}
sl@0	4958
sl@0	4959	/*
sl@0	4960	* The number of characters that we got may be less than the number
sl@0	4961	* that we started with because "\r\n" sequences may have been
sl@0	4962	* turned into just '\n' in dst.
sl@0	4963	*/
sl@0	4964
sl@0	4965	numChars -= (dstRead - dstWrote);
sl@0	4966
sl@0	4967	if ((unsigned) numChars > (unsigned) toRead) {
sl@0	4968	/*
sl@0	4969	* Got too many chars.
sl@0	4970	*/
sl@0	4971
sl@0	4972	CONST char *eof;
sl@0	4973
sl@0	4974	eof = Tcl_UtfAtIndex(dst, toRead);
sl@0	4975	statePtr->inputEncodingState = oldState;
sl@0	4976	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
sl@0	4977	statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
sl@0	4978	dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
sl@0	4979	dstRead = dstWrote;
sl@0	4980	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
sl@0	4981	numChars -= (dstRead - dstWrote);
sl@0	4982	}
sl@0	4983	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
sl@0	4984
sl@0	4985	bufPtr->nextRemoved += srcRead;
sl@0	4986	if (dstWrote > srcRead + 1) {
sl@0	4987	factorPtr = dstWrote UTF_EXPANSION_FACTOR / srcRead;
sl@0	4988	}
sl@0	4989	*offsetPtr += dstWrote;
sl@0	4990	return numChars;
sl@0	4991	}
sl@0	4992
sl@0	4993	/*
sl@0	4994	*---------------------------------------------------------------------------
sl@0	4995	*
sl@0	4996	* TranslateInputEOL --
sl@0	4997	*
sl@0	4998	* Perform input EOL and EOF translation on the source buffer,
sl@0	4999	* leaving the translated result in the destination buffer.
sl@0	5000	*
sl@0	5001	* Results:
sl@0	5002	* The return value is 1 if the EOF character was found when copying
sl@0	5003	* bytes to the destination buffer, 0 otherwise.
sl@0	5004	*
sl@0	5005	* Side effects:
sl@0	5006	* None.
sl@0	5007	*
sl@0	5008	*---------------------------------------------------------------------------
sl@0	5009	*/
sl@0	5010
sl@0	5011	static int
sl@0	5012	TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
sl@0	5013	ChannelState statePtr; / Channel being read, for EOL translation
sl@0	5014	* and EOF character. */
sl@0	5015	char dstStart; / Output buffer filled with chars by
sl@0	5016	* applying appropriate EOL translation to
sl@0	5017	* source characters. */
sl@0	5018	CONST char srcStart; / Source characters. */
sl@0	5019	int dstLenPtr; / On entry, the maximum length of output
sl@0	5020	* buffer in bytes; must be <= *srcLenPtr. On
sl@0	5021	* exit, the number of bytes actually used in
sl@0	5022	* output buffer. */
sl@0	5023	int srcLenPtr; / On entry, the length of source buffer.
sl@0	5024	* On exit, the number of bytes read from
sl@0	5025	* the source buffer. */
sl@0	5026	{
sl@0	5027	int dstLen, srcLen, inEofChar;
sl@0	5028	CONST char *eof;
sl@0	5029
sl@0	5030	dstLen = *dstLenPtr;
sl@0	5031
sl@0	5032	eof = NULL;
sl@0	5033	inEofChar = statePtr->inEofChar;
sl@0	5034	if (inEofChar != '\0') {
sl@0	5035	/*
sl@0	5036	* Find EOF in translated buffer then compress out the EOL. The
sl@0	5037	* source buffer may be much longer than the destination buffer --
sl@0	5038	* we only want to return EOF if the EOF has been copied to the
sl@0	5039	* destination buffer.
sl@0	5040	*/
sl@0	5041
sl@0	5042	CONST char src, srcMax;
sl@0	5043
sl@0	5044	srcMax = srcStart + *srcLenPtr;
sl@0	5045	for (src = srcStart; src < srcMax; src++) {
sl@0	5046	if (*src == inEofChar) {
sl@0	5047	eof = src;
sl@0	5048	srcLen = src - srcStart;
sl@0	5049	if (srcLen < dstLen) {
sl@0	5050	dstLen = srcLen;
sl@0	5051	}
sl@0	5052	*srcLenPtr = srcLen;
sl@0	5053	break;
sl@0	5054	}
sl@0	5055	}
sl@0	5056	}
sl@0	5057	switch (statePtr->inputTranslation) {
sl@0	5058	case TCL_TRANSLATE_LF: {
sl@0	5059	if (dstStart != srcStart) {
sl@0	5060	memcpy((VOID ) dstStart, (VOID ) srcStart, (size_t) dstLen);
sl@0	5061	}
sl@0	5062	srcLen = dstLen;
sl@0	5063	break;
sl@0	5064	}
sl@0	5065	case TCL_TRANSLATE_CR: {
sl@0	5066	char dst, dstEnd;
sl@0	5067
sl@0	5068	if (dstStart != srcStart) {
sl@0	5069	memcpy((VOID ) dstStart, (VOID ) srcStart, (size_t) dstLen);
sl@0	5070	}
sl@0	5071	dstEnd = dstStart + dstLen;
sl@0	5072	for (dst = dstStart; dst < dstEnd; dst++) {
sl@0	5073	if (*dst == '\r') {
sl@0	5074	*dst = '\n';
sl@0	5075	}
sl@0	5076	}
sl@0	5077	srcLen = dstLen;
sl@0	5078	break;
sl@0	5079	}
sl@0	5080	case TCL_TRANSLATE_CRLF: {
sl@0	5081	char *dst;
sl@0	5082	CONST char src, srcEnd, *srcMax;
sl@0	5083
sl@0	5084	dst = dstStart;
sl@0	5085	src = srcStart;
sl@0	5086	srcEnd = srcStart + dstLen;
sl@0	5087	srcMax = srcStart + *srcLenPtr;
sl@0	5088
sl@0	5089	for ( ; src < srcEnd; ) {
sl@0	5090	if (*src == '\r') {
sl@0	5091	src++;
sl@0	5092	if (src >= srcMax) {
sl@0	5093	statePtr->flags \|= INPUT_NEED_NL;
sl@0	5094	} else if (*src == '\n') {
sl@0	5095	dst++ = src++;
sl@0	5096	} else {
sl@0	5097	*dst++ = '\r';
sl@0	5098	}
sl@0	5099	} else {
sl@0	5100	dst++ = src++;
sl@0	5101	}
sl@0	5102	}
sl@0	5103	srcLen = src - srcStart;
sl@0	5104	dstLen = dst - dstStart;
sl@0	5105	break;
sl@0	5106	}
sl@0	5107	case TCL_TRANSLATE_AUTO: {
sl@0	5108	char *dst;
sl@0	5109	CONST char src, srcEnd, *srcMax;
sl@0	5110
sl@0	5111	dst = dstStart;
sl@0	5112	src = srcStart;
sl@0	5113	srcEnd = srcStart + dstLen;
sl@0	5114	srcMax = srcStart + *srcLenPtr;
sl@0	5115
sl@0	5116	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
sl@0	5117	if (*src == '\n') {
sl@0	5118	src++;
sl@0	5119	}
sl@0	5120	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	5121	}
sl@0	5122	for ( ; src < srcEnd; ) {
sl@0	5123	if (*src == '\r') {
sl@0	5124	src++;
sl@0	5125	if (src >= srcMax) {
sl@0	5126	statePtr->flags \|= INPUT_SAW_CR;
sl@0	5127	} else if (*src == '\n') {
sl@0	5128	if (srcEnd < srcMax) {
sl@0	5129	srcEnd++;
sl@0	5130	}
sl@0	5131	src++;
sl@0	5132	}
sl@0	5133	*dst++ = '\n';
sl@0	5134	} else {
sl@0	5135	dst++ = src++;
sl@0	5136	}
sl@0	5137	}
sl@0	5138	srcLen = src - srcStart;
sl@0	5139	dstLen = dst - dstStart;
sl@0	5140	break;
sl@0	5141	}
sl@0	5142	default: { /* lint. */
sl@0	5143	return 0;
sl@0	5144	}
sl@0	5145	}
sl@0	5146	*dstLenPtr = dstLen;
sl@0	5147
sl@0	5148	if ((eof != NULL) && (srcStart + srcLen >= eof)) {
sl@0	5149	/*
sl@0	5150	* EOF character was seen in EOL translated range. Leave current
sl@0	5151	* file position pointing at the EOF character, but don't store the
sl@0	5152	* EOF character in the output string.
sl@0	5153	*/
sl@0	5154
sl@0	5155	statePtr->flags \|= (CHANNEL_EOF \| CHANNEL_STICKY_EOF);
sl@0	5156	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	5157	statePtr->flags &= ~(INPUT_SAW_CR \| INPUT_NEED_NL);
sl@0	5158	return 1;
sl@0	5159	}
sl@0	5160
sl@0	5161	*srcLenPtr = srcLen;
sl@0	5162	return 0;
sl@0	5163	}
sl@0	5164
sl@0	5165	/*
sl@0	5166	*----------------------------------------------------------------------
sl@0	5167	*
sl@0	5168	* Tcl_Ungets --
sl@0	5169	*
sl@0	5170	* Causes the supplied string to be added to the input queue of
sl@0	5171	* the channel, at either the head or tail of the queue.
sl@0	5172	*
sl@0	5173	* Results:
sl@0	5174	* The number of bytes stored in the channel, or -1 on error.
sl@0	5175	*
sl@0	5176	* Side effects:
sl@0	5177	* Adds input to the input queue of a channel.
sl@0	5178	*
sl@0	5179	*----------------------------------------------------------------------
sl@0	5180	*/
sl@0	5181
sl@0	5182	EXPORT_C int
sl@0	5183	Tcl_Ungets(chan, str, len, atEnd)
sl@0	5184	Tcl_Channel chan; /* The channel for which to add the input. */
sl@0	5185	CONST char str; / The input itself. */
sl@0	5186	int len; /* The length of the input. */
sl@0	5187	int atEnd; /* If non-zero, add at end of queue; otherwise
sl@0	5188	* add at head of queue. */
sl@0	5189	{
sl@0	5190	Channel chanPtr; / The real IO channel. */
sl@0	5191	ChannelState statePtr; / State of actual channel. */
sl@0	5192	ChannelBuffer bufPtr; / Buffer to contain the data. */
sl@0	5193	int i, flags;
sl@0	5194
sl@0	5195	chanPtr = (Channel *) chan;
sl@0	5196	statePtr = chanPtr->state;
sl@0	5197
sl@0	5198	/*
sl@0	5199	* This operation should occur at the top of a channel stack.
sl@0	5200	*/
sl@0	5201
sl@0	5202	chanPtr = statePtr->topChanPtr;
sl@0	5203
sl@0	5204	/*
sl@0	5205	* CheckChannelErrors clears too many flag bits in this one case.
sl@0	5206	*/
sl@0	5207
sl@0	5208	flags = statePtr->flags;
sl@0	5209	if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
sl@0	5210	len = -1;
sl@0	5211	goto done;
sl@0	5212	}
sl@0	5213	statePtr->flags = flags;
sl@0	5214
sl@0	5215	/*
sl@0	5216	* If we have encountered a sticky EOF, just punt without storing.
sl@0	5217	* (sticky EOF is set if we have seen the input eofChar, to prevent
sl@0	5218	* reading beyond the eofChar). Otherwise, clear the EOF flags, and
sl@0	5219	* clear the BLOCKED bit. We want to discover these conditions anew
sl@0	5220	* in each operation.
sl@0	5221	*/
sl@0	5222
sl@0	5223	if (statePtr->flags & CHANNEL_STICKY_EOF) {
sl@0	5224	goto done;
sl@0	5225	}
sl@0	5226	statePtr->flags &= (~(CHANNEL_BLOCKED \| CHANNEL_EOF));
sl@0	5227
sl@0	5228	bufPtr = AllocChannelBuffer(len);
sl@0	5229	for (i = 0; i < len; i++) {
sl@0	5230	bufPtr->buf[bufPtr->nextAdded++] = str[i];
sl@0	5231	}
sl@0	5232
sl@0	5233	if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	5234	bufPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	5235	statePtr->inQueueHead = bufPtr;
sl@0	5236	statePtr->inQueueTail = bufPtr;
sl@0	5237	} else if (atEnd) {
sl@0	5238	bufPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	5239	statePtr->inQueueTail->nextPtr = bufPtr;
sl@0	5240	statePtr->inQueueTail = bufPtr;
sl@0	5241	} else {
sl@0	5242	bufPtr->nextPtr = statePtr->inQueueHead;
sl@0	5243	statePtr->inQueueHead = bufPtr;
sl@0	5244	}
sl@0	5245
sl@0	5246	done:
sl@0	5247	/*
sl@0	5248	* Update the notifier state so we don't block while there is still
sl@0	5249	* data in the buffers.
sl@0	5250	*/
sl@0	5251
sl@0	5252	UpdateInterest(chanPtr);
sl@0	5253	return len;
sl@0	5254	}
sl@0	5255
sl@0	5256	/*
sl@0	5257	*----------------------------------------------------------------------
sl@0	5258	*
sl@0	5259	* Tcl_Flush --
sl@0	5260	*
sl@0	5261	* Flushes output data on a channel.
sl@0	5262	*
sl@0	5263	* Results:
sl@0	5264	* A standard Tcl result.
sl@0	5265	*
sl@0	5266	* Side effects:
sl@0	5267	* May flush output queued on this channel.
sl@0	5268	*
sl@0	5269	*----------------------------------------------------------------------
sl@0	5270	*/
sl@0	5271
sl@0	5272	EXPORT_C int
sl@0	5273	Tcl_Flush(chan)
sl@0	5274	Tcl_Channel chan; /* The Channel to flush. */
sl@0	5275	{
sl@0	5276	int result; /* Of calling FlushChannel. */
sl@0	5277	Channel chanPtr = (Channel ) chan; /* The actual channel. */
sl@0	5278	ChannelState statePtr = chanPtr->state; / State of actual channel. */
sl@0	5279
sl@0	5280	/*
sl@0	5281	* This operation should occur at the top of a channel stack.
sl@0	5282	*/
sl@0	5283
sl@0	5284	chanPtr = statePtr->topChanPtr;
sl@0	5285
sl@0	5286	if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
sl@0	5287	return -1;
sl@0	5288	}
sl@0	5289
sl@0	5290	/*
sl@0	5291	* Force current output buffer to be output also.
sl@0	5292	*/
sl@0	5293
sl@0	5294	if ((statePtr->curOutPtr != NULL)
sl@0	5295	&& (statePtr->curOutPtr->nextAdded > 0)) {
sl@0	5296	statePtr->flags \|= BUFFER_READY;
sl@0	5297	}
sl@0	5298
sl@0	5299	result = FlushChannel(NULL, chanPtr, 0);
sl@0	5300	if (result != 0) {
sl@0	5301	return TCL_ERROR;
sl@0	5302	}
sl@0	5303
sl@0	5304	return TCL_OK;
sl@0	5305	}
sl@0	5306
sl@0	5307	/*
sl@0	5308	*----------------------------------------------------------------------
sl@0	5309	*
sl@0	5310	* DiscardInputQueued --
sl@0	5311	*
sl@0	5312	* Discards any input read from the channel but not yet consumed
sl@0	5313	* by Tcl reading commands.
sl@0	5314	*
sl@0	5315	* Results:
sl@0	5316	* None.
sl@0	5317	*
sl@0	5318	* Side effects:
sl@0	5319	* May discard input from the channel. If discardLastBuffer is zero,
sl@0	5320	* leaves one buffer in place for back-filling.
sl@0	5321	*
sl@0	5322	*----------------------------------------------------------------------
sl@0	5323	*/
sl@0	5324
sl@0	5325	static void
sl@0	5326	DiscardInputQueued(statePtr, discardSavedBuffers)
sl@0	5327	ChannelState statePtr; / Channel on which to discard
sl@0	5328	* the queued input. */
sl@0	5329	int discardSavedBuffers; /* If non-zero, discard all buffers including
sl@0	5330	* last one. */
sl@0	5331	{
sl@0	5332	ChannelBuffer bufPtr, nxtPtr; /* Loop variables. */
sl@0	5333
sl@0	5334	bufPtr = statePtr->inQueueHead;
sl@0	5335	statePtr->inQueueHead = (ChannelBuffer *) NULL;
sl@0	5336	statePtr->inQueueTail = (ChannelBuffer *) NULL;
sl@0	5337	for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
sl@0	5338	nxtPtr = bufPtr->nextPtr;
sl@0	5339	RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
sl@0	5340	}
sl@0	5341
sl@0	5342	/*
sl@0	5343	* If discardSavedBuffers is nonzero, must also discard any previously
sl@0	5344	* saved buffer in the saveInBufPtr field.
sl@0	5345	*/
sl@0	5346
sl@0	5347	if (discardSavedBuffers) {
sl@0	5348	if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
sl@0	5349	ckfree((char *) statePtr->saveInBufPtr);
sl@0	5350	statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
sl@0	5351	}
sl@0	5352	}
sl@0	5353	}
sl@0	5354
sl@0	5355	/*
sl@0	5356	*---------------------------------------------------------------------------
sl@0	5357	*
sl@0	5358	* GetInput --
sl@0	5359	*
sl@0	5360	* Reads input data from a device into a channel buffer.
sl@0	5361	*
sl@0	5362	* Results:
sl@0	5363	* The return value is the Posix error code if an error occurred while
sl@0	5364	* reading from the file, or 0 otherwise.
sl@0	5365	*
sl@0	5366	* Side effects:
sl@0	5367	* Reads from the underlying device.
sl@0	5368	*
sl@0	5369	*---------------------------------------------------------------------------
sl@0	5370	*/
sl@0	5371
sl@0	5372	static int
sl@0	5373	GetInput(chanPtr)
sl@0	5374	Channel chanPtr; / Channel to read input from. */
sl@0	5375	{
sl@0	5376	int toRead; /* How much to read? */
sl@0	5377	int result; /* Of calling driver. */
sl@0	5378	int nread; /* How much was read from channel? */
sl@0	5379	ChannelBuffer bufPtr; / New buffer to add to input queue. */
sl@0	5380	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	5381
sl@0	5382	/*
sl@0	5383	* Prevent reading from a dead channel -- a channel that has been closed
sl@0	5384	* but not yet deallocated, which can happen if the exit handler for
sl@0	5385	* channel cleanup has run but the channel is still registered in some
sl@0	5386	* interpreter.
sl@0	5387	*/
sl@0	5388
sl@0	5389	if (CheckForDeadChannel(NULL, statePtr)) {
sl@0	5390	return EINVAL;
sl@0	5391	}
sl@0	5392
sl@0	5393	/*
sl@0	5394	* First check for more buffers in the pushback area of the
sl@0	5395	* topmost channel in the stack and use them. They can be the
sl@0	5396	* result of a transformation which went away without reading all
sl@0	5397	* the information placed in the area when it was stacked.
sl@0	5398	*
sl@0	5399	* Two possibilities for the state: No buffers in it, or a single
sl@0	5400	* empty buffer. In the latter case we can recycle it now.
sl@0	5401	*/
sl@0	5402
sl@0	5403	if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
sl@0	5404	if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
sl@0	5405	RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
sl@0	5406	statePtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	5407	}
sl@0	5408
sl@0	5409	statePtr->inQueueHead = chanPtr->inQueueHead;
sl@0	5410	statePtr->inQueueTail = chanPtr->inQueueTail;
sl@0	5411	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	5412	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	5413	return 0;
sl@0	5414	}
sl@0	5415
sl@0	5416	/*
sl@0	5417	* Nothing in the pushback area, fall back to the usual handling
sl@0	5418	* (driver, etc.)
sl@0	5419	*/
sl@0	5420
sl@0	5421	/*
sl@0	5422	* See if we can fill an existing buffer. If we can, read only
sl@0	5423	* as much as will fit in it. Otherwise allocate a new buffer,
sl@0	5424	* add it to the input queue and attempt to fill it to the max.
sl@0	5425	*/
sl@0	5426
sl@0	5427	bufPtr = statePtr->inQueueTail;
sl@0	5428	if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
sl@0	5429	toRead = bufPtr->bufLength - bufPtr->nextAdded;
sl@0	5430	} else {
sl@0	5431	bufPtr = statePtr->saveInBufPtr;
sl@0	5432	statePtr->saveInBufPtr = NULL;
sl@0	5433
sl@0	5434	/*
sl@0	5435	* Check the actual buffersize against the requested
sl@0	5436	* buffersize. Buffers which are smaller than requested are
sl@0	5437	* squashed. This is done to honor dynamic changes of the
sl@0	5438	* buffersize made by the user.
sl@0	5439	*/
sl@0	5440
sl@0	5441	if ((bufPtr != NULL) && ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize)) {
sl@0	5442	ckfree((char *) bufPtr);
sl@0	5443	bufPtr = NULL;
sl@0	5444	}
sl@0	5445
sl@0	5446	if (bufPtr == NULL) {
sl@0	5447	bufPtr = AllocChannelBuffer(statePtr->bufSize);
sl@0	5448	}
sl@0	5449	bufPtr->nextPtr = (ChannelBuffer *) NULL;
sl@0	5450
sl@0	5451	/* SF #427196: Use the actual size of the buffer to determine
sl@0	5452	* the number of bytes to read from the channel and not the
sl@0	5453	* size for new buffers. They can be different if the
sl@0	5454	* buffersize was changed between reads.
sl@0	5455	*
sl@0	5456	* Note: This affects performance negatively if the buffersize
sl@0	5457	* was extended but this small buffer is reused for all
sl@0	5458	* subsequent reads. The system never uses buffers with the
sl@0	5459	* requested bigger size in that case. An adjunct patch could
sl@0	5460	* try and delete all unused buffers it encounters and which
sl@0	5461	* are smaller than the formally requested buffersize.
sl@0	5462	*/
sl@0	5463
sl@0	5464	toRead = bufPtr->bufLength - bufPtr->nextAdded;
sl@0	5465
sl@0	5466	if (statePtr->inQueueTail == NULL) {
sl@0	5467	statePtr->inQueueHead = bufPtr;
sl@0	5468	} else {
sl@0	5469	statePtr->inQueueTail->nextPtr = bufPtr;
sl@0	5470	}
sl@0	5471	statePtr->inQueueTail = bufPtr;
sl@0	5472	}
sl@0	5473
sl@0	5474	/*
sl@0	5475	* If EOF is set, we should avoid calling the driver because on some
sl@0	5476	* platforms it is impossible to read from a device after EOF.
sl@0	5477	*/
sl@0	5478
sl@0	5479	if (statePtr->flags & CHANNEL_EOF) {
sl@0	5480	return 0;
sl@0	5481	}
sl@0	5482
sl@0	5483	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	5484	/* [SF Tcl Bug 943274]. Better emulation of non-blocking channels
sl@0	5485	* for channels without BlockModeProc, by keeping track of true
sl@0	5486	* fileevents generated by the OS == Data waiting and reading if
sl@0	5487	* and only if we are sure to have data.
sl@0	5488	*/
sl@0	5489
sl@0	5490	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
sl@0	5491	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
sl@0	5492	!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
sl@0	5493
sl@0	5494	/* Bypass the driver, it would block, as no data is available */
sl@0	5495	nread = -1;
sl@0	5496	result = EWOULDBLOCK;
sl@0	5497	} else {
sl@0	5498	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	5499
sl@0	5500	nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
sl@0	5501	bufPtr->buf + bufPtr->nextAdded, toRead, &result);
sl@0	5502
sl@0	5503	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	5504	}
sl@0	5505	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	5506
sl@0	5507	if (nread > 0) {
sl@0	5508	bufPtr->nextAdded += nread;
sl@0	5509
sl@0	5510	/*
sl@0	5511	* If we get a short read, signal up that we may be BLOCKED. We
sl@0	5512	* should avoid calling the driver because on some platforms we
sl@0	5513	* will block in the low level reading code even though the
sl@0	5514	* channel is set into nonblocking mode.
sl@0	5515	*/
sl@0	5516
sl@0	5517	if (nread < toRead) {
sl@0	5518	statePtr->flags \|= CHANNEL_BLOCKED;
sl@0	5519	}
sl@0	5520
sl@0	5521	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	5522	if (nread <= toRead) {
sl@0	5523	/* [SF Tcl Bug 943274] We have read the available data,
sl@0	5524	* clear flag */
sl@0	5525	statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
sl@0	5526	}
sl@0	5527	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	5528
sl@0	5529	} else if (nread == 0) {
sl@0	5530	statePtr->flags \|= CHANNEL_EOF;
sl@0	5531	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	5532	} else if (nread < 0) {
sl@0	5533	if ((result == EWOULDBLOCK) \|\| (result == EAGAIN)) {
sl@0	5534	statePtr->flags \|= CHANNEL_BLOCKED;
sl@0	5535	result = EAGAIN;
sl@0	5536	}
sl@0	5537	Tcl_SetErrno(result);
sl@0	5538	return result;
sl@0	5539	}
sl@0	5540	return 0;
sl@0	5541	}
sl@0	5542
sl@0	5543	/*
sl@0	5544	*----------------------------------------------------------------------
sl@0	5545	*
sl@0	5546	* Tcl_Seek --
sl@0	5547	*
sl@0	5548	* Implements seeking on Tcl Channels. This is a public function
sl@0	5549	* so that other C facilities may be implemented on top of it.
sl@0	5550	*
sl@0	5551	* Results:
sl@0	5552	* The new access point or -1 on error. If error, use Tcl_GetErrno()
sl@0	5553	* to retrieve the POSIX error code for the error that occurred.
sl@0	5554	*
sl@0	5555	* Side effects:
sl@0	5556	* May flush output on the channel. May discard queued input.
sl@0	5557	*
sl@0	5558	*----------------------------------------------------------------------
sl@0	5559	*/
sl@0	5560
sl@0	5561	EXPORT_C Tcl_WideInt
sl@0	5562	Tcl_Seek(chan, offset, mode)
sl@0	5563	Tcl_Channel chan; /* The channel on which to seek. */
sl@0	5564	Tcl_WideInt offset; /* Offset to seek to. */
sl@0	5565	int mode; /* Relative to which location to seek? */
sl@0	5566	{
sl@0	5567	Channel chanPtr = (Channel ) chan; /* The real IO channel. */
sl@0	5568	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	5569	int inputBuffered, outputBuffered;
sl@0	5570	/* # bytes held in buffers. */
sl@0	5571	int result; /* Of device driver operations. */
sl@0	5572	Tcl_WideInt curPos; /* Position on the device. */
sl@0	5573	int wasAsync; /* Was the channel nonblocking before the
sl@0	5574	* seek operation? If so, must restore to
sl@0	5575	* nonblocking mode after the seek. */
sl@0	5576
sl@0	5577	if (CheckChannelErrors(statePtr, TCL_WRITABLE \| TCL_READABLE) != 0) {
sl@0	5578	return Tcl_LongAsWide(-1);
sl@0	5579	}
sl@0	5580
sl@0	5581	/*
sl@0	5582	* Disallow seek on dead channels -- channels that have been closed but
sl@0	5583	* not yet been deallocated. Such channels can be found if the exit
sl@0	5584	* handler for channel cleanup has run but the channel is still
sl@0	5585	* registered in an interpreter.
sl@0	5586	*/
sl@0	5587
sl@0	5588	if (CheckForDeadChannel(NULL, statePtr)) {
sl@0	5589	return Tcl_LongAsWide(-1);
sl@0	5590	}
sl@0	5591
sl@0	5592	/*
sl@0	5593	* This operation should occur at the top of a channel stack.
sl@0	5594	*/
sl@0	5595
sl@0	5596	chanPtr = statePtr->topChanPtr;
sl@0	5597
sl@0	5598	/*
sl@0	5599	* Disallow seek on channels whose type does not have a seek procedure
sl@0	5600	* defined. This means that the channel does not support seeking.
sl@0	5601	*/
sl@0	5602
sl@0	5603	if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
sl@0	5604	Tcl_SetErrno(EINVAL);
sl@0	5605	return Tcl_LongAsWide(-1);
sl@0	5606	}
sl@0	5607
sl@0	5608	/*
sl@0	5609	* Compute how much input and output is buffered. If both input and
sl@0	5610	* output is buffered, cannot compute the current position.
sl@0	5611	*/
sl@0	5612
sl@0	5613	inputBuffered = Tcl_InputBuffered(chan);
sl@0	5614	outputBuffered = Tcl_OutputBuffered(chan);
sl@0	5615
sl@0	5616	if ((inputBuffered != 0) && (outputBuffered != 0)) {
sl@0	5617	Tcl_SetErrno(EFAULT);
sl@0	5618	return Tcl_LongAsWide(-1);
sl@0	5619	}
sl@0	5620
sl@0	5621	/*
sl@0	5622	* If we are seeking relative to the current position, compute the
sl@0	5623	* corrected offset taking into account the amount of unread input.
sl@0	5624	*/
sl@0	5625
sl@0	5626	if (mode == SEEK_CUR) {
sl@0	5627	offset -= inputBuffered;
sl@0	5628	}
sl@0	5629
sl@0	5630	/*
sl@0	5631	* Discard any queued input - this input should not be read after
sl@0	5632	* the seek.
sl@0	5633	*/
sl@0	5634
sl@0	5635	DiscardInputQueued(statePtr, 0);
sl@0	5636
sl@0	5637	/*
sl@0	5638	* Reset EOF and BLOCKED flags. We invalidate them by moving the
sl@0	5639	* access point. Also clear CR related flags.
sl@0	5640	*/
sl@0	5641
sl@0	5642	statePtr->flags &=
sl@0	5643	(~(CHANNEL_EOF \| CHANNEL_STICKY_EOF \| CHANNEL_BLOCKED \| INPUT_SAW_CR));
sl@0	5644
sl@0	5645	/*
sl@0	5646	* If the channel is in asynchronous output mode, switch it back
sl@0	5647	* to synchronous mode and cancel any async flush that may be
sl@0	5648	* scheduled. After the flush, the channel will be put back into
sl@0	5649	* asynchronous output mode.
sl@0	5650	*/
sl@0	5651
sl@0	5652	wasAsync = 0;
sl@0	5653	if (statePtr->flags & CHANNEL_NONBLOCKING) {
sl@0	5654	wasAsync = 1;
sl@0	5655	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
sl@0	5656	if (result != 0) {
sl@0	5657	return Tcl_LongAsWide(-1);
sl@0	5658	}
sl@0	5659	statePtr->flags &= (~(CHANNEL_NONBLOCKING));
sl@0	5660	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
sl@0	5661	statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
sl@0	5662	}
sl@0	5663	}
sl@0	5664
sl@0	5665	/*
sl@0	5666	* If the flush fails we cannot recover the original position. In
sl@0	5667	* that case the seek is not attempted because we do not know where
sl@0	5668	* the access position is - instead we return the error. FlushChannel
sl@0	5669	* has already called Tcl_SetErrno() to report the error upwards.
sl@0	5670	* If the flush succeeds we do the seek also.
sl@0	5671	*/
sl@0	5672
sl@0	5673	if (FlushChannel(NULL, chanPtr, 0) != 0) {
sl@0	5674	curPos = -1;
sl@0	5675	} else {
sl@0	5676
sl@0	5677	/*
sl@0	5678	* Now seek to the new position in the channel as requested by the
sl@0	5679	* caller. Note that we prefer the wideSeekProc if that is
sl@0	5680	* available and non-NULL...
sl@0	5681	*/
sl@0	5682
sl@0	5683	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
sl@0	5684	chanPtr->typePtr->wideSeekProc != NULL) {
sl@0	5685	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
sl@0	5686	offset, mode, &result);
sl@0	5687	} else if (offset < Tcl_LongAsWide(LONG_MIN) \|\|
sl@0	5688	offset > Tcl_LongAsWide(LONG_MAX)) {
sl@0	5689	result = EOVERFLOW;
sl@0	5690	curPos = Tcl_LongAsWide(-1);
sl@0	5691	} else {
sl@0	5692	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
sl@0	5693	chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
sl@0	5694	&result));
sl@0	5695	}
sl@0	5696	if (curPos == Tcl_LongAsWide(-1)) {
sl@0	5697	Tcl_SetErrno(result);
sl@0	5698	}
sl@0	5699	}
sl@0	5700
sl@0	5701	/*
sl@0	5702	* Restore to nonblocking mode if that was the previous behavior.
sl@0	5703	*
sl@0	5704	* NOTE: Even if there was an async flush active we do not restore
sl@0	5705	* it now because we already flushed all the queued output, above.
sl@0	5706	*/
sl@0	5707
sl@0	5708	if (wasAsync) {
sl@0	5709	statePtr->flags \|= CHANNEL_NONBLOCKING;
sl@0	5710	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
sl@0	5711	if (result != 0) {
sl@0	5712	return Tcl_LongAsWide(-1);
sl@0	5713	}
sl@0	5714	}
sl@0	5715
sl@0	5716	return curPos;
sl@0	5717	}
sl@0	5718
sl@0	5719	/*
sl@0	5720	*----------------------------------------------------------------------
sl@0	5721	*
sl@0	5722	* Tcl_Tell --
sl@0	5723	*
sl@0	5724	* Returns the position of the next character to be read/written on
sl@0	5725	* this channel.
sl@0	5726	*
sl@0	5727	* Results:
sl@0	5728	* A nonnegative integer on success, -1 on failure. If failed,
sl@0	5729	* use Tcl_GetErrno() to retrieve the POSIX error code for the
sl@0	5730	* error that occurred.
sl@0	5731	*
sl@0	5732	* Side effects:
sl@0	5733	* None.
sl@0	5734	*
sl@0	5735	*----------------------------------------------------------------------
sl@0	5736	*/
sl@0	5737
sl@0	5738	EXPORT_C Tcl_WideInt
sl@0	5739	Tcl_Tell(chan)
sl@0	5740	Tcl_Channel chan; /* The channel to return pos for. */
sl@0	5741	{
sl@0	5742	Channel chanPtr = (Channel ) chan; /* The real IO channel. */
sl@0	5743	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	5744	int inputBuffered, outputBuffered; /* # bytes held in buffers. */
sl@0	5745	int result; /* Of calling device driver. */
sl@0	5746	Tcl_WideInt curPos; /* Position on device. */
sl@0	5747
sl@0	5748	if (CheckChannelErrors(statePtr, TCL_WRITABLE \| TCL_READABLE) != 0) {
sl@0	5749	return Tcl_LongAsWide(-1);
sl@0	5750	}
sl@0	5751
sl@0	5752	/*
sl@0	5753	* Disallow tell on dead channels -- channels that have been closed but
sl@0	5754	* not yet been deallocated. Such channels can be found if the exit
sl@0	5755	* handler for channel cleanup has run but the channel is still
sl@0	5756	* registered in an interpreter.
sl@0	5757	*/
sl@0	5758
sl@0	5759	if (CheckForDeadChannel(NULL, statePtr)) {
sl@0	5760	return Tcl_LongAsWide(-1);
sl@0	5761	}
sl@0	5762
sl@0	5763	/*
sl@0	5764	* This operation should occur at the top of a channel stack.
sl@0	5765	*/
sl@0	5766
sl@0	5767	chanPtr = statePtr->topChanPtr;
sl@0	5768
sl@0	5769	/*
sl@0	5770	* Disallow tell on channels whose type does not have a seek procedure
sl@0	5771	* defined. This means that the channel does not support seeking.
sl@0	5772	*/
sl@0	5773
sl@0	5774	if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
sl@0	5775	Tcl_SetErrno(EINVAL);
sl@0	5776	return Tcl_LongAsWide(-1);
sl@0	5777	}
sl@0	5778
sl@0	5779	/*
sl@0	5780	* Compute how much input and output is buffered. If both input and
sl@0	5781	* output is buffered, cannot compute the current position.
sl@0	5782	*/
sl@0	5783
sl@0	5784	inputBuffered = Tcl_InputBuffered(chan);
sl@0	5785	outputBuffered = Tcl_OutputBuffered(chan);
sl@0	5786
sl@0	5787	if ((inputBuffered != 0) && (outputBuffered != 0)) {
sl@0	5788	Tcl_SetErrno(EFAULT);
sl@0	5789	return Tcl_LongAsWide(-1);
sl@0	5790	}
sl@0	5791
sl@0	5792	/*
sl@0	5793	* Get the current position in the device and compute the position
sl@0	5794	* where the next character will be read or written. Note that we
sl@0	5795	* prefer the wideSeekProc if that is available and non-NULL...
sl@0	5796	*/
sl@0	5797
sl@0	5798	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
sl@0	5799	chanPtr->typePtr->wideSeekProc != NULL) {
sl@0	5800	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
sl@0	5801	Tcl_LongAsWide(0), SEEK_CUR, &result);
sl@0	5802	} else {
sl@0	5803	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
sl@0	5804	chanPtr->instanceData, 0, SEEK_CUR, &result));
sl@0	5805	}
sl@0	5806	if (curPos == Tcl_LongAsWide(-1)) {
sl@0	5807	Tcl_SetErrno(result);
sl@0	5808	return Tcl_LongAsWide(-1);
sl@0	5809	}
sl@0	5810	if (inputBuffered != 0) {
sl@0	5811	return curPos - inputBuffered;
sl@0	5812	}
sl@0	5813	return curPos + outputBuffered;
sl@0	5814	}
sl@0	5815
sl@0	5816	/*
sl@0	5817	*---------------------------------------------------------------------------
sl@0	5818	*
sl@0	5819	* Tcl_SeekOld, Tcl_TellOld --
sl@0	5820	*
sl@0	5821	* Backward-compatability versions of the seek/tell interface that
sl@0	5822	* do not support 64-bit offsets. This interface is not documented
sl@0	5823	* or expected to be supported indefinitely.
sl@0	5824	*
sl@0	5825	* Results:
sl@0	5826	* As for Tcl_Seek and Tcl_Tell respectively, except truncated to
sl@0	5827	* whatever value will fit in an 'int'.
sl@0	5828	*
sl@0	5829	* Side effects:
sl@0	5830	* As for Tcl_Seek and Tcl_Tell respectively.
sl@0	5831	*
sl@0	5832	*---------------------------------------------------------------------------
sl@0	5833	*/
sl@0	5834
sl@0	5835	EXPORT_C int
sl@0	5836	Tcl_SeekOld(chan, offset, mode)
sl@0	5837	Tcl_Channel chan; /* The channel on which to seek. */
sl@0	5838	int offset; /* Offset to seek to. */
sl@0	5839	int mode; /* Relative to which location to seek? */
sl@0	5840	{
sl@0	5841	Tcl_WideInt wOffset, wResult;
sl@0	5842
sl@0	5843	wOffset = Tcl_LongAsWide((long)offset);
sl@0	5844	wResult = Tcl_Seek(chan, wOffset, mode);
sl@0	5845	return (int)Tcl_WideAsLong(wResult);
sl@0	5846	}
sl@0	5847
sl@0	5848	EXPORT_C int
sl@0	5849	Tcl_TellOld(chan)
sl@0	5850	Tcl_Channel chan; /* The channel to return pos for. */
sl@0	5851	{
sl@0	5852	Tcl_WideInt wResult;
sl@0	5853
sl@0	5854	wResult = Tcl_Tell(chan);
sl@0	5855	return (int)Tcl_WideAsLong(wResult);
sl@0	5856	}
sl@0	5857
sl@0	5858	/*
sl@0	5859	*---------------------------------------------------------------------------
sl@0	5860	*
sl@0	5861	* CheckChannelErrors --
sl@0	5862	*
sl@0	5863	* See if the channel is in an ready state and can perform the
sl@0	5864	* desired operation.
sl@0	5865	*
sl@0	5866	* Results:
sl@0	5867	* The return value is 0 if the channel is OK, otherwise the
sl@0	5868	* return value is -1 and errno is set to indicate the error.
sl@0	5869	*
sl@0	5870	* Side effects:
sl@0	5871	* May clear the EOF and/or BLOCKED bits if reading from channel.
sl@0	5872	*
sl@0	5873	*---------------------------------------------------------------------------
sl@0	5874	*/
sl@0	5875
sl@0	5876	static int
sl@0	5877	CheckChannelErrors(statePtr, flags)
sl@0	5878	ChannelState statePtr; / Channel to check. */
sl@0	5879	int flags; /* Test if channel supports desired operation:
sl@0	5880	* TCL_READABLE, TCL_WRITABLE. Also indicates
sl@0	5881	* Raw read or write for special close
sl@0	5882	* processing*/
sl@0	5883	{
sl@0	5884	int direction = flags & (TCL_READABLE\|TCL_WRITABLE);
sl@0	5885
sl@0	5886	/*
sl@0	5887	* Check for unreported error.
sl@0	5888	*/
sl@0	5889
sl@0	5890	if (statePtr->unreportedError != 0) {
sl@0	5891	Tcl_SetErrno(statePtr->unreportedError);
sl@0	5892	statePtr->unreportedError = 0;
sl@0	5893	return -1;
sl@0	5894	}
sl@0	5895
sl@0	5896	/*
sl@0	5897	* Only the raw read and write operations are allowed during close
sl@0	5898	* in order to drain data from stacked channels.
sl@0	5899	*/
sl@0	5900
sl@0	5901	if ((statePtr->flags & CHANNEL_CLOSED) &&
sl@0	5902	((flags & CHANNEL_RAW_MODE) == 0)) {
sl@0	5903	Tcl_SetErrno(EACCES);
sl@0	5904	return -1;
sl@0	5905	}
sl@0	5906
sl@0	5907	/*
sl@0	5908	* Fail if the channel is not opened for desired operation.
sl@0	5909	*/
sl@0	5910
sl@0	5911	if ((statePtr->flags & direction) == 0) {
sl@0	5912	Tcl_SetErrno(EACCES);
sl@0	5913	return -1;
sl@0	5914	}
sl@0	5915
sl@0	5916	/*
sl@0	5917	* Fail if the channel is in the middle of a background copy.
sl@0	5918	*
sl@0	5919	* Don't do this tests for raw channels here or else the chaining in the
sl@0	5920	* transformation drivers will fail with 'file busy' error instead of
sl@0	5921	* retrieving and transforming the data to copy.
sl@0	5922	*/
sl@0	5923
sl@0	5924	if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) {
sl@0	5925	Tcl_SetErrno(EBUSY);
sl@0	5926	return -1;
sl@0	5927	}
sl@0	5928
sl@0	5929	if (direction == TCL_READABLE) {
sl@0	5930	/*
sl@0	5931	* If we have not encountered a sticky EOF, clear the EOF bit
sl@0	5932	* (sticky EOF is set if we have seen the input eofChar, to prevent
sl@0	5933	* reading beyond the eofChar). Also, always clear the BLOCKED bit.
sl@0	5934	* We want to discover these conditions anew in each operation.
sl@0	5935	*/
sl@0	5936
sl@0	5937	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
sl@0	5938	statePtr->flags &= ~CHANNEL_EOF;
sl@0	5939	}
sl@0	5940	statePtr->flags &= ~(CHANNEL_BLOCKED \| CHANNEL_NEED_MORE_DATA);
sl@0	5941	}
sl@0	5942
sl@0	5943	return 0;
sl@0	5944	}
sl@0	5945
sl@0	5946	/*
sl@0	5947	*----------------------------------------------------------------------
sl@0	5948	*
sl@0	5949	* Tcl_Eof --
sl@0	5950	*
sl@0	5951	* Returns 1 if the channel is at EOF, 0 otherwise.
sl@0	5952	*
sl@0	5953	* Results:
sl@0	5954	* 1 or 0, always.
sl@0	5955	*
sl@0	5956	* Side effects:
sl@0	5957	* None.
sl@0	5958	*
sl@0	5959	*----------------------------------------------------------------------
sl@0	5960	*/
sl@0	5961
sl@0	5962	EXPORT_C int
sl@0	5963	Tcl_Eof(chan)
sl@0	5964	Tcl_Channel chan; /* Does this channel have EOF? */
sl@0	5965	{
sl@0	5966	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	5967	/* State of real channel structure. */
sl@0	5968
sl@0	5969	return ((statePtr->flags & CHANNEL_STICKY_EOF) \|\|
sl@0	5970	((statePtr->flags & CHANNEL_EOF) &&
sl@0	5971	(Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
sl@0	5972	}
sl@0	5973
sl@0	5974	/*
sl@0	5975	*----------------------------------------------------------------------
sl@0	5976	*
sl@0	5977	* Tcl_InputBlocked --
sl@0	5978	*
sl@0	5979	* Returns 1 if input is blocked on this channel, 0 otherwise.
sl@0	5980	*
sl@0	5981	* Results:
sl@0	5982	* 0 or 1, always.
sl@0	5983	*
sl@0	5984	* Side effects:
sl@0	5985	* None.
sl@0	5986	*
sl@0	5987	*----------------------------------------------------------------------
sl@0	5988	*/
sl@0	5989
sl@0	5990	EXPORT_C int
sl@0	5991	Tcl_InputBlocked(chan)
sl@0	5992	Tcl_Channel chan; /* Is this channel blocked? */
sl@0	5993	{
sl@0	5994	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	5995	/* State of real channel structure. */
sl@0	5996
sl@0	5997	return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
sl@0	5998	}
sl@0	5999
sl@0	6000	/*
sl@0	6001	*----------------------------------------------------------------------
sl@0	6002	*
sl@0	6003	* Tcl_InputBuffered --
sl@0	6004	*
sl@0	6005	* Returns the number of bytes of input currently buffered in the
sl@0	6006	* common internal buffer of a channel.
sl@0	6007	*
sl@0	6008	* Results:
sl@0	6009	* The number of input bytes buffered, or zero if the channel is not
sl@0	6010	* open for reading.
sl@0	6011	*
sl@0	6012	* Side effects:
sl@0	6013	* None.
sl@0	6014	*
sl@0	6015	*----------------------------------------------------------------------
sl@0	6016	*/
sl@0	6017
sl@0	6018	EXPORT_C int
sl@0	6019	Tcl_InputBuffered(chan)
sl@0	6020	Tcl_Channel chan; /* The channel to query. */
sl@0	6021	{
sl@0	6022	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	6023	/* State of real channel structure. */
sl@0	6024	ChannelBuffer *bufPtr;
sl@0	6025	int bytesBuffered;
sl@0	6026
sl@0	6027	for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
sl@0	6028	bufPtr != (ChannelBuffer *) NULL;
sl@0	6029	bufPtr = bufPtr->nextPtr) {
sl@0	6030	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
sl@0	6031	}
sl@0	6032
sl@0	6033	/*
sl@0	6034	* Don't forget the bytes in the topmost pushback area.
sl@0	6035	*/
sl@0	6036
sl@0	6037	for (bufPtr = statePtr->topChanPtr->inQueueHead;
sl@0	6038	bufPtr != (ChannelBuffer *) NULL;
sl@0	6039	bufPtr = bufPtr->nextPtr) {
sl@0	6040	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
sl@0	6041	}
sl@0	6042
sl@0	6043	return bytesBuffered;
sl@0	6044	}
sl@0	6045
sl@0	6046	/*
sl@0	6047	*----------------------------------------------------------------------
sl@0	6048	*
sl@0	6049	* Tcl_OutputBuffered --
sl@0	6050	*
sl@0	6051	* Returns the number of bytes of output currently buffered in the
sl@0	6052	* common internal buffer of a channel.
sl@0	6053	*
sl@0	6054	* Results:
sl@0	6055	* The number of output bytes buffered, or zero if the channel is not
sl@0	6056	* open for writing.
sl@0	6057	*
sl@0	6058	* Side effects:
sl@0	6059	* None.
sl@0	6060	*
sl@0	6061	*----------------------------------------------------------------------
sl@0	6062	*/
sl@0	6063
sl@0	6064	EXPORT_C int
sl@0	6065	Tcl_OutputBuffered(chan)
sl@0	6066	Tcl_Channel chan; /* The channel to query. */
sl@0	6067	{
sl@0	6068	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	6069	/* State of real channel structure. */
sl@0	6070	ChannelBuffer *bufPtr;
sl@0	6071	int bytesBuffered;
sl@0	6072
sl@0	6073	for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead;
sl@0	6074	bufPtr != (ChannelBuffer *) NULL;
sl@0	6075	bufPtr = bufPtr->nextPtr) {
sl@0	6076	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
sl@0	6077	}
sl@0	6078	if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
sl@0	6079	(statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
sl@0	6080	statePtr->flags \|= BUFFER_READY;
sl@0	6081	bytesBuffered +=
sl@0	6082	(statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
sl@0	6083	}
sl@0	6084
sl@0	6085	return bytesBuffered;
sl@0	6086	}
sl@0	6087
sl@0	6088	/*
sl@0	6089	*----------------------------------------------------------------------
sl@0	6090	*
sl@0	6091	* Tcl_ChannelBuffered --
sl@0	6092	*
sl@0	6093	* Returns the number of bytes of input currently buffered in the
sl@0	6094	* internal buffer (push back area) of a channel.
sl@0	6095	*
sl@0	6096	* Results:
sl@0	6097	* The number of input bytes buffered, or zero if the channel is not
sl@0	6098	* open for reading.
sl@0	6099	*
sl@0	6100	* Side effects:
sl@0	6101	* None.
sl@0	6102	*
sl@0	6103	*----------------------------------------------------------------------
sl@0	6104	*/
sl@0	6105
sl@0	6106	EXPORT_C int
sl@0	6107	Tcl_ChannelBuffered(chan)
sl@0	6108	Tcl_Channel chan; /* The channel to query. */
sl@0	6109	{
sl@0	6110	Channel chanPtr = (Channel ) chan;
sl@0	6111	/* real channel structure. */
sl@0	6112	ChannelBuffer *bufPtr;
sl@0	6113	int bytesBuffered;
sl@0	6114
sl@0	6115	for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
sl@0	6116	bufPtr != (ChannelBuffer *) NULL;
sl@0	6117	bufPtr = bufPtr->nextPtr) {
sl@0	6118	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
sl@0	6119	}
sl@0	6120
sl@0	6121	return bytesBuffered;
sl@0	6122	}
sl@0	6123
sl@0	6124	/*
sl@0	6125	*----------------------------------------------------------------------
sl@0	6126	*
sl@0	6127	* Tcl_SetChannelBufferSize --
sl@0	6128	*
sl@0	6129	* Sets the size of buffers to allocate to store input or output
sl@0	6130	* in the channel. The size must be between 1 byte and 1 MByte.
sl@0	6131	*
sl@0	6132	* Results:
sl@0	6133	* None.
sl@0	6134	*
sl@0	6135	* Side effects:
sl@0	6136	* Sets the size of buffers subsequently allocated for this channel.
sl@0	6137	*
sl@0	6138	*----------------------------------------------------------------------
sl@0	6139	*/
sl@0	6140
sl@0	6141	EXPORT_C void
sl@0	6142	Tcl_SetChannelBufferSize(chan, sz)
sl@0	6143	Tcl_Channel chan; /* The channel whose buffer size
sl@0	6144	* to set. */
sl@0	6145	int sz; /* The size to set. */
sl@0	6146	{
sl@0	6147	ChannelState statePtr; / State of real channel structure. */
sl@0	6148
sl@0	6149	/*
sl@0	6150	* If the buffer size is smaller than 1 byte or larger than one MByte,
sl@0	6151	* do not accept the requested size and leave the current buffer size.
sl@0	6152	*/
sl@0	6153
sl@0	6154	if (sz < 1) {
sl@0	6155	return;
sl@0	6156	}
sl@0	6157	if (sz > (1024 * 1024)) {
sl@0	6158	return;
sl@0	6159	}
sl@0	6160
sl@0	6161	statePtr = ((Channel *) chan)->state;
sl@0	6162	statePtr->bufSize = sz;
sl@0	6163
sl@0	6164	if (statePtr->outputStage != NULL) {
sl@0	6165	ckfree((char *) statePtr->outputStage);
sl@0	6166	statePtr->outputStage = NULL;
sl@0	6167	}
sl@0	6168	if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
sl@0	6169	statePtr->outputStage = (char *)
sl@0	6170	ckalloc((unsigned) (statePtr->bufSize + 2));
sl@0	6171	}
sl@0	6172	}
sl@0	6173
sl@0	6174	/*
sl@0	6175	*----------------------------------------------------------------------
sl@0	6176	*
sl@0	6177	* Tcl_GetChannelBufferSize --
sl@0	6178	*
sl@0	6179	* Retrieves the size of buffers to allocate for this channel.
sl@0	6180	*
sl@0	6181	* Results:
sl@0	6182	* The size.
sl@0	6183	*
sl@0	6184	* Side effects:
sl@0	6185	* None.
sl@0	6186	*
sl@0	6187	*----------------------------------------------------------------------
sl@0	6188	*/
sl@0	6189
sl@0	6190	EXPORT_C int
sl@0	6191	Tcl_GetChannelBufferSize(chan)
sl@0	6192	Tcl_Channel chan; /* The channel for which to find the
sl@0	6193	* buffer size. */
sl@0	6194	{
sl@0	6195	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	6196	/* State of real channel structure. */
sl@0	6197
sl@0	6198	return statePtr->bufSize;
sl@0	6199	}
sl@0	6200
sl@0	6201	/*
sl@0	6202	*----------------------------------------------------------------------
sl@0	6203	*
sl@0	6204	* Tcl_BadChannelOption --
sl@0	6205	*
sl@0	6206	* This procedure generates a "bad option" error message in an
sl@0	6207	* (optional) interpreter. It is used by channel drivers when
sl@0	6208	* a invalid Set/Get option is requested. Its purpose is to concatenate
sl@0	6209	* the generic options list to the specific ones and factorize
sl@0	6210	* the generic options error message string.
sl@0	6211	*
sl@0	6212	* Results:
sl@0	6213	* TCL_ERROR.
sl@0	6214	*
sl@0	6215	* Side effects:
sl@0	6216	* An error message is generated in interp's result object to
sl@0	6217	* indicate that a command was invoked with the a bad option
sl@0	6218	* The message has the form
sl@0	6219	* bad option "blah": should be one of
sl@0	6220	* <...generic options...>+<...specific options...>
sl@0	6221	* "blah" is the optionName argument and "<specific options>"
sl@0	6222	* is a space separated list of specific option words.
sl@0	6223	* The function takes good care of inserting minus signs before
sl@0	6224	* each option, commas after, and an "or" before the last option.
sl@0	6225	*
sl@0	6226	*----------------------------------------------------------------------
sl@0	6227	*/
sl@0	6228
sl@0	6229	EXPORT_C int
sl@0	6230	Tcl_BadChannelOption(interp, optionName, optionList)
sl@0	6231	Tcl_Interp interp; / Current interpreter. (can be NULL)*/
sl@0	6232	CONST char optionName; / 'bad option' name */
sl@0	6233	CONST char optionList; / Specific options list to append
sl@0	6234	* to the standard generic options.
sl@0	6235	* can be NULL for generic options
sl@0	6236	* only.
sl@0	6237	*/
sl@0	6238	{
sl@0	6239	if (interp) {
sl@0	6240	CONST char *genericopt =
sl@0	6241	"blocking buffering buffersize encoding eofchar translation";
sl@0	6242	CONST char **argv;
sl@0	6243	int argc, i;
sl@0	6244	Tcl_DString ds;
sl@0	6245
sl@0	6246	Tcl_DStringInit(&ds);
sl@0	6247	Tcl_DStringAppend(&ds, genericopt, -1);
sl@0	6248	if (optionList && (*optionList)) {
sl@0	6249	Tcl_DStringAppend(&ds, " ", 1);
sl@0	6250	Tcl_DStringAppend(&ds, optionList, -1);
sl@0	6251	}
sl@0	6252	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
sl@0	6253	&argc, &argv) != TCL_OK) {
sl@0	6254	panic("malformed option list in channel driver");
sl@0	6255	}
sl@0	6256	Tcl_ResetResult(interp);
sl@0	6257	Tcl_AppendResult(interp, "bad option \"", optionName,
sl@0	6258	"\": should be one of ", (char *) NULL);
sl@0	6259	argc--;
sl@0	6260	for (i = 0; i < argc; i++) {
sl@0	6261	Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
sl@0	6262	}
sl@0	6263	Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
sl@0	6264	Tcl_DStringFree(&ds);
sl@0	6265	ckfree((char *) argv);
sl@0	6266	}
sl@0	6267	Tcl_SetErrno(EINVAL);
sl@0	6268	return TCL_ERROR;
sl@0	6269	}
sl@0	6270
sl@0	6271	/*
sl@0	6272	*----------------------------------------------------------------------
sl@0	6273	*
sl@0	6274	* Tcl_GetChannelOption --
sl@0	6275	*
sl@0	6276	* Gets a mode associated with an IO channel. If the optionName arg
sl@0	6277	* is non NULL, retrieves the value of that option. If the optionName
sl@0	6278	* arg is NULL, retrieves a list of alternating option names and
sl@0	6279	* values for the given channel.
sl@0	6280	*
sl@0	6281	* Results:
sl@0	6282	* A standard Tcl result. Also sets the supplied DString to the
sl@0	6283	* string value of the option(s) returned.
sl@0	6284	*
sl@0	6285	* Side effects:
sl@0	6286	* None.
sl@0	6287	*
sl@0	6288	*----------------------------------------------------------------------
sl@0	6289	*/
sl@0	6290
sl@0	6291	EXPORT_C int
sl@0	6292	Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
sl@0	6293	Tcl_Interp interp; / For error reporting - can be NULL. */
sl@0	6294	Tcl_Channel chan; /* Channel on which to get option. */
sl@0	6295	CONST char optionName; / Option to get. */
sl@0	6296	Tcl_DString dsPtr; / Where to store value(s). */
sl@0	6297	{
sl@0	6298	size_t len; /* Length of optionName string. */
sl@0	6299	char optionVal[128]; /* Buffer for sprintf. */
sl@0	6300	Channel chanPtr = (Channel ) chan;
sl@0	6301	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	6302	int flags;
sl@0	6303
sl@0	6304	/*
sl@0	6305	* Disallow options on dead channels -- channels that have been closed but
sl@0	6306	* not yet been deallocated. Such channels can be found if the exit
sl@0	6307	* handler for channel cleanup has run but the channel is still
sl@0	6308	* registered in an interpreter.
sl@0	6309	*/
sl@0	6310
sl@0	6311	if (CheckForDeadChannel(interp, statePtr)) {
sl@0	6312	return TCL_ERROR;
sl@0	6313	}
sl@0	6314
sl@0	6315	/*
sl@0	6316	* This operation should occur at the top of a channel stack.
sl@0	6317	*/
sl@0	6318
sl@0	6319	chanPtr = statePtr->topChanPtr;
sl@0	6320
sl@0	6321	/*
sl@0	6322	* If we are in the middle of a background copy, use the saved flags.
sl@0	6323	*/
sl@0	6324
sl@0	6325	if (statePtr->csPtr) {
sl@0	6326	if (chanPtr == statePtr->csPtr->readPtr) {
sl@0	6327	flags = statePtr->csPtr->readFlags;
sl@0	6328	} else {
sl@0	6329	flags = statePtr->csPtr->writeFlags;
sl@0	6330	}
sl@0	6331	} else {
sl@0	6332	flags = statePtr->flags;
sl@0	6333	}
sl@0	6334
sl@0	6335	/*
sl@0	6336	* If the optionName is NULL it means that we want a list of all
sl@0	6337	* options and values.
sl@0	6338	*/
sl@0	6339
sl@0	6340	if (optionName == (char *) NULL) {
sl@0	6341	len = 0;
sl@0	6342	} else {
sl@0	6343	len = strlen(optionName);
sl@0	6344	}
sl@0	6345
sl@0	6346	if ((len == 0) \|\| ((len > 2) && (optionName[1] == 'b') &&
sl@0	6347	(strncmp(optionName, "-blocking", len) == 0))) {
sl@0	6348	if (len == 0) {
sl@0	6349	Tcl_DStringAppendElement(dsPtr, "-blocking");
sl@0	6350	}
sl@0	6351	Tcl_DStringAppendElement(dsPtr,
sl@0	6352	(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
sl@0	6353	if (len > 0) {
sl@0	6354	return TCL_OK;
sl@0	6355	}
sl@0	6356	}
sl@0	6357	if ((len == 0) \|\| ((len > 7) && (optionName[1] == 'b') &&
sl@0	6358	(strncmp(optionName, "-buffering", len) == 0))) {
sl@0	6359	if (len == 0) {
sl@0	6360	Tcl_DStringAppendElement(dsPtr, "-buffering");
sl@0	6361	}
sl@0	6362	if (flags & CHANNEL_LINEBUFFERED) {
sl@0	6363	Tcl_DStringAppendElement(dsPtr, "line");
sl@0	6364	} else if (flags & CHANNEL_UNBUFFERED) {
sl@0	6365	Tcl_DStringAppendElement(dsPtr, "none");
sl@0	6366	} else {
sl@0	6367	Tcl_DStringAppendElement(dsPtr, "full");
sl@0	6368	}
sl@0	6369	if (len > 0) {
sl@0	6370	return TCL_OK;
sl@0	6371	}
sl@0	6372	}
sl@0	6373	if ((len == 0) \|\| ((len > 7) && (optionName[1] == 'b') &&
sl@0	6374	(strncmp(optionName, "-buffersize", len) == 0))) {
sl@0	6375	if (len == 0) {
sl@0	6376	Tcl_DStringAppendElement(dsPtr, "-buffersize");
sl@0	6377	}
sl@0	6378	TclFormatInt(optionVal, statePtr->bufSize);
sl@0	6379	Tcl_DStringAppendElement(dsPtr, optionVal);
sl@0	6380	if (len > 0) {
sl@0	6381	return TCL_OK;
sl@0	6382	}
sl@0	6383	}
sl@0	6384	if ((len == 0) \|\|
sl@0	6385	((len > 2) && (optionName[1] == 'e') &&
sl@0	6386	(strncmp(optionName, "-encoding", len) == 0))) {
sl@0	6387	if (len == 0) {
sl@0	6388	Tcl_DStringAppendElement(dsPtr, "-encoding");
sl@0	6389	}
sl@0	6390	if (statePtr->encoding == NULL) {
sl@0	6391	Tcl_DStringAppendElement(dsPtr, "binary");
sl@0	6392	} else {
sl@0	6393	Tcl_DStringAppendElement(dsPtr,
sl@0	6394	Tcl_GetEncodingName(statePtr->encoding));
sl@0	6395	}
sl@0	6396	if (len > 0) {
sl@0	6397	return TCL_OK;
sl@0	6398	}
sl@0	6399	}
sl@0	6400	if ((len == 0) \|\|
sl@0	6401	((len > 2) && (optionName[1] == 'e') &&
sl@0	6402	(strncmp(optionName, "-eofchar", len) == 0))) {
sl@0	6403	if (len == 0) {
sl@0	6404	Tcl_DStringAppendElement(dsPtr, "-eofchar");
sl@0	6405	}
sl@0	6406	if (((flags & (TCL_READABLE\|TCL_WRITABLE)) ==
sl@0	6407	(TCL_READABLE\|TCL_WRITABLE)) && (len == 0)) {
sl@0	6408	Tcl_DStringStartSublist(dsPtr);
sl@0	6409	}
sl@0	6410	if (flags & TCL_READABLE) {
sl@0	6411	if (statePtr->inEofChar == 0) {
sl@0	6412	Tcl_DStringAppendElement(dsPtr, "");
sl@0	6413	} else {
sl@0	6414	char buf[4];
sl@0	6415
sl@0	6416	sprintf(buf, "%c", statePtr->inEofChar);
sl@0	6417	Tcl_DStringAppendElement(dsPtr, buf);
sl@0	6418	}
sl@0	6419	}
sl@0	6420	if (flags & TCL_WRITABLE) {
sl@0	6421	if (statePtr->outEofChar == 0) {
sl@0	6422	Tcl_DStringAppendElement(dsPtr, "");
sl@0	6423	} else {
sl@0	6424	char buf[4];
sl@0	6425
sl@0	6426	sprintf(buf, "%c", statePtr->outEofChar);
sl@0	6427	Tcl_DStringAppendElement(dsPtr, buf);
sl@0	6428	}
sl@0	6429	}
sl@0	6430	if ( !(flags & (TCL_READABLE\|TCL_WRITABLE))) {
sl@0	6431	/* Not readable or writable (server socket) */
sl@0	6432	Tcl_DStringAppendElement(dsPtr, "");
sl@0	6433	}
sl@0	6434	if (((flags & (TCL_READABLE\|TCL_WRITABLE)) ==
sl@0	6435	(TCL_READABLE\|TCL_WRITABLE)) && (len == 0)) {
sl@0	6436	Tcl_DStringEndSublist(dsPtr);
sl@0	6437	}
sl@0	6438	if (len > 0) {
sl@0	6439	return TCL_OK;
sl@0	6440	}
sl@0	6441	}
sl@0	6442	if ((len == 0) \|\|
sl@0	6443	((len > 1) && (optionName[1] == 't') &&
sl@0	6444	(strncmp(optionName, "-translation", len) == 0))) {
sl@0	6445	if (len == 0) {
sl@0	6446	Tcl_DStringAppendElement(dsPtr, "-translation");
sl@0	6447	}
sl@0	6448	if (((flags & (TCL_READABLE\|TCL_WRITABLE)) ==
sl@0	6449	(TCL_READABLE\|TCL_WRITABLE)) && (len == 0)) {
sl@0	6450	Tcl_DStringStartSublist(dsPtr);
sl@0	6451	}
sl@0	6452	if (flags & TCL_READABLE) {
sl@0	6453	if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
sl@0	6454	Tcl_DStringAppendElement(dsPtr, "auto");
sl@0	6455	} else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
sl@0	6456	Tcl_DStringAppendElement(dsPtr, "cr");
sl@0	6457	} else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
sl@0	6458	Tcl_DStringAppendElement(dsPtr, "crlf");
sl@0	6459	} else {
sl@0	6460	Tcl_DStringAppendElement(dsPtr, "lf");
sl@0	6461	}
sl@0	6462	}
sl@0	6463	if (flags & TCL_WRITABLE) {
sl@0	6464	if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
sl@0	6465	Tcl_DStringAppendElement(dsPtr, "auto");
sl@0	6466	} else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
sl@0	6467	Tcl_DStringAppendElement(dsPtr, "cr");
sl@0	6468	} else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
sl@0	6469	Tcl_DStringAppendElement(dsPtr, "crlf");
sl@0	6470	} else {
sl@0	6471	Tcl_DStringAppendElement(dsPtr, "lf");
sl@0	6472	}
sl@0	6473	}
sl@0	6474	if ( !(flags & (TCL_READABLE\|TCL_WRITABLE))) {
sl@0	6475	/* Not readable or writable (server socket) */
sl@0	6476	Tcl_DStringAppendElement(dsPtr, "auto");
sl@0	6477	}
sl@0	6478	if (((flags & (TCL_READABLE\|TCL_WRITABLE)) ==
sl@0	6479	(TCL_READABLE\|TCL_WRITABLE)) && (len == 0)) {
sl@0	6480	Tcl_DStringEndSublist(dsPtr);
sl@0	6481	}
sl@0	6482	if (len > 0) {
sl@0	6483	return TCL_OK;
sl@0	6484	}
sl@0	6485	}
sl@0	6486	if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
sl@0	6487	/*
sl@0	6488	* let the driver specific handle additional options
sl@0	6489	* and result code and message.
sl@0	6490	*/
sl@0	6491
sl@0	6492	return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
sl@0	6493	interp, optionName, dsPtr);
sl@0	6494	} else {
sl@0	6495	/*
sl@0	6496	* no driver specific options case.
sl@0	6497	*/
sl@0	6498
sl@0	6499	if (len == 0) {
sl@0	6500	return TCL_OK;
sl@0	6501	}
sl@0	6502	return Tcl_BadChannelOption(interp, optionName, NULL);
sl@0	6503	}
sl@0	6504	}
sl@0	6505
sl@0	6506	/*
sl@0	6507	*---------------------------------------------------------------------------
sl@0	6508	*
sl@0	6509	* Tcl_SetChannelOption --
sl@0	6510	*
sl@0	6511	* Sets an option on a channel.
sl@0	6512	*
sl@0	6513	* Results:
sl@0	6514	* A standard Tcl result. On error, sets interp's result object
sl@0	6515	* if interp is not NULL.
sl@0	6516	*
sl@0	6517	* Side effects:
sl@0	6518	* May modify an option on a device.
sl@0	6519	*
sl@0	6520	*---------------------------------------------------------------------------
sl@0	6521	*/
sl@0	6522
sl@0	6523	EXPORT_C int
sl@0	6524	Tcl_SetChannelOption(interp, chan, optionName, newValue)
sl@0	6525	Tcl_Interp interp; / For error reporting - can be NULL. */
sl@0	6526	Tcl_Channel chan; /* Channel on which to set mode. */
sl@0	6527	CONST char optionName; / Which option to set? */
sl@0	6528	CONST char newValue; / New value for option. */
sl@0	6529	{
sl@0	6530	Channel chanPtr = (Channel ) chan; /* The real IO channel. */
sl@0	6531	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	6532	size_t len; /* Length of optionName string. */
sl@0	6533	int argc;
sl@0	6534	CONST char **argv;
sl@0	6535
sl@0	6536	/*
sl@0	6537	* If the channel is in the middle of a background copy, fail.
sl@0	6538	*/
sl@0	6539
sl@0	6540	if (statePtr->csPtr) {
sl@0	6541	if (interp) {
sl@0	6542	Tcl_AppendResult(interp,
sl@0	6543	"unable to set channel options: background copy in progress",
sl@0	6544	(char *) NULL);
sl@0	6545	}
sl@0	6546	return TCL_ERROR;
sl@0	6547	}
sl@0	6548
sl@0	6549	/*
sl@0	6550	* Disallow options on dead channels -- channels that have been closed but
sl@0	6551	* not yet been deallocated. Such channels can be found if the exit
sl@0	6552	* handler for channel cleanup has run but the channel is still
sl@0	6553	* registered in an interpreter.
sl@0	6554	*/
sl@0	6555
sl@0	6556	if (CheckForDeadChannel(NULL, statePtr)) {
sl@0	6557	return TCL_ERROR;
sl@0	6558	}
sl@0	6559
sl@0	6560	/*
sl@0	6561	* This operation should occur at the top of a channel stack.
sl@0	6562	*/
sl@0	6563
sl@0	6564	chanPtr = statePtr->topChanPtr;
sl@0	6565
sl@0	6566	len = strlen(optionName);
sl@0	6567
sl@0	6568	if ((len > 2) && (optionName[1] == 'b') &&
sl@0	6569	(strncmp(optionName, "-blocking", len) == 0)) {
sl@0	6570	int newMode;
sl@0	6571	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
sl@0	6572	return TCL_ERROR;
sl@0	6573	}
sl@0	6574	if (newMode) {
sl@0	6575	newMode = TCL_MODE_BLOCKING;
sl@0	6576	} else {
sl@0	6577	newMode = TCL_MODE_NONBLOCKING;
sl@0	6578	}
sl@0	6579	return SetBlockMode(interp, chanPtr, newMode);
sl@0	6580	} else if ((len > 7) && (optionName[1] == 'b') &&
sl@0	6581	(strncmp(optionName, "-buffering", len) == 0)) {
sl@0	6582	len = strlen(newValue);
sl@0	6583	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
sl@0	6584	statePtr->flags &=
sl@0	6585	(~(CHANNEL_UNBUFFERED\|CHANNEL_LINEBUFFERED));
sl@0	6586	} else if ((newValue[0] == 'l') &&
sl@0	6587	(strncmp(newValue, "line", len) == 0)) {
sl@0	6588	statePtr->flags &= (~(CHANNEL_UNBUFFERED));
sl@0	6589	statePtr->flags \|= CHANNEL_LINEBUFFERED;
sl@0	6590	} else if ((newValue[0] == 'n') &&
sl@0	6591	(strncmp(newValue, "none", len) == 0)) {
sl@0	6592	statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
sl@0	6593	statePtr->flags \|= CHANNEL_UNBUFFERED;
sl@0	6594	} else {
sl@0	6595	if (interp) {
sl@0	6596	Tcl_AppendResult(interp, "bad value for -buffering: ",
sl@0	6597	"must be one of full, line, or none",
sl@0	6598	(char *) NULL);
sl@0	6599	return TCL_ERROR;
sl@0	6600	}
sl@0	6601	}
sl@0	6602	return TCL_OK;
sl@0	6603	} else if ((len > 7) && (optionName[1] == 'b') &&
sl@0	6604	(strncmp(optionName, "-buffersize", len) == 0)) {
sl@0	6605	int newBufferSize;
sl@0	6606	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
sl@0	6607	return TCL_ERROR;
sl@0	6608	}
sl@0	6609	Tcl_SetChannelBufferSize(chan, newBufferSize);
sl@0	6610	} else if ((len > 2) && (optionName[1] == 'e') &&
sl@0	6611	(strncmp(optionName, "-encoding", len) == 0)) {
sl@0	6612	Tcl_Encoding encoding;
sl@0	6613
sl@0	6614	if ((newValue[0] == '\0') \|\| (strcmp(newValue, "binary") == 0)) {
sl@0	6615	encoding = NULL;
sl@0	6616	} else {
sl@0	6617	encoding = Tcl_GetEncoding(interp, newValue);
sl@0	6618	if (encoding == NULL) {
sl@0	6619	return TCL_ERROR;
sl@0	6620	}
sl@0	6621	}
sl@0	6622	/*
sl@0	6623	* When the channel has an escape sequence driven encoding such as
sl@0	6624	* iso2022, the terminated escape sequence must write to the buffer.
sl@0	6625	*/
sl@0	6626	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
sl@0	6627	&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
sl@0	6628	statePtr->outputEncodingFlags \|= TCL_ENCODING_END;
sl@0	6629	WriteChars(chanPtr, "", 0);
sl@0	6630	}
sl@0	6631	Tcl_FreeEncoding(statePtr->encoding);
sl@0	6632	statePtr->encoding = encoding;
sl@0	6633	statePtr->inputEncodingState = NULL;
sl@0	6634	statePtr->inputEncodingFlags = TCL_ENCODING_START;
sl@0	6635	statePtr->outputEncodingState = NULL;
sl@0	6636	statePtr->outputEncodingFlags = TCL_ENCODING_START;
sl@0	6637	statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
sl@0	6638	UpdateInterest(chanPtr);
sl@0	6639	} else if ((len > 2) && (optionName[1] == 'e') &&
sl@0	6640	(strncmp(optionName, "-eofchar", len) == 0)) {
sl@0	6641	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
sl@0	6642	return TCL_ERROR;
sl@0	6643	}
sl@0	6644	if (argc == 0) {
sl@0	6645	statePtr->inEofChar = 0;
sl@0	6646	statePtr->outEofChar = 0;
sl@0	6647	} else if (argc == 1) {
sl@0	6648	if (statePtr->flags & TCL_WRITABLE) {
sl@0	6649	statePtr->outEofChar = (int) argv[0][0];
sl@0	6650	}
sl@0	6651	if (statePtr->flags & TCL_READABLE) {
sl@0	6652	statePtr->inEofChar = (int) argv[0][0];
sl@0	6653	}
sl@0	6654	} else if (argc != 2) {
sl@0	6655	if (interp) {
sl@0	6656	Tcl_AppendResult(interp,
sl@0	6657	"bad value for -eofchar: should be a list of zero,",
sl@0	6658	" one, or two elements", (char *) NULL);
sl@0	6659	}
sl@0	6660	ckfree((char *) argv);
sl@0	6661	return TCL_ERROR;
sl@0	6662	} else {
sl@0	6663	if (statePtr->flags & TCL_READABLE) {
sl@0	6664	statePtr->inEofChar = (int) argv[0][0];
sl@0	6665	}
sl@0	6666	if (statePtr->flags & TCL_WRITABLE) {
sl@0	6667	statePtr->outEofChar = (int) argv[1][0];
sl@0	6668	}
sl@0	6669	}
sl@0	6670	if (argv != NULL) {
sl@0	6671	ckfree((char *) argv);
sl@0	6672	}
sl@0	6673
sl@0	6674	/*
sl@0	6675	* [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing
sl@0	6676	* the character which signals eof can transform a current eof
sl@0	6677	* condition into a 'go ahead'. Ditto for blocked.
sl@0	6678	*/
sl@0	6679
sl@0	6680	statePtr->flags &= (~(CHANNEL_EOF \| CHANNEL_STICKY_EOF \| CHANNEL_BLOCKED));
sl@0	6681
sl@0	6682	return TCL_OK;
sl@0	6683	} else if ((len > 1) && (optionName[1] == 't') &&
sl@0	6684	(strncmp(optionName, "-translation", len) == 0)) {
sl@0	6685	CONST char readMode, writeMode;
sl@0	6686
sl@0	6687	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
sl@0	6688	return TCL_ERROR;
sl@0	6689	}
sl@0	6690
sl@0	6691	if (argc == 1) {
sl@0	6692	readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
sl@0	6693	writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
sl@0	6694	} else if (argc == 2) {
sl@0	6695	readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
sl@0	6696	writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
sl@0	6697	} else {
sl@0	6698	if (interp) {
sl@0	6699	Tcl_AppendResult(interp,
sl@0	6700	"bad value for -translation: must be a one or two",
sl@0	6701	" element list", (char *) NULL);
sl@0	6702	}
sl@0	6703	ckfree((char *) argv);
sl@0	6704	return TCL_ERROR;
sl@0	6705	}
sl@0	6706
sl@0	6707	if (readMode) {
sl@0	6708	TclEolTranslation translation;
sl@0	6709	if (*readMode == '\0') {
sl@0	6710	translation = statePtr->inputTranslation;
sl@0	6711	} else if (strcmp(readMode, "auto") == 0) {
sl@0	6712	translation = TCL_TRANSLATE_AUTO;
sl@0	6713	} else if (strcmp(readMode, "binary") == 0) {
sl@0	6714	translation = TCL_TRANSLATE_LF;
sl@0	6715	statePtr->inEofChar = 0;
sl@0	6716	Tcl_FreeEncoding(statePtr->encoding);
sl@0	6717	statePtr->encoding = NULL;
sl@0	6718	} else if (strcmp(readMode, "lf") == 0) {
sl@0	6719	translation = TCL_TRANSLATE_LF;
sl@0	6720	} else if (strcmp(readMode, "cr") == 0) {
sl@0	6721	translation = TCL_TRANSLATE_CR;
sl@0	6722	} else if (strcmp(readMode, "crlf") == 0) {
sl@0	6723	translation = TCL_TRANSLATE_CRLF;
sl@0	6724	} else if (strcmp(readMode, "platform") == 0) {
sl@0	6725	translation = TCL_PLATFORM_TRANSLATION;
sl@0	6726	} else {
sl@0	6727	if (interp) {
sl@0	6728	Tcl_AppendResult(interp,
sl@0	6729	"bad value for -translation: ",
sl@0	6730	"must be one of auto, binary, cr, lf, crlf,",
sl@0	6731	" or platform", (char *) NULL);
sl@0	6732	}
sl@0	6733	ckfree((char *) argv);
sl@0	6734	return TCL_ERROR;
sl@0	6735	}
sl@0	6736
sl@0	6737	/*
sl@0	6738	* Reset the EOL flags since we need to look at any buffered
sl@0	6739	* data to see if the new translation mode allows us to
sl@0	6740	* complete the line.
sl@0	6741	*/
sl@0	6742
sl@0	6743	if (translation != statePtr->inputTranslation) {
sl@0	6744	statePtr->inputTranslation = translation;
sl@0	6745	statePtr->flags &= ~(INPUT_SAW_CR);
sl@0	6746	statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
sl@0	6747	UpdateInterest(chanPtr);
sl@0	6748	}
sl@0	6749	}
sl@0	6750	if (writeMode) {
sl@0	6751	if (*writeMode == '\0') {
sl@0	6752	/* Do nothing. */
sl@0	6753	} else if (strcmp(writeMode, "auto") == 0) {
sl@0	6754	/*
sl@0	6755	* This is a hack to get TCP sockets to produce output
sl@0	6756	* in CRLF mode if they are being set into AUTO mode.
sl@0	6757	* A better solution for achieving this effect will be
sl@0	6758	* coded later.
sl@0	6759	*/
sl@0	6760
sl@0	6761	if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
sl@0	6762	statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
sl@0	6763	} else {
sl@0	6764	statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
sl@0	6765	}
sl@0	6766	} else if (strcmp(writeMode, "binary") == 0) {
sl@0	6767	statePtr->outEofChar = 0;
sl@0	6768	statePtr->outputTranslation = TCL_TRANSLATE_LF;
sl@0	6769	Tcl_FreeEncoding(statePtr->encoding);
sl@0	6770	statePtr->encoding = NULL;
sl@0	6771	} else if (strcmp(writeMode, "lf") == 0) {
sl@0	6772	statePtr->outputTranslation = TCL_TRANSLATE_LF;
sl@0	6773	} else if (strcmp(writeMode, "cr") == 0) {
sl@0	6774	statePtr->outputTranslation = TCL_TRANSLATE_CR;
sl@0	6775	} else if (strcmp(writeMode, "crlf") == 0) {
sl@0	6776	statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
sl@0	6777	} else if (strcmp(writeMode, "platform") == 0) {
sl@0	6778	statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
sl@0	6779	} else {
sl@0	6780	if (interp) {
sl@0	6781	Tcl_AppendResult(interp,
sl@0	6782	"bad value for -translation: ",
sl@0	6783	"must be one of auto, binary, cr, lf, crlf,",
sl@0	6784	" or platform", (char *) NULL);
sl@0	6785	}
sl@0	6786	ckfree((char *) argv);
sl@0	6787	return TCL_ERROR;
sl@0	6788	}
sl@0	6789	}
sl@0	6790	ckfree((char *) argv);
sl@0	6791	return TCL_OK;
sl@0	6792	} else if (chanPtr->typePtr->setOptionProc != NULL) {
sl@0	6793	return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
sl@0	6794	interp, optionName, newValue);
sl@0	6795	} else {
sl@0	6796	return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
sl@0	6797	}
sl@0	6798
sl@0	6799	/*
sl@0	6800	* If bufsize changes, need to get rid of old utility buffer.
sl@0	6801	*/
sl@0	6802
sl@0	6803	if (statePtr->saveInBufPtr != NULL) {
sl@0	6804	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
sl@0	6805	statePtr->saveInBufPtr = NULL;
sl@0	6806	}
sl@0	6807	if (statePtr->inQueueHead != NULL) {
sl@0	6808	if ((statePtr->inQueueHead->nextPtr == NULL)
sl@0	6809	&& (statePtr->inQueueHead->nextAdded ==
sl@0	6810	statePtr->inQueueHead->nextRemoved)) {
sl@0	6811	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
sl@0	6812	statePtr->inQueueHead = NULL;
sl@0	6813	statePtr->inQueueTail = NULL;
sl@0	6814	}
sl@0	6815	}
sl@0	6816
sl@0	6817	/*
sl@0	6818	* If encoding or bufsize changes, need to update output staging buffer.
sl@0	6819	*/
sl@0	6820
sl@0	6821	if (statePtr->outputStage != NULL) {
sl@0	6822	ckfree((char *) statePtr->outputStage);
sl@0	6823	statePtr->outputStage = NULL;
sl@0	6824	}
sl@0	6825	if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
sl@0	6826	statePtr->outputStage = (char *)
sl@0	6827	ckalloc((unsigned) (statePtr->bufSize + 2));
sl@0	6828	}
sl@0	6829	return TCL_OK;
sl@0	6830	}
sl@0	6831
sl@0	6832	/*
sl@0	6833	*----------------------------------------------------------------------
sl@0	6834	*
sl@0	6835	* CleanupChannelHandlers --
sl@0	6836	*
sl@0	6837	* Removes channel handlers that refer to the supplied interpreter,
sl@0	6838	* so that if the actual channel is not closed now, these handlers
sl@0	6839	* will not run on subsequent events on the channel. This would be
sl@0	6840	* erroneous, because the interpreter no longer has a reference to
sl@0	6841	* this channel.
sl@0	6842	*
sl@0	6843	* Results:
sl@0	6844	* None.
sl@0	6845	*
sl@0	6846	* Side effects:
sl@0	6847	* Removes channel handlers.
sl@0	6848	*
sl@0	6849	*----------------------------------------------------------------------
sl@0	6850	*/
sl@0	6851
sl@0	6852	static void
sl@0	6853	CleanupChannelHandlers(interp, chanPtr)
sl@0	6854	Tcl_Interp *interp;
sl@0	6855	Channel *chanPtr;
sl@0	6856	{
sl@0	6857	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	6858	EventScriptRecord sPtr, prevPtr, *nextPtr;
sl@0	6859
sl@0	6860	/*
sl@0	6861	* Remove fileevent records on this channel that refer to the
sl@0	6862	* given interpreter.
sl@0	6863	*/
sl@0	6864
sl@0	6865	for (sPtr = statePtr->scriptRecordPtr,
sl@0	6866	prevPtr = (EventScriptRecord *) NULL;
sl@0	6867	sPtr != (EventScriptRecord *) NULL;
sl@0	6868	sPtr = nextPtr) {
sl@0	6869	nextPtr = sPtr->nextPtr;
sl@0	6870	if (sPtr->interp == interp) {
sl@0	6871	if (prevPtr == (EventScriptRecord *) NULL) {
sl@0	6872	statePtr->scriptRecordPtr = nextPtr;
sl@0	6873	} else {
sl@0	6874	prevPtr->nextPtr = nextPtr;
sl@0	6875	}
sl@0	6876
sl@0	6877	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
sl@0	6878	TclChannelEventScriptInvoker, (ClientData) sPtr);
sl@0	6879
sl@0	6880	Tcl_DecrRefCount(sPtr->scriptPtr);
sl@0	6881	ckfree((char *) sPtr);
sl@0	6882	} else {
sl@0	6883	prevPtr = sPtr;
sl@0	6884	}
sl@0	6885	}
sl@0	6886	}
sl@0	6887
sl@0	6888	/*
sl@0	6889	*----------------------------------------------------------------------
sl@0	6890	*
sl@0	6891	* Tcl_NotifyChannel --
sl@0	6892	*
sl@0	6893	* This procedure is called by a channel driver when a driver
sl@0	6894	* detects an event on a channel. This procedure is responsible
sl@0	6895	* for actually handling the event by invoking any channel
sl@0	6896	* handler callbacks.
sl@0	6897	*
sl@0	6898	* Results:
sl@0	6899	* None.
sl@0	6900	*
sl@0	6901	* Side effects:
sl@0	6902	* Whatever the channel handler callback procedure does.
sl@0	6903	*
sl@0	6904	*----------------------------------------------------------------------
sl@0	6905	*/
sl@0	6906
sl@0	6907	EXPORT_C void
sl@0	6908	Tcl_NotifyChannel(channel, mask)
sl@0	6909	Tcl_Channel channel; /* Channel that detected an event. */
sl@0	6910	int mask; /* OR'ed combination of TCL_READABLE,
sl@0	6911	* TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0	6912	* which events were detected. */
sl@0	6913	{
sl@0	6914	Channel chanPtr = (Channel ) channel;
sl@0	6915	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	6916	ChannelHandler *chPtr;
sl@0	6917	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	6918	NextChannelHandler nh;
sl@0	6919	Channel* upChanPtr;
sl@0	6920	Tcl_ChannelType* upTypePtr;
sl@0	6921
sl@0	6922	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	6923	/* [SF Tcl Bug 943274]
sl@0	6924	* For a non-blocking channel without blockmodeproc we keep track
sl@0	6925	* of actual input coming from the OS so that we can do a credible
sl@0	6926	* imitation of non-blocking behaviour.
sl@0	6927	*/
sl@0	6928
sl@0	6929	if ((mask & TCL_READABLE) &&
sl@0	6930	(statePtr->flags & CHANNEL_NONBLOCKING) &&
sl@0	6931	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
sl@0	6932	!(statePtr->flags & CHANNEL_TIMER_FEV)) {
sl@0	6933
sl@0	6934	statePtr->flags \|= CHANNEL_HAS_MORE_DATA;
sl@0	6935	}
sl@0	6936	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	6937
sl@0	6938	/*
sl@0	6939	* In contrast to the other API functions this procedure walks towards
sl@0	6940	* the top of a stack and not down from it.
sl@0	6941	*
sl@0	6942	* The channel calling this procedure is the one who generated the event,
sl@0	6943	* and thus does not take part in handling it. IOW, its HandlerProc is
sl@0	6944	* not called, instead we begin with the channel above it.
sl@0	6945	*
sl@0	6946	* This behaviour also allows the transformation channels to
sl@0	6947	* generate their own events and pass them upward.
sl@0	6948	*/
sl@0	6949
sl@0	6950	while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
sl@0	6951	Tcl_DriverHandlerProc* upHandlerProc;
sl@0	6952
sl@0	6953	upChanPtr = chanPtr->upChanPtr;
sl@0	6954	upTypePtr = upChanPtr->typePtr;
sl@0	6955	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
sl@0	6956	if (upHandlerProc != NULL) {
sl@0	6957	mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
sl@0	6958	}
sl@0	6959
sl@0	6960	/* ELSE:
sl@0	6961	* Ignore transformations which are unable to handle the event
sl@0	6962	* coming from below. Assume that they don't change the mask and
sl@0	6963	* pass it on.
sl@0	6964	*/
sl@0	6965
sl@0	6966	chanPtr = upChanPtr;
sl@0	6967	}
sl@0	6968
sl@0	6969	channel = (Tcl_Channel) chanPtr;
sl@0	6970
sl@0	6971	/*
sl@0	6972	* Here we have either reached the top of the stack or the mask is
sl@0	6973	* empty. We break out of the procedure if it is the latter.
sl@0	6974	*/
sl@0	6975
sl@0	6976	if (!mask) {
sl@0	6977	return;
sl@0	6978	}
sl@0	6979
sl@0	6980	/*
sl@0	6981	* We are now above the topmost channel in a stack and have events
sl@0	6982	* left. Now call the channel handlers as usual.
sl@0	6983	*
sl@0	6984	* Preserve the channel struct in case the script closes it.
sl@0	6985	*/
sl@0	6986
sl@0	6987	Tcl_Preserve((ClientData) channel);
sl@0	6988	Tcl_Preserve((ClientData) statePtr);
sl@0	6989
sl@0	6990	/*
sl@0	6991	* If we are flushing in the background, be sure to call FlushChannel
sl@0	6992	* for writable events. Note that we have to discard the writable
sl@0	6993	* event so we don't call any write handlers before the flush is
sl@0	6994	* complete.
sl@0	6995	*/
sl@0	6996
sl@0	6997	if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
sl@0	6998	FlushChannel(NULL, chanPtr, 1);
sl@0	6999	mask &= ~TCL_WRITABLE;
sl@0	7000	}
sl@0	7001
sl@0	7002	/*
sl@0	7003	* Add this invocation to the list of recursive invocations of
sl@0	7004	* ChannelHandlerEventProc.
sl@0	7005	*/
sl@0	7006
sl@0	7007	nh.nextHandlerPtr = (ChannelHandler *) NULL;
sl@0	7008	nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
sl@0	7009	tsdPtr->nestedHandlerPtr = &nh;
sl@0	7010
sl@0	7011	for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
sl@0	7012	/*
sl@0	7013	* If this channel handler is interested in any of the events that
sl@0	7014	* have occurred on the channel, invoke its procedure.
sl@0	7015	*/
sl@0	7016
sl@0	7017	if ((chPtr->mask & mask) != 0) {
sl@0	7018	nh.nextHandlerPtr = chPtr->nextPtr;
sl@0	7019	(*(chPtr->proc))(chPtr->clientData, mask);
sl@0	7020	chPtr = nh.nextHandlerPtr;
sl@0	7021	} else {
sl@0	7022	chPtr = chPtr->nextPtr;
sl@0	7023	}
sl@0	7024	}
sl@0	7025
sl@0	7026	/*
sl@0	7027	* Update the notifier interest, since it may have changed after
sl@0	7028	* invoking event handlers. Skip that if the channel was deleted
sl@0	7029	* in the call to the channel handler.
sl@0	7030	*/
sl@0	7031
sl@0	7032	if (chanPtr->typePtr != NULL) {
sl@0	7033	UpdateInterest(chanPtr);
sl@0	7034	}
sl@0	7035
sl@0	7036	Tcl_Release((ClientData) statePtr);
sl@0	7037	Tcl_Release((ClientData) channel);
sl@0	7038
sl@0	7039	tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
sl@0	7040	}
sl@0	7041
sl@0	7042	/*
sl@0	7043	*----------------------------------------------------------------------
sl@0	7044	*
sl@0	7045	* UpdateInterest --
sl@0	7046	*
sl@0	7047	* Arrange for the notifier to call us back at appropriate times
sl@0	7048	* based on the current state of the channel.
sl@0	7049	*
sl@0	7050	* Results:
sl@0	7051	* None.
sl@0	7052	*
sl@0	7053	* Side effects:
sl@0	7054	* May schedule a timer or driver handler.
sl@0	7055	*
sl@0	7056	*----------------------------------------------------------------------
sl@0	7057	*/
sl@0	7058
sl@0	7059	static void
sl@0	7060	UpdateInterest(chanPtr)
sl@0	7061	Channel chanPtr; / Channel to update. */
sl@0	7062	{
sl@0	7063	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7064	int mask = statePtr->interestMask;
sl@0	7065
sl@0	7066	/*
sl@0	7067	* If there are flushed buffers waiting to be written, then
sl@0	7068	* we need to watch for the channel to become writable.
sl@0	7069	*/
sl@0	7070
sl@0	7071	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
sl@0	7072	mask \|= TCL_WRITABLE;
sl@0	7073	}
sl@0	7074
sl@0	7075	/*
sl@0	7076	* If there is data in the input queue, and we aren't waiting for more
sl@0	7077	* data, then we need to schedule a timer so we don't block in the
sl@0	7078	* notifier. Also, cancel the read interest so we don't get duplicate
sl@0	7079	* events.
sl@0	7080	*/
sl@0	7081
sl@0	7082	if (mask & TCL_READABLE) {
sl@0	7083	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
sl@0	7084	&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
sl@0	7085	&& (statePtr->inQueueHead->nextRemoved <
sl@0	7086	statePtr->inQueueHead->nextAdded)) {
sl@0	7087	mask &= ~TCL_READABLE;
sl@0	7088
sl@0	7089	/*
sl@0	7090	* Andreas Kupries, April 11, 2003
sl@0	7091	*
sl@0	7092	* Some operating systems (Solaris 2.6 and higher (but not
sl@0	7093	* Solaris 2.5, go figure)) generate READABLE and
sl@0	7094	* EXCEPTION events when select()'ing [*] on a plain file,
sl@0	7095	* even if EOF was not yet reached. This is a problem in
sl@0	7096	* the following situation:
sl@0	7097	*
sl@0	7098	* - An extension asks to get both READABLE and EXCEPTION
sl@0	7099	* events.
sl@0	7100	* - It reads data into a buffer smaller than the buffer
sl@0	7101	* used by Tcl itself.
sl@0	7102	* - It does not process all events in the event queue, but
sl@0	7103	* only only one, at least in some situations.
sl@0	7104	*
sl@0	7105	* In that case we can get into a situation where
sl@0	7106	*
sl@0	7107	* - Tcl drops READABLE here, because it has data in its own
sl@0	7108	* buffers waiting to be read by the extension.
sl@0	7109	* - A READABLE event is syntesized via timer.
sl@0	7110	* - The OS still reports the EXCEPTION condition on the file.
sl@0	7111	* - And the extension gets the EXCPTION event first, and
sl@0	7112	* handles this as EOF.
sl@0	7113	*
sl@0	7114	* End result ==> Premature end of reading from a file.
sl@0	7115	*
sl@0	7116	* The concrete example is 'Expect', and its [expect]
sl@0	7117	* command (and at the C-level, deep in the bowels of
sl@0	7118	* Expect, 'exp_get_next_event'. See marker 'SunOS' for
sl@0	7119	* commentary in that function too).
sl@0	7120	*
sl@0	7121	* [*] As the Tcl notifier does. See also for marker
sl@0	7122	* 'SunOS' in file 'exp_event.c' of Expect.
sl@0	7123	*
sl@0	7124	* Our solution here is to drop the interest in the
sl@0	7125	* EXCEPTION events too. This compiles on all platforms,
sl@0	7126	* and also passes the testsuite on all of them.
sl@0	7127	*/
sl@0	7128
sl@0	7129	mask &= ~TCL_EXCEPTION;
sl@0	7130
sl@0	7131	if (!statePtr->timer) {
sl@0	7132	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
sl@0	7133	(ClientData) chanPtr);
sl@0	7134	}
sl@0	7135	}
sl@0	7136	}
sl@0	7137	(chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
sl@0	7138	}
sl@0	7139
sl@0	7140	/*
sl@0	7141	*----------------------------------------------------------------------
sl@0	7142	*
sl@0	7143	* ChannelTimerProc --
sl@0	7144	*
sl@0	7145	* Timer handler scheduled by UpdateInterest to monitor the
sl@0	7146	* channel buffers until they are empty.
sl@0	7147	*
sl@0	7148	* Results:
sl@0	7149	* None.
sl@0	7150	*
sl@0	7151	* Side effects:
sl@0	7152	* May invoke channel handlers.
sl@0	7153	*
sl@0	7154	*----------------------------------------------------------------------
sl@0	7155	*/
sl@0	7156
sl@0	7157	static void
sl@0	7158	ChannelTimerProc(clientData)
sl@0	7159	ClientData clientData;
sl@0	7160	{
sl@0	7161	Channel chanPtr = (Channel ) clientData;
sl@0	7162	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7163
sl@0	7164	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
sl@0	7165	&& (statePtr->interestMask & TCL_READABLE)
sl@0	7166	&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
sl@0	7167	&& (statePtr->inQueueHead->nextRemoved <
sl@0	7168	statePtr->inQueueHead->nextAdded)) {
sl@0	7169	/*
sl@0	7170	* Restart the timer in case a channel handler reenters the
sl@0	7171	* event loop before UpdateInterest gets called by Tcl_NotifyChannel.
sl@0	7172	*/
sl@0	7173
sl@0	7174	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
sl@0	7175	(ClientData) chanPtr);
sl@0	7176
sl@0	7177	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	7178	/* Set the TIMER flag to notify the higher levels that the
sl@0	7179	* driver might have no data for us. We do this only if we are
sl@0	7180	* in non-blocking mode and the driver has no BlockModeProc
sl@0	7181	* because only then we really don't know if the driver will
sl@0	7182	* block or not. A similar test is done in "PeekAhead".
sl@0	7183	*/
sl@0	7184
sl@0	7185	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
sl@0	7186	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
sl@0	7187	statePtr->flags \|= CHANNEL_TIMER_FEV;
sl@0	7188	}
sl@0	7189	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	7190
sl@0	7191	Tcl_Preserve((ClientData) statePtr);
sl@0	7192	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
sl@0	7193
sl@0	7194	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	7195	statePtr->flags &= ~CHANNEL_TIMER_FEV;
sl@0	7196	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	7197
sl@0	7198	Tcl_Release((ClientData) statePtr);
sl@0	7199	} else {
sl@0	7200	statePtr->timer = NULL;
sl@0	7201	UpdateInterest(chanPtr);
sl@0	7202	}
sl@0	7203	}
sl@0	7204
sl@0	7205	/*
sl@0	7206	*----------------------------------------------------------------------
sl@0	7207	*
sl@0	7208	* Tcl_CreateChannelHandler --
sl@0	7209	*
sl@0	7210	* Arrange for a given procedure to be invoked whenever the
sl@0	7211	* channel indicated by the chanPtr arg becomes readable or
sl@0	7212	* writable.
sl@0	7213	*
sl@0	7214	* Results:
sl@0	7215	* None.
sl@0	7216	*
sl@0	7217	* Side effects:
sl@0	7218	* From now on, whenever the I/O channel given by chanPtr becomes
sl@0	7219	* ready in the way indicated by mask, proc will be invoked.
sl@0	7220	* See the manual entry for details on the calling sequence
sl@0	7221	* to proc. If there is already an event handler for chan, proc
sl@0	7222	* and clientData, then the mask will be updated.
sl@0	7223	*
sl@0	7224	*----------------------------------------------------------------------
sl@0	7225	*/
sl@0	7226
sl@0	7227	EXPORT_C void
sl@0	7228	Tcl_CreateChannelHandler(chan, mask, proc, clientData)
sl@0	7229	Tcl_Channel chan; /* The channel to create the handler for. */
sl@0	7230	int mask; /* OR'ed combination of TCL_READABLE,
sl@0	7231	* TCL_WRITABLE, and TCL_EXCEPTION:
sl@0	7232	* indicates conditions under which
sl@0	7233	* proc should be called. Use 0 to
sl@0	7234	* disable a registered handler. */
sl@0	7235	Tcl_ChannelProc proc; / Procedure to call for each
sl@0	7236	* selected event. */
sl@0	7237	ClientData clientData; /* Arbitrary data to pass to proc. */
sl@0	7238	{
sl@0	7239	ChannelHandler *chPtr;
sl@0	7240	Channel chanPtr = (Channel ) chan;
sl@0	7241	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7242
sl@0	7243	/*
sl@0	7244	* Check whether this channel handler is not already registered. If
sl@0	7245	* it is not, create a new record, else reuse existing record (smash
sl@0	7246	* current values).
sl@0	7247	*/
sl@0	7248
sl@0	7249	for (chPtr = statePtr->chPtr;
sl@0	7250	chPtr != (ChannelHandler *) NULL;
sl@0	7251	chPtr = chPtr->nextPtr) {
sl@0	7252	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
sl@0	7253	(chPtr->clientData == clientData)) {
sl@0	7254	break;
sl@0	7255	}
sl@0	7256	}
sl@0	7257	if (chPtr == (ChannelHandler *) NULL) {
sl@0	7258	chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
sl@0	7259	chPtr->mask = 0;
sl@0	7260	chPtr->proc = proc;
sl@0	7261	chPtr->clientData = clientData;
sl@0	7262	chPtr->chanPtr = chanPtr;
sl@0	7263	chPtr->nextPtr = statePtr->chPtr;
sl@0	7264	statePtr->chPtr = chPtr;
sl@0	7265	}
sl@0	7266
sl@0	7267	/*
sl@0	7268	* The remainder of the initialization below is done regardless of
sl@0	7269	* whether or not this is a new record or a modification of an old
sl@0	7270	* one.
sl@0	7271	*/
sl@0	7272
sl@0	7273	chPtr->mask = mask;
sl@0	7274
sl@0	7275	/*
sl@0	7276	* Recompute the interest mask for the channel - this call may actually
sl@0	7277	* be disabling an existing handler.
sl@0	7278	*/
sl@0	7279
sl@0	7280	statePtr->interestMask = 0;
sl@0	7281	for (chPtr = statePtr->chPtr;
sl@0	7282	chPtr != (ChannelHandler *) NULL;
sl@0	7283	chPtr = chPtr->nextPtr) {
sl@0	7284	statePtr->interestMask \|= chPtr->mask;
sl@0	7285	}
sl@0	7286
sl@0	7287	UpdateInterest(statePtr->topChanPtr);
sl@0	7288	}
sl@0	7289
sl@0	7290	/*
sl@0	7291	*----------------------------------------------------------------------
sl@0	7292	*
sl@0	7293	* Tcl_DeleteChannelHandler --
sl@0	7294	*
sl@0	7295	* Cancel a previously arranged callback arrangement for an IO
sl@0	7296	* channel.
sl@0	7297	*
sl@0	7298	* Results:
sl@0	7299	* None.
sl@0	7300	*
sl@0	7301	* Side effects:
sl@0	7302	* If a callback was previously registered for this chan, proc and
sl@0	7303	* clientData , it is removed and the callback will no longer be called
sl@0	7304	* when the channel becomes ready for IO.
sl@0	7305	*
sl@0	7306	*----------------------------------------------------------------------
sl@0	7307	*/
sl@0	7308
sl@0	7309	EXPORT_C void
sl@0	7310	Tcl_DeleteChannelHandler(chan, proc, clientData)
sl@0	7311	Tcl_Channel chan; /* The channel for which to remove the
sl@0	7312	* callback. */
sl@0	7313	Tcl_ChannelProc proc; / The procedure in the callback to delete. */
sl@0	7314	ClientData clientData; /* The client data in the callback
sl@0	7315	* to delete. */
sl@0	7316
sl@0	7317	{
sl@0	7318	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	7319	ChannelHandler chPtr, prevChPtr;
sl@0	7320	Channel chanPtr = (Channel ) chan;
sl@0	7321	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7322	NextChannelHandler *nhPtr;
sl@0	7323
sl@0	7324	/*
sl@0	7325	* Find the entry and the previous one in the list.
sl@0	7326	*/
sl@0	7327
sl@0	7328	for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
sl@0	7329	chPtr != (ChannelHandler *) NULL;
sl@0	7330	chPtr = chPtr->nextPtr) {
sl@0	7331	if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
sl@0	7332	&& (chPtr->proc == proc)) {
sl@0	7333	break;
sl@0	7334	}
sl@0	7335	prevChPtr = chPtr;
sl@0	7336	}
sl@0	7337
sl@0	7338	/*
sl@0	7339	* If not found, return without doing anything.
sl@0	7340	*/
sl@0	7341
sl@0	7342	if (chPtr == (ChannelHandler *) NULL) {
sl@0	7343	return;
sl@0	7344	}
sl@0	7345
sl@0	7346	/*
sl@0	7347	* If ChannelHandlerEventProc is about to process this handler, tell it to
sl@0	7348	* process the next one instead - we are going to delete this one.
sl@0	7349	*/
sl@0	7350
sl@0	7351	for (nhPtr = tsdPtr->nestedHandlerPtr;
sl@0	7352	nhPtr != (NextChannelHandler *) NULL;
sl@0	7353	nhPtr = nhPtr->nestedHandlerPtr) {
sl@0	7354	if (nhPtr->nextHandlerPtr == chPtr) {
sl@0	7355	nhPtr->nextHandlerPtr = chPtr->nextPtr;
sl@0	7356	}
sl@0	7357	}
sl@0	7358
sl@0	7359	/*
sl@0	7360	* Splice it out of the list of channel handlers.
sl@0	7361	*/
sl@0	7362
sl@0	7363	if (prevChPtr == (ChannelHandler *) NULL) {
sl@0	7364	statePtr->chPtr = chPtr->nextPtr;
sl@0	7365	} else {
sl@0	7366	prevChPtr->nextPtr = chPtr->nextPtr;
sl@0	7367	}
sl@0	7368	ckfree((char *) chPtr);
sl@0	7369
sl@0	7370	/*
sl@0	7371	* Recompute the interest list for the channel, so that infinite loops
sl@0	7372	* will not result if Tcl_DeleteChannelHandler is called inside an
sl@0	7373	* event.
sl@0	7374	*/
sl@0	7375
sl@0	7376	statePtr->interestMask = 0;
sl@0	7377	for (chPtr = statePtr->chPtr;
sl@0	7378	chPtr != (ChannelHandler *) NULL;
sl@0	7379	chPtr = chPtr->nextPtr) {
sl@0	7380	statePtr->interestMask \|= chPtr->mask;
sl@0	7381	}
sl@0	7382
sl@0	7383	UpdateInterest(statePtr->topChanPtr);
sl@0	7384	}
sl@0	7385
sl@0	7386	/*
sl@0	7387	*----------------------------------------------------------------------
sl@0	7388	*
sl@0	7389	* DeleteScriptRecord --
sl@0	7390	*
sl@0	7391	* Delete a script record for this combination of channel, interp
sl@0	7392	* and mask.
sl@0	7393	*
sl@0	7394	* Results:
sl@0	7395	* None.
sl@0	7396	*
sl@0	7397	* Side effects:
sl@0	7398	* Deletes a script record and cancels a channel event handler.
sl@0	7399	*
sl@0	7400	*----------------------------------------------------------------------
sl@0	7401	*/
sl@0	7402
sl@0	7403	static void
sl@0	7404	DeleteScriptRecord(interp, chanPtr, mask)
sl@0	7405	Tcl_Interp interp; / Interpreter in which script was to be
sl@0	7406	* executed. */
sl@0	7407	Channel chanPtr; / The channel for which to delete the
sl@0	7408	* script record (if any). */
sl@0	7409	int mask; /* Events in mask must exactly match mask
sl@0	7410	* of script to delete. */
sl@0	7411	{
sl@0	7412	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7413	EventScriptRecord esPtr, prevEsPtr;
sl@0	7414
sl@0	7415	for (esPtr = statePtr->scriptRecordPtr,
sl@0	7416	prevEsPtr = (EventScriptRecord *) NULL;
sl@0	7417	esPtr != (EventScriptRecord *) NULL;
sl@0	7418	prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
sl@0	7419	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
sl@0	7420	if (esPtr == statePtr->scriptRecordPtr) {
sl@0	7421	statePtr->scriptRecordPtr = esPtr->nextPtr;
sl@0	7422	} else {
sl@0	7423	prevEsPtr->nextPtr = esPtr->nextPtr;
sl@0	7424	}
sl@0	7425
sl@0	7426	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
sl@0	7427	TclChannelEventScriptInvoker, (ClientData) esPtr);
sl@0	7428
sl@0	7429	Tcl_DecrRefCount(esPtr->scriptPtr);
sl@0	7430	ckfree((char *) esPtr);
sl@0	7431
sl@0	7432	break;
sl@0	7433	}
sl@0	7434	}
sl@0	7435	}
sl@0	7436
sl@0	7437	/*
sl@0	7438	*----------------------------------------------------------------------
sl@0	7439	*
sl@0	7440	* CreateScriptRecord --
sl@0	7441	*
sl@0	7442	* Creates a record to store a script to be executed when a specific
sl@0	7443	* event fires on a specific channel.
sl@0	7444	*
sl@0	7445	* Results:
sl@0	7446	* None.
sl@0	7447	*
sl@0	7448	* Side effects:
sl@0	7449	* Causes the script to be stored for later execution.
sl@0	7450	*
sl@0	7451	*----------------------------------------------------------------------
sl@0	7452	*/
sl@0	7453
sl@0	7454	static void
sl@0	7455	CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
sl@0	7456	Tcl_Interp interp; / Interpreter in which to execute
sl@0	7457	* the stored script. */
sl@0	7458	Channel chanPtr; / Channel for which script is to
sl@0	7459	* be stored. */
sl@0	7460	int mask; /* Set of events for which script
sl@0	7461	* will be invoked. */
sl@0	7462	Tcl_Obj scriptPtr; / Pointer to script object. */
sl@0	7463	{
sl@0	7464	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	7465	EventScriptRecord *esPtr;
sl@0	7466
sl@0	7467	for (esPtr = statePtr->scriptRecordPtr;
sl@0	7468	esPtr != (EventScriptRecord *) NULL;
sl@0	7469	esPtr = esPtr->nextPtr) {
sl@0	7470	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
sl@0	7471	Tcl_DecrRefCount(esPtr->scriptPtr);
sl@0	7472	esPtr->scriptPtr = (Tcl_Obj *) NULL;
sl@0	7473	break;
sl@0	7474	}
sl@0	7475	}
sl@0	7476	if (esPtr == (EventScriptRecord *) NULL) {
sl@0	7477	esPtr = (EventScriptRecord *) ckalloc((unsigned)
sl@0	7478	sizeof(EventScriptRecord));
sl@0	7479	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
sl@0	7480	TclChannelEventScriptInvoker, (ClientData) esPtr);
sl@0	7481	esPtr->nextPtr = statePtr->scriptRecordPtr;
sl@0	7482	statePtr->scriptRecordPtr = esPtr;
sl@0	7483	}
sl@0	7484	esPtr->chanPtr = chanPtr;
sl@0	7485	esPtr->interp = interp;
sl@0	7486	esPtr->mask = mask;
sl@0	7487	Tcl_IncrRefCount(scriptPtr);
sl@0	7488	esPtr->scriptPtr = scriptPtr;
sl@0	7489	}
sl@0	7490
sl@0	7491	/*
sl@0	7492	*----------------------------------------------------------------------
sl@0	7493	*
sl@0	7494	* TclChannelEventScriptInvoker --
sl@0	7495	*
sl@0	7496	* Invokes a script scheduled by "fileevent" for when the channel
sl@0	7497	* becomes ready for IO. This function is invoked by the channel
sl@0	7498	* handler which was created by the Tcl "fileevent" command.
sl@0	7499	*
sl@0	7500	* Results:
sl@0	7501	* None.
sl@0	7502	*
sl@0	7503	* Side effects:
sl@0	7504	* Whatever the script does.
sl@0	7505	*
sl@0	7506	*----------------------------------------------------------------------
sl@0	7507	*/
sl@0	7508
sl@0	7509	void
sl@0	7510	TclChannelEventScriptInvoker(clientData, mask)
sl@0	7511	ClientData clientData; /* The script+interp record. */
sl@0	7512	int mask; /* Not used. */
sl@0	7513	{
sl@0	7514	Tcl_Interp interp; / Interpreter in which to eval the script. */
sl@0	7515	Channel chanPtr; / The channel for which this handler is
sl@0	7516	* registered. */
sl@0	7517	EventScriptRecord esPtr; / The event script + interpreter to eval it
sl@0	7518	* in. */
sl@0	7519	int result; /* Result of call to eval script. */
sl@0	7520
sl@0	7521	esPtr = (EventScriptRecord *) clientData;
sl@0	7522	chanPtr = esPtr->chanPtr;
sl@0	7523	mask = esPtr->mask;
sl@0	7524	interp = esPtr->interp;
sl@0	7525
sl@0	7526	/*
sl@0	7527	* We must preserve the interpreter so we can report errors on it
sl@0	7528	* later. Note that we do not need to preserve the channel because
sl@0	7529	* that is done by Tcl_NotifyChannel before calling channel handlers.
sl@0	7530	*/
sl@0	7531
sl@0	7532	Tcl_Preserve((ClientData) interp);
sl@0	7533	result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
sl@0	7534
sl@0	7535	/*
sl@0	7536	* On error, cause a background error and remove the channel handler
sl@0	7537	* and the script record.
sl@0	7538	*
sl@0	7539	* NOTE: Must delete channel handler before causing the background error
sl@0	7540	* because the background error may want to reinstall the handler.
sl@0	7541	*/
sl@0	7542
sl@0	7543	if (result != TCL_OK) {
sl@0	7544	if (chanPtr->typePtr != NULL) {
sl@0	7545	DeleteScriptRecord(interp, chanPtr, mask);
sl@0	7546	}
sl@0	7547	Tcl_BackgroundError(interp);
sl@0	7548	}
sl@0	7549	Tcl_Release((ClientData) interp);
sl@0	7550	}
sl@0	7551
sl@0	7552	/*
sl@0	7553	*----------------------------------------------------------------------
sl@0	7554	*
sl@0	7555	* Tcl_FileEventObjCmd --
sl@0	7556	*
sl@0	7557	* This procedure implements the "fileevent" Tcl command. See the
sl@0	7558	* user documentation for details on what it does. This command is
sl@0	7559	* based on the Tk command "fileevent" which in turn is based on work
sl@0	7560	* contributed by Mark Diekhans.
sl@0	7561	*
sl@0	7562	* Results:
sl@0	7563	* A standard Tcl result.
sl@0	7564	*
sl@0	7565	* Side effects:
sl@0	7566	* May create a channel handler for the specified channel.
sl@0	7567	*
sl@0	7568	*----------------------------------------------------------------------
sl@0	7569	*/
sl@0	7570
sl@0	7571	/* ARGSUSED */
sl@0	7572	int
sl@0	7573	Tcl_FileEventObjCmd(clientData, interp, objc, objv)
sl@0	7574	ClientData clientData; /* Not used. */
sl@0	7575	Tcl_Interp interp; / Interpreter in which the channel
sl@0	7576	* for which to create the handler
sl@0	7577	* is found. */
sl@0	7578	int objc; /* Number of arguments. */
sl@0	7579	Tcl_Obj CONST objv[]; / Argument objects. */
sl@0	7580	{
sl@0	7581	Channel chanPtr; / The channel to create
sl@0	7582	* the handler for. */
sl@0	7583	ChannelState statePtr; / state info for channel */
sl@0	7584	Tcl_Channel chan; /* The opaque type for the channel. */
sl@0	7585	char *chanName;
sl@0	7586	int modeIndex; /* Index of mode argument. */
sl@0	7587	int mask;
sl@0	7588	static CONST char *modeOptions[] = {"readable", "writable", NULL};
sl@0	7589	static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
sl@0	7590
sl@0	7591	if ((objc != 3) && (objc != 4)) {
sl@0	7592	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
sl@0	7593	return TCL_ERROR;
sl@0	7594	}
sl@0	7595	if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
sl@0	7596	&modeIndex) != TCL_OK) {
sl@0	7597	return TCL_ERROR;
sl@0	7598	}
sl@0	7599	mask = maskArray[modeIndex];
sl@0	7600
sl@0	7601	chanName = Tcl_GetString(objv[1]);
sl@0	7602	chan = Tcl_GetChannel(interp, chanName, NULL);
sl@0	7603	if (chan == (Tcl_Channel) NULL) {
sl@0	7604	return TCL_ERROR;
sl@0	7605	}
sl@0	7606	chanPtr = (Channel *) chan;
sl@0	7607	statePtr = chanPtr->state;
sl@0	7608	if ((statePtr->flags & mask) == 0) {
sl@0	7609	Tcl_AppendResult(interp, "channel is not ",
sl@0	7610	(mask == TCL_READABLE) ? "readable" : "writable",
sl@0	7611	(char *) NULL);
sl@0	7612	return TCL_ERROR;
sl@0	7613	}
sl@0	7614
sl@0	7615	/*
sl@0	7616	* If we are supposed to return the script, do so.
sl@0	7617	*/
sl@0	7618
sl@0	7619	if (objc == 3) {
sl@0	7620	EventScriptRecord *esPtr;
sl@0	7621	for (esPtr = statePtr->scriptRecordPtr;
sl@0	7622	esPtr != (EventScriptRecord *) NULL;
sl@0	7623	esPtr = esPtr->nextPtr) {
sl@0	7624	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
sl@0	7625	Tcl_SetObjResult(interp, esPtr->scriptPtr);
sl@0	7626	break;
sl@0	7627	}
sl@0	7628	}
sl@0	7629	return TCL_OK;
sl@0	7630	}
sl@0	7631
sl@0	7632	/*
sl@0	7633	* If we are supposed to delete a stored script, do so.
sl@0	7634	*/
sl@0	7635
sl@0	7636	if (*(Tcl_GetString(objv[3])) == '\0') {
sl@0	7637	DeleteScriptRecord(interp, chanPtr, mask);
sl@0	7638	return TCL_OK;
sl@0	7639	}
sl@0	7640
sl@0	7641	/*
sl@0	7642	* Make the script record that will link between the event and the
sl@0	7643	* script to invoke. This also creates a channel event handler which
sl@0	7644	* will evaluate the script in the supplied interpreter.
sl@0	7645	*/
sl@0	7646
sl@0	7647	CreateScriptRecord(interp, chanPtr, mask, objv[3]);
sl@0	7648
sl@0	7649	return TCL_OK;
sl@0	7650	}
sl@0	7651
sl@0	7652	/*
sl@0	7653	*----------------------------------------------------------------------
sl@0	7654	*
sl@0	7655	* TclCopyChannel --
sl@0	7656	*
sl@0	7657	* This routine copies data from one channel to another, either
sl@0	7658	* synchronously or asynchronously. If a command script is
sl@0	7659	* supplied, the operation runs in the background. The script
sl@0	7660	* is invoked when the copy completes. Otherwise the function
sl@0	7661	* waits until the copy is completed before returning.
sl@0	7662	*
sl@0	7663	* Results:
sl@0	7664	* A standard Tcl result.
sl@0	7665	*
sl@0	7666	* Side effects:
sl@0	7667	* May schedule a background copy operation that causes both
sl@0	7668	* channels to be marked busy.
sl@0	7669	*
sl@0	7670	*----------------------------------------------------------------------
sl@0	7671	*/
sl@0	7672
sl@0	7673	int
sl@0	7674	TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
sl@0	7675	Tcl_Interp interp; / Current interpreter. */
sl@0	7676	Tcl_Channel inChan; /* Channel to read from. */
sl@0	7677	Tcl_Channel outChan; /* Channel to write to. */
sl@0	7678	int toRead; /* Amount of data to copy, or -1 for all. */
sl@0	7679	Tcl_Obj cmdPtr; / Pointer to script to execute or NULL. */
sl@0	7680	{
sl@0	7681	Channel inPtr = (Channel ) inChan;
sl@0	7682	Channel outPtr = (Channel ) outChan;
sl@0	7683	ChannelState inStatePtr, outStatePtr;
sl@0	7684	int readFlags, writeFlags;
sl@0	7685	CopyState *csPtr;
sl@0	7686	int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
sl@0	7687
sl@0	7688	inStatePtr = inPtr->state;
sl@0	7689	outStatePtr = outPtr->state;
sl@0	7690
sl@0	7691	if (inStatePtr->csPtr) {
sl@0	7692	if (interp) {
sl@0	7693	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
sl@0	7694	Tcl_GetChannelName(inChan), "\" is busy", NULL);
sl@0	7695	}
sl@0	7696	return TCL_ERROR;
sl@0	7697	}
sl@0	7698	if (outStatePtr->csPtr) {
sl@0	7699	if (interp) {
sl@0	7700	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
sl@0	7701	Tcl_GetChannelName(outChan), "\" is busy", NULL);
sl@0	7702	}
sl@0	7703	return TCL_ERROR;
sl@0	7704	}
sl@0	7705
sl@0	7706	readFlags = inStatePtr->flags;
sl@0	7707	writeFlags = outStatePtr->flags;
sl@0	7708
sl@0	7709	/*
sl@0	7710	* Set up the blocking mode appropriately. Background copies need
sl@0	7711	* non-blocking channels. Foreground copies need blocking channels.
sl@0	7712	* If there is an error, restore the old blocking mode.
sl@0	7713	*/
sl@0	7714
sl@0	7715	if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
sl@0	7716	if (SetBlockMode(interp, inPtr,
sl@0	7717	nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
sl@0	7718	!= TCL_OK) {
sl@0	7719	return TCL_ERROR;
sl@0	7720	}
sl@0	7721	}
sl@0	7722	if (inPtr != outPtr) {
sl@0	7723	if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
sl@0	7724	if (SetBlockMode(NULL, outPtr,
sl@0	7725	nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
sl@0	7726	!= TCL_OK) {
sl@0	7727	if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
sl@0	7728	SetBlockMode(NULL, inPtr,
sl@0	7729	(readFlags & CHANNEL_NONBLOCKING)
sl@0	7730	? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
sl@0	7731	return TCL_ERROR;
sl@0	7732	}
sl@0	7733	}
sl@0	7734	}
sl@0	7735	}
sl@0	7736
sl@0	7737	/*
sl@0	7738	* Make sure the output side is unbuffered.
sl@0	7739	*/
sl@0	7740
sl@0	7741	outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
sl@0	7742	\| CHANNEL_UNBUFFERED;
sl@0	7743
sl@0	7744	/*
sl@0	7745	* Allocate a new CopyState to maintain info about the current copy in
sl@0	7746	* progress. This structure will be deallocated when the copy is
sl@0	7747	* completed.
sl@0	7748	*/
sl@0	7749
sl@0	7750	csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
sl@0	7751	csPtr->bufSize = inStatePtr->bufSize;
sl@0	7752	csPtr->readPtr = inPtr;
sl@0	7753	csPtr->writePtr = outPtr;
sl@0	7754	csPtr->readFlags = readFlags;
sl@0	7755	csPtr->writeFlags = writeFlags;
sl@0	7756	csPtr->toRead = toRead;
sl@0	7757	csPtr->total = 0;
sl@0	7758	csPtr->interp = interp;
sl@0	7759	if (cmdPtr) {
sl@0	7760	Tcl_IncrRefCount(cmdPtr);
sl@0	7761	}
sl@0	7762	csPtr->cmdPtr = cmdPtr;
sl@0	7763	inStatePtr->csPtr = csPtr;
sl@0	7764	outStatePtr->csPtr = csPtr;
sl@0	7765
sl@0	7766	/*
sl@0	7767	* Start copying data between the channels.
sl@0	7768	*/
sl@0	7769
sl@0	7770	return CopyData(csPtr, 0);
sl@0	7771	}
sl@0	7772
sl@0	7773	/*
sl@0	7774	*----------------------------------------------------------------------
sl@0	7775	*
sl@0	7776	* CopyData --
sl@0	7777	*
sl@0	7778	* This function implements the lowest level of the copying
sl@0	7779	* mechanism for TclCopyChannel.
sl@0	7780	*
sl@0	7781	* Results:
sl@0	7782	* Returns TCL_OK on success, else TCL_ERROR.
sl@0	7783	*
sl@0	7784	* Side effects:
sl@0	7785	* Moves data between channels, may create channel handlers.
sl@0	7786	*
sl@0	7787	*----------------------------------------------------------------------
sl@0	7788	*/
sl@0	7789
sl@0	7790	static int
sl@0	7791	CopyData(csPtr, mask)
sl@0	7792	CopyState csPtr; / State of copy operation. */
sl@0	7793	int mask; /* Current channel event flags. */
sl@0	7794	{
sl@0	7795	Tcl_Interp *interp;
sl@0	7796	Tcl_Obj cmdPtr, errObj = NULL, *bufObj = NULL;
sl@0	7797	Tcl_Channel inChan, outChan;
sl@0	7798	ChannelState inStatePtr, outStatePtr;
sl@0	7799	int result = TCL_OK, size, total, sizeb;
sl@0	7800	char* buffer;
sl@0	7801
sl@0	7802	int inBinary, outBinary, sameEncoding; /* Encoding control */
sl@0	7803	int underflow; /* input underflow */
sl@0	7804
sl@0	7805	inChan = (Tcl_Channel) csPtr->readPtr;
sl@0	7806	outChan = (Tcl_Channel) csPtr->writePtr;
sl@0	7807	inStatePtr = csPtr->readPtr->state;
sl@0	7808	outStatePtr = csPtr->writePtr->state;
sl@0	7809	interp = csPtr->interp;
sl@0	7810	cmdPtr = csPtr->cmdPtr;
sl@0	7811
sl@0	7812	/*
sl@0	7813	* Copy the data the slow way, using the translation mechanism.
sl@0	7814	*
sl@0	7815	* Note: We have make sure that we use the topmost channel in a stack
sl@0	7816	* for the copying. The caller uses Tcl_GetChannel to access it, and
sl@0	7817	* thus gets the bottom of the stack.
sl@0	7818	*/
sl@0	7819
sl@0	7820	inBinary = (inStatePtr->encoding == NULL);
sl@0	7821	outBinary = (outStatePtr->encoding == NULL);
sl@0	7822	sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);
sl@0	7823
sl@0	7824	if (!(inBinary \|\| sameEncoding)) {
sl@0	7825	bufObj = Tcl_NewObj ();
sl@0	7826	Tcl_IncrRefCount (bufObj);
sl@0	7827	}
sl@0	7828
sl@0	7829	while (csPtr->toRead != 0) {
sl@0	7830	/*
sl@0	7831	* Check for unreported background errors.
sl@0	7832	*/
sl@0	7833
sl@0	7834	if (inStatePtr->unreportedError != 0) {
sl@0	7835	Tcl_SetErrno(inStatePtr->unreportedError);
sl@0	7836	inStatePtr->unreportedError = 0;
sl@0	7837	goto readError;
sl@0	7838	}
sl@0	7839	if (outStatePtr->unreportedError != 0) {
sl@0	7840	Tcl_SetErrno(outStatePtr->unreportedError);
sl@0	7841	outStatePtr->unreportedError = 0;
sl@0	7842	goto writeError;
sl@0	7843	}
sl@0	7844
sl@0	7845	/*
sl@0	7846	* Read up to bufSize bytes.
sl@0	7847	*/
sl@0	7848
sl@0	7849	if ((csPtr->toRead == -1) \|\| (csPtr->toRead > csPtr->bufSize)) {
sl@0	7850	sizeb = csPtr->bufSize;
sl@0	7851	} else {
sl@0	7852	sizeb = csPtr->toRead;
sl@0	7853	}
sl@0	7854
sl@0	7855	if (inBinary \|\| sameEncoding) {
sl@0	7856	size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
sl@0	7857	} else {
sl@0	7858	size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
sl@0	7859	}
sl@0	7860	underflow = (size >= 0) && (size < sizeb); /* input underflow */
sl@0	7861
sl@0	7862	if (size < 0) {
sl@0	7863	readError:
sl@0	7864	errObj = Tcl_NewObj();
sl@0	7865	Tcl_AppendStringsToObj(errObj, "error reading \"",
sl@0	7866	Tcl_GetChannelName(inChan), "\": ",
sl@0	7867	Tcl_PosixError(interp), (char *) NULL);
sl@0	7868	break;
sl@0	7869	} else if (underflow) {
sl@0	7870	/*
sl@0	7871	* We had an underflow on the read side. If we are at EOF,
sl@0	7872	* then the copying is done, otherwise set up a channel
sl@0	7873	* handler to detect when the channel becomes readable again.
sl@0	7874	*/
sl@0	7875
sl@0	7876	if ((size == 0) && Tcl_Eof(inChan)) {
sl@0	7877	break;
sl@0	7878	}
sl@0	7879	if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
sl@0	7880	if (mask & TCL_WRITABLE) {
sl@0	7881	Tcl_DeleteChannelHandler(outChan, CopyEventProc,
sl@0	7882	(ClientData) csPtr);
sl@0	7883	}
sl@0	7884	Tcl_CreateChannelHandler(inChan, TCL_READABLE,
sl@0	7885	CopyEventProc, (ClientData) csPtr);
sl@0	7886	}
sl@0	7887	if (size == 0) {
sl@0	7888	if (bufObj != (Tcl_Obj*) NULL) {
sl@0	7889	Tcl_DecrRefCount (bufObj);
sl@0	7890	bufObj = (Tcl_Obj*) NULL;
sl@0	7891	}
sl@0	7892	return TCL_OK;
sl@0	7893	}
sl@0	7894	}
sl@0	7895
sl@0	7896	/*
sl@0	7897	* Now write the buffer out.
sl@0	7898	*/
sl@0	7899
sl@0	7900	if (inBinary \|\| sameEncoding) {
sl@0	7901	buffer = csPtr->buffer;
sl@0	7902	sizeb = size;
sl@0	7903	} else {
sl@0	7904	buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
sl@0	7905	}
sl@0	7906
sl@0	7907	if (outBinary \|\| sameEncoding) {
sl@0	7908	sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
sl@0	7909	} else {
sl@0	7910	sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
sl@0	7911	}
sl@0	7912
sl@0	7913	if (inBinary \|\| sameEncoding) {
sl@0	7914	/* Both read and write counted bytes */
sl@0	7915	size = sizeb;
sl@0	7916	} /* else : Read counted characters, write counted bytes, i.e. size != sizeb */
sl@0	7917
sl@0	7918	if (sizeb < 0) {
sl@0	7919	writeError:
sl@0	7920	errObj = Tcl_NewObj();
sl@0	7921	Tcl_AppendStringsToObj(errObj, "error writing \"",
sl@0	7922	Tcl_GetChannelName(outChan), "\": ",
sl@0	7923	Tcl_PosixError(interp), (char *) NULL);
sl@0	7924	break;
sl@0	7925	}
sl@0	7926
sl@0	7927	/*
sl@0	7928	* Update the current byte count. Do it now so the count is
sl@0	7929	* valid before a return or break takes us out of the loop.
sl@0	7930	* The invariant at the top of the loop should be that
sl@0	7931	* csPtr->toRead holds the number of bytes left to copy.
sl@0	7932	*/
sl@0	7933
sl@0	7934	if (csPtr->toRead != -1) {
sl@0	7935	csPtr->toRead -= size;
sl@0	7936	}
sl@0	7937	csPtr->total += size;
sl@0	7938
sl@0	7939	/*
sl@0	7940	* Break loop if EOF && (size>0)
sl@0	7941	*/
sl@0	7942
sl@0	7943	if (Tcl_Eof(inChan)) {
sl@0	7944	break;
sl@0	7945	}
sl@0	7946
sl@0	7947	/*
sl@0	7948	* Check to see if the write is happening in the background. If so,
sl@0	7949	* stop copying and wait for the channel to become writable again.
sl@0	7950	* After input underflow we already installed a readable handler
sl@0	7951	* therefore we don't need a writable handler.
sl@0	7952	*/
sl@0	7953
sl@0	7954	if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
sl@0	7955	if (!(mask & TCL_WRITABLE)) {
sl@0	7956	if (mask & TCL_READABLE) {
sl@0	7957	Tcl_DeleteChannelHandler(inChan, CopyEventProc,
sl@0	7958	(ClientData) csPtr);
sl@0	7959	}
sl@0	7960	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
sl@0	7961	CopyEventProc, (ClientData) csPtr);
sl@0	7962	}
sl@0	7963	if (bufObj != (Tcl_Obj*) NULL) {
sl@0	7964	Tcl_DecrRefCount (bufObj);
sl@0	7965	bufObj = (Tcl_Obj*) NULL;
sl@0	7966	}
sl@0	7967	return TCL_OK;
sl@0	7968	}
sl@0	7969
sl@0	7970	/*
sl@0	7971	* For background copies, we only do one buffer per invocation so
sl@0	7972	* we don't starve the rest of the system.
sl@0	7973	*/
sl@0	7974
sl@0	7975	if (cmdPtr) {
sl@0	7976	/*
sl@0	7977	* The first time we enter this code, there won't be a
sl@0	7978	* channel handler established yet, so do it here.
sl@0	7979	*/
sl@0	7980
sl@0	7981	if (mask == 0) {
sl@0	7982	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
sl@0	7983	CopyEventProc, (ClientData) csPtr);
sl@0	7984	}
sl@0	7985	if (bufObj != (Tcl_Obj*) NULL) {
sl@0	7986	Tcl_DecrRefCount (bufObj);
sl@0	7987	bufObj = (Tcl_Obj*) NULL;
sl@0	7988	}
sl@0	7989	return TCL_OK;
sl@0	7990	}
sl@0	7991	} /* while */
sl@0	7992
sl@0	7993	if (bufObj != (Tcl_Obj*) NULL) {
sl@0	7994	Tcl_DecrRefCount (bufObj);
sl@0	7995	bufObj = (Tcl_Obj*) NULL;
sl@0	7996	}
sl@0	7997
sl@0	7998	/*
sl@0	7999	* Make the callback or return the number of bytes transferred.
sl@0	8000	* The local total is used because StopCopy frees csPtr.
sl@0	8001	*/
sl@0	8002
sl@0	8003	total = csPtr->total;
sl@0	8004	if (cmdPtr && interp) {
sl@0	8005	/*
sl@0	8006	* Get a private copy of the command so we can mutate it
sl@0	8007	* by adding arguments. Note that StopCopy frees our saved
sl@0	8008	* reference to the original command obj.
sl@0	8009	*/
sl@0	8010
sl@0	8011	cmdPtr = Tcl_DuplicateObj(cmdPtr);
sl@0	8012	Tcl_IncrRefCount(cmdPtr);
sl@0	8013	StopCopy(csPtr);
sl@0	8014	Tcl_Preserve((ClientData) interp);
sl@0	8015
sl@0	8016	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
sl@0	8017	if (errObj) {
sl@0	8018	Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
sl@0	8019	}
sl@0	8020	if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
sl@0	8021	Tcl_BackgroundError(interp);
sl@0	8022	result = TCL_ERROR;
sl@0	8023	}
sl@0	8024	Tcl_DecrRefCount(cmdPtr);
sl@0	8025	Tcl_Release((ClientData) interp);
sl@0	8026	} else {
sl@0	8027	StopCopy(csPtr);
sl@0	8028	if (interp) {
sl@0	8029	if (errObj) {
sl@0	8030	Tcl_SetObjResult(interp, errObj);
sl@0	8031	result = TCL_ERROR;
sl@0	8032	} else {
sl@0	8033	Tcl_ResetResult(interp);
sl@0	8034	Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
sl@0	8035	}
sl@0	8036	}
sl@0	8037	}
sl@0	8038	return result;
sl@0	8039	}
sl@0	8040
sl@0	8041	/*
sl@0	8042	*----------------------------------------------------------------------
sl@0	8043	*
sl@0	8044	* DoRead --
sl@0	8045	*
sl@0	8046	* Reads a given number of bytes from a channel.
sl@0	8047	*
sl@0	8048	* No encoding conversions are applied to the bytes being read.
sl@0	8049	*
sl@0	8050	* Results:
sl@0	8051	* The number of characters read, or -1 on error. Use Tcl_GetErrno()
sl@0	8052	* to retrieve the error code for the error that occurred.
sl@0	8053	*
sl@0	8054	* Side effects:
sl@0	8055	* May cause input to be buffered.
sl@0	8056	*
sl@0	8057	*----------------------------------------------------------------------
sl@0	8058	*/
sl@0	8059
sl@0	8060	static int
sl@0	8061	DoRead(chanPtr, bufPtr, toRead)
sl@0	8062	Channel chanPtr; / The channel from which to read. */
sl@0	8063	char bufPtr; / Where to store input read. */
sl@0	8064	int toRead; /* Maximum number of bytes to read. */
sl@0	8065	{
sl@0	8066	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	8067	int copied; /* How many characters were copied into
sl@0	8068	* the result string? */
sl@0	8069	int copiedNow; /* How many characters were copied from
sl@0	8070	* the current input buffer? */
sl@0	8071	int result; /* Of calling GetInput. */
sl@0	8072
sl@0	8073	/*
sl@0	8074	* If we have not encountered a sticky EOF, clear the EOF bit. Either
sl@0	8075	* way clear the BLOCKED bit. We want to discover these anew during
sl@0	8076	* each operation.
sl@0	8077	*/
sl@0	8078
sl@0	8079	if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
sl@0	8080	statePtr->flags &= ~CHANNEL_EOF;
sl@0	8081	}
sl@0	8082	statePtr->flags &= ~(CHANNEL_BLOCKED \| CHANNEL_NEED_MORE_DATA);
sl@0	8083
sl@0	8084	for (copied = 0; copied < toRead; copied += copiedNow) {
sl@0	8085	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
sl@0	8086	toRead - copied);
sl@0	8087	if (copiedNow == 0) {
sl@0	8088	if (statePtr->flags & CHANNEL_EOF) {
sl@0	8089	goto done;
sl@0	8090	}
sl@0	8091	if (statePtr->flags & CHANNEL_BLOCKED) {
sl@0	8092	if (statePtr->flags & CHANNEL_NONBLOCKING) {
sl@0	8093	goto done;
sl@0	8094	}
sl@0	8095	statePtr->flags &= (~(CHANNEL_BLOCKED));
sl@0	8096	}
sl@0	8097	result = GetInput(chanPtr);
sl@0	8098	if (result != 0) {
sl@0	8099	if (result != EAGAIN) {
sl@0	8100	copied = -1;
sl@0	8101	}
sl@0	8102	goto done;
sl@0	8103	}
sl@0	8104	}
sl@0	8105	}
sl@0	8106
sl@0	8107	statePtr->flags &= (~(CHANNEL_BLOCKED));
sl@0	8108
sl@0	8109	done:
sl@0	8110	/*
sl@0	8111	* Update the notifier state so we don't block while there is still
sl@0	8112	* data in the buffers.
sl@0	8113	*/
sl@0	8114
sl@0	8115	UpdateInterest(chanPtr);
sl@0	8116	return copied;
sl@0	8117	}
sl@0	8118
sl@0	8119	/*
sl@0	8120	*----------------------------------------------------------------------
sl@0	8121	*
sl@0	8122	* CopyAndTranslateBuffer --
sl@0	8123	*
sl@0	8124	* Copy at most one buffer of input to the result space, doing
sl@0	8125	* eol translations according to mode in effect currently.
sl@0	8126	*
sl@0	8127	* Results:
sl@0	8128	* Number of bytes stored in the result buffer (as opposed to the
sl@0	8129	* number of bytes read from the channel). May return
sl@0	8130	* zero if no input is available to be translated.
sl@0	8131	*
sl@0	8132	* Side effects:
sl@0	8133	* Consumes buffered input. May deallocate one buffer.
sl@0	8134	*
sl@0	8135	*----------------------------------------------------------------------
sl@0	8136	*/
sl@0	8137
sl@0	8138	static int
sl@0	8139	CopyAndTranslateBuffer(statePtr, result, space)
sl@0	8140	ChannelState statePtr; / Channel state from which to read input. */
sl@0	8141	char result; / Where to store the copied input. */
sl@0	8142	int space; /* How many bytes are available in result
sl@0	8143	* to store the copied input? */
sl@0	8144	{
sl@0	8145	ChannelBuffer bufPtr; / The buffer from which to copy bytes. */
sl@0	8146	int bytesInBuffer; /* How many bytes are available to be
sl@0	8147	* copied in the current input buffer? */
sl@0	8148	int copied; /* How many characters were already copied
sl@0	8149	* into the destination space? */
sl@0	8150	int i; /* Iterates over the copied input looking
sl@0	8151	* for the input eofChar. */
sl@0	8152
sl@0	8153	/*
sl@0	8154	* If there is no input at all, return zero. The invariant is that either
sl@0	8155	* there is no buffer in the queue, or if the first buffer is empty, it
sl@0	8156	* is also the last buffer (and thus there is no input in the queue).
sl@0	8157	* Note also that if the buffer is empty, we leave it in the queue.
sl@0	8158	*/
sl@0	8159
sl@0	8160	if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	8161	return 0;
sl@0	8162	}
sl@0	8163	bufPtr = statePtr->inQueueHead;
sl@0	8164	bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
sl@0	8165
sl@0	8166	copied = 0;
sl@0	8167	switch (statePtr->inputTranslation) {
sl@0	8168	case TCL_TRANSLATE_LF: {
sl@0	8169	if (bytesInBuffer == 0) {
sl@0	8170	return 0;
sl@0	8171	}
sl@0	8172
sl@0	8173	/*
sl@0	8174	* Copy the current chunk into the result buffer.
sl@0	8175	*/
sl@0	8176
sl@0	8177	if (bytesInBuffer < space) {
sl@0	8178	space = bytesInBuffer;
sl@0	8179	}
sl@0	8180	memcpy((VOID *) result,
sl@0	8181	(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
sl@0	8182	(size_t) space);
sl@0	8183	bufPtr->nextRemoved += space;
sl@0	8184	copied = space;
sl@0	8185	break;
sl@0	8186	}
sl@0	8187	case TCL_TRANSLATE_CR: {
sl@0	8188	char *end;
sl@0	8189
sl@0	8190	if (bytesInBuffer == 0) {
sl@0	8191	return 0;
sl@0	8192	}
sl@0	8193
sl@0	8194	/*
sl@0	8195	* Copy the current chunk into the result buffer, then
sl@0	8196	* replace all \r with \n.
sl@0	8197	*/
sl@0	8198
sl@0	8199	if (bytesInBuffer < space) {
sl@0	8200	space = bytesInBuffer;
sl@0	8201	}
sl@0	8202	memcpy((VOID *) result,
sl@0	8203	(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
sl@0	8204	(size_t) space);
sl@0	8205	bufPtr->nextRemoved += space;
sl@0	8206	copied = space;
sl@0	8207
sl@0	8208	for (end = result + copied; result < end; result++) {
sl@0	8209	if (*result == '\r') {
sl@0	8210	*result = '\n';
sl@0	8211	}
sl@0	8212	}
sl@0	8213	break;
sl@0	8214	}
sl@0	8215	case TCL_TRANSLATE_CRLF: {
sl@0	8216	char src, end, *dst;
sl@0	8217	int curByte;
sl@0	8218
sl@0	8219	/*
sl@0	8220	* If there is a held-back "\r" at EOF, produce it now.
sl@0	8221	*/
sl@0	8222
sl@0	8223	if (bytesInBuffer == 0) {
sl@0	8224	if ((statePtr->flags & (INPUT_SAW_CR \| CHANNEL_EOF)) ==
sl@0	8225	(INPUT_SAW_CR \| CHANNEL_EOF)) {
sl@0	8226	result[0] = '\r';
sl@0	8227	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	8228	return 1;
sl@0	8229	}
sl@0	8230	return 0;
sl@0	8231	}
sl@0	8232
sl@0	8233	/*
sl@0	8234	* Copy the current chunk and replace "\r\n" with "\n"
sl@0	8235	* (but not standalone "\r"!).
sl@0	8236	*/
sl@0	8237
sl@0	8238	if (bytesInBuffer < space) {
sl@0	8239	space = bytesInBuffer;
sl@0	8240	}
sl@0	8241	memcpy((VOID *) result,
sl@0	8242	(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
sl@0	8243	(size_t) space);
sl@0	8244	bufPtr->nextRemoved += space;
sl@0	8245	copied = space;
sl@0	8246
sl@0	8247	end = result + copied;
sl@0	8248	dst = result;
sl@0	8249	for (src = result; src < end; src++) {
sl@0	8250	curByte = *src;
sl@0	8251	if (curByte == '\n') {
sl@0	8252	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	8253	} else if (statePtr->flags & INPUT_SAW_CR) {
sl@0	8254	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	8255	*dst = '\r';
sl@0	8256	dst++;
sl@0	8257	}
sl@0	8258	if (curByte == '\r') {
sl@0	8259	statePtr->flags \|= INPUT_SAW_CR;
sl@0	8260	} else {
sl@0	8261	*dst = (char) curByte;
sl@0	8262	dst++;
sl@0	8263	}
sl@0	8264	}
sl@0	8265	copied = dst - result;
sl@0	8266	break;
sl@0	8267	}
sl@0	8268	case TCL_TRANSLATE_AUTO: {
sl@0	8269	char src, end, *dst;
sl@0	8270	int curByte;
sl@0	8271
sl@0	8272	if (bytesInBuffer == 0) {
sl@0	8273	return 0;
sl@0	8274	}
sl@0	8275
sl@0	8276	/*
sl@0	8277	* Loop over the current buffer, converting "\r" and "\r\n"
sl@0	8278	* to "\n".
sl@0	8279	*/
sl@0	8280
sl@0	8281	if (bytesInBuffer < space) {
sl@0	8282	space = bytesInBuffer;
sl@0	8283	}
sl@0	8284	memcpy((VOID *) result,
sl@0	8285	(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
sl@0	8286	(size_t) space);
sl@0	8287	bufPtr->nextRemoved += space;
sl@0	8288	copied = space;
sl@0	8289
sl@0	8290	end = result + copied;
sl@0	8291	dst = result;
sl@0	8292	for (src = result; src < end; src++) {
sl@0	8293	curByte = *src;
sl@0	8294	if (curByte == '\r') {
sl@0	8295	statePtr->flags \|= INPUT_SAW_CR;
sl@0	8296	*dst = '\n';
sl@0	8297	dst++;
sl@0	8298	} else {
sl@0	8299	if ((curByte != '\n') \|\|
sl@0	8300	!(statePtr->flags & INPUT_SAW_CR)) {
sl@0	8301	*dst = (char) curByte;
sl@0	8302	dst++;
sl@0	8303	}
sl@0	8304	statePtr->flags &= ~INPUT_SAW_CR;
sl@0	8305	}
sl@0	8306	}
sl@0	8307	copied = dst - result;
sl@0	8308	break;
sl@0	8309	}
sl@0	8310	default: {
sl@0	8311	panic("unknown eol translation mode");
sl@0	8312	}
sl@0	8313	}
sl@0	8314
sl@0	8315	/*
sl@0	8316	* If an in-stream EOF character is set for this channel, check that
sl@0	8317	* the input we copied so far does not contain the EOF char. If it does,
sl@0	8318	* copy only up to and excluding that character.
sl@0	8319	*/
sl@0	8320
sl@0	8321	if (statePtr->inEofChar != 0) {
sl@0	8322	for (i = 0; i < copied; i++) {
sl@0	8323	if (result[i] == (char) statePtr->inEofChar) {
sl@0	8324	/*
sl@0	8325	* Set sticky EOF so that no further input is presented
sl@0	8326	* to the caller.
sl@0	8327	*/
sl@0	8328
sl@0	8329	statePtr->flags \|= (CHANNEL_EOF \| CHANNEL_STICKY_EOF);
sl@0	8330	statePtr->inputEncodingFlags \|= TCL_ENCODING_END;
sl@0	8331	copied = i;
sl@0	8332	break;
sl@0	8333	}
sl@0	8334	}
sl@0	8335	}
sl@0	8336
sl@0	8337	/*
sl@0	8338	* If the current buffer is empty recycle it.
sl@0	8339	*/
sl@0	8340
sl@0	8341	if (bufPtr->nextRemoved == bufPtr->nextAdded) {
sl@0	8342	statePtr->inQueueHead = bufPtr->nextPtr;
sl@0	8343	if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	8344	statePtr->inQueueTail = (ChannelBuffer *) NULL;
sl@0	8345	}
sl@0	8346	RecycleBuffer(statePtr, bufPtr, 0);
sl@0	8347	}
sl@0	8348
sl@0	8349	/*
sl@0	8350	* Return the number of characters copied into the result buffer.
sl@0	8351	* This may be different from the number of bytes consumed, because
sl@0	8352	* of EOL translations.
sl@0	8353	*/
sl@0	8354
sl@0	8355	return copied;
sl@0	8356	}
sl@0	8357
sl@0	8358	/*
sl@0	8359	*----------------------------------------------------------------------
sl@0	8360	*
sl@0	8361	* CopyBuffer --
sl@0	8362	*
sl@0	8363	* Copy at most one buffer of input to the result space.
sl@0	8364	*
sl@0	8365	* Results:
sl@0	8366	* Number of bytes stored in the result buffer. May return
sl@0	8367	* zero if no input is available.
sl@0	8368	*
sl@0	8369	* Side effects:
sl@0	8370	* Consumes buffered input. May deallocate one buffer.
sl@0	8371	*
sl@0	8372	*----------------------------------------------------------------------
sl@0	8373	*/
sl@0	8374
sl@0	8375	static int
sl@0	8376	CopyBuffer(chanPtr, result, space)
sl@0	8377	Channel chanPtr; / Channel from which to read input. */
sl@0	8378	char result; / Where to store the copied input. */
sl@0	8379	int space; /* How many bytes are available in result
sl@0	8380	* to store the copied input? */
sl@0	8381	{
sl@0	8382	ChannelBuffer bufPtr; / The buffer from which to copy bytes. */
sl@0	8383	int bytesInBuffer; /* How many bytes are available to be
sl@0	8384	* copied in the current input buffer? */
sl@0	8385	int copied; /* How many characters were already copied
sl@0	8386	* into the destination space? */
sl@0	8387
sl@0	8388	/*
sl@0	8389	* If there is no input at all, return zero. The invariant is that
sl@0	8390	* either there is no buffer in the queue, or if the first buffer
sl@0	8391	* is empty, it is also the last buffer (and thus there is no
sl@0	8392	* input in the queue). Note also that if the buffer is empty, we
sl@0	8393	* don't leave it in the queue, but recycle it.
sl@0	8394	*/
sl@0	8395
sl@0	8396	if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	8397	return 0;
sl@0	8398	}
sl@0	8399	bufPtr = chanPtr->inQueueHead;
sl@0	8400	bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
sl@0	8401
sl@0	8402	copied = 0;
sl@0	8403
sl@0	8404	if (bytesInBuffer == 0) {
sl@0	8405	RecycleBuffer(chanPtr->state, bufPtr, 0);
sl@0	8406	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
sl@0	8407	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
sl@0	8408	return 0;
sl@0	8409	}
sl@0	8410
sl@0	8411	/*
sl@0	8412	* Copy the current chunk into the result buffer.
sl@0	8413	*/
sl@0	8414
sl@0	8415	if (bytesInBuffer < space) {
sl@0	8416	space = bytesInBuffer;
sl@0	8417	}
sl@0	8418
sl@0	8419	memcpy((VOID *) result,
sl@0	8420	(VOID *) (bufPtr->buf + bufPtr->nextRemoved),
sl@0	8421	(size_t) space);
sl@0	8422	bufPtr->nextRemoved += space;
sl@0	8423	copied = space;
sl@0	8424
sl@0	8425	/*
sl@0	8426	* We don't care about in-stream EOF characters here as the data
sl@0	8427	* read here may still flow through one or more transformations,
sl@0	8428	* i.e. is not in its final state yet.
sl@0	8429	*/
sl@0	8430
sl@0	8431	/*
sl@0	8432	* If the current buffer is empty recycle it.
sl@0	8433	*/
sl@0	8434
sl@0	8435	if (bufPtr->nextRemoved == bufPtr->nextAdded) {
sl@0	8436	chanPtr->inQueueHead = bufPtr->nextPtr;
sl@0	8437	if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
sl@0	8438	chanPtr->inQueueTail = (ChannelBuffer *) NULL;
sl@0	8439	}
sl@0	8440	RecycleBuffer(chanPtr->state, bufPtr, 0);
sl@0	8441	}
sl@0	8442
sl@0	8443	/*
sl@0	8444	* Return the number of characters copied into the result buffer.
sl@0	8445	*/
sl@0	8446
sl@0	8447	return copied;
sl@0	8448	}
sl@0	8449
sl@0	8450	/*
sl@0	8451	*----------------------------------------------------------------------
sl@0	8452	*
sl@0	8453	* DoWrite --
sl@0	8454	*
sl@0	8455	* Puts a sequence of characters into an output buffer, may queue the
sl@0	8456	* buffer for output if it gets full, and also remembers whether the
sl@0	8457	* current buffer is ready e.g. if it contains a newline and we are in
sl@0	8458	* line buffering mode.
sl@0	8459	*
sl@0	8460	* Results:
sl@0	8461	* The number of bytes written or -1 in case of error. If -1,
sl@0	8462	* Tcl_GetErrno will return the error code.
sl@0	8463	*
sl@0	8464	* Side effects:
sl@0	8465	* May buffer up output and may cause output to be produced on the
sl@0	8466	* channel.
sl@0	8467	*
sl@0	8468	*----------------------------------------------------------------------
sl@0	8469	*/
sl@0	8470
sl@0	8471	static int
sl@0	8472	DoWrite(chanPtr, src, srcLen)
sl@0	8473	Channel chanPtr; / The channel to buffer output for. */
sl@0	8474	CONST char src; / Data to write. */
sl@0	8475	int srcLen; /* Number of bytes to write. */
sl@0	8476	{
sl@0	8477	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	8478	ChannelBuffer outBufPtr; / Current output buffer. */
sl@0	8479	int foundNewline; /* Did we find a newline in output? */
sl@0	8480	char *dPtr;
sl@0	8481	CONST char sPtr; / Search variables for newline. */
sl@0	8482	int crsent; /* In CRLF eol translation mode,
sl@0	8483	* remember the fact that a CR was
sl@0	8484	* output to the channel without
sl@0	8485	* its following NL. */
sl@0	8486	int i; /* Loop index for newline search. */
sl@0	8487	int destCopied; /* How many bytes were used in this
sl@0	8488	* destination buffer to hold the
sl@0	8489	* output? */
sl@0	8490	int totalDestCopied; /* How many bytes total were
sl@0	8491	* copied to the channel buffer? */
sl@0	8492	int srcCopied; /* How many bytes were copied from
sl@0	8493	* the source string? */
sl@0	8494	char destPtr; / Where in line to copy to? */
sl@0	8495
sl@0	8496	/*
sl@0	8497	* If we are in network (or windows) translation mode, record the fact
sl@0	8498	* that we have not yet sent a CR to the channel.
sl@0	8499	*/
sl@0	8500
sl@0	8501	crsent = 0;
sl@0	8502
sl@0	8503	/*
sl@0	8504	* Loop filling buffers and flushing them until all output has been
sl@0	8505	* consumed.
sl@0	8506	*/
sl@0	8507
sl@0	8508	srcCopied = 0;
sl@0	8509	totalDestCopied = 0;
sl@0	8510
sl@0	8511	while (srcLen > 0) {
sl@0	8512
sl@0	8513	/*
sl@0	8514	* Make sure there is a current output buffer to accept output.
sl@0	8515	*/
sl@0	8516
sl@0	8517	if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
sl@0	8518	statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
sl@0	8519	}
sl@0	8520
sl@0	8521	outBufPtr = statePtr->curOutPtr;
sl@0	8522
sl@0	8523	destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
sl@0	8524	if (destCopied > srcLen) {
sl@0	8525	destCopied = srcLen;
sl@0	8526	}
sl@0	8527
sl@0	8528	destPtr = outBufPtr->buf + outBufPtr->nextAdded;
sl@0	8529	switch (statePtr->outputTranslation) {
sl@0	8530	case TCL_TRANSLATE_LF:
sl@0	8531	srcCopied = destCopied;
sl@0	8532	memcpy((VOID ) destPtr, (VOID ) src, (size_t) destCopied);
sl@0	8533	break;
sl@0	8534	case TCL_TRANSLATE_CR:
sl@0	8535	srcCopied = destCopied;
sl@0	8536	memcpy((VOID ) destPtr, (VOID ) src, (size_t) destCopied);
sl@0	8537	for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
sl@0	8538	if (*dPtr == '\n') {
sl@0	8539	*dPtr = '\r';
sl@0	8540	}
sl@0	8541	}
sl@0	8542	break;
sl@0	8543	case TCL_TRANSLATE_CRLF:
sl@0	8544	for (srcCopied = 0, dPtr = destPtr, sPtr = src;
sl@0	8545	dPtr < destPtr + destCopied;
sl@0	8546	dPtr++, sPtr++, srcCopied++) {
sl@0	8547	if (*sPtr == '\n') {
sl@0	8548	if (crsent) {
sl@0	8549	*dPtr = '\n';
sl@0	8550	crsent = 0;
sl@0	8551	} else {
sl@0	8552	*dPtr = '\r';
sl@0	8553	crsent = 1;
sl@0	8554	sPtr--, srcCopied--;
sl@0	8555	}
sl@0	8556	} else {
sl@0	8557	dPtr = sPtr;
sl@0	8558	}
sl@0	8559	}
sl@0	8560	break;
sl@0	8561	case TCL_TRANSLATE_AUTO:
sl@0	8562	panic("Tcl_Write: AUTO output translation mode not supported");
sl@0	8563	default:
sl@0	8564	panic("Tcl_Write: unknown output translation mode");
sl@0	8565	}
sl@0	8566
sl@0	8567	/*
sl@0	8568	* The current buffer is ready for output if it is full, or if it
sl@0	8569	* contains a newline and this channel is line-buffered, or if it
sl@0	8570	* contains any output and this channel is unbuffered.
sl@0	8571	*/
sl@0	8572
sl@0	8573	outBufPtr->nextAdded += destCopied;
sl@0	8574	if (!(statePtr->flags & BUFFER_READY)) {
sl@0	8575	if (outBufPtr->nextAdded == outBufPtr->bufLength) {
sl@0	8576	statePtr->flags \|= BUFFER_READY;
sl@0	8577	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
sl@0	8578	for (sPtr = src, i = 0, foundNewline = 0;
sl@0	8579	(i < srcCopied) && (!foundNewline);
sl@0	8580	i++, sPtr++) {
sl@0	8581	if (*sPtr == '\n') {
sl@0	8582	foundNewline = 1;
sl@0	8583	break;
sl@0	8584	}
sl@0	8585	}
sl@0	8586	if (foundNewline) {
sl@0	8587	statePtr->flags \|= BUFFER_READY;
sl@0	8588	}
sl@0	8589	} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
sl@0	8590	statePtr->flags \|= BUFFER_READY;
sl@0	8591	}
sl@0	8592	}
sl@0	8593
sl@0	8594	totalDestCopied += srcCopied;
sl@0	8595	src += srcCopied;
sl@0	8596	srcLen -= srcCopied;
sl@0	8597
sl@0	8598	if (statePtr->flags & BUFFER_READY) {
sl@0	8599	if (FlushChannel(NULL, chanPtr, 0) != 0) {
sl@0	8600	return -1;
sl@0	8601	}
sl@0	8602	}
sl@0	8603	} /* Closes "while" */
sl@0	8604
sl@0	8605	return totalDestCopied;
sl@0	8606	}
sl@0	8607
sl@0	8608	/*
sl@0	8609	*----------------------------------------------------------------------
sl@0	8610	*
sl@0	8611	* CopyEventProc --
sl@0	8612	*
sl@0	8613	* This routine is invoked as a channel event handler for
sl@0	8614	* the background copy operation. It is just a trivial wrapper
sl@0	8615	* around the CopyData routine.
sl@0	8616	*
sl@0	8617	* Results:
sl@0	8618	* None.
sl@0	8619	*
sl@0	8620	* Side effects:
sl@0	8621	* None.
sl@0	8622	*
sl@0	8623	*----------------------------------------------------------------------
sl@0	8624	*/
sl@0	8625
sl@0	8626	static void
sl@0	8627	CopyEventProc(clientData, mask)
sl@0	8628	ClientData clientData;
sl@0	8629	int mask;
sl@0	8630	{
sl@0	8631	(void) CopyData((CopyState *)clientData, mask);
sl@0	8632	}
sl@0	8633
sl@0	8634	/*
sl@0	8635	*----------------------------------------------------------------------
sl@0	8636	*
sl@0	8637	* StopCopy --
sl@0	8638	*
sl@0	8639	* This routine halts a copy that is in progress.
sl@0	8640	*
sl@0	8641	* Results:
sl@0	8642	* None.
sl@0	8643	*
sl@0	8644	* Side effects:
sl@0	8645	* Removes any pending channel handlers and restores the blocking
sl@0	8646	* and buffering modes of the channels. The CopyState is freed.
sl@0	8647	*
sl@0	8648	*----------------------------------------------------------------------
sl@0	8649	*/
sl@0	8650
sl@0	8651	static void
sl@0	8652	StopCopy(csPtr)
sl@0	8653	CopyState csPtr; / State for bg copy to stop . */
sl@0	8654	{
sl@0	8655	ChannelState inStatePtr, outStatePtr;
sl@0	8656	int nonBlocking;
sl@0	8657
sl@0	8658	if (!csPtr) {
sl@0	8659	return;
sl@0	8660	}
sl@0	8661
sl@0	8662	inStatePtr = csPtr->readPtr->state;
sl@0	8663	outStatePtr = csPtr->writePtr->state;
sl@0	8664
sl@0	8665	/*
sl@0	8666	* Restore the old blocking mode and output buffering mode.
sl@0	8667	*/
sl@0	8668
sl@0	8669	nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
sl@0	8670	if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
sl@0	8671	SetBlockMode(NULL, csPtr->readPtr,
sl@0	8672	nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
sl@0	8673	}
sl@0	8674	if (csPtr->readPtr != csPtr->writePtr) {
sl@0	8675	nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
sl@0	8676	if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
sl@0	8677	SetBlockMode(NULL, csPtr->writePtr,
sl@0	8678	nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
sl@0	8679	}
sl@0	8680	}
sl@0	8681	outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED \| CHANNEL_UNBUFFERED);
sl@0	8682	outStatePtr->flags \|=
sl@0	8683	csPtr->writeFlags & (CHANNEL_LINEBUFFERED \| CHANNEL_UNBUFFERED);
sl@0	8684
sl@0	8685	if (csPtr->cmdPtr) {
sl@0	8686	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
sl@0	8687	(ClientData)csPtr);
sl@0	8688	if (csPtr->readPtr != csPtr->writePtr) {
sl@0	8689	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
sl@0	8690	CopyEventProc, (ClientData)csPtr);
sl@0	8691	}
sl@0	8692	Tcl_DecrRefCount(csPtr->cmdPtr);
sl@0	8693	}
sl@0	8694	inStatePtr->csPtr = NULL;
sl@0	8695	outStatePtr->csPtr = NULL;
sl@0	8696	ckfree((char*) csPtr);
sl@0	8697	}
sl@0	8698
sl@0	8699	/*
sl@0	8700	*----------------------------------------------------------------------
sl@0	8701	*
sl@0	8702	* StackSetBlockMode --
sl@0	8703	*
sl@0	8704	* This function sets the blocking mode for a channel, iterating
sl@0	8705	* through each channel in a stack and updates the state flags.
sl@0	8706	*
sl@0	8707	* Results:
sl@0	8708	* 0 if OK, result code from failed blockModeProc otherwise.
sl@0	8709	*
sl@0	8710	* Side effects:
sl@0	8711	* Modifies the blocking mode of the channel and possibly generates
sl@0	8712	* an error.
sl@0	8713	*
sl@0	8714	*----------------------------------------------------------------------
sl@0	8715	*/
sl@0	8716
sl@0	8717	static int
sl@0	8718	StackSetBlockMode(chanPtr, mode)
sl@0	8719	Channel chanPtr; / Channel to modify. */
sl@0	8720	int mode; /* One of TCL_MODE_BLOCKING or
sl@0	8721	* TCL_MODE_NONBLOCKING. */
sl@0	8722	{
sl@0	8723	int result = 0;
sl@0	8724	Tcl_DriverBlockModeProc *blockModeProc;
sl@0	8725
sl@0	8726	/*
sl@0	8727	* Start at the top of the channel stack
sl@0	8728	*/
sl@0	8729
sl@0	8730	chanPtr = chanPtr->state->topChanPtr;
sl@0	8731	while (chanPtr != (Channel *) NULL) {
sl@0	8732	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
sl@0	8733	if (blockModeProc != NULL) {
sl@0	8734	result = (*blockModeProc) (chanPtr->instanceData, mode);
sl@0	8735	if (result != 0) {
sl@0	8736	Tcl_SetErrno(result);
sl@0	8737	return result;
sl@0	8738	}
sl@0	8739	}
sl@0	8740	chanPtr = chanPtr->downChanPtr;
sl@0	8741	}
sl@0	8742	return 0;
sl@0	8743	}
sl@0	8744
sl@0	8745	/*
sl@0	8746	*----------------------------------------------------------------------
sl@0	8747	*
sl@0	8748	* SetBlockMode --
sl@0	8749	*
sl@0	8750	* This function sets the blocking mode for a channel and updates
sl@0	8751	* the state flags.
sl@0	8752	*
sl@0	8753	* Results:
sl@0	8754	* A standard Tcl result.
sl@0	8755	*
sl@0	8756	* Side effects:
sl@0	8757	* Modifies the blocking mode of the channel and possibly generates
sl@0	8758	* an error.
sl@0	8759	*
sl@0	8760	*----------------------------------------------------------------------
sl@0	8761	*/
sl@0	8762
sl@0	8763	static int
sl@0	8764	SetBlockMode(interp, chanPtr, mode)
sl@0	8765	Tcl_Interp interp; / Interp for error reporting. */
sl@0	8766	Channel chanPtr; / Channel to modify. */
sl@0	8767	int mode; /* One of TCL_MODE_BLOCKING or
sl@0	8768	* TCL_MODE_NONBLOCKING. */
sl@0	8769	{
sl@0	8770	ChannelState statePtr = chanPtr->state; / state info for channel */
sl@0	8771	int result = 0;
sl@0	8772
sl@0	8773	result = StackSetBlockMode(chanPtr, mode);
sl@0	8774	if (result != 0) {
sl@0	8775	if (interp != (Tcl_Interp *) NULL) {
sl@0	8776	Tcl_AppendResult(interp, "error setting blocking mode: ",
sl@0	8777	Tcl_PosixError(interp), (char *) NULL);
sl@0	8778	}
sl@0	8779	return TCL_ERROR;
sl@0	8780	}
sl@0	8781	if (mode == TCL_MODE_BLOCKING) {
sl@0	8782	statePtr->flags &= (~(CHANNEL_NONBLOCKING \| BG_FLUSH_SCHEDULED));
sl@0	8783	} else {
sl@0	8784	statePtr->flags \|= CHANNEL_NONBLOCKING;
sl@0	8785	}
sl@0	8786	return TCL_OK;
sl@0	8787	}
sl@0	8788
sl@0	8789	/*
sl@0	8790	*----------------------------------------------------------------------
sl@0	8791	*
sl@0	8792	* Tcl_GetChannelNames --
sl@0	8793	*
sl@0	8794	* Return the names of all open channels in the interp.
sl@0	8795	*
sl@0	8796	* Results:
sl@0	8797	* TCL_OK or TCL_ERROR.
sl@0	8798	*
sl@0	8799	* Side effects:
sl@0	8800	* Interp result modified with list of channel names.
sl@0	8801	*
sl@0	8802	*----------------------------------------------------------------------
sl@0	8803	*/
sl@0	8804
sl@0	8805	EXPORT_C int
sl@0	8806	Tcl_GetChannelNames(interp)
sl@0	8807	Tcl_Interp interp; / Interp for error reporting. */
sl@0	8808	{
sl@0	8809	return Tcl_GetChannelNamesEx(interp, (char *) NULL);
sl@0	8810	}
sl@0	8811
sl@0	8812	/*
sl@0	8813	*----------------------------------------------------------------------
sl@0	8814	*
sl@0	8815	* Tcl_GetChannelNamesEx --
sl@0	8816	*
sl@0	8817	* Return the names of open channels in the interp filtered
sl@0	8818	* filtered through a pattern. If pattern is NULL, it returns
sl@0	8819	* all the open channels.
sl@0	8820	*
sl@0	8821	* Results:
sl@0	8822	* TCL_OK or TCL_ERROR.
sl@0	8823	*
sl@0	8824	* Side effects:
sl@0	8825	* Interp result modified with list of channel names.
sl@0	8826	*
sl@0	8827	*----------------------------------------------------------------------
sl@0	8828	*/
sl@0	8829
sl@0	8830	EXPORT_C int
sl@0	8831	Tcl_GetChannelNamesEx(interp, pattern)
sl@0	8832	Tcl_Interp interp; / Interp for error reporting. */
sl@0	8833	CONST char pattern; / pattern to filter on. */
sl@0	8834	{
sl@0	8835	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	8836	ChannelState *statePtr;
sl@0	8837	CONST char name; / name for channel */
sl@0	8838	Tcl_Obj resultPtr; / pointer to result object */
sl@0	8839	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	8840	Tcl_HashEntry hPtr; / Search variable. */
sl@0	8841	Tcl_HashSearch hSearch; /* Search variable. */
sl@0	8842
sl@0	8843	if (interp == (Tcl_Interp *) NULL) {
sl@0	8844	return TCL_OK;
sl@0	8845	}
sl@0	8846
sl@0	8847	/*
sl@0	8848	* Get the channel table that stores the channels registered
sl@0	8849	* for this interpreter.
sl@0	8850	*/
sl@0	8851	hTblPtr = GetChannelTable(interp);
sl@0	8852	resultPtr = Tcl_GetObjResult(interp);
sl@0	8853
sl@0	8854	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
sl@0	8855	hPtr != (Tcl_HashEntry *) NULL;
sl@0	8856	hPtr = Tcl_NextHashEntry(&hSearch)) {
sl@0	8857
sl@0	8858	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
sl@0	8859	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
sl@0	8860	name = "stdin";
sl@0	8861	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
sl@0	8862	name = "stdout";
sl@0	8863	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
sl@0	8864	name = "stderr";
sl@0	8865	} else {
sl@0	8866	/*
sl@0	8867	* This is also stored in Tcl_GetHashKey(hTblPtr, hPtr),
sl@0	8868	* but it's simpler to just grab the name from the statePtr.
sl@0	8869	*/
sl@0	8870	name = statePtr->channelName;
sl@0	8871	}
sl@0	8872
sl@0	8873	if (((pattern == NULL) \|\| Tcl_StringMatch(name, pattern)) &&
sl@0	8874	(Tcl_ListObjAppendElement(interp, resultPtr,
sl@0	8875	Tcl_NewStringObj(name, -1)) != TCL_OK)) {
sl@0	8876	return TCL_ERROR;
sl@0	8877	}
sl@0	8878	}
sl@0	8879	return TCL_OK;
sl@0	8880	}
sl@0	8881
sl@0	8882	/*
sl@0	8883	*----------------------------------------------------------------------
sl@0	8884	*
sl@0	8885	* Tcl_IsChannelRegistered --
sl@0	8886	*
sl@0	8887	* Checks whether the channel is associated with the interp.
sl@0	8888	* See also Tcl_RegisterChannel and Tcl_UnregisterChannel.
sl@0	8889	*
sl@0	8890	* Results:
sl@0	8891	* 0 if the channel is not registered in the interpreter, 1 else.
sl@0	8892	*
sl@0	8893	* Side effects:
sl@0	8894	* None.
sl@0	8895	*
sl@0	8896	*----------------------------------------------------------------------
sl@0	8897	*/
sl@0	8898
sl@0	8899	EXPORT_C int
sl@0	8900	Tcl_IsChannelRegistered (interp, chan)
sl@0	8901	Tcl_Interp* interp; /* The interp to query of the channel */
sl@0	8902	Tcl_Channel chan; /* The channel to check */
sl@0	8903	{
sl@0	8904	Tcl_HashTable hTblPtr; / Hash table of channels. */
sl@0	8905	Tcl_HashEntry hPtr; / Search variable. */
sl@0	8906	Channel chanPtr; / The real IO channel. */
sl@0	8907	ChannelState statePtr; / State of the real channel. */
sl@0	8908
sl@0	8909	/*
sl@0	8910	* Always check bottom-most channel in the stack. This is the one
sl@0	8911	* that gets registered.
sl@0	8912	*/
sl@0	8913	chanPtr = ((Channel *) chan)->state->bottomChanPtr;
sl@0	8914	statePtr = chanPtr->state;
sl@0	8915
sl@0	8916	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
sl@0	8917	if (hTblPtr == (Tcl_HashTable *) NULL) {
sl@0	8918	return 0;
sl@0	8919	}
sl@0	8920	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
sl@0	8921	if (hPtr == (Tcl_HashEntry *) NULL) {
sl@0	8922	return 0;
sl@0	8923	}
sl@0	8924	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
sl@0	8925	return 0;
sl@0	8926	}
sl@0	8927
sl@0	8928	return 1;
sl@0	8929	}
sl@0	8930
sl@0	8931	/*
sl@0	8932	*----------------------------------------------------------------------
sl@0	8933	*
sl@0	8934	* Tcl_IsChannelShared --
sl@0	8935	*
sl@0	8936	* Checks whether the channel is shared by multiple interpreters.
sl@0	8937	*
sl@0	8938	* Results:
sl@0	8939	* A boolean value (0 = Not shared, 1 = Shared).
sl@0	8940	*
sl@0	8941	* Side effects:
sl@0	8942	* None.
sl@0	8943	*
sl@0	8944	*----------------------------------------------------------------------
sl@0	8945	*/
sl@0	8946
sl@0	8947	EXPORT_C int
sl@0	8948	Tcl_IsChannelShared (chan)
sl@0	8949	Tcl_Channel chan; /* The channel to query */
sl@0	8950	{
sl@0	8951	ChannelState statePtr = ((Channel ) chan)->state;
sl@0	8952	/* State of real channel structure. */
sl@0	8953
sl@0	8954	return ((statePtr->refCount > 1) ? 1 : 0);
sl@0	8955	}
sl@0	8956
sl@0	8957	/*
sl@0	8958	*----------------------------------------------------------------------
sl@0	8959	*
sl@0	8960	* Tcl_IsChannelExisting --
sl@0	8961	*
sl@0	8962	* Checks whether a channel of the given name exists in the
sl@0	8963	* (thread)-global list of all channels.
sl@0	8964	* See Tcl_GetChannelNamesEx for function exposed at the Tcl level.
sl@0	8965	*
sl@0	8966	* Results:
sl@0	8967	* A boolean value (0 = Does not exist, 1 = Does exist).
sl@0	8968	*
sl@0	8969	* Side effects:
sl@0	8970	* None.
sl@0	8971	*
sl@0	8972	*----------------------------------------------------------------------
sl@0	8973	*/
sl@0	8974
sl@0	8975	EXPORT_C int
sl@0	8976	Tcl_IsChannelExisting(chanName)
sl@0	8977	CONST char* chanName; /* The name of the channel to look for. */
sl@0	8978	{
sl@0	8979	ChannelState *statePtr;
sl@0	8980	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	8981	CONST char *name;
sl@0	8982	int chanNameLen;
sl@0	8983
sl@0	8984	chanNameLen = strlen(chanName);
sl@0	8985	for (statePtr = tsdPtr->firstCSPtr;
sl@0	8986	statePtr != NULL;
sl@0	8987	statePtr = statePtr->nextCSPtr) {
sl@0	8988	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
sl@0	8989	name = "stdin";
sl@0	8990	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
sl@0	8991	name = "stdout";
sl@0	8992	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
sl@0	8993	name = "stderr";
sl@0	8994	} else {
sl@0	8995	name = statePtr->channelName;
sl@0	8996	}
sl@0	8997
sl@0	8998	if ((chanName == name) &&
sl@0	8999	(memcmp(name, chanName, (size_t) chanNameLen) == 0)) {
sl@0	9000	return 1;
sl@0	9001	}
sl@0	9002	}
sl@0	9003
sl@0	9004	return 0;
sl@0	9005	}
sl@0	9006
sl@0	9007	/*
sl@0	9008	*----------------------------------------------------------------------
sl@0	9009	*
sl@0	9010	* Tcl_ChannelName --
sl@0	9011	*
sl@0	9012	* Return the name of the channel type.
sl@0	9013	*
sl@0	9014	* Results:
sl@0	9015	* A pointer the name of the channel type.
sl@0	9016	*
sl@0	9017	* Side effects:
sl@0	9018	* None.
sl@0	9019	*
sl@0	9020	*----------------------------------------------------------------------
sl@0	9021	*/
sl@0	9022
sl@0	9023	EXPORT_C CONST char *
sl@0	9024	Tcl_ChannelName(chanTypePtr)
sl@0	9025	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9026	{
sl@0	9027	return chanTypePtr->typeName;
sl@0	9028	}
sl@0	9029
sl@0	9030	/*
sl@0	9031	*----------------------------------------------------------------------
sl@0	9032	*
sl@0	9033	* Tcl_ChannelVersion --
sl@0	9034	*
sl@0	9035	* Return the of version of the channel type.
sl@0	9036	*
sl@0	9037	* Results:
sl@0	9038	* One of the TCL_CHANNEL_VERSION_* constants from tcl.h
sl@0	9039	*
sl@0	9040	* Side effects:
sl@0	9041	* None.
sl@0	9042	*
sl@0	9043	*----------------------------------------------------------------------
sl@0	9044	*/
sl@0	9045
sl@0	9046	EXPORT_C Tcl_ChannelTypeVersion
sl@0	9047	Tcl_ChannelVersion(chanTypePtr)
sl@0	9048	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9049	{
sl@0	9050	if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
sl@0	9051	return TCL_CHANNEL_VERSION_2;
sl@0	9052	} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
sl@0	9053	return TCL_CHANNEL_VERSION_3;
sl@0	9054	} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
sl@0	9055	return TCL_CHANNEL_VERSION_4;
sl@0	9056	} else {
sl@0	9057	/*
sl@0	9058	* In <v2 channel versions, the version field is occupied
sl@0	9059	* by the Tcl_DriverBlockModeProc
sl@0	9060	*/
sl@0	9061	return TCL_CHANNEL_VERSION_1;
sl@0	9062	}
sl@0	9063	}
sl@0	9064
sl@0	9065	/*
sl@0	9066	*----------------------------------------------------------------------
sl@0	9067	*
sl@0	9068	* HaveVersion --
sl@0	9069	*
sl@0	9070	* Return whether a channel type is (at least) of a given version.
sl@0	9071	*
sl@0	9072	* Results:
sl@0	9073	* True if the minimum version is exceeded by the version actually
sl@0	9074	* present.
sl@0	9075	*
sl@0	9076	* Side effects:
sl@0	9077	* None.
sl@0	9078	*
sl@0	9079	*----------------------------------------------------------------------
sl@0	9080	*/
sl@0	9081
sl@0	9082	static int
sl@0	9083	HaveVersion(chanTypePtr, minimumVersion)
sl@0	9084	Tcl_ChannelType *chanTypePtr;
sl@0	9085	Tcl_ChannelTypeVersion minimumVersion;
sl@0	9086	{
sl@0	9087	Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
sl@0	9088
sl@0	9089	return ((int)actualVersion) >= ((int)minimumVersion);
sl@0	9090	}
sl@0	9091
sl@0	9092	/*
sl@0	9093	*----------------------------------------------------------------------
sl@0	9094	*
sl@0	9095	* Tcl_ChannelBlockModeProc --
sl@0	9096	*
sl@0	9097	* Return the Tcl_DriverBlockModeProc of the channel type.
sl@0	9098	*
sl@0	9099	* Results:
sl@0	9100	* A pointer to the proc.
sl@0	9101	*
sl@0	9102	* Side effects:
sl@0	9103	* None.
sl@0	9104	*
sl@0	9105	---------------------------------------------------------------------- /
sl@0	9106
sl@0	9107	EXPORT_C Tcl_DriverBlockModeProc *
sl@0	9108	Tcl_ChannelBlockModeProc(chanTypePtr)
sl@0	9109	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9110	{
sl@0	9111	if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
sl@0	9112	return chanTypePtr->blockModeProc;
sl@0	9113	} else {
sl@0	9114	/*
sl@0	9115	* The v1 structure had the blockModeProc in a different place.
sl@0	9116	*/
sl@0	9117	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
sl@0	9118	}
sl@0	9119	}
sl@0	9120
sl@0	9121	/*
sl@0	9122	*----------------------------------------------------------------------
sl@0	9123	*
sl@0	9124	* Tcl_ChannelCloseProc --
sl@0	9125	*
sl@0	9126	* Return the Tcl_DriverCloseProc of the channel type.
sl@0	9127	*
sl@0	9128	* Results:
sl@0	9129	* A pointer to the proc.
sl@0	9130	*
sl@0	9131	* Side effects:
sl@0	9132	* None.
sl@0	9133	*
sl@0	9134	*----------------------------------------------------------------------
sl@0	9135	*/
sl@0	9136
sl@0	9137	EXPORT_C Tcl_DriverCloseProc *
sl@0	9138	Tcl_ChannelCloseProc(chanTypePtr)
sl@0	9139	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9140	{
sl@0	9141	return chanTypePtr->closeProc;
sl@0	9142	}
sl@0	9143
sl@0	9144	/*
sl@0	9145	*----------------------------------------------------------------------
sl@0	9146	*
sl@0	9147	* Tcl_ChannelClose2Proc --
sl@0	9148	*
sl@0	9149	* Return the Tcl_DriverClose2Proc of the channel type.
sl@0	9150	*
sl@0	9151	* Results:
sl@0	9152	* A pointer to the proc.
sl@0	9153	*
sl@0	9154	* Side effects:
sl@0	9155	* None.
sl@0	9156	*
sl@0	9157	*----------------------------------------------------------------------
sl@0	9158	*/
sl@0	9159
sl@0	9160	EXPORT_C Tcl_DriverClose2Proc *
sl@0	9161	Tcl_ChannelClose2Proc(chanTypePtr)
sl@0	9162	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9163	{
sl@0	9164	return chanTypePtr->close2Proc;
sl@0	9165	}
sl@0	9166
sl@0	9167	/*
sl@0	9168	*----------------------------------------------------------------------
sl@0	9169	*
sl@0	9170	* Tcl_ChannelInputProc --
sl@0	9171	*
sl@0	9172	* Return the Tcl_DriverInputProc of the channel type.
sl@0	9173	*
sl@0	9174	* Results:
sl@0	9175	* A pointer to the proc.
sl@0	9176	*
sl@0	9177	* Side effects:
sl@0	9178	* None.
sl@0	9179	*
sl@0	9180	*----------------------------------------------------------------------
sl@0	9181	*/
sl@0	9182
sl@0	9183	EXPORT_C Tcl_DriverInputProc *
sl@0	9184	Tcl_ChannelInputProc(chanTypePtr)
sl@0	9185	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9186	{
sl@0	9187	return chanTypePtr->inputProc;
sl@0	9188	}
sl@0	9189
sl@0	9190	/*
sl@0	9191	*----------------------------------------------------------------------
sl@0	9192	*
sl@0	9193	* Tcl_ChannelOutputProc --
sl@0	9194	*
sl@0	9195	* Return the Tcl_DriverOutputProc of the channel type.
sl@0	9196	*
sl@0	9197	* Results:
sl@0	9198	* A pointer to the proc.
sl@0	9199	*
sl@0	9200	* Side effects:
sl@0	9201	* None.
sl@0	9202	*
sl@0	9203	*----------------------------------------------------------------------
sl@0	9204	*/
sl@0	9205
sl@0	9206	EXPORT_C Tcl_DriverOutputProc *
sl@0	9207	Tcl_ChannelOutputProc(chanTypePtr)
sl@0	9208	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9209	{
sl@0	9210	return chanTypePtr->outputProc;
sl@0	9211	}
sl@0	9212
sl@0	9213	/*
sl@0	9214	*----------------------------------------------------------------------
sl@0	9215	*
sl@0	9216	* Tcl_ChannelSeekProc --
sl@0	9217	*
sl@0	9218	* Return the Tcl_DriverSeekProc of the channel type.
sl@0	9219	*
sl@0	9220	* Results:
sl@0	9221	* A pointer to the proc.
sl@0	9222	*
sl@0	9223	* Side effects:
sl@0	9224	* None.
sl@0	9225	*
sl@0	9226	*----------------------------------------------------------------------
sl@0	9227	*/
sl@0	9228
sl@0	9229	EXPORT_C Tcl_DriverSeekProc *
sl@0	9230	Tcl_ChannelSeekProc(chanTypePtr)
sl@0	9231	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9232	{
sl@0	9233	return chanTypePtr->seekProc;
sl@0	9234	}
sl@0	9235
sl@0	9236	/*
sl@0	9237	*----------------------------------------------------------------------
sl@0	9238	*
sl@0	9239	* Tcl_ChannelSetOptionProc --
sl@0	9240	*
sl@0	9241	* Return the Tcl_DriverSetOptionProc of the channel type.
sl@0	9242	*
sl@0	9243	* Results:
sl@0	9244	* A pointer to the proc.
sl@0	9245	*
sl@0	9246	* Side effects:
sl@0	9247	* None.
sl@0	9248	*
sl@0	9249	*----------------------------------------------------------------------
sl@0	9250	*/
sl@0	9251
sl@0	9252	EXPORT_C Tcl_DriverSetOptionProc *
sl@0	9253	Tcl_ChannelSetOptionProc(chanTypePtr)
sl@0	9254	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9255	{
sl@0	9256	return chanTypePtr->setOptionProc;
sl@0	9257	}
sl@0	9258
sl@0	9259	/*
sl@0	9260	*----------------------------------------------------------------------
sl@0	9261	*
sl@0	9262	* Tcl_ChannelGetOptionProc --
sl@0	9263	*
sl@0	9264	* Return the Tcl_DriverGetOptionProc of the channel type.
sl@0	9265	*
sl@0	9266	* Results:
sl@0	9267	* A pointer to the proc.
sl@0	9268	*
sl@0	9269	* Side effects:
sl@0	9270	* None.
sl@0	9271	*
sl@0	9272	*----------------------------------------------------------------------
sl@0	9273	*/
sl@0	9274
sl@0	9275	EXPORT_C Tcl_DriverGetOptionProc *
sl@0	9276	Tcl_ChannelGetOptionProc(chanTypePtr)
sl@0	9277	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9278	{
sl@0	9279	return chanTypePtr->getOptionProc;
sl@0	9280	}
sl@0	9281
sl@0	9282	/*
sl@0	9283	*----------------------------------------------------------------------
sl@0	9284	*
sl@0	9285	* Tcl_ChannelWatchProc --
sl@0	9286	*
sl@0	9287	* Return the Tcl_DriverWatchProc of the channel type.
sl@0	9288	*
sl@0	9289	* Results:
sl@0	9290	* A pointer to the proc.
sl@0	9291	*
sl@0	9292	* Side effects:
sl@0	9293	* None.
sl@0	9294	*
sl@0	9295	*----------------------------------------------------------------------
sl@0	9296	*/
sl@0	9297
sl@0	9298	EXPORT_C Tcl_DriverWatchProc *
sl@0	9299	Tcl_ChannelWatchProc(chanTypePtr)
sl@0	9300	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9301	{
sl@0	9302	return chanTypePtr->watchProc;
sl@0	9303	}
sl@0	9304
sl@0	9305	/*
sl@0	9306	*----------------------------------------------------------------------
sl@0	9307	*
sl@0	9308	* Tcl_ChannelGetHandleProc --
sl@0	9309	*
sl@0	9310	* Return the Tcl_DriverGetHandleProc of the channel type.
sl@0	9311	*
sl@0	9312	* Results:
sl@0	9313	* A pointer to the proc.
sl@0	9314	*
sl@0	9315	* Side effects:
sl@0	9316	* None.
sl@0	9317	*
sl@0	9318	*----------------------------------------------------------------------
sl@0	9319	*/
sl@0	9320
sl@0	9321	EXPORT_C Tcl_DriverGetHandleProc *
sl@0	9322	Tcl_ChannelGetHandleProc(chanTypePtr)
sl@0	9323	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9324	{
sl@0	9325	return chanTypePtr->getHandleProc;
sl@0	9326	}
sl@0	9327
sl@0	9328	/*
sl@0	9329	*----------------------------------------------------------------------
sl@0	9330	*
sl@0	9331	* Tcl_ChannelFlushProc --
sl@0	9332	*
sl@0	9333	* Return the Tcl_DriverFlushProc of the channel type.
sl@0	9334	*
sl@0	9335	* Results:
sl@0	9336	* A pointer to the proc.
sl@0	9337	*
sl@0	9338	* Side effects:
sl@0	9339	* None.
sl@0	9340	*
sl@0	9341	*----------------------------------------------------------------------
sl@0	9342	*/
sl@0	9343
sl@0	9344	EXPORT_C Tcl_DriverFlushProc *
sl@0	9345	Tcl_ChannelFlushProc(chanTypePtr)
sl@0	9346	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9347	{
sl@0	9348	if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
sl@0	9349	return chanTypePtr->flushProc;
sl@0	9350	} else {
sl@0	9351	return NULL;
sl@0	9352	}
sl@0	9353	}
sl@0	9354
sl@0	9355	/*
sl@0	9356	*----------------------------------------------------------------------
sl@0	9357	*
sl@0	9358	* Tcl_ChannelHandlerProc --
sl@0	9359	*
sl@0	9360	* Return the Tcl_DriverHandlerProc of the channel type.
sl@0	9361	*
sl@0	9362	* Results:
sl@0	9363	* A pointer to the proc.
sl@0	9364	*
sl@0	9365	* Side effects:
sl@0	9366	* None.
sl@0	9367	*
sl@0	9368	*----------------------------------------------------------------------
sl@0	9369	*/
sl@0	9370
sl@0	9371	EXPORT_C Tcl_DriverHandlerProc *
sl@0	9372	Tcl_ChannelHandlerProc(chanTypePtr)
sl@0	9373	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9374	{
sl@0	9375	if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
sl@0	9376	return chanTypePtr->handlerProc;
sl@0	9377	} else {
sl@0	9378	return NULL;
sl@0	9379	}
sl@0	9380	}
sl@0	9381
sl@0	9382	/*
sl@0	9383	*----------------------------------------------------------------------
sl@0	9384	*
sl@0	9385	* Tcl_ChannelWideSeekProc --
sl@0	9386	*
sl@0	9387	* Return the Tcl_DriverWideSeekProc of the channel type.
sl@0	9388	*
sl@0	9389	* Results:
sl@0	9390	* A pointer to the proc.
sl@0	9391	*
sl@0	9392	* Side effects:
sl@0	9393	* None.
sl@0	9394	*
sl@0	9395	*----------------------------------------------------------------------
sl@0	9396	*/
sl@0	9397
sl@0	9398	EXPORT_C Tcl_DriverWideSeekProc *
sl@0	9399	Tcl_ChannelWideSeekProc(chanTypePtr)
sl@0	9400	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9401	{
sl@0	9402	if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
sl@0	9403	return chanTypePtr->wideSeekProc;
sl@0	9404	} else {
sl@0	9405	return NULL;
sl@0	9406	}
sl@0	9407	}
sl@0	9408
sl@0	9409	/*
sl@0	9410	*----------------------------------------------------------------------
sl@0	9411	*
sl@0	9412	* Tcl_ChannelThreadActionProc --
sl@0	9413	*
sl@0	9414	* Return the Tcl_DriverThreadActionProc of the channel type.
sl@0	9415	*
sl@0	9416	* Results:
sl@0	9417	* A pointer to the proc.
sl@0	9418	*
sl@0	9419	* Side effects:
sl@0	9420	* None.
sl@0	9421	*
sl@0	9422	*----------------------------------------------------------------------
sl@0	9423	*/
sl@0	9424
sl@0	9425	EXPORT_C Tcl_DriverThreadActionProc *
sl@0	9426	Tcl_ChannelThreadActionProc(chanTypePtr)
sl@0	9427	Tcl_ChannelType chanTypePtr; / Pointer to channel type. */
sl@0	9428	{
sl@0	9429	if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
sl@0	9430	return chanTypePtr->threadActionProc;
sl@0	9431	} else {
sl@0	9432	return NULL;
sl@0	9433	}
sl@0	9434	}
sl@0	9435
sl@0	9436	#if 0
sl@0	9437	/* For future debugging work, a simple function to print the flags of
sl@0	9438	* a channel in semi-readable form.
sl@0	9439	*/
sl@0	9440
sl@0	9441	static int
sl@0	9442	DumpFlags (str, flags)
sl@0	9443	char* str;
sl@0	9444	int flags;
sl@0	9445	{
sl@0	9446	char buf [20];
sl@0	9447	int i = 0;
sl@0	9448
sl@0	9449	if (flags & TCL_READABLE) {buf[i] = 'r';} else {buf [i]='_';}; i++;
sl@0	9450	if (flags & TCL_WRITABLE) {buf[i] = 'w';} else {buf [i]='_';}; i++;
sl@0	9451	if (flags & CHANNEL_NONBLOCKING) {buf[i] = 'n';} else {buf [i]='_';}; i++;
sl@0	9452	if (flags & CHANNEL_LINEBUFFERED) {buf[i] = 'l';} else {buf [i]='_';}; i++;
sl@0	9453	if (flags & CHANNEL_UNBUFFERED) {buf[i] = 'u';} else {buf [i]='_';}; i++;
sl@0	9454	if (flags & BUFFER_READY) {buf[i] = 'R';} else {buf [i]='_';}; i++;
sl@0	9455	if (flags & BG_FLUSH_SCHEDULED) {buf[i] = 'F';} else {buf [i]='_';}; i++;
sl@0	9456	if (flags & CHANNEL_CLOSED) {buf[i] = 'c';} else {buf [i]='_';}; i++;
sl@0	9457	if (flags & CHANNEL_EOF) {buf[i] = 'E';} else {buf [i]='_';}; i++;
sl@0	9458	if (flags & CHANNEL_STICKY_EOF) {buf[i] = 'S';} else {buf [i]='_';}; i++;
sl@0	9459	if (flags & CHANNEL_BLOCKED) {buf[i] = 'B';} else {buf [i]='_';}; i++;
sl@0	9460	if (flags & INPUT_SAW_CR) {buf[i] = '/';} else {buf [i]='_';}; i++;
sl@0	9461	if (flags & INPUT_NEED_NL) {buf[i] = '*';} else {buf [i]='_';}; i++;
sl@0	9462	if (flags & CHANNEL_DEAD) {buf[i] = 'D';} else {buf [i]='_';}; i++;
sl@0	9463	if (flags & CHANNEL_RAW_MODE) {buf[i] = 'R';} else {buf [i]='_';}; i++;
sl@0	9464	#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
sl@0	9465	if (flags & CHANNEL_TIMER_FEV) {buf[i] = 'T';} else {buf [i]='_';}; i++;
sl@0	9466	if (flags & CHANNEL_HAS_MORE_DATA) {buf[i] = 'H';} else {buf [i]='_';}; i++;
sl@0	9467	#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
sl@0	9468	if (flags & CHANNEL_INCLOSE) {buf[i] = 'x';} else {buf [i]='_';}; i++;
sl@0	9469	buf [i] ='\0';
sl@0	9470
sl@0	9471	fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr);
sl@0	9472	return 0;
sl@0	9473	}
sl@0	9474	#endif

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--