Tcl Source Code

2011-04-08  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: fix for [Bug 3280043]: win2k: unresolved DLL imports
	* win/configure.in
	* win/configure

2011-04-06  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): earlier return if Tip280
	gymnastics not needed.

	* generic/tclExecute.c: fix for [Bug 3274728], making *catchTop an
	unsigned long.

2011-04-06  Jan Nijtmans  <[email protected]>

	* unix/tclAppInit.c:  Make symbols "main" and "Tcl_AppInit"
	MODULE_SCOPE: there is absolutely no reason for exporting them.
	* unix/tcl.m4:        Don't use -fvisibility=hidden with static
	* unix/configure      libraries (--disable-shared)

2011-04-06  Donal K. Fellows  <[email protected]>

	* generic/tclFCmd.c, macosx/tclMacOSXFCmd.c, unix/tclUnixChan.c,
	* unix/tclUnixFCmd.c, win/tclWinChan.c, win/tclWinDde.c,
	* win/tclWinFCmd.c, win/tclWinLoad.c, win/tclWinPipe.c,
	* win/tclWinReg.c, win/tclWinSerial.c, win/tclWinSock.c: More
	generation of error codes (most platform-specific parts not already
	using Tcl_PosixError).

2011-04-05  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e
	* library/tzdata/America/Santiago:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/America/Metlakatla: (new)
	* library/tzdata/America/North_Dakota/Beulah: (new)

 * TclNewInstNameObj --
 *
 *	Creates a new InstName Tcl_Obj based on the given instruction
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclNewInstNameObj(
    unsigned char inst)
{
    Tcl_Obj *objPtr = Tcl_NewObj();

    objPtr->typePtr = &tclInstNameType;
    objPtr->internalRep.longValue = (long) inst;

 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct TEBCdata {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    const unsigned char *pc;	/* These fields are used on return TO this */
    unsigned long *catchTop;	/* this level: they record the state when a */
    int cleanup;		/* new codePtr was received for NR */
    Tcl_Obj *auxObjList;	/* execution. */
    int checkInterp;
    CmdFrame cmdFrame;
    void * stack[1];            /* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))

#define CURR_DEPTH	((unsigned long) (tosPtr - initTosPtr))

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
 * only used in TRACE* calls to get a string from an object.
 */

	 *     offset between saved starting line and actual one. Then modify
	 *     the users to adjust the locations they have by this offset.
	 *
	 * (3) Alternative 2: Do not fully recompile, adjust just the location
	 *     information.
	 */

	if (!invoker) {
	    return codePtr;
	}
	
	{
	    Tcl_HashEntry *hePtr =
		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
	    ExtCmdLoc *eclPtr;
	    CmdFrame *ctxPtr;
	    int redo;

	    if (!hePtr) {
		return codePtr;
	    }

	    eclPtr = Tcl_GetHashValue(hePtr);
	    redo = 0;
	    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    *ctxPtr = *invoker;

 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */
#define	bcFramePtr	(&TD->cmdFrame)
#define	initCatchTop	((unsigned long *) (&TD->stack[-1]))
#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
#define esPtr           (iPtr->execEnvPtr->execStackPtr)

int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
		    "\", there are no file attributes in this filesystem.",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", 0, &index) != TCL_OK) {
	    goto end;
	}

	int i, index;

	if (numObjStrings == 0) {
	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
		    "\", there are no file attributes in this filesystem.",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", 0, &index) != TCL_OK) {
		goto end;
	    }
	    if (attributeStringsAllocated != NULL) {
		TclFreeIntRep(objv[i]);
	    }
	    if (i + 1 == objc) {
		Tcl_AppendResult(interp, "value for \"",
			TclGetString(objv[i]), "\" missing", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", NULL);
		goto end;
	    }
	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
		    objv[i + 1]) != TCL_OK) {
		goto end;
	    }
	}

	     * errors, we use the standard posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_AppendResult(interp, "could not create new link \"",
			TclGetString(objv[index]),
			"\": that path already exists", NULL);
		Tcl_PosixError(interp);
	    } else if (errno == ENOENT) {
		/*
		 * There are two cases here: either the target doesn't exist,
		 * or the directory of the src doesn't exist.
		 */

		int access;
		Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			TCL_PATH_DIRNAME);

		if (dirPtr == NULL) {
		    return TCL_ERROR;
		}
		access = Tcl_FSAccess(dirPtr, F_OK);
		Tcl_DecrRefCount(dirPtr);
		if (access != 0) {
		    Tcl_AppendResult(interp, "could not create new link \"",
			    TclGetString(objv[index]),
			    "\": no such file or directory", NULL);
		    Tcl_PosixError(interp);
		} else {
		    Tcl_AppendResult(interp, "could not create new link \"",
			    TclGetString(objv[index]), "\": target \"",
			    TclGetString(objv[index+1]), "\" doesn't exist",
			    NULL);
		    errno = ENOENT;
		    Tcl_PosixError(interp);
		}
	    } else {
		Tcl_AppendResult(interp, "could not create new link \"",
			TclGetString(objv[index]), "\" pointing to \"",
			TclGetString(objv[index+1]), "\": ",
			Tcl_PosixError(interp), NULL);
	    }

    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif
}

/*
 *---------------------------------------------------------------------------
 *

	     * Only setting rsrclength to 0 to strip a file's resource fork is
	     * supported.
	     */

	    if (newRsrcForkSize != 0) {
		Tcl_AppendResult(interp,
			"setting nonzero rsrclength not supported", NULL);
		Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Construct path to resource fork.
	     */

		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
#else
    Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif
}

/*
 *---------------------------------------------------------------------------
 *

    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
# This test fails due to --export-dynamic
test load-2.5 {loading package with symbol conflict, this test fails when using  --export-dynamic} [list $dll $loaded] {
    pkga_quote
} {I'm in pkga.c}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing

    { echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5
echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6; }
if test "${tcl_cv_cc_visibility_hidden+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else

	    if test "$GCC" = yes -a "$SHARED_BUILD" = 1; then

		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
		cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF

cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE extern
_ACEOF


else






	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

 * Prototypes for procedures defined later in this file:
 */

static int    Pkga_EqObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int    Pkga_QuoteObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
 * Function to be backlinked from the tcltest executable
 */
#if 0
extern const char *Tcltest_Foo();
#else
EXTERN const char *Tcltest_Foo() {
    return "I'm in pkga.c";
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * Pkga_EqObjCmd --
 *
 *	This procedure is invoked to process the "pkga_eq" Tcl command. It

static int
Pkga_QuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetResult(interp, (char *) Tcltest_Foo(), TCL_VOLATILE);
    } else {
    Tcl_SetObjResult(interp, objv[1]);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkga_Init --

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"
#include <stdio.h>

/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * Pkgua_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */
#undef TCL_STORAGE_CLASS

static int
PkguaQuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    if (objc == 1) {
	int major, minor, patch, type;
	char result[128];

#undef Tcl_GetVersion /* Link this symbol without stubs */
	Tcl_GetVersion(&major, &minor, &patch, &type);
	sprintf(result, "%d %d %d %d", major, minor, patch, type);
	Tcl_SetResult(interp, result, TCL_VOLATILE);
    } else {
    Tcl_SetObjResult(interp, objv[1]);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgua_Init --

    AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes])

    # Step 0.c: Check if visibility support is available. Do this here so
    # that platform specific alternatives can be used below if this fails.

    AC_CACHE_CHECK([if compiler supports visibility "hidden"],
	tcl_cv_cc_visibility_hidden, [
	    AS_IF([test "$GCC" = yes -a "$SHARED_BUILD" = 1], [
		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
		AC_TRY_COMPILE(,, tcl_cv_cc_visibility_hidden=yes,
		    tcl_cv_cc_visibility_hidden=no)
		CFLAGS=$hold_cflags
	    ], [
		tcl_cv_cc_visibility_hidden=no
	    ])

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#include "tcl.h"

#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it doesn't exist.
 */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
MODULE_SCOPE int main(int, char **);

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif

    return TCL_OK;
}

#ifdef TCL_TEST
#   undef TCL_STORAGE_CLASS
#   define TCL_STORAGE_CLASS DLLEXPORT
EXTERN const char *Tcltest_Foo() {
    return "I'm in tclAppInit.c";
}
#endif /* TCL_TEST */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

#endif	/* !SUPPORTS_TTY */

#define UNSUPPORTED_OPTION(detail) \
    if (interp) {						\
	Tcl_AppendResult(interp, (detail),			\
		" not supported for this platform", NULL);	\
	Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);	\
    }

/*
 * Static routines for this file:
 */

static int		FileBlockModeProc(ClientData instanceData, int mode);

	    UNSUPPORTED_OPTION("-handshake DTRDSR");
	    return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -handshake: "
			"must be one of xonxoff, rtscts, dtrdsr or none",
			NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	SETIOSTATE(fsPtr->fd, &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_AppendResult(interp, "bad value for -xchar: "
			"should be a list of two elements", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	GETIOSTATE(fsPtr->fd, &iostate);

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -ttycontrol: "
			"should be a list of signal,value pairs", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	GETCONTROL(fsPtr->fd, &control);
	for (i = 0; i < argc-1; i += 2) {

		return TCL_ERROR;
#endif /* SETBREAK */
	    } else {
		if (interp) {
		    Tcl_AppendResult(interp, "bad signal \"", argv[i],
			    "\" for -ttycontrol: must be "
			    "DTR, RTS or BREAK", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	SETCONTROL(fsPtr->fd, &control);

    i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr,
	    stopPtr, &end);
    if ((i != 4) || (mode[end] != '\0')) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
		    NULL);
	    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]

	    Tcl_AppendResult(interp, bad, " parity: should be ",
#if defined(PAREXT) || defined(USE_TERMIO)
		    "n, o, e, m, or s",
#else
		    "n, o, or e",
#endif /* PAREXT|USE_TERMIO */
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	}
	return TCL_ERROR;
    }
    *parityPtr = parity;
    if ((*dataPtr < 5) || (*dataPtr > 8)) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	}
	return TCL_ERROR;
    }
    if ((*stopPtr < 0) || (*stopPtr > 2)) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    chan = Tcl_GetChannel(interp, chanID, &chanMode);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE",
		NULL);
	return TCL_ERROR;
    } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
		NULL);
	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,

	     * writing....
	     */

	    f = fdopen(fd, (forWriting ? "w" : "r"));
	    if (f == NULL) {
		Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
			"\"", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL",
			"FILE_FAILURE", NULL);
		return TCL_ERROR;
	    }
	    *filePtr = f;
	    return TCL_OK;
	}
    }

    Tcl_AppendResult(interp, "\"", chanID,
	    "\" cannot be used to get a FILE *", NULL);
    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 */
/*
 *----------------------------------------------------------------------

	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not set group for file \"",
			TclGetString(fileName), "\": group \"", string,
			"\" does not exist", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP",
			"NO_GROUP", NULL);
	    }
	    return TCL_ERROR;
	}
	gid = groupPtr->gr_gid;
    }

    native = Tcl_FSGetNativePath(fileName);

	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not set owner for file \"",
			TclGetString(fileName), "\": user \"", string,
			"\" does not exist", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN",
			"NO_USER", NULL);
	    }
	    return TCL_ERROR;
	}
	uid = pwPtr->pw_uid;
    }

    native = Tcl_FSGetNativePath(fileName);

	}
	newMode = (mode_t) (buf.st_mode & 0x00007FFF);

	if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "unknown permission string format \"",
			modeStringPtr, "\"", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chmod(native, newMode);		/* INTL: Native. */

echo "${ECHO_T}$tcl_cv_intrinsics" >&6
if test "$tcl_cv_intrinsics" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_INTRIN_H 1
_ACEOF

fi

# See if the <wspiapi.h> header file is present

echo "$as_me:$LINENO: checking for wspiapi.h" >&5
echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
if test "${tcl_have_wspiapi_h+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#include <wspiapi.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_have_wspiapi_h=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_have_wspiapi_h=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_have_wspiapi_h" >&5
echo "${ECHO_T}$tcl_have_wspiapi_h" >&6
if test "$tcl_have_wspiapi_h" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_WSPIAPI_H 1
_ACEOF

fi

#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------

        tcl_cv_intrinsics=yes,
        tcl_cv_intrinsics=no)
)
if test "$tcl_cv_intrinsics" = "yes"; then
    AC_DEFINE(HAVE_INTRIN_H, 1,
            [Defined when the compilers supports intrinsics])
fi

# See if the <wspiapi.h> header file is present    

AC_CACHE_CHECK(for wspiapi.h,
    tcl_have_wspiapi_h,
AC_TRY_COMPILE([
#include <wspiapi.h>
], [],
        tcl_have_wspiapi_h=yes,
        tcl_have_wspiapi_h=no)
)
if test "$tcl_have_wspiapi_h" = "yes"; then
    AC_DEFINE(HAVE_WSPIAPI_H, 1,
            [Defined when wspiapi.h exists])
fi

#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------

AC_OBJEXT
AC_EXEEXT

	 * The handle is of an unknown type, probably /dev/nul equivalent or
	 * possibly a closed handle.
	 */

	channel = NULL;
	Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		"\": bad file type", NULL);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
		NULL);
	break;
    }

    return channel;
}

/*

    Tcl_Obj *returnPackagePtr;
    int result = TCL_OK;

    if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
		"a handler procedure must be defined for use in a safe "
		"interp", -1));
	Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
	result = TCL_ERROR;
    }

    if (riPtr->handlerPtr != NULL) {
	/*
	 * Add the dde request data to the handler proc list.
	 */

    DdeFreeStringHandle(ddeInstance, ddeService);
    DdeFreeStringHandle(ddeInstance, ddeTopic);

    if (ddeConv == (HCONV) NULL) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "no registered server named \"",
		    name, "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
	}
	return TCL_ERROR;
    }

    *ddeConvPtr = ddeConv;
    return TCL_OK;
}

 *----------------------------------------------------------------------
 */

static void
SetDdeError(
    Tcl_Interp *interp)	    /* The interp to put the message in. */
{
    const char *errorMessage, *errorCode;

    switch (DdeGetLastError(ddeInstance)) {
    case DMLERR_DATAACKTIMEOUT:
    case DMLERR_EXECACKTIMEOUT:
    case DMLERR_POKEACKTIMEOUT:
	errorMessage = "remote interpreter did not respond";
	errorCode = "TIMEOUT";
	break;
    case DMLERR_BUSY:
	errorMessage = "remote server is busy";
	errorCode = "BUSY";
	break;
    case DMLERR_NOTPROCESSED:
	errorMessage = "remote server cannot handle this command";
	errorCode = "NOCANDO";
	break;
    default:
	errorMessage = "dde command failed";
	errorCode = "FAILED";
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
    Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * DdeObjCmd --
 *

	int dataLength;
	BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
		objv[firstArg + 2], &dataLength);

	if (dataLength == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

    case DDE_REQUEST: {
	const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot request value of null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);
	BYTE *dataString;

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
		&length);

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);

    case DDE_EVAL: {
	RegisteredInterp *riPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (serviceName == NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("invalid service name \"\"", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	objc -= (async + 3);
	objv += (async + 3);

	     * referring to deallocated objects.
	     */

	    if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
		Tcl_SetResult(riPtr->interp, "permission denied: "
			"a handler procedure must be defined for use in "
			"a safe interp", TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
			NULL);
		result = TCL_ERROR;
	    }

	    if (result == TCL_OK) {
		if (objc == 1)
		    objPtr = objv[0];
		else {

	     */

	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
	    invalidServerResponse:
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("invalid data returned from server",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = Tcl_GetStringFromObj(objPtr, &length);
	    ddeItemData = DdeCreateDataHandle(ddeInstance,

    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(fileName), "\": no such file or directory",
		    (char *) NULL);
	    errno = ENOENT;
	    Tcl_PosixError(interp);
	}
	goto cleanup;
    }

    /*
     * We will decrement this again at the end.	 It is safer to do this in
     * case any of the calls below retain a reference to splitPath.

    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
{
    Tcl_AppendResult(interp, "cannot set attribute \"",
	    tclpFileAttrStrings[objIndex], "\" for file \"",
	    Tcl_GetString(fileName), "\": attribute is readonly", NULL);
    errno = EINVAL;
    Tcl_PosixError(interp);
    return TCL_ERROR;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclpObjListVolumes --
 *
 *	Lists the currently mounted volumes

	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
	 * about any problem, but it's better than nothing. It'd be even
	 * better if there was a way to get what DLLs
	 */

	switch (lastError) {
	case ERROR_MOD_NOT_FOUND:
	    Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
	    goto notFoundMsg;
	case ERROR_DLL_NOT_FOUND:
	    Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
	notFoundMsg:
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " could not be found in library path", NULL);
	    break;
	case ERROR_PROC_NOT_FOUND:
	    Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
	    Tcl_AppendResult(interp, "A function specified in the import"
		    " table could not be resolved by the system.  Windows"
		    " is not telling which one, I'm sorry.", NULL);
	    break;
	case ERROR_INVALID_DLL:
	    Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " is damaged", NULL);
	    break;
	case ERROR_DLL_INIT_FAILED:
	    Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
	    Tcl_AppendResult(interp, "the library initialization"
		    " routine failed", NULL);
	    break;
	default:
	    TclWinConvertError(lastError);
	    Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --

		wcscpy(dllDirectoryName, name);
	    }
	}
	Tcl_MutexUnlock(&loadMutex);
    }
    if (dllDirectoryName == NULL) {
	Tcl_AppendResult(interp, "couldn't create temporary directory: ",
		Tcl_PosixError(interp), NULL);
    }
    fileName = TclpNativeToNormalized(dllDirectoryName);
    tail = TclPathPart(interp, path, TCL_PATH_TAIL);
    if (tail == NULL) {
	Tcl_DecrRefCount(fileName);
	return NULL;
    } else {

	    createFlags = DETACHED_PROCESS;
	}

	if (applType == APPL_DOS) {
	    Tcl_AppendResult(interp,
		    "DOS application process not supported on this platform",
		    (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
		    NULL);
	    goto end;
	}
    }

    /*
     * cmdLine gets the full command line used to invoke the executable,
     * including the name of the executable itself. The command line arguments

/*
 * Ask for the winsock function typedefs, also.
 */
#define INCL_WINSOCK_API_TYPEDEFS   1
#include <winsock2.h>
#include <ws2tcpip.h>
#ifdef HAVE_WSPIAPI_H
#   include <wspiapi.h>
#endif

#ifdef CHECK_UNICODE_CALLS
#   define _UNICODE
#   define UNICODE
#   define __TCHAR_DEFINED
    typedef float *_TCHAR;
#   define _TCHAR_DEFINED

	ckfree(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	ckfree(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
	*tail++ = '\0';

	}
    } else {
	rootName = name;
    }
    if (!rootName) {
	Tcl_AppendResult(interp, "bad key \"", name,
		"\": must start with a valid root", NULL);
	Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
	return TCL_ERROR;
    }

    /*
     * Split the root into root and subkey portions.
     */

    /*
     * Option -mode baud,parity,databits,stopbits
     */

    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	native = Tcl_WinUtfToTChar(value, -1, &ds);
	result = BuildCommDCB(native, &dcb);
	Tcl_DStringFree(&ds);

	if (result == FALSE) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -mode: should be baud,parity,data,stop", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Default settings for serial communications.
	 */

	dcb.fBinary = TRUE;
	dcb.fErrorChar = FALSE;
	dcb.fNull = FALSE;
	dcb.fAbortOnError = FALSE;

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't set comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
     */

    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Reset all handshake options. DTR and RTS are ON by default.
	 */

	    dcb.fOutxDsrFlow = TRUE;
	    dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
	} else {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -handshake: must be one of xonxoff, rtscts, "
			"dtrdsr or none", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't set comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -xchar {\x11 \x13}
     */

    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (argc != 2) {
	badXchar:
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value for -xchar: should be "
			"a list of two elements with each a single character",
			NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	/*
	 * These dereferences are safe, even in the zero-length string cases,

	    }
	    dcb.XoffChar = (char) character;
	}
	ckfree(argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't set comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*

	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -ttycontrol: should be a list of "
			"signal,value pairs", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		result = TCL_ERROR;
		break;
	    }
	    if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETDTR : CLRDTR))) {
		    if (interp != NULL) {
			Tcl_AppendResult(interp, "can't set DTR signal", NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    result = TCL_ERROR;
		    break;
		}
	    } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETRTS : CLRRTS))) {
		    if (interp != NULL) {
			Tcl_AppendResult(interp, "can't set RTS signal", NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    result = TCL_ERROR;
		    break;
		}
	    } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETBREAK : CLRBREAK))) {
		    if (interp != NULL) {
			Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    result = TCL_ERROR;
		    break;
		}
	    } else {
		if (interp != NULL) {
		    Tcl_AppendResult(interp, "bad signal name \"", argv[i],
			    "\" for -ttycontrol: must be DTR, RTS or BREAK",
			    NULL);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
			    NULL);
		}
		result = TCL_ERROR;
		break;
	    }
	}

	ckfree(argv);

	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -sysbuffer: should be a list of one or two "
			"integers > 0", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetupComm(infoPtr->handle, inSize, outSize)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't setup comm buffers: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	infoPtr->sysBufRead  = inSize;
	infoPtr->sysBufWrite = outSize;

	/*
	 * Adjust the handshake limits. Yes, the XonXoff limits seem to
	 * influence even hardware handshake.
	 */

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
	dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't set comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*

	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
	    return TCL_ERROR;
	}
	tout.ReadTotalTimeoutConstant = msec;
	if (!SetCommTimeouts(infoPtr->handle, &tout)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't set comm timeouts: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}

	return TCL_OK;
    }

    if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
	char parity;
	const char *stop;
	char buf[2 * TCL_INTEGER_SPACE + 16];

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}

	valid = 1;
	parity = 'n';
	if (dcb.Parity <= 4) {

    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
	char buf[4];
	valid = 1;

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get comm state: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	sprintf(buf, "%c", dcb.XonChar);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%c", dcb.XoffChar);
	Tcl_DStringAppendElement(dsPtr, buf);

     */

    if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
	DWORD status;

	if (!GetCommModemStatus(infoPtr->handle, &status)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_AppendResult(interp, "can't get tty status: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	valid = 1;
	SerialModemStatusStr(status, dsPtr);
    }

static void
InitSockets(void)
{
    DWORD id;
    WSADATA wsaData;
    DWORD err;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*
	 * Create the async notification window with a new class. We must

 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    if (tsdPtr != NULL) {
	if (tsdPtr->socketThread != NULL) {
	    if (tsdPtr->hwnd != NULL) {
		PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);

		/*
		 * Wait for the thread to exit. This ensures that we are

static int
TcpBlockProc(
    ClientData instanceData,	/* The socket to block/un-block. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    SocketInfo *infoPtr = instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	infoPtr->flags |= SOCKET_ASYNC;
    } else {
	infoPtr->flags &= ~(SOCKET_ASYNC);
    }
    return 0;

    /* ARGSUSED */
static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp)		/* Unused. */
{
    SocketInfo *infoPtr = instanceData;
    /* TIP #218 */
    int errorCode = 0;
    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for

static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    SocketInfo *infoPtr = instanceData;
    int errorCode = 0;
    int sd;

    /*
     * Shutdown the OS socket handle.
     */
    switch(flags)
	{
	case TCL_CLOSE_READ:
	    sd=SD_RECEIVE;
	    break;
	case TCL_CLOSE_WRITE:
	    sd=SD_SEND;
	    break;
	default:
	    if (interp) {
		Tcl_AppendResult(interp,
			"Socket close2proc called bidirectionally", NULL);
	    }
	    return TCL_ERROR;
	}
    if (shutdown(infoPtr->sockets->fd,sd) == SOCKET_ERROR) {
	TclWinConvertWSAError((DWORD) WSAGetLastError());
	errorCode = Tcl_GetErrno();
    }

				 * progress. */
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
    struct addrinfo *myaddrlist = NULL, *myaddrPtr; /* Socket address for client */
    const char *errorMsg = NULL;
    SOCKET sock = INVALID_SOCKET;
    SocketInfo *infoPtr = NULL;	/* The returned value. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

		newfds->infoPtr = infoPtr;
		newfds->next = NULL;
		fds->next = newfds;
		fds = newfds;
	    }
	}
    } else {
	for (addrPtr = addrlist; addrPtr != NULL;
		addrPtr = addrPtr->ai_next) {
	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
		    myaddrPtr = myaddrPtr->ai_next) {
		/*
		 * No need to try combinations of local and remote addresses
		 * of different families.
		 */
		if (myaddrPtr->ai_family != addrPtr->ai_family) {
		    continue;
		}

WaitForSocketEvent(
    SocketInfo *infoPtr,	/* Information about this socket. */
    int events,			/* Events to look for. */
    int *errorCodePtr)		/* Where to store errors? */
{
    int result = 1;
    int oldMode;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);

    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers((ClientData) sock, TCP_BUFFER_SIZE);

{
    SOCKET newSocket;
    SocketInfo *newInfoPtr;
    SocketInfo *infoPtr = fds->infoPtr;
    SOCKADDR_IN addr;
    int len;
    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

static int
TcpInputProc(
    ClientData instanceData,	/* The socket state. */
    char *buf,			/* Where to store data. */
    int toRead,			/* Maximum number of bytes to read. */
    int *errorCodePtr)		/* Where to store error codes. */
{
    SocketInfo *infoPtr = instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.

static int
TcpOutputProc(
    ClientData instanceData,	/* The socket state. */
    const char *buf,		/* Where to get data. */
    int toWrite,		/* Maximum number of bytes to write. */
    int *errorCodePtr)		/* Where to store error codes. */
{
    SocketInfo *infoPtr = instanceData;
    int bytesWritten;
    DWORD error;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);


    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.

static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    const char *value)		/* New value for option. */
{
    SocketInfo *infoPtr = instanceData;
    SOCKET sock;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
	}
	return TCL_ERROR;
    }


    sock = infoPtr->sockets->fd;

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    if (!strcasecmp(optionName, "-keepalive")) {
	BOOL val = FALSE;
	int boolVar, rtn;

    Tcl_Interp *interp,		/* For error reporting - can be NULL */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    SocketInfo *infoPtr = instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SOCKET sock;
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
	}
	return TCL_ERROR;
    }


    sock = infoPtr->sockets->fd;
    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {

	    TclWinConvertWSAError(err);
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
	}
	return TCL_OK;
    }

    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);
	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),
		    NULL, 0, NI_NUMERICHOST);
	    Tcl_DStringAppendElement(dsPtr, host);
	    getnameinfo(&(peername.sa), size, host, sizeof(host),
		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
	    Tcl_DStringAppendElement(dsPtr, host);
	    Tcl_DStringAppendElement(dsPtr, port);
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }

		return TCL_ERROR;
	    }
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
	    (strncmp(optionName, "-sockname", len) == 0))) {

	TcpFdList *fds;
	address sockname;
	socklen_t size;
	int found = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-sockname");
	    Tcl_DStringStartSublist(dsPtr);
	}
	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
	    sock = fds->fd;
	    size = sizeof(sockname);
	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		int flags = reverseDNS;
		found = 1;

		getnameinfo(&sockname.sa, size, host, sizeof(host),
			NULL, 0, NI_NUMERICHOST);
		Tcl_DStringAppendElement(dsPtr, host);

		/*
		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
		 * can sometimes cause problems (and never have a name).
		 */
		flags |= NI_NUMERICSERV;
		if (sockname.sa.sa_family == AF_INET) {
		    if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
			flags |= NI_NUMERICHOST;
		    }
		} else if (sockname.sa.sa_family == AF_INET6) {
		    if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
				&in6addr_any)) ||
			    (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
			    && sockname.sa6.sin6_addr.s6_addr[12] == 0
			    && sockname.sa6.sin6_addr.s6_addr[13] == 0
			    && sockname.sa6.sin6_addr.s6_addr[14] == 0
			    && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
			flags |= NI_NUMERICHOST;
		    }
		}
		getnameinfo(&sockname.sa, size, host, sizeof(host),
			port, sizeof(port), flags);
		Tcl_DStringAppendElement(dsPtr, host);
		Tcl_DStringAppendElement(dsPtr, port);
	    }
	}
	if (found) {
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    if (interp) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		Tcl_AppendResult(interp, "can't get sockname: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
    }

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {

	int optlen;
	BOOL opt = FALSE;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-nagle");
	}
	optlen = sizeof(BOOL);
	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);

	if (opt) {
	    Tcl_DStringAppendElement(dsPtr, "0");
	} else {
	    Tcl_DStringAppendElement(dsPtr, "1");
	}
	if (len > 0) {
	    return TCL_OK;

static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. Fix for SF Tcl Bug #557878.
     */

    if (!infoPtr->acceptProc) {

static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    int direction,		/* Not used. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    SocketInfo *statePtr = instanceData;

    *handlePtr = INT2PTR(statePtr->sockets->fd);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

 */

static DWORD WINAPI
SocketThread(
    LPVOID arg)
{
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;

    /*
     * Create a dummy window receiving socket events.
     */

    tsdPtr->hwnd = CreateWindow(classname, classname,
	    WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);

static void
TcpThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr;
    SocketInfo *infoPtr = instanceData;
    int notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * Ensure that socket subsystem is initialized in this thread, or else
	 * sockets will not work.
	 */