Tcl Source Code

    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the
				 * procedure. */
    Tcl_Obj *bodyPtr;		/* Points to the ByteCode object for
				 * procedure's body command. */
    int numArgs;		/* Number of formal parameters. */



    int numCompiledLocals;	/* Count of local variables recognized by the
				 * compiler including arguments and
				 * temporaries. */
    CompiledLocal *firstLocalPtr;
				/* Pointer to first of the procedure's
				 * compiler-allocated local variables, or NULL
				 * if none. The first numArgs entries in this
................................................................................

#define CMD_IS_DELETED		    0x01
#define CMD_TRACE_ACTIVE	    0x02
#define CMD_HAS_EXEC_TRACES	    0x04
#define CMD_COMPILES_EXPANDED	    0x08
#define CMD_REDEF_IN_PROGRESS	    0x10
#define CMD_VIA_RESOLVER	    0x20


/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */

    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the
				 * procedure. */
    Tcl_Obj *bodyPtr;		/* Points to the ByteCode object for
				 * procedure's body command. */
    int numArgs;		/* Number of formal parameters. */

    int numArgsCompiledLocals;	/* TIP #460: Count of locals recognized by
				 * the compiler used in the arguments list. */
    int numCompiledLocals;	/* Count of local variables recognized by the
				 * compiler including arguments and
				 * temporaries. */
    CompiledLocal *firstLocalPtr;
				/* Pointer to first of the procedure's
				 * compiler-allocated local variables, or NULL
				 * if none. The first numArgs entries in this
................................................................................

#define CMD_IS_DELETED		    0x01
#define CMD_TRACE_ACTIVE	    0x02
#define CMD_HAS_EXEC_TRACES	    0x04
#define CMD_COMPILES_EXPANDED	    0x08
#define CMD_REDEF_IN_PROGRESS	    0x10
#define CMD_VIA_RESOLVER	    0x20


/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */

	Tcl_IncrRefCount(bodyPtr);

	procPtr = ckalloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */

	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;
    }

    /*
     * Break up the argument list into argument specifiers, then process each
................................................................................
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {
	procPtr->numArgs = numArgs;

	procPtr->numCompiledLocals = numArgs;
    }

    for (i = 0; i < numArgs; i++) {
	int fieldCount, nameLength, valueLength;
	const char **fieldValues;

	/*
	 * Now divide the specifier up into name and default.
	 */

	result = Tcl_SplitList(interp, argArray[i], &fieldCount,
		&fieldValues);
	if (result != TCL_OK) {
	    goto procError;
	}

	if (fieldCount > 2) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "too many fields in argument specifier \"%s\"",
		    argArray[i]));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	nameLength = strlen(fieldValues[0]);
	if (fieldCount == 2) {
	    valueLength = strlen(fieldValues[1]);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	p = fieldValues[0];
	while (*p != '\0') {
	    if (*p == '(') {
		const char *q = p;
		do {
		    q++;
		} while (*q != '\0');
		q--;
		if (*q == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
			    fieldValues[0]));
		    ckfree(fieldValues);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
		    goto procError;
		}
	    } else if ((*p == ':') && (*(p+1) == ':')) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"formal parameter \"%s\" is not a simple name",
			fieldValues[0]));
		ckfree(fieldValues);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"FORMALARGUMENTFORMAT", NULL);
		goto procError;
	    }
	    p++;
	}




























	if (precompiled) {
	    /*
	     * Compare the parsed argument with the stored one. Note that the
	     * only flag value that makes sense at this point is VAR_ARGUMENT
	     * (its value was kept the same as pre VarReform to simplify
	     * tbcload's processing of older byetcodes).
	     *
	     * The only other flag vlaue that is important to retrieve from
	     * precompiled procs is VAR_TEMPORARY (also unchanged). It is
	     * needed later when retrieving the variable names.
	     */

	    if ((localPtr->nameLength != nameLength)
		    || (strcmp(localPtr->name, fieldValues[0]))
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %d is "
			"inconsistent with precompiled body", procName, i));
................................................................................
			&tmpLength);

		if ((valueLength != tmpLength) ||
			strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"%s\" has "
			    "default value inconsistent with precompiled body",
			    procName, fieldValues[0]));
		    ckfree(fieldValues);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "BYTECODELIES", NULL);
		    goto procError;
		}
	    }
	    if ((i == numArgs - 1)
		    && (localPtr->nameLength == 4)


		    && (localPtr->name[0] == 'a')
		    && (strcmp(localPtr->name, "args") == 0)) {



		localPtr->flags |= VAR_IS_ARGS;
	    }

	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }

	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = nameLength;
	    localPtr->frameIndex = i;
	    localPtr->flags = VAR_ARGUMENT;
	    localPtr->resolveInfo = NULL;

	    if (fieldCount == 2) {
		localPtr->defValuePtr =
			Tcl_NewStringObj(fieldValues[1], valueLength);
		Tcl_IncrRefCount(localPtr->defValuePtr);
	    } else {
		localPtr->defValuePtr = NULL;
	    }
	    memcpy(localPtr->name, fieldValues[0], nameLength + 1);













	    if ((i == numArgs - 1)







		    && (localPtr->nameLength == 4)





		    && (localPtr->name[0] == 'a')
		    && (strcmp(localPtr->name, "args") == 0)) {

		localPtr->flags |= VAR_IS_ARGS;

	    }



	}



	ckfree(fieldValues);

    }

    *procPtrPtr = procPtr;
    ckfree(argArray);
    return TCL_OK;

  procError:
................................................................................
static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    int localCt = procPtr->numCompiledLocals;
    int numArgs = procPtr->numArgs, i = 0;

    Tcl_Obj **namePtr;
    Var *varPtr;
    LocalCache *localCachePtr;
    CompiledLocal *localPtr;
    int new;

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.


     */

    localCachePtr = ckalloc(sizeof(LocalCache)
	    + (localCt - 1) * sizeof(Tcl_Obj *)
	    + numArgs * sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
................................................................................
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ (unsigned int) -1,
		    &new, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {







	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;

	    varPtr++;
	    i++;
	}

	namePtr++;
	localPtr = localPtr->nextPtr;
    }
    codePtr->localCachePtr = localCachePtr;
    localCachePtr->refCount = 1;
    localCachePtr->numVars = localCt;
}
................................................................................
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates memory on the stack for the compiled local variables, the
 *	caller is responsible for freeing them. Initialises all variables. May
 *	invoke various name resolvers in order to determine which variables
 *	are being referenced at runtime.

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

static int
InitArgsAndLocals(
    register Tcl_Interp *interp,/* Interpreter in which procedure was
................................................................................
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    register Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
     */

................................................................................
    if (numArgs == 0) {
	if (argCt) {
	    goto incorrectArgs;
	} else {
	    goto correctArgs;
	}
    }

    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
    for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
	/*
	 * "Normal" arguments; last formal is special, depends on it being
	 * 'args'.
	 */

	Tcl_Obj *objPtr = argObjs[i];

	varPtr->flags = 0;
	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
    }

    for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
	/*
	 * This loop is entered if argCt < (numArgs-1). Set default values;
	 * last formal is special.
	 */

	Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
................................................................................

    /*
     * Initialise and resolve the remaining compiledLocals. In the absence of
     * resolvers, they are undefined local vars: (flags=0, value=NULL).
     */

  correctArgs:




































































    if (numArgs < localCt) {
	if (!framePtr->nsPtr->compiledVarResProc
		&& !((Interp *)interp)->resolverPtr) {
	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
	} else {
	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
	}
    }

    return TCL_OK;

    /*
     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
     */

  incorrectArgs:
    if ((skip != 1) &&
	    TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    memset(varPtr, 0,
	    ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
    return ProcWrongNumArgs(interp, skip);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPushProcCallFrame --
 *
................................................................................
	 * 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;






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

	    for (i = 0; i < numArgs; i++) {
		lastPtr = clPtr;
		clPtr = clPtr->nextPtr;
	    }

	    if (lastPtr) {
		lastPtr->nextPtr = NULL;
	    } else {
................................................................................
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			ckfree(toFree->resolveInfo);
		    }
		}
		ckfree(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

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

	/*
	 * TIP #280: We get the invoking context from the cmdFrame which

	Tcl_IncrRefCount(bodyPtr);

	procPtr = ckalloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */
	procPtr->numArgsCompiledLocals = 0;
	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;
    }

    /*
     * Break up the argument list into argument specifiers, then process each
................................................................................
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {
	procPtr->numArgs = numArgs;
	procPtr->numArgsCompiledLocals = numArgs;
	procPtr->numCompiledLocals = numArgs;
    }

    for (i = 0; i < numArgs; i++) {
	int fieldCount, nameLength, valueLength, varFlags = 0;
	const char **fieldValues, *varName;

	/*
	 * Now divide the specifier up into name and default.
	 */

	result = Tcl_SplitList(interp, argArray[i], &fieldCount,
		&fieldValues);
	if (result != TCL_OK) {
	    goto procError;
	}
        varName = fieldValues[0];
	if (fieldCount > 2) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "too many fields in argument specifier \"%s\"",
		    argArray[i]));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (*varName == '\0')) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	nameLength = strlen(varName);
	if (fieldCount == 2) {
	    valueLength = strlen(fieldValues[1]);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	p = varName;
	while (*p != '\0') {
	    if (*p == '(') {
		const char *q = p;
		do {
		    q++;
		} while (*q != '\0');
		q--;
		if (*q == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
			    varName));
		    ckfree(fieldValues);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
		    goto procError;
		}
	    } else if ((*p == ':') && (*(p+1) == ':')) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"formal parameter \"%s\" is not a simple name",
			varName));
		ckfree(fieldValues);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"FORMALARGUMENTFORMAT", NULL);
		goto procError;
	    }
	    p++;
	}

	if (*varName == '*' && !precompiled) {
            /*
             * TIP #460: Indicate we want to create a link to this argument's 
	     * value for when this proc is called. Also need to increase
	     * the locals count for args associated locals.
             */

	    if (fieldCount == 2) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "procedure \"%s\": formal parameter \"%s\" "
                        " is to be linked and must not have a default value",
                        procName, varName));
                ckfree(fieldValues);
                Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
                        "FORMALARGUMENTFORMAT", NULL);
                goto procError;
            } else {
                varFlags |= VAR_LINK;
	        procPtr->numArgsCompiledLocals++;
            }
        } else if ((i == numArgs - 1)
        	&& (nameLength == 4)
                && (*varName == 'a')
                && (strcmp(varName, "args") == 0)) {
            varFlags |= VAR_IS_ARGS;
        } 

	if (precompiled) {
	    /*
	     * Compare the parsed argument with the stored one. Note that the
	     * only flag value that makes sense at this point is VAR_ARGUMENT
	     * (its value was kept the same as pre VarReform to simplify
	     * tbcload's processing of older byetcodes).
	     *
	     * The only other flag value that is important to retrieve from
	     * precompiled procs is VAR_TEMPORARY (also unchanged). It is
	     * needed later when retrieving the variable names.
	     */

	    if ((localPtr->nameLength != nameLength)
		    || (strcmp(localPtr->name, varName))
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %d is "
			"inconsistent with precompiled body", procName, i));
................................................................................
			&tmpLength);

		if ((valueLength != tmpLength) ||
			strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"%s\" has "
			    "default value inconsistent with precompiled body",
			    procName, varName));
		    ckfree(fieldValues);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "BYTECODELIES", NULL);
		    goto procError;
		}
	    }



            /*
             * Set the VAR_IS_ARGS flag, if needed.

             */
             
            if (varFlags & VAR_IS_ARGS) {
                localPtr->flags |= VAR_IS_ARGS;
            }

	    localPtr = localPtr->nextPtr;
	} else {
            /*
             * Allocate an entry in the runtime procedure frame's array of
             * local variables for the argument.
             */

	    localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
	    if (procPtr->firstLocalPtr == NULL) {
                procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
            } else {
                procPtr->lastLocalPtr->nextPtr = localPtr;
                procPtr->lastLocalPtr = localPtr;
            }

            localPtr->nextPtr = NULL;
            localPtr->nameLength = nameLength;
            localPtr->frameIndex = i;
	    localPtr->flags = (varFlags | VAR_ARGUMENT);
            localPtr->resolveInfo = NULL;

            if (fieldCount == 2) {
                localPtr->defValuePtr =
                        Tcl_NewStringObj(fieldValues[1], valueLength);
                Tcl_IncrRefCount(localPtr->defValuePtr);
            } else {
                localPtr->defValuePtr = NULL;
            }
            memcpy(localPtr->name, varName, nameLength + 1);
        }

	ckfree(fieldValues);
    }
    /*
     * TIP #460: If there's any formals defined for linking then add a new
     * local variable for the link. For compatibility, link variables must 
     * come after the list of arguments.
     * The argument's index in the local table is stored in the link local's 
     * defValuePtr so it can be used for lookup later.
     */

    if (procPtr->numArgsCompiledLocals > procPtr->numCompiledLocals) {
	int frameIndex = numArgs;
        procPtr->numCompiledLocals = procPtr->numArgsCompiledLocals;   
	localPtr = procPtr->firstLocalPtr;

	for (i = 0; i < numArgs; i++, localPtr = localPtr->nextPtr) {
	    if (TclIsVarLink(localPtr)) {
		CompiledLocal *linkLocalPtr;
		const char *varName = localPtr->name;
		int nameLength = localPtr->nameLength - 1;
		localPtr->flags &= ~VAR_LINK;

		linkLocalPtr = ckalloc(TclOffset(CompiledLocal, name)
                        + nameLength + 1);
		linkLocalPtr->nextPtr = NULL;
		linkLocalPtr->nameLength = nameLength;

                linkLocalPtr->frameIndex = frameIndex++;
                linkLocalPtr->flags = VAR_LINK;
                linkLocalPtr->resolveInfo = NULL;

                linkLocalPtr->defValuePtr = Tcl_NewIntObj(i);
		Tcl_IncrRefCount(linkLocalPtr->defValuePtr);
		memcpy(linkLocalPtr->name, varName + 1, nameLength + 1);

		procPtr->lastLocalPtr->nextPtr = linkLocalPtr;
                procPtr->lastLocalPtr = linkLocalPtr;
	    }

	}
    }

    *procPtrPtr = procPtr;
    ckfree(argArray);
    return TCL_OK;

  procError:
................................................................................
static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    int localCt = procPtr->numCompiledLocals;
    int numArgVars = procPtr->numArgsCompiledLocals, i = 0;

    Tcl_Obj **namePtr;
    Var *varPtr;
    LocalCache *localCachePtr;
    CompiledLocal *localPtr;
    int new;

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls. TIP #460: We may need to also allocate space for 
     * variables to be resolved inline. numArgVars = numArgs when there
     * are none.
     */

    localCachePtr = ckalloc(sizeof(LocalCache)
	    + (localCt - 1) * sizeof(Tcl_Obj *)
	    + numArgVars * sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
................................................................................
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ (unsigned int) -1,
		    &new, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgVars) {
	    /*
             * varPtr->flags used to be set to either VAR_IS_ARGS or 0.
	     * Assumed it is to remove VAR_ARGUMENT, but varPtr flags are set
             * accordingly in InitArgsAndLocals. varPtr must have VAR_LINK 
             * if it exists in localPtr, checked by InitArgsAndLocals.
             */

	    varPtr->flags = (localPtr->flags & ~VAR_ARGUMENT);
	    varPtr->value.objPtr = localPtr->defValuePtr;

	    varPtr++;
	    i++;
	}

	namePtr++;
	localPtr = localPtr->nextPtr;
    }
    codePtr->localCachePtr = localCachePtr;
    localCachePtr->refCount = 1;
    localCachePtr->numVars = localCt;
}
................................................................................
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates memory on the stack for the compiled local variables, the
 *	caller is responsible for freeing them. Initialises all variables. May
 *	invoke various name resolvers in order to determine which variables
 *	are being referenced at runtime. Links variables for the caller when
 *      a formal parameter has the VAR_LINK flag.
 *
 *----------------------------------------------------------------------
 */

static int
InitArgsAndLocals(
    register Tcl_Interp *interp,/* Interpreter in which procedure was
................................................................................
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    register Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, imax, i = 0;
    Tcl_Obj *const *argObjs;

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
     */

................................................................................
    if (numArgs == 0) {
	if (argCt) {
	    goto incorrectArgs;
	} else {
	    goto correctArgs;
	}
    }

    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
    for (; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
        /*
         * "Normal" arguments; last formal is special, depends on it being
	 * 'args'.
	 */

	Tcl_Obj *objPtr = argObjs[i];

	varPtr->flags = 0;
	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference */
    }

    for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
	/*
	 * This loop is entered if argCt < (numArgs-1). Set default values;
	 * last formal is special.
	 */

	Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
................................................................................

    /*
     * Initialise and resolve the remaining compiledLocals. In the absence of
     * resolvers, they are undefined local vars: (flags=0, value=NULL).
     */

  correctArgs:
  {
    /*
     * TIP #460: Check for and construct links for any formals defined to be
     * linked to their corresponding argument. The link locals will be 
     * immediately after the args list. The local's index they link to is 
     * stored in the link's default value.
     */

    int numArgVars = procPtr->numArgsCompiledLocals;
    if (numArgVars > numArgs) {
        CallFrame *upFramePtr;
        Var *otherPtr, *arrayPtr;

	/*
         * If we got here, assume we'll be resolving links.
         */

	if (TclObjGetFrame(interp, NULL, &upFramePtr) == -1) {
            i = -1;    /* Tell incorrectArgs we set the error */
            goto incorrectArgs;
        }

	defPtr++;	/* Here, defPtr cannot be NULL */
	for(i = numArgs; i < numArgVars; i++, varPtr++, defPtr++) {
            if (TclIsVarLink(defPtr)) {
		int argIndex;

		if (TCL_OK != (TclGetIntFromObj(interp, defPtr->value.objPtr, 
			&argIndex)) 
			|| (argIndex < 0 || argIndex > argCt - 1)) {
                    /*
                     * Something went horribly wrong if this comes to a Panic.
		     * Should not happen unless there's an internal bug.
                     */

		    Tcl_Panic("Link variable points to an invalid local index.");
		} else {
		    /*
		     * Defaults are illegal for linked arguments, so argIndex
		     * should be safe.
		     */

		    Tcl_Obj *objPtr = argObjs[argIndex];	

                    /*
                     * Locate the other variable.
                     */

                    ((Interp *)interp)->varFramePtr = upFramePtr;
                    otherPtr = TclObjLookupVarEx(interp, objPtr, NULL,
                            TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
                            /*createPart2*/ 1, &arrayPtr);
                    ((Interp *)interp)->varFramePtr = framePtr;
                    if (otherPtr == NULL) {
                        i = -1;    /* Tell incorrectArgs we set the error */
                        goto incorrectArgs;
                    }

                    varPtr->flags = VAR_LINK;
                    varPtr->value.linkPtr = otherPtr;
                    if (TclIsVarInHash(otherPtr)) {
                        VarHashRefCount(otherPtr)++;
                    }
		}
            }
        }
    }

    if (numArgVars < localCt) {
	if (!framePtr->nsPtr->compiledVarResProc
		&& !((Interp *)interp)->resolverPtr) {
	    memset(varPtr, 0, (localCt - numArgVars)*sizeof(Var));
	} else {
	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
	}
    }
  }
    return TCL_OK;

    /*
     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
     */

  incorrectArgs:
    if ((skip != 1) &&
	    TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    memset(varPtr, 0,
	    ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
    return (i != -1 ? ProcWrongNumArgs(interp, skip) : TCL_ERROR);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPushProcCallFrame --
 *
................................................................................
	 * 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;

	/*
	 * TIP #460: We may need to hang on to more locals than just the
         * Proc's formals (i.e. locals to be linked to an arg's value).
	 */

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

	    for (i = 0; i < numArgVars; i++) {
		lastPtr = clPtr;
		clPtr = clPtr->nextPtr;
	    }

	    if (lastPtr) {
		lastPtr->nextPtr = NULL;
	    } else {
................................................................................
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			ckfree(toFree->resolveInfo);
		    }
		}
		ckfree(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgsCompiledLocals;
	}

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

	/*
	 * TIP #280: We get the invoking context from the cmdFrame which

} {}
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}






















 
cleanupTests
return

# Local Variables:
# mode: tcl
# End:

} {}
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}

test oo-36.1 {OO: Auto linking} -setup {
    oo::class create C
} -body {
    oo::define C {
        constructor {*a} {
            incr a
            lappend ::result $a
        }
        method m {*a} {
            incr a
            lappend ::result $a
        }
    }
    set a 0
    set c [C new a]
    $c m a
    return $result
} -cleanup {
    C destroy
} -result {1 2}

 
cleanupTests
return

# Local Variables:
# mode: tcl
# End:

    set lambda x
    lappend lambda {set a 1}
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}
 




































































































































































# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

    set lambda x
    lappend lambda {set a 1}
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}

test proc-8.1 {Auto argument linking} -body {
    proc P {*a} {
        set a 1
        return
    }
    apply {{} {
        set a {}
        P a
        set a
    }}
} -cleanup {
    rename P {}
} -result 1

test proc-8.2 {Auto argument linking, multiple} -body {
    proc P {*a *b} {
        set a 1
        set b 2
        return
    }
    apply {{} {
        set a {}
        set b {}
        P a b
        set b
    }}
} -cleanup {
    rename P {}
} -result 2

test proc-8.3 {Auto argument linking, multiple of same} -body {
    proc P {*a *a} {
        set a 1
        return
    }
    apply {{} {
        set a {}
        P a a
        set a
    }}
} -cleanup {
    rename P {}
} -result 1

test proc-8.4 {Auto argument linking, and defaults} -body {
    proc P {*a {foo bar} args} {
        return $foo
    }
    apply {{} {
        set a {}
        P a
    }}
} -cleanup {
    rename P {}
} -result {bar}

test proc-8.5 {Auto argument linking, and args} -body {
    proc P {*a args} {
        return [lindex $args 0]
    }
    apply {{} {
        set a {}
        P a foo
    }}
} -cleanup {
    rename P {}
} -result {foo}

test proc-8.6 {Auto argument linking, chain linking} -body {
    proc P {*a} {
        P2 a
    }
    proc P2 {*a} {
        incr a
    }
    apply {{} {
        P a
        set a
    }}
} -cleanup {
    rename P {}
    rename P2 {}
} -result {1}

test proc-8.7 {Auto argument linking, create var in caller} -body {
    proc P {*a} {
        incr a
    }
    apply {{} {
        P a
        set a
    }}
} -cleanup {
    rename P {}
} -result {1}

test proc-8.8 {Auto argument linking, default for auto-link formal} -body {
    proc P {{*a b}} {
        incr a
    }
    apply {{} {
        set a 0
        P a
    }}
} -constraints procbodytest -returnCodes error -cleanup {
    catch {rename P {}}
} -result {procedure "P": formal parameter "*a"  is to be linked and must not have a default value}

test proc-8.9 {Auto argument linking, bad variable} -body {
    proc P {*a} {
        incr a
    }
    P mumbo::jumbo
} -constraints procbodytest -returnCodes error -cleanup {
    catch {rename P {}}
} -result {can't access "mumbo::jumbo": parent namespace doesn't exist}

test proc-8.10 {Auto argument linking, empty link name} -body {
    proc P {*} {
        incr {}
    }
    apply {{} {
        P a
        set a
    }}
} -cleanup {
    rename P {}
} -result {1}

test proc-8.11 {Auto argument linking, link name consistency} -body {
    proc P {**a} {
        incr *a
    }
    apply {{} {
        P a
        set a
    }}
} -cleanup {
    rename P {}
} -result {1}

test proc-8.12 {Auto argument linking, info args} -body {
    proc P {*a b *c} {}
    info args P
} -cleanup {
    rename P {}
} -result {*a b *c}

test proc-8.13 {Auto argument linking, info locals} -body {
    proc P {*a b *c} {info locals}
    P a b c
} -cleanup {
    rename P {}
} -result {*a b *c}

test proc-8.14 {Auto argument linking, linked arg retains value} -body {
    proc P {*a} {set *a}
    P a
} -cleanup {
    rename P {}
} -result {a}


 
# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End: