Merge commit '9966985d896629eede849a84f18e406d1164a16c' as 'tcl8.6'

1 files changed, 1937 insertions, 0 deletions

diff --git a/tcl8.6/unix/tclUnixChan.c b/tcl8.6/unix/tclUnixChan.c
new file mode 100644
index 0000000..b4b2739
--- /dev/null
+++ b/tcl8.6/unix/tclUnixChan.c
@@ -0,0 +1,1937 @@
+/*
+ * tclUnixChan.c
+ *
+ *	Common channel driver for Unix channels based on files, command pipes
+ *	and TCP sockets.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"	/* Internal definitions for Tcl. */
+#include "tclIO.h"	/* To get Channel type declaration. */
+
+#undef SUPPORTS_TTY
+#if defined(HAVE_TERMIOS_H)
+#   define SUPPORTS_TTY 1
+#   include <termios.h>
+#   ifdef HAVE_SYS_IOCTL_H
+#	include <sys/ioctl.h>
+#   endif /* HAVE_SYS_IOCTL_H */
+#   ifdef HAVE_SYS_MODEM_H
+#	include <sys/modem.h>
+#   endif /* HAVE_SYS_MODEM_H */
+
+#   ifdef FIONREAD
+#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
+#   elif defined(FIORDCHK)
+#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
+#   else
+#       define GETREADQUEUE(fd, int)    int = 0
+#   endif
+
+#   ifdef TIOCOUTQ
+#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))
+#   else
+#	define GETWRITEQUEUE(fd, int)	int = 0
+#   endif
+
+#   if !defined(CRTSCTS) && defined(CNEW_RTSCTS)
+#	define CRTSCTS CNEW_RTSCTS
+#   endif /* !CRTSCTS&CNEW_RTSCTS */
+#   if !defined(PAREXT) && defined(CMSPAR)
+#	define PAREXT CMSPAR
+#   endif /* !PAREXT&&CMSPAR */
+
+#endif	/* HAVE_TERMIOS_H */
+
+/*
+ * Helper macros to make parts of this file clearer. The macros do exactly
+ * what they say on the tin. :-) They also only ever refer to their arguments
+ * once, and so can be used without regard to side effects.
+ */
+
+#define SET_BITS(var, bits)	((var) |= (bits))
+#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
+
+/*
+ * This structure describes per-instance state of a file based channel.
+ */
+
+typedef struct FileState {
+    Tcl_Channel channel;	/* Channel associated with this file. */
+    int fd;			/* File handle. */
+    int validMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which operations are valid on the file. */
+} FileState;
+
+#ifdef SUPPORTS_TTY
+
+/*
+ * The following structure is used to set or get the serial port attributes in
+ * a platform-independant manner.
+ */
+
+typedef struct TtyAttrs {
+    int baud;
+    int parity;
+    int data;
+    int stop;
+} TtyAttrs;
+
+#endif	/* !SUPPORTS_TTY */
+
+#define UNSUPPORTED_OPTION(detail) \
+    if (interp) {							\
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(				\
+		"%s not supported for this platform", (detail)));	\
+	Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);		\
+    }
+
+/*
+ * Static routines for this file:
+ */
+
+static int		FileBlockModeProc(ClientData instanceData, int mode);
+static int		FileCloseProc(ClientData instanceData,
+			    Tcl_Interp *interp);
+static int		FileGetHandleProc(ClientData instanceData,
+			    int direction, ClientData *handlePtr);
+static int		FileInputProc(ClientData instanceData, char *buf,
+			    int toRead, int *errorCode);
+static int		FileOutputProc(ClientData instanceData,
+			    const char *buf, int toWrite, int *errorCode);
+static int		FileSeekProc(ClientData instanceData, long offset,
+			    int mode, int *errorCode);
+static int		FileTruncateProc(ClientData instanceData,
+			    Tcl_WideInt length);
+static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
+			    Tcl_WideInt offset, int mode, int *errorCode);
+static void		FileWatchProc(ClientData instanceData, int mask);
+#ifdef SUPPORTS_TTY
+static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
+static int		TtyGetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
+static int		TtyGetBaud(speed_t speed);
+static speed_t		TtyGetSpeed(int baud);
+static void		TtyInit(int fd);
+static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);
+static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
+			    TtyAttrs *ttyPtr);
+static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
+static int		TtySetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *value);
+#endif	/* SUPPORTS_TTY */
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static const Tcl_ChannelType fileChannelType = {
+    "file",			/* Type name. */
+    TCL_CHANNEL_VERSION_5,	/* v5 channel */
+    FileCloseProc,		/* Close proc. */
+    FileInputProc,		/* Input proc. */
+    FileOutputProc,		/* Output proc. */
+    FileSeekProc,		/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    FileWatchProc,		/* Initialize notifier. */
+    FileGetHandleProc,		/* Get OS handles out of channel. */
+    NULL,			/* close2proc. */
+    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
+    NULL,			/* flush proc. */
+    NULL,			/* handler proc. */
+    FileWideSeekProc,		/* wide seek proc. */
+    NULL,
+    FileTruncateProc		/* truncate proc. */
+};
+
+#ifdef SUPPORTS_TTY
+/*
+ * This structure describes the channel type structure for serial IO.
+ * Note that this type is a subclass of the "file" type.
+ */
+
+static const Tcl_ChannelType ttyChannelType = {
+    "tty",			/* Type name. */
+    TCL_CHANNEL_VERSION_5,	/* v5 channel */
+    FileCloseProc,		/* Close proc. */
+    FileInputProc,		/* Input proc. */
+    FileOutputProc,		/* Output proc. */
+    NULL,			/* Seek proc. */
+    TtySetOptionProc,		/* Set option proc. */
+    TtyGetOptionProc,		/* Get option proc. */
+    FileWatchProc,		/* Initialize notifier. */
+    FileGetHandleProc,		/* Get OS handles out of channel. */
+    NULL,			/* close2proc. */
+    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
+    NULL,			/* flush proc. */
+    NULL,			/* handler proc. */
+    NULL,			/* wide seek proc. */
+    NULL,			/* thread action proc. */
+    NULL			/* truncate proc. */
+};
+#endif	/* SUPPORTS_TTY */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockModeProc --
+ *
+ *	Helper function to set blocking and nonblocking modes on a file based
+ *	channel. Invoked by generic IO level code.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+FileBlockModeProc(
+    ClientData instanceData,	/* File state. */
+    int mode)			/* The mode to set. Can be TCL_MODE_BLOCKING
+				 * or TCL_MODE_NONBLOCKING. */
+{
+    FileState *fsPtr = instanceData;
+
+    if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) {
+	return errno;
+    }
+
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInputProc --
+ *
+ *	This function is invoked from the generic IO level to read input from
+ *	a file based channel.
+ *
+ * Results:
+ *	The number of bytes read is returned or -1 on error. An output
+ *	argument contains a POSIX error code if an error occurs, or zero.
+ *
+ * Side effects:
+ *	Reads input from the input device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileInputProc(
+    ClientData instanceData,	/* File state. */
+    char *buf,			/* Where to store data read. */
+    int toRead,			/* How much space is available in the
+				 * buffer? */
+    int *errorCodePtr)		/* Where to store error code. */
+{
+    FileState *fsPtr = instanceData;
+    int bytesRead;		/* How many bytes were actually read from the
+				 * input device? */
+
+    *errorCodePtr = 0;
+
+    /*
+     * Assume there is always enough input available. This will block
+     * appropriately, and read will unblock as soon as a short read is
+     * possible, if the channel is in blocking mode. If the channel is
+     * nonblocking, the read will never block.
+     */
+
+    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
+    if (bytesRead > -1) {
+	return bytesRead;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutputProc--
+ *
+ *	This function is invoked from the generic IO level to write output to
+ *	a file channel.
+ *
+ * Results:
+ *	The number of bytes written is returned or -1 on error. An output
+ *	argument contains a POSIX error code if an error occurred, or zero.
+ *
+ * Side effects:
+ *	Writes output on the output device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileOutputProc(
+    ClientData instanceData,	/* File state. */
+    const char *buf,		/* The data buffer. */
+    int toWrite,		/* How many bytes to write? */
+    int *errorCodePtr)		/* Where to store error code. */
+{
+    FileState *fsPtr = instanceData;
+    int written;
+
+    *errorCodePtr = 0;
+
+    if (toWrite == 0) {
+	/*
+	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
+	 * based implementations will considers this as EOF (if there is a
+	 * pipe behind the file).
+	 */
+
+	return 0;
+    }
+    written = write(fsPtr->fd, buf, (size_t) toWrite);
+    if (written > -1) {
+	return written;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCloseProc --
+ *
+ *	This function is called from the generic IO level to perform
+ *	channel-type-specific cleanup when a file based channel is closed.
+ *
+ * Results:
+ *	0 if successful, errno if failed.
+ *
+ * Side effects:
+ *	Closes the device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileCloseProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_Interp *interp)		/* For error reporting - unused. */
+{
+    FileState *fsPtr = instanceData;
+    int errorCode = 0;
+
+    Tcl_DeleteFileHandler(fsPtr->fd);
+
+    /*
+     * Do not close standard channels while in thread-exit.
+     */
+
+    if (!TclInThreadExit()
+	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
+	if (close(fsPtr->fd) < 0) {
+	    errorCode = errno;
+	}
+    }
+    ckfree(fsPtr);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeekProc --
+ *
+ *	This function is called by the generic IO level to move the access
+ *	point in a file based channel.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. An output argument
+ *	contains the POSIX error code if an error occurred, or zero.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in future
+ *	operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileSeekProc(
+    ClientData instanceData,	/* File state. */
+    long offset,		/* Offset to seek to. */
+    int mode,			/* Relative to where should we seek? Can be
+				 * one of SEEK_START, SEEK_SET or SEEK_END. */
+    int *errorCodePtr)		/* To store error code. */
+{
+    FileState *fsPtr = instanceData;
+    Tcl_WideInt oldLoc, newLoc;
+
+    /*
+     * Save our current place in case we need to roll-back the seek.
+     */
+
+    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
+    if (oldLoc == Tcl_LongAsWide(-1)) {
+	/*
+	 * Bad things are happening. Error out...
+	 */
+
+	*errorCodePtr = errno;
+	return -1;
+    }
+
+    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
+
+    /*
+     * Check for expressability in our return type, and roll-back otherwise.
+     */
+
+    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
+	*errorCodePtr = EOVERFLOW;
+	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
+	return -1;
+    } else {
+	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
+    }
+    return (int) Tcl_WideAsLong(newLoc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ *	This function is called by the generic IO level to move the access
+ *	point in a file based channel, with offsets expressed as wide
+ *	integers.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. An output argument
+ *	contains the POSIX error code if an error occurred, or zero.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in future
+ *	operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+FileWideSeekProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_WideInt offset,		/* Offset to seek to. */
+    int mode,			/* Relative to where should we seek? Can be
+				 * one of SEEK_START, SEEK_CUR or SEEK_END. */
+    int *errorCodePtr)		/* To store error code. */
+{
+    FileState *fsPtr = instanceData;
+    Tcl_WideInt newLoc;
+
+    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
+
+    *errorCodePtr = (newLoc == -1) ? errno : 0;
+    return newLoc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWatchProc --
+ *
+ *	Initialize the notifier to watch the fd from this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets up the notifier so that a future event on the channel will
+ *	be seen by Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileWatchProc(
+    ClientData instanceData,	/* The file state. */
+    int mask)			/* Events of interest; an OR-ed combination of
+				 * TCL_READABLE, TCL_WRITABLE and
+				 * TCL_EXCEPTION. */
+{
+    FileState *fsPtr = instanceData;
+
+    /*
+     * Make sure we only register for events that are valid on this file. Note
+     * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler
+     * with the channel pointer as the client data.
+     */
+
+    mask &= fsPtr->validMask;
+    if (mask) {
+	Tcl_CreateFileHandler(fsPtr->fd, mask,
+		(Tcl_FileProc *) Tcl_NotifyChannel, fsPtr->channel);
+    } else {
+	Tcl_DeleteFileHandler(fsPtr->fd);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileGetHandleProc --
+ *
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from a file
+ *	based channel.
+ *
+ * Results:
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ *	handle for the specified direction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileGetHandleProc(
+    ClientData instanceData,	/* The file state. */
+    int direction,		/* TCL_READABLE or TCL_WRITABLE */
+    ClientData *handlePtr)	/* Where to store the handle. */
+{
+    FileState *fsPtr = instanceData;
+
+    if (direction & fsPtr->validMask) {
+	*handlePtr = INT2PTR(fsPtr->fd);
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+#ifdef SUPPORTS_TTY
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtyModemStatusStr --
+ *
+ *	Converts a RS232 modem status list of readable flags
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TtyModemStatusStr(
+    int status,			/* RS232 modem status */
+    Tcl_DString *dsPtr)		/* Where to store string */
+{
+#ifdef TIOCM_CTS
+    Tcl_DStringAppendElement(dsPtr, "CTS");
+    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CTS) ? "1" : "0");
+#endif /* TIOCM_CTS */
+#ifdef TIOCM_DSR
+    Tcl_DStringAppendElement(dsPtr, "DSR");
+    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_DSR) ? "1" : "0");
+#endif /* TIOCM_DSR */
+#ifdef TIOCM_RNG
+    Tcl_DStringAppendElement(dsPtr, "RING");
+    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0");
+#endif /* TIOCM_RNG */
+#ifdef TIOCM_CD
+    Tcl_DStringAppendElement(dsPtr, "DCD");
+    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0");
+#endif /* TIOCM_CD */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtySetOptionProc --
+ *
+ *	Sets an option on a channel.
+ *
+ * Results:
+ *	A standard Tcl result. Also sets the interp's result on error if
+ *	interp is not NULL.
+ *
+ * Side effects:
+ *	May modify an option on a device. Sets Error message if needed (by
+ *	calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TtySetOptionProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Which option to set? */
+    const char *value)		/* New value for option. */
+{
+    FileState *fsPtr = instanceData;
+    unsigned int len, vlen;
+    TtyAttrs tty;
+    int argc;
+    const char **argv;
+    struct termios iostate;
+
+    len = strlen(optionName);
+    vlen = strlen(value);
+
+    /*
+     * Option -mode baud,parity,databits,stopbits
+     */
+
+    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
+	if (TtyParseMode(interp, value, &tty) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * system calls results should be checked there. - dl
+	 */
+
+	TtySetAttributes(fsPtr->fd, &tty);
+	return TCL_OK;
+    }
+
+
+    /*
+     * Option -handshake none|xonxoff|rtscts|dtrdsr
+     */
+
+    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
+	/*
+	 * Reset all handshake options. DTR and RTS are ON by default.
+	 */
+
+	tcgetattr(fsPtr->fd, &iostate);
+	CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
+#ifdef CRTSCTS
+	CLEAR_BITS(iostate.c_cflag, CRTSCTS);
+#endif /* CRTSCTS */
+	if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) {
+	    /*
+	     * Leave all handshake options disabled.
+	     */
+	} else if (Tcl_UtfNcasecmp(value, "XONXOFF", vlen) == 0) {
+	    SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
+	} else if (Tcl_UtfNcasecmp(value, "RTSCTS", vlen) == 0) {
+#ifdef CRTSCTS
+	    SET_BITS(iostate.c_cflag, CRTSCTS);
+#else /* !CRTSTS */
+	    UNSUPPORTED_OPTION("-handshake RTSCTS");
+	    return TCL_ERROR;
+#endif /* CRTSCTS */
+	} else if (Tcl_UtfNcasecmp(value, "DTRDSR", vlen) == 0) {
+	    UNSUPPORTED_OPTION("-handshake DTRDSR");
+	    return TCL_ERROR;
+	} else {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"bad value for -handshake: must be one of"
+			" xonxoff, rtscts, dtrdsr or none", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
+	return TCL_OK;
+    }
+
+    /*
+     * Option -xchar {\x11 \x13}
+     */
+
+    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
+	Tcl_DString ds;
+
+	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+	    return TCL_ERROR;
+	} else if (argc != 2) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"bad value for -xchar: should be a list of"
+			" two elements", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+	    }
+	    ckfree(argv);
+	    return TCL_ERROR;
+	}
+
+	tcgetattr(fsPtr->fd, &iostate);
+
+	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
+	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
+	TclDStringClear(&ds);
+
+	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
+	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
+	Tcl_DStringFree(&ds);
+	ckfree(argv);
+
+	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
+	return TCL_OK;
+    }
+
+    /*
+     * Option -timeout msec
+     */
+
+    if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
+	int msec;
+
+	tcgetattr(fsPtr->fd, &iostate);
+	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	iostate.c_cc[VMIN] = 0;
+	iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100;
+	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
+	return TCL_OK;
+    }
+
+    /*
+     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
+     */
+    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
+#if defined(TIOCMGET) && defined(TIOCMSET)
+	int i, control, flag;
+
+	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if ((argc % 2) == 1) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"bad value for -ttycontrol: should be a list of"
+			" signal,value pairs", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+	    }
+	    ckfree(argv);
+	    return TCL_ERROR;
+	}
+
+	ioctl(fsPtr->fd, TIOCMGET, &control);
+	for (i = 0; i < argc-1; i += 2) {
+	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
+		ckfree(argv);
+		return TCL_ERROR;
+	    }
+	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
+		if (flag) {
+		    SET_BITS(control, TIOCM_DTR);
+		} else {
+		    CLEAR_BITS(control, TIOCM_DTR);
+		}
+	    } else if (Tcl_UtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
+		if (flag) {
+		    SET_BITS(control, TIOCM_RTS);
+		} else {
+		    CLEAR_BITS(control, TIOCM_RTS);
+		}
+	    } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
+#if defined(TIOCSBRK) && defined(TIOCCBRK)
+		if (flag) {
+		    ioctl(fsPtr->fd, TIOCSBRK, NULL);
+		} else {
+		    ioctl(fsPtr->fd, TIOCCBRK, NULL);
+		}
+#else /* TIOCSBRK & TIOCCBRK */
+		UNSUPPORTED_OPTION("-ttycontrol BREAK");
+		ckfree(argv);
+		return TCL_ERROR;
+#endif /* TIOCSBRK & TIOCCBRK */
+	    } else {
+		if (interp) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "bad signal \"%s\" for -ttycontrol: must be"
+			    " DTR, RTS or BREAK", argv[i]));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+		}
+		ckfree(argv);
+		return TCL_ERROR;
+	    }
+	} /* -ttycontrol options loop */
+
+	ioctl(fsPtr->fd, TIOCMSET, &control);
+	ckfree(argv);
+	return TCL_OK;
+#else /* TIOCMGET&TIOCMSET */
+	UNSUPPORTED_OPTION("-ttycontrol");
+#endif /* TIOCMGET&TIOCMSET */
+    }
+
+    return Tcl_BadChannelOption(interp, optionName,
+	    "mode handshake timeout ttycontrol xchar");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtyGetOptionProc --
+ *
+ *	Gets a mode associated with an IO channel. If the optionName arg is
+ *	non-NULL, retrieves the value of that option. If the optionName arg is
+ *	NULL, retrieves a list of alternating option names and values for the
+ *	given channel.
+ *
+ * Results:
+ *	A standard Tcl result. Also sets the supplied DString to the string
+ *	value of the option(s) returned.  Sets error message if needed
+ *	(by calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TtyGetOptionProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Option to get. */
+    Tcl_DString *dsPtr)		/* Where to store value(s). */
+{
+    FileState *fsPtr = instanceData;
+    unsigned int len;
+    char buf[3*TCL_INTEGER_SPACE + 16];
+    int valid = 0;		/* Flag if valid option parsed. */
+
+    if (optionName == NULL) {
+	len = 0;
+    } else {
+	len = strlen(optionName);
+    }
+    if (len == 0) {
+	Tcl_DStringAppendElement(dsPtr, "-mode");
+    }
+    if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
+	TtyAttrs tty;
+
+	valid = 1;
+	TtyGetAttributes(fsPtr->fd, &tty);
+	sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
+	Tcl_DStringAppendElement(dsPtr, buf);
+    }
+
+    /*
+     * Get option -xchar
+     */
+
+    if (len == 0) {
+	Tcl_DStringAppendElement(dsPtr, "-xchar");
+	Tcl_DStringStartSublist(dsPtr);
+    }
+    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
+	struct termios iostate;
+	Tcl_DString ds;
+
+	valid = 1;
+	tcgetattr(fsPtr->fd, &iostate);
+	Tcl_DStringInit(&ds);
+
+	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
+	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
+	TclDStringClear(&ds);
+
+	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
+	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
+	Tcl_DStringFree(&ds);
+    }
+    if (len == 0) {
+	Tcl_DStringEndSublist(dsPtr);
+    }
+
+    /*
+     * Get option -queue
+     * Option is readonly and returned by [fconfigure chan -queue] but not
+     * returned by unnamed [fconfigure chan].
+     */
+
+    if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
+	int inQueue=0, outQueue=0, inBuffered, outBuffered;
+
+	valid = 1;
+	GETREADQUEUE(fsPtr->fd, inQueue);
+	GETWRITEQUEUE(fsPtr->fd, outQueue);
+	inBuffered = Tcl_InputBuffered(fsPtr->channel);
+	outBuffered = Tcl_OutputBuffered(fsPtr->channel);
+
+	sprintf(buf, "%d", inBuffered+inQueue);
+	Tcl_DStringAppendElement(dsPtr, buf);
+	sprintf(buf, "%d", outBuffered+outQueue);
+	Tcl_DStringAppendElement(dsPtr, buf);
+    }
+
+#if defined(TIOCMGET)
+    /*
+     * Get option -ttystatus
+     * Option is readonly and returned by [fconfigure chan -ttystatus] but not
+     * returned by unnamed [fconfigure chan].
+     */
+    if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
+	int status;
+
+	valid = 1;
+	ioctl(fsPtr->fd, TIOCMGET, &status);
+	TtyModemStatusStr(status, dsPtr);
+    }
+#endif /* TIOCMGET */
+
+    if (valid) {
+	return TCL_OK;
+    }
+    return Tcl_BadChannelOption(interp, optionName, "mode"
+	    " queue ttystatus xchar"
+	    );
+}
+
+
+static const struct {int baud; speed_t speed;} speeds[] = {
+#ifdef B0
+    {0, B0},
+#endif
+#ifdef B50
+    {50, B50},
+#endif
+#ifdef B75
+    {75, B75},
+#endif
+#ifdef B110
+    {110, B110},
+#endif
+#ifdef B134
+    {134, B134},
+#endif
+#ifdef B150
+    {150, B150},
+#endif
+#ifdef B200
+    {200, B200},
+#endif
+#ifdef B300
+    {300, B300},
+#endif
+#ifdef B600
+    {600, B600},
+#endif
+#ifdef B1200
+    {1200, B1200},
+#endif
+#ifdef B1800
+    {1800, B1800},
+#endif
+#ifdef B2400
+    {2400, B2400},
+#endif
+#ifdef B4800
+    {4800, B4800},
+#endif
+#ifdef B9600
+    {9600, B9600},
+#endif
+#ifdef B14400
+    {14400, B14400},
+#endif
+#ifdef B19200
+    {19200, B19200},
+#endif
+#ifdef EXTA
+    {19200, EXTA},
+#endif
+#ifdef B28800
+    {28800, B28800},
+#endif
+#ifdef B38400
+    {38400, B38400},
+#endif
+#ifdef EXTB
+    {38400, EXTB},
+#endif
+#ifdef B57600
+    {57600, B57600},
+#endif
+#ifdef _B57600
+    {57600, _B57600},
+#endif
+#ifdef B76800
+    {76800, B76800},
+#endif
+#ifdef B115200
+    {115200, B115200},
+#endif
+#ifdef _B115200
+    {115200, _B115200},
+#endif
+#ifdef B153600
+    {153600, B153600},
+#endif
+#ifdef B230400
+    {230400, B230400},
+#endif
+#ifdef B307200
+    {307200, B307200},
+#endif
+#ifdef B460800
+    {460800, B460800},
+#endif
+#ifdef B500000
+    {500000, B500000},
+#endif
+#ifdef B576000
+    {576000, B576000},
+#endif
+#ifdef B921600
+    {921600, B921600},
+#endif
+#ifdef B1000000
+    {1000000, B1000000},
+#endif
+#ifdef B1152000
+    {1152000, B1152000},
+#endif
+#ifdef B1500000
+    {1500000,B1500000},
+#endif
+#ifdef B2000000
+    {2000000, B2000000},
+#endif
+#ifdef B2500000
+    {2500000,B2500000},
+#endif
+#ifdef B3000000
+    {3000000,B3000000},
+#endif
+#ifdef B3500000
+    {3500000,B3500000},
+#endif
+#ifdef B4000000
+    {4000000,B4000000},
+#endif
+    {-1, 0}
+};
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetSpeed --
+ *
+ *	Given an integer baud rate, get the speed_t value that should be
+ *	used to select that baud rate.
+ *
+ * Results:
+ *	As above.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static speed_t
+TtyGetSpeed(
+    int baud)			/* The baud rate to look up. */
+{
+    int bestIdx, bestDiff, i, diff;
+
+    bestIdx = 0;
+    bestDiff = 1000000;
+
+    /*
+     * If the baud rate does not correspond to one of the known mask values,
+     * choose the mask value whose baud rate is closest to the specified baud
+     * rate.
+     */
+
+    for (i = 0; speeds[i].baud >= 0; i++) {
+	diff = speeds[i].baud - baud;
+	if (diff < 0) {
+	    diff = -diff;
+	}
+	if (diff < bestDiff) {
+	    bestIdx = i;
+	    bestDiff = diff;
+	}
+    }
+    return speeds[bestIdx].speed;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetBaud --
+ *
+ *	Return the integer baud rate corresponding to a given speed_t value.
+ *
+ * Results:
+ *	As above. If the mask value was not recognized, 0 is returned.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TtyGetBaud(
+    speed_t speed)		/* Speed mask value to look up. */
+{
+    int i;
+
+    for (i = 0; speeds[i].baud >= 0; i++) {
+	if (speeds[i].speed == speed) {
+	    return speeds[i].baud;
+	}
+    }
+    return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetAttributes --
+ *
+ *	Get the current attributes of the specified serial device.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtyGetAttributes(
+    int fd,			/* Open file descriptor for serial port to be
+				 * queried. */
+    TtyAttrs *ttyPtr)		/* Buffer filled with serial port
+				 * attributes. */
+{
+    struct termios iostate;
+    int baud, parity, data, stop;
+
+    tcgetattr(fd, &iostate);
+
+    baud = TtyGetBaud(cfgetospeed(&iostate));
+
+    parity = 'n';
+#ifdef PAREXT
+    switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
+    case PARENB			  : parity = 'e'; break;
+    case PARENB | PARODD	  : parity = 'o'; break;
+    case PARENB |	   PAREXT : parity = 's'; break;
+    case PARENB | PARODD | PAREXT : parity = 'm'; break;
+    }
+#else /* !PAREXT */
+    switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
+    case PARENB		 : parity = 'e'; break;
+    case PARENB | PARODD : parity = 'o'; break;
+    }
+#endif /* PAREXT */
+
+    data = iostate.c_cflag & CSIZE;
+    data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
+
+    stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
+
+    ttyPtr->baud    = baud;
+    ttyPtr->parity  = parity;
+    ttyPtr->data    = data;
+    ttyPtr->stop    = stop;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtySetAttributes --
+ *
+ *	Set the current attributes of the specified serial device.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtySetAttributes(
+    int fd,			/* Open file descriptor for serial port to be
+				 * modified. */
+    TtyAttrs *ttyPtr)		/* Buffer containing new attributes for serial
+				 * port. */
+{
+    struct termios iostate;
+    int parity, data, flag;
+
+    tcgetattr(fd, &iostate);
+    cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud));
+    cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud));
+
+    flag = 0;
+    parity = ttyPtr->parity;
+    if (parity != 'n') {
+	SET_BITS(flag, PARENB);
+#ifdef PAREXT
+	CLEAR_BITS(iostate.c_cflag, PAREXT);
+	if ((parity == 'm') || (parity == 's')) {
+	    SET_BITS(flag, PAREXT);
+	}
+#endif /* PAREXT */
+	if ((parity == 'm') || (parity == 'o')) {
+	    SET_BITS(flag, PARODD);
+	}
+    }
+    data = ttyPtr->data;
+    SET_BITS(flag,
+	    (data == 5) ? CS5 :
+	    (data == 6) ? CS6 :
+	    (data == 7) ? CS7 : CS8);
+    if (ttyPtr->stop == 2) {
+	SET_BITS(flag, CSTOPB);
+    }
+
+    CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB);
+    SET_BITS(iostate.c_cflag, flag);
+
+    tcsetattr(fd, TCSADRAIN, &iostate);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyParseMode --
+ *
+ *	Parse the "-mode" argument to the fconfigure command. The argument is
+ *	of the form baud,parity,data,stop.
+ *
+ * Results:
+ *	The return value is TCL_OK if the argument was successfully parsed,
+ *	TCL_ERROR otherwise. If TCL_ERROR is returned, an error message is
+ *	left in the interp's result (if interp is non-NULL).
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TtyParseMode(
+    Tcl_Interp *interp,		/* If non-NULL, interp for error return. */
+    const char *mode,		/* Mode string to be parsed. */
+    TtyAttrs *ttyPtr)		/* Filled with data from mode string */
+{
+    int i, end;
+    char parity;
+    const char *bad = "bad value for -mode";
+
+    i = sscanf(mode, "%d,%c,%d,%d%n",
+	    &ttyPtr->baud,
+	    &parity,
+	    &ttyPtr->data,
+	    &ttyPtr->stop, &end);
+    if ((i != 4) || (mode[end] != '\0')) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s: should be baud,parity,data,stop", bad));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Only allow setting mark/space parity on platforms that support it Make
+     * sure to allow for the case where strchr is a macro. [Bug: 5089]
+     *
+     * We cannot if/else/endif the strchr arguments, it has to be the whole
+     * function. On AIX this function is apparently a macro, and macros do
+     * not allow pre-processor directives in their arguments.
+     */
+
+    if (
+#if defined(PAREXT)
+        strchr("noems", parity)
+#else
+        strchr("noe", parity)
+#endif /* PAREXT */
+                               == NULL) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s parity: should be %s", bad,
+#if defined(PAREXT)
+		    "n, o, e, m, or s"
+#else
+		    "n, o, or e"
+#endif /* PAREXT */
+		    ));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+	}
+	return TCL_ERROR;
+    }
+    ttyPtr->parity = parity;
+    if ((ttyPtr->data < 5) || (ttyPtr->data > 8)) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s data: should be 5, 6, 7, or 8", bad));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+	}
+	return TCL_ERROR;
+    }
+    if ((ttyPtr->stop < 0) || (ttyPtr->stop > 2)) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s stop: should be 1 or 2", bad));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyInit --
+ *
+ *	Given file descriptor that refers to a serial port, initialize the
+ *	serial port to a set of sane values so that Tcl can talk to a device
+ *	located on the serial port.
+ *
+ * Side effects:
+ *	Serial device initialized to non-blocking raw mode, similar to sockets
+ *	All other modes can be simulated on top of this in Tcl.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtyInit(
+    int fd)	/* Open file descriptor for serial port to be initialized. */
+{
+    struct termios iostate;
+    tcgetattr(fd, &iostate);
+
+    if (iostate.c_iflag != IGNBRK
+	    || iostate.c_oflag != 0
+	    || iostate.c_lflag != 0
+	    || iostate.c_cflag & CREAD
+	    || iostate.c_cc[VMIN] != 1
+	    || iostate.c_cc[VTIME] != 0)
+    {
+	iostate.c_iflag = IGNBRK;
+	iostate.c_oflag = 0;
+	iostate.c_lflag = 0;
+	iostate.c_cflag |= CREAD;
+	iostate.c_cc[VMIN] = 1;
+	iostate.c_cc[VTIME] = 0;
+
+	tcsetattr(fd, TCSADRAIN, &iostate);
+    }
+}
+#endif	/* SUPPORTS_TTY */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFileChannel --
+ *
+ *	Open an file based channel on Unix systems.
+ *
+ * Results:
+ *	The new channel or NULL. If NULL, the output argument errorCodePtr is
+ *	set to a POSIX error and an error message is left in the interp's
+ *	result if interp is not NULL.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the file
+ *	system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    Tcl_Obj *pathPtr,		/* Name of file to open. */
+    int mode,			/* POSIX open mode. */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
+{
+    int fd, channelPermissions;
+    FileState *fsPtr;
+    const char *native, *translation;
+    char channelName[16 + TCL_INTEGER_SPACE];
+    const Tcl_ChannelType *channelTypePtr;
+
+    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+    case O_RDONLY:
+	channelPermissions = TCL_READABLE;
+	break;
+    case O_WRONLY:
+	channelPermissions = TCL_WRITABLE;
+	break;
+    case O_RDWR:
+	channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+	break;
+    default:
+	/*
+	 * This may occurr if modeString was "", for example.
+	 */
+
+	Tcl_Panic("TclpOpenFileChannel: invalid mode value");
+	return NULL;
+    }
+
+    native = Tcl_FSGetNativePath(pathPtr);
+    if (native == NULL) {
+	if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_AppendResult(interp, "couldn't open \"",
+	    TclGetString(pathPtr), "\": filename is invalid on this platform",
+	    NULL);
+	}
+	return NULL;
+    }
+
+#ifdef DJGPP
+    SET_BITS(mode, O_BINARY);
+#endif
+
+    fd = TclOSopen(native, mode, permissions);
+
+    if (fd < 0) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open \"%s\": %s",
+		    TclGetString(pathPtr), Tcl_PosixError(interp)));
+	}
+	return NULL;
+    }
+
+    /*
+     * Set close-on-exec flag on the fd so that child processes will not
+     * inherit this fd.
+     */
+
+    fcntl(fd, F_SETFD, FD_CLOEXEC);
+
+    sprintf(channelName, "file%d", fd);
+
+#ifdef SUPPORTS_TTY
+    if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) {
+	/*
+	 * Initialize the serial port to a set of sane parameters. Especially
+	 * important if the remote device is set to echo and the serial port
+	 * driver was also set to echo -- as soon as a char were sent to the
+	 * serial port, the remote device would echo it, then the serial
+	 * driver would echo it back to the device, etc.
+	 *
+	 * Note that we do not do this if we're dealing with /dev/tty itself,
+	 * as that tends to cause Bad Things To Happen when you're working
+	 * interactively. Strictly a better check would be to see if the FD
+	 * being set up is a device and has the same major/minor as the
+	 * initial std FDs (beware reopening!) but that's nearly as messy.
+	 */
+
+	translation = "auto crlf";
+	channelTypePtr = &ttyChannelType;
+	TtyInit(fd);
+    } else
+#endif	/* SUPPORTS_TTY */
+    {
+	translation = NULL;
+	channelTypePtr = &fileChannelType;
+    }
+
+    fsPtr = ckalloc(sizeof(FileState));
+    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
+    fsPtr->fd = fd;
+
+    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+	    fsPtr, channelPermissions);
+
+    if (translation != NULL) {
+	/*
+	 * Gotcha. Most modems need a "\r" at the end of the command sequence.
+	 * If you just send "at\n", the modem will not respond with "OK"
+	 * because it never got a "\r" to actually invoke the command. So, by
+	 * default, newlines are translated to "\r\n" on output to avoid "bug"
+	 * reports that the serial port isn't working.
+	 */
+
+	if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
+		translation) != TCL_OK) {
+	    Tcl_Close(NULL, fsPtr->channel);
+	    return NULL;
+	}
+    }
+
+    return fsPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeFileChannel --
+ *
+ *	Makes a Tcl_Channel from an existing OS level file handle.
+ *
+ * Results:
+ *	The Tcl_Channel created around the preexisting OS level file handle.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeFileChannel(
+    ClientData handle,		/* OS level handle. */
+    int mode)			/* ORed combination of TCL_READABLE and
+				 * TCL_WRITABLE to indicate file mode. */
+{
+    FileState *fsPtr;
+    char channelName[16 + TCL_INTEGER_SPACE];
+    int fd = PTR2INT(handle);
+    const Tcl_ChannelType *channelTypePtr;
+    struct sockaddr sockaddr;
+    socklen_t sockaddrLen = sizeof(sockaddr);
+
+    if (mode == 0) {
+	return NULL;
+    }
+
+    sockaddr.sa_family = AF_UNSPEC;
+
+#ifdef SUPPORTS_TTY
+    if (isatty(fd)) {
+	channelTypePtr = &ttyChannelType;
+	sprintf(channelName, "serial%d", fd);
+    } else
+#endif /* SUPPORTS_TTY */
+    if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
+	&& (sockaddrLen > 0)
+	&& (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) {
+	return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
+    } else {
+	channelTypePtr = &fileChannelType;
+	sprintf(channelName, "file%d", fd);
+    }
+
+    fsPtr = ckalloc(sizeof(FileState));
+    fsPtr->fd = fd;
+    fsPtr->validMask = mode | TCL_EXCEPTION;
+    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+	    fsPtr, mode);
+
+    return fsPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetDefaultStdChannel --
+ *
+ *	Creates channels for standard input, standard output or standard error
+ *	output if they do not already exist.
+ *
+ * Results:
+ *	Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpGetDefaultStdChannel(
+    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel = NULL;
+    int fd = 0;			/* Initializations needed to prevent */
+    int mode = 0;		/* compiler warning (used before set). */
+    const char *bufMode = NULL;
+
+    /*
+     * Some #def's to make the code a little clearer!
+     */
+
+#define ZERO_OFFSET	((Tcl_SeekOffset) 0)
+#define ERROR_OFFSET	((Tcl_SeekOffset) -1)
+
+    switch (type) {
+    case TCL_STDIN:
+	if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+		&& (errno == EBADF)) {
+	    return NULL;
+	}
+	fd = 0;
+	mode = TCL_READABLE;
+	bufMode = "line";
+	break;
+    case TCL_STDOUT:
+	if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+		&& (errno == EBADF)) {
+	    return NULL;
+	}
+	fd = 1;
+	mode = TCL_WRITABLE;
+	bufMode = "line";
+	break;
+    case TCL_STDERR:
+	if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+		&& (errno == EBADF)) {
+	    return NULL;
+	}
+	fd = 2;
+	mode = TCL_WRITABLE;
+	bufMode = "none";
+	break;
+    default:
+	Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
+	break;
+    }
+
+#undef ZERO_OFFSET
+#undef ERROR_OFFSET
+
+    channel = Tcl_MakeFileChannel(INT2PTR(fd), mode);
+    if (channel == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Set up the normal channel options for stdio handles.
+     */
+
+    if (Tcl_GetChannelType(channel) == &fileChannelType) {
+	Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+    } else {
+	Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
+    }
+    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
+    return channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOpenFile --
+ *
+ *	Given a name of a channel registered in the given interpreter, returns
+ *	a FILE * for it.
+ *
+ * Results:
+ *	A standard Tcl result. If the channel is registered in the given
+ *	interpreter and it is managed by the "file" channel driver, and it is
+ *	open for the requested mode, then the output parameter filePtr is set
+ *	to a FILE * for the underlying file. On error, the filePtr is not set,
+ *	TCL_ERROR is returned and an error message is left in the interp's
+ *	result.
+ *
+ * Side effects:
+ *	May invoke fdopen to create the FILE * for the requested file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetOpenFile(
+    Tcl_Interp *interp,		/* Interpreter in which to find file. */
+    const char *chanID,		/* String that identifies file. */
+    int forWriting,		/* 1 means the file is going to be used for
+				 * writing, 0 means for reading. */
+    int checkUsage,		/* 1 means verify that the file was opened in
+				 * a mode that allows the access specified by
+				 * "forWriting". Ignored, we always check that
+				 * the channel is open for the requested
+				 * mode. */
+    ClientData *filePtr)	/* Store pointer to FILE structure here. */
+{
+    Tcl_Channel chan;
+    int chanMode, fd;
+    const Tcl_ChannelType *chanTypePtr;
+    ClientData data;
+    FILE *f;
+
+    chan = Tcl_GetChannel(interp, chanID, &chanMode);
+    if (chan == NULL) {
+	return TCL_ERROR;
+    }
+    if (forWriting && !(chanMode & TCL_WRITABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" wasn't opened for writing", chanID));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE",
+		NULL);
+	return TCL_ERROR;
+    } else if (!forWriting && !(chanMode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" wasn't opened for reading", chanID));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE",
+		NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * We allow creating a FILE * out of file based, pipe based and socket
+     * based channels. We currently do not allow any other channel types,
+     * because it is likely that stdio will not know what to do with them.
+     */
+
+    chanTypePtr = Tcl_GetChannelType(chan);
+    if ((chanTypePtr == &fileChannelType)
+#ifdef SUPPORTS_TTY
+	    || (chanTypePtr == &ttyChannelType)
+#endif /* SUPPORTS_TTY */
+	    || (strcmp(chanTypePtr->typeName, "tcp") == 0)
+	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
+	if (Tcl_GetChannelHandle(chan,
+		(forWriting ? TCL_WRITABLE : TCL_READABLE), &data) == TCL_OK) {
+	    fd = PTR2INT(data);
+
+	    /*
+	     * The call to fdopen below is probably dangerous, since it will
+	     * truncate an existing file if the file is being opened for
+	     * writing....
+	     */
+
+	    f = fdopen(fd, (forWriting ? "w" : "r"));
+	    if (f == NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"cannot get a FILE * for \"%s\"", chanID));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL",
+			"FILE_FAILURE", NULL);
+		return TCL_ERROR;
+	    }
+	    *filePtr = f;
+	    return TCL_OK;
+	}
+    }
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "\"%s\" cannot be used to get a FILE *", chanID));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR",
+	    NULL);
+    return TCL_ERROR;
+}
+
+#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
+				 * in tclMacOSXNotify.c */
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnixWaitForFile --
+ *
+ *	This function waits synchronously for a file to become readable or
+ *	writable, with an optional timeout.
+ *
+ * Results:
+ *	The return value is an OR'ed combination of TCL_READABLE,
+ *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
+ *	present on file at the time of the return. This function will not
+ *	return until either "timeout" milliseconds have elapsed or at least
+ *	one of the conditions given by mask has occurred for file (a return
+ *	value of 0 means that a timeout occurred). No normal events will be
+ *	serviced during the execution of this function.
+ *
+ * Side effects:
+ *	Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUnixWaitForFile(
+    int fd,			/* Handle for file on which to wait. */
+    int mask,			/* What to wait for: OR'ed combination of
+				 * TCL_READABLE, TCL_WRITABLE, and
+				 * TCL_EXCEPTION. */
+    int timeout)		/* Maximum amount of time to wait for one of
+				 * the conditions in mask to occur, in
+				 * milliseconds. A value of 0 means don't wait
+				 * at all, and a value of -1 means wait
+				 * forever. */
+{
+    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
+    struct timeval blockTime, *timeoutPtr;
+    int numFound, result = 0;
+    fd_set readableMask;
+    fd_set writableMask;
+    fd_set exceptionMask;
+
+#ifndef _DARWIN_C_SOURCE
+    /*
+     * Sanity check fd.
+     */
+
+    if (fd >= FD_SETSIZE) {
+	Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
+	/* must never get here, or select masks overrun will occur below */
+    }
+#endif
+
+    /*
+     * If there is a non-zero finite timeout, compute the time when we give
+     * up.
+     */
+
+    if (timeout > 0) {
+	Tcl_GetTime(&now);
+	abortTime.sec = now.sec + timeout/1000;
+	abortTime.usec = now.usec + (timeout%1000)*1000;
+	if (abortTime.usec >= 1000000) {
+	    abortTime.usec -= 1000000;
+	    abortTime.sec += 1;
+	}
+	timeoutPtr = &blockTime;
+    } else if (timeout == 0) {
+	timeoutPtr = &blockTime;
+	blockTime.tv_sec = 0;
+	blockTime.tv_usec = 0;
+    } else {
+	timeoutPtr = NULL;
+    }
+
+    /*
+     * Initialize the select masks.
+     */
+
+    FD_ZERO(&readableMask);
+    FD_ZERO(&writableMask);
+    FD_ZERO(&exceptionMask);
+
+    /*
+     * Loop in a mini-event loop of our own, waiting for either the file to
+     * become ready or a timeout to occur.
+     */
+
+    while (1) {
+	if (timeout > 0) {
+	    blockTime.tv_sec = abortTime.sec - now.sec;
+	    blockTime.tv_usec = abortTime.usec - now.usec;
+	    if (blockTime.tv_usec < 0) {
+		blockTime.tv_sec -= 1;
+		blockTime.tv_usec += 1000000;
+	    }
+	    if (blockTime.tv_sec < 0) {
+		blockTime.tv_sec = 0;
+		blockTime.tv_usec = 0;
+	    }
+	}
+
+	/*
+	 * Setup the select masks for the fd.
+	 */
+
+	if (mask & TCL_READABLE) {
+	    FD_SET(fd, &readableMask);
+	}
+	if (mask & TCL_WRITABLE) {
+	    FD_SET(fd, &writableMask);
+	}
+	if (mask & TCL_EXCEPTION) {
+	    FD_SET(fd, &exceptionMask);
+	}
+
+	/*
+	 * Wait for the event or a timeout.
+	 */
+
+	numFound = select(fd + 1, &readableMask, &writableMask,
+		&exceptionMask, timeoutPtr);
+	if (numFound == 1) {
+	    if (FD_ISSET(fd, &readableMask)) {
+		SET_BITS(result, TCL_READABLE);
+	    }
+	    if (FD_ISSET(fd, &writableMask)) {
+		SET_BITS(result, TCL_WRITABLE);
+	    }
+	    if (FD_ISSET(fd, &exceptionMask)) {
+		SET_BITS(result, TCL_EXCEPTION);
+	    }
+	    result &= mask;
+	    if (result) {
+		break;
+	    }
+	}
+	if (timeout == 0) {
+	    break;
+	}
+	if (timeout < 0) {
+	    continue;
+	}
+
+	/*
+	 * The select returned early, so we need to recompute the timeout.
+	 */
+
+	Tcl_GetTime(&now);
+	if ((abortTime.sec < now.sec)
+		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
+	    break;
+	}
+    }
+    return result;
+}
+#endif /* HAVE_COREFOUNDATION */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileTruncateProc --
+ *
+ *	Truncates a file to a given length.
+ *
+ * Results:
+ *	0 if the operation succeeded, and -1 if it failed (in which case
+ *	*errorCodePtr will be set to errno).
+ *
+ * Side effects:
+ *	The underlying file is potentially truncated. This can have a wide
+ *	variety of side effects, including moving file pointers that point at
+ *	places later in the file than the truncate point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileTruncateProc(
+    ClientData instanceData,
+    Tcl_WideInt length)
+{
+    FileState *fsPtr = instanceData;
+    int result;
+
+#ifdef HAVE_TYPE_OFF64_T
+    /*
+     * We assume this goes with the type for now...
+     */
+
+    result = ftruncate64(fsPtr->fd, (off64_t) length);
+#else
+    result = ftruncate(fsPtr->fd, (off_t) length);
+#endif
+    if (result) {
+	return errno;
+    }
+    return 0;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */