2021-10-27 (new) support for MacOS Monterey (nijtmans)
=> platform 1.0.18

2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans)

- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ -

2021-12-08 (update) tcltest package to version 2.5.4

2022-01-13 (bug)[26f132] Crash when sizeof(int) < sizeof(void *) (Plan 9 port)

2022-01-19 (TIP 623)[e9a271] Tcl_GetRange index args < 0 (petasis,nijtmans)

2022-03-08 (bug) test string-5.22 (porter)

2022-03-11 (bug)[8a7ec8] fat binary compile on Mac M1 (davis, nijtmans)

2022-04-04 (bug)[e5ed1b] numeric IPv6 in URLs (nijtmans)
=> http 2.9.6

2022-04-26 (bug)[27520c] test error-9.6 (goth,sebres)

2022-05-04 (bug)[8eb64b] http package tolerant again invalid reply header

2022-05-11 (bug)[6898f9] http package failed detection of shiftjis charset

2022-05-25 (bug)[76ad7a] tests string-6.13[23] (mistachkin, nijtmans)

2022-06-20 (bug)[55bf73] Avoid connection reuse after response code 101.
=> http 2.9.8

2022-07-22 (bug)[713653] FP rounding exposed by x86 musl (rubicon,sebres)

2022-07-22 More portable notation of microseconds in verbose output (sebres)
=> tcltest 2.5.5

2022-07-27 (bug)[b3977d] Process CR-LF split across packets (nadkarni,sebres)

2022-07-29 (bug)[4eb3a1] crash due to undetected bytecode invalidity (nadkarni)

2022-08-23 (new)[371080] Portability to CHERI-enabled Morello processor (jrtc27)

2022-09-06 (bug)[55a02f] Fallback init env(HOME) from USERPROFILE (nadkarni)

2022-09-13 (bug)[1073da] crash writing invalid utf-8 (nijtmans)

2022-09-14 (new) Update to Unicode-15 (nijtmans)

2022-10-14 tzdata updated to Olson's tzdata2022e (nijtmans)

Update bundled zlib to 1.2.13

Update bundled libtommath

Many code fixes to avoid overflow or undefined behavior.  Thanks chrstphrchvz.

- Released 8.6.13, Nov 22, 2022 - details at https://core.tcl-lang.org/tcl/ -

\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_DStringToObj\fR(\fIdsPtr\fR)
.sp
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in

.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to the interpreter's result.
This saves the cost of allocating new memory and copying the string.
\fBTcl_DStringResult\fR also reinitializes the dynamic string to
an empty string.
Since the dynamic string is reinitialized, there is no need to
further call \fBTcl_DStringFree\fR on it and it can be reused without
calling \fBTcl_DStringInit\fR.
.PP
\fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR.
It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and
it clears \fIinterp\fR's result.
If possible it does this by moving a pointer rather than by copying
the string.
.PP
\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR
and reinitializing to dynamic string to an empty string.
This saves the cost of allocating new memory and copying the string.
Since the dynamic string is reinitialized, there is no need to
further call \fBTcl_DStringFree\fR on it and it can be reused without
calling \fBTcl_DStringInit\fR.
The returned \fBTcl_Obj\fR has a reference count of 0.

.SH KEYWORDS
append, dynamic string, free, result

'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp

.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp
int
\fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR)
.sp
.sp
\fB#include <tclTomMath.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewBignumObj\fR(\fIbigValue\fR)
.sp
\fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR)

Points to place to store the integer value retrieved from \fIobjPtr\fR.
.AP long *longPtr out
Points to place to store the long integer value retrieved from \fIobjPtr\fR.
.AP size_t *indexPtr out
Points to place to store the size_t value retrieved from \fIobjPtr\fR.
.AP Tcl_WideInt *widePtr out
Points to place to store the wide integer value retrieved from \fIobjPtr\fR.
.AP Tcl_WideUInt *uwidePtr out
Points to place to store the unsigned wide integer value retrieved from \fIobjPtr\fR.
.AP mp_int *bigValue in/out
Points to a multi-precision integer structure declared by the LibTomMath
library.
.AP double doubleValue in
Double value from which the integer part is determined and
used to initialize a multi-precision integer value.
.BE

.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
Any value written into the Tcl variable must have a proper unsigned
wideinteger form acceptable to \fBTcl_GetWideUIntFromObj\fR;

attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.

#declare 684 {
#    Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue)
#}
#declare 685 {
#    void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue)
#}

# TIP #650
declare 686 {
    int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_WideUInt *uwidePtr)

}

# TIP 651
declare 687 {
    Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr)

}

# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

/*
 * The structure used for the AirthSeries internal representation.
 * Note that the len can in theory be always computed by start,end,step
 * but it's faster to cache it inside the internal representation.
 */
typedef struct ArithSeries {



    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
} ArithSeries;

typedef struct ArithSeriesDbl {



    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    double start;
    double end;
    double step;
} ArithSeriesDbl;

MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
                            int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
                            Tcl_Obj *stepObj, Tcl_Obj *lenObj);

/*

    byteArrayPtr->used = dst - byteArrayPtr->bytes;
    byteArrayPtr->allocated = numBytes;

    *byteArrayPtrPtr = byteArrayPtr;
    return proper;
}

static Tcl_Obj *
TclNarrowToBytes(
    Tcl_Obj *objPtr)
{
    if (NULL == TclFetchInternalRep(objPtr, &properByteArrayType)) {
	Tcl_ObjInternalRep ir;
	ByteArray *byteArrayPtr;

    }

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

    Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));

    /*
     * We're done with the encoding
     */

    Tcl_FreeEncoding(encoding);
    return TCL_OK;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --

				size_t numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
				Tcl_Channel chan, int mode);
/* 683 */
EXTERN int		Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* 686 */
EXTERN int		Tcl_GetWideUIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr);
/* 687 */
EXTERN Tcl_Obj *	Tcl_DStringToObj(Tcl_DString *dsPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
    int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
    int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
    void (*reserved684)(void);
    void (*reserved685)(void);
    int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 686 */
    Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 687 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
	(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */
/* Slot 684 is reserved */
/* Slot 685 is reserved */
#define Tcl_GetWideUIntFromObj \
	(tclStubsPtr->tcl_GetWideUIntFromObj) /* 686 */
#define Tcl_DStringToObj \
	(tclStubsPtr->tcl_DStringToObj) /* 687 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#ifdef _WIN32
#   undef Tcl_CreateFileHandler

	    *dst++ = *src++;
	} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)
		&& (UCHAR(src[1]) == 0x80) && (!(flags & TCL_ENCODING_MODIFIED) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT))) {
	    /*
	     * If in input mode, and -strict is specified: This is an error.
	     */
	    if (flags & TCL_ENCODING_MODIFIED) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }

	    /*
	     * Convert 0xC080 to real nulls when we are in output mode, with or without '-strict'.
	     */
	    *dst++ = 0;

	     */

	    if (flags & TCL_ENCODING_MODIFIED) {
		if ((STOPONERROR) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
		    result = TCL_CONVERT_MULTIBYTE;
		    break;
		}
	    if (((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
		ch = UCHAR(*src++);
	    } else {
		char chbuf[2];
		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
		TclUtfToUCS4(chbuf, &ch);
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
	    const char *saveSrc = src;
	    size_t len = TclUtfToUCS4(src, &ch);
	    if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_MODIFIED)
		    && (((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT))) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
	    src += len;
	    if (!(flags & TCL_ENCODING_UTF) && (ch > 0x3FF)) {
		if (ch > 0xFFFF) {
		    /* CESU-8 6-byte sequence for chars > U+FFFF */

        const char *rootEnd;

        Tcl_DStringInit(&ds);
        rootEnd = ExtractWinRoot(path, &ds, 0, &type);
        if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
            *driveNameLengthPtr = rootEnd - path;
            if (driveNameRef != NULL) {
                *driveNameRef = Tcl_DStringToObj(&ds);
                Tcl_IncrRefCount(*driveNameRef);
            }
        }
        Tcl_DStringFree(&ds);
        break;
    }
    }

    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, Tcl_DStringToObj(&buf));
    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes.
     */

	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = Tcl_DStringToObj(&append);
	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*

    /*
     * Note that we prefer the wideSeekProc if that field is available in the
     * type and non-NULL.
     */

    if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) {
	*errnoPtr = EINVAL;
	return TCL_INDEX_NONE;
    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
}

static inline void

    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }

    if (DetachChannel(interp, chan) != TCL_OK) {
	return TCL_OK;
    }

    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
	return 0;
    }

    Tcl_SetErrno(EINVAL);
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unable to access channel: invalid channel", TCL_INDEX_NONE));
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *

		 * regular message if nothing was found in the bypasses.
		 */

		Tcl_SetErrno(errorCode);
		if (interp != NULL && !TclChanCaughtErrorBypass(interp,
			(Tcl_Channel) chanPtr)) {
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE));
		}

		/*
		 * An unreportable bypassed message is kept, for the caller of
		 * Tcl_Seek, Tcl_Write, etc.
		 */
	    }

	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as

	result = EINVAL;
    }

    if (stickyError != 0) {
	Tcl_SetErrno(stickyError);
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }

    /*
     * Bug 97069ea11a: set error message if a flush code is set and no error
     * message set up to now.
     */

    if (flushcode != 0) {
	/* flushcode has precedence, if available */
	result = flushcode;
    }
    if ((result != 0) && (result != TCL_ERROR) && (interp != NULL)
	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) {
	Tcl_SetErrno(result);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE));
    }
    if (result != 0) {
	return TCL_ERROR;
    }
    return TCL_OK;
}


    /*
     * Is the channel unstacked ? If not we fail.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"half-close not applicable to stack of transformations", TCL_INDEX_NONE));
	return TCL_ERROR;
    }

    /*
     * Check direction against channel mode. It is an error if we try to close
     * a direction not supported by the channel (already closed, or never
     * opened for that direction).

     * That won't do.
     */

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,

 */

size_t
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    size_t len)			/* Length of string in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    size_t result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }

    chanPtr = statePtr->topChanPtr;

     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    Tcl_IncrRefCount(objPtr);
    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
    if (src == NULL) {
	Tcl_SetErrno(EILSEQ);
	result = TCL_INDEX_NONE;
    } else {
	result = WriteBytes(chanPtr, src, len);
    }
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteObj --
 *
 *	Takes the Tcl object and queues its contents for output. If the
 *	encoding of the channel is NULL, takes the byte-array representation
 *	of the object and queues those bytes for output. Otherwise, takes the
 *	characters in the UTF-8 (string) representation of the object and
 *	converts them for output using the channel's current encoding. May
 *	flush internal buffers to output if one becomes full or is ready for
 *	some other reason, e.g. if it contains a newline and the channel is in
 *	line buffering mode.
 *
 * Results:
 *	The number of bytes written or TCL_INDEX_NONE in case of error. If
 *	TCL_INDEX_NONE, Tcl_GetErrno() will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }
    if (statePtr->encoding == NULL) {
	size_t result;


	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	if (src == NULL) {
	    Tcl_SetErrno(EILSEQ);
	    result = TCL_INDEX_NONE;
	} else {
	    result = WriteBytes(chanPtr, src, srcLen);

	}
	return result;
    } else {
	src = Tcl_GetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}


 *
 *	Convert srcLen bytes starting at src according to encoding and write
 *	produced bytes into an output buffer, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering mode.
 *
 * Results:
 *	The number of bytes written or TCL_INDEX_NONE in case of error. If TCL_INDEX_NONE,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------

	 * See io-75.2, TCL bug 6978c01b65.
	 * Check, if an encoding error occured and should be reported to the
	 * script level.
	 * This happens, if a written character may not be represented by the
	 * current output encoding and strict encoding is active.
	 */

	if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) {
	    encodingError = 1;
	    result = TCL_OK;
	}

	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
	    /*
	     * We're reading from invalid/incomplete UTF-8.

 *---------------------------------------------------------------------------
 *
 * Tcl_Gets --
 *
 *	Reads a complete line of input from the channel into a Tcl_DString.
 *
 * Results:
 *	Length of line read (in characters) or TCL_INDEX_NONE if error, EOF, or blocked.
 *	If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error code for the
 *	error or condition that occurred.
 *
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------

 * Tcl_GetsObj --
 *
 *	Accumulate input from the input channel until end-of-line or
 *	end-of-file has been seen. Bytes read from the input channel are
 *	converted to UTF-8 using the encoding specified by the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or TCL_INDEX_NONE if error,
 *	blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.

 *	channel return as a ByteArray obj.
 *
 *	WARNING!  The notion of "binary" used here is different from notions
 *	of "binary" used in other places. In particular, this "binary" routine
 *	may be called when an -eofchar is set on the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or TCL_INDEX_NONE if error,
 *	blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.

	}
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    skip = 0;
	    eol = dstEnd;
	    if ((dst == dstEnd) && (byteLen == oldLength)) {
		/*
		 * If we didn't append any bytes before encountering EOF,
		 * caller needs to see TCL_INDEX_NONE.
		 */

		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
		CommonGetsCleanup(chanPtr);
		copiedTotal = -1;
		ResetFlag(statePtr, CHANNEL_BLOCKED);
		goto done;

	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
    }

    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);

	if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) {
	    SetFlag(statePtr, CHANNEL_ENCODING_ERROR);
	    result = TCL_OK;
	}

    /*
     * Make sure that if we go through 'gets', that we reset the
     * TCL_ENCODING_START flag still. [Bug #523988]
     */

    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;

 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,		/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    Channel *chanPtr = (Channel *) chan;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	/*
	 * Update the notifier state so we don't block while there is still
	 * data in the buffers.
	 */

	UpdateInterest(chanPtr);
	return TCL_INDEX_NONE;
    }

    return DoReadChars(chanPtr, objPtr, toRead, appendFlag);
}
/*
 *---------------------------------------------------------------------------
 *
 * DoReadChars --
 *
 *	Reads from the channel until the requested number of characters have
 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,			/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    ChannelState *statePtr = chanPtr->state;

    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copied;
}

 *	are done.
 *
 *	'bytesToRead' can safely be a very large number because space is only
 *	allocated to hold data read from the channel as needed.
 *
 * Results:
 *	The return value is the number of bytes appended to the object, or
 *	TCL_INDEX_NONE to indicate that zero bytes were read due to an EOF.
 *
 * Side effects:
 *	The storage of bytes in objPtr can cause (re-)allocation of memory.
 *
 *---------------------------------------------------------------------------
 */

ReadChars(
    ChannelState *statePtr,	/* State of channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this object.
				 * objPtr->length is how much space has been
				 * allocated to hold data, not how many bytes
				 * of data have been stored in the object. */
    int charsToRead,		/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to get all available characters.
				 * Characters are obtained from the first
				 * buffer in the queue -- even if this number
				 * is larger than the number of characters
				 * available in the first buffer, only the
				 * characters from the first buffer are
				 * returned. The execption is when there is
				 * not any complete character in the first

	assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);

	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
		flags, &statePtr->inputEncodingState,
		dst, dstLimit, &srcRead, &dstDecoded, &numChars);

	if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX) {
	    SetFlag(statePtr, CHANNEL_ENCODING_ERROR);
	    code = TCL_OK;
	}

	/*
	 * Perform the translation transformation in place.  Read no more than
	 * the dstDecoded bytes the encoding transformation actually produced.
	 * Capture the number of bytes written in dstWrote. Capture the number
	 * of bytes actually consumed in dstRead.
	 */

		 *    we saw it and stopped translating at that point.
		 *
		 * NOTE the bizarre spec of TranslateInputEOL in this case.
		 * Clearly the eof char had to be read in order to account for
		 * the stopping, but the value of dstRead does not include it.
		 *
		 * Also rather bizarre, our caller can only notice an EOF
		 * condition if we return the value TCL_INDEX_NONE as the number of chars
		 * read.  This forces us to perform a 2-call dance where the
		 * first call can read all the chars up to the eof char, and
		 * the second call is solely for consuming the encoded eof
		 * char then pointed at by src so that we can return that
		 * magic TCL_INDEX_NONE value.  This seems really wasteful, especially
		 * since the first decoding pass of each call is likely to
		 * decode many bytes beyond that eof char that's all we care
		 * about.
		 */

		if (dstRead == 0) {
		    /*

		"blocking buffering buffersize encoding eofchar translation";
	const char **argv;
	size_t argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, TCL_INDEX_NONE);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, optionList, TCL_INDEX_NONE);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);
	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",

     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "unable to set channel options: background copy in"
                    " progress", TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }

    /*
     * Disallow options on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit

	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
	} else if (interp) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "bad value for -buffering: must be one of"
                    " full, line, or none", TCL_INDEX_NONE));
            return TCL_ERROR;
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	Tcl_WideInt newBufferSize;
	Tcl_Obj obj;
	int code;

	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = newValue[0];
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: must be non-NUL ASCII"
			" character", TCL_INDEX_NONE));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)argv);
	}

	} else if (argc == 2) {
	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", TCL_INDEX_NONE));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE));
		}
		Tcl_Free((void *)argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data

		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE));
		}
		Tcl_Free((void *)argv);
		return TCL_ERROR;
	    }
	}
	Tcl_Free((void *)argv);
	return TCL_OK;

 *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
 *	These bytes come from reading the channel "chanPtr" and
 *	performing the configured translations.  No encoding conversions
 *	are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes actually stored (<= bytesToRead),
 * 	or TCL_INDEX_NONE if there is an error in reading the channel.  Use
 * 	Tcl_GetErrno() to retrieve the error code for the error
 *	that occurred.
 *
 *	The number of bytes stored can be less than the number
 * 	requested when
 *	  - EOF is reached on the channel; or
 *	  - the channel is non-blocking, and we've read all we can
 *	    without blocking.
 *	  - a channel reading error occurs (and we return TCL_INDEX_NONE)
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

    hTblPtr = GetChannelTable(interp);
    TclNewObj(resultPtr);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)
	    && !((pattern[0] == 's') && (pattern[1] == 't')
	    && (pattern[2] == 'd'))) {
	if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL)
		&& (Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(pattern, TCL_INDEX_NONE)) != TCL_OK)) {
	    goto error;
	}
	goto done;
    }

    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {

	     */

	    name = statePtr->channelName;
	}

	if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
		(Tcl_ListObjAppendElement(interp, resultPtr,
			Tcl_NewStringObj(name, TCL_INDEX_NONE)) != TCL_OK)) {
	error:
	    TclDecrRefCount(resultPtr);
	    return TCL_ERROR;
	}
    }

  done:

					 * flag is set when gets fails to get
					 * a complete line or when read fails
					 * to get a complete character. When
					 * set, file events will not be
					 * delivered for buffered data until
					 * the state of the channel
					 * changes. */
#define CHANNEL_ENCODING_ERROR	(1<<15)	/* set if channel
					 * encountered an encoding error */
#define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
					 * being used. */
#define CHANNEL_ENCODING_NOCOMPLAIN	(1<<17)	/* set if option
					 * -nocomplainencoding is set to 1 */
#define CHANNEL_ENCODING_STRICT	(1<<18)	/* set if option
					 * -strictencoding is set to 1 */
#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.

 * 			complex to compile effectively, or it can indicate
 * 			that in the current state of the interp, the command
 * 			would raise an error. The bytecode compiler will not
 * 			do any error reporting at compiler time. Error
 * 			reporting is deferred until the actual runtime,
 * 			because by then changes in the interp state may allow
 * 			the command to be successfully evaluated.


 */



typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
	struct Command *cmdPtr, struct CompileEnv *compEnvPtr);

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);

MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, size_t objc, size_t *objcPtr);
MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);

			    const EnsembleImplMap map[]);
MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, size_t numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);

MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);

/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);


/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,

    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    void *(*tclpReaddir) (void *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */

	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */


#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \

}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    if (Tcl_GetWideUIntFromObj(NULL, objPtr, uwidePtr) != TCL_OK) {

	int intValue;









	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {







	    return 1;
	}
	*uwidePtr = intValue;

    }










    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)

#ifdef UNICODE
    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString(string, -1, &ds);
#else
    (void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
    return Tcl_DStringToObj(&ds);
}

/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).
 */

	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

		{
	    mp_int big;
	    unsigned long scratch, value = 0;
	    unsigned char *bytes = (unsigned char *) &scratch;
	    size_t numBytes;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    if (value <= 1 + (unsigned long)LONG_MAX) {
			*longPtr = (long)(-value);
			return TCL_OK;
		    }
		} else {
		    if (value <= (unsigned long)ULONG_MAX) {

	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			*wideIntPtr = (Tcl_WideInt)(-value);
			return TCL_OK;
		    }
		} else {
		    if (value <= (Tcl_WideUInt)WIDE_MAX) {

	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideUIntFromObj --
 *
 *	Attempt to return a unsigned wide integer from the Tcl object "objPtr". If the
 *	object is not already a wide int object or a bignum object, an attempt will
 *	be made to convert it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already an int object, the conversion will free
 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetWideUIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideUInt *wideUIntPtr)
				/* Place to store resulting long. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    if (objPtr->internalRep.wideValue < 0) {
	wideUIntOutOfRange:
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected unsigned integer but got \"%s\"",
			    TclGetString(objPtr)));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
		}
		return TCL_ERROR;
	    }
	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    goto wideUIntOutOfRange;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideUInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideUInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (big.sign == MP_NEG) {
		goto wideUIntOutOfRange;
	    }
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		*wideUIntPtr = (Tcl_WideUInt)value;
		return TCL_OK;
	    }

	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetWideBitsFromObj --
 *
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made

	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;
	    mp_err err;

	    Tcl_WideUInt value = 0, scratch;
	    size_t numBytes;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
	    err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
	    if (err == MP_OKAY) {

		err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes);
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
	    mp_clear(&big);
	    return TCL_OK;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;

void
Tcl_SetBignumObj(
    Tcl_Obj *objPtr,		/* Object to set */
    void *big)	/* Value to store */
{
    Tcl_WideUInt value = 0;
    size_t numBytes;
    Tcl_WideUInt scratch;
    unsigned char *bytes = (unsigned char *) &scratch;
    mp_int *bignumValue = (mp_int *) big;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
    }

    if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) {
	goto tooLargeForWide;
    }
    while (numBytes-- > 0) {
	value = (value << CHAR_BIT) | *bytes++;
    }
    if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	goto tooLargeForWide;
    }
    if (bignumValue->sign) {
	TclSetIntObj(objPtr, (Tcl_WideInt)(-value));
    } else {
	TclSetIntObj(objPtr, (Tcl_WideInt)value);

 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_OPEN_PAREN -	Character is a left parenthesis.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */

const unsigned char tclCharTypeTable[] = {

    /*
     * Positive character values, from 0-127:
     */

    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,

#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40
#define TYPE_OPEN_PAREN		0x80
#define TYPE_BAD_ARRAY_INDEX	(TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE)

#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]

MODULE_SCOPE const unsigned char tclCharTypeTable[];

    const char *user)   /* User name. NULL -> current user */
{
    Tcl_DString dirString;

    if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
	return NULL;
    }
    return Tcl_DStringToObj(&dirString);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePath --
 *

				  &resolvedPath)
	    != TCL_OK) {
	    Tcl_DStringFree(&userName);
	    return NULL;
	}
	Tcl_DStringFree(&userName);
    }
    return Tcl_DStringToObj(&resolvedPath);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePathList --
 *

     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
	    NULL) == TCL_OK) {
	regexpPtr->globObjPtr = Tcl_DStringToObj(&stringBuf);
	Tcl_IncrRefCount(regexpPtr->globObjPtr);
    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for

    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    Tcl_GetNumber, /* 681 */
    Tcl_RemoveChannelMode, /* 682 */
    Tcl_GetEncodingNulLength, /* 683 */
    0, /* 684 */
    0, /* 685 */
    Tcl_GetWideUIntFromObj, /* 686 */
    Tcl_DStringToObj, /* 687 */
};

/* !END!: Do not edit above this line. */

	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
    } else if (strcmp(argv[1], "result") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringResult(interp, &dstring);
    } else if (strcmp(argv[1], "toobj") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_SetObjResult(interp, Tcl_DStringToObj(&dstring));
    } else if (strcmp(argv[1], "trunc") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_DStringSetLength(&dstring, count);
    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be append, element, end, free, get, gresult, length, "
		"result, start, toobj, or trunc", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * The procedure below is used as a special freeProc to test how well

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
    Tcl_SetObjResult(interp, Tcl_DStringToObj(dsPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringGetResult --
 *

    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringToObj --
 *
 *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
 *	aware that this function does *not* check that the encoding of the
 *	contents of the dynamic string is correct; this is the caller's
 *	responsibility to enforce.
 *
 * Results:
 *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
 *	reference count of zero.
 *
 * Side effects:
 *	The string is "moved" to the object. dsPtr is reinitialized to an
 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_DStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->string == dsPtr->staticSpace) {
	if (dsPtr->length == 0) {
	    TclNewObj(result);

	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1,
		TCL_ENCODING_NOCOMPLAIN, &tmp);
	SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp));
    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->name, -1,
		TCL_ENCODING_NOCOMPLAIN, &tmp);
	SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp));
    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
    }

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]

test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "a\x4D\x00"
    chan close $f
    contents $path(test1)
} "aM\x00"
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis
    chan puts -nonewline $f "a乍\x00"

    list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {0 3 5 4 defg}
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts $f "\x81\x34\x00"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary
    list [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 3 "\x81\x34\x00"]

    set result {}
    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a specially-allocated stringz}}

test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append xyz -1
    list [testdstring toobj] [testdstring length]
} -cleanup {
    testdstring free
} -result {xyz 0}
test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup {
    testdstring free
    unset -nocomplain a
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    set a [testdstring toobj]
    testdstring append abc -1
    list $a [testdstring get]
} -cleanup {
    testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}


# cleanup
if {[testConstraint testdstring]} {
    testdstring free
}
::tcltest::cleanupTests
return

test encoding-24.10 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xE0\xA0\x80"]
} 1
test encoding-24.11 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xEF\xBF\xBF"]
} 1
test encoding-24.12 {Parse valid or invalid utf-8} -body {
    encoding convertfrom -strict utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.13 {Parse valid or invalid utf-8} -body {
    encoding convertfrom -strict utf-8 "\xC1\xBF"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.14 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC2\x80"]
} 1
test encoding-24.15 {Parse valid or invalid utf-8} -body {
    encoding convertfrom utf-8 "Z\xE0\x80"
} -result Z\xE0\x80

} 1
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test encoding-24.24 {Parse invalid utf-8 with -strict} -body {
    encoding convertfrom -strict utf-8 "\xC0\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.25 {Parse invalid utf-8 with -strict} -body {
    encoding convertfrom -strict utf-8 "\x40\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\x80'}
test encoding-24.26 {Parse valid utf-8 with -strict} -body {
    encoding convertfrom -strict utf-8 "\xF1\x80\x80\x80"
} -result \U40000
test encoding-24.27 {Parse invalid utf-8 with -strict} -body {
    encoding convertfrom -strict utf-8 "\xF0\x80\x80\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF0'}
test encoding-24.28 {Parse invalid utf-8 with -strict} -body {
    encoding convertfrom -strict utf-8 "\xFF\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xFF'}

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {

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

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

source [file join [file dirname [info script]] tcltests.tcl]



# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]







# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {

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

    variable fname1 登鸛鵲樓













    source [file join [file dirname [info script]] tcltests.tcl]


    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]

test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "a\x4D\x00"
    close $f
    contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis
    puts -nonewline $f "a乍\x00"

    set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
    close $f
    set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts $f "\x81\x34\x00"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation binary
    set x [list [gets $f line] $line]
    close $f
    set x
} [list 3 "\x81\x34\x00"]

} -cleanup {
    close $f
    removeFile io-75.9
} -result "41"
# The current result cuts at the invalid sequence. IMHO, there should be an
# error thrown or the whole sequence should be returned as byte (compat mode).

test io-75.10 {invalid utf-8 encoding read is ignored} -setup {
    set fn [makeFile {} io-75.5]
    set f [open $fn w+]
    fconfigure $f -encoding binary

    puts -nonewline $f "A\x81"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf
} -body {
    set d [read $f]
    close $f
    binary scan $d H* hd
    set hd
} -cleanup {
    removeFile io-75.10
} -result "4181"
test io-75.11 {invalid utf-8 encoding read is not ignored (-strictencoding 1)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f "A\x81"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -strictencoding 1
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {read $f} msg]
    close $f
    lappend hd $msg
} -cleanup {
    removeFile io-75.6
} -result "41 0 {}" ; # Here, an exception should be thrown

# ### ### ### ######### ######### #########



test io-76.0 {channel modes} -setup {
    set datafile [makeFile {some characters} dummy]

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

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]



# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]

#----------------------------------------------------------------------

test iocmd-1.1 {puts command} {
   list [catch {puts} msg] $msg

} -body {
    lrange {    1 2   3 4   } $zero $end
} -result {1 2 3 4}

test listrep-1.11 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - lreplace version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.1 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - linsert version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [linsert [freeSpaceNone 1000] $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.2 {
    Append elements to large unshared list leaves no free space in front
    - lappend version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [freeSpaceNone 1000]
    lappend l 1000 1001
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1001] 0 1 0]


test listrep-1.12 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 0 0]

test listrep-1.12.1 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l 0 -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {-1 1 2 3 4 5 6 7} 0 0]

test listrep-1.13 {
    Replacement of elements at front with fewer elements in unshared list
    results in a spanned list with space only in front
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 4 0]

test listrep-1.14 {
    Replacement of elements at front with more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {10 11 12 2 3 4 5 6 7} 1]

test listrep-1.15 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 11 3 4 5 6 7} 0 0]

test listrep-1.15.1 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $two -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 -1 3 4 5 6 7} 0 0]

test listrep-1.16 {
    Replacement of elements in front half with fewer elements in unshared list
    results in a spanned list with space only in front since smaller segment moved
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 5 6 7} 3 0]

test listrep-1.17 {
    Replacement of elements in back half with fewer elements in unshared list
    results in a spanned list with space only at back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] end-$four end-$one 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 10 7} 0 3]

test listrep-1.18 {
    Replacement of elements in middle more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 10 11 12 3 4 5 6 7} 1]

test listrep-1.19 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 0 0]

test listrep-1.19.1 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0]

test listrep-1.20 {
    Replacement of elements at back with fewer elements in unshared list
    is in-place with space only at the back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 0 2]

test listrep-1.21 {
    Replacement of elements at back with more elements in unshared list
    allocates new representation with equal space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 4 5 10 11 12} 1]

#
# listrep-2.* tests all operate on shared list reps with no free space. Note the

    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]

test listrep-3.23 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 3 3]

test listrep-3.23.1 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $zero 10
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 1 2 3 4 5 6 7} 3 3]

test listrep-3.24 {
    Replacement of elements at front with fewer elements in unshared
    spanned list expands leading space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $four 10]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 7 3]

test listrep-3.25 {
    Replacement of elements at front with more elements in unshared
    spanned list with sufficient leading space shrinks leading space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11 12]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 12 2 3 4 5 6 7} 2 3]

test listrep-3.26 {
    Replacement of elements at front with more elements in unshared
    spanned list with insufficient leading space but sufficient total

    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]

test listrep-3.28 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 3 3]

test listrep-3.28.1 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 3 3]

test listrep-3.29 {
    Replacement of elements at back with fewer elements in unshared
    spanned list expands tail space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 3 5]

test listrep-3.30 {
    Replacement of elements at back with more elements in unshared
    spanned list with sufficient tail space shrinks tailspace
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12} 3 2]

test listrep-3.31 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient tail space but enough total free space moves up the span
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 0 1]

test listrep-3.32 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient total space reallocates with more room in the tail because
    of realloc()
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 10]

test listrep-3.33 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 12 5 6 7} 3 3]

test listrep-3.33.1 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $two 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 3 4 5 6 7} 3 3]

test listrep-3.34 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the front half moves the front (smaller) segment
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 5 6 7} 4 3]

test listrep-3.35 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the back half moves the tail (smaller) segment
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10 7} 3 4]

test listrep-3.36 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (front case)
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $one $two 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 3 4 5 6 7} 2 3]

test listrep-3.37 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (back case)
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 8 9 10 7} 3 2]

test listrep-3.38 {
    Replacement of elements in an unshared spanned list with more elements
    when only front has room
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 8 9 10 7} 1 1]

test listrep-3.39 {
    Replacement of elements in an unshared spanned list with more elements
    when only back has room
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 2 3 4 5 6 7} 1 1]

test listrep-3.40 {
    Replacement of elements in an unshared spanned list with more elements
    when neither send has enough room by itself
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 1]

test listrep-3.41 {
    Replacement of elements in an unshared spanned list with more elements
    when there is not enough free space results in new allocation. The back
    end has more space because of realloc()
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 11]

#
# 4.* - tests on shared spanned lists

# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

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

unset -nocomplain foo
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint exec [llength [info commands exec]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]

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

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]


# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

#! /usr/bin/env tclsh

# Don't overwrite tcltests facilities already present
if {[package provide tcltests] ne {}} return

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]

    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]


set threadSuperKillScript {

    close $f
    set enc
} -cleanup {
    unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
    catch {set oldlc_all $env(LC_ALL)}
    catch {set oldtcl_library $env(TCL_LIBRARY)}
    unset -nocomplain env(TCL_LIBRARY)
} -constraints {unix stdio knownBug} -body {
    set env(LANG) japanese
    set env(LC_ALL) japanese
    set f [open "|[list [interpreter]]" w+]
    chan configure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    set validEncodings [list euc-jp]
    if {[string match HP-UX $tcl_platform(os)]} {
	# Some older HP-UX systems need us to accept this as valid Bug 453883
	# reports that newer HP-UX systems report euc-jp like everybody else.
	lappend validEncodings shiftjis
    }
    expr {$enc ni $validEncodings}
} -cleanup {
    unset -nocomplain env(LANG) env(LC_ALL)
    catch {set env(LC_ALL) $oldlc_all}
    catch {set env(TCL_LIBRARY) $oldtcl_library}
} -result 0

test unixInit-4.1 {TclpSetVariables} {unix} {
    # just make sure they exist
    set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
    set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
    set tcl_platform(platform)

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

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.4]
	    set ::ddelib [info loaded {} Dde]}]} {

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
    } else {
	Tcl_DString ds;

	Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
	*attributePtrPtr = Tcl_DStringToObj(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp);
    Tcl_DStringFree(&templ);
    return Tcl_DStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds);
	linkPtr = Tcl_DStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;

    Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
    return Tcl_DStringToObj(&ds);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *

	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds));
	}
	Tcl_Free(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different

TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8		= tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\
			  package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]]

	@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest

${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
	@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest

${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
	@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest

${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest

${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinReg.${OBJEXT}: tclWinReg.c
	$(CC)  -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinDde.${OBJEXT}: tclWinDde.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclAppInit.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

tclMainW.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support

static int		MakeDdeConnection(Tcl_Interp *interp,
			    const WCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = Tcl_DStringToObj(&ds);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;

	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
	    Tcl_DStringFree(&ds);

            tempPath = Tcl_DStringToObj(&dsTemp);
            Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

     * We actually made the directory, so we're done! Report what we made back
     * as a (clean) Tcl_Obj.
     */

    Tcl_DStringInit(&name);
    Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
    Tcl_DStringFree(&base);
    return Tcl_DStringToObj(&name);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
	return Tcl_DStringToObj(&ds);
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new

	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_DStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free((void *)pathv);
    }
}

static int		RegistryObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif