/* 
 * 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.
 *
 * 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.4 2004/03/26 22:28:27 dgp Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.46.2.5 2004/05/04 17:44:18 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file

 *
 * TclCreateProc --
 *
 *	Creates the data associated with a Tcl procedure definition.
 *	This procedure knows how to handle two types of body objects:
 *	strings and procbody. Strings are the traditional (and common) value
 *	for bodies, procbody are values created by extensions that have
 *	loaded a previously compiled script.
 *	loaded a previously compiled script. 
 *
 * Results:
 *	Returns TCL_OK on success, along with a pointer to a Tcl
 *	procedure definition in procPtrPtr.  This definition should
 *	be freed by calling TclCleanupProc() when it is no longer
 *	needed.  Returns TCL_ERROR if anything goes wrong.
 *	procedure definition in procPtrPtr where the cmdPtr field is not
 *      initialised. This definition should be freed by calling
 *      TclCleanupProc() when it is no longer needed.  Returns TCL_ERROR if
 *      anything goes wrong. 
 *
 * Side effects:
 *	If anything goes wrong, this procedure returns an error
 *	message in the interpreter.
 *
 *----------------------------------------------------------------------
 */

        /*
         * Because the body is a TclProProcBody, the actual body is already
         * compiled, and it is not shared with anyone else, so it's OK not to
         * unshare it (as a matter of fact, it is bad to unshare it, because
         * there may be no source code).
         *
         * We don't create and initialize a Proc structure for the procedure;
         * rather, we use what is in the body object. Note that
         * rather, we use what is in the body object. We increment the ref
         * we initialize its cmdPtr field below after we've created the command
         * for the procedure. We increment the ref count of the Proc struct
         * since the command (soon to be created) will be holding a reference
         * count of the Proc struct since the command (soon to be created)
         * will be holding a reference to it.
         * to it.
         */
    
        procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
        procPtr->iPtr = iPtr;
        procPtr->refCount++;
        precompiled = 1;
    } else {

        if (Tcl_IsShared(bodyPtr)) {
            bytes = Tcl_GetStringFromObj(bodyPtr, &length);
            bodyPtr = Tcl_NewStringObj(bytes, length);
        }

        /*
         * Create and initialize a Proc structure for the procedure. Note that
         * Create and initialize a Proc structure for the procedure. We
         * we initialize its cmdPtr field below after we've created the command
         * 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
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
         * structure.
         */
    
        Tcl_IncrRefCount(bodyPtr);

        procPtr = (Proc *) ckalloc(sizeof(Proc));
        procPtr->iPtr = iPtr;
        procPtr->refCount = 1;

                localPtr->defValuePtr = NULL;
            }
            strcpy(localPtr->name, fieldValues[0]);
	}

        ckfree((char *) fieldValues);
    }

    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
     * later when the procedure is called to determine what namespace the
     * procedure will run in. This will be different than the current
     * namespace if the proc was renamed into a different namespace.
     */
    
    *procPtrPtr = procPtr;
    ckfree((char *) argArray);
    return TCL_OK;

procError:
    if (precompiled) {

    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame frame;
    register CallFrame *framePtr = &frame;
    register Var *varPtr;
    register CompiledLocal *localPtr;
    char *procName;
    int nameLen, localCt, numArgs, argCt, i, result;
    Tcl_Obj *objResult = Tcl_GetObjResult(interp);

    /*
     * This procedure generates an array "compiledLocals" that holds the
     * storage for local variables. It starts out with stack-allocated space
     * but uses dynamically-allocated storage if needed.
     */

	} else {
	    goto incorrectArgs;
	}
	varPtr++;
	localPtr = localPtr->nextPtr;
    }
    if (argCt > 0) {
	Tcl_Obj *objResult;
	int len, flags;

	incorrectArgs:
	/*
	 * Build up equivalent to Tcl_WrongNumArgs message for proc
	 */

	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(objResult,
		"wrong # args: should be \"", procName, (char *) NULL);
	objResult = Tcl_GetObjResult(interp);
	Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);

	/*
	 * Quote the proc name if it contains spaces (Bug 942757).
	 */
	
	len = Tcl_ScanCountedElement(procName, nameLen, &flags);
	if (len != nameLen) {
	    char *procName1 = ckalloc((unsigned) len);
	    len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags);
	    Tcl_AppendToObj(objResult, procName1, len);
	    ckfree(procName1);
	} else {
	    Tcl_AppendToObj(objResult, procName, len);
	}

	localPtr = procPtr->firstLocalPtr;
	for (i = 1;  i <= numArgs;  i++) {
	    if (localPtr->defValuePtr != NULL) {
		Tcl_AppendStringsToObj(objResult,
			" ?", localPtr->name, "?", (char *) NULL);
	    } else {
		Tcl_AppendStringsToObj(objResult,