void
closedir(
    register DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    ckfree((char *) dirp);
}

	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	ckfree((char *) waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait

     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);

    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }

    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    ckfree((char *) iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

{
    Command *cmdPtr = clientData;
    int i, result;
    const char **argv =
	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));

    for (i = 0; i < objc; i++) {
	argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command's string-based Tcl_CmdProc.
     */

    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	TclDStringAppendLiteral(&newFullName, "::");
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

    /*
     * The new command name is okay, so remove the command from its current
     * namespace. This is like deleting the command, so bump the cmdEpoch to
     * invalidate any cached references to the command.

static void
MathFuncWrongNumArgs(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int expected,		/* Formal parameter count. */
    int found,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    const char *name = Tcl_GetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;

    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "coroutine \"%s\" is already running",
                Tcl_GetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine

	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree((char *) bodyToken);
	    ckfree((char *) bodyTokenArray);
	    ckfree((char *) bodyLines);
	    ckfree((char *) bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably

{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	ckfree((char *) eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	ckfree((char *) eclPtr->loc);
    }

    ckfree((char *) eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *

    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);

    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		Tcl_GetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    Tcl_GetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	if (cdPtr->encoding) {
	    venc = Tcl_GetEncoding(interp, cdPtr->encoding);
	    if (!venc) {
		return TCL_ERROR;

    QCCD *cdPtr = clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree((char *)cdPtr->encoding);
    }
    ckfree((char *)cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *

int
Tcl_GetEncodingFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *name = Tcl_GetString(objPtr);

    if (objPtr->typePtr != &encodingType) {
	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);

	if (encoding == NULL) {
	    return TCL_ERROR;
	}

	for (i=0; i<numDirs && !verified; i++) {
	    if (dir[i] == directory) {
		verified = 1;
	    }
	}
	if (!verified) {
	    const char *dirString = Tcl_GetString(directory);

	    for (i=0; i<numDirs && !verified; i++) {
		if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
		    verified = 1;
		}
	    }
	}
	if (!verified) {
	    /*
	     * Directory no longer on the search path. Remove from cache.

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;

	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
	p = Tcl_GetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
	p += 2;
	for (lo = 0; lo < 256; lo++) {
	    if ((lo & 0x0f) == 0) {
		p++;
	    }

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

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs, numBytes;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetStringFromObj(searchPathObj, &numBytes);

    *lengthPtr = numBytes;
    *valuePtr = ckalloc(numBytes + 1);
    memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	ckfree((char *) nameParts);
    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *

{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	ckfree((char *) freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.

	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
			Tcl_GetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	/*
	 * Install a tailcall record in the caller and continue with the

		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "\n executing ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
	    fprintf(stderr,"%s\n", Tcl_GetString(message));
	    Tcl_DecrRefCount(message);
	} else {
	    fprintf(stderr, "\n");
	}
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
    }
}

	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
	}
    } else {
	Tcl_Obj *objPtr = Tcl_ObjPrintf(
		"unknown floating-point error, errno = %d", errno);

	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
		Tcl_GetString(objPtr), NULL);
	Tcl_SetObjResult(interp, objPtr);
    }
}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------

     *   Check for non-optionals through the mask.
     *   Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,

	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"read\" method",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"write\" method",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.

		FreeReceivedError(&p);
	    }
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*

	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*

    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
    UnmarshallErrorResult(rcPtr->interp, resObj);

    resObj = Tcl_GetObjResult(rcPtr->interp);

    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
	    || (code >= 0))) {
	if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
	    code = -EAGAIN;
	} else {
	    code = 0;
	}
    }

    Tcl_RestoreInterpState(rcPtr->interp, sr);

    }

    /*
     * First argument is a channel handle.
     */

    chanObj = objv[CHAN];
    parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
    if (parentChan == NULL) {
	return TCL_ERROR;
    }
    parentChan = Tcl_GetTopChannel(parentChan);

    /*
     * Second argument is command prefix, i.e. list of words, first word is

     * - List, of method names. Convert to mask. Check for non-optionals
     *   through the mask. Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames,
		sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "chan handler \"%s initialize\" returned %s",
		    Tcl_GetString(cmdObj),
		    Tcl_GetString(Tcl_GetObjResult(interp))));
	    Tcl_DecrRefCount(resObj);
	    goto error;
	}

	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the

    if (!HAS(methods, METH_WRITE)) {
	mode &= ~TCL_WRITABLE;
    }

    if (!mode) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" makes the channel inaccessible",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    /*
     * The mode and support for it is ok, now check the internal constraints.
     */

    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"drain\" but not \"read\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"flush\" but not \"write\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
     */

    rtPtr->methods = methods;
    rtPtr->mode = mode;
    rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, rtPtr, mode,
	    rtPtr->parent);

    /*
     * Register the transform in our our map for proper handling of deleted
     * interpreters and/or threads.
     */

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#ifdef TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
     */

	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#ifdef TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }

    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);

	/*
	 * Remove the channel from the map before releasing the memory, to
	 * prevent future accesses (like by 'postevent') from finding and
	 * dereferencing a dangling pointer.
	 */

	rtmPtr = GetReflectedTransformMap(interp);
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * In a threaded interpreter we manage a per-thread map as well, to
	 * allow us to survive if the script level pulls the rug out under a
	 * channel by deleting the owning thread.
	 */

	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	FreeReflectedTransformArgs(rtPtr);
	break;

    case ForwardedInput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)

{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    ckfree((char *) rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *

/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
	Tcl_Encoding *encodingPtr);

/*
 * A ProcessGlobalValue struct exists for each internal value in Tcl that is
 * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
 * the value, and the master is kept as a counted string, with epoch and mutex
 * control. Each ProcessGlobalValue struct should be a static variable in some
 * file.
 */

typedef struct ProcessGlobalValue {
    int epoch;			/* Epoch counter to detect changes in the
				 * master value. */
    int numBytes;		/* Length of the master string. */
    char *value;		/* The master string value. */
    Tcl_Encoding encoding;	/* system encoding when master string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the master string
				 * copy when a "get" request comes in before
				 * any "set" request has been received. */

			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, ClientData clientData,
			    int stackSize, int flags);
MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);
MODULE_SCOPE void	TclpMasterUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,

    do { \
	Tcl_Obj *_objPtr = (objPtr); \
	if (_objPtr->refCount-- <= 1) { \
	    if (!_objPtr->typePtr || !_objPtr->typePtr->freeIntRepProc) { \
		TCL_DTRACE_OBJ_FREE(_objPtr); \
		if (_objPtr->bytes \
			&& (_objPtr->bytes != tclEmptyStringRep)) { \
		    ckfree((char *) _objPtr->bytes); \
		} \
		_objPtr->length = -1; \
		TclFreeObjStorage(_objPtr); \
		TclIncrObjsFreed(); \
	    } else { \
		TclFreeObj(_objPtr); \
	    } \

 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree((char *) (objPtr))

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from

 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))

#define TclGetStringFromObj(objPtr, lenPtr) \
    ((objPtr)->bytes \
	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\
	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))

/*

 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    if (objPtr->bytes != NULL) { \
	if (objPtr->bytes != tclEmptyStringRep) { \
	    ckfree((char *) objPtr->bytes); \
	} \
	objPtr->bytes = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:

 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    if ((cmdPtr)->refCount-- <= 1) { \
	ckfree((char *) (cmdPtr));\
    }

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  ckfree((char *) (ptr))
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif

	    int elemSize, literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		ckfree((char *) listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    /* TODO: replace panic with error on alloc failure? */

static inline void
StashCallChain(
    Tcl_Obj *objPtr,
    CallChain *callPtr)
{
    callPtr->refCount++;

    TclFreeIntRep(objPtr);
    objPtr->typePtr = &methodNameType;
    objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
}

void
TclOOStashContext(

		}
	    }
	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		ckfree((char *) superclasses);
		return TCL_ERROR;
	    }
	}
    }

    /*
     * Install the list of superclasses into the class. Note that this also
     * involves splicing the class out of the superclasses' subclass list that
     * it used to be a member of and splicing it into the new superclasses'
     * subclass list.
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	}
	ckfree((char *) oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);

	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;

	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->classPtr->variables.list);
	} else if (i) {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->classPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);

    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;

    }

    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->variables.list);
	} else if (i) {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do {			\
	if ((ptr)->refCount-- <= 1) {		\
	    ckfree((char *) (ptr));		\
	}					\
    } while(0)

#endif /* TCL_OO_INTERNAL_H */

