/*
 * tclProc.c --
 *
 *	This file contains routines that implement Tcl procedures, including
 *	the "proc" and "uplevel" commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 *
 * 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.98 2006/10/24 00:29:31 msofer Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.99 2006/10/24 22:31:09 msofer Exp $
 */

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

/*
 * Prototypes for static functions in this file

	desiredObjs = (Tcl_Obj **)
		ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));

#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = objv[0];
#else
	desiredObjs[0] = Tcl_NewListObj(1, objv);
	desiredObjs[0] = (isLambda? objv[0]: Tcl_NewListObj(1, objv));
#endif /* AVOID_HACKS_FOR_ITCL */

	localPtr = procPtr->firstLocalPtr;
	for (i=1 ; i<=numArgs ; i++) {
	    TclNewObj(argObj);
	    if (localPtr->defValuePtr != NULL) {
		Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL);
	    } else if ((i==numArgs) && !strcmp(localPtr->name, "args")) {
		Tcl_AppendStringsToObj(argObj, "...", NULL);
	    } else {
		Tcl_AppendStringsToObj(argObj, localPtr->name, NULL);
	    }
	    desiredObjs[i] = argObj;
	    localPtr = localPtr->nextPtr;
	}

	Tcl_ResetResult(interp);
	Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL);
	result = TCL_ERROR;

#ifdef AVOID_HACKS_FOR_ITCL
#ifndef AVOID_HACKS_FOR_ITCL
	if (!isLambda) {
	    TclDecrRefCount(desiredObjs[0]);
	}
#endif /* AVOID_HACKS_FOR_ITCL */

	for (i=1 ; i<=numArgs ; i++) {
	    TclDecrRefCount(desiredObjs[i]);
	}
#else
	for (i=0 ; i<=numArgs ; i++) {
	    TclDecrRefCount(desiredObjs[i]);
	}
#endif /* AVOID_HACKS_FOR_ITCL */
	ckfree((char *) desiredObjs);
	goto procDone;
    }

    varPtr->name = localPtr->name;
    varPtr->nsPtr = NULL;
    varPtr->hPtr = NULL;