sudo: false
language: c

matrix:
  include:
    - name: "Linux/Clang/Shared"
      os: linux
      dist: xenial
      compiler: clang
      env:
        - BUILD_DIR=unix
    - name: "Linux/Clang/Static"
      os: linux
      dist: xenial
      compiler: clang
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - name: "Linux/GCC/Shared"
      os: linux
      dist: xenial
      compiler: gcc
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC/Static"
      os: linux
      dist: xenial
      compiler: gcc
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - name: "Linux/GCC 4.9/Shared"
      os: linux
      dist: xenial
      compiler: gcc-4.9
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-4.9
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 5/Shared"
      os: linux
      dist: xenial
      compiler: gcc-5
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-5
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 6/Shared"
      os: linux
      dist: xenial
      compiler: gcc-6
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-6
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 7/Shared"
      os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 7/Shared/UTF_MAX=6"
      os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
    - name: "Linux/GCC 7/Shared/UTF_MAX=3"
      os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3
    - name: "Linux/GCC 7/Shared/NO_DEPRECATED"
      os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1
    - name: "macOS/Xcode 8/Shared/Unix-like"
      os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=unix
    - name: "macOS/Xcode 8/Shared/Mac-like"
      os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
    - name: "macOS/Xcode 9/Shared/Mac-like"
      os: osx
      osx_image: xcode9
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
    - name: "macOS/Xcode 10/Shared/Mac-like"
      os: osx
      osx_image: xcode10.2
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
### C builds not currently supported on Windows instances
#    - os: windows
#      env:
#        - BUILD_DIR=win
### ... so proxy with a Mingw cross-compile
# Test with mingw-w64 (32 bit)
    - name: "Linux-cross-Windows-32/GCC/Shared/no test"
      os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT=--host=i686-w64-mingw32
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-32/GCC/Static/no test"
      os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 --disable-shared"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-32/GCC/Shared/no test/UTF_MAX=6"
      os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-32/GCC/Shared/no test/UTF_MAX=3"
      os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-32/GCC/Shared/no test/NO_DEPRECATED"
      os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1"
        - NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
    - name: "Linux-cross-Windows-64/GCC/Shared/no test"
      os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-64/GCC/Static/no test"
      os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-64/GCC/Shared/no test/UTF_MAX=6"
      os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-64/GCC/Shared/no test/UTF_MAX=3"
      os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
        - NO_DIRECT_TEST=1
    - name: "Linux-cross-Windows-64/GCC/Shared/no test/NO_DEPRECATED"
      os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64

already exist.
.AP int objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors. This allows the generation of correct
error messages even when complicated calling patterns are used (e.g., via the
\fBnext\fR command).
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.
.AP ClientData metadata in
An item of metadata to attach to the class, or NULL to remove the metadata
associated with a particular \fImetaTypePtr\fR.
.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in

with that name, and then to use \fBTcl_GetObjectAsClass\fR.
.PP
Every object has its own command and namespace associated with it. The command
may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of
the object (and hence the name of the command) with \fBTcl_GetObjectName\fR,
and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR
function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR
is a shared reference. You can also get whether the object has been marked for
deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the
object has begun); this can be useful during the processing of methods.
.PP
Instances of classes are created using \fBTcl_NewObjectInstance\fR, which
creates an object from any class (and which is internally called by both
the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes
parameters that optionally give the name of the object and namespace to
create, and which describe the arguments to pass to the class's constructor
(if any). The result of the function will be either a reference to the newly
created object, or NULL if the creation failed (when an error message will be
left in the interpreter result). In addition, objects may be copied by using
\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
any constructors.
.PP
Note that the lifetime management of objects is handled internally within
TclOO, and does not use \fBTcl_Preserve\fR. \fIIt is not safe to put a
Tcl_Object handle in a C structure with a lifespan different to the object;\fR
you should use the object's command name (as retrieved with
\fBTcl_GetObjectName\fR) instead. It is safe to use a Tcl_Object handle for
the lifespan of a call of a method on that object; handles do not become
invalid while there is an outstanding call on their object (even if the only
operation guaranteed to be safe on them is \fBTcl_ObjectDeleted\fR; the other
operations are only guaranteed to work on non-deleted objects).
.SH "OBJECT AND CLASS METADATA"
.PP
Every object and every class may have arbitrary amounts of metadata attached
to it, which the object or class attaches no meaning to beyond what is
described in a Tcl_ObjectMetadataType structure instance. Metadata to be
attached is described by the type of the metadata (given in the
\fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	overPtr->rangeCheckMagic = RMAGIC;
	BLOCK_END(overPtr) = RMAGIC;
#endif

	Tcl_MutexUnlock(allocMutexPtr);
	return (char *)(overPtr+1);
    }

    /*
     * Convert amount of memory requested into closest block size stored in
     * hash buckets which satisfies request. Account for space used per block
     * for accounting.
     */

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = (Interp *)ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

#ifdef TCL_NO_DEPRECATED
    iPtr->result = &tclEmptyString;
#else
    iPtr->result = iPtr->resultSpace;
#endif

    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
     * structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
    iPtr->scriptCLLocPtr = NULL;

    iPtr->activeVarTracePtr = NULL;

    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = (CallFrame *)ckalloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;

    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

		&& (cmdInfoPtr->nreProc == NULL)) {
	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
	}

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = (Command *)ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;

    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
	occdPtr->expected = opcmdInfoPtr->expected;
	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);

    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    ckfree(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *

}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    Tcl_ObjCmdProc *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {

static int
BadEnsembleSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
				 * to be deleted. */
    ClientData clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}

    hTablePtr = iPtr->assocData;
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    ckfree(dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}

{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    } else {
	dPtr = (AssocData *)ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}


    if (iPtr->assocData == NULL) {
	return;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    ckfree(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}


    if (iPtr->assocData == NULL) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return NULL;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (procPtr != NULL) {
	*procPtr = dPtr->proc;
    }
    return dPtr->clientData;
}

/*

     * TIP #285, Script cancellation support. Delete this interp from the
     * global hash table of CancelInfo structs.
     */

    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
    if (hPtr != NULL) {
	CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);

	if (cancelInfo != NULL) {
	    if (cancelInfo->result != NULL) {
		ckfree(cancelInfo->result);
	    }
	    ckfree(cancelInfo);
	}

	 * to create any new hidden or non-hidden commands.
	 * Tcl_DeleteCommandFromToken will remove the entry from the
	 * hiddenCmdTablePtr.
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	iPtr->assocData = NULL;
	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
		hPtr != NULL;
		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
	    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);

     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
     * contents.
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr);
	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);

	procPtr->iPtr = NULL;
	if (cfPtr) {
	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(cfPtr->data.eval.path);
	    }

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr);

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

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already

    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown hidden command \"%s\"", hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
                hiddenCmdToken, NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve any existing import links so we can restore
	 * them down below. That way, you can redefine a command and its
	 * import status will remain intact.
	 */

	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;

     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;
	    dataPtr = (ImportedCmdData *)refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent

}

Tcl_Command
TclCreateObjCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,	/* Name of command, without any namespace
                                 * components. */
    Tcl_Namespace *ns,   /* The namespace to create the command in */
    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
				 * name. */
    ClientData clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    int deleted = 0, isNew = 0;
    Command *cmdPtr;
    ImportRef *oldRefPtr = NULL;
    ImportedCmdData *dataPtr;
    Tcl_HashEntry *hPtr;
    Namespace *nsPtr = (Namespace *) ns;

    /*
     * If the command name we seek to create already exists, we need to delete
     * that first. That can be tricky in the presence of traces. Loop until we
     * no longer find an existing command in the way, or until we've deleted
     * one command and that didn't finish the job.
     */

	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*
	 * [***] This is wrong.  See Tcl Bug a16752c252.
	 * However, this buggy behavior is kept under particular circumstances
	 * to accommodate deployed binaries of the "tclcompiler" program
	 * <http://sourceforge.net/projects/tclpro/> that crash if the bug is
	 * fixed.

	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;

     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;

	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent

int
TclInvokeStringCommand(
    ClientData clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    register int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr = (Command *)clientData;
    int i, result;
    const char **argv = (const char **)
	    TclStackAlloc(interp, (objc + 1) * sizeof(char *));

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

static int
CancelEvalProc(
    ClientData clientData,	/* Interp to cancel the script in progress. */
    Tcl_Interp *interp,		/* Ignored */
    int code)			/* Current return code from command. */
{
    CancelInfo *cancelInfo = (CancelInfo *)clientData;
    Interp *iPtr;

    if (cancelInfo != NULL) {
	Tcl_MutexLock(&cancelLock);
	iPtr = (Interp *) cancelInfo->interp;

	if (iPtr != NULL) {

				 * argument. */
    Tcl_MathProc *proc,		/* C function that implements the math
				 * function. */
    ClientData clientData)	/* Additional value to pass to the
				 * function. */
{
    Tcl_DString bigName;
    OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData));

    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
    Tcl_DStringAppend(&bigName, name, -1);

    ClientData clientData,	/* Pointer to OldMathFuncData describing the
				 * function being called */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    Tcl_Obj *valuePtr;
    OldMathFuncData *dataPtr = (OldMathFuncData *)clientData;
    Tcl_Value funcResult, *args;
    int result;
    int j, k;
    double d;

    /*
     * Check argument count.
     */

    if (objc != dataPtr->numArgs + 1) {
	MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
	return TCL_ERROR;
    }

    /*
     * Convert arguments from Tcl_Obj's to Tcl_Value's.
     */

    args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
    for (j = 1, k = 0; j < objc; ++j, ++k) {
	/* TODO: Convert to TclGetNumberFromObj? */
	valuePtr = objv[j];
	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
	if (result != TCL_OK) {
	    const Tcl_ObjIntRep *irPtr

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

static void
OldMathFuncDeleteProc(
    ClientData clientData)
{
    OldMathFuncData *dataPtr = (OldMathFuncData *)clientData;

    ckfree(dataPtr->argTypes);
    ckfree(dataPtr);
}

/*
 *----------------------------------------------------------------------

    /*
     * Retrieve function info for user defined functions; return dummy
     * information for builtins.
     */

    if (cmdPtr->objProc == &OldMathFuncProc) {
	OldMathFuncData *dataPtr = (OldMathFuncData *)cmdPtr->clientData;

	*procPtr = dataPtr->proc;
	*numArgsPtr = dataPtr->numArgs;
	*argTypesPtr = dataPtr->argTypes;
	*clientDataPtr = dataPtr->clientData;
    } else {
	*procPtr = NULL;

    if (hPtr == NULL) {
	/*
	 * No CancelInfo record for this interpreter.
	 */

	goto done;
    }
    cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);

    /*
     * Populate information needed by the interpreter thread to fulfill the
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = NULL;
    int enterTracesDone = 0;

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).

static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0];
    ClientData clientData = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	const char *a[10];
	int i = 0;

static int
TEOV_RestoreVarFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ((Interp *) interp)->varFramePtr = (CallFrame *)data[0];
    return result;
}

static int
TEOV_Exception(
    ClientData data[],
    Tcl_Interp *interp,

    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

TEOV_NotFoundCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];
    Namespace *savedNsPtr = (Namespace *)data[2];

    int i;

    if (savedNsPtr) {
	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }

    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);

	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    (int *)ckalloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *)ckalloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;

		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];

TclArgumentEnter(
    Tcl_Interp *interp,
    Tcl_Obj **objv,
    int objc,
    CmdFrame *cfPtr)
{
    Interp *iPtr = (Interp *) interp;
    int isNew, i;
    Tcl_HashEntry *hPtr;
    CFWord *cfwPtr;

    for (i = 1; i < objc; i++) {
	/*
	 * Ignore argument words without line information (= dynamic). If they
	 * are variables they may have location information associated with
	 * that, either through globally recorded 'set' invokations, or
	 * literals in bytecode. Eitehr way there is no need to record
	 * something here.
	 */

	if (cfPtr->line[i] < 0) {
	    continue;
	}
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);
	if (isNew) {
	    /*
	     * The word is not on the stack yet, remember the current location
	     * and initialize references.
	     */

	    cfwPtr = (CFWord *)ckalloc(sizeof(CFWord));
	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->word = i;
	    cfwPtr->refCount = 1;
	    Tcl_SetHashValue(hPtr, cfwPtr);
	} else {
	    /*
	     * The word is already on the stack, its current location is not
	     * relevant. Just remember the reference to prevent early removal.
	     */

	    cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
	    cfwPtr->refCount++;
	}
    }
}

/*
 *----------------------------------------------------------------------

	CFWord *cfwPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);

	if (!hPtr) {
	    continue;
	}
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	ckfree(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);

    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);

    if (!hePtr) {
	return;
    }
    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
    ePtr = &eclPtr->loc[cmd];

    /*
     * ePtr->nline is the number of words originally parsed.
     *
     * objc is the number of elements getting invoked.
     *

     *
     * Item (2) is why we can use objv to get the literals, and do not
     * have to save them at compile time.
     */

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isNew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isNew);
	    CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;

	    if (isNew) {
		/*
		 * The word is not on the stack yet, remember the current
		 * location and initialize references.
		 */

		cfwPtr->prevPtr = NULL;
	    } else {
		/*
		 * The object is already on the stack, however it may have
		 * a different location now (literal sharing may map
		 * multiple location to a single Tcl_Obj*. Save the old
		 * information in the new structure.
		 */

		cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
	    }

	    Tcl_SetHashValue(hPtr, cfwPtr);
	}
    } /* for */

    cfPtr->litarg = lastPtr;

    Interp *iPtr = (Interp *) interp;
    CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;

    while (cfwPtr) {
	CFWordBC *nextPtr = cfwPtr->nextPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
	CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);

	if (xPtr != cfwPtr) {
	    Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
	}

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);

    /*
     * First look for location information recorded in the argument
     * stack. That is nearest.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
    if (hPtr) {
	CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	*wordPtr = cfwPtr->word;
	*cfPtrPtr = cfwPtr->framePtr;
	return;
    }

    /*
     * Check if the Tcl_Obj has location information as a bytecode literal, in
     * that stack.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
    if (hPtr) {
	CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);

	framePtr = cfwPtr->framePtr;
	framePtr->data.tebc.pc = (char *) (((ByteCode *)
		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
	*cfPtrPtr = cfwPtr->framePtr;
	*wordPtr = cfwPtr->word;
	return;

static int
TEOEx_ByteCodeCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *savedVarFramePtr = (CallFrame *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];
    int allowExceptions = PTR2INT(data[2]);

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {

static int
TEOEx_ListCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];
    CmdFrame *eoFramePtr = (CmdFrame *)data[1];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[2];

    /*
     * Remove the cmdFrame
     */

    if (eoFramePtr) {
	iPtr->cmdFramePtr = eoFramePtr->nextPtr;

    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
     * Avoid the exception-handling brain damage when numLevels == 0
     */

    iPtr->numLevels++;
    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);

int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    int objc;
    Tcl_Obj **objv;

    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];


static int
RewindCoroutineCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]);
}

static int
RewindCoroutine(
    CoroutineData *corPtr,
    int result)
{

    return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}

static void
DeleteCoroutine(
    ClientData clientData)
{
    CoroutineData *corPtr = (CoroutineData *)clientData;
    Tcl_Interp *interp = corPtr->eePtr->interp;
    NRE_callback *rootPtr = TOP_CB(interp);

    if (COR_IS_SUSPENDED(corPtr)) {
	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
    }
}

static int
NRCoroutineCallerCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This is the last callback in the caller execEnv, right before switching
     * to the coroutine's
     */


static int
NRCoroutineExitCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This runs at the bottom of the Coroutine's execEnv: it will be executed
     * when the coroutine returns or is wound down, but not when it yields. It
     * deletes the coroutine and restores the caller's environment.
     */

int
TclNRCoroutineActivateCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    int type = PTR2INT(data[1]);
    int numLevels, unused;
    int *stackLevel = &unused;

    if (!corPtr->stackLevel) {
        /*
         * -- Coroutine is suspended --

TclNREvalList(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    int objc;
    Tcl_Obj **objv;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];

    Tcl_IncrRefCount(listPtr);

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);

    }

    /*
     * An active coroutine is "active". Can't tell what it might do in the
     * future.
     */

    corPtr = (CoroutineData *)cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
        return TCL_OK;
    }

    /*
     * Inactive coroutines are classified by the (effective) command used to

    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objPtr), NULL);
        return NULL;
    }
    return (CoroutineData *)cmdPtr->objClientData;
}

static int
TclNRCoroInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,

static int
InjectHandler(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int objc;
    Tcl_Obj **objv;

    if (!isProbe) {
        /*

static int
InjectHandlerPostCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int numLevels;

    /*
     * Delete the command words for what we just executed.
     */

int
TclNRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = (CoroutineData *)clientData;

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

    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;

     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,

	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclInvalidateStringRep(objPtr);

    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }
    SET_BYTEARRAY(&ir, byteArrayPtr);

		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    if (newLength > byteArrayPtr->allocated) {
	byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
	byteArrayPtr->allocated = newLength;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = newLength;
    return byteArrayPtr->bytes;
}

	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	improper = improper || (ch > 255);
	*dst++ = UCHAR(ch);
    }

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

    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}

static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {

    int type)			/* What type of thing are we copying? */
{
    switch (NeedReversing(type)) {
    case 0:
	memcpy(to, from, length);
	break;
    case 1: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	switch (length) {
	case 4:
	    toPtr[0] = fromPtr[3];
	    toPtr[1] = fromPtr[2];
	    toPtr[2] = fromPtr[1];
	    toPtr[3] = fromPtr[0];

	    toPtr[6] = fromPtr[1];
	    toPtr[7] = fromPtr[0];
	    break;
	}
	break;
    }
    case 2: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	toPtr[0] = fromPtr[4];
	toPtr[1] = fromPtr[5];
	toPtr[2] = fromPtr[6];
	toPtr[3] = fromPtr[7];
	toPtr[4] = fromPtr[0];
	toPtr[5] = fromPtr[1];
	toPtr[6] = fromPtr[2];
	toPtr[7] = fromPtr[3];
	break;
    }
    case 3: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	toPtr[0] = fromPtr[3];
	toPtr[1] = fromPtr[2];
	toPtr[2] = fromPtr[1];
	toPtr[3] = fromPtr[0];
	toPtr[4] = fromPtr[7];
	toPtr[5] = fromPtr[6];

	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
	    register Tcl_HashEntry *hPtr;
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
	    if (!isNew) {
		return (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	    }
	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
		register Tcl_Obj *objPtr = Tcl_NewWideIntObj(value);

		Tcl_IncrRefCount(objPtr);
		Tcl_SetHashValue(hPtr, objPtr);
		return objPtr;

    if (numberCachePtr == NULL) {
	return;
    }

    hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
    while (hEntry != NULL) {
	Tcl_Obj *value = (Tcl_Obj *)Tcl_GetHashValue(hEntry);

	if (value != NULL) {
	    Tcl_DecrRefCount(value);
	}
	hEntry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(numberCachePtr);

				 * epoch */
    Tcl_WideInt localSeconds;	/* Local time expressed in nominal seconds
				 * from the Posix epoch */
    int tzOffset;		/* Time zone offset in seconds east of
				 * Greenwich */
    Tcl_Obj *tzName;		/* Time zone name */
    int julianDay;		/* Julian Day Number in local time zone */
    int isBce;			/* 1 if BCE */
    int gregorian;		/* Flag == 1 if the date is Gregorian */
    int year;			/* Year of the era */
    int dayOfYear;		/* Day of the year (1 January == 1) */
    int month;			/* Month number */
    int dayOfMonth;		/* Day of the month */
    int iso8601Year;		/* ISO8601 week-based year */
    int iso8601Week;		/* ISO8601 week number */

	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = (ClockClientData *)ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.

static int
ClockConvertlocaltoutcObjCmd(
    ClientData clientData,	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;

    /*
     * Check params.
     */

    Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
	    Tcl_NewWideIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
	    Tcl_NewWideIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
	    literals[fields.isBce ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
	    Tcl_NewWideIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
	    Tcl_NewWideIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
	    Tcl_NewWideIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],

    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
		&fields.dayOfMonth) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearMonthDay(&fields, changeover);

    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
		&fields.iso8601Year) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
		&fields.iso8601Week) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
		&fields.dayOfWeek) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearWeekDay(&fields, changeover);

	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

    fields->isBce = 0;
    fields->year = timeVal->tm_year + 1900;
    fields->month = timeVal->tm_mon + 1;
    fields->dayOfMonth = timeVal->tm_mday;
    GetJulianDayFromEraYearMonthDay(fields, changeover);

    /*
     * Convert that value to seconds.

    /*
     * Find the given date, minus three days, plus one year. That date's
     * iso8601 year is an upper bound on the ISO8601 year of the given date.
     */

    temp.julianDay = fields->julianDay - 3;
    GetGregorianEraYearDay(&temp, changeover);
    if (temp.isBce) {
	temp.iso8601Year = temp.year - 1;
    } else {
	temp.iso8601Year = temp.year + 1;
    }
    temp.iso8601Week = 1;
    temp.dayOfWeek = 1;
    GetJulianDayFromEraYearWeekDay(&temp, changeover);

    /*
     * temp.julianDay is now the start of an ISO8601 year, either the one
     * corresponding to the given date, or the one after. If we guessed high,
     * move one year earlier
     */

    if (fields->julianDay < temp.julianDay) {
	if (temp.isBce) {
	    temp.iso8601Year += 1;
	} else {
	    temp.iso8601Year -= 1;
	}
	GetJulianDayFromEraYearWeekDay(&temp, changeover);
    }

    year += n;

    /*
     * store era/year/day back into fields.
     */

    if (year <= 0) {
	fields->isBce = 1;
	fields->year = 1 - year;
    } else {
	fields->isBce = 0;
	fields->year = year;
    }
    fields->dayOfYear = day + 1;
}

/*
 *----------------------------------------------------------------------

				 * given year */
    TclDateFields firstWeek;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    firstWeek.isBce = fields->isBce;
    firstWeek.year = fields->iso8601Year;
    firstWeek.month = 1;
    firstWeek.dayOfMonth = 4;
    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);

    /*
     * Find Monday of week 1.

static void
GetJulianDayFromEraYearMonthDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;

    if (fields->isBce) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }

    /*
     * Reduce month modulo 12.

    /*
     * Adjust the year after reducing the month.
     */

    fields->gregorian = 1;
    if (year < 1) {
	fields->isBce = 1;
	fields->year = 1-year;
    } else {
	fields->isBce = 0;
	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

static int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    int year = fields->year;

    if (fields->isBce) {
	year = 1 - year;
    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {

    const time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
    localtime_r(timePtr, tmPtr);
#else
    struct tm *sysTmPtr;

    Tcl_MutexLock(&clockMutex);
    sysTmPtr = localtime(timePtr);

static int
ClockParseformatargsObjCmd(
    ClientData clientData,	/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj **litPtr = dataPtr->literals;
    Tcl_Obj *results[3];	/* Format, locale and timezone */
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;
    static const char *const options[] = { /* Command line options expected */

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

static void
TzsetIfNecessary(void)
{
    static char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
				 * clockMutex. */
    const char *tzIsNow;	/* Current value of TZ */

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    ckfree(tzWas);
	}
	tzWas = (char *)ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);

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

static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);

CatchObjCmdCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *varNamePtr = (Tcl_Obj *)data[1];
    Tcl_Obj *optionVarNamePtr = (Tcl_Obj *)data[2];
    int rewind = iPtr->execEnvPtr->rewind;

    /*
     * We disable catch in interpreters where the limit has been exceeded.
     */

    if (rewind || Tcl_LimitExceeded(interp)) {

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];

    if (objPtr != NULL) {
	Tcl_DecrRefCount(objPtr);
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);

	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = Tcl_GetModificationTimeFromStat(&buf);

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * atime - hopefully the same as the one we sent in. However, fs's
	 * like FAT don't even know what atime is.
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf)));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrModifyTimeCmd --

	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = Tcl_GetAccessTimeFromStat(&buf);
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * mtime - hopefully the same as the one we sent in.
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf)));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrLinkStatCmd --

    STORE_ARY("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;
}

static int
ForSetupCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = (ForIterData *)data[0];

    if (result != TCL_OK) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
	}
	TclSmallFreeEx(interp, iterPtr);
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return TCL_OK;
}

int
TclNRForIterCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj;

    switch (result) {
    case TCL_OK:
    case TCL_CONTINUE:
	/*
	 * We need to reset the result before evaluating the expression.

static int
ForCondCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj = (Tcl_Obj *)data[1];
    int value;

    if (result != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFreeEx(interp, iterPtr);
	return result;
    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {

static int
ForNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *next = iterPtr->next;

    if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
		NULL);

	/*

static int
ForPostNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = (ForIterData *)data[0];

    if ((result != TCL_BREAK) && (result != TCL_OK)) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
	    TclSmallFreeEx(interp, iterPtr);
	}
	return result;

				 * evaluation. */
    int collect,		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
    int objc,			/* The arguments being passed in... */
    Tcl_Obj *const objv[])
{
    int numLists = (objc-2) / 2;
    struct ForeachState *statePtr;
    int i, j, result;

    if (objc < 4 || (objc%2 != 0)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"varList list ?varList list ...? command");
	return TCL_ERROR;
    }

     *		statePtr->argvList[i].
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = (struct ForeachState *)TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;

static int
ForeachLoopStep(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    struct ForeachState *statePtr = (struct ForeachState *)data[0];

    /*
     * Process the result code from this run of the [foreach] body. Note that
     * this switch uses fallthroughs in several places. Maintainer aware!
     */

    switch (result) {

IfConditionCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1];
    int i = PTR2INT(data[2]);
    Tcl_Obj *boolObj = (Tcl_Obj *)data[3];
    int value, thenScriptIndex = 0;
    const char *clause;

    if (result != TCL_OK) {
	TclDecrRefCount(boolObj);
	return result;
    }

	 * Special case for when the pattern doesn't include any of glob's
	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		elemObjPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
	    return TCL_OK;
	}
	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {

		}
	    }
	    if (entryPtr == NULL) {
		tablePtr = &globalNsPtr->cmdTable;
		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
	    }
	    if (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr);
		Tcl_ListObjAppendElement(interp, listPtr,
			Tcl_NewStringObj(cmdName, -1));
		Tcl_SetObjResult(interp, listPtr);
		return TCL_OK;
	    }
	}
    } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
	/*
	 * The pattern is non-trivial, but either there is no explicit path or
	 * there is an explicit namespace in the pattern. In both cases, the
	 * old matching scheme is perfect.
	 */

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }

	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr,
				Tcl_NewStringObj(cmdName, -1));
		    }
		}

	 * We keep a hash of the objects already added to the result list.
	 */

	Tcl_InitObjHashTable(&addedCommandsTable);

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		(void) Tcl_CreateHashEntry(&addedCommandsTable,
			elemObjPtr, &isNew);
	    }

		continue;
	    }
	    if (pathNsPtr == globalNsPtr) {
		foundGlobal = 1;
	    }
	    entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
			    elemObjPtr, &isNew);
		    if (isNew) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if (!foundGlobal) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    if (Tcl_FindHashEntry(&addedCommandsTable,
			    (char *) elemObjPtr) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {

	     */

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {
		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
		if (efiPtr->fields[i].proc) {
		    lv[lc++] =
			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
		} else {
		    lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData;
		}
	    }
	}
    }

    /*
     * 'level'. Common to all frame types. Conditional on having an associated

     */

    listPtr = Tcl_NewListObj(0, NULL);
#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

	    if (!TclIsProc(cmdPtr)) {
		realCmdPtr = (Command *)
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}

	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

		if (!TclIsProc(cmdPtr)) {
		    realCmdPtr = (Command *)
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }

	 * decided not to "fix" it in 8.3, leaving the behavior slightly
	 * different.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
			realCmdPtr = (Command *) TclGetOriginalCommand(
				(Tcl_Command) cmdPtr);

			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
				&& TclIsProc(realCmdPtr))) {
			    Tcl_ListObjAppendElement(interp, listPtr,
				    Tcl_NewStringObj(cmdName, -1));

    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = (int *)ckalloc((objc - 2) * sizeof(int));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    ckfree(idxv);
	    return TCL_ERROR;
	}
    }

    }

    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elementArray = (SortElement *)ckalloc(length * sizeof(SortElement));

    for (i=0; i < length; i++) {
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(

	};
	int index;

	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
		"option", TCL_EXACT, &index)) {
	    return TCL_ERROR;
	}
	pkgFiles = (void **)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	/* Make sure that during the following TclNREvalFile no filenames
	 * are recorded for inclusion in the "package files" command */
	names = *pkgFiles;
	*pkgFiles = NULL;
    }
    result = TclNREvalFile(interp, fileName, encodingName);
    if (pkgFiles) {

		/*
		 * Don't need to fiddle with refcount...
		 */

		Tcl_SetHashValue(hPtr, objPtr);
	    } else {
		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	    }
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	}
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	char *p;

    /*
     * We've got a match. Find a body to execute, skipping bodies that are
     * "-".
     */

  matchFound:
    ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    *ctxPtr = *iPtr->cmdFramePtr;

    if (splitObjs) {
	/*
	 * We have to perform the GetSrc and other type dependent handling of
	 * the frame here because we are munging with the line numbers,
	 * something the other commands like if, etc. are not doing. Them are

	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    ctxPtr->line = (int *)ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
	} else {
	    /*
	     * This is either a dynamic code word, when all elements are
	     * relative to themselves, or something else less expected and
	     * where we have no information. The result is the same in both
	     * cases; tell the code to come that it doesn't know where it is,
	     * which triggers reversion to the old behavior.
	     */

	    int k;

	    ctxPtr->line = (int *)ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    ClientData data[],		/* Data passed from Tcl_NRAddCallback above */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int result)			/* Result to return*/
{
    /* Unpack the preserved data */

    int splitObjs = PTR2INT(data[0]);
    CmdFrame *ctxPtr = (CmdFrame *)data[1];
    int pc = PTR2INT(data[2]);
    const char *pattern = (const char *)data[3];
    int patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {

    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
    int i, dummy, code, objc;
    int numHandlers = 0;

    handlersObj = (Tcl_Obj *)data[0];
    finallyObj = (Tcl_Obj *)data[1];
    objv = (Tcl_Obj **)data[2];
    objc = PTR2INT(data[3]);

    cmdObj = objv[0];

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.
     */

    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
    Tcl_Obj *finallyObj;
    int finally;

    objv = (Tcl_Obj **)data[0];
    options = (Tcl_Obj *)data[1];
    handlerKindObj = (Tcl_Obj *)data[2];
    finally = PTR2INT(data[3]);

    cmdObj = objv[0];
    finallyObj = finally ? objv[finally] : 0;

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.

TryPostFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *cmdObj;

    resultObj = (Tcl_Obj *)data[0];
    options = (Tcl_Obj *)data[1];
    cmdObj = (Tcl_Obj *)data[2];

    /*
     * If the result wasn't OK, we need to adjust the result options.
     */

    if (result != TCL_OK) {
	Tcl_DecrRefCount(resultObj);

    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.
     */

    duiPtr = (DictUpdateInfo *)ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.
	 */

 */

static ClientData
DupDictUpdateInfo(
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    size_t len;

    dui1Ptr = (DictUpdateInfo *)clientData;
    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
    dui2Ptr = (DictUpdateInfo *)ckalloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    ckfree(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    int i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    int i;
    Tcl_Obj *variables = Tcl_NewObj();

    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewIntObj(duiPtr->varIndices[i]));
    }

    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    numLists = (numWords - 2)/2;
    infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
	    + (numLists - 1) * sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Parse each var list into sequence of var names.  Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
		+ (numVars - 1) * sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;

 */

static ClientData
DupForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    register ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
	    + numLists * sizeof(ForeachVarList *));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
		+ numVars * sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }

 */

static void
FreeForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to free. */
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    register int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	ckfree(listPtr);
    }

static void
PrintForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;

    Tcl_AppendToObj(appendObj, "data=[", -1);

    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);

static void
PrintNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);

static void
DisassembleForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Data stores.
     */

static void
DisassembleNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Jump offset.
     */

    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	objv[i] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}

	    if (!(flags & TCL_NO_ELEMENT) && elNameLen) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = elNameLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = 1;
	    }

	    if (!(flags & TCL_NO_ELEMENT)) {
	      if (remainingLen) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = (Tcl_Obj **)TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     *
     * TODO: There is potential for improvement if all option keys are known

    int code = TCL_ERROR;
    DefineLineInformation;	/* TIP #280 */

    if (numArgs == 0) {
	return TCL_ERROR;
    }

    objv = (Tcl_Obj **)TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));

    for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    goto cleanup;

	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {
	    return TCL_ERROR;
	}
	bodyTokenArray = (Tcl_Token *)ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = (int *)ckalloc(sizeof(int) * maxLen);
	bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = (int *)ckalloc(sizeof(int) * numWords);
	bodyContLines = (int **)ckalloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */

    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    contFixCount = 0;
    fixupArray = (JumpFixup *)TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = (unsigned int *)TclStackAlloc(interp, sizeof(int) * numBodyTokens);
    memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<numBodyTokens ; i+=2) {
	nextArmFixupIndex = -1;
	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {

     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty). Note that

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

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    JumptableInfo *newJtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {
	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
    }
    return newJtPtr;
}

static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    ckfree(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset, i = 0;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));

	if (i++) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	    if (i%4==0) {
		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
	    }
	}
	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
		keyPtr, pcOffset + offset);
    }
}

static void
DisassembleJumptableInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_Obj *mapping = Tcl_NewObj();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));
	Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
		Tcl_NewIntObj(offset));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
}


    /*
     * Extract information about what handlers there are.
     */

    numHandlers = numWords >> 2;
    numWords -= numHandlers * 4;
    if (numHandlers > 0) {
	handlerTokens = (Tcl_Token**)TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
	matchClauses = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    int objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;

    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     * For us to be here, there must be at least one handler.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	noError[i] = -1;
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);

    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	int noTrapError, trapError;
	const char *p;

	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);

				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		errCode = "NOMEM";

int
TclSingleOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    OpNode nodes[2];
    Tcl_Obj *const *litObjv = objv + 1;

    if (objc != 1 + occdPtr->i.numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;

    Tcl_Obj *const objv[])
{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
	Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
		2 * (objc-2) * sizeof(Tcl_Obj *));
	OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
	unsigned char lexeme;
	int i, lastAnd = 1;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

int
TclVariadicOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    int code;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
	return TCL_OK;
    }

int
TclNoIdentOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }
    return TclVariadicOpCmd(clientData, interp, objc, objv);
}

     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.
     *
     * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
     * non-compiling evaluator
     */

    envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*

	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = (int *)ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = (unsigned char *)ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;

 */

void
TclExpandCodeArray(
    void *envArgPtr)		/* Points to the CompileEnv whose code array
				 * must be enlarged. */
{
    CompileEnv *envPtr = (CompileEnv *)envArgPtr;
				/* The CompileEnv containing the code array to
				 * be doubled in size. */

    /*
     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
     * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	unsigned char *newPtr = (unsigned char *)ckalloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;

	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
	     * ckrealloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }

	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
	 */

	size_t currElems = eclPtr->nloc;
	size_t newElems = (currElems ? 2*currElems : 1);
	size_t newBytes = newElems * sizeof(ECL);

	eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = (int *)ckalloc(numWords * sizeof(int));
    ePtr->next = (int **)ckalloc(numWords * sizeof(int *));
    ePtr->nline = numWords;
    wwlines = (int *)ckalloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);

	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
	int newElems = 2*envPtr->exceptArrayEnd;
	size_t newBytes = newElems * sizeof(ExceptionRange);
	size_t newBytes2 = newElems * sizeof(ExceptionAux);

	if (envPtr->mallocedExceptArray) {
	    envPtr->exceptArrayPtr =
		    (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes);
	    ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}

	Tcl_Panic("trying to add 'break' fixup to full exception range");
    }

    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
	auxPtr->allocBreakTargets *= 2;
	auxPtr->allocBreakTargets += 2;
	if (auxPtr->breakTargets) {
	    auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void

	Tcl_Panic("trying to add 'continue' fixup to full exception range");
    }

    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
	auxPtr->allocContinueTargets *= 2;
	auxPtr->allocContinueTargets += 2;
	if (auxPtr->continueTargets) {
	    auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}


	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    AuxData *newPtr = (AuxData *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }

     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);

    if (fixupArrayPtr->mallocedArray) {
	fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}

    const Tcl_Config *configuration,	/* Embedded configuration. */
    const char *valEncoding)	/* Name of the encoding used to store the
				 * configuration values, ASCII, thus UTF-8. */
{
    Tcl_Obj *pDB, *pkgDict;
    Tcl_DString cmdName;
    const Tcl_Config *cfg;
    QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*

static int
QueryConfigObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    int n, index;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {

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

static void
QueryConfigDelete(
    ClientData clientData)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree(cdPtr->encoding);

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

static Tcl_Obj *
GetConfigDict(
    Tcl_Interp *interp)
{
    Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);

    if (pDB == NULL) {
	pDB = Tcl_NewDictObj();
	Tcl_IncrRefCount(pDB);
	Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
    }

 */

static void
ConfigDictDeleteProc(
    ClientData clientData,	/* Pointer to Tcl_Obj. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    Tcl_Obj *pDB = (Tcl_Obj *)clientData;

    Tcl_DecrRefCount(pDB);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,

        Tcl_StoreIntRep((objPtr), &tclDictType, &ir);                   \
    } while (0)

#define DictGetIntRep(objPtr, dictRepPtr)				\
    do {                                                                \
        const Tcl_ObjIntRep *irPtr;                                     \
        irPtr = TclFetchIntRep((objPtr), &tclDictType);                \
        (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;          \
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.

 */

static Tcl_HashEntry *
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    ChainEntry *cPtr;

    cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    cPtr->entry.clientData = NULL;
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

static inline void
DeleteChainTable(
    Dict *dict)
{
    ChainEntry *cPtr;

    for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }
    Tcl_DeleteHashTable(&dict->table);
}

static inline Tcl_HashEntry *

{
    ChainEntry *cPtr = (ChainEntry *)
	    Tcl_FindHashEntry(&dict->table, keyPtr);

    if (cPtr == NULL) {
	return 0;
    } else {
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }

    /*
     * Unstitch from the chain.
     */

 */

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetIntRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);
    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	int n;
	Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);

	/*
	 * Fill in the contents.
	 */

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)ckalloc(numElems);
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {

static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = (Dict *)ckalloc(sizeof(Dict));

    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.

	}

	for (i=0 ; i<objc ; i+=2) {

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		/*
		 * Not really a well-formed dictionary as there are duplicate
		 * keys, so better get the string rep here so that we can
		 * convert back.
		 */

		(void)Tcl_InitStringRep(valuePtr, NULL,
			TclCopyAndCollapse(elemSize, elemStart, dst));
	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		TclDecrRefCount(keyPtr);
		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, valuePtr);
	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
	}

	     */

	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
	    tmpObj = Tcl_NewDictObj();
	    Tcl_IncrRefCount(tmpObj);
	    Tcl_SetHashValue(hPtr, tmpObj);
	} else {
	    tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	    DictGetIntRep(tmpObj, newDict);

	    if (newDict == NULL) {
		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
		    return NULL;
		}

    TclInvalidateStringRep(dictPtr);
    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
    dict->refCount++;
    TclFreeIntRep(dictPtr)
    DictSetIntRep(dictPtr, dict);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    dict->epoch++;
    return TCL_OK;
}

	return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
    if (hPtr == NULL) {
	*valuePtrPtr = NULL;
    } else {
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    } else {
	*donePtr = 0;
	searchPtr->dictionaryPtr = (Tcl_Dict) dict;
	searchPtr->epoch = dict->epoch;
	searchPtr->next = cPtr->nextPtr;
	dict->refCount++;
	if (keyPtrPtr != NULL) {
	    *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	}
	if (valuePtrPtr != NULL) {
	    *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

     * removed. This *shouldn't* happen, but...
     */

    if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
	Tcl_Panic("concurrent dictionary modification and search");
    }

    cPtr = (ChainEntry *)searchPtr->next;
    if (cPtr == NULL) {
	Tcl_DictObjDone(searchPtr);
	*donePtr = 1;
	return;
    }

    searchPtr->next = cPtr->nextPtr;
    *donePtr = 0;
    if (keyPtrPtr != NULL) {
	*keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(
		&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
    }
    if (valuePtrPtr != NULL) {
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjDone --

    }

    DictGetIntRep(dictPtr, dict);
    assert(dict != NULL);
    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    InvalidateDictChain(dictPtr);

    return TCL_OK;

#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
#endif

static int
DictForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_DictSearch *searchPtr = (Tcl_DictSearch *)data[0];
    Tcl_Obj *keyVarObj = (Tcl_Obj *)data[1];
    Tcl_Obj *valueVarObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

static int
DictMapLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    DictMapStorage *storagePtr = (DictMapStorage *)data[0];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *dictPtr, *objPtr, **objv;
    Tcl_InterpState state;
    int i, objc;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *argsObj = (Tcl_Obj *)data[1];

    /*
     * ErrorInfo handling.
     */

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict update\")");

    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    int pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *keysPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
    }

    /*

	unknownMethod:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown method \"%s\"", TclGetString(objv[3])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(objv[3]), NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}

	Tcl_StoreIntRep((objPtr), &encodingType, &ir);			\
    } while (0)

#define EncodingGetIntRep(objPtr, encoding)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep ((objPtr), &encodingType);		\
	(encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingFromObj --

    /*
     * Need the iso8859-1 encoding in order to process binary data, so force
     * it to always be embedded. Note that this encoding *must* be a proper
     * table encoding or some of the escape encodings crash! Hence the ugly
     * code to duplicate the structure of a table encoding here.
     */

    dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';

    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
    dataPtr->toUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    dataPtr->fromUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);

    dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
    dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
    for (i=1 ; i<256 ; i++) {
	dataPtr->toUnicode[i] = emptyPage;
	dataPtr->fromUnicode[i] = emptyPage;

	/*
	 * Call FreeEncoding instead of doing it directly to handle refcounts
	 * like escape encodings use. [Bug 524674] Make sure to call
	 * Tcl_FirstHashEntry repeatedly so that all encodings are eventually
	 * cleaned up.
	 */

	FreeEncoding((Tcl_Encoding)Tcl_GetHashValue(hPtr));
	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    }

    Tcl_DeleteHashTable(&encodingTable);
    Tcl_MutexUnlock(&encodingMutex);
}


	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return systemEncoding;
    }

    hPtr = Tcl_FindHashEntry(&encodingTable, name);
    if (hPtr != NULL) {
	encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return (Tcl_Encoding) encodingPtr;
    }
    Tcl_MutexUnlock(&encodingMutex);

    return LoadEncodingFile(interp, name);

    /*
     * Copy encoding names from loaded encoding table to table.
     */

    Tcl_MutexLock(&encodingMutex);
    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);

	Tcl_CreateHashEntry(&table,
		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
    }
    Tcl_MutexUnlock(&encodingMutex);

    FillEncodingFileMap();

 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {

    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
    if (isNew == 0) {
	/*
	 * Remove old encoding from hash table, but don't delete it until last
	 * reference goes away.
	 */

	Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = (char *)ckalloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }
    return (Tcl_Encoding) encodingPtr;

    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));

    dataPtr->fallback = fallback;

    /*
     * Read the table that maps characters to Unicode. Performs a single
     * malloc to get the memory for the array and all the pages needed by the
     * array.
     */

    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->toUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

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

    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->fromUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);

    for (hi = 0; hi < 256; hi++) {
	if (dataPtr->toUnicode[hi] == NULL) {
	    dataPtr->toUnicode[hi] = emptyPage;
	    continue;

	}
	ckfree(argv);
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),

{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd, *prefixBytes;
    Tcl_UniChar ch = 0;
    int result, len, word, numChars;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    const unsigned short *const *fromUnicode;

    result = TCL_OK;

    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;

 */

static void
TableFreeProc(
    ClientData clientData)	/* TableEncodingData that specifies
				 * encoding. */
{
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    ckfree(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;

    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
    const unsigned short *const *tableToUnicode;
    const Encoding *encodingPtr;
    int state, result, numChars, charLimit = INT_MAX;
    const char *dstStart, *dstEnd;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {

	    break;
	}

	if (encodingPtr == NULL) {
	    TableEncodingData *tableDataPtr;

	    encodingPtr = GetTableEncoding(dataPtr, state);
	    tableDataPtr = (TableEncodingData *)encodingPtr->clientData;
	    tablePrefixBytes = tableDataPtr->prefixBytes;
	    tableToUnicode = (const unsigned short *const*)
		    tableDataPtr->toUnicode;
	}

	if (tablePrefixBytes[byte]) {
	    src++;

    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const Encoding *encodingPtr;
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int state, result, numChars;
    const TableEncodingData *tableDataPtr;
    const char *tablePrefixBytes;
    const unsigned short *const *tableFromUnicode;

	memcpy(dst, dataPtr->init, dataPtr->initLen);
	dst += dataPtr->initLen;
    } else {
	state = PTR2INT(*statePtr);
    }

    encodingPtr = GetTableEncoding(dataPtr, state);
    tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
    tablePrefixBytes = tableDataPtr->prefixBytes;
    tableFromUnicode = (const unsigned short *const *)
	    tableDataPtr->fromUnicode;

    for (numChars = 0; src < srcEnd; numChars++) {
	unsigned len;
	int word;

	if ((word == 0) && (ch != 0)) {
	    int oldState;
	    const EscapeSubTable *subTablePtr;

	    oldState = state;
	    for (state = 0; state < dataPtr->numSubTables; state++) {
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
		if (word != 0) {
		    break;
		}
	    }

	    if (word == 0) {
		state = oldState;
		if (flags & TCL_ENCODING_STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    break;
		}
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fallback;
	    }

	    tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
	    tableFromUnicode = (const unsigned short *const *)
		    tableDataPtr->fromUnicode;

 */

static void
EscapeFreeProc(
    ClientData clientData)	/* EscapeEncodingData that specifies
				 * encoding. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    EscapeSubTable *subTablePtr;
    int i;

    if (dataPtr == NULL) {
	return;
    }

    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);

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

	Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir);		\
    } while (0)

#define ECRGetIntRep(objPtr, ecRepPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &ensembleCmdType);		\
	(ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	ckfree(ensemblePtr);
	return NULL;
    }

	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->subcmdList;
    ensemblePtr->subcmdList = subcmdList;
    if (subcmdList != NULL) {
	Tcl_IncrRefCount(subcmdList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);

	    return TCL_ERROR;
	}
	if (length < 1) {
	    paramList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->parameterList;
    ensemblePtr->parameterList = paramList;
    if (paramList != NULL) {
	Tcl_IncrRefCount(paramList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);

	}

	if (size < 1) {
	    mapDict = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldDict = ensemblePtr->subcommandDict;
    ensemblePtr->subcommandDict = mapDict;
    if (mapDict != NULL) {
	Tcl_IncrRefCount(mapDict);
    }
    if (oldDict != NULL) {
	TclDecrRefCount(oldDict);

	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->unknownHandler;
    ensemblePtr->unknownHandler = unknownList;
    if (unknownList != NULL) {
	Tcl_IncrRefCount(unknownList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;

    /*
     * This API refuses to set the ENSEMBLE_DEAD flag...
     */

    ensemblePtr->flags &= ENSEMBLE_DEAD;

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *paramListPtr = ensemblePtr->parameterList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

static int
NsEnsembleImplementationCmdNR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
				/* The ensemble itself. */
    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
				 * the command that implements the
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */

	 */
	EnsembleCmdRep *ensembleCmd;

	ECRGetIntRep(subObj, ensembleCmd);
	if (ensembleCmd) {
	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == (Command *)ensemblePtr->token) {
		prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr);
		Tcl_IncrRefCount(prefixObj);
		if (ensembleCmd->fix) {
		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
		}
		goto runResultingSubcommand;
	    }
	}

	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
	TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
    }

    prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    Tcl_IncrRefCount(prefixObj);
  runResultingSubcommand:

    /*
     * Do the real work of execution of the subcommand by building an array of
     * objects (note that this is potentially not the same length as the
     * number of arguments to this ensemble command), populating it and then

	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    }  else {
	Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *));

	store = (Tcl_Obj **)ckalloc(size * sizeof(Tcl_Obj *));
	memcpy(store, iPtr->ensembleRewrite.sourceObjs,
		size * sizeof(Tcl_Obj *));

	/*
	 * Awful casting abuse here! Note that the NULL in the first element
	 * indicates that the initial objects are a raw array in the second
	 * element and the rewritten ones are a raw array in the third.

static void
MakeCachedEnsembleCommand(
    Tcl_Obj *objPtr,
    EnsembleConfig *ensemblePtr,
    Tcl_HashEntry *hPtr,
    Tcl_Obj *fix)
{
    EnsembleCmdRep *ensembleCmd;

    ECRGetIntRep(objPtr, ensembleCmd);
    if (ensembleCmd) {
	TclCleanupCommandMacro(ensembleCmd->token);
	if (ensembleCmd->fix) {
	    Tcl_DecrRefCount(ensembleCmd->fix);
	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
	ECRSetIntRep(objPtr, ensembleCmd);
    }

    /*
     * Populate the internal rep.
     */

    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;

    if (hash->numEntries != 0) {
        Tcl_HashSearch search;
        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

        while (hPtr != NULL) {
            Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
{
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
    Namespace *nsPtr = ensemblePtr->nsPtr;

    /*
     * Unlink from the ensemble chain if it has not been marked as having been
     * done already.
     */

	 * place them in the hash too, which should make for even faster
	 * matching.
	 */

	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
	    char *nsCmdName =		/* Name of command in namespace. */
		    (char *)Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);

	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
		if (Tcl_StringMatch(nsCmdName,
			ensemblePtr->nsPtr->exportArrayPtr[i])) {
		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);

		    /*

     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr =
	    (char **)ckalloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;

     * awful runtime behaviour.
     */

    i = 0;
    j = hash->numEntries;
    hPtr = Tcl_FirstHashEntry(hash, &search);
    while (hPtr != NULL) {
	ensemblePtr->subcommandArrayPtr[i++] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd;
    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));

    ECRGetIntRep(objPtr, ensembleCmd);
    ECRSetIntRep(copyPtr, ensembleCopy);

    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;

    /*
     * Delete those elements that existed in the array but which had no
     * counterparts in the environment array.
     */

    for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
	    hPtr=Tcl_NextHashEntry(&search)) {
	Tcl_Obj *elemName = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
    }
    Tcl_DeleteHashTable(&namesHash);
    Tcl_DecrRefCount(varNamePtr);

    /*

	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
	    char **newEnviron = (char **)ckalloc((length + 5) * sizeof(char *));

	    memcpy(newEnviron, environ, length * sizeof(char *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		ckfree(env.ourEnviron);
	    }
	    environ = env.ourEnviron = newEnviron;
	    env.ourEnvironSize = length + 5;

    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */

    valueLength = strlen(value);
    p = (char *)ckalloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    } else {
	/*
	 * We need to grow the cache in order to hold the new string.
	 */

	const int growth = 5;

	env.cache = (char **)ckrealloc(env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(size_t) (growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}

	objPtr->internalRep.twoPtrValue.ptr1 = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

#define POP_TAUX_OBJ() \
    do {							\
	tmpPtr = auxObjList;					\
	auxObjList = (Tcl_Obj *)tmpPtr->internalRep.twoPtrValue.ptr1;	\
	Tcl_DecrRefCount(tmpPtr);				\
    } while (0)

/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

    assert(irPtr != NULL);

    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);

    dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InitByteCodeExecution --

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    int size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)ckalloc(sizeof(ExecStack)
	    + (size_t) (size-1) * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);

#else
    newElems = needed;
#endif

    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = (ExecStack *)ckalloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:

static int
CopyCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0];
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];

    if (result == TCL_OK) {
	*resultPtrPtr = resultPtr;
	Tcl_IncrRefCount(resultPtr);
    } else {
	Tcl_DecrRefCount(resultPtr);
    }

static int
ExprObjCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_InterpState state = (Tcl_InterpState)data[0];
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];

    if (result == TCL_OK) {
	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
	(void) Tcl_RestoreInterpState(interp, state);
    } else {
	Tcl_DiscardInterpState(state);
    }

	    CmdFrame *ctxCopyPtr;
	    int redo;

	    if (!hePtr) {
		return codePtr;
	    }

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

	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctx.data.eval.path    is not used.

#define TCONST(i)	(constants[(i)])

    /*
     * These macros are just meant to save some global variables that are not
     * used too frequently
     */

    TEBCdata *TD = (TEBCdata *)data[0];
#define auxObjList	(TD->auxObjList)
#define catchTop	(TD->catchTop)
#define codePtr		(TD->codePtr)

    /*
     * Globals: variables that store state, must remain valid at all times.
     */

    Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
				 * stack. */
    const unsigned char *pc = (const unsigned char *)data[1];
                                /* The current program counter. */
    unsigned char inst;         /* The currently running instruction */

    /*
     * Transfer variables - needed only between opcodes, but not while
     * executing an instruction.
     */

		    "self may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	/*
	 * Call out to get the name; it's expensive to compute but cached.
	 */

	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
	TRACE_WITH_OBJ(("=> "), objResultPtr);

		    "nextto may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
	if (oPtr == NULL) {
	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
	    goto gotError;
	} else {
	    Class *classPtr = oPtr->classPtr;

		    "next may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	newDepth = contextPtr->index + 1;
	if (newDepth >= contextPtr->callPtr->numChain) {
	    /*
	     * We're at the end of the chain; generate an error message unless
	     * the interpreter is being torn down, in which case we might be
	     * getting here because of methods/destructors doing a [next] (or

    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {
	    TclNewIntObj(iterVarPtr->value.objPtr, -1);
	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);

	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;

	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;
	TRACE(("%u => ", opnd));

	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;

	 */
	pc++;
#endif

    case INST_FOREACH_END:
	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
	tmpPtr = OBJ_AT_TOS;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> loop terminated\n"));
	NEXT_INST_V(1, numLists+2, 0);

    case INST_LMAP_COLLECT:
	/*
	 * This instruction is only issued by lmap. The stack is:
	 *   - result
	 *   - infoPtr
	 *   - loop counters
	 *   - valLists
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));

	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }

	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].

	TRACE(("%u => ", opnd));
	statePtr = (*LOCAL(opnd)).value.objPtr;
	{
	    const Tcl_ObjIntRep *irPtr;

	    if (statePtr &&
		    (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) {
		searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
		Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
	    } else {
		Tcl_Panic("mis-issued dictNext!");
	    }
	}
    pushDictIteratorResult:
	if (done) {

	JUMP_PEEPHOLE_F(done, 5, 0);

    case INST_DICT_UPDATE_START:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();

	NEXT_INST_F(9, 0, 0);

    case INST_DICT_UPDATE_END:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();

static int
FinalizeOONext(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = (CallContext *)data[1];

    /*
     * Reset the variable lookup frame.
     */

    iPtr->varFramePtr = (CallFrame *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[2]);
    contextPtr->skip = PTR2INT(data[3]);
    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    return result;
}

static int
FinalizeOONextFilter(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = (CallContext *)data[1];

    /*
     * Reset the variable lookup frame.
     */

    iPtr->varFramePtr = (CallFrame *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[2]);

				 * when the illegal type was found. */
    Tcl_Obj *opndPtr)		/* Points to the operand holding the value
				 * with the illegal type. */
{
    ClientData ptr;
    int type;
    const unsigned char opcode = *pc;
    const char *description, *op = "unknown";

    if (opcode == INST_EXPON) {
	op = "**";
    } else if (opcode <= INST_LNOT) {
	op = operatorStrings[opcode - INST_LOR];
    }

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	int numBytes;
	const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);

	if (numBytes == 0) {

	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "can't use %s as operand of \"%s\"", description, op));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --

		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}

	srcOffset = cfPtr->cmd - codePtr->source;
	eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);

	for (i=0; i < eclPtr->nuloc; i++) {
	    if (eclPtr->loc[i].srcOffset == srcOffset) {
		locPtr = eclPtr->loc+i;
		break;
	    }
	}

    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = (const char **)ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];

	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	ckfree(elemv);
	return ret;
    }

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

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *

	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,

 */

Tcl_HashEntry *
Tcl_FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const void *key)		/* Key to use to find matching entry. */
{
    return (*((tablePtr)->findProc))(tablePtr, (const char *)key);
}

static Tcl_HashEntry *
FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{

Tcl_CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const void *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    return (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr);
}

static Tcl_HashEntry *
CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */

     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];

	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)ckalloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);

    count = tablePtr->keyType;

    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = (Tcl_HashEntry *)ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    hPtr->clientData = 0;

    Tcl_HashEntry *hPtr;
    unsigned int size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    hPtr->clientData = 0;
    return hPtr;
}

/*

 */

static TCL_HASH_TYPE
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    const char *string = (const char *)keyPtr;
    unsigned int result;
    char c;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0);
    } else {
	tablePtr->buckets =
		(Tcl_HashEntry **)ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->downShift -= 2;

				 * TCL_EVAL_GLOBAL means evaluate the script
				 * in global variable context instead of the
				 * current procedure. */
{
    int result, call = 1;
    Tcl_CmdInfo info;
    HistoryObjs *histObjsPtr =
	    (HistoryObjs *)Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = (HistoryObjs *)ckalloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }

 */

static void
DeleteHistoryObjs(
    ClientData clientData,
    Tcl_Interp *interp)
{
    HistoryObjs *histObjsPtr = (HistoryObjs *)clientData;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    ckfree(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	Tcl_StoreIntRep((objPtr), &chanObjType, &ir);			\
    } while (0)

#define ChanGetIntRep(objPtr, resPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &chanObjType);		\
	(resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)

				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = (CloseCallback *)ckalloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}


static Tcl_HashTable *
GetChannelTable(
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclIO",
		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);

	/*
	 * If the interpreter is trusted (not "safe"), insert channels for
	 * stdin, stdout and stderr (possibly creating them in the process).

				 * to the interpreter being deleted. */

    /*
     * Delete all the registered channels - this will close channels whose
     * refcount reaches zero.
     */

    hTblPtr = (Tcl_HashTable *)clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any fileevents registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;

     * necessary during (un)stack operation.
     */

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

    if (interp != NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
	if (hTblPtr == NULL) {
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
	if (hPtr == NULL) {
	    return TCL_ERROR;
	}

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs
     * compensate where necessary to retrieve the topmost channel again.
     */

    chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
    chanPtr = chanPtr->state->bottomChanPtr;
    if (modePtr != NULL) {
	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
    }

    return (Tcl_Channel) chanPtr;
}

    }

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    chanPtr = (Channel *)ckalloc(sizeof(Channel));
    statePtr = (ChannelState *)ckalloc(sizeof(ChannelState));
    chanPtr->state = statePtr;

    chanPtr->instanceData = instanceData;
    chanPtr->typePtr = typePtr;

    /*
     * Set all the bits that are part of the stack-independent state
     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = (char *)ckalloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = (char *)ckalloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.

	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = (Channel *)ckalloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */

AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)ckalloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
    bufPtr->refCount	= 1;
    return bufPtr;
}

     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = (char *)memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0) {
	ChannelBuffer *bufPtr;
	char *dst, safe[BUFFER_PADDING];
	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;

	    bufPtr->nextAdded += dstWrote;
	    src++;
	    srcLen--;
	    total += dstWrote;
	    dst += dstWrote;
	    dstLen -= dstWrote;
	    nextNewLine = (char *)memchr(src, '\n', srcLen);
	    needNlFlush = 1;
	}

	if (IsBufferOverflowing(bufPtr)) {
	    /*
	     * When translating from UTF-8 to external encoding, we allowed
	     * the translation to produce a character that crossed the end of

    if (inEofChar != '\0') {
	/*
	 * Make sure we do not read past any logical end of channel input
	 * created by the presence of the input eof char.
	 */

	if ((eof = (const char *)memchr(srcStart, inEofChar, srcLen))) {
	    srcLen = eof - srcStart;
	}
    }

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (dstStart != srcStart) {
	    memcpy(dstStart, srcStart, srcLen);
	}
	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
	    char *dst = dstStart;
	    char *dstEnd = dstStart + srcLen;

	    while ((dst = (char *)memchr(dst, '\r', dstEnd - dst))) {
		*dst++ = '\n';
	    }
	}
	dstLen = srcLen;
	break;
    case TCL_TRANSLATE_CRLF: {
	const char *crFound, *src = srcStart;
	char *dst = dstStart;
	int lesser = (dstLen < srcLen) ? dstLen : srcLen;

	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst += numBytes; dstLen -= numBytes;
	    src += numBytes; srcLen -= numBytes;
	    if (srcLen == 1) {
		/* valid src bytes end in \r */

	int lesser;

	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
	    if (*src == '\n') { src++; srcLen--; }
	    ResetFlag(statePtr, INPUT_SAW_CR);
	}
	lesser = (dstLen < srcLen) ? dstLen : srcLen;
	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst[numBytes] = '\n';
	    dst += numBytes + 1; dstLen -= numBytes + 1;
	    src += numBytes + 1; srcLen -= numBytes + 1;
	    if (srcLen == 0) {

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

static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = (Channel *)clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)

    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
		(chPtr->clientData == clientData)) {
	    break;
	}
    }
    if (chPtr == NULL) {
	chPtr = (ChannelHandler *)ckalloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }

	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to

    Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
    Channel *chanPtr;		/* The channel for which this handler is
				 * registered. */
    EventScriptRecord *esPtr;	/* The event script + interpreter to eval it
				 * in. */
    int result;			/* Result of call to eval script. */

    esPtr = (EventScriptRecord *)clientData;
    chanPtr = esPtr->chanPtr;
    mask = esPtr->mask;
    interp = esPtr->interp;

    /*
     * We must preserve the interpreter so we can report errors on it later.
     * Note that we do not need to preserve the channel because that is done

static void
ZeroTransferTimerProc(
    ClientData clientData)
{
    /* calling CopyData with mask==0 still implies immediate invocation of the
     *  -command callback, and completion of the fcopy.
     */
    CopyData((CopyState *)clientData, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCopyChannel --
 *

    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

    csPtr = (CopyState *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;

 */

static void
CopyEventProc(
    ClientData clientData,
    int mask)
{
    (void) CopyData((CopyState *)clientData, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *

     * Always check bottom-most channel in the stack. This is the one that
     * gets registered.
     */

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

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	return 0;
    }
    hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
    if (hPtr == NULL) {
	return 0;
    }

    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */