Tcl Source Code

    for (i=3 ; i<numWords ; i++,tokenPtr=TokenAfter(tokenPtr)) {
	PUSH_TOKEN(		tokenPtr, i);
    }

    /*
     * First operand is count of arguments.
     * Second operand is bitmask
     *  TCL_LREPLACE_END_IS_LAST - end refers to last element
     *  TCL_LREPLACE_SINGLE_INDEX - second index is not present
     *     indicating this is a pure insert
     */
    OP41(			LREPLACE, numWords - 1,
					TCL_LREPLACE_SINGLE_INDEX);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLreplaceCmd --

    for (i=4; i<numWords; i++,tokenPtr=TokenAfter(tokenPtr)) {
	PUSH_TOKEN(		tokenPtr, i);
    }

    /*
     * First operand is count of arguments.
     * Second operand is bitmask
     *  TCL_LREPLACE_END_IS_LAST - end refers to last element
     */
    OP41(			LREPLACE, numWords - 1,
					TCL_LREPLACE_END_IS_LAST);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLeditCmd --

	OP(			SWAP);
    }
    // Stack: varWords... listValue idx1 idx2 values...

    /*
     * First operand is count of arguments.
     * Second operand is bitmask
     *  TCL_LREPLACE_END_IS_LAST - end refers to last element
     */
    OP41(			LREPLACE, numWords - 1,
					TCL_LREPLACE_END_IS_LAST);
    // Stack: varWords... listValue

    /*
     * Write back the updated value. We've prepped the stack exactly right for
     * this to be something we can Just Do at this point.
     */

	} else {
	    PUSH(		"end");
	}
    }
    // Stack: value list index
    OP(				DUP);
    // Stack: value list index index
    OP41(			LREPLACE, 3, TCL_LREPLACE_END_IS_LAST
					| TCL_LREPLACE_NEED_IN_RANGE);
    // Stack: value newList
    OP4(			STORE_SCALAR, varIdx);
    OP(				POP);
    // Stack: value

    return TCL_OK;
}

	/* String Less or equal:	push (stknext <= stktop) */
    TCL_INSTRUCTION_ENTRY(
	"strge",		-1),
	/* String Greater or equal:	push (stknext >= stktop) */
    TCL_INSTRUCTION_ENTRY2(
	"lreplace",	  6,	INT_MIN,  OPERAND_UINT4, OPERAND_LRPL1),
	/* Operands: number of arguments, flags
	 * flags: Combination of TCL_LREPLACE_* flags
	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj
	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
	 * set in flags. */

    TCL_INSTRUCTION_ENTRY1(
	"constImm",	  5,	-1,	  OPERAND_LVT4),
	/* Create constant. Index into LVT is immediate, value is on stack.

    OPERAND_LIT1,		/* One byte unsigned index into table of
				 * literals. */
    OPERAND_LIT4,		/* Four byte unsigned index into table of
				 * literals. */
    OPERAND_SCLS1,		/* Index into tclStringClassTable. */
    OPERAND_UNSF1,		/* Flags for [unset] */
    OPERAND_CLK1,		/* Index into [clock] types. */
    OPERAND_LRPL1		/* Combination of TCL_LREPLACE_* flags. */
} InstOperandType;

typedef struct InstructionDesc {
    const char *name;		/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
				 * instruction, used for stack requirements

    TCL_NO_ELEMENT = 2		/* Do not push the array element. */
};

/*
 * Flags bits used by lreplace4 instruction
 */
enum Lreplace4Flags {
    TCL_LREPLACE_END_IS_LAST = 1,	/* "end" refers to last element */
    TCL_LREPLACE_SINGLE_INDEX = 2,	/* Second index absent (pure insert) */
    TCL_LREPLACE_NEED_IN_RANGE = 4	/* First index must resolve to real list index */
};

/*
 * Helper functions for jump tables that call other internal API bits.
 */

static inline Tcl_Size

	case OPERAND_LRPL1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    switch (opnd) {
	    case 0:
		Tcl_AppendPrintfToObj(bufferObj, "0 ");
		break;
	    case TCL_LREPLACE_END_IS_LAST:
		Tcl_AppendPrintfToObj(bufferObj, "endLast ");
		break;
	    case TCL_LREPLACE_SINGLE_INDEX:
		Tcl_AppendPrintfToObj(bufferObj, "singleIdx ");
		break;
	    case TCL_LREPLACE_END_IS_LAST | TCL_LREPLACE_NEED_IN_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "endLast,indexTest ");
		break;
	    default:
		Tcl_AppendPrintfToObj(bufferObj, "endLast,singleIdx ");
		break;
	    }
	    break;

	numArgs = TclGetUInt4AtPtr(pc + 1);
	int flags = TclGetInt1AtPtr(pc + 5);

	/* Stack: ... listobj index1 ?index2? new1 ... newN */
	valuePtr = OBJ_AT_DEPTH(numArgs - 1);

	/* haveSecondIndex==0 => pure insert */
	int haveSecondIndex = (flags & TCL_LREPLACE_SINGLE_INDEX) == 0;
	size_t numNewElems = numArgs - 2 - haveSecondIndex;

	/* end_indicator==1 => "end" is last element's index, 0=>index beyond */
	int endIndicator = (flags & TCL_LREPLACE_END_IS_LAST) != 0;
	Tcl_Obj *fromIdxObj = OBJ_AT_DEPTH(numArgs - 2);
	Tcl_Obj *toIdxObj = haveSecondIndex ? OBJ_AT_DEPTH(numArgs - 3) : NULL;
	if (Tcl_ListObjLength(interp, valuePtr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, fromIdxObj, length - endIndicator,
		&fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (flags & TCL_LREPLACE_NEED_IN_RANGE) {
	    if (fromIdx < 0 || fromIdx >= length) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range", Tcl_GetString(fromIdxObj)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE",
			(char *)NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);

# Encoding file: cp165, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00200021002200230024066A0026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00B000B72219221A259225002502253C2524252C251C25342510250C25142518
03B2221E03C600B100BD00BC224800AB00BBFEF7FEF8FEF9FEFAFEFBFEFCFE73
00A000ADFE8200A300A4FE84FE87FE88FE8EFE8FFE95FE99060CFE9DFEA1FEA5
0660066106620663066406650666066706680669FED1061BFEB1FEB5FEB9061F
00A2FE80FE81FE83FE85FECAFE8BFE8DFE91FE93FE97FE9BFE9FFEA3FEA7FEA9
FEABFEADFEAFFEB3FEB7FEBBFEBFFEC1FEC5FECBFECF00A600AC00F700D7FEC9
0640FED3FED7FEDBFEDFFEE3FEE7FEEBFEEDFEEFFEF3FEBDFECCFECEFECDFEE1
FE7D0651FEE5FEE9FEECFEF0FEF2FED0FED5FEF5FEF6FEDDFED9FEF125A000A0

# Encoding file: cp864, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00200021002200230024066A0026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00B000B72219221A259225002502253C2524252C251C25342510250C25142518
03B2221E03C600B100BD00BC224800AB00BBFEF7FEF800000000FEFBFEFCFE73
00A000ADFE8200A300A4FE84000020ACFE8EFE8FFE95FE99060CFE9DFEA1FEA5
0660066106620663066406650666066706680669FED1061BFEB1FEB5FEB9061F
00A2FE80FE81FE83FE85FECAFE8BFE8DFE91FE93FE97FE9BFE9FFEA3FEA7FEA9
FEABFEADFEAFFEB3FEB7FEBBFEBFFEC1FEC5FECBFECF00A600AC00F700D7FEC9
0640FED3FED7FEDBFEDFFEE3FEE7FEEBFEEDFEEFFEF3FEBDFECCFECEFECDFEE1
FE7D0651FEE5FEE9FEECFEF0FEF2FED0FED5FEF5FEF6FEDDFED9FEF125A00000

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint noappverifier [expr {
        [llength [info commands testappverifierpresent]] == 0
        || ![testappverifierpresent]}]

test exit-1.1 {normal, quick exit} -constraints noappverifier -body {
    set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
    set aft [after 1000 {set done "Quick exit hangs !!!"}]
    fileevent $f readable {after cancel $aft;set done OK}
    vwait done
    if {$done != "OK"} {
	fconfigure $f -blocking 0
	close $f
    } else {
	if {[catch {close $f} err]} {
	    set done "Quick exit misbehaves: $err"
	}
    }
    set done
} -result OK

test exit-1.2 {full-finalized exit} -constraints noappverifier -body {
    set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r]
    set aft [after 1000 {set done "Full-finalized exit hangs !!!"}]
    fileevent $f readable {after cancel $aft;set done OK}
    vwait done
    if {$done != "OK"} {
	fconfigure $f -blocking 0
	close $f
    } else {
	if {[catch {close $f} err]} {
	    set done "Full-finalized exit misbehaves: $err"
	}
    }
    set done
} -result OK


# cleanup
::tcltest::cleanupTests
return

# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint noappverifier [expr {
        [llength [info commands testappverifierpresent]] == 0
        || ![testappverifierpresent]}]

namespace eval ::tcl::test::io {

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
    update
    variable x {}
} -constraints {stdio fileevent noappverifier} -body {
    set f [openpipe w+ $path(cat)]
    chan configure $f -buffering none
    chan puts -nonewline $f "foobar"
    chan configure $f -blocking 0
    after 500 [namespace code {
	lappend x timeout
    }]

    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\nfgh"
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
    variable x {}
    variable y {}
} -constraints {stdio testchannel fileevent noappverifier} -body {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.
    set f [openpipe w+ $path(cat)]
    chan configure $f -blocking 0 -buffering none -translation {auto lf}
    chan event $f read [namespace code {
	lappend x [chan read $f] [testchannel queuedcr $f]
    }]

    set cat [makeFile {
	fconfigure stdout -buffering line
	while {[gets stdin line] >= 0} {puts $line}
	puts DONE
	exit 0
    } cat.tcl]
    variable done
} -constraints noappverifier -body {
    set ff [openpipe r+ $cat]
    puts $ff Hey
    close $ff w
    set timer [after 1000 [namespace code {set done Failed}]]
    set acc {}
    fileevent $ff readable [namespace code {
	if {[gets $ff line] < 0} {

    if {[catch {
	    ::tcltest::loadTestedCommands
	}]} {
	# nothing to be done (registry loaded on demand)
    }
}

# Application Verifier hooks system calls in a way that locale
# detection fails. Disable tests that depend on that if
# it is running.
testConstraint noappverifier [expr {
        [llength [info commands testappverifierpresent]] == 0
        || ![testappverifierpresent]}]

package require msgcat 1.4

testConstraint detroit \
    [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
    [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]

    rename test_add_dst {}
} -result {}

# END testcases30


test clock-31.1 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches

	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%d-%b-%Y}]

test clock-31.2 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches

	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {the %d' day of %B %Y}]

test clock-31.3 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches

	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%l:%M:%S %p}]

test clock-31.4 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {

	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]

test clock-31.5 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {

	}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {the %d' day of %B %Y}]

test clock-31.6 {system locale} \
    -constraints {win noappverifier} \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {

	    clock format -86400 -timezone :localtime -format %Y
	} result] $result
    } \
    -match regexp \
    -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}

test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
    -constraints {win noappverifier} \
    -setup {
	# override the registry so that the test takes place in New York time
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}

# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint noappverifier [expr {
        [llength [info commands testappverifierpresent]] == 0
        || ![testappverifierpresent]}]

namespace eval ::tcl::test::cmdMZ {
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::customMatch
    namespace import ::tcltest::makeFile
    namespace import ::tcltest::removeFile
    namespace import ::tcltest::temporaryDirectory
    namespace import ::tcltest::testConstraint

} {1 {missing close-brace}}
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {
    Tcl_TimeRateObjCmd: slower commands take longer, but it
    remains almost the same time of measurement
} -constraints noappverifier -body {
    set m1 [timerate {_nrt_sleep 0.01} 50]
    set m2 [timerate {_nrt_sleep 1.00} 50]
    if {[testConstraint valgrind] && ([lindex $m1 0] >= 100 || [lindex $m1 2] <= 500)} {
	tcltest::Skip "too-slow-by-valgrind"
    }
    list [list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \

    append x [encoding convertfrom jis0208 8C&A]
} "8C&A乎α"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol γ]
    append x [encoding convertto symbol g]
    append x [encoding convertfrom symbol g]
} "ggγ"
test encoding-12.7 {cp864 [ecafd8611d]} {
    encoding convertfrom cp864 \xA7
} €
test encoding-12.8 {cp165 [ecafd8611d]} {
    encoding convertfrom cp165 \xA7
} ﺈ

test encoding-13.1 {LoadEscapeTable} {
    encoding convertto iso2022 ab乎棙g
} ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 £

		encoding convertto -profile tcl8 $name $string

		# discard the cached internal representation of Tcl_Encoding
		# Unfortunately, without this, encoding 2-1 fails.
		llength $name
	}
	return $count
} -result 94

runtests

test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF

proc cleanup1 {} {
    encodingrestore
    envrestore
}

# OANOCACHE comes from Application Verifier
variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) OANOCACHE ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 USERPROFILE
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
    WINELOADER WINEUSERLOCALE WINEUSERNAME
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {

0x98	0x00bb	#RIGHT POINTING GUILLEMET
0x99	0xfef7	#ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE ISOLATED FORM
0x9a	0xfef8	#ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE FINAL FORM
0x9b		#UNDEFINED
0x9c		#UNDEFINED
0x9d	0xfefb	#ARABIC LIGATURE LAM WITH ALEF ISOLATED FORM
0x9e	0xfefc	#ARABIC LIGATURE LAM WITH ALEF FINAL FORM
0x9f	0xfe73	#ARABIC TAIL FRAGMENT
0xa0	0x00a0	#NON-BREAKING SPACE
0xa1	0x00ad	#SOFT HYPHEN
0xa2	0xfe82	#ARABIC LETTER ALEF WITH MADDA ABOVE FINAL FORM
0xa3	0x00a3	#POUND SIGN
0xa4	0x00a4	#CURRENCY SIGN
0xa5	0xfe84	#ARABIC LETTER ALEF WITH HAMZA ABOVE FINAL FORM
0xa6		#UNDEFINED
0xa7	0x20ac  #EURO SIGN
0xa8	0xfe8e	#ARABIC LETTER ALEF FINAL FORM
0xa9	0xfe8f	#ARABIC LETTER BEH ISOLATED FORM
0xaa	0xfe95	#ARABIC LETTER TEH ISOLATED FORM
0xab	0xfe99	#ARABIC LETTER THEH ISOLATED FORM
0xac	0x060c	#ARABIC COMMA
0xad	0xfe9d	#ARABIC LETTER JEEM ISOLATED FORM
0xae	0xfea1	#ARABIC LETTER HAH ISOLATED FORM

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 */
    void *clientData;		/* Referenced data of the main thread */

} TclPipeThreadInfo;

/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
 * more overhead for finalize thread (should be executed anyway)
 *
 * #define _PTI_USE_CKALLOC 1
 */

    PTI_STATE_STOP = 2,		/* thread should stop work (owns TI structure) */
    PTI_STATE_END = 4,		/* thread should stop work (worker is busy) */
    PTI_STATE_DOWN = 8		/* worker is down */
};

MODULE_SCOPE
TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
			    void *clientData);
MODULE_SCOPE int	TclPipeThreadWaitForSignal(
			    TclPipeThreadInfo **pipeTIPtr);

static inline void
TclPipeThreadSignal(
    TclPipeThreadInfo **pipeTIPtr)
{

    if (readFile != NULL) {
	/*
	 * Start the background reader thread.
	 */

	infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
	    TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr), 0, NULL);

	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
	infoPtr->validMask |= TCL_READABLE;
    } else {
	infoPtr->readTI = NULL;
	infoPtr->readThread = 0;
    }
    if (writeFile != NULL) {
	/*
	 * Start the background writer thread.
	 */

	infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
	    TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr), 0, NULL);

	SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
	infoPtr->validMask |= TCL_WRITABLE;
    } else {
	infoPtr->writeTI = NULL;
	infoPtr->writeThread = 0;
    }

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

TclPipeThreadInfo *
TclPipeThreadCreateTI(
    TclPipeThreadInfo **pipeTIPtr,
    void *clientData)

{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo));
#endif /* !_PTI_USE_CKALLOC */
    pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
    pipeTI->state = PTI_STATE_IDLE;
    pipeTI->clientData = clientData;

    return (*pipeTIPtr = pipeTI);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadWaitForSignal --

int
TclPipeThreadWaitForSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    LONG state;
    DWORD waitResult;


    if (!pipeTI) {
	return 0;
    }



    /*
     * Wait for the main thread to signal before attempting to do the work.
     */

    /*
     * Reset work state of thread (idle/waiting)
     */

  end:
    /*
     * End of work, check the owner of the TI structure.
     */

    if (state != PTI_STATE_STOP) {
	*pipeTIPtr = NULL;





    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *

    HANDLE evControl;
    int state;

    if (!pipeTI) {
	return 1;
    }
    evControl = pipeTI->evControl;

    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
	    PTI_STATE_IDLE);
    switch (state) {
    case PTI_STATE_IDLE:
	/*
	 * Thread was idle/waiting, notify it goes teardown
	 */

    int state;

    if (!pipeTI) {
	return;
    }
    pipeTI = *pipeTIPtr;
    evControl = pipeTI->evControl;


    /*
     * Try to sane stop the pipe worker, corresponding its current state
     */

    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
	    PTI_STATE_IDLE);

		}
	    }
	}
    }

    *pipeTIPtr = NULL;
    if (pipeTI) {



	CloseHandle(pipeTI->evControl);
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	Tcl_Free(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
    }

    if (!pipeTI) {
	return;
    }
    *pipeTIPtr = NULL;
    state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN);
    if (state == PTI_STATE_STOP) {
	CloseHandle(pipeTI->evControl);



#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	Tcl_Free(pipeTI);
	/* be sure all subsystems used are finalized */
	Tcl_FinalizeThread();
#endif /* !_PTI_USE_CKALLOC */

	/*
	 * Initially the channel is writable and the writeThread is idle.
	 */

	infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
	infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
		TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr), 0, NULL);

    }

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");

    return infoPtr->channel;
}


	    PostMessageW(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);

	    /*
	     * Wait for the thread to exit. This ensures that we are
	     * completely cleaned up before we leave this function.
	     */

	    WaitForSingleObject(tsdPtr->socketThread, INFINITE);
	    tsdPtr->hwnd = NULL;
	}
	CloseHandle(tsdPtr->socketThread);
	tsdPtr->socketThread = NULL;
    }
    if (tsdPtr->readyEvent != NULL) {
	CloseHandle(tsdPtr->readyEvent);

	 * place to look for bugs.
	 */

	if (bind(sock, addrPtr->ai_addr,
		(socklen_t)addrPtr->ai_addrlen) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    sock = INVALID_SOCKET; /* Bug [40b1814b93] */
	    continue;
	}
	if (port == 0 && chosenport == 0) {
	    address sockname;
	    socklen_t namelen = sizeof(sockname);

	    /*

	if (backlog < 0) {
	    backlog = SOMAXCONN;
	}
	if (listen(sock, backlog) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    sock = INVALID_SOCKET; /* Bug [40b1814b93] */
	    continue;
	}

	if (statePtr == NULL) {
	    /*
	     * Add this socket to the global list of sockets.
	     */