Diff
Not logged in

Differences From Artifact [e6ec73f4a4]:

To Artifact [4868b5b3f2]:


8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclProc.c,v 1.46.2.62 2010/02/09 17:53:09 dgp Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.46.2.63 2010/02/25 21:53:08 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"

/*
436
437
438
439
440
441
442
443

444
445
446
447
448
449
450
451
452
453
454

455
456
457
458
459
460
461
436
437
438
439
440
441
442

443
444
445
446
447
448
449
450
451
452
453

454
455
456
457
458
459
460
461







-
+










-
+







	 * means that the same code can not be shared by two procedures that
	 * have a different number of arguments, even if their bodies are
	 * identical. Note that we don't use Tcl_DuplicateObj since we would
	 * not want any bytecode internal representation.
	 */

	if (Tcl_IsShared(bodyPtr)) {
	    Tcl_Obj* sharedBodyPtr = bodyPtr;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.
	     * Ensure that the continuation line data for the original body is
	     * not lost and applies to the new body as well.
	     */

	    TclContinuationsCopy (bodyPtr, sharedBodyPtr);
	    TclContinuationsCopy(bodyPtr, sharedBodyPtr);
	}

	/*
	 * Create and initialize a Proc structure for the procedure. We
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
	 */
1574
1575
1576
1577
1578
1579
1580
1581

1582
1583
1584
1585
1586
1587
1588
1574
1575
1576
1577
1578
1579
1580

1581
1582
1583
1584
1585
1586
1587
1588







-
+







 *	to be popped by the caller.
 *
 *----------------------------------------------------------------------
 */

static int
PushProcCallFrame(
    ClientData clientData, 	/* Record describing procedure to be
    ClientData clientData,	/* Record describing procedure to be
				 * interpreted. */
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[],	/* Argument value objects. */
    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
1611
1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625
1611
1612
1613
1614
1615
1616
1617

1618
1619
1620
1621
1622
1623
1624
1625







-
+







	 * the code must be from the current epoch (so subcommand compilation
	 * is up-to-date), the namespace must match (so variable handling
	 * is right) and the resolverEpoch must match (so that new shadowed
	 * commands and/or resolver changes are considered).
	 */

	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
	    goto doCompilation;
	}
    } else {
    doCompilation:
1669
1670
1671
1672
1673
1674
1675
1676

1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697
1698
1699
1700
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696
1697
1698
1699
1700







-
+
















-
+







 *	Depends on the commands in the procedure.
 *
 *----------------------------------------------------------------------
 */

int
TclObjInterpProc(
    ClientData clientData, 	/* Record describing procedure to be
    ClientData clientData,	/* Record describing procedure to be
				 * interpreted. */
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    /*
     * Not used much in the core; external interface for iTcl
     */

    return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}

int
TclNRInterpProc(
    ClientData clientData, 	/* Record describing procedure to be
    ClientData clientData,	/* Record describing procedure to be
				 * interpreted. */
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
1937
1938
1939
1940
1941
1942
1943
1944
1945


1946
1947
1948
1949
1950
1951
1952
1937
1938
1939
1940
1941
1942
1943


1944
1945
1946
1947
1948
1949
1950
1951
1952







-
-
+
+







 */

int
TclProcCompileProc(
    Tcl_Interp *interp,		/* Interpreter containing procedure. */
    Proc *procPtr,		/* Data associated with procedure. */
    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
 				 * but could be any code fragment compiled in
 				 * the context of this procedure.) */
				 * but could be any code fragment compiled in
				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    const char *description,	/* string describing this body of code. */
    const char *procName)	/* Name of this procedure. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_CallFrame *framePtr;
    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
1962
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987

1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998





1999
2000
2001
2002
2003
2004
2005
2006

2007
2008

2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019









2020
2021

2022
2023
2024
2025
2026
2027
2028
1962
1963
1964
1965
1966
1967
1968

1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986

1987
1988
1989
1990
1991
1992
1993





1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005

2006
2007

2008
2009
2010









2011
2012
2013
2014
2015
2016
2017
2018
2019
2020

2021
2022
2023
2024
2025
2026
2027
2028







-
+

















-
+






-
-
-
-
-
+
+
+
+
+







-
+

-
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+







     * compiling.
     *
     * Precompiled procedure bodies, however, are immutable and therefore they
     * are not recompiled, even if things have changed.
     */

    if (bodyPtr->typePtr == &tclByteCodeType) {
 	if (((Interp *) *codePtr->interpHandle == iPtr)
	if (((Interp *) *codePtr->interpHandle == iPtr)
		&& (codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsPtr == nsPtr)
		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_AppendResult(interp,
			"a precompiled script jumped interps", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    bodyPtr->typePtr->freeIntRepProc(bodyPtr);
	    bodyPtr->typePtr = NULL;
 	}
	}
    }

    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_HashEntry *hePtr;

#ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 1) {
 	    /*
 	     * Display a line summarizing the top level command we are about
 	     * to compile.
 	     */
	if (tclTraceCompile >= 1) {
	    /*
	     * Display a line summarizing the top level command we are about
	     * to compile.
	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
 	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
 	}
	}
#endif

 	/*
 	 * Plug the current procPtr into the interpreter and coerce the code
 	 * body to byte codes. The interpreter needs to know which proc it's
 	 * compiling so that it can access its list of compiled locals.
 	 *
 	 * TRICKY NOTE: Be careful to push a call frame with the proper
 	 *   namespace context, so that the byte codes are compiled in the
 	 *   appropriate class context.
 	 */
	/*
	 * Plug the current procPtr into the interpreter and coerce the code
	 * body to byte codes. The interpreter needs to know which proc it's
	 * compiling so that it can access its list of compiled locals.
	 *
	 * TRICKY NOTE: Be careful to push a call frame with the proper
	 *   namespace context, so that the byte codes are compiled in the
	 *   appropriate class context.
	 */

 	iPtr->compiledProcPtr = procPtr;
	iPtr->compiledProcPtr = procPtr;

	if (procPtr->numCompiledLocals > procPtr->numArgs) {
	    CompiledLocal *clPtr = procPtr->firstLocalPtr;
	    CompiledLocal *lastPtr = NULL;
	    int i, numArgs = procPtr->numArgs;

	    for (i = 0; i < numArgs; i++) {
2040
2041
2042
2043
2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2040
2041
2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053
2054







-
+







		CompiledLocal *toFree = clPtr;
		clPtr = clPtr->nextPtr;
		ckfree((char *) toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

 	TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
	TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);

	/*
	 * TIP #280: We get the invoking context from the cmdFrame which
	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
	 */