/*
 * Local Variables:

	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    size_t limit = STRING_MAXCHARS - needed;
	    size_t extra = needed - stringPtr->numChars1
		    + TCL_MIN_UNICHAR_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars1;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars1 = numChars;
    }
    return numChars;
}

/*
 *----------------------------------------------------------------------
 *

    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars1 == (size_t)-1) {
	    TclNumUtfChars(stringPtr->numChars1, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars1 == (size_t)objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    return stringPtr->unicode[index];
}

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars1;
    }
    return stringPtr->unicode;
}

/*
 *----------------------------------------------------------------------
 *

    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars1 == (size_t)-1) {
	    TclNumUtfChars(stringPtr->numChars1, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars1 == (size_t)objPtr->length) {
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars1 = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars1 = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);
	if ((size_t)length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string
	 */

	stringPtr->numChars1 = length;
	stringPtr->unicode[length] = 0;
	stringPtr->hasUnicode = 1;

	/*
	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
	 * the string rep.
	 */

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars1 = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if ((size_t)length > STRING_MAXCHARS) {

	}

	/*
	 * Mark the new end of the unicode string.
	 */

	stringPtr->unicode[length] = 0;
	stringPtr->numChars1 = length;
	stringPtr->hasUnicode = 1;

	/*
	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
	 * the string rep.
	 */
    }

    stringPtr = stringAlloc(numChars);
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars1 = numChars;
    stringPtr->hasUnicode = 1;

    TclInvalidateStringRep(objPtr);
    stringPtr->allocated = 0;
}

/*

     * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
     * objPtr's string rep.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode && (stringPtr->numChars1+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars1+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
    }
}

/*

     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars1;
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars1;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars != (size_t)-1) {
	stringPtr->numChars1 = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --

     * If not enough space has been allocated for the unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars1 + appendNumChars;
    stringCheckLimits(numChars);

    if (numChars > stringPtr->maxChars) {
	size_t offset = (size_t)-1;

	/*
	 * Protect against case where unicode points into the existing

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (unicode) {
	memmove(stringPtr->unicode + stringPtr->numChars1, unicode,
		appendNumChars * sizeof(Tcl_UniChar));
    }
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars1 = numChars;
    stringPtr->allocated = 0;

    TclInvalidateStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------

    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    size_t numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars1 != (size_t)-1) {
	stringPtr->numChars1 += numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUnicodeRep --

	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars1 = (size_t)-1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;

    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars1;

	if (Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *to;

	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    ch = 0;
	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars1);
	    to = Tcl_GetUnicode(objPtr);
	    while (--src >= from) {
		*to++ = *src;
	    }
	} else {
	    /* Reversing in place */
	    while (--src > from) {
		ch = *src;
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    if (objPtr->bytes) {
	int numChars = stringPtr->numChars1;
	int numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objPtr, numBytes);
	}

		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
	    }

	    from = to = objPtr->bytes;
	    stringPtr->numChars1 = charCount;
	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
    }

    return objPtr;
}

FillUnicodeRep(
    Tcl_Obj *objPtr)		/* The object in which to fill the unicode
				 * rep. */
{
    String *stringPtr = GET_STRING(objPtr);

    ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
	    stringPtr->numChars1);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    size_t numBytes,
    size_t numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    size_t needed, numOrigChars = 0;
    Tcl_UniChar *dst;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars1;
    }
    if (numAppendChars == (size_t)-1) {
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;
    stringCheckLimits(needed);

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
	stringPtr = GET_STRING(objPtr);
    }

    stringPtr->hasUnicode = 1;
    if (bytes) {
	stringPtr->numChars1 = needed;
    } else {
	numAppendChars = 0;
    }
    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
	bytes += TclUtfToUniChar(bytes, dst);
    }
    *dst = 0;

				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;

    if (srcStringPtr->numChars1 == (size_t)-1) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

	return;
    }

    if (srcStringPtr->hasUnicode) {
	int copyMaxChars;

	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars1) {
	    copyMaxChars = 2 * srcStringPtr->numChars1;
	} else {
	    copyMaxChars = srcStringPtr->maxChars;
	}
	copyStringPtr = stringAttemptAlloc(copyMaxChars);
	if (copyStringPtr == NULL) {
	    copyMaxChars = srcStringPtr->numChars1;
	    copyStringPtr = stringAlloc(copyMaxChars);
	}
	copyStringPtr->maxChars = copyMaxChars;
	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
		srcStringPtr->numChars1 * sizeof(Tcl_UniChar));
	copyStringPtr->unicode[srcStringPtr->numChars1] = 0;
    } else {
	copyStringPtr = stringAlloc(0);
	copyStringPtr->maxChars = 0;
	copyStringPtr->unicode[0] = 0;
    }
    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
    copyStringPtr->numChars1 = srcStringPtr->numChars1;

    /*
     * Tricky point: the string value was copied by generic object management
     * code, so it doesn't contain any extra bytes that might exist in the
     * source object.
     */

	TclFreeIntRep(objPtr);

	/*
	 * Create a basic String intrep that just points to the UTF-8 string
	 * already in place at objPtr->bytes.
	 */

	stringPtr->numChars1 = (size_t)-1;
	stringPtr->allocated = objPtr->length;
	stringPtr->maxChars = 0;
	stringPtr->hasUnicode = 0;
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;

     * In that circumstance, any lingering claim about the size of
     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */

    stringPtr->allocated = 0;

    if (stringPtr->numChars1 == 0) {
	TclInitStringRep(objPtr, tclEmptyStringRep, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars1);
    }
}

static size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,

 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct {
    size_t numChars1;	/* The number of chars in the string. (size_t)-1 means
				 * this value has not been calculated. Any other
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    size_t allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    int length;
    char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, length);
    Tcl_ResetResult(interp);
}

/*

    /*
     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	bytes = Tcl_GetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": must be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes);

    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
     * Fill the local thread copy directly with the Tcl_Obj value to avoid
     * loss of the intrep. Increment newValue refCount early to handle case
     * where we set a PGV to itself.
     */

    Tcl_IncrRefCount(newValue);
    cacheMap = GetThreadHash(&pgvPtr->key);
    ClearHash(cacheMap);
    hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
    Tcl_SetHashValue(hPtr, newValue);
    Tcl_MutexUnlock(&pgvPtr->mutex);
}

/*
 *----------------------------------------------------------------------
 *

Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    int epoch = pgvPtr->epoch;

    if (pgvPtr->encoding) {
	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);

	if (pgvPtr->encoding != current) {
	    /*
	     * The system encoding has changed since the master string value
	     * was saved. Convert the master value to be based on the new
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    pgvPtr->epoch++;
	    epoch = pgvPtr->epoch;
	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    (size_t) Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
    }
    cacheMap = GetThreadHash(&pgvPtr->key);
    hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
    if (NULL == hPtr) {
	int dummy;

	/*
	 * No cache for the current epoch - must be a new one.
	 *
	 * First, clear the cacheMap, as anything in it must refer to some

	/*
	 * Store a copy of the shared value in our epoch-indexed cache.
	 */

	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
	hPtr = Tcl_CreateHashEntry(cacheMap,
		INT2PTR(pgvPtr->epoch), &dummy);
	Tcl_MutexUnlock(&pgvPtr->mutex);
	Tcl_SetHashValue(hPtr, value);
	Tcl_IncrRefCount(value);
    }
    return Tcl_GetHashValue(hPtr);
}


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

const char *
Tcl_GetNameOfExecutable(void)
{
    int numBytes;
    const char *bytes =
	    Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);

    if (numBytes == 0) {
	return NULL;
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------

static int
SetOSTypeFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int length, result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");

    string = TclGetStringFromObj(objPtr, &length);
    Tcl_UtfToExternalDString(encoding, string, length, &ds);

    if (Tcl_DStringLength(&ds) > 4) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected Macintosh OS type but got \"%s\": ", string));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
	}

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

void
TclpInitLibraryPath(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

	    objPtr = Tcl_NewStringObj(str, -1);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetStringFromObj(pathPtr, lengthPtr);

    *valuePtr = ckalloc((*lengthPtr) + 1);
    memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --

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

static void
InitializeHostName(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *native = NULL;

#ifndef NO_UNAME
    struct utsname u;
    struct hostent *hp;

    if (gethostname(buffer, sizeof(buffer)) > -1) {	/* INTL: Native. */
	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    *lengthPtr = strlen(native);
    *valuePtr = ckalloc((*lengthPtr) + 1);
    memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
 *

/*
 * The following structure and linked list is to allow us to map between
 * volume mount points and drive letters on the fly (no Win API exists for
 * this).
 */

typedef struct MountPointMap {
    const TCHAR *volumeName;	/* Native wide string volume name. */
    TCHAR driveLetter;		/* Drive letter corresponding to the volume
				 * name. */
    struct MountPointMap *nextPtr;
				/* Pointer to next structure in list, or
				 * NULL. */
} MountPointMap;

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

void
TclpInitLibraryPath(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;

     * Look for the library in its source checkout location.
     */

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, lengthPtr);

    *valuePtr = ckalloc((*lengthPtr) + 1);
    memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * AppendEnvironment --

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

static void
InitializeDefaultLibraryDir(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
    char *end, *p;

    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeSourceLibraryDir --
 *

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

static void
InitializeSourceLibraryDir(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
    char *end, *p;

    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * ToUtf --
 *

/*
 * The following macros have trivial definitions, allowing generic code to
 * address platform-specific issues.
 */

#define TclpReleaseFile(file)	ckfree((char *) file)

/*
 * The following macros and declarations wrap the C runtime library
 * functions.
 */

#define TclpExit		exit

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

void
InitializeHostName(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
    Tcl_DString ds;

    if (GetComputerName(tbuf, &length) != 0) {

	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = ckalloc((*lengthPtr) + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --

	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    ckfree((char *)winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --