#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"












/*
 * Structure used to contain all the information needed about a call frame
 * used in a procedure-like method.
 */

typedef struct {
    CallFrame *framePtr;	/* Reference to the call frame itself (it's
				 * actually allocated on the Tcl stack). */
    ProcErrorProc *errProc;	/* The error handler for the body. */
    Tcl_Obj *nameObj;		/* The "name" of the command. */
    Command cmd;		/* The command structure. Mostly bogus. */

    Command *oldCmdPtr;		/* Saved cmdPtr so that we can be safe after a
				 * recursive call returns. */


} PMFrameData;

/*
 * Structure used to pass information about variable resolution to the
 * on-the-ground resolvers used when working with resolved compiled variables.
 */

			    void *clientData, void **newClientData);
static void		MethodErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static void		ConstructorErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static void		DestructorErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static inline void	InitFrameInfo(Tcl_Interp *interp,
			    ProcedureMethod *pmPtr, Tcl_ObjectContext context);
static Tcl_Obj *	RenderMethodName(void *clientData);
static Tcl_Obj *	RenderDeclarerName(void *clientData);
static int		InvokeForwardMethod(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static void		DeleteForwardMethod(void *clientData);
static int		CloneForwardMethod(Tcl_Interp *interp,
			    void *clientData, void **newClientData);

 *	How to invoke a procedure-like method.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeProcedureMethod(
    void *clientData,		/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
    int result;

    if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) ||
	Tcl_InterpDeleted(interp)
    ) {
	return TclNRObjectContextInvokeNext(interp, context, objc, objv,
		Tcl_ObjectContextSkippedArgs(context));
    }

    InitFrameInfo(interp, pmPtr, context);

    /*
     * Allocate the special frame data.
     */

    fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData));

     * Now invoke the body of the method.
     */

    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
    return TclNRInterpProcCore(interp, fdPtr->nameObj,
	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
}

/*
 * Finishes filling out the extra frame info so that [info frame] works.
 */
static inline void
InitFrameInfo(
    Tcl_Interp *interp,		/* For object name resolution later. */
    ProcedureMethod *pmPtr,	/* What we're writing to. */
    Tcl_ObjectContext context)	/* The calling context, used to figure out how
				 * we're using the method. */
{
    Tcl_Method method = Tcl_ObjectContextMethod(context);

    if (pmPtr->efi.length) {
	/*
	 * Do nothing if already set up.
	 */
	return;
    }

    pmPtr->efi.length = 2;
    pmPtr->efi.fields[0].name = "method";
    pmPtr->efi.fields[0].proc = RenderMethodName;
    pmPtr->efi.fields[0].clientData = pmPtr;
    pmPtr->callSiteFlags = ((CallContext *)
	    context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR);
    pmPtr->interp = interp;
    pmPtr->method = method;
    if (pmPtr->gfivProc != NULL) {
	pmPtr->efi.fields[1].name = "";
	pmPtr->efi.fields[1].proc = pmPtr->gfivProc;
	pmPtr->efi.fields[1].clientData = pmPtr;
    } else {
	if (Tcl_MethodDeclarerObject(method) != NULL) {
	    pmPtr->efi.fields[1].name = "object";
	} else {
	    pmPtr->efi.fields[1].name = "class";
	}
	pmPtr->efi.fields[1].proc = RenderDeclarerName;
	pmPtr->efi.fields[1].clientData = pmPtr;
    }
}

static int
FinalizePMCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{

    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv,	/* Array of arguments. */
    PMFrameData *fdPtr)		/* Place to store information about the call
				 * frame. */
{
    Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr;
    int result;

    CallFrame **framePtrPtr = &fdPtr->framePtr;

    /*
     * Compute basic information on the basis of the type of method it is.
     */

    if (contextPtr->callPtr->flags & CONSTRUCTOR) {

	fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName;
	fdPtr->errProc = ConstructorErrorHandler;
    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {

	fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName;
	fdPtr->errProc = DestructorErrorHandler;
    } else {
	fdPtr->nameObj = Tcl_MethodName(
		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr));

	fdPtr->errProc = MethodErrorHandler;
    }
    if (pmPtr->errProc != NULL) {
	fdPtr->errProc = pmPtr->errProc;
    }

    /*
     * Magic to enable things like [incr Tcl], which wants methods to run in
     * their class's namespace.
     */

    if (pmPtr->flags & USE_DECLARER_NS) {

	Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;

	if (mPtr->declaringClassPtr != NULL) {
	    nsPtr = (Namespace *)
		    mPtr->declaringClassPtr->thisPtr->namespacePtr;
	} else {
	    nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr;
	}

    fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr;

    /*
     * Compile the body. This operation may fail.
     */


    memset(&fdPtr->cmd, 0, sizeof(Command));
    fdPtr->cmd.nsPtr = nsPtr;
    fdPtr->cmd.clientData = &pmPtr->efi;
    pmPtr->procPtr->cmdPtr = &fdPtr->cmd;

    /*
     * [Bug 2037727] Always call TclProcCompileProc so that we check not only
     * that we have bytecode, but also that it remains valid. Note that we set
     * the namespace of the code here directly; this is a hack, but the
     * alternative is *so* slow...
     */

    if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
	ByteCode *codePtr =
		pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;

	codePtr->nsPtr = nsPtr;
    }
    result = TclProcCompileProc(interp, pmPtr->procPtr,
	    pmPtr->procPtr->bodyPtr, nsPtr, "body of method",
	    TclGetString(fdPtr->nameObj));
    if (result != TCL_OK) {
	goto failureReturn;
    }

    /*
     * Make the stack frame and fill it out with information about this call.
     * This operation may fail.
     */

    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);

    fdPtr->framePtr->clientData = contextPtr;
    fdPtr->framePtr->objc = objc;
    fdPtr->framePtr->objv = objv;
    fdPtr->framePtr->procPtr = pmPtr->procPtr;



























    return TCL_OK;

    /*
     * Restore the old cmdPtr so that a subsequent use of [info frame] won't
     * crash on us. [Bug 3001438]
     */

    *rPtrPtr = &infoPtr->info;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * RenderMethodName --
 *
 *	Returns the name of the declared method. Used for producing information
 *	for [info frame].
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj *
RenderMethodName(
    void *clientData)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;

    if (pmPtr->callSiteFlags & CONSTRUCTOR) {
	return TclOOGetFoundation(pmPtr->interp)->constructorName;
    } else if (pmPtr->callSiteFlags & DESTRUCTOR) {
	return TclOOGetFoundation(pmPtr->interp)->destructorName;
    } else {
	return Tcl_MethodName(pmPtr->method);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * RenderDeclarerName --
 *
 *	Returns the name of the entity (object or class) which declared a
 *	method. Used for producing information for [info frame] in such a way
 *	that the expensive part of this (generating the object or class name
 *	itself) isn't done until it is needed.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj *
RenderDeclarerName(
    void *clientData)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
    Tcl_Object object = Tcl_MethodDeclarerObject(pmPtr->method);

    if (object == NULL) {
	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pmPtr->method));
    }
    return TclOOObjectName(pmPtr->interp, (Object *) object);
}

/*
 * ----------------------------------------------------------------------
 *
 * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler --
 *