Tcl Source Code

	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	if (opnd < 0 || opnd > 3) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("operand must be [0..3]", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_CONCAT1:

	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	if (opnd < 2) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("operand must be >=2", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
	    }
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    Tcl_Obj* operandObj;

    TclNewObj(operandObj);
    if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
	Tcl_DecrRefCount(operandObj);
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "assembly code may not contain substitutions", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
	}
	return TCL_ERROR;
    }
    *tokenPtrPtr = TokenAfter(*tokenPtrPtr);
    Tcl_IncrRefCount(operandObj);
    *operandObjPtr = operandObj;

    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == TCL_INDEX_NONE) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot use this instruction to create a variable"
		    " in a non-proc context", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
	}
	return TCL_INDEX_NONE;
    }
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return localVar;
}

CheckOneByte(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value < 0 || value > 0xFF) {
	result = Tcl_NewStringObj("operand does not fit in one byte", TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


CheckSignedOneByte(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value > 0x7F || value < -0x80) {
	result = Tcl_NewStringObj("operand does not fit in one byte", TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


CheckNonNegative(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value < 0) {
	result = Tcl_NewStringObj("operand must be nonnegative", TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


CheckStrictlyPositive(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value <= 0) {
	result = Tcl_NewStringObj("operand must be positive", TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


	 */

	if (blockPtr->initialStackDepth == initialStackDepth) {
	    return TCL_OK;
	}
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "inconsistent stack depths on two execution paths", TCL_INDEX_NONE));

	    /*
	     * TODO - add execution trace of both paths
	     */

	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);

    /*
     * Calculate minimum stack depth, and flag an error if the block
     * underflows the stack.
     */

    if (initialStackDepth + blockPtr->minStackDepth < 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	}
	return TCL_ERROR;
    }

    /*
     * Make sure that the block doesn't try to pop below the stack level of an
     * enclosing catch.
     */

    if (blockPtr->enclosingCatch != 0 &&
	    initialStackDepth + blockPtr->minStackDepth
	    < (blockPtr->enclosingCatch->initialStackDepth
		+ blockPtr->enclosingCatch->finalStackDepth)) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "code pops stack below level of enclosing catch", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", TCL_INDEX_NONE);
	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	}
	return TCL_ERROR;
    }

    /*

    if (bbPtr->catchState == BBCS_UNKNOWN) {
	bbPtr->enclosingCatch = enclosing;
    } else if (bbPtr->enclosingCatch != enclosing) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "execution reaches an instruction in inconsistent "
		    "exception contexts", TCL_INDEX_NONE));
	    Tcl_SetErrorLine(interp, bbPtr->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
	}
	return TCL_ERROR;
    }
    if (state > bbPtr->catchState) {
	bbPtr->catchState = state;

	 * If the block ends a catch, the state for the successor is whatever
	 * the state was on entry to the catch.
	 */

	if (enclosing == NULL) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"endCatch without a corresponding beginCatch", TCL_INDEX_NONE));
		Tcl_SetErrorLine(interp, bbPtr->startLine);
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
	    }
	    return TCL_ERROR;
	}
	fallThruEnclosing = enclosing->enclosingCatch;
	fallThruState = enclosing->catchState;

				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "catch still active on exit from assembly code", TCL_INDEX_NONE));
	    Tcl_SetErrorLine(interp,
		    assemEnvPtr->curr_bb->enclosingCatch->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;

     * the source, in order to avoid potential confusion, lets prevent "::" in
     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
	return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of

     * The trace function needs to get a fully qualified name for old and new
     * commands [Tcl bug #651271], or else there's no way for the trace
     * function to get the namespace from which the old command is being
     * renamed!
     */

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

    /*
     * The new command name is okay, so remove the command from its current

    /*
     * Add the full name of the containing namespace, followed by the "::"
     * separator, and the command name.
     */

    if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) {
	if (cmdPtr->nsPtr != NULL) {
	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, TCL_INDEX_NONE);
	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
		Tcl_AppendToObj(objPtr, "::", 2);
	    }
	}
	if (cmdPtr->hPtr != NULL) {
	    name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
	    Tcl_AppendToObj(objPtr, name, TCL_INDEX_NONE);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * If the interpreter has been deleted, return an error.
     */

    if (iPtr->flags & DELETED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to call eval in deleted interpreter", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "IDELETE",
		"attempt to call eval in deleted interpreter", NULL);
	return TCL_ERROR;
    }

    if (iPtr->execEnvPtr->rewind) {
	return TCL_ERROR;

     */

    if ((iPtr->numLevels <= iPtr->maxNestingDepth)) {
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested evaluations (infinite loop?)", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.

    int returnCode)		/* The unexpected result code. */
{
    char buf[TCL_INTEGER_SPACE];

    Tcl_ResetResult(interp);
    if (returnCode == TCL_BREAK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"break\" outside of a loop", TCL_INDEX_NONE));
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", TCL_INDEX_NONE));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    sprintf(buf, "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}

    if (*exprstring == '\0') {
	/*
	 * Legacy compatibility - return 0 for the zero-length string.
	 */

	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
    }
    return result;
}

    if (*exprstring == '\0') {
	/*
	 * Legacy compatibility - return 0 for the zero-length string.
	 */

	*ptr = 0.0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
				/* Discard the expression object. */
    }
    return result;
}

	 * An empty string. Just set the result boolean to 0 (false).
	 */

	*ptr = 0;
	return TCL_OK;
    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
	return result;
    }
}

				 * or TCL_INVOKE_NO_TRACEBACK. */
{
    if (interp == NULL) {
	return TCL_ERROR;
    }
    if ((objc < 1) || (objv == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "illegal argument vector", TCL_INDEX_NONE));
	return TCL_ERROR;
    }
    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }
    return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
}

    if (expr[0] == '\0') {
	/*
	 * An empty string. Just set the interpreter's result to 0.
	 */

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
    } else {
	Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, TCL_INDEX_NONE);

	Tcl_IncrRefCount(exprObj);
	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);

    Tcl_DStringInit(&buf);
    while (1) {
	string = va_arg(argList, char *);
	if (string == NULL) {
	    break;
	}
	Tcl_DStringAppend(&buf, string, TCL_INDEX_NONE);
    }

    result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, 0);
    Tcl_DStringFree(&buf);
    return result;
}

/*
 *----------------------------------------------------------------------
 *

	}
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
    }
    return TCL_OK;

  negarg:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "square root of negative argument", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
	    "domain error: argument not in valid range", NULL);
    return TCL_ERROR;
}

static int
ExprSqrtFunc(

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
	return TCL_ERROR;
    }

    if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.

        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;

        /*
         * The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled.
         */

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
    return TCL_RETURN;
}

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yield can only be called in a coroutine", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (objc == 2) {
	Tcl_SetObjResult(interp, objv[1]);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (((Namespace *) nsPtr)->flags & NS_DYING) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"yieldto called in deleted namespace", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		NULL);
        return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

    listPtr = Tcl_NewListObj(objc, objv);
    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE);
    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;

		    }
		}
	    }
	    iPtr->execEnvPtr = corPtr->eePtr;


            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "cannot yield: C stack busy", TCL_INDEX_NONE));
            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    NULL);
            return TCL_ERROR;
        }

        void *type = data[1];
        if (type == CORO_ACTIVATE_YIELD) {

    /*
     * Look up the coroutine.
     */

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only get coroutine type of a coroutine", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

    /*
     * 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", TCL_INDEX_NONE));
        return TCL_OK;
    }

    /*
     * Inactive coroutines are classified by the (effective) command used to
     * suspend them, which matters when you're injecting a probe.
     */

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE));
        return TCL_OK;
    case COROUTINE_ARGUMENTS_ARBITRARY:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE));
        return TCL_OK;
    default:
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unknown coroutine type", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL);
        return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------

    /*
     * How to get a coroutine from its handle.
     */

    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

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

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.

    if (!isProbe) {
        /*
         * If this is [coroinject], add the extra arguments now.
         */

        if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yield", TCL_INDEX_NONE));
        } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yieldto", TCL_INDEX_NONE));
        } else {
            /*
             * I don't think this is reachable...
             */

            Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj((Tcl_WideInt)(nargs + 1U) - 1));
        }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.

            return TCL_ERROR;
        }
        break;
    default:
        if (corPtr->nargs + 1 != (size_t)objc) {
            Tcl_SetObjResult(interp,
                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
                    "not implemented!", TCL_INDEX_NONE));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
        /* fallthrough */
    case COROUTINE_ARGUMENTS_ARBITRARY:
        if (objc > 1) {
            Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));

    if (bytes && numBytesPtr) {
	if (numBytes > INT_MAX) {
	    /* Caller asked for numBytes to be written to an int, but the
	     * value is outside the int range. */

	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"byte sequence length exceeds INT_MAX", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
	    }
	    return NULL;
	} else {
	    *numBytesPtr = (int) numBytes;
	}
    }

	    }
	    offset += count*size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot use \"*\" in format string with \"x\"", TCL_INDEX_NONE));
		return TCL_ERROR;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    offset += count;
	    break;
	case 'X':

	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, TCL_INDEX_NONE));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryScanCmd --

	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, TCL_INDEX_NONE));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GetFormatSpec --

	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)Tcl_GetByteArrayFromObj(

	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1],
		    &lineLength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (lineLength < 5 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:

     */

    listObjPtr = Tcl_NewListObj(0, NULL);
    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_ListObjAppendElement(interp, listObjPtr,
		    Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE));
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*

	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, TCL_INDEX_NONE);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
	    return TCL_OK;
	}
	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    Tcl_HashTable *tablePtr = NULL;	/* Quell warning. */

	    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, TCL_INDEX_NONE));
		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

	    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, TCL_INDEX_NONE);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
	}

	/*

	    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, TCL_INDEX_NONE));
		    }
		}
		entryPtr = Tcl_NextHashEntry(&search);
	    }
	}
    } else {
	/*

	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, TCL_INDEX_NONE);
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		(void) Tcl_CreateHashEntry(&addedCommandsTable,
			elemObjPtr, &isNew);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
	}

		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, TCL_INDEX_NONE);
		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
			    elemObjPtr, &isNew);
		    if (isNew) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {
			TclDecrRefCount(elemObjPtr);
		    }

	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, TCL_INDEX_NONE);
		    if (Tcl_FindHashEntry(&addedCommandsTable,
			    (char *) elemObjPtr) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {
			TclDecrRefCount(elemObjPtr);
		    }
		}

    switch (framePtr->type) {
    case TCL_LOCATION_EVAL:
	/*
	 * Evaluation, dynamic script. Type, line, cmd, the latter through
	 * str.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE));
	if (framePtr->line) {
	    ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
	} else {
	    ADD_PAIR("line", Tcl_NewWideIntObj(1));
	}
	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
	break;

    case TCL_LOCATION_PREBC:
	/*
	 * Precompiled. Result contains the type as signal, nothing else.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE));
	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */

	TclGetSrcInfoForPc(fPtr);

	/*
	 * Now filled: cmd.str.(cmd,len), line
	 * Possibly modified: type, path!
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], TCL_INDEX_NONE));
	if (fPtr->line) {
	    ADD_PAIR("line", Tcl_NewWideIntObj(fPtr->line[0]));
	}

	if (fPtr->type == TCL_LOCATION_SOURCE) {
	    ADD_PAIR("file", fPtr->data.eval.path);

    }

    case TCL_LOCATION_SOURCE:
	/*
	 * Evaluation of a script file.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE));
	ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
	ADD_PAIR("file", framePtr->data.eval.path);

	/*
	 * Refcount framePtr->data.eval.path goes up when lv is converted into
	 * the result list object.
	 */

	    /*
	     * 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, TCL_INDEX_NONE);
		if (efiPtr->fields[i].proc) {
		    lv[lc++] =
			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
		} else {
		    lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData;
		}
	    }

"		::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n"
"		    ::set cmd [::namespace tail $cmd]\n"
"		    ::if {$cmd ni $cmds} {\n"
"			::lappend cmds $cmd\n"
"		    }\n"
"		}\n"
"		::return $cmds\n"
"	    } [::namespace current]] ", TCL_INDEX_NONE);

    if (objc == 2) {
	Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1]));

	Tcl_AppendObjToObj(script, arg);
	Tcl_DecrRefCount(arg);
    }

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    name = Tcl_GetHostName();
    if (name) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, TCL_INDEX_NONE));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "unable to determine name of host", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    if (libDirName != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, TCL_INDEX_NONE));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "no library has been specified for Tcl", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL,
	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
    if (patchlevel != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, TCL_INDEX_NONE));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, TCL_INDEX_NONE);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {

		} else {
		procOK:
		    if (specificNsInPattern) {
			elemObjPtr = Tcl_NewObj();
			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
	}

			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, TCL_INDEX_NONE));
			}
		    }
		}
		entryPtr = Tcl_NextHashEntry(&search);
	    }
	}
#endif

{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

#ifdef TCL_SHLIB_EXT
    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, TCL_INDEX_NONE));
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

     */

    if (Tcl_IsSafe(interp)
	    && (((Command *) command)->objProc == TclAliasObjCmd)) {
	Tcl_AppendResult(interp, "native", NULL);
    } else {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(TclGetCommandTypeName(command), TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

     * TclLindexFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (!listLen) {
	    /* empty list, throw the same error as with index "end" */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"index \"end\" out of range", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
		"OUTOFRANGE", NULL);
	    return TCL_ERROR;
	}
	elemPtr = elemPtrs[listLen - 1];
	Tcl_IncrRefCount(elemPtr);
    } else {

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
		startPtr = NULL;
	    }
	    if (i + 4 > (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
	    if (objv[i] == objv[objc - 2]) {
		/*

	    }
	    Tcl_IncrRefCount(startPtr);
	    break;
	case LSEARCH_STRIDE:		/* -stride */
	    if (i + 4 > (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (wide < 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 1", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADSTRIDE", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    groupSize = wide;
	    i++;

    /*
     * Subindices only make sense if asked for with -index option set.
     */

    if (returnSubindices && sortInfo.indexc==0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-subindices cannot be used without -index option", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	result = TCL_ERROR;
	goto done;
    }

    if (bisect && (allMatches || negatedMatch)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-bisect is not compatible with -all or -not", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	result = TCL_ERROR;
	goto done;
    }

    if (mode == REGEXP) {

	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;

	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i + 2 == (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-command\" option must be followed "
			"by comparison command", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];
	    i++;

	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i + 2 == (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (wide < 2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 2", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADSTRIDE", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    groupSize = wide;
	    group = 1;

	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;

	/*
	 * Parse the result of the command.
	 */

	if (TclGetIntFromObj(infoPtr->interp,
		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
	    Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
		    "-compare command returned non-integer result", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "COMPARISONFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return 0;
	}
    }
    if (!infoPtr->isIncreasing) {

    /*
     * Check if the user requested -inline, but specified match variables; a
     * no-no.
     */

    if (doinline && ((objc - 2) != 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"regexp match variables not allowed when using -inline", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
		"MIX_VAR_INLINE", NULL);
	goto optionError;
    }

    /*
     * Handle the odd about case separately.

	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, 0) != TCL_OK) {
	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;

	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer.
		 */

		break;

	     * Don't bother computing the failure point if we're not going to
	     * return it.
	     */

	    break;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer, but rejected by
		 * Tcl_Get(Wide)IntFromObj() so we must have overflowed the
		 * target type, and our convention is to return failure at
		 * index -1 in that situation.

	    return TCL_OK;
	} else if (mapElemc & 1) {
	    /*
	     * The charMap must be an even number of key/value items.
	     */

	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("char map list unbalanced", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
		    "UNBALANCED", NULL);
	    return TCL_ERROR;
	}
    }

    /*

	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, resultPtr);
    }

    return TCL_OK;
}

/*

	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, resultPtr);
    }

    return TCL_OK;
}

/*

	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, resultPtr);
    }

    return TCL_OK;
}

/*

     * Complain if there is an odd number of words in the list of patterns and
     * bodies.
     */

    if (objc % 2) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"extra switch pattern with no body", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		NULL);

	/*
	 * Check if this can be due to a badly placed comment in the switch
	 * block.
	 *
	 * The following is an heuristic to detect the infamous "comment in
	 * switch" error: just check if a pattern begins with '#'.
	 */

	if (splitObjs) {
	    for (i=0 ; i<objc ; i+=2) {
		if (TclGetString(objv[i])[0] == '#') {
		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
			    ", this may be due to a comment incorrectly"
			    " placed outside of a switch body - see the"
			    " \"switch\" documentation", TCL_INDEX_NONE);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			    "BADARM", "COMMENT?", NULL);
		    break;
		}
	    }
	}

     * The type must be a list of at least length 1.
     */

    if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
	return TCL_ERROR;
    } else if (len < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"type must be non-empty list", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Now prepare the result options dictionary. We use the list API as it is

	    Tcl_DecrRefCount(handlersObj);
	    return TCL_ERROR;
	}
	switch (type) {
	case TryFinally:	/* finally script */
	    if (i < objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"finally clause must be last", TCL_INDEX_NONE));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"NONTERMINAL", NULL);
		return TCL_ERROR;
	    } else if (i == objc-1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to finally clause: must be"
			" \"... finally script\"", TCL_INDEX_NONE));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    finallyObj = objv[++i];
	    break;

	case TryOn:		/* on code variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to on clause: must be \"... on code"
			" variableList script\"", TCL_INDEX_NONE));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    if (TclGetCompletionCodeFromObj(interp, objv[i+1],
		    &code) != TCL_OK) {

	    haveHandlers = 1;
	    i += 3;
	    break;
	}
    }
    if (bodyShared) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"last non-finally clause must not have a body of \"-\"", TCL_INDEX_NONE));
	Tcl_DecrRefCount(handlersObj);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
		NULL);
	return TCL_ERROR;
    }
    if (!haveHandlers) {
	Tcl_DecrRefCount(handlersObj);

			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);

			if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
			    switch (start[1]) {
			    case 'b':
				Tcl_AppendToObj(post,
					" (invalid binary number?)", TCL_INDEX_NONE);
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				errCode = "BADNUMBER";
				subErrCode = "BINARY";
				break;
			    case 'o':
				Tcl_AppendToObj(post,
					" (invalid octal number?)", TCL_INDEX_NONE);
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				errCode = "BADNUMBER";
				subErrCode = "OCTAL";
				break;
			    default:
				if (isdigit(UCHAR(start[1]))) {
				    Tcl_AppendToObj(post,
					    " (invalid octal number?)", TCL_INDEX_NONE);
				    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				    errCode = "BADNUMBER";
				    subErrCode = "OCTAL";
				}
				break;
			    }
			}

		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	 */

	if (post != NULL) {
	    Tcl_AppendToObj(msg, ";\n", TCL_INDEX_NONE);
	    Tcl_AppendObjToObj(msg, post);
	    Tcl_DecrRefCount(post);
	}
	Tcl_SetObjResult(interp, msg);

	/*
	 * Finally, place context information in the errorInfo.

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", TCL_INDEX_NONE);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line >= 0 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		TclGetString(fileObj), line);
    }

			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {
		    Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE);
		} else {
		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
			    localPtr->name);
		}
		localPtr = localPtr->nextPtr;
	    }
	}

     * If there were no commands (e.g., an expression or an empty string was
     * compiled), just print all instructions and return.
     */

    if (numCmds == 0) {
	pc = codeStart;
	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", TCL_INDEX_NONE);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
	return bufferObj;
    }

    /*
     * Print table showing the code offset, source offset, and source length

	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
		((i % 2)? "     " : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE);
    }

    /*
     * Print each instruction. If the instruction corresponds to the start of
     * a command, print the command's source. Note that we don't need the code
     * length here.
     */

	}

	/*
	 * Print instructions before command i.
	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", TCL_INDEX_NONE);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.
	 */

	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", TCL_INDEX_NONE);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
    }
    return bufferObj;
}

/*

	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", TCL_INDEX_NONE);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }
    Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE);
    if (auxPtr && auxPtr->type->printProc) {
	Tcl_AppendToObj(bufferObj, "\t\t[", TCL_INDEX_NONE);
	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
		pcOffset);
	Tcl_AppendToObj(bufferObj, "]\n", TCL_INDEX_NONE);
    }
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *

    const char *stringPtr,	/* The string to print. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    const char *p;
    size_t i = 0, len;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", TCL_INDEX_NONE);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", TCL_INDEX_NONE);
    p = stringPtr;
    for (;  (*p != '\0') && (i < maxChars);  p+=len) {
	int ucs4;

	len = TclUtfToUCS4(p, &ucs4);
	switch (ucs4) {
	case '"':
	    Tcl_AppendToObj(appendObj, "\\\"", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	case '\f':
	    Tcl_AppendToObj(appendObj, "\\f", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	case '\n':
	    Tcl_AppendToObj(appendObj, "\\n", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	case '\r':
	    Tcl_AppendToObj(appendObj, "\\r", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	case '\t':
	    Tcl_AppendToObj(appendObj, "\\t", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	case '\v':
	    Tcl_AppendToObj(appendObj, "\\v", TCL_INDEX_NONE);
	    i += 2;
	    continue;
	default:
	    if (ucs4 > 0xFFFF) {
		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ucs4);
		i += 10;
	    } else if (ucs4 < 0x20 || ucs4 >= 0x7F) {
		Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ucs4);
		i += 6;
	    } else {
		Tcl_AppendPrintfToObj(appendObj, "%c", ucs4);
		i++;
	    }
	    continue;
	}
    }
    if (*p != '\0') {
	Tcl_AppendToObj(appendObj, "...", TCL_INDEX_NONE);
    }
    Tcl_AppendToObj(appendObj, "\"", TCL_INDEX_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * DisassembleByteCodeAsDicts --
 *

	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
	    Tcl_Obj *descriptor[2];

	    TclNewObj(descriptor[0]);
	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("scalar", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_ARRAY) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("array", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_LINK) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("link", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_ARGUMENT) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("arg", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_TEMPORARY) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("temp", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_RESOLVED) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("resolved", TCL_INDEX_NONE));
	    }
	    if (localPtr->flags & VAR_TEMPORARY) {
		Tcl_ListObjAppendElement(NULL, variables,
			Tcl_NewListObj(1, descriptor));
	    } else {
		descriptor[1] = Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE);
		Tcl_ListObjAppendElement(NULL, variables,
			Tcl_NewListObj(2, descriptor));
	    }
	}
    }

    /*
     * Get the instructions from the bytecode.
     */

    TclNewObj(instructions);
    for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){
	const InstructionDesc *instDesc = &tclInstructionTable[*pc];
	int address = pc - codePtr->codeStart;

	TclNewObj(inst);
	Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
		instDesc->name, TCL_INDEX_NONE));
	opnd = pc + 1;
	for (i=0 ; i<instDesc->numOperands ; i++) {
	    switch (instDesc->opTypes[i]) {
	    case OPERAND_INT1:
		val = TclGetInt1AtPtr(opnd);
		opnd += 1;
		goto formatNumber;

		val = TclGetInt4AtPtr(opnd);
		opnd += 4;
		if (val >= -1) {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			    ".%d", val));
		} else if (val == -2) {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
			    ".end", TCL_INDEX_NONE));
		} else {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			    ".end-%d", -2-val));
		}
		break;
	    case OPERAND_AUX4:
		val = TclGetInt4AtPtr(opnd);

    /*
     * Get the auxiliary data from the bytecode.
     */

    TclNewObj(aux);
    for (i=0 ; i<(int)codePtr->numAuxDataItems ; i++) {
	AuxData *auxData = &codePtr->auxDataArrayPtr[i];
	Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, TCL_INDEX_NONE);

	if (auxData->type->disassembleProc) {
	    Tcl_Obj *desc;

	    TclNewObj(desc);
	    Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", TCL_INDEX_NONE), auxDesc);
	    auxDesc = desc;
	    auxData->type->disassembleProc(auxData->clientData, auxDesc,
		    codePtr, 0);
	} else if (auxData->type->printProc) {
	    Tcl_Obj *desc;

	    TclNewObj(desc);

	Tcl_Obj *cmd;

	codeOffset += Decode(codeOffPtr);
	codeLength = Decode(codeLenPtr);
	sourceOffset += Decode(srcOffPtr);
	sourceLength = Decode(srcLenPtr);
	TclNewObj(cmd);
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", TCL_INDEX_NONE),
		Tcl_NewWideIntObj(codeOffset));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", TCL_INDEX_NONE),
		Tcl_NewWideIntObj(codeOffset + codeLength - 1));

	/*
	 * Convert byte offsets to character offsets; important if multibyte
	 * characters are present in the source!
	 */

	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", TCL_INDEX_NONE),
		Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source,
			sourceOffset)));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", TCL_INDEX_NONE),
		Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source,
			sourceOffset + sourceLength - 1)));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", TCL_INDEX_NONE),
		Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
	Tcl_ListObjAppendElement(NULL, commands, cmd);
    }

#undef Decode

    /*
     * Get the source file and line number information from the CmdFrame
     * system if it is available.
     */

    GetLocationInformation(codePtr->procPtr, &file, &line);

    /*
     * Build the overall result.
     */

    TclNewObj(description);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", TCL_INDEX_NONE),
	    literals);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", TCL_INDEX_NONE),
	    variables);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", TCL_INDEX_NONE), exn);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", TCL_INDEX_NONE),
	    instructions);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", TCL_INDEX_NONE), aux);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", TCL_INDEX_NONE),
	    commands);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", TCL_INDEX_NONE),
	    Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", TCL_INDEX_NONE),
	    Tcl_NewStringObj(codePtr->nsPtr->fullName, TCL_INDEX_NONE));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", TCL_INDEX_NONE),
	    Tcl_NewWideIntObj(codePtr->maxStackDepth));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", TCL_INDEX_NONE),
	    Tcl_NewWideIntObj(codePtr->maxExceptDepth));
    if (line >= 0) {
	Tcl_DictObjPut(NULL, description,
		Tcl_NewStringObj("initiallinenumber", TCL_INDEX_NONE),
		Tcl_NewWideIntObj(line));
    }
    if (file) {
	Tcl_DictObjPut(NULL, description,
		Tcl_NewStringObj("sourcefile", TCL_INDEX_NONE), file);
    }
    return description;
}

/*
 *----------------------------------------------------------------------
 *

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "CONSRUCTOR", NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of constructor", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "DESRUCTOR", NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of destructor", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.

	    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", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

     * Do the actual disassembly.
     */

    ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr);

    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not disassemble prebuilt bytecode", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		"BYTECODE", NULL);
	return TCL_ERROR;
    }
    if (clientData) {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeAsDicts(codeObjPtr));

    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;

    if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
	return Tcl_NewStringObj("::", 2);
    }
    return Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNamespaceEnsembleCmd --
 *

			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (len < 1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"ensemble subcommand implementations "
				"must be non-empty lists", TCL_INDEX_NONE));
			Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				"EMPTY_TARGET", NULL);
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {

	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
	    int flags = 0;			/* silence gcc 4 warning */

	    TclNewObj(resultObj);

	    /* -map option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], TCL_INDEX_NONE));
	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -namespace option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE],
			    -1));
	    namespacePtr = NULL;		/* silence gcc 4 warning */
	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
	    Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));

	    /* -parameters option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], TCL_INDEX_NONE));
	    Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -prefix option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], TCL_INDEX_NONE));
	    Tcl_GetEnsembleFlags(NULL, token, &flags);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));

	    /* -subcommands option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1));

				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "must be non-empty lists", TCL_INDEX_NONE));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;

		    if (patchedDict) {
			allocatedMapFlag = 1;
		    }
		    continue;
		}
		case CONF_NAMESPACE:
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "option -namespace is read-only", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
			    NULL);
		    goto freeMapAndError;
		case CONF_PREFIX:
		    if (Tcl_GetBooleanFromObj(interp, objv[1],
			    &permitPrefix) != TCL_OK) {
			goto freeMapAndError;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

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

	if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) {

    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    size_t length;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;
    } else {
	if (TclListObjLengthM(interp, paramList, &length) != TCL_OK) {

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	size_t size;
	int done;
	Tcl_DictSearch search;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

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

	if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) {

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

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

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

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *paramListPtr = ensemblePtr->parameterList;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

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

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);
    Tcl_DStringInit(&hiddenBuf);
    TclDStringAppendLiteral(&hiddenBuf, "tcl:");
    Tcl_DStringAppend(&hiddenBuf, name, TCL_INDEX_NONE);
    TclDStringAppendLiteral(&hiddenBuf, ":");
    hiddenLen = Tcl_DStringLength(&hiddenBuf);
    if (name[0] == ':' && name[1] == ':') {
	/*
	 * An absolute name, so use it directly.
	 */

	cmdName = name;
	Tcl_DStringAppend(&buf, name, TCL_INDEX_NONE);
	ensembleFlags = TCL_ENSEMBLE_PREFIX;
    } else {
	/*
	 * Not an absolute name, so do munging of it. Note that this treats a
	 * multi-word list differently to a single word.
	 */

	TclDStringAppendLiteral(&buf, "::tcl");

	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
	    Tcl_Panic("invalid ensemble name '%s'", name);
	}

	for (i = 0; i < nameCount; ++i) {
	    TclDStringAppendLiteral(&buf, "::");
	    Tcl_DStringAppend(&buf, nameParts[i], TCL_INDEX_NONE);
	}
    }

    ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (!ns) {
	Tcl_Panic("unable to find or create %s namespace!",

    if (ensemble != NULL) {
	Tcl_Obj *mapDict, *fromObj, *toObj;
	Command *cmdPtr;

	TclDStringAppendLiteral(&buf, "::");
	TclNewObj(mapDict);
	for (i=0 ; map[i].name != NULL ; i++) {
	    fromObj = Tcl_NewStringObj(map[i].name, TCL_INDEX_NONE);
	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
		    Tcl_DStringLength(&buf));
	    Tcl_AppendToObj(toObj, map[i].name, TCL_INDEX_NONE);
	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);

	    if (map[i].proc || map[i].nreProc) {
		/*
		 * If the command is unsafe, hide it when we're in a safe
		 * interpreter. The code to do this is really hokey! It also
		 * doesn't work properly yet; this function is always
		 * currently called before the safe-interp flag is set so the
		 * Tcl_IsSafe check fails.
		 */

		if (map[i].unsafe && Tcl_IsSafe(interp)) {
		    cmdPtr = (Command *)
			    Tcl_NRCreateCommand(interp, "___tmp", map[i].proc,
			    map[i].nreProc, map[i].clientData, NULL);
		    Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
		    if (Tcl_HideCommand(interp, "___tmp",
			    Tcl_DStringAppend(&hiddenBuf, map[i].name, TCL_INDEX_NONE))) {
			Tcl_Panic("%s", Tcl_GetStringResult(interp));
		    }
		} else {
		    /*
		     * Not hidden, so just create it. Yay!
		     */

	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
	if (ensemblePtr->parameterList) {
	    Tcl_DStringAppend(&buf,
		    TclGetString(ensemblePtr->parameterList), TCL_INDEX_NONE);
	    TclDStringAppendLiteral(&buf, " ");
	}
	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DEAD) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "ensemble activated for deleted namespace", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * If the table of subcommands is valid just lookup up the command there

		    fullName);
	}

	/*
	 * Record the spelling correction for usage message.
	 */

	fix = Tcl_NewStringObj(fullName, TCL_INDEX_NONE);

	/*
	 * Cache for later in the subcommand object.
	 */

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

		ensemblePtr->nsPtr->fullName));
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], TCL_INDEX_NONE);
    } else {
	size_t i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], TCL_INDEX_NONE);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
    }
    Tcl_SetObjResult(interp, errorObj);
    return TCL_ERROR;

    Tcl_Preserve(ensemblePtr);
    TclSkipTailcall(interp);
    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
    if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler deleted its ensemble", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
		    NULL);
	}
	result = TCL_ERROR;
    }
    Tcl_Release(ensemblePtr);

     * Convert exceptional result to an error.
     */

    if (!Tcl_InterpDeleted(interp)) {
	if (result != TCL_ERROR) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler returned bad code: ", TCL_INDEX_NONE));
	    switch (result) {
	    case TCL_RETURN:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", TCL_INDEX_NONE);
		break;
	    case TCL_BREAK:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", TCL_INDEX_NONE);
		break;
	    case TCL_CONTINUE:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", TCL_INDEX_NONE);
		break;
	    default:
		Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
	    }
	    Tcl_AddErrorInfo(interp, "\n    result of "
		    "ensemble unknown subcommand handler: ");
	    Tcl_AppendObjToErrorInfo(interp, unknownCmd);

                }
                Tcl_SetHashValue(hPtr, subv[i+1]);
                Tcl_IncrRefCount(subv[i+1]);

                name = TclGetString(subv[i+1]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (isNew) {
                    cmdObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
                    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
                    Tcl_SetHashValue(hPtr, cmdPrefixObj);
                    Tcl_IncrRefCount(cmdPrefixObj);
                }
            }
        } else {
            /*

                /*
                 * Target was not in the dictionary.  Map onto the namespace.
                 * In this case there is no guarantee that the command
                 * is actually there.  It is the responsibility of the
		 * programmer (or [::unknown] of course) to provide the procedure.
                 */

                cmdObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
                cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
                Tcl_SetHashValue(hPtr, cmdPrefixObj);
                Tcl_IncrRefCount(cmdPrefixObj);
            }
        }
    } else if (mapDict) {
        /*

		TclNewLiteralStringObj(keyPtr, "-errorinfo");
		Tcl_IncrRefCount(keyPtr);
		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
		Tcl_DecrRefCount(keyPtr);

		Tcl_WriteChars(errChannel,
			"error in background error handler:\n", TCL_INDEX_NONE);
		if (valuePtr) {
		    Tcl_WriteObj(errChannel, valuePtr);
		} else {
		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
		}
		Tcl_WriteChars(errChannel, "\n", 1);
		Tcl_Flush(errChannel);

    TclNewLiteralStringObj(keyPtr, "-level");
    Tcl_IncrRefCount(keyPtr);
    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (result != TCL_OK || valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-level\"", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
	return TCL_ERROR;
    }
    TclNewLiteralStringObj(keyPtr, "-code");
    Tcl_IncrRefCount(keyPtr);
    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (result != TCL_OK || valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-code\"", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
	return TCL_ERROR;
    }

		Tcl_IncrRefCount(resultPtr);
		if (Tcl_FindCommand(interp, "bgerror", NULL,
			TCL_GLOBAL_ONLY) == NULL) {
		    Tcl_RestoreInterpState(interp, saved);
		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
			    "errorInfo", NULL, TCL_GLOBAL_ONLY));
		    Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE);
		} else {
		    Tcl_DiscardInterpState(saved);
		    Tcl_WriteChars(errChannel,
			    "bgerror failed to handle background error.\n", TCL_INDEX_NONE);
		    Tcl_WriteChars(errChannel, "    Original error: ", TCL_INDEX_NONE);
		    Tcl_WriteObj(errChannel, tempObjv[1]);
		    Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE);
		    Tcl_WriteChars(errChannel, "    Error in bgerror: ", TCL_INDEX_NONE);
		    Tcl_WriteObj(errChannel, resultPtr);
		    Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE);
		}
		Tcl_DecrRefCount(resultPtr);
		Tcl_Flush(errChannel);
	    } else {
		Tcl_DiscardInterpState(saved);
	    }
	}

	    if (Tcl_GetIntFromObj(interp, objv[i], &timeout) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (timeout < 0) {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"timeout must be positive", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "EVENT", "NEGTIME", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    break;
	case OPT_LAST:
	    i++;

	}
    }

  endOfOptionLoop:
    if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS |
		 TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"can't wait: would block forever", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
	result = TCL_ERROR;
	goto done;
    }

    if ((timeout > 0) && ((mask & TCL_TIMER_EVENTS) == 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"timer events disabled with timeout specified", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_TIME", NULL);
	result = TCL_ERROR;
	goto done;
    }

    for (result = TCL_OK; i < objc; i++) {
	result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL,

	goto done;
    }

    if (!(mask & TCL_FILE_EVENTS)) {
	for (i = 0; i < numItems; i++) {
	    if (vwaitItems[i].mask) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"file events disabled with channel(s) specified", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_FILE_EVENT", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	}
    }

	   ((!any && (done < numItems)) || (any && !done))) {
	foundEvent = Tcl_DoOneEvent(mask);
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    break;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "EVENT", "LIMIT", NULL);
	    break;
	}
	if ((numItems == 0) && (timeout == 0)) {
	    /*
	     * Behavior like "update": clear interpreter's result because
	     * event handlers could have executed commands.

    while (Tcl_DoOneEvent(flags) != 0) {
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
    }

    /*
     * Must clear the interpreter's result because event handlers could have
     * executed commands.

    case INST_YIELD:
	corPtr = iPtr->execEnvPtr->corPtr;
	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
	if (!corPtr) {
	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yield can only be called in a coroutine", TCL_INDEX_NONE));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

    case INST_YIELD_TO_INVOKE:
	corPtr = iPtr->execEnvPtr->corPtr;
	valuePtr = OBJ_AT_TOS;
	if (!corPtr) {
	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
		    O2S(valuePtr)));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yieldto can only be called in a coroutine", TCL_INDEX_NONE));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
		    O2S(valuePtr)));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yieldto called in deleted namespace", TCL_INDEX_NONE));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

	Tcl_Obj *listPtr, *nsObjPtr;

	opnd = TclGetUInt1AtPtr(pc+1);

	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tailcall can only be called from a proc or lambda", TCL_INDEX_NONE));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG

	/*
	 * Push the evaluation of the called command into the NR callback
	 * stack.
	 */

	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, TCL_INDEX_NONE);
	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
	if (iPtr->varFramePtr->tailcallPtr) {
	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
	}
	iPtr->varFramePtr->tailcallPtr = listPtr;

	result = TCL_RETURN;

    stringCompare:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	{
	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
	    match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, TCL_INDEX_NONE);
	}

	/*
	 * Make sure only -1,0,1 is returned
	 * TODO: consider peephole opt.
	 */

		    goto wideResultOfArithmetic;
		}
		break;

	    case INST_RSHIFT:
		if (w2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", TCL_INDEX_NONE));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */

		    goto wideResultOfArithmetic;
		}
		break;

	    case INST_LSHIFT:
		if (w2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", TCL_INDEX_NONE));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */

		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", TCL_INDEX_NONE));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;

	/*
	 * Division by zero in an expression. Control only reaches this point
	 * by "goto divideByZero".
	 */

    divideByZero:
	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", TCL_INDEX_NONE));
	DECACHE_STACK_INFO();
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	CACHE_STACK_INFO();
	goto gotError;

    outOfMemory:
	Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", TCL_INDEX_NONE));
	DECACHE_STACK_INFO();
	Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL);
	CACHE_STACK_INFO();
	goto gotError;

	/*
	 * Exponentiation of zero by negative number in an expression. Control
	 * only reaches this point by "goto exponOfZero".
	 */

    exponOfZero:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"exponentiation of zero by negative power", TCL_INDEX_NONE));
	DECACHE_STACK_INFO();
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);
	CACHE_STACK_INFO();

	/*
	 * Almost all error paths feed through here rather than assigning to

	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "negative shift argument", TCL_INDEX_NONE));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"integer value too large to represent", TCL_INDEX_NONE));
		return GENERAL_ARITHMETIC_ERROR;
	    }
	    shift = (int)(*((const Tcl_WideInt *)ptr2));

	    /*
	     * Handle shifts within the native wide range.
	     */

	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_INT type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_INT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", TCL_INDEX_NONE));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/* From here (up to overflowExpon) w1 and exponent w2 are wide-int's. */
	assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);

	if (w1 == 2) {

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
		|| (value2Ptr->typePtr != &tclIntType.objType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", TCL_INDEX_NONE));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	err = mp_init(&bigResult);
	if (err == MP_OKAY) {
	    err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
	}

    double value)		/* Value returned after error; used to
				 * distinguish underflows from overflows. */
{
    const char *s;

    if ((errno == EDOM) || isnan(value)) {
	s = "domain error: argument not in valid range";
	Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
    } else if ((errno == ERANGE) || isinf(value)) {
	if (value == 0.0) {
	    s = "floating-point value too small to represent";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
	} else {
	    s = "floating-point value too large to represent";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
	}
    } else {
	Tcl_Obj *objPtr = Tcl_ObjPrintf(
		"unknown floating-point error, errno = %d", errno);

	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",

    char *p;
    const char *str;

    /*
     * Perform the splitting, using objectified, vfs-aware code.
     */

    tmpPtr = Tcl_NewStringObj(path, TCL_INDEX_NONE);
    Tcl_IncrRefCount(tmpPtr);
    resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
    Tcl_IncrRefCount(resultPtr);
    Tcl_DecrRefCount(tmpPtr);

    /*
     * Calculate space required for the result.

    /*
     * Build the list of paths.
     */

    TclNewObj(listObj);
    for (i = 0; i < argc; i++) {
	Tcl_ListObjAppendElement(NULL, listObj,
		Tcl_NewStringObj(argv[i], TCL_INDEX_NONE));
    }

    /*
     * Ask the objectified code to join the paths.
     */

    Tcl_IncrRefCount(listObj);

    const char *name,		/* File name, which may begin with "~" (to
				 * indicate current user's home directory) or
				 * "~<user>" (to indicate any user's home
				 * directory). */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name. */
{
    Tcl_Obj *path = Tcl_NewStringObj(name, TCL_INDEX_NONE);
    Tcl_Obj *transPtr;

    Tcl_IncrRefCount(path);
    transPtr = Tcl_FSGetTranslatedPath(interp, path);
    if (transPtr == NULL) {
	Tcl_DecrRefCount(path);
	return NULL;

	     * Do nothing; This is normal operations in Tcl 9.
	     * Keep accepting as a no-op option to accommodate old scripts.
	     */
	    break;
	case GLOB_DIR:				/* -dir */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-directory\"", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			dir == PATH_DIR
			    ? "\"-directory\" may only be used once"

	    break;
	case GLOB_TAILS:				/* -tails */
	    globFlags |= TCL_GLOBMODE_TAILS;
	    break;
	case GLOB_PATH:				/* -path */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-path\"", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			dir == PATH_GENERAL
			    ? "\"-path\" may only be used once"
			    : "\"-path\" cannot be used with \"-dictionary\"",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_GENERAL;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_TYPE:				/* -types */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-types\"", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    typePtr = objv[i+1];
	    if (TclListObjLengthM(interp, typePtr, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    i++;
	    break;
	case GLOB_LAST:				/* -- */
	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
		"BADOPTIONCOMBINATION", NULL);
	return TCL_ERROR;
    }

    separators = NULL;
    switch (tclPlatform) {

		/*
		 * The whole thing is a prefix. This means we must remove any
		 * 'tails' flag too, since it is irrelevant now (the same
		 * effect will happen without it), but in particular its use
		 * in TclGlob requires a non-NULL pathOrDir.
		 */

		Tcl_DStringAppend(&pref, first, TCL_INDEX_NONE);
		globFlags &= ~TCL_GLOBMODE_TAILS;
		pathOrDir = NULL;
	    } else {
		/*
		 * Have to split off the end.
		 */

		Tcl_DStringAppend(&prefix, find, 1);
		search = find+1;
		if (*search == '\0') {
		    break;
		}
	    }
	    if (*search != '\0') {
		Tcl_DStringAppend(&prefix, search, TCL_INDEX_NONE);
	    }
	    Tcl_DStringFree(&pref);
	}
    }

    if (pathOrDir != NULL) {
	Tcl_IncrRefCount(pathOrDir);

		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"only one MacOS type or creator argument"
			" to \"-types\" allowed", TCL_INDEX_NONE));
		result = TCL_ERROR;
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		join = 0;
		goto endOfGlob;
	    }
	}
    }

	    }
	    tail = p;
	    Tcl_IncrRefCount(pathPrefix);
	} else if (pathPrefix == NULL && (tail[0] == '/'
		|| (tail[0] == '\\' && tail[1] == '\\'))) {
	    size_t driveNameLen;
	    Tcl_Obj *driveName;
	    Tcl_Obj *temp = Tcl_NewStringObj(tail, TCL_INDEX_NONE);
	    Tcl_IncrRefCount(temp);

	    switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) {
	    case TCL_PATH_VOLUME_RELATIVE: {
		/*
		 * Volume relative path which is equivalent to a path in the
		 * root of the cwd's volume. We will actually return

		 * Balanced braces.
		 */

		closeBrace = p;
		break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched open-brace in file name", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;

	} else if (*p == '}') {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched close-brace in file name", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;
	}
    }

    /*

	*closeBrace = '\0';
	for (p = openBrace; p != closeBrace; ) {
	    p++;
	    element = p;
	    SkipToChar(&p, ',');
	    Tcl_DStringSetLength(&newName, baseLength);
	    Tcl_DStringAppend(&newName, element, p-element);
	    Tcl_DStringAppend(&newName, closeBrace+1, TCL_INDEX_NONE);
	    result = DoGlob(interp, matchesObj, separators, pathPtr, flags,
		    Tcl_DStringValue(&newName), types);
	    if (result != TCL_OK) {
		break;
	    }
	}
	*closeBrace = '}';

#include "tclIO.h"

/*
 * Forward declarations of internal procedures. First the driver procedures of
 * the transformation.
 */

static int		TransformBlockModeProc(void *instanceData,
			    int mode);
static int		TransformCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		TransformInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCodePtr);
static int		TransformOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCodePtr);
static int		TransformSetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static int		TransformGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(void *instanceData, int mask);
static int		TransformGetFileHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		TransformNotifyProc(void *instanceData, int mask);
static long long	TransformWideSeekProc(void *instanceData,
			    long long offset, int mode, int *errorCodePtr);

/*
 * Forward declarations of internal procedures. Secondly the procedures for
 * handling and generating fileeevents.
 */

static void		TransformChannelHandlerTimer(void *clientData);

/*
 * Forward declarations of internal procedures. Third, helper procedures
 * encapsulating essential tasks.
 */

typedef struct TransformChannelData TransformChannelData;

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

    if (TCL_OK != TclListObjLengthM(interp, cmdObjPtr, &objc)) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("-command value is not a list", TCL_INDEX_NONE));
	return TCL_ERROR;
    }

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

     */

    if (preserve == P_PRESERVE) {
	state = Tcl_SaveInterpState(eval, res);
    }

    Tcl_IncrRefCount(command);
    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, TCL_INDEX_NONE));

    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as UTF while at the tcl level.
     */

    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));

 *	0 if successful, errno when failed.
 *
 *----------------------------------------------------------------------
 */

static int
TransformBlockModeProc(
    void *instanceData,	/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {

 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformCloseProc(
    void *instanceData,
    Tcl_Interp *interp,
	int flags)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;

 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformInputProc(
    void *instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    int gotBytes, read, copied;
    Tcl_Channel downChan;

 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformOutputProc(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*

 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static long long
TransformWideSeekProc(
    void *instanceData,	/* The channel to manipulate. */
    long long offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);

 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformSetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverSetOptionProc *setOptionProc;

 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverGetOptionProc *getOptionProc;

 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformWatchProc(
    void *instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occuring for this channel. We

 *	The appropriate Tcl_File or NULL if not present.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetFileHandleProc(
    void *instanceData,	/* Channel to query. */
    int direction,		/* Direction of interest. */
    void **handlePtr)	/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */

 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformNotifyProc(
    void *clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occuring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occured in the underlying channel. This transformation doesn't

 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformChannelHandlerTimer(
    void *clientData)	/* Transformation to query. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,
    int port,
    const char *host,
    Tcl_TcpAcceptProc *acceptProc,
    void *callbackData)
{
    char portbuf[TCL_INTEGER_SPACE];

    TclFormatInt(portbuf, port);
    return Tcl_OpenTcpServerEx(interp, portbuf, host, -1,
	    TCL_TCPSERVER_REUSEADDR, acceptProc, callbackData);
}

    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE,
	    memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }

    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE,
	    memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;

    }

    if (attrTable != NULL) {
	/*
	 * It's a constant attribute table, so use T_GIFO.
	 */

	Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, TCL_INDEX_NONE);
	int result;

	result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT,
		indexPtr);
	TclDecrRefCount(tmpObj);
	if (listObj != NULL) {
	    TclDecrRefCount(listObj);

	  * Try to delete the file we probably created and then exit.
	  */

	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "couldn't load from current filesystem", TCL_INDEX_NONE));
	}
	return TCL_ERROR;
    }

    if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) {
	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);

    if (fsPtr == NULL) {
	return NULL;
    }

    resPtr = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(NULL, resPtr,
	    Tcl_NewStringObj(fsPtr->typeName, TCL_INDEX_NONE));

    if (fsPtr->filesystemPathTypeProc != NULL) {
	Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);

	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}

	switch (index) {
	case PRFMATCH_EXACT:
	    flags |= TCL_EXACT;
	    break;
	case PRFMATCH_MESSAGE:
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing value for -message", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
		return TCL_ERROR;
	    }
	    i++;
	    message = TclGetString(objv[i]);
	    break;
	case PRFMATCH_ERROR:
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing value for -error", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
		return TCL_ERROR;
	    }
	    i++;
	    result = TclListObjLengthM(interp, objv[i], &errorLength);
	    if (result != TCL_OK) {
		return TCL_ERROR;

    Interp *iPtr = (Interp *)interp;
    const char *elementStr;

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", TCL_INDEX_NONE);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", TCL_INDEX_NONE);
    }

    /*
     * If processing an an ensemble implementation, rewrite the results in
     * terms of how the ensemble was invoked.
     */

	}
    }

    /*
     * Now add the option information, with pretty-printing.
     */

    msg = Tcl_NewStringObj("Command-specific options:", TCL_INDEX_NONE);
    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
	if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
	    Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
	    continue;
	}
	Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
	numSpaces = width + 1 - strlen(infoPtr->keyStr);
	while (numSpaces > 0) {
	    if (numSpaces >= NUM_SPACES) {
		Tcl_AppendToObj(msg, spaces, NUM_SPACES);
	    } else {
		Tcl_AppendToObj(msg, spaces, numSpaces);
	    }
	    numSpaces -= NUM_SPACES;
	}
	Tcl_AppendToObj(msg, infoPtr->helpStr, TCL_INDEX_NONE);
	switch (infoPtr->type) {
	case TCL_ARGV_INT:
	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d",
		    *((int *) infoPtr->dstPtr));
	    break;
	case TCL_ARGV_FLOAT:
	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",

 * TIP#143 limit handler internal representation.
 */

struct LimitHandler {
    int flags;			/* The state of this particular handler. */
    Tcl_LimitHandlerProc *handlerProc;
				/* The handler callback. */
    void *clientData;	/* Opaque argument to the handler callback. */
    Tcl_LimitHandlerDeleteProc *deleteProc;
				/* How to delete the clientData. */
    LimitHandler *prevPtr;	/* Previous item in linked list of
				 * handlers. */
    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
};

static int		ChildTimeLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
static void		InheritLimitsFromParent(Tcl_Interp *childInterp,
			    Tcl_Interp *parentInterp);
static void		SetScriptLimitCallback(Tcl_Interp *interp, int type,
			    Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
static void		CallScriptLimitCallback(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(void *clientData);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(void *clientData);

/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;



    PkgName pkgName = {NULL, "tcl"};
    PkgName **names = (PkgName **)TclInitPkgFiles(interp);
    int result = TCL_ERROR;

    pkgName.nextPtr = *names;
    *names = &pkgName;
    if (tclPreInitScript != NULL) {
	if (Tcl_EvalEx(interp, tclPreInitScript, TCL_INDEX_NONE, 0) == TCL_ERROR) {
	    goto end;
	}
    }

    /*
     * In order to find init.tcl during initialization, the following script
     * is invoked by Tcl_Init(). It looks in several different directories:

"    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", TCL_INDEX_NONE, 0);

end:
    *names = (*names)->nextPtr;
    return result;
}

/*

 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_InterpObjCmd(
    void *clientData,
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
}

		Tcl_CmdInfo cmdInfo;

		sprintf(buf, "interp%d", i);
		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
		    break;
		}
	    }
	    childPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
	}
	if (ChildCreate(interp, childPtr, safe) == NULL) {
	    if (buf[0] != '\0') {
		Tcl_DecrRefCount(childPtr);
	    }
	    return TCL_ERROR;
	}

	for (i = 2; i < objc; i++) {
	    childInterp = GetInterp(interp, objv[i]);
	    if (childInterp == NULL) {
		return TCL_ERROR;
	    } else if (childInterp == interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot delete the current interpreter", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			"DELETESELF", NULL);
		return TCL_ERROR;
	    }
	    iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	    Tcl_DeleteCommandFromToken(iiPtr->child.parentInterp,
		    iiPtr->child.interpCmd);

	}
	iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	TclNewObj(resultPtr);
	hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch);
	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
	    string = (char *)Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr);
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    Tcl_NewStringObj(string, TCL_INDEX_NONE));
	}
	Tcl_SetObjResult(interp, resultPtr);
	return TCL_OK;
    }
    case OPT_TRANSFER:
    case OPT_SHARE: {
	Tcl_Interp *parentInterp;	/* The parent of the child. */

    Tcl_Obj *childObjPtr, *targetObjPtr;
    Tcl_Obj **objv;
    size_t i;
    int result;

    objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc);
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], TCL_INDEX_NONE);
	Tcl_IncrRefCount(objv[i]);
    }

    childObjPtr = Tcl_NewStringObj(childCmd, TCL_INDEX_NONE);
    Tcl_IncrRefCount(childObjPtr);

    targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_INDEX_NONE);
    Tcl_IncrRefCount(targetObjPtr);

    result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
	    targetObjPtr, argc, objv);

    for (i = 0; i < argc; i++) {
	Tcl_DecrRefCount(objv[i]);

    const char *targetCmd,	/* Name of target command. */
    size_t objc,			/* How many additional arguments? */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    int result;

    childObjPtr = Tcl_NewStringObj(childCmd, TCL_INDEX_NONE);
    Tcl_IncrRefCount(childObjPtr);

    targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_INDEX_NONE);
    Tcl_IncrRefCount(targetObjPtr);

    result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
	    targetObjPtr, objc, objv);

    Tcl_DecrRefCount(childObjPtr);
    Tcl_DecrRefCount(targetObjPtr);

 *	forwarded.
 *
 *----------------------------------------------------------------------
 */

static int
AliasNRCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;

    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

int
TclAliasObjCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    Tcl_Interp *targetInterp = aliasPtr->targetInterp;

    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    int result, prefc, cmdc, i;

 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
AliasObjCmdDeleteProc(
    void *clientData)	/* The alias record for this alias. */
{
    Alias *aliasPtr = (Alias *)clientData;
    Target *targetPtr;
    int i;
    Tcl_Obj **objv;

    Tcl_DecrRefCount(aliasPtr->token);

    Tcl_Interp *interp,		/* Interpreter to start search at. */
    const char *childPath,	/* Name of child to create. */
    int isSafe)			/* Should new child be "safe" ? */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *childInterp;

    pathPtr = Tcl_NewStringObj(childPath, TCL_INDEX_NONE);
    childInterp = ChildCreate(interp, pathPtr, isSafe);
    Tcl_DecrRefCount(pathPtr);

    return childInterp;
}

/*

Tcl_GetChild(
    Tcl_Interp *interp,		/* Interpreter to start search from. */
    const char *childPath)	/* Path of child to find. */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *childInterp;

    pathPtr = Tcl_NewStringObj(childPath, TCL_INDEX_NONE);
    childInterp = GetInterp(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);

    return childInterp;
}

/*

    }
    iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
    if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK){
	return TCL_ERROR;
    }
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
	    Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable,
		    iiPtr->child.childEntryPtr), TCL_INDEX_NONE));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetInterp --

{
    if (objc) {
	size_t length;

	if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length)
		|| (length < 1)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cmdPrefix must be list of length >= 1", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "BGERRORFORMAT", NULL);
	    return TCL_ERROR;
	}
	TclSetBgErrorHandler(childInterp, objv[0]);
    }
    Tcl_SetObjResult(interp, TclGetBgErrorHandler(childInterp));

 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

int
TclChildObjCmd(
    void *clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv);
}

static int
NRChildCmd(
    void *clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",

 *	the child interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
ChildObjCmdDeleteProc(
    void *clientData)	/* The ChildRecord for the command. */
{
    Child *childPtr;		/* Interim storage for Child record. */
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
				/* And for a child interp. */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;

    Interp *iPtr;
    Tcl_Obj *resultPtr;

    iPtr = (Interp *) childInterp;
    if (objc == 0) {
	TclNewObj(resultPtr);
	Tcl_ListObjAppendElement(NULL, resultPtr,
		Tcl_NewStringObj("-frame", TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(NULL, resultPtr,
		Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option",
		0, &debugType) != TCL_OK) {
	    return TCL_ERROR;

{
    Interp *iPtr;
    Tcl_WideInt limit;

    if (objc) {
	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: "
		    "safe interpreters cannot change recursion limit", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		    NULL);
	    return TCL_ERROR;
	}
	if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (limit <= 0 || (size_t)limit >= ((Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "recursion limit must be > 0 and < %" TCL_LL_MODIFIER "u", (Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetRecursionLimit(childInterp, limit);
	iPtr = (Interp *) childInterp;
	if (interp == childInterp && iPtr->numLevels > (size_t)limit) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "falling back due to new recursion limit", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, objv[0]);
	return TCL_OK;
    } else {
	limit = Tcl_SetRecursionLimit(childInterp, 0);

    TclNewObj(listObjPtr);
    hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
		hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    Tcl_ListObjAppendElement(NULL, listObjPtr,
		    Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), TCL_INDEX_NONE));
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*

    Tcl_Release(childInterp);
    return result;
}

static int
NRPostInvokeHidden(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Interp *childInterp = (Tcl_Interp *)data[0];
    NRE_callback *rootPtr = (NRE_callback *)data[1];

    if (interp != childInterp) {

	 * Alias these function implementations in the child to those in the
	 * parent; the overall implementations are safe, but they're normally
	 * defined by init.tcl which is not sourced by safe interpreters.
	 * Assume these functions all work. [Bug 2895741]
	 */

	(void) Tcl_EvalEx(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}", TCL_INDEX_NONE, 0);
    }

    iPtr->flags |= SAFE_INTERP;

    /*
     * Unsetting variables : (which should not have been set in the first
     * place, but...)

	iPtr->limit.exceeded |= TCL_LIMIT_COMMANDS;
	Tcl_Preserve(interp);
	RunLimitHandlers(iPtr->limit.cmdHandlers, interp);
	if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
	    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
	} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command count limit exceeded", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
	    Tcl_Release(interp);
	    return TCL_ERROR;
	}
	Tcl_Release(interp);
    }

	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
	    if (iPtr->limit.time.sec > now.sec ||
		    (iPtr->limit.time.sec == now.sec &&
		    iPtr->limit.time.usec >= now.usec)) {
		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
	    } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"time limit exceeded", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
		Tcl_Release(interp);
		return TCL_ERROR;
	    }
	    Tcl_Release(interp);
	}
    }

 */

void
Tcl_LimitAddHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    void *clientData,
    Tcl_LimitHandlerDeleteProc *deleteProc)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.

 */

void
Tcl_LimitRemoveHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    void *clientData)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    switch (type) {
    case TCL_LIMIT_COMMANDS:
	handlerPtr = iPtr->limit.cmdHandlers;

 *	commands. May make callbacks into other interpreters.
 *
 *----------------------------------------------------------------------
 */

static void
TimeLimitCallback(
    void *clientData)
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Interp *iPtr = (Interp *)clientData;
    int code;

    Tcl_Preserve(interp);
    iPtr->limit.timeEvent = NULL;

 *	is removed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteScriptLimitCallback(
    void *clientData)
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }

 *	errors.
 *
 *----------------------------------------------------------------------
 */

static void
CallScriptLimitCallback(
    void *clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    int code;

    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;

     * interpreter's limits; it may only manipulate its children. Note that
     * the low level API enforces this with Tcl_Panic, which we want to
     * avoid. [Bug 3398794]
     */

    if (interp == childInterp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"limits on current interpreter inaccessible", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
	return TCL_ERROR;
    }

    if (objc == consumedObjc) {
	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = childInterp;
	key.type = TCL_LIMIT_COMMANDS;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key);
	if (hPtr != NULL) {
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], TCL_INDEX_NONE),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
	    Tcl_Obj *empty;

	putEmptyCommandInDict:
	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[0], TCL_INDEX_NONE), empty);
	}
	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], TCL_INDEX_NONE),
		Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
		TCL_LIMIT_COMMANDS)));

	if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], TCL_INDEX_NONE),
		    Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
	} else {
	    Tcl_Obj *empty;

	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[2], TCL_INDEX_NONE), empty);
	}
	Tcl_SetObjResult(interp, dictPtr);
	return TCL_OK;
    } else if (objc == consumedObjc+1) {
	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
		0, &index) != TCL_OK) {
	    return TCL_ERROR;

	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "command limit value must be at least 0", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}

     * interpreter's limits; it may only manipulate its children. Note that
     * the low level API enforces this with Tcl_Panic, which we want to
     * avoid. [Bug 3398794]
     */

    if (interp == childInterp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"limits on current interpreter inaccessible", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
	return TCL_ERROR;
    }

    if (objc == consumedObjc) {
	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = childInterp;
	key.type = TCL_LIMIT_TIME;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key);
	if (hPtr != NULL) {
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], TCL_INDEX_NONE),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
	    Tcl_Obj *empty;
	putEmptyCommandInDict:
	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[0], TCL_INDEX_NONE), empty);
	}
	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], TCL_INDEX_NONE),
		Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
		TCL_LIMIT_TIME)));

	if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
	    Tcl_Time limitMoment;

	    Tcl_LimitGetTime(childInterp, &limitMoment);
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], TCL_INDEX_NONE),
		    Tcl_NewWideIntObj(limitMoment.usec/1000));
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], TCL_INDEX_NONE),
		    Tcl_NewWideIntObj(limitMoment.sec));
	} else {
	    Tcl_Obj *empty;

	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[2], TCL_INDEX_NONE), empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[3], TCL_INDEX_NONE), empty);
	}
	Tcl_SetObjResult(interp, dictPtr);
	return TCL_OK;
    } else if (objc == consumedObjc+1) {
	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
		0, &index) != TCL_OK) {
	    return TCL_ERROR;

	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];

		 * Setting -milliseconds but clearing -seconds, or resetting
		 * -milliseconds but not resetting -seconds? Bad voodoo!
		 */

		if (secObj != NULL && secLen == 0 && milliLen > 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "may only set -milliseconds if -seconds is not "
			    "also being reset", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADUSAGE", NULL);
		    return TCL_ERROR;
		}
		if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "may only reset -milliseconds if -seconds is "
			    "also being reset", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADUSAGE", NULL);
		    return TCL_ERROR;
		}
	    }

	    if (milliLen > 0 || secLen > 0) {

				 * becomes zero. */
} ResolvedNsName;

/*
 * Declarations for functions local to this file:
 */

static void		DeleteImportedCmd(void *clientData);
static int		DoImport(Tcl_Interp *interp,
			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
			    const char *cmdName, const char *pattern,
			    Namespace *importNsPtr, int allowOverwrite);
static void		DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
static char *		ErrorCodeRead(void *clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		ErrorInfoRead(void *clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		EstablishErrorCodeTraces(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedNRCmd(void *clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	NamespaceChildrenCmd;
static Tcl_ObjCmdProc	NamespaceCodeCmd;
static Tcl_ObjCmdProc	NamespaceCurrentCmd;
static Tcl_ObjCmdProc	NamespaceDeleteCmd;
static Tcl_ObjCmdProc	NamespaceEvalCmd;
static Tcl_ObjCmdProc	NRNamespaceEvalCmd;

Tcl_CreateNamespace(
    Tcl_Interp *interp,		/* Interpreter in which a new namespace is
				 * being created. Also used for error
				 * reporting. */
    const char *name,		/* Name for the new namespace. May be a
				 * qualified name with names of ancestor
				 * namespaces separated by "::"s. */
    void *clientData,	/* One-word value to store with namespace. */
    Tcl_NamespaceDeleteProc *deleteProc)
				/* Function called to delete client data when
				 * the namespace is deleted. NULL if no
				 * function should be called. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr, *ancestorPtr;

     * Ensure that there are no trailing colons as that causes chaos when a
     * deleteProc is specified. [Bug d614d63989]
     */

    if (deleteProc != NULL) {
	nameStr = name + strlen(name) - 2;
	if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') {
	    Tcl_DStringAppend(&tmpBuffer, name, TCL_INDEX_NONE);
	    while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0
		    && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') {
		Tcl_DStringSetLength(&tmpBuffer, nameLen-1);
	    }
	    name = Tcl_DStringValue(&tmpBuffer);
	}
    }

    /*
     * If we've ended up with an empty string now, we're attempting to create
     * the global namespace despite the global namespace existing. That's
     * naughty!
     */

    if (*name == '\0') {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
                " \"\": only global namespace can have empty name", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
		"CREATEGLOBAL", NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

    /*

    buffPtr = &buffer2;
    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
	    ancestorPtr = ancestorPtr->parentPtr) {
	if (ancestorPtr != globalNsPtr) {
	    Tcl_DString *tempPtr = namePtr;

	    TclDStringAppendLiteral(buffPtr, "::");
	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, TCL_INDEX_NONE);
	    TclDStringAppendDString(buffPtr, namePtr);

	    /*
	     * Clear the unwanted buffer or we end up appending to previous
	     * results, making the namespace fullNames of nested namespaces
	     * very wrong (and strange).
	     */

    /*
     * Append the export pattern list onto objPtr.
     */

    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	result = Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(nsPtr->exportArrayPtr[i], TCL_INDEX_NONE));
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}


     */

    if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) {
	Tcl_Obj *objv[2];
	int result;

	TclNewLiteralStringObj(objv[0], "auto_import");
	objv[1] = Tcl_NewStringObj(pattern, TCL_INDEX_NONE);

	Tcl_IncrRefCount(objv[0]);
	Tcl_IncrRefCount(objv[1]);
	result = Tcl_EvalObjv(interp, 2, objv, TCL_GLOBAL_ONLY);
	Tcl_DecrRefCount(objv[0]);
	Tcl_DecrRefCount(objv[1]);

	Tcl_DString ds;
	Tcl_Command importedCmd;
	ImportedCmdData *dataPtr;
	Command *cmdPtr;
	ImportRef *refPtr;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, nsPtr->fullName, TCL_INDEX_NONE);
	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
	    TclDStringAppendLiteral(&ds, "::");
	}
	Tcl_DStringAppend(&ds, cmdName, TCL_INDEX_NONE);

	/*
	 * Check whether creating the new imported command in the current
	 * namespace would create a cycle of imported command references.
	 */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

 *	wrong, the result object is set to an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InvokeImportedNRCmd(
    void *clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

int
TclInvokeImportedCmd(
    void *clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
	    objc, objv);

 *	Removes the imported command from the real command's import list.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteImportedCmd(
    void *clientData)	/* Points to the imported command's
				 * ImportedCmdData structure. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    Command *selfPtr = dataPtr->selfPtr;
    ImportRef *refPtr, *prevPtr;

    Tcl_DStringInit(&buffer);
    if (objc == 3) {
	const char *name = TclGetString(objv[2]);

	if ((*name == ':') && (*(name+1) == ':')) {
	    pattern = name;
	} else {
	    Tcl_DStringAppend(&buffer, nsPtr->fullName, TCL_INDEX_NONE);
	    if (nsPtr != globalNsPtr) {
		TclDStringAppendLiteral(&buffer, "::");
	    }
	    Tcl_DStringAppend(&buffer, name, TCL_INDEX_NONE);
	    pattern = Tcl_DStringValue(&buffer);
	}
    }

    /*
     * Create a list containing the full names of all child namespaces whose
     * names match the specified pattern, if any.

	    Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL
#else
	    nsPtr->childTablePtr != NULL &&
	    Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL
#endif
	) {
	    Tcl_ListObjAppendElement(interp, listPtr,
		    Tcl_NewStringObj(pattern, TCL_INDEX_NONE));
	}
	goto searchDone;
    }
#ifndef BREAK_NAMESPACE_COMPAT
    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
#else
    if (nsPtr->childTablePtr == NULL) {
	goto searchDone;
    }
    entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
#endif
    while (entryPtr != NULL) {
	childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
	if ((pattern == NULL)
		|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
	    elemPtr = Tcl_NewStringObj(childNsPtr->fullName, TCL_INDEX_NONE);
	    Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
	}
	entryPtr = Tcl_NextHashEntry(&search);
    }

  searchDone:
    Tcl_SetObjResult(interp, listPtr);

    TclNewLiteralStringObj(objPtr, "inscope");
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);

    currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
	TclNewLiteralStringObj(objPtr, "::");
    } else {
	objPtr = Tcl_NewStringObj(currNsPtr->fullName, TCL_INDEX_NONE);
    }
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);

    Tcl_ListObjAppendElement(interp, listPtr, objv[1]);

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;

     *    namespace [namespace current]::bar { ... }
     */

    currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceEvalCmd(
    void *clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
	    objv);
}

    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
	    NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}

static int
NsEval_Callback(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	size_t length = strlen(namespacePtr->fullName);

 *	Returns a result in the Tcl interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceInscopeCmd(
    void *clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
	    objv);
}

    /*
     * Report the parent of the specified namespace.
     */

    if (nsPtr->parentPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		nsPtr->parentPtr->fullName, TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    if (objc == 1) {
	Tcl_Obj *resultObj;

	TclNewObj(resultObj);
	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	    if (nsPtr->commandPathArray[i].nsPtr != NULL) {
		Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
			nsPtr->commandPathArray[i].nsPtr->fullName, TCL_INDEX_NONE));
	    }
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;
    }

    /*

	if ((*p == ':') && (*(p-1) == ':')) {
	    p++;			/* Just after the last "::" */
	    break;
	}
    }

    if (p >= name) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(void *clientData);
static void		DeletedObjdefNamespace(void *clientData);
static void		DeletedHelpersNamespace(void *clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;
static Tcl_NRPostProc	FinalizeObjectCall;
static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void		InitClassSystemRoots(Tcl_Interp *interp,
			    Foundation *fPtr);
static int		InitFoundation(Tcl_Interp *interp);
static Tcl_InterpDeleteProc	KillFoundation;
static void		MyDeleted(void *clientData);
static void		ObjectNamespaceDeleted(void *clientData);
static Tcl_CommandTraceProc	ObjectRenamedTrace;
static inline void	RemoveClass(Class **list, size_t num, size_t idx);
static inline void	RemoveObject(Object **list, size_t num, size_t idx);
static inline void	SquelchCachedName(Object *oPtr);

static int		PublicNRObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(void *clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.

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

static inline void
RemoveClass(
    Class **list,
    size_t num,
    size_t idx)
{
    for (; idx + 1 < num; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

static inline void
RemoveObject(
    Object **list,
    size_t num,
    size_t idx)
{
    for (; idx + 1 < num; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------

    }

    /*
     * Run our initialization script and, if that works, declare the package
     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) {
	return TCL_ERROR;
    }

#ifndef TCL_NO_DEPRECATED
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
#endif

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i = 0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, TCL_INDEX_NONE);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i = 0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, TCL_INDEX_NONE);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);

	return TCL_ERROR;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, tclOOSetupScript, TCL_INDEX_NONE, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *

 *	longer hold useful information.
 *
 * ----------------------------------------------------------------------
 */

static void
DeletedDefineNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->defineNs = NULL;
}

static void
DeletedObjdefNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->objdefNs = NULL;
}

static void
DeletedHelpersNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->helpersNs = NULL;
}

/*

 *	of those commands when the object itself is deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    void *clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    Object *oPtr = (Object *)clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    void *clientData)
{
    Object *oPtr = (Object *)clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any
 *	mechanism. It runs the destructors and arranges for the actual cleanup
 *	of the object's namespace, which in turn triggers cleansing of the
 *	object data structures.
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectRenamedTrace(
    void *clientData,	/* The object being deleted. */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(const char *) /*oldName*/,
    TCL_UNUSED(const char *) /*newName*/,
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = (Object *)clientData;

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	Tcl_Free(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;

 *	(interpreter teardown is complex!)
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectNamespaceDeleted(
    void *clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = (Object *)clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;

	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	Tcl_Free(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;

				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    size_t skip)			/* Number of arguments to _not_ pass to the
				 * constructor. */
{
    Class *classPtr = (Class *) cls;
    Object *oPtr;
    void *clientData[4];

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return NULL;
    }

    /*

	oPtr->classPtr = NULL;
    }
    return oPtr;
}

static int
FinalizeAlloc(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[2];
    Tcl_Object *objectPtr = (Tcl_Object *)data[3];

    /*
     * Ensure an error if the object was deleted in the constructor. Don't
     * want to lose errors by accident. [Bug 2903011]
     */

    if (result != TCL_ERROR && Destructing(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object deleted in constructor", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not clone the class of classes", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, TCL_INDEX_NONE,
	    NULL, TCL_INDEX_NONE);
    if (o2Ptr == NULL) {
	return NULL;
    }

    /*
     * Copy the object-local methods to the new object.
     */

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value, *duplicate;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    if (metadataTypePtr->cloneProc == NULL) {
		duplicate = value;
	    } else {
		if (metadataTypePtr->cloneProc(interp, value,
			&duplicate) != TCL_OK) {

	/*
	 * Duplicate the class's metadata.
	 */

	if (clsPtr->metadataPtr != NULL) {
	    Tcl_ObjectMetadataType *metadataTypePtr;
	    void *value, *duplicate;

	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		if (metadataTypePtr->cloneProc == NULL) {
		    duplicate = value;
		} else {
		    if (metadataTypePtr->cloneProc(interp, value,
			    &duplicate) != TCL_OK) {

    Method *mPtr,
    Tcl_Obj *namePtr)
{
    if (mPtr->typePtr == NULL) {
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	void *newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);

{
    Method *m2Ptr;

    if (mPtr->typePtr == NULL) {
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	void *newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,

 *	attached (replacing the previous value, which is deleted if present)
 *	otherwise. This means it is impossible to attach a NULL value for any
 *	metadata type.
 *
 * ----------------------------------------------------------------------
 */

void *
Tcl_ClassGetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;

    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ClassSetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr,
    void *metadata)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.

    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, typePtr, &isNew);
    if (!isNew) {
	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
    }
    Tcl_SetHashValue(hPtr, metadata);
}

void *
Tcl_ObjectGetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;

    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ObjectSetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr,
    void *metadata)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.

 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOPublicObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}

static int
PrivateNRObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}

 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *)clientData;

    if (objc < 2) {

	    }
	    if (miPtr->mPtr->declaringClassPtr == startCls) {
		break;
	    }
	}
	if (contextPtr->index >= contextPtr->callPtr->numChain) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "no valid method implementation", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    TclOODeleteContext(contextPtr);
	    return TCL_ERROR;
	}
    }

    /*
     * Invoke the call chain, locking the object structure against deletion
     * for the duration.
     */

    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    /*
     * Dispose of the call chain, which drops the lock on the object's
     * structure.
     */

     */

    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeNext(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke

    }

    /*
     * Make the class definition delegate. This is special; it doesn't reenter
     * here (and the class definition delegate doesn't run any constructors).
     */

    nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, TCL_INDEX_NONE);
    Tcl_AppendToObj(nameObj, ":: oo ::delegate", TCL_INDEX_NONE);
    Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
	    TclGetString(nameObj), NULL, TCL_INDEX_NONE, NULL, TCL_INDEX_NONE);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *));

    Object *oPtr = (Object *)data[1];
    Tcl_InterpState saved;
    int code;

    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);
    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", TCL_INDEX_NONE);
    invoke[1] = TclOOObjectName(interp, oPtr);
    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    saved = Tcl_SaveInterpState(interp, result);
    code = Tcl_EvalObjv(interp, 2, invoke, 0);
    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);

		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
    nsName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"namespace name must not be empty", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

	return TCL_ERROR;
    }

    errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
	    TclGetString(objv[skip]));
    for (i=0 ; i<numMethodNames-1 ; i++) {
	if (i) {
	    Tcl_AppendToObj(errorMsg, ", ", TCL_INDEX_NONE);
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], TCL_INDEX_NONE);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", TCL_INDEX_NONE);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], TCL_INDEX_NONE);
    Tcl_Free((void *)methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), NULL);
    return TCL_ERROR;
}


			    break;
			}
		    }
		}
	    }
	}

	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, TCL_INDEX_NONE);
	Tcl_AppendToObj(varNamePtr, "::", 2);
	Tcl_AppendObjToObj(varNamePtr, argPtr);
    }
    Tcl_IncrRefCount(varNamePtr);
    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
	    TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
    Tcl_DecrRefCount(varNamePtr);

    if (aryVar != NULL) {
	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);

	/*
	 * WARNING! This code pokes inside the implementation of hash tables!
	 */

	Tcl_AppendToObj(varNamePtr, "(", TCL_INDEX_NONE);
	Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
		varPtr)->entry.key.objPtr);
	Tcl_AppendToObj(varNamePtr, ")", TCL_INDEX_NONE);
    } else {
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
    }
    Tcl_SetObjResult(interp, varNamePtr);
    return TCL_OK;
}


		contextPtr->oPtr->namespacePtr->fullName,-1));
	return TCL_OK;
    case SELF_CLASS: {
	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;

	if (clsPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "method not defined by a class", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
	return TCL_OK;
    }
    case SELF_METHOD:
	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
	} else {
	    Tcl_SetObjResult(interp,
		    CurrentlyInvoked(contextPtr).mPtr->namePtr);
	}
	return TCL_OK;
    case SELF_FILTER:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
	    Object *oPtr;
	    const char *type;

	    if (miPtr->filterDeclarer != NULL) {
		oPtr = miPtr->filterDeclarer->thisPtr;
		type = "class";
	    } else {
		oPtr = contextPtr->oPtr;
		type = "object";
	    }

	    result[0] = TclOOObjectName(interp, oPtr);
	    result[1] = Tcl_NewStringObj(type, TCL_INDEX_NONE);
	    result[2] = miPtr->mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
	    return TCL_OK;
	}
    case SELF_CALLER:
	if ((framePtr->callerVarPtr == NULL) ||
		!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "caller is not an object", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    return TCL_ERROR;
	} else {
	    CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData;
	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
	    Object *declarerPtr;

	    if (mPtr->declaringClassPtr != NULL) {
		declarerPtr = mPtr->declaringClassPtr->thisPtr;
	    } else if (mPtr->declaringObjectPtr != NULL) {
		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", TCL_INDEX_NONE));
		return TCL_ERROR;
	    }

	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = TclOOObjectName(interp, callerPtr->oPtr);
	    if (callerPtr->callPtr->flags & CONSTRUCTOR) {
		result[2] = declarerPtr->fPtr->constructorName;

		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", TCL_INDEX_NONE));
		return TCL_ERROR;
	    }

	    result[0] = TclOOObjectName(interp, declarerPtr);
	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
		result[1] = declarerPtr->fPtr->constructorName;
	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
		result[1] = declarerPtr->fPtr->destructorName;
	    } else {
		result[1] = mPtr->namePtr;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	}
	return TCL_OK;
    case SELF_TARGET:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    Method *mPtr;
	    Object *declarerPtr;
	    size_t i;

		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", TCL_INDEX_NONE));
		return TCL_ERROR;
	    }
	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	    return TCL_OK;
	}

static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
			    int useClass, Tcl_Obj *const fromPtr,
			    Tcl_Obj *const toPtr);
static int		ClassFilterGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassFilterSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ResolveClass(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

	}
	if (toPtr) {
	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, toPtr,
		    &isNew);
	    if (hPtr == newHPtr) {
	    renameToSelf:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot rename method to itself", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
		return TCL_ERROR;
	    } else if (!isNew) {
	    renameToExisting:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"method called %s already exists",
			TclGetString(toPtr)));

    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    size_t soughtLen;
    const char *soughtStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }