Tcl Source Code

static Tcl_Obj *
GetCommandSource(
    Interp *iPtr,
    int objc,
    Tcl_Obj *const objv[])
{

    CmdFrame *cfPtr = iPtr->cmdFramePtr;

    if (cfPtr && (cfPtr->numLevels != iPtr->numLevels-1)) {
	cfPtr = NULL;

    }
















    return TclGetSourceFromFrame(cfPtr, objc, objv);


}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupCommand --
 *

    int cmdEpoch = cmdPtr->cmdEpoch;
    int newEpoch;
    const char *command;
    int length;
    Tcl_Obj *commandPtr;

    commandPtr = GetCommandSource(iPtr, objc, objv);
    Tcl_IncrRefCount(commandPtr);
    command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the traces
     * so that the structure doesn't go away underneath our feet.

    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
    eeFramePtr->numLevels = iPtr->numLevels;
    eeFramePtr->framePtr = iPtr->framePtr;
    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
    eeFramePtr->nline = 0;
    eeFramePtr->line = NULL;
    eeFramePtr->cmdObj = NULL;

    iPtr->cmdFramePtr = eeFramePtr;
    if (iPtr->evalFlags & TCL_EVAL_FILE) {
	/*
	 * Set up for a sourced file.
	 */

	    TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
	    code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR);
	    TclArgumentRelease(interp, objv, objectsUsed);

	    eeFramePtr->line = NULL;
	    eeFramePtr->nline = 0;
	    if (eeFramePtr->cmdObj) {
		Tcl_DecrRefCount(eeFramePtr->cmdObj);
		eeFramePtr->cmdObj = NULL;
	    }

	    if (code != TCL_OK) {
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }

	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclListObjCopy(interp, objPtr);
	Tcl_IncrRefCount(listPtr);


	if (word != INT_MIN) {
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     *
	     * TIP #280. We do _not_ compute all the line numbers for the

	    eoFramePtr->type = TCL_LOCATION_EVAL;
	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
		    1 : iPtr->cmdFramePtr->level + 1);
	    eoFramePtr->numLevels = iPtr->numLevels;
	    eoFramePtr->framePtr = iPtr->framePtr;
	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;

	    eoFramePtr->cmdObj = objPtr;
	    eoFramePtr->cmd = NULL;
	    eoFramePtr->len = 0;
	    eoFramePtr->data.eval.path = NULL;

	    iPtr->cmdFramePtr = eoFramePtr;
	}

	TclMarkTailcall(interp);
        TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
		objPtr, NULL);

	ListObjGetElements(listPtr, objc, objv);
	return TclNREvalObjv(interp, objc, objv, flags, NULL);
    }

    if (!(flags & TCL_EVAL_DIRECT)) {
	/*

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

    /*
     * Remove the cmdFrame
     */

    if (eoFramePtr) {
	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
	TclStackFree(interp, eoFramePtr);
    }
    TclDecrRefCount(objPtr);
    TclDecrRefCount(listPtr);

    return result;
}

/*
 *----------------------------------------------------------------------

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclGetSourceFromFrame(
    CmdFrame *cfPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    if (cfPtr == NULL) {
	return Tcl_NewListObj(objc, objv);
    }
    if (cfPtr->cmdObj == NULL) {
	if (cfPtr->cmd == NULL) {
	    cfPtr->cmd = TclGetSrcInfoForCmdFrame(cfPtr, &cfPtr->len);
	}
	cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
	Tcl_IncrRefCount(cfPtr->cmdObj);
    }
    return cfPtr->cmdObj;
}

Tcl_Obj *
TclInfoFrame(
    Tcl_Interp *interp,		/* Current interpreter. */
    CmdFrame *framePtr)		/* Frame to get info for. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *tmpObj;

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

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

	    /*
	     * Death of reference by TclGetSrcInfoForPc.
	     */

	    Tcl_DecrRefCount(fPtr->data.eval.path);
	}

	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
	TclStackFree(interp, fPtr);
	break;
    }

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

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	ADD_PAIR("line", Tcl_NewIntObj(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.
	 */

	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
	break;

    case TCL_LOCATION_PROC:
	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
	break;
    }

    bcFramePtr->framePtr = iPtr->framePtr;
    bcFramePtr->nextPtr = iPtr->cmdFramePtr;
    bcFramePtr->nline = 0;
    bcFramePtr->line = NULL;
    bcFramePtr->litarg = NULL;
    bcFramePtr->data.tebc.codePtr = codePtr;
    bcFramePtr->data.tebc.pc = NULL;
    bcFramePtr->cmdObj = NULL;
    bcFramePtr->cmd = NULL;
    bcFramePtr->len = 0;

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numExecutions++;
#endif

#endif

    if (data[1] /* resume from invocation */) {
	if (iPtr->execEnvPtr->rewind) {
	    result = TCL_ERROR;
	}
	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
	if (bcFramePtr->cmdObj) {
	    Tcl_DecrRefCount(bcFramePtr->cmdObj);
	    bcFramePtr->cmdObj = NULL;
	    bcFramePtr->cmd = NULL;
	}
	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
	if (iPtr->flags & INTERP_DEBUG_FRAME) {
	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
	}
	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;

 */

const char *
TclGetSrcInfoForCmd(
    Interp *iPtr,
    int *lenPtr)
{
    return TclGetSrcInfoForCmdFrame(iPtr->cmdFramePtr, lenPtr);
}

const char *
TclGetSrcInfoForCmdFrame(
    CmdFrame *cfPtr,
    int *lenPtr)
{
    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;

    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
	    codePtr, lenPtr, NULL, NULL);
}

void
TclGetSrcInfoForPc(
    CmdFrame *cfPtr)
{
    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;

    assert(cfPtr->type == TCL_LOCATION_BC);

    if (cfPtr->cmd == NULL) {

	cfPtr->cmd = GetSrcInfoForPc(
		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
		&cfPtr->len, NULL, NULL);
    }

    assert(cfPtr->cmd != NULL);
    {
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

				 * in. */
	} eval;
	struct {
	    const void *codePtr;/* Byte code currently executed... */
	    const char *pc;	/* ... and instruction pointer. */
	} tebc;
    } data;
    Tcl_Obj *cmdObj;
    const char *cmd;		/* The executed command, if possible... */
    int len;			/* ... and its length. */
    int numLevels;		/* Value of interp's numLevels when the frame
				 * was pushed. */
    const struct CFWordBC *litarg;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by

MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
			    int *typePtr);
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    const char *modeString, int *seekFlagPtr,
			    int *binaryPtr);
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
MODULE_SCOPE const char *TclGetSrcInfoForCmdFrame(CmdFrame *cfPtr,
			    int *lenPtr);
MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
			    Tcl_Obj *unquotedPrefix, int globFlags,
			    Tcl_GlobTypeData *types);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);