merge trunk

32 files changed, 965 insertions, 576 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 6ec47c6..6fa26f9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -60,6 +60,7 @@ extern "C" {
 #define TCL_VERSION	    "8.7"
 #define TCL_PATCH_LEVEL	    "8.7a0"
 
+#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
 /*
  *----------------------------------------------------------------------------
  * The following definitions set up the proper options for Windows compilers.
@@ -88,6 +89,7 @@ extern "C" {
 #  define JOIN(a,b) JOIN1(a,b)
 #  define JOIN1(a,b) a##b
 #endif
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  * A special definition used to allow this header file to be included from
@@ -139,7 +141,7 @@ extern "C" {
 #    define TCL_VARARGS(type, name) (type name, ...)
 #    define TCL_VARARGS_DEF(type, name) (type name, ...)
 #    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
-#endif
+#endif /* !TCL_NO_DEPRECATED */
 #if defined(__GNUC__) && (__GNUC__ > 2)
 #   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
 #   define TCL_NORETURN __attribute__ ((noreturn))
@@ -255,7 +257,7 @@ extern "C" {
 #ifndef TCL_NO_DEPRECATED
 #   undef _ANSI_ARGS_
 #   define _ANSI_ARGS_(x)	x
-#endif
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  * Definitions that allow this header file to be used either with or without
@@ -521,7 +523,7 @@ typedef struct Tcl_Interp
     int errorLineDontUse; /* Don't use in extensions! */
 #endif
 }
-#endif /* TCL_NO_DEPRECATED */
+#endif /* !TCL_NO_DEPRECATED */
 Tcl_Interp;
 
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
@@ -995,7 +997,9 @@ typedef struct Tcl_DString {
 
 #define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
 #define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
-#define Tcl_DStringTrunc Tcl_DStringSetLength
+#ifndef TCL_NO_DEPRECATED
+#   define Tcl_DStringTrunc Tcl_DStringSetLength
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  * Definitions for the maximum number of digits of precision that may be
@@ -1123,7 +1127,7 @@ typedef struct Tcl_DString {
 
 #ifndef TCL_NO_DEPRECATED
 #   define TCL_PARSE_PART1	0x400
-#endif
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  * Types for linked variables:
@@ -2624,7 +2628,6 @@ EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 #   define panic		Tcl_Panic
 #endif
 #   define panicVA		Tcl_PanicVA
-#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------------
@@ -2635,6 +2638,8 @@ EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 
 extern Tcl_AppInitProc Tcl_AppInit;
 
+#endif /* !TCL_NO_DEPRECATED */
+
 #endif /* RC_INVOKED */
 
 /*
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 5e977e6..d61ed42 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -27,9 +27,8 @@ static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 static int		FormatInstruction(ByteCode *codePtr,
 			    const unsigned char *pc, Tcl_Obj *bufferObj);
-static void		GetLocationInformation(Tcl_Interp *interp,
-			    Proc *procPtr, Tcl_Obj **fileObjPtr,
-			    int *linePtr);
+static void		GetLocationInformation(Proc *procPtr,
+			    Tcl_Obj **fileObjPtr, int *linePtr);
 static void		PrintSourceToObj(Tcl_Obj *appendObj,
 			    const char *stringPtr, int maxChars);
 static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
@@ -73,8 +72,6 @@ static const Tcl_ObjType tclInstNameType = {
 
 static void
 GetLocationInformation(
-    Tcl_Interp *interp,		/* Where to look up the location
-				 * information. */
     Proc *procPtr,		/* What to look up the information for. */
     Tcl_Obj **fileObjPtr,	/* Where to write the information about what
 				 * file the code came from. Will be written
@@ -88,20 +85,21 @@ GetLocationInformation(
 				 * either with the line number or with -1 if
 				 * the information is not available. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr;
-    CmdFrame *cfPtr;
+    CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);
 
     *fileObjPtr = NULL;
     *linePtr = -1;
-    if (iPtr != NULL && procPtr != NULL) {
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
-	if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
-	    *linePtr = cfPtr->line[0];
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		*fileObjPtr = cfPtr->data.eval.path;
-	    }
-	}
+    if (cfPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Get the source location data out of the CmdFrame.
+     */
+
+    *linePtr = cfPtr->line[0];
+    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	*fileObjPtr = cfPtr->data.eval.path;
     }
 }
 
@@ -275,7 +273,7 @@ DisassembleByteCodeObj(
     Tcl_AppendToObj(bufferObj, "  Source ", -1);
     PrintSourceToObj(bufferObj, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
-    GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
+    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
     if (line > -1 && fileObj != NULL) {
 	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
 		Tcl_GetString(fileObj), line);
@@ -1217,7 +1215,7 @@ DisassembleByteCodeAsDicts(
      * system if it is available.
      */
 
-    GetLocationInformation(interp, codePtr->procPtr, &file, &line);
+    GetLocationInformation(codePtr->procPtr, &file, &line);
 
     /*
      * Build the overall result.
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ad80b28..cfcdd26 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -510,8 +510,7 @@ VarHashCreateVar(
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
 		*(ptrPtr) = (ClientData)				\
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
-    ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
-    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
 	? TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #else /* !TCL_WIDE_INT_IS_LONG */
@@ -530,8 +529,7 @@ VarHashCreateVar(
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
 		*(ptrPtr) = (ClientData)				\
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
-    ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
-    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
 	? TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #endif /* TCL_WIDE_INT_IS_LONG */
@@ -9232,7 +9230,7 @@ TclCompareTwoNumbers(
     Tcl_Obj *valuePtr,
     Tcl_Obj *value2Ptr)
 {
-    int type1, type2, compare;
+    int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
     ClientData ptr1, ptr2;
     mp_int big1, big2;
     double d1, d2, tmp;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d725688..725280c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2630,7 +2630,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
  */
 
 typedef struct ProcessGlobalValue {
-    size_t epoch;			/* Epoch counter to detect changes in the
+    size_t epoch;		/* Epoch counter to detect changes in the
 				 * master value. */
     size_t numBytes;		/* Length of the master string. */
     char *value;		/* The master string value. */
@@ -2971,7 +2971,8 @@ MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
 MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
 			    int *modePtr, int flags);
-MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
+MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
+MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *value, int *code);
 MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
@@ -3968,7 +3969,7 @@ MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
 			    struct CompileEnv *envPtr);
 
 /*
- * Functions defined in generic/tclVar.c and currenttly exported only for use
+ * Functions defined in generic/tclVar.c and currently exported only for use
  * by the bytecode compiler and engine. Some of these could later be placed in
  * the public interface.
  */
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 0053041..5984c16 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -921,7 +921,17 @@ TclJoinPath(
 			if (res != NULL) {
 			    TclDecrRefCount(res);
 			}
-			return TclNewFSPathObj(elt, str, len);
+
+			if (PATHFLAGS(elt)) {
+			    return TclNewFSPathObj(elt, str, len);
+			}
+			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
+			    return TclNewFSPathObj(elt, str, len);
+			}
+			(void) Tcl_FSGetNormalizedPath(NULL, elt);
+			if (elt == PATHOBJ(elt)->normPathPtr) {
+			    return TclNewFSPathObj(elt, str, len);
+			}
 		    }
 		}
 
@@ -948,6 +958,7 @@ TclJoinPath(
 	    }
 	}
 	strElt = TclGetStringFromObj(elt, &strEltLen);
+	driveNameLength = 0;
 	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
 	if (type != TCL_PATH_RELATIVE) {
 	    /*
@@ -1003,6 +1014,12 @@ TclJoinPath(
 		}
 	    }
 	    ptr = strElt;
+	    /* [Bug f34cf83dd0] */
+	    if (driveNameLength > 0) {
+		if (ptr[0] == '/' && ptr[-1] == '/') {
+		    goto noQuickReturn;
+		}
+	    }
 	    while (*ptr != '\0') {
 		if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
 		    /*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 373192c..96bdcf3 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2750,6 +2750,41 @@ MakeLambdaError(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCmdFrameForProcedure --
+ *
+ *	How to get the CmdFrame information for a procedure.
+ *
+ * Results:
+ *	A pointer to the CmdFrame (only guaranteed to be valid until the next
+ *	Tcl command is processed or the interpreter's state is otherwise
+ *	modified) or a NULL if the information is not available.
+ *
+ * Side effects:
+ *	none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CmdFrame *
+TclGetCmdFrameForProcedure(
+    Proc *procPtr)		/* The procedure whose cmd-frame is to be
+				 * looked up. */
+{
+    Tcl_HashEntry *hePtr;
+
+    if (procPtr == NULL || procPtr->iPtr == NULL) {
+	return NULL;
+    }
+    hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr);
+    if (hePtr == NULL) {
+	return NULL;
+    }
+    return (CmdFrame *) Tcl_GetHashValue(hePtr);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 59325b7..55ef325 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -143,6 +143,7 @@ void *TclWinGetTclInstance()
     return hInstance;
 }
 
+#ifndef TCL_NO_DEPRECATED
 #define TclWinSetSockOpt winSetSockOpt
 static int
 TclWinSetSockOpt(SOCKET s, int level, int optname,
@@ -165,6 +166,7 @@ TclWinGetServByName(const char *name, const char *proto)
 {
     return getservbyname(name, proto);
 }
+#endif /* TCL_NO_DEPRECATED */
 
 #define TclWinNoBackslash winNoBackslash
 static char *
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 96b8318..33eebd1 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3113,30 +3113,28 @@ ZlibTransformOutput(
 		errorCodePtr);
     }
 
+    /*
+     * No zero-length writes. Flushes must be explicit.
+     */
+
+    if (toWrite == 0) {
+	return 0;
+    }
+
     cd->outStream.next_in = (Bytef *) buf;
     cd->outStream.avail_in = toWrite;
-    do {
+    while (cd->outStream.avail_in > 0) {
 	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
 		Z_NO_FLUSH, &produced);
+	if (e != Z_OK || produced == 0) {
+	    break;
+	}
 
-	if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) {
-	    /*
-	     * deflate() indicates that it is out of space by returning
-	     * Z_BUF_ERROR *or* by simply returning Z_OK with no remaining
-	     * space; in either case, we must write the whole buffer out and
-	     * retry to compress what is left.
-	     */
-
-	    if (e == Z_BUF_ERROR) {
-		produced = cd->outAllocated;
-		e = Z_OK;
-	    }
-	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
-		*errorCodePtr = Tcl_GetErrno();
-		return -1;
-	    }
+	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
+	    *errorCodePtr = Tcl_GetErrno();
+	    return -1;
 	}
-    } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
+    }
 
     if (e == Z_OK) {
 	return toWrite - cd->outStream.avail_in;
diff --git a/library/http/http.tcl b/library/http/http.tcl
index ccd4cd1..03751a3 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -28,10 +28,19 @@ namespace eval http {
 	# We need a useragent string of this style or various servers will refuse to
 	# send us compressed content even when we ask for it. This follows the
 	# de-facto layout of user-agent strings in current browsers.
-	set http(-useragent) "Mozilla/5.0\
-            ([string totitle $::tcl_platform(platform)]; U;\
-            $::tcl_platform(os) $::tcl_platform(osVersion))\
-            http/[package provide http] Tcl/[package provide Tcl]"
+	# Safe interpreters do not have ::tcl_platform(os) or
+	# ::tcl_platform(osVersion).
+	if {[interp issafe]} {
+	    set http(-useragent) "Mozilla/5.0\
+                (Windows; U;\
+                Windows NT 10.0)\
+                http/[package provide http] Tcl/[package provide Tcl]"
+	} else {
+	    set http(-useragent) "Mozilla/5.0\
+                ([string totitle $::tcl_platform(platform)]; U;\
+                $::tcl_platform(os) $::tcl_platform(osVersion))\
+                http/[package provide http] Tcl/[package provide Tcl]"
+	}
     }
 
     proc init {} {
diff --git a/tests/chanio.test b/tests/chanio.test
index 2d900d0..8c74566 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5345,7 +5345,7 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
     lappend x [chan gets $f]
 } -cleanup {
     chan close $f
-} -result {0o600 {line 1}}
+} -result {0600 {line 1}}
 test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
     file delete $path(test3)
 } -constraints {unix umask} -body {
@@ -5353,7 +5353,7 @@ test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
     chan close [open $path(test3) {WRONLY CREAT}]
     file stat $path(test3) stats
     format "%#o" [expr $stats(mode)&0o777]
-} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
+} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
 test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
     file delete $path(test3)
 } -body {
diff --git a/tests/fileName.test b/tests/fileName.test
index 387d844..ce89623 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -441,6 +441,9 @@ test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     file join /// a b
 } "/a/b"
+test filename-7.19 {[Bug f34cf83dd0]} {
+    file join foo //bar
+} /bar
 
 test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
     testsetplatform win
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 1941936..4c90376 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -367,6 +367,16 @@ test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
 test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
     testPathEqual [file norm /../../] [file norm /]
 } ok
+test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -constraints unix -body {
+    set x //foo
+    file normalize $x
+    file join $x bar
+} -result /foo/bar
+test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body {
+    set x //foo
+    file normalize $x
+    file join $x
+} -result /foo
 
 test filesystem-2.0 {new native path} {unix} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
diff --git a/tests/io.test b/tests/io.test
index aaceec5..3fc370d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -5653,7 +5653,7 @@ test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
     close $f
     file stat $path(test3) stats
     format "%#o" [expr $stats(mode)&0o777]
-} [format %#5o [expr {0o666 & ~ $umaskValue}]]
+} [format %#4o [expr {0o666 & ~ $umaskValue}]]
 test io-40.4 {POSIX open access modes: CREAT} {
     file delete $path(test3)
     set f [open $path(test3) w]
diff --git a/tests/link.test b/tests/link.test
index dda7d6b..6bff356 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -152,7 +152,7 @@ test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
     set uwide "0O"
     concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
 } -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0O 0X 0B 0O 0x 0b 0o 0X 0B 0O}
-test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
+test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
 } -body {
     testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
diff --git a/tests/zlib.test b/tests/zlib.test
index 9f06eb1..c2f7825 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -1004,7 +1004,7 @@ test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup {
 } -cleanup {
     removeFile $filesrc
     removeFile $filedst
-} -result 4152
+} -result 56
 
 ::tcltest::cleanupTests
 return
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 742aa46..830ba2b 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -191,19 +191,21 @@ proc genStubs::declare {args} {
     regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
     set decl [parseDecl $decl]
 
-    foreach platform $platformList {
-	if {$decl ne ""} {
-	    set stubs($curName,$platform,$index) $decl
-	    if {![info exists stubs($curName,$platform,lastNum)] \
-		    || ($index > $stubs($curName,$platform,lastNum))} {
-		set stubs($curName,$platform,lastNum) $index
-	    }
+    if {([lindex $platformList 0] eq "deprecated")} {
+	set stubs($curName,deprecated,$index) [lindex $platformList 1]
+	set stubs($curName,generic,$index) $decl
+	if {![info exists stubs($curName,generic,lastNum)] \
+		|| ($index > $stubs($curName,generic,lastNum))} {
+	    set stubs($curName,generic,lastNum) $index
 	}
-	if {$platformList eq "deprecated"} {
-	    set stubs($curName,generic,$index) $decl
-	    if {![info exists stubs($curName,generic,lastNum)] \
-		    || ($index > $stubs($curName,generic,lastNum))} {
-		set stubs($curName,$platform,lastNum) $index
+    } else {
+	foreach platform $platformList {
+	    if {$decl ne ""} {
+		set stubs($curName,$platform,$index) $decl
+		    if {![info exists stubs($curName,$platform,lastNum)] \
+			    || ($index > $stubs($curName,$platform,lastNum))} {
+			set stubs($curName,$platform,lastNum) $index
+		}
 	    }
 	}
     }
@@ -468,9 +470,10 @@ proc genStubs::makeDecl {name decl index} {
 
     append text "/* $index */\n"
     if {[info exists stubs($name,deprecated,$index)]} {
-    set line "[string toupper $libraryName]_DEPRECATED $rtype"
+	append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
+	set line "$rtype"
     } else {
-    set line "$scspec $rtype"
+	set line "$scspec $rtype"
     }
     set count [expr {2 - ([string length $line] / 8)}]
     append line [string range "\t\t\t" 0 $count]
@@ -582,11 +585,15 @@ proc genStubs::makeMacro {name decl index} {
 
 proc genStubs::makeSlot {name decl index} {
     lassign $decl rtype fname args
+    variable stubs
 
     set lfname [string tolower [string index $fname 0]]
     append lfname [string range $fname 1 end]
 
     set text "    "
+    if {[info exists stubs($name,deprecated,$index)]} {
+	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
+    }
     if {$args eq ""} {
 	append text $rtype " *" $lfname "; /* $index */\n"
 	return $text
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 5d21866..b0c2d8f 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -586,6 +586,7 @@ array set exclude_refs_map {
     scrollbar.n		{set}
     selection.n		{string}
     tcltest.n		{error}
+    text.n		{bind image lower raise}
     tkvars.n		{tk}
     tkwait.n		{variable}
     tm.n		{exec}
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 27fd513..fdc56b7 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -81,7 +81,7 @@ TCL_DL_LIBS='@DL_LIBS@'
 # an executable tclsh or tcltest binary.
 TCL_LD_FLAGS='@LDFLAGS@'
 
-# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
+# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
 # run-time dynamic linker where to look for shared libraries such as
 # libtcl.so.  Used when linking applications.  Only works if there
 # is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 08b4805..ced684a 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -605,7 +605,6 @@ TtySetOptionProc(
 	return TCL_OK;
     }
 
-
     /*
      * Option -handshake none|xonxoff|rtscts|dtrdsr
      */
@@ -706,6 +705,7 @@ TtySetOptionProc(
     /*
      * 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;
@@ -882,6 +882,7 @@ TtyGetOptionProc(
      * 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;
 
@@ -894,12 +895,10 @@ TtyGetOptionProc(
     if (valid) {
 	return TCL_OK;
     }
-    return Tcl_BadChannelOption(interp, optionName, "mode"
-	    " queue ttystatus xchar"
-	    );
+    return Tcl_BadChannelOption(interp, optionName,
+		"mode queue ttystatus xchar");
 }
 
-
 static const struct {int baud; speed_t speed;} speeds[] = {
 #ifdef B0
     {0, B0},
@@ -1023,7 +1022,7 @@ static const struct {int baud; speed_t speed;} speeds[] = {
 #endif
     {-1, 0}
 };
-
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -1315,7 +1314,8 @@ TtyParseMode(
 
 static void
 TtyInit(
-    int fd)	/* Open file descriptor for serial port to be initialized. */
+    int fd)			/* Open file descriptor for serial port to be
+				 * initialized. */
 {
     struct termios iostate;
     tcgetattr(fd, &iostate);
@@ -1325,8 +1325,7 @@ TtyInit(
 	    || iostate.c_lflag != 0
 	    || iostate.c_cflag & CREAD
 	    || iostate.c_cc[VMIN] != 1
-	    || iostate.c_cc[VTIME] != 0)
-    {
+	    || iostate.c_cc[VTIME] != 0) {
 	iostate.c_iflag = IGNBRK;
 	iostate.c_oflag = 0;
 	iostate.c_lflag = 0;
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 1e35b92..80d315e 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -737,6 +737,43 @@ Tcl_GetEncodingNameFromEnvironment(
  *----------------------------------------------------------------------
  */
 
+#if defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020
+/*
+ * Helper because whether CFLocaleCopyCurrent and CFLocaleGetIdentifier are
+ * strongly or weakly bound varies by version of OSX, triggering warnings.
+ */
+
+static inline void
+InitMacLocaleInfoVar(
+    CFLocaleRef (*localeCopyCurrent)(void),
+    CFStringRef (*localeGetIdentifier)(CFLocaleRef),
+    Tcl_Interp *interp)
+{
+    CFLocaleRef localeRef;
+    CFStringRef locale;
+    char loc[256];
+
+    if (localeCopyCurrent == NULL || localeGetIdentifier == NULL) {
+	return;
+    }
+
+    localeRef = localeCopyCurrent();
+    if (!localeRef) {
+	return;
+    }
+
+    locale = localeGetIdentifier(localeRef);
+    if (locale && CFStringGetCString(locale, loc, 256,
+	    kCFStringEncodingUTF8)) {
+	if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
+	    Tcl_ResetResult(interp);
+	}
+	Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
+    }
+    CFRelease(localeRef);
+}
+#endif /*defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020*/
+
 void
 TclpSetVariables(
     Tcl_Interp *interp)
@@ -755,29 +792,12 @@ TclpSetVariables(
 #ifdef HAVE_COREFOUNDATION
     char tclLibPath[MAXPATHLEN + 1];
 
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
     /*
      * Set msgcat fallback locale to current CFLocale identifier.
      */
 
-    CFLocaleRef localeRef;
-
-    if (&CFLocaleCopyCurrent != NULL && &CFLocaleGetIdentifier != NULL &&
-	    (localeRef = CFLocaleCopyCurrent())) {
-	CFStringRef locale = CFLocaleGetIdentifier(localeRef);
-
-	if (locale) {
-	    char loc[256];
-
-	    if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
-		if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
-		    Tcl_ResetResult(interp);
-		}
-		Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
-	    }
-	}
-	CFRelease(localeRef);
-    }
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
+    InitMacLocaleInfoVar(CFLocaleCopyCurrent, CFLocaleGetIdentifier, interp);
 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */
 
     if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index b404080..2353f94 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -728,6 +728,33 @@ TcpClose2Proc(
  *
  *----------------------------------------------------------------------
  */
+
+#ifndef NEED_FAKE_RFC2553
+static inline int
+IPv6AddressNeedsNumericRendering(
+    struct in6_addr addr)
+{
+    if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) {
+        return 1;
+    }
+
+    /*
+     * The IN6_IS_ADDR_V4MAPPED macro has a problem with aliasing warnings on
+     * at least some versions of OSX.
+     */
+
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wstrict-aliasing"
+    if (!IN6_IS_ADDR_V4MAPPED(&addr)) {
+#pragma GCC diagnostic pop
+        return 0;
+    }
+
+    return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0
+            && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0);
+}
+#endif /* NEED_FAKE_RFC2553 */
+
 static void
 TcpHostPortList(
     Tcl_Interp *interp,
@@ -754,12 +781,7 @@ TcpHostPortList(
         }
 #ifndef NEED_FAKE_RFC2553
     } else if (addr.sa.sa_family == AF_INET6) {
-        if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr, &in6addr_any))
-            || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) &&
-                addr.sa6.sin6_addr.s6_addr[12] == 0 &&
-                addr.sa6.sin6_addr.s6_addr[13] == 0 &&
-                addr.sa6.sin6_addr.s6_addr[14] == 0 &&
-                addr.sa6.sin6_addr.s6_addr[15] == 0)) {
+        if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) {
             flags |= NI_NUMERICHOST;
         }
 #endif /* NEED_FAKE_RFC2553 */
diff --git a/win/configure b/win/configure
index 147252c..d0431cb 100755
--- a/win/configure
+++ b/win/configure
@@ -639,6 +639,7 @@ TCL_EXP_FILE
 TCL_BUILD_EXP_FILE
 TCL_NEEDS_EXP_FILE
 TCL_LD_SEARCH_FLAGS
+TCL_CC_SEARCH_FLAGS
 TCL_BUILD_LIB_SPEC
 MAKE_EXE
 MAKE_DLL
@@ -5284,6 +5285,7 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
 
 
 
+
 # win only
 
 
diff --git a/win/configure.ac b/win/configure.ac
index 7405bf4..2821bc3 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -433,6 +433,7 @@ AC_SUBST(MAKE_EXE)
 
 # empty on win, but needs sub'ing
 AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_CC_SEARCH_FLAGS)
 AC_SUBST(TCL_LD_SEARCH_FLAGS)
 AC_SUBST(TCL_NEEDS_EXP_FILE)
 AC_SUBST(TCL_BUILD_EXP_FILE)
diff --git a/win/makefile.vc b/win/makefile.vc
index d6de5e1..18f691b 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -879,6 +879,7 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
 @SHLIB_SUFFIX@       .dll

 @DL_LIBS@

 @LDFLAGS@

+@TCL_CC_SEARCH_FLAGS@

 @TCL_LD_SEARCH_FLAGS@

 @LIBOBJS@

 @RANLIB@

diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index b060370..97670aa 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -92,10 +92,11 @@ TCL_DL_LIBS='@DL_LIBS@'
 # an executable tclsh or tcltest binary.
 TCL_LD_FLAGS='@LDFLAGS@'
 
-# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
+# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
 # run-time dynamic linker where to look for shared libraries such as
 # libtcl.so.  Used when linking applications.  Only works if there
 # is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
+TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
 TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
 
 # Additional object files linked with Tcl to provide compatibility
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 7518e3e..2898db0 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -25,7 +25,8 @@
 #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
 
 /*
- * The following structure contains per-instance data for a file based channel.
+ * The following structure contains per-instance data for a file based
+ * channel.
  */
 
 typedef struct FileInfo {
@@ -96,6 +97,7 @@ static int		FileTruncateProc(ClientData instanceData,
 			    Tcl_WideInt length);
 static DWORD		FileGetType(HANDLE handle);
 static int		NativeIsComPort(const TCHAR *nativeName);
+
 /*
  * This structure describes the channel type structure for file based IO.
  */
@@ -119,6 +121,14 @@ static const Tcl_ChannelType fileChannelType = {
     FileThreadActionProc,	/* Thread action proc. */
     FileTruncateProc		/* Truncate proc. */
 };
+
+/*
+ * General useful clarification macros.
+ */
+
+#define SET_FLAG(var, flag)	((var) |= (flag))
+#define CLEAR_FLAG(var, flag)	((var) &= ~(flag))
+#define TEST_FLAG(value, flag)	(((value) & (flag)) != 0)
 
 /*
  *----------------------------------------------------------------------
@@ -140,7 +150,7 @@ static ThreadSpecificData *
 FileInit(void)
 {
     ThreadSpecificData *tsdPtr =
-	    (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+	    (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -201,7 +211,7 @@ FileSetupProc(
     Tcl_Time blockTime = { 0, 0 };
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
+    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
 	return;
     }
 
@@ -244,7 +254,7 @@ FileCheckProc(
     FileInfo *infoPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
+    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
 	return;
     }
 
@@ -255,8 +265,8 @@ FileCheckProc(
 
     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
-	    infoPtr->flags |= FILE_PENDING;
+	if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
+	    SET_FLAG(infoPtr->flags, FILE_PENDING);
 	    evPtr = ckalloc(sizeof(FileEvent));
 	    evPtr->header.proc = FileEventProc;
 	    evPtr->infoPtr = infoPtr;
@@ -296,7 +306,7 @@ FileEventProc(
     FileInfo *infoPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
+    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
 	return 0;
     }
 
@@ -310,7 +320,7 @@ FileEventProc(
     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
 	if (fileEvPtr->infoPtr == infoPtr) {
-	    infoPtr->flags &= ~(FILE_PENDING);
+	    CLEAR_FLAG(infoPtr->flags, FILE_PENDING);
 	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
 	    break;
 	}
@@ -350,9 +360,9 @@ FileBlockProc(
      */
 
     if (mode == TCL_MODE_NONBLOCKING) {
-	infoPtr->flags |= FILE_ASYNC;
+	SET_FLAG(infoPtr->flags, FILE_ASYNC);
     } else {
-	infoPtr->flags &= ~(FILE_ASYNC);
+	CLEAR_FLAG(infoPtr->flags, FILE_ASYNC);
     }
     return 0;
 }
@@ -472,7 +482,7 @@ FileSeekProc(
 
     oldPosHigh = 0;
     oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
-    if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
+    if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 
 	if (winError != NO_ERROR) {
@@ -484,7 +494,7 @@ FileSeekProc(
 
     newPosHigh = (offset < 0 ? -1 : 0);
     newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
-    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 
 	if (winError != NO_ERROR) {
@@ -547,7 +557,7 @@ FileWideSeekProc(
     newPosHigh = Tcl_WideAsLong(offset >> 32);
     newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
 	    &newPosHigh, moveMethod);
-    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 
 	if (winError != NO_ERROR) {
@@ -556,7 +566,8 @@ FileWideSeekProc(
 	    return -1;
 	}
     }
-    return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32));
+    return (((Tcl_WideInt)((unsigned)newPos))
+	    | (Tcl_LongAsWide(newPosHigh) << 32));
 }
 
 /*
@@ -589,8 +600,9 @@ FileTruncateProc(
 
     oldPosHigh = 0;
     oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
-    if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
+    if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
+
 	if (winError != NO_ERROR) {
 	    TclWinConvertError(winError);
 	    return errno;
@@ -604,8 +616,9 @@ FileTruncateProc(
     newPosHigh = Tcl_WideAsLong(length >> 32);
     newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
 	    &newPosHigh, FILE_BEGIN);
-    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
+
 	if (winError != NO_ERROR) {
 	    TclWinConvertError(winError);
 	    return errno;
@@ -662,9 +675,9 @@ FileInputProc(
     *errorCode = 0;
 
     /*
-     * TODO: This comment appears to be out of date.  We *do* have a
-     * console driver, over in tclWinConsole.c.  After some Windows
-     * developer confirms, this comment should be revised.
+     * TODO: This comment appears to be out of date. We *do* have a console
+     * driver, over in tclWinConsole.c. After some Windows developer confirms,
+     * this comment should be revised.
      *
      * Note that we will block on reads from a console buffer until a full
      * line has been entered. The only way I know of to get around this is to
@@ -721,7 +734,7 @@ FileOutputProc(
      * seek to the end of the file before writing the current buffer.
      */
 
-    if (infoPtr->flags & FILE_APPEND) {
+    if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) {
 	SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
     }
 
@@ -798,12 +811,12 @@ FileGetHandleProc(
 {
     FileInfo *infoPtr = instanceData;
 
-    if (direction & infoPtr->validMask) {
-	*handlePtr = (ClientData) infoPtr->handle;
-	return TCL_OK;
-    } else {
+    if (!TEST_FLAG(direction, infoPtr->validMask)) {
 	return TCL_ERROR;
     }
+
+    *handlePtr = (ClientData) infoPtr->handle;
+    return TCL_OK;
 }
 
 /*
@@ -843,10 +856,10 @@ TclpOpenFileChannel(
 
     nativeName = Tcl_FSGetNativePath(pathPtr);
     if (nativeName == NULL) {
-	if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_AppendResult(interp, "couldn't open \"",
-	    TclGetString(pathPtr), "\": filename is invalid on this platform",
-	    NULL);
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open \"%s\": filename is invalid on this platform",
+		    TclGetString(pathPtr)));
 	}
 	return NULL;
     }
@@ -894,39 +907,40 @@ TclpOpenFileChannel(
     }
 
     /*
-     * [2413550] Avoid double-open of serial ports on Windows
-     * Special handling for Windows serial ports by a "name-hint"
-     * to directly open it with the OVERLAPPED flag set.
+     * [2413550] Avoid double-open of serial ports on Windows.  Special
+     * handling for Windows serial ports by a "name-hint" to directly open it
+     * with the OVERLAPPED flag set.
      */
 
-    if( NativeIsComPort(nativeName) ) {
-
+    if (NativeIsComPort(nativeName)) {
 	handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
 	if (handle == INVALID_HANDLE_VALUE) {
 	    TclWinConvertError(GetLastError());
-	    if (interp != (Tcl_Interp *) NULL) {
-		Tcl_AppendResult(interp, "couldn't open serial \"",
-			TclGetString(pathPtr), "\": ",
-			Tcl_PosixError(interp), NULL);
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't open serial \"%s\": %s",
+			TclGetString(pathPtr), Tcl_PosixError(interp)));
 	    }
 	    return NULL;
 	}
 
 	/*
-	* For natively named Windows serial ports we are done.
-	*/
+	 * For natively named Windows serial ports we are done.
+	 */
+
 	channel = TclWinOpenSerialChannel(handle, channelName,
 		channelPermissions);
 
 	return channel;
     }
+
     /*
      * If the file is being created, get the file attributes from the
      * permissions argument, else use the existing file attributes.
      */
 
-    if (mode & O_CREAT) {
-	if (permissions & S_IWRITE) {
+    if (TEST_FLAG(mode, O_CREAT)) {
+	if (TEST_FLAG(permissions, S_IWRITE)) {
 	    flags = FILE_ATTRIBUTE_NORMAL;
 	} else {
 	    flags = FILE_ATTRIBUTE_READONLY;
@@ -955,10 +969,11 @@ TclpOpenFileChannel(
 	DWORD err = GetLastError();
 
 	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
-	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
+	    err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS
+		    : ERROR_FILE_NOT_FOUND;
 	}
 	TclWinConvertError(err);
-	if (interp != (Tcl_Interp *) NULL) {
+	if (interp) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "couldn't open \"%s\": %s",
 		    TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -971,9 +986,9 @@ TclpOpenFileChannel(
     switch (FileGetType(handle)) {
     case FILE_TYPE_SERIAL:
 	/*
-	 * Natively named serial ports "com1-9", "\\\\.\\comXX" are
-	 * already done with the code above.
-	 * Here we handle all other serial port names.
+	 * Natively named serial ports "com1-9", "\\\\.\\comXX" are already
+	 * done with the code above.  Here we handle all other serial port
+	 * names.
 	 *
 	 * Reopen channel for OVERLAPPED operation. Normally this shouldn't
 	 * fail, because the channel exists.
@@ -982,7 +997,7 @@ TclpOpenFileChannel(
 	handle = TclWinSerialOpen(handle, nativeName, accessMode);
 	if (handle == INVALID_HANDLE_VALUE) {
 	    TclWinConvertError(GetLastError());
-	    if (interp != (Tcl_Interp *) NULL) {
+	    if (interp) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"couldn't reopen serial \"%s\": %s",
 			TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -997,10 +1012,10 @@ TclpOpenFileChannel(
 		channelPermissions);
 	break;
     case FILE_TYPE_PIPE:
-	if (channelPermissions & TCL_READABLE) {
+	if (TEST_FLAG(channelPermissions, TCL_READABLE)) {
 	    readFile = TclWinMakeFile(handle);
 	}
-	if (channelPermissions & TCL_WRITABLE) {
+	if (TEST_FLAG(channelPermissions, TCL_WRITABLE)) {
 	    writeFile = TclWinMakeFile(handle);
 	}
 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
@@ -1009,7 +1024,8 @@ TclpOpenFileChannel(
     case FILE_TYPE_DISK:
     case FILE_TYPE_UNKNOWN:
 	channel = TclWinOpenFileChannel(handle, channelName,
-		channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0);
+		channelPermissions,
+		TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0);
 	break;
 
     default:
@@ -1074,10 +1090,10 @@ Tcl_MakeFileChannel(
 	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
 	break;
     case FILE_TYPE_PIPE:
-	if (mode & TCL_READABLE) {
+	if (TEST_FLAG(mode, TCL_READABLE)) {
 	    readFile = TclWinMakeFile(handle);
 	}
-	if (mode & TCL_WRITABLE) {
+	if (TEST_FLAG(mode, TCL_WRITABLE)) {
 	    writeFile = TclWinMakeFile(handle);
 	}
 	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
@@ -1524,10 +1540,11 @@ FileGetType(
  *
  * NativeIsComPort --
  *
- *	Determines if a path refers to a Windows serial port.
- *	A simple and efficient solution is to use a "name hint" to detect
- *      COM ports by their filename instead of resorting to a syscall
- *	to detect serialness after the fact.
+ *	Determines if a path refers to a Windows serial port.  A simple and
+ *	efficient solution is to use a "name hint" to detect COM ports by
+ *	their filename instead of resorting to a syscall to detect serialness
+ *	after the fact.
+ *
  *	The following patterns cover common serial port names:
  *	    COM[1-9]
  *	    \\.\COM[0-9]+
@@ -1549,12 +1566,12 @@ NativeIsComPort(
      * 1. Look for com[1-9]:?
      */
 
-    if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) {
+    if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) {
 	/*
-	* The 4th character must be a digit 1..9
-	*/
+	 * The 4th character must be a digit 1..9
+	 */
 
-	if ( (p[3] < L'1') || (p[3] > L'9') ) {
+	if ((p[3] < L'1') || (p[3] > L'9')) {
 	    return 0;
 	}
 	return 1;
@@ -1566,11 +1583,11 @@ NativeIsComPort(
 
     if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
 	/*
-	* Charaters 8..end must be a digits 0..9
-	*/
+	 * Charaters 8..end must be a digits 0..9
+	 */
 
-	for ( i=7; i<len; i++ ) {
-	    if ( (p[i] < '0') || (p[i] > '9') ) {
+	for (i=7; i<len; i++) {
+	    if ((p[i] < '0') || (p[i] > '9')) {
 		return 0;
 	    }
 	}
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 5ce8a2b..d148872 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -54,11 +54,7 @@ typedef struct {
     HANDLE readyEvent;		/* Manual-reset event to signal _to_ the main
 				 * thread when the worker thread has finished
 				 * waiting for its normal work to happen. */
-    HANDLE startEvent;		/* Auto-reset event used by the main thread to
-				 * signal when the thread should attempt to do
-				 * its normal work. */
-    HANDLE stopEvent;		/* Auto-reset event used by the main thread to
-				 * signal when the thread should exit. */
+    TclPipeThreadInfo *TI;	/* Thread info structure of writer and reader. */
 } ConsoleThreadInfo;
 
 /*
@@ -82,16 +78,14 @@ typedef struct ConsoleInfo {
 				 * threads. */
     ConsoleThreadInfo writer;	/* A specialized thread for handling
 				 * asynchronous writes to the console; the
-				 * waiting starts when a start event is sent,
+				 * waiting starts when a control event is sent,
 				 * and a reset event is sent back to the main
-				 * thread when the write is done. A stop event
-				 * is used to terminate the thread. */
+				 * thread when the write is done. */
     ConsoleThreadInfo reader;	/* A specialized thread for handling
 				 * asynchronous reads from the console; the
-				 * waiting starts when a start event is sent,
+				 * waiting starts when a control event is sent,
 				 * and a reset event is sent back to the main
-				 * thread when input is available. A stop
-				 * event is used to terminate the thread. */
+				 * thread when input is available. */
     DWORD writeError;		/* An error caused by the last background
 				 * write. Set to 0 if no error has been
 				 * detected. This word is shared with the
@@ -168,10 +162,6 @@ static BOOL		ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer,
 static BOOL		WriteConsoleBytes(HANDLE hConsole,
 			    const void *lpBuffer, DWORD nbytes,
 			    LPDWORD nbyteswritten);
-static void		StartChannelThread(ConsoleInfo *infoPtr,
-			    ConsoleThreadInfo *threadInfoPtr,
-			    LPTHREAD_START_ROUTINE threadProc);
-static void		StopChannelThread(ConsoleThreadInfo *threadInfoPtr);
 
 /*
  * This structure describes the channel type structure for command console
@@ -518,84 +508,6 @@ ConsoleBlockModeProc(
 /*
  *----------------------------------------------------------------------
  *
- * StartChannelThread, StopChannelThread --
- *
- *	Helpers that codify how to ask one of the console service threads to
- *	start and stop.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StartChannelThread(
-    ConsoleInfo *infoPtr,
-    ConsoleThreadInfo *threadInfoPtr,
-    LPTHREAD_START_ROUTINE threadProc)
-{
-    DWORD id;
-
-    threadInfoPtr->readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
-    threadInfoPtr->startEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
-    threadInfoPtr->stopEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
-    threadInfoPtr->thread = CreateThread(NULL, 256, threadProc, infoPtr, 0,
-	    &id);
-    SetThreadPriority(threadInfoPtr->thread, THREAD_PRIORITY_HIGHEST);
-}
-
-static void
-StopChannelThread(
-    ConsoleThreadInfo *threadInfoPtr)
-{
-    DWORD exitCode = 0;
-
-    /*
-     * The thread may already have closed on it's own. Check it's exit
-     * code.
-     */
-
-    GetExitCodeThread(threadInfoPtr->thread, &exitCode);
-    if (exitCode == STILL_ACTIVE) {
-	/*
-	 * Set the stop event so that if the reader thread is blocked in
-	 * ConsoleReaderThread on WaitForMultipleEvents, it will exit cleanly.
-	 */
-
-	SetEvent(threadInfoPtr->stopEvent);
-
-	/*
-	 * Wait at most 20 milliseconds for the reader thread to close.
-	 */
-
-	if (WaitForSingleObject(threadInfoPtr->thread, 20) == WAIT_TIMEOUT) {
-	    /*
-	     * Forcibly terminate the background thread as a last resort.
-	     * Note that we need to guard against terminating the thread while
-	     * it is in the middle of Tcl_ThreadAlert because it won't be able
-	     * to release the notifier lock.
-	     */
-
-	    Tcl_MutexLock(&consoleMutex);
-	    /* BUG: this leaks memory. */
-	    TerminateThread(threadInfoPtr->thread, 0);
-	    Tcl_MutexUnlock(&consoleMutex);
-	}
-    }
-
-    /*
-     * Close all the handles associated with the thread, and set the thread
-     * handle field to NULL to mark that the thread has been cleaned up.
-     */
-
-    CloseHandle(threadInfoPtr->thread);
-    CloseHandle(threadInfoPtr->readyEvent);
-    CloseHandle(threadInfoPtr->startEvent);
-    CloseHandle(threadInfoPtr->stopEvent);
-    threadInfoPtr->thread = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * ConsoleCloseProc --
  *
  *	Closes a console based IO channel.
@@ -626,7 +538,10 @@ ConsoleCloseProc(
      */
 
     if (consolePtr->reader.thread) {
-	StopChannelThread(&consolePtr->reader);
+	TclPipeThreadStop(&consolePtr->reader.TI, consolePtr->reader.thread);
+	CloseHandle(consolePtr->reader.thread);
+	CloseHandle(consolePtr->reader.readyEvent);
+	consolePtr->reader.thread = NULL;
     }
     consolePtr->validMask &= ~TCL_READABLE;
 
@@ -643,10 +558,13 @@ ConsoleCloseProc(
 	     * prevent infinite wait on exit. [Python Bug 216289]
 	     */
 
-	    WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE);
+	    WaitForSingleObject(consolePtr->writer.readyEvent, 5000);
 	}
 
-	StopChannelThread(&consolePtr->writer);
+	TclPipeThreadStop(&consolePtr->writer.TI, consolePtr->writer.thread);
+	CloseHandle(consolePtr->writer.thread);
+	CloseHandle(consolePtr->writer.readyEvent);
+	consolePtr->writer.thread = NULL;
     }
     consolePtr->validMask &= ~TCL_WRITABLE;
 
@@ -808,12 +726,15 @@ ConsoleOutputProc(
     int *errorCode)		/* Where to store error code. */
 {
     ConsoleInfo *infoPtr = instanceData;
-    ConsoleThreadInfo *threadInfo = &infoPtr->reader;
+    ConsoleThreadInfo *threadInfo = &infoPtr->writer;
     DWORD bytesWritten, timeout;
 
     *errorCode = 0;
-    timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
-    if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) {
+
+    /* avoid blocking if pipe-thread exited */
+    timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI)
+	|| TclInExit() || TclInThreadExit() ? 0 : INFINITE;
+    if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
 	/*
 	 * The writer thread is blocked waiting for a write to complete and
 	 * the channel is in non-blocking mode.
@@ -853,7 +774,7 @@ ConsoleOutputProc(
 	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
 	infoPtr->toWrite = toWrite;
 	ResetEvent(threadInfo->readyEvent);
-	SetEvent(threadInfo->startEvent);
+	TclPipeThreadSignal(&threadInfo->TI);
 	bytesWritten = toWrite;
     } else {
 	/*
@@ -1090,9 +1011,10 @@ WaitForRead(
 	 * Synchronize with the reader thread.
 	 */
 
-	timeout = blocking ? INFINITE : 0;
-	if (WaitForSingleObject(threadInfo->readyEvent,
-		timeout) == WAIT_TIMEOUT) {
+	/* avoid blocking if pipe-thread exited */
+	timeout = (!blocking || !TclPipeThreadIsAlive(&threadInfo->TI)
+		|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
+	if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
 	    /*
 	     * The reader thread is blocked waiting for data and the channel
 	     * is in non-blocking mode.
@@ -1152,7 +1074,7 @@ WaitForRead(
 	 */
 
 	ResetEvent(threadInfo->readyEvent);
-	SetEvent(threadInfo->startEvent);
+	TclPipeThreadSignal(&threadInfo->TI);
     }
 }
 
@@ -1179,34 +1101,27 @@ static DWORD WINAPI
 ConsoleReaderThread(
     LPVOID arg)
 {
-    ConsoleInfo *infoPtr = arg;
-    HANDLE *handle = infoPtr->handle;
-    ConsoleThreadInfo *threadInfo = &infoPtr->reader;
-    DWORD waitResult;
-    HANDLE wEvents[2];
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
+    HANDLE *handle = NULL;
+    ConsoleThreadInfo *threadInfo = NULL;
+    int done = 0;
 
-    /*
-     * The first event takes precedence.
-     */
-
-    wEvents[0] = threadInfo->stopEvent;
-    wEvents[1] = threadInfo->startEvent;
-
-    for (;;) {
+    while (!done) {
 	/*
-	 * Wait for the main thread to signal before attempting to wait.
+	 * Wait for the main thread to signal before attempting to read.
 	 */
 
-	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
-	if (waitResult != (WAIT_OBJECT_0 + 1)) {
-	    /*
-	     * The start event was not signaled. It must be the stop event or
-	     * an error, so exit this thread.
-	     */
-
+	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+	    /* exit */
 	    break;
 	}
+	if (!infoPtr) {
+	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
+	    handle = infoPtr->handle;
+	    threadInfo = &infoPtr->reader;
+	}
+
 
 	/*
 	 * Look for data on the console, but first ignore any events that are
@@ -1226,6 +1141,7 @@ ConsoleReaderThread(
 	    if (err == (DWORD) EOF) {
 		infoPtr->readFlags = CONSOLE_EOF;
 	    }
+	    done = 1;
 	}
 
 	/*
@@ -1253,6 +1169,9 @@ ConsoleReaderThread(
 	Tcl_MutexUnlock(&consoleMutex);
     }
 
+    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
+    TclPipeThreadExit(&pipeTI);
+
     return 0;
 }
 
@@ -1279,35 +1198,27 @@ static DWORD WINAPI
 ConsoleWriterThread(
     LPVOID arg)
 {
-    ConsoleInfo *infoPtr = arg;
-    HANDLE *handle = infoPtr->handle;
-    ConsoleThreadInfo *threadInfo = &infoPtr->writer;
-    DWORD count, toWrite, waitResult;
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
+    HANDLE *handle = NULL;
+    ConsoleThreadInfo *threadInfo = NULL;
+    DWORD count, toWrite;
     char *buf;
-    HANDLE wEvents[2];
-
-    /*
-     * The first event takes precedence.
-     */
+    int done = 0;
 
-    wEvents[0] = threadInfo->stopEvent;
-    wEvents[1] = threadInfo->startEvent;
-
-    for (;;) {
+    while (!done) {
 	/*
 	 * Wait for the main thread to signal before attempting to write.
 	 */
-
-	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
-	if (waitResult != (WAIT_OBJECT_0 + 1)) {
-	    /*
-	     * The start event was not signaled. It must be the stop event or
-	     * an error, so exit this thread.
-	     */
-
+	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+	    /* exit */
 	    break;
 	}
+	if (!infoPtr) {
+	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
+	    handle = infoPtr->handle;
+	    threadInfo = &infoPtr->writer;
+	}
 
 	buf = infoPtr->writeBuf;
 	toWrite = infoPtr->toWrite;
@@ -1320,6 +1231,7 @@ ConsoleWriterThread(
 	    if (WriteConsoleBytes(handle, buf, (DWORD) toWrite,
 		    &count) == FALSE) {
 		infoPtr->writeError = GetLastError();
+		done = 1;
 		break;
 	    }
 	    toWrite -= count;
@@ -1351,6 +1263,9 @@ ConsoleWriterThread(
 	Tcl_MutexUnlock(&consoleMutex);
     }
 
+    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
+    TclPipeThreadExit(&pipeTI);
+
     return 0;
 }
 
@@ -1421,11 +1336,21 @@ TclWinOpenConsoleChannel(
 	modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
 	modes |= ENABLE_LINE_INPUT;
 	SetConsoleMode(infoPtr->handle, modes);
-	StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread);
+
+	infoPtr->reader.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
+	infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread,
+		TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr,
+			infoPtr->reader.readyEvent), 0, NULL);
+	SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST);
     }
 
     if (permissions & TCL_WRITABLE) {
-	StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread);
+
+	infoPtr->writer.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
+	infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread,
+		TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr,
+			infoPtr->writer.readyEvent), 0, NULL);
+	SetThreadPriority(infoPtr->writer.thread, THREAD_PRIORITY_HIGHEST);
     }
 
     /*
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index d2ee7e1..c590865 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -76,6 +76,12 @@ typedef struct {
 #define PROCESSOR_ARCHITECTURE_UNKNOWN		0xFFFF
 #endif
 
+
+/*
+ * Windows version dependend functions
+ */
+TclWinProcs tclWinProcs;
+
 /*
  * The following arrays contain the human readable strings for the Windows
  * platform and processor values.
@@ -132,6 +138,7 @@ TclpInitPlatform(void)
 {
     WSADATA wsaData;
     WORD wVersionRequested = MAKEWORD(2, 2);
+    HMODULE handle;
 
     tclPlatform = TCL_PLATFORM_WINDOWS;
 
@@ -150,6 +157,14 @@ TclpInitPlatform(void)
 
     TclWinInit(GetModuleHandle(NULL));
 #endif
+
+    /*
+     * Fill available functions depending on windows version
+     */
+    handle = GetModuleHandle(TEXT("KERNEL32"));
+    tclWinProcs.cancelSynchronousIo =
+	    (BOOL (WINAPI *)(HANDLE)) GetProcAddress(handle,
+	    "CancelSynchronousIo");
 }
 
 /*
@@ -537,16 +552,13 @@ TclpSetVariables(
 	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
 
     if (!osInfoInitialized) {
-	HANDLE handle = LoadLibraryW(L"NTDLL");
+	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
 	int(__stdcall *getversion)(void *) =
 		(int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion");
 	osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
 	if (!getversion || getversion(&osInfo)) {
 	    GetVersionExW(&osInfo);
 	}
-	if (handle) {
-		FreeLibrary(handle);
-	}
 	osInfoInitialized = 1;
     }
     GetSystemInfo(&sys.info);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 6b098f8..43799d0 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -32,6 +32,15 @@ typedef struct TCLEXCEPTION_REGISTRATION {
 #endif
 
 /*
+ * Windows version dependend functions
+ */
+typedef struct TclWinProcs {
+    BOOL (WINAPI *cancelSynchronousIo)(HANDLE);
+} TclWinProcs;
+
+MODULE_SCOPE TclWinProcs tclWinProcs;
+
+/*
  * Some versions of Borland C have a define for the OSVERSIONINFO for
  * Win32s and for NT, but not for Windows 95.
  * Define VER_PLATFORM_WIN32_CE for those without newer headers.
@@ -86,4 +95,70 @@ MODULE_SCOPE void	TclpSetAllocCache(void *);
 #define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
 #endif
 
+/*
+ *----------------------------------------------------------------------
+ * Declarations of helper-workers threaded facilities for a pipe based channel.
+ *
+ * Corresponding functionality provided in "tclWinPipe.c".
+ *----------------------------------------------------------------------
+ */
+
+typedef struct TclPipeThreadInfo {
+    HANDLE evControl;		/* Auto-reset event used by the main thread to
+				 * signal when the pipe thread should attempt
+				 * to do read/write operation. Additionally
+				 * used as signal to stop (state set to -1) */
+    volatile LONG state;	/* Indicates current state of the thread */
+    ClientData clientData;	/* Referenced data of the main thread */
+    HANDLE evWakeUp;		/* Optional wake-up event worker set by shutdown */
+} TclPipeThreadInfo;
+
+
+/* If pipe-workers will use some tcl subsystem, we can use ckalloc without
+ * more overhead for finalize thread (should be executed anyway)
+ *
+ * #define _PTI_USE_CKALLOC 1
+ */
+
+/*
+ * State of the pipe-worker.
+ *
+ * State PTI_STATE_STOP possible from idle state only, worker owns TI structure.
+ * Otherwise PTI_STATE_END used (main thread hold ownership of the TI).
+ */
+
+#define PTI_STATE_IDLE	0	/* idle or not yet initialzed */
+#define PTI_STATE_WORK	1	/* in work */
+#define PTI_STATE_STOP	2	/* thread should stop work (owns TI structure) */
+#define PTI_STATE_END	4	/* thread should stop work (worker is busy) */
+#define PTI_STATE_DOWN  8	/* worker is down */
+
+
+MODULE_SCOPE
+TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
+			    ClientData clientData, HANDLE wakeEvent);
+MODULE_SCOPE int	TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);
+
+static inline void
+TclPipeThreadSignal(
+    TclPipeThreadInfo **pipeTIPtr)
+{
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    if (pipeTI) {
+	SetEvent(pipeTI->evControl);
+    }
+};
+
+static inline int
+TclPipeThreadIsAlive(
+    TclPipeThreadInfo **pipeTIPtr)
+{
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    return (pipeTI && pipeTI->state != PTI_STATE_DOWN);
+};
+
+MODULE_SCOPE int	TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent);
+MODULE_SCOPE void	TclPipeThreadStop(TclPipeThreadInfo **pipeTIPtr, HANDLE hThread);
+MODULE_SCOPE void	TclPipeThreadExit(TclPipeThreadInfo **pipeTIPtr);
+
 #endif	/* _TCLWININT */
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 4666deb..3e7e5eb 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -109,24 +109,17 @@ typedef struct PipeInfo {
     Tcl_ThreadId threadId;	/* Thread to which events should be reported.
 				 * This value is used by the reader/writer
 				 * threads. */
+    TclPipeThreadInfo *writeTI;	/* Thread info of writer and reader, this */
+    TclPipeThreadInfo *readTI;	/* structure owned by corresponding thread. */
     HANDLE writeThread;		/* Handle to writer thread. */
     HANDLE readThread;		/* Handle to reader thread. */
+
     HANDLE writable;		/* Manual-reset event to signal when the
 				 * writer thread has finished waiting for the
 				 * current buffer to be written. */
     HANDLE readable;		/* Manual-reset event to signal when the
 				 * reader thread has finished waiting for
 				 * input. */
-    HANDLE startWriter;		/* Auto-reset event used by the main thread to
-				 * signal when the writer thread should
-				 * attempt to write to the pipe. */
-    HANDLE stopWriter;		/* Manual-reset event used to alert the reader
-				 * thread to fall-out and exit */
-    HANDLE startReader;		/* Auto-reset event used by the main thread to
-				 * signal when the reader thread should
-				 * attempt to read from the pipe. */
-    HANDLE stopReader;		/* Manual-reset event used to alert the reader
-				 * thread to fall-out and exit */
     DWORD writeError;		/* An error caused by the last background
 				 * write. Set to 0 if no error has been
 				 * detected. This word is shared with the
@@ -1571,7 +1564,6 @@ TclpCreateCommandChannel(
     Tcl_Pid *pidPtr)		/* An array of process identifiers. */
 {
     char channelName[16 + TCL_INTEGER_SPACE];
-    DWORD id;
     PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
 
     PipeInit();
@@ -1599,13 +1591,13 @@ TclpCreateCommandChannel(
 	 */
 
 	infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
-	infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
-	infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
 	infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
-		infoPtr, 0, &id);
+	    TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable),
+	    0, NULL);
 	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
 	infoPtr->validMask |= TCL_READABLE;
     } else {
+    	infoPtr->readTI = NULL;
 	infoPtr->readThread = 0;
     }
     if (writeFile != NULL) {
@@ -1614,12 +1606,14 @@ TclpCreateCommandChannel(
 	 */
 
 	infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
-	infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
-	infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
 	infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
-		infoPtr, 0, &id);
-	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
+	    TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable),
+	    0, NULL);
+	SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
 	infoPtr->validMask |= TCL_WRITABLE;
+    } else {
+    	infoPtr->writeTI = NULL;
+    	infoPtr->writeThread = 0;
     }
 
     /*
@@ -1805,12 +1799,12 @@ PipeClose2Proc(
     int errorCode, result;
     PipeInfo *infoPtr, **nextPtrPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    DWORD exitCode;
+    int inExit = (TclInExit() || TclInThreadExit());
 
     errorCode = 0;
     result = 0;
 
-    if ((!flags || flags == TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
+    if ((!flags || flags & TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
 	/*
 	 * Clean up the background thread if necessary. Note that this must be
 	 * done before we can close the file, since the thread may be blocking
@@ -1818,55 +1812,10 @@ PipeClose2Proc(
 	 */
 
 	if (pipePtr->readThread) {
-	    /*
-	     * The thread may already have closed on its own. Check its exit
-	     * code.
-	     */
-
-	    GetExitCodeThread(pipePtr->readThread, &exitCode);
-
-	    if (exitCode == STILL_ACTIVE) {
-		/*
-		 * Set the stop event so that if the reader thread is blocked
-		 * in PipeReaderThread on WaitForMultipleEvents, it will exit
-		 * cleanly.
-		 */
-
-		SetEvent(pipePtr->stopReader);
-
-		/*
-		 * Wait at most 20 milliseconds for the reader thread to
-		 * close.
-		 */
-
-		if (WaitForSingleObject(pipePtr->readThread,
-			20) == WAIT_TIMEOUT) {
-		    /*
-		     * The thread must be blocked waiting for the pipe to
-		     * become readable in ReadFile(). There isn't a clean way
-		     * to exit the thread from this condition. We should
-		     * terminate the child process instead to get the reader
-		     * thread to fall out of ReadFile with a FALSE. (below) is
-		     * not the correct way to do this, but will stay here
-		     * until a better solution is found.
-		     *
-		     * Note that we need to guard against terminating the
-		     * thread while it is in the middle of Tcl_ThreadAlert
-		     * because it won't be able to release the notifier lock.
-		     */
-
-		    Tcl_MutexLock(&pipeMutex);
-
-		    /* BUG: this leaks memory */
-		    TerminateThread(pipePtr->readThread, 0);
-		    Tcl_MutexUnlock(&pipeMutex);
-		}
-	    }
 
+	    TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread);
 	    CloseHandle(pipePtr->readThread);
 	    CloseHandle(pipePtr->readable);
-	    CloseHandle(pipePtr->startReader);
-	    CloseHandle(pipePtr->stopReader);
 	    pipePtr->readThread = NULL;
 	}
 	if (TclpCloseFile(pipePtr->readFile) != 0) {
@@ -1875,80 +1824,34 @@ PipeClose2Proc(
 	pipePtr->validMask &= ~TCL_READABLE;
 	pipePtr->readFile = NULL;
     }
-    if ((!flags || flags & TCL_CLOSE_WRITE)
-	    && (pipePtr->writeFile != NULL)) {
+    if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) {
 	if (pipePtr->writeThread) {
+
 	    /*
 	     * Wait for the  writer thread to finish the  current buffer, then
 	     * terminate the thread  and close the handles. If  the channel is
-	     * nonblocking but blocked during  exit, bail out since the worker
+	     * nonblocking or may block during exit, bail out since the worker
 	     * thread is not interruptible and we want TIP#398-fast-exit.
 	     */
-	    if (TclInExit()
-		&& (pipePtr->flags & PIPE_ASYNC)) {
+	    if ((pipePtr->flags & PIPE_ASYNC) && inExit) {
 
 		/* give it a chance to leave honorably */
-		SetEvent(pipePtr->stopWriter);
+		TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable);
 
-		if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) {
+		if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) {
 		    return EWOULDBLOCK;
 		}
 
 	    } else {
 
-		WaitForSingleObject(pipePtr->writable, INFINITE);
+		WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE);
 
 	    }
 
-	    /*
-	     * The thread may already have closed on it's own. Check its exit
-	     * code.
-	     */
-
-	    GetExitCodeThread(pipePtr->writeThread, &exitCode);
-
-	    if (exitCode == STILL_ACTIVE) {
-		/*
-		 * Set the stop event so that if the reader thread is blocked
-		 * in PipeReaderThread on WaitForMultipleEvents, it will exit
-		 * cleanly.
-		 */
-
-		SetEvent(pipePtr->stopWriter);
-
-		/*
-		 * Wait at most 20 milliseconds for the reader thread to
-		 * close.
-		 */
+	    TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread);
 
-		if (WaitForSingleObject(pipePtr->writeThread,
-			20) == WAIT_TIMEOUT) {
-		    /*
-		     * The thread must be blocked waiting for the pipe to
-		     * consume input in WriteFile(). There isn't a clean way
-		     * to exit the thread from this condition. We should
-		     * terminate the child process instead to get the writer
-		     * thread to fall out of WriteFile with a FALSE. (below)
-		     * is not the correct way to do this, but will stay here
-		     * until a better solution is found.
-		     *
-		     * Note that we need to guard against terminating the
-		     * thread while it is in the middle of Tcl_ThreadAlert
-		     * because it won't be able to release the notifier lock.
-		     */
-
-		    Tcl_MutexLock(&pipeMutex);
-
-		    /* BUG: this leaks memory */
-		    TerminateThread(pipePtr->writeThread, 0);
-		    Tcl_MutexUnlock(&pipeMutex);
-		}
-	    }
-
-	    CloseHandle(pipePtr->writeThread);
 	    CloseHandle(pipePtr->writable);
-	    CloseHandle(pipePtr->startWriter);
-	    CloseHandle(pipePtr->stopWriter);
+	    CloseHandle(pipePtr->writeThread);
 	    pipePtr->writeThread = NULL;
 	}
 	if (TclpCloseFile(pipePtr->writeFile) != 0) {
@@ -1983,7 +1886,7 @@ PipeClose2Proc(
 	}
     }
 
-    if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
+    if ((pipePtr->flags & PIPE_ASYNC) || inExit) {
 	/*
 	 * If the channel is non-blocking or Tcl is being cleaned up, just
 	 * detach the children PIDs, reap them (important if we are in a
@@ -2161,7 +2064,10 @@ PipeOutputProc(
     DWORD bytesWritten, timeout;
 
     *errorCode = 0;
-    timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
+
+    /* avoid blocking if pipe-thread exited */
+    timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI)
+	|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
     if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
 	/*
 	 * The writer thread is blocked waiting for a write to complete and
@@ -2202,7 +2108,7 @@ PipeOutputProc(
 	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
 	infoPtr->toWrite = toWrite;
 	ResetEvent(infoPtr->writable);
-	SetEvent(infoPtr->startWriter);
+	TclPipeThreadSignal(&infoPtr->writeTI);
 	bytesWritten = toWrite;
     } else {
 	/*
@@ -2712,7 +2618,9 @@ WaitForRead(
 	 * Synchronize with the reader thread.
 	 */
 
-	timeout = blocking ? INFINITE : 0;
+	/* avoid blocking if pipe-thread exited */
+	timeout = (!blocking || !TclPipeThreadIsAlive(&infoPtr->readTI)
+		|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
 	if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
 	    /*
 	     * The reader thread is blocked waiting for data and the channel
@@ -2786,7 +2694,7 @@ WaitForRead(
 	 */
 
 	ResetEvent(infoPtr->readable);
-	SetEvent(infoPtr->startReader);
+	TclPipeThreadSignal(&infoPtr->readTI);
     }
 }
 
@@ -2814,33 +2722,27 @@ static DWORD WINAPI
 PipeReaderThread(
     LPVOID arg)
 {
-    PipeInfo *infoPtr = (PipeInfo *)arg;
-    HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
+    HANDLE handle = NULL;
     DWORD count, err;
     int done = 0;
-    HANDLE wEvents[2];
-    DWORD waitResult;
-
-    wEvents[0] = infoPtr->stopReader;
-    wEvents[1] = infoPtr->startReader;
 
     while (!done) {
 	/*
 	 * Wait for the main thread to signal before attempting to wait on the
 	 * pipe becoming readable.
 	 */
-
-	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
-	if (waitResult != (WAIT_OBJECT_0 + 1)) {
-	    /*
-	     * The start event was not signaled. It might be the stop event or
-	     * an error, so exit.
-	     */
-
+	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+	    /* exit */
 	    break;
 	}
 
+	if (!infoPtr) {
+	    infoPtr = (PipeInfo *)pipeTI->clientData;
+	    handle = ((WinFile *) infoPtr->readFile)->handle;
+	}
+
 	/*
 	 * Try waiting for 0 bytes. This will block until some data is
 	 * available on NT, but will return immediately on Win 95. So, if no
@@ -2860,7 +2762,7 @@ PipeReaderThread(
 		infoPtr->readFlags |= PIPE_EOF;
 		done = 1;
 	    } else if (err == ERROR_INVALID_HANDLE) {
-		break;
+		done = 1;
 	    }
 	} else if (count == 0) {
 	    if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
@@ -2882,12 +2784,11 @@ PipeReaderThread(
 		    infoPtr->readFlags |= PIPE_EOF;
 		    done = 1;
 		} else if (err == ERROR_INVALID_HANDLE) {
-		    break;
+		    done = 1;
 		}
 	    }
 	}
 
-
 	/*
 	 * Signal the main thread by signalling the readable event and then
 	 * waking up the notifier thread.
@@ -2913,6 +2814,12 @@ PipeReaderThread(
 	Tcl_MutexUnlock(&pipeMutex);
     }
 
+    /*
+     * If state of thread was set to stop, we can sane free info structure,
+     * otherwise it is shared with main thread, so main thread will own it
+     */
+    TclPipeThreadExit(&pipeTI);
+
     return 0;
 }
 
@@ -2937,37 +2844,27 @@ static DWORD WINAPI
 PipeWriterThread(
     LPVOID arg)
 {
-    PipeInfo *infoPtr = (PipeInfo *)arg;
-    HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
+    HANDLE handle = NULL;
     DWORD count, toWrite;
     char *buf;
     int done = 0;
-    HANDLE wEvents[2];
-    DWORD waitResult;
-
-    wEvents[0] = infoPtr->stopWriter;
-    wEvents[1] = infoPtr->startWriter;
 
     while (!done) {
 	/*
 	 * Wait for the main thread to signal before attempting to write.
 	 */
-
-	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
-	if (waitResult != (WAIT_OBJECT_0 + 1)) {
-	    /*
-	     * The start event was not signaled. It might be the stop event or
-	     * an error, so exit.
-	     */
-
-	    if (waitResult == WAIT_OBJECT_0) {
-		SetEvent(infoPtr->writable);
-	    }
-
+	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+	    /* exit */
 	    break;
 	}
 
+	if (!infoPtr) {
+	    infoPtr = (PipeInfo *)pipeTI->clientData;
+	    handle = ((WinFile *) infoPtr->writeFile)->handle;
+	}
+
 	buf = infoPtr->writeBuf;
 	toWrite = infoPtr->toWrite;
 
@@ -3011,6 +2908,12 @@ PipeWriterThread(
 	Tcl_MutexUnlock(&pipeMutex);
     }
 
+    /*
+     * If state of thread was set to stop, we can sane free info structure,
+     * otherwise it is shared with main thread, so main thread will own it.
+     */
+    TclPipeThreadExit(&pipeTI);
+
     return 0;
 }
 
@@ -3159,6 +3062,396 @@ TclpOpenTemporaryFile(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadCreateTI --
+ *
+ *	Creates a thread info structure, can be owned by worker.
+ *
+ * Results:
+ *	Pointer to created TI structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclPipeThreadInfo *
+TclPipeThreadCreateTI(
+    TclPipeThreadInfo **pipeTIPtr,
+    ClientData clientData,
+    HANDLE wakeEvent)
+{
+    TclPipeThreadInfo *pipeTI;
+#ifndef _PTI_USE_CKALLOC
+    pipeTI = malloc(sizeof(TclPipeThreadInfo));
+#else
+    pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
+#endif
+    pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
+    pipeTI->state = PTI_STATE_IDLE;
+    pipeTI->clientData = clientData;
+    pipeTI->evWakeUp = wakeEvent;
+    return (*pipeTIPtr = pipeTI);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadWaitForSignal --
+ *
+ *	Wait for work/stop signals inside pipe worker.
+ *
+ * Results:
+ *	1 if signaled to work, 0 if signaled to stop.
+ *
+ * Side effects:
+ *	If this function returns 0, TI-structure pointer given via pipeTIPtr
+ *	may be NULL, so not accessible (can be owned by main thread).
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPipeThreadWaitForSignal(
+    TclPipeThreadInfo **pipeTIPtr)
+{
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    LONG state;
+    DWORD waitResult;
+    HANDLE wakeEvent;
+
+    if (!pipeTI) {
+	return 0;
+    }
+
+    wakeEvent = pipeTI->evWakeUp;
+    /*
+     * Wait for the main thread to signal before attempting to do the work.
+     */
+
+    /* reset work state of thread (idle/waiting) */
+    if ((state = InterlockedCompareExchange(&pipeTI->state,
+	    PTI_STATE_IDLE, PTI_STATE_WORK)) & (PTI_STATE_STOP|PTI_STATE_END)) {
+	/* end of work, check the owner of structure */
+	goto end;
+    }
+    /* entering wait */
+    waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
+
+    if (waitResult != WAIT_OBJECT_0) {
+
+	/*
+	 * The control event was not signaled, so end of work (unexpected
+	 * behaviour, main thread can be dead?).
+	 */
+	goto end;
+    }
+
+    /* try to set work state of thread */
+    if ((state = InterlockedCompareExchange(&pipeTI->state,
+	    PTI_STATE_WORK, PTI_STATE_IDLE)) & (PTI_STATE_STOP|PTI_STATE_END)) {
+	/* end of work */
+	goto end;
+    }
+
+    /* signaled to work */
+    return 1;
+
+end:
+    /* end of work, check the owner of the TI structure */
+    if (state != PTI_STATE_STOP) {
+	*pipeTIPtr = NULL;
+    } else {
+    	pipeTI->evWakeUp = NULL;
+    }
+    if (wakeEvent) {
+    	SetEvent(wakeEvent);
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadStopSignal --
+ *
+ *	Send stop signal to the pipe worker (without waiting).
+ *
+ *	After calling of this function, TI-structure pointer given via pipeTIPtr
+ *	may be NULL.
+ *
+ * Results:
+ *	1 if signaled (or pipe-thread is down), 0 if pipe thread still working.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPipeThreadStopSignal(
+    TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent)
+{
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    HANDLE evControl;
+    int state;
+
+    if (!pipeTI) {
+	return 1;
+    }
+    evControl = pipeTI->evControl;
+    pipeTI->evWakeUp = wakeEvent;
+    switch (
+	(state = InterlockedCompareExchange(&pipeTI->state,
+	    PTI_STATE_STOP, PTI_STATE_IDLE))
+    ) {
+
+	case PTI_STATE_IDLE:
+
+	    /* Thread was idle/waiting, notify it goes teardown */
+	    SetEvent(evControl);
+
+	    *pipeTIPtr = NULL;
+
+	case PTI_STATE_DOWN:
+
+	return 1;
+
+	default:
+	    /*
+	     * Thread works currently, we should try to end it, own the TI structure
+	     * (because of possible sharing the joint structures with thread)
+	     */
+	    InterlockedExchange(&pipeTI->state, PTI_STATE_END);
+	break;
+    }
+
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadStop --
+ *
+ *	Send stop signal to the pipe worker and wait for thread completion.
+ *
+ *	May be combined with TclPipeThreadStopSignal.
+ *
+ *	After calling of this function, TI-structure pointer given via pipeTIPtr
+ *	is not accessible (owned by pipe worker or released here).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Can terminate pipe worker (and / or stop its synchronous operations).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPipeThreadStop(
+    TclPipeThreadInfo **pipeTIPtr,
+    HANDLE hThread)
+{
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    HANDLE evControl, wakeEvent;
+    int state;
+
+    if (!pipeTI) {
+	return;
+    }
+    pipeTI = *pipeTIPtr;
+    evControl = pipeTI->evControl;
+    wakeEvent = pipeTI->evWakeUp;
+    pipeTI->evWakeUp = NULL;
+    /*
+     * Try to sane stop the pipe worker, corresponding its current state
+     */
+    switch (
+	(state = InterlockedCompareExchange(&pipeTI->state,
+	    PTI_STATE_STOP, PTI_STATE_IDLE))
+    ) {
+
+	case PTI_STATE_IDLE:
+
+	    /* Thread was idle/waiting, notify it goes teardown */
+	    SetEvent(evControl);
+
+	    /* we don't need to wait for it at all, thread frees himself (owns the TI structure) */
+	    pipeTI = NULL;
+	break;
+
+	case PTI_STATE_STOP:
+	    /* already stopped, thread frees himself (owns the TI structure) */
+	    pipeTI = NULL;
+	break;
+	case PTI_STATE_DOWN:
+	    /* Thread already down (?), do nothing */
+
+	    /* we don't need to wait for it, but we should free pipeTI */
+	    hThread = NULL;
+	break;
+
+	/* case PTI_STATE_WORK: */
+	default:
+	    /*
+	     * Thread works currently, we should try to end it, own the TI structure
+	     * (because of possible sharing the joint structures with thread)
+	     */
+	    if ((state = InterlockedCompareExchange(&pipeTI->state,
+		    PTI_STATE_END, PTI_STATE_WORK)) == PTI_STATE_DOWN
+	    ) {
+		/* we don't need to wait for it, but we should free pipeTI */
+		hThread = NULL;
+	    };
+	break;
+    }
+
+    if (pipeTI && hThread) {
+	DWORD exitCode;
+
+	/*
+	 * The thread may already have closed on its own. Check its exit
+	 * code.
+	 */
+
+	GetExitCodeThread(hThread, &exitCode);
+
+	if (exitCode == STILL_ACTIVE) {
+
+	    int inExit = (TclInExit() || TclInThreadExit());
+	    /*
+	     * Set the stop event so that if the pipe thread is blocked
+	     * somewhere, it may hereafter sane exit cleanly.
+	     */
+
+	    SetEvent(evControl);
+
+	    /*
+	     * Cancel all sync-IO of this thread (may be blocked there).
+	     */
+	    if (tclWinProcs.cancelSynchronousIo) {
+		tclWinProcs.cancelSynchronousIo(hThread);
+	    }
+
+	    /*
+	     * Wait at most 20 milliseconds for the reader thread to
+	     * close (regarding TIP#398-fast-exit).
+	     */
+
+	    /* if we want TIP#398-fast-exit. */
+	    if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
+
+		/*
+		 * The thread must be blocked waiting for the pipe to
+		 * become readable in ReadFile(). There isn't a clean way
+		 * to exit the thread from this condition. We should
+		 * terminate the child process instead to get the reader
+		 * thread to fall out of ReadFile with a FALSE. (below) is
+		 * not the correct way to do this, but will stay here
+		 * until a better solution is found.
+		 *
+		 * Note that we need to guard against terminating the
+		 * thread while it is in the middle of Tcl_ThreadAlert
+		 * because it won't be able to release the notifier lock.
+		 *
+		 * Also note that terminating threads during their initialization or teardown phase
+		 * may result in ntdll.dll's LoaderLock to remain locked indefinitely.
+		 * This causes ntdll.dll's LdrpInitializeThread() to deadlock trying to acquire LoaderLock.
+		 * LdrpInitializeThread() is executed within new threads to perform
+		 * initialization and to execute DllMain() of all loaded dlls.
+		 * As a result, all new threads are deadlocked in their initialization phase and never execute,
+		 * even though CreateThread() reports successful thread creation.
+		 * This results in a very weird process-wide behavior, which is extremely hard to debug.
+		 *
+		 * THREADS SHOULD NEVER BE TERMINATED. Period.
+		 *
+		 * But for now, check if thread is exiting, and if so, let it die peacefully.
+		 *
+		 * Also don't terminate if in exit (otherwise deadlocked in ntdll.dll's).
+		 */
+
+		if ( pipeTI->state != PTI_STATE_DOWN
+		  && WaitForSingleObject(hThread,
+			inExit ? 50 : 5000) != WAIT_OBJECT_0
+		) {
+		    /* BUG: this leaks memory */
+		    if (inExit || !TerminateThread(hThread, 0)) {
+			/* in exit or terminate fails, just give thread a chance to exit */
+			if (InterlockedExchange(&pipeTI->state,
+				PTI_STATE_STOP) != PTI_STATE_DOWN) {
+			    pipeTI = NULL;
+			}
+		    };
+		}
+	    }
+	}
+    }
+
+    *pipeTIPtr = NULL;
+    if (pipeTI) {
+	if (pipeTI->evWakeUp) {
+	    SetEvent(pipeTI->evWakeUp);
+	}
+	CloseHandle(pipeTI->evControl);
+    #ifndef _PTI_USE_CKALLOC
+	free(pipeTI);
+    #else
+	ckfree(pipeTI);
+    #endif
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPipeThreadExit --
+ *
+ *	Clean-up for the pipe thread (removes owned TI-structure in worker).
+ *
+ *	Should be executed on worker exit, to inform the main thread or
+ *	free TI-structure (if owned).
+ *
+ *	After calling of this function, TI-structure pointer given via pipeTIPtr
+ *	is not accessible (owned by main thread or released here).
+ *
+ * Results:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPipeThreadExit(
+    TclPipeThreadInfo **pipeTIPtr)
+{
+    LONG state;
+    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+    /*
+     * If state of thread was set to stop (exactly), we can sane free its info
+     * structure, otherwise it is shared with main thread, so main thread will
+     * own it.
+     */
+    if (!pipeTI) {
+	return;
+    }
+    *pipeTIPtr = NULL;
+    if ((state = InterlockedExchange(&pipeTI->state,
+	    PTI_STATE_DOWN)) == PTI_STATE_STOP) {
+	CloseHandle(pipeTI->evControl);
+	if (pipeTI->evWakeUp) {
+	    SetEvent(pipeTI->evWakeUp);
+	}
+    #ifndef _PTI_USE_CKALLOC
+	free(pipeTI);
+    #else
+	ckfree(pipeTI);
+	/* be sure all subsystems used are finalized */
+	Tcl_FinalizeThread();
+    #endif
+    }
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 5f7fd31..de48b9b 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -1197,14 +1197,12 @@ RecursiveDeleteKey(
 	     */
 
 	    if (mode && !checkExProc) {
-		HINSTANCE dllH;
+		HMODULE handle;
 
 		checkExProc = 1;
-		dllH = LoadLibrary(TEXT("advapi32.dll"));
-		if (dllH) {
-		    regDeleteKeyExProc = (FARPROC)
-			    GetProcAddress(dllH, "RegDeleteKeyExW");
-		}
+		handle = GetModuleHandle(TEXT("ADVAPI32"));
+		regDeleteKeyExProc = (FARPROC)
+			GetProcAddress(handle, "RegDeleteKeyExW");
 	    }
 	    if (mode && regDeleteKeyExProc) {
 		result = regDeleteKeyExProc(startKey, keyName, mode, 0);
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 0ce5f4d..ed1a8e5 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -93,17 +93,12 @@ typedef struct SerialInfo {
 				 * threads. */
     OVERLAPPED osRead;		/* OVERLAPPED structure for read operations. */
     OVERLAPPED osWrite;		/* OVERLAPPED structure for write operations */
+    TclPipeThreadInfo *writeTI;	/* Thread info structure of writer worker. */
     HANDLE writeThread;		/* Handle to writer thread. */
     CRITICAL_SECTION csWrite;	/* Writer thread synchronisation. */
     HANDLE evWritable;		/* Manual-reset event to signal when the
 				 * writer thread has finished waiting for the
 				 * current buffer to be written. */
-    HANDLE evStartWriter;	/* Auto-reset event used by the main thread to
-				 * signal when the writer thread should
-				 * attempt to write to the serial. */
-    HANDLE evStopWriter;	/* Auto-reset event used by the main thread to
-				 * signal when the writer thread should close.
-				 */
     DWORD writeError;		/* An error caused by the last background
 				 * write. Set to 0 if no error has been
 				 * detected. This word is shared with the
@@ -599,7 +594,6 @@ SerialCloseProc(
     int errorCode, result = 0;
     SerialInfo *infoPtr, **nextPtrPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    DWORD exitCode;
 
     errorCode = 0;
 
@@ -609,56 +603,13 @@ SerialCloseProc(
     }
     serialPtr->validMask &= ~TCL_READABLE;
 
-    if (serialPtr->validMask & TCL_WRITABLE) {
-	/*
-	 * Generally we cannot wait for a pending write operation because it
-	 * may hang due to handshake
-	 *    WaitForSingleObject(serialPtr->evWritable, INFINITE);
-	 */
-
-	/*
-	 * The thread may have already closed on it's own. Check it's exit
-	 * code.
-	 */
-
-	GetExitCodeThread(serialPtr->writeThread, &exitCode);
-
-	if (exitCode == STILL_ACTIVE) {
-	    /*
-	     * Set the stop event so that if the writer thread is blocked in
-	     * SerialWriterThread on WaitForMultipleEvents, it will exit
-	     * cleanly.
-	     */
-
-	    SetEvent(serialPtr->evStopWriter);
-
-	    /*
-	     * Wait at most 20 milliseconds for the writer thread to close.
-	     */
-
-	    if (WaitForSingleObject(serialPtr->writeThread,
-		    20) == WAIT_TIMEOUT) {
-		/*
-		 * Forcibly terminate the background thread as a last resort.
-		 * Note that we need to guard against terminating the thread
-		 * while it is in the middle of Tcl_ThreadAlert because it
-		 * won't be able to release the notifier lock.
-		 */
+    if (serialPtr->writeThread) {
 
-		Tcl_MutexLock(&serialMutex);
+    	TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
 
-		/* BUG: this leaks memory */
-		TerminateThread(serialPtr->writeThread, 0);
-
-		Tcl_MutexUnlock(&serialMutex);
-	    }
-	}
-
-	CloseHandle(serialPtr->writeThread);
 	CloseHandle(serialPtr->osWrite.hEvent);
 	CloseHandle(serialPtr->evWritable);
-	CloseHandle(serialPtr->evStartWriter);
-	CloseHandle(serialPtr->evStopWriter);
+	CloseHandle(serialPtr->writeThread);
 	serialPtr->writeThread = NULL;
 
 	PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
@@ -1076,7 +1027,7 @@ SerialOutputProc(
 	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
 	infoPtr->toWrite = toWrite;
 	ResetEvent(infoPtr->evWritable);
-	SetEvent(infoPtr->evStartWriter);
+	TclPipeThreadSignal(&infoPtr->writeTI);
 	bytesWritten = (DWORD) toWrite;
 
     } else {
@@ -1313,34 +1264,21 @@ static DWORD WINAPI
 SerialWriterThread(
     LPVOID arg)
 {
-    SerialInfo *infoPtr = (SerialInfo *)arg;
-    DWORD bytesWritten, toWrite, waitResult;
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    SerialInfo *infoPtr = NULL; /* access info only after success init/wait */
+    DWORD bytesWritten, toWrite;
     char *buf;
     OVERLAPPED myWrite;		/* Have an own OVERLAPPED in this thread. */
-    HANDLE wEvents[2];
-
-    /*
-     * The stop event takes precedence by being first in the list.
-     */
-
-    wEvents[0] = infoPtr->evStopWriter;
-    wEvents[1] = infoPtr->evStartWriter;
 
     for (;;) {
 	/*
 	 * Wait for the main thread to signal before attempting to write.
 	 */
-
-	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
-
-	if (waitResult != (WAIT_OBJECT_0 + 1)) {
-	    /*
-	     * The start event was not signaled. It might be the stop event or
-	     * an error, so exit.
-	     */
-
+	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
+	    /* exit */
 	    break;
 	}
+	infoPtr = (SerialInfo *)pipeTI->clientData;
 
 	buf = infoPtr->writeBuf;
 	toWrite = infoPtr->toWrite;
@@ -1404,6 +1342,9 @@ SerialWriterThread(
 	Tcl_MutexUnlock(&serialMutex);
     }
 
+    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
+    TclPipeThreadExit(&pipeTI);
+
     return 0;
 }
 
@@ -1477,7 +1418,6 @@ TclWinOpenSerialChannel(
     int permissions)
 {
     SerialInfo *infoPtr;
-    DWORD id;
 
     SerialInit();
 
@@ -1529,10 +1469,9 @@ TclWinOpenSerialChannel(
 
 	infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
 	infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
-	infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
-	infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
 	infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
-		infoPtr, 0, &id);
+		TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
+			infoPtr->evWritable), 0, NULL);
     }
 
     /*