/*

 * tclNamesp.c --

 *

 *      Contains support for namespaces, which provide a separate context of

 *      commands and global variables. The global :: namespace is the

 *      traditional Tcl "global" scope. Other namespaces are created as

 *      children of the global namespace. These other namespaces contain

 *      special-purpose commands and variables for packages.

 *

 * Copyright (c) 1993-1997 Lucent Technologies.

 * Copyright (c) 1997 Sun Microsystems, Inc.

 * Copyright (c) 1998-1999 by Scriptics Corporation.

 *

 * Originally implemented by

 *   Michael J. McLennan

 *   Bell Labs Innovations for Lucent Technologies

 *   mmclennan@lucent.com

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.14 2007/05/15 18:32:18 dgp Exp $

 */

#include "tclInt.h"

/*

 * Flag passed to TclGetNamespaceForQualName to indicate that it should

 * search for a namespace rather than a command or variable inside a

 * namespace. Note that this flag's value must not conflict with the values

 * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN.

 */

#define FIND_ONLY_NS	0x1000

/*

 * Initial size of stack allocated space for tail list - used when resetting

 * shadowed command references in the functin: TclResetShadowedCmdRefs.

 */

#define NUM_TRAIL_ELEMS 5

/*

 * Count of the number of namespaces created. This value is used as a

 * unique id for each namespace.

 */

static long numNsCreated = 0; 

TCL_DECLARE_MUTEX(nsMutex)

/*

 * This structure contains a cached pointer to a namespace that is the

 * result of resolving the namespace's name in some other namespace. It is

 * the internal representation for a nsName object. It contains the

 * pointer along with some information that is used to check the cached

 * pointer's validity.

 */

typedef struct ResolvedNsName {

    Namespace *nsPtr;		/* A cached namespace pointer. */

    long nsId;			/* nsPtr's unique namespace id. Used to

				 * verify that nsPtr is still valid

				 * (e.g., it's possible that the namespace

				 * was deleted and a new one created at

				 * the same address). */

    Namespace *refNsPtr;	/* Points to the namespace containing the

				 * reference (not the namespace that

				 * contains the referenced namespace). */

    int refCount;		/* Reference count: 1 for each nsName

				 * object that has a pointer to this

				 * ResolvedNsName structure as its internal

				 * rep. This structure can be freed when

				 * refCount becomes zero. */

} ResolvedNsName;

/*

 * Declarations for procedures local to this file:

 */

static void		DeleteImportedCmd _ANSI_ARGS_((

			    ClientData clientData));

static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,

			    Tcl_Obj *copyPtr));

static void		FreeNsNameInternalRep _ANSI_ARGS_((

			    Tcl_Obj *objPtr));

static int		GetNamespaceFromObj _ANSI_ARGS_((

			    Tcl_Interp *interp, Tcl_Obj *objPtr,

			    Tcl_Namespace **nsPtrPtr));

static int		InvokeImportedCmd _ANSI_ARGS_((

			    ClientData clientData, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceChildrenCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceCodeCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceCurrentCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceDeleteCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceEvalCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceExistsCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceExportCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceForgetCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static void		NamespaceFree _ANSI_ARGS_((Namespace *nsPtr));

static int		NamespaceImportCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceInscopeCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceOriginCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceParentCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceQualifiersCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceTailCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		NamespaceWhichCmd _ANSI_ARGS_((

			    ClientData dummy, Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[]));

static int		SetNsNameFromAny _ANSI_ARGS_((

			    Tcl_Interp *interp, Tcl_Obj *objPtr));

static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));

/*

 * This structure defines a Tcl object type that contains a

 * namespace reference.  It is used in commands that take the

 * name of a namespace as an argument.  The namespace reference

 * is resolved, and the result in cached in the object.

 */

Tcl_ObjType tclNsNameType = {

    "nsName",			/* the type's name */

    FreeNsNameInternalRep,	/* freeIntRepProc */

    DupNsNameInternalRep,	/* dupIntRepProc */

    UpdateStringOfNsName,	/* updateStringProc */

    SetNsNameFromAny		/* setFromAnyProc */

};

/*

 *----------------------------------------------------------------------

 *

 * TclInitNamespaceSubsystem --

 *

 *	This procedure is called to initialize all the structures that 

 *	are used by namespaces on a per-process basis.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

void

TclInitNamespaceSubsystem()

{

    /*

     * Does nothing for now.

     */

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_GetCurrentNamespace --

 *

 *	Returns a pointer to an interpreter's currently active namespace.

 *

 * Results:

 *	Returns a pointer to the interpreter's current namespace.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

Tcl_Namespace *

Tcl_GetCurrentNamespace(interp)

    register Tcl_Interp *interp; /* Interpreter whose current namespace is

				  * being queried. */

{

    register Interp *iPtr = (Interp *) interp;

    register Namespace *nsPtr;

    if (iPtr->varFramePtr != NULL) {

        nsPtr = iPtr->varFramePtr->nsPtr;

    } else {

        nsPtr = iPtr->globalNsPtr;

    }

    return (Tcl_Namespace *) nsPtr;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_GetGlobalNamespace --

 *

 *	Returns a pointer to an interpreter's global :: namespace.

 *

 * Results:

 *	Returns a pointer to the specified interpreter's global namespace.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

Tcl_Namespace *

Tcl_GetGlobalNamespace(interp)

    register Tcl_Interp *interp; /* Interpreter whose global namespace 

				  * should be returned. */

{

    register Interp *iPtr = (Interp *) interp;

    return (Tcl_Namespace *) iPtr->globalNsPtr;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_PushCallFrame --

 *

 *	Pushes a new call frame onto the interpreter's Tcl call stack.

 *	Called when executing a Tcl procedure or a "namespace eval" or

 *	"namespace inscope" command. 

 *

 * Results:

 *	Returns TCL_OK if successful, or TCL_ERROR (along with an error

 *	message in the interpreter's result object) if something goes wrong.

 *

 * Side effects:

 *	Modifies the interpreter's Tcl call stack.

 *

 *----------------------------------------------------------------------

 */

int

Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)

    Tcl_Interp *interp;		 /* Interpreter in which the new call frame

				  * is to be pushed. */

    Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to

				  * push. Storage for this has already been

				  * allocated by the caller; typically this

				  * is the address of a CallFrame structure

				  * allocated on the caller's C stack.  The

				  * call frame will be initialized by this

				  * procedure. The caller can pop the frame

				  * later with Tcl_PopCallFrame, and it is

				  * responsible for freeing the frame's

				  * storage. */

    Tcl_Namespace *namespacePtr; /* Points to the namespace in which the

				  * frame will execute. If NULL, the

				  * interpreter's current namespace will

				  * be used. */

    int isProcCallFrame;	 /* If nonzero, the frame represents a

				  * called Tcl procedure and may have local

				  * vars. Vars will ordinarily be looked up

				  * in the frame. If new variables are

				  * created, they will be created in the

				  * frame. If 0, the frame is for a

				  * "namespace eval" or "namespace inscope"

				  * command and var references are treated

				  * as references to namespace variables. */

{

    Interp *iPtr = (Interp *) interp;

    register CallFrame *framePtr = (CallFrame *) callFramePtr;

    register Namespace *nsPtr;

    if (namespacePtr == NULL) {

	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);

    } else {

        nsPtr = (Namespace *) namespacePtr;

        if (nsPtr->flags & NS_DEAD) {

	    panic("Trying to push call frame for dead namespace");

	    /*NOTREACHED*/

        }

    }

    nsPtr->activationCount++;

    framePtr->nsPtr = nsPtr;

    framePtr->isProcCallFrame = isProcCallFrame;

    framePtr->objc = 0;

    framePtr->objv = NULL;

    framePtr->callerPtr = iPtr->framePtr;

    framePtr->callerVarPtr = iPtr->varFramePtr;

    if (iPtr->varFramePtr != NULL) {

        framePtr->level = (iPtr->varFramePtr->level + 1);

    } else {

        framePtr->level = 1;

    }

    framePtr->procPtr = NULL; 	   /* no called procedure */

    framePtr->varTablePtr = NULL;  /* and no local variables */

    framePtr->numCompiledLocals = 0;

    framePtr->compiledLocals = NULL;

    /*

     * Push the new call frame onto the interpreter's stack of procedure

     * call frames making it the current frame.

     */

    iPtr->framePtr = framePtr;

    iPtr->varFramePtr = framePtr;

    return TCL_OK;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_PopCallFrame --

 *

 *	Removes a call frame from the Tcl call stack for the interpreter.

 *	Called to remove a frame previously pushed by Tcl_PushCallFrame.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	Modifies the call stack of the interpreter. Resets various fields of

 *	the popped call frame. If a namespace has been deleted and

 *	has no more activations on the call stack, the namespace is

 *	destroyed.

 *

 *----------------------------------------------------------------------

 */

void

Tcl_PopCallFrame(interp)

    Tcl_Interp* interp;		/* Interpreter with call frame to pop. */

{

    register Interp *iPtr = (Interp *) interp;

    register CallFrame *framePtr = iPtr->framePtr;

    Namespace *nsPtr;

    /*

     * It's important to remove the call frame from the interpreter's stack

     * of call frames before deleting local variables, so that traces

     * invoked by the variable deletion don't see the partially-deleted

     * frame.

     */

    iPtr->framePtr = framePtr->callerPtr;

    iPtr->varFramePtr = framePtr->callerVarPtr;

    if (framePtr->varTablePtr != NULL) {

        TclDeleteVars(iPtr, framePtr->varTablePtr);

        ckfree((char *) framePtr->varTablePtr);

        framePtr->varTablePtr = NULL;

    }

    if (framePtr->numCompiledLocals > 0) {

        TclDeleteCompiledLocalVars(iPtr, framePtr);

    }

    /*

     * Decrement the namespace's count of active call frames. If the

     * namespace is "dying" and there are no more active call frames,

     * call Tcl_DeleteNamespace to destroy it.

     */

    nsPtr = framePtr->nsPtr;

    nsPtr->activationCount--;

    if ((nsPtr->flags & NS_DYING)

	    && (nsPtr->activationCount == 0)) {

        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);

    }

    framePtr->nsPtr = NULL;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_CreateNamespace --

 *

 *	Creates a new namespace with the given name. If there is no

 *	active namespace (i.e., the interpreter is being initialized),

 *	the global :: namespace is created and returned.

 *

 * Results:

 *	Returns a pointer to the new namespace if successful. If the

 *	namespace already exists or if another error occurs, this routine

 *	returns NULL, along with an error message in the interpreter's

 *	result object.

 *

 * Side effects:

 *	If the name contains "::" qualifiers and a parent namespace does

 *	not already exist, it is automatically created. 

 *

 *----------------------------------------------------------------------

 */

Tcl_Namespace *

Tcl_CreateNamespace(interp, name, clientData, deleteProc)

    Tcl_Interp *interp;             /* Interpreter in which a new namespace

				     * is being created. Also used for

				     * error reporting. */

    CONST char *name;               /* Name for the new namespace. May be a

				     * qualified name with names of ancestor

				     * namespaces separated by "::"s. */

    ClientData clientData;	    /* One-word value to store with

				     * namespace. */

    Tcl_NamespaceDeleteProc *deleteProc;

    				    /* Procedure called to delete client

				     * data when the namespace is deleted.

				     * NULL if no procedure should be

				     * called. */

{

    Interp *iPtr = (Interp *) interp;

    register Namespace *nsPtr, *ancestorPtr;

    Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;

    Namespace *globalNsPtr = iPtr->globalNsPtr;

    CONST char *simpleName;

    Tcl_HashEntry *entryPtr;

    Tcl_DString buffer1, buffer2;

    int newEntry;

    /*

     * If there is no active namespace, the interpreter is being

     * initialized. 

     */

    if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {

	/*

	 * Treat this namespace as the global namespace, and avoid

	 * looking for a parent.

	 */

        parentPtr = NULL;

        simpleName = "";

    } else if (*name == '\0') {

	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);

	return NULL;

    } else {

	/*

	 * Find the parent for the new namespace.

	 */

	TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,

		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),

		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);

	/*

	 * If the unqualified name at the end is empty, there were trailing

	 * "::"s after the namespace's name which we ignore. The new

	 * namespace was already (recursively) created and is pointed to

	 * by parentPtr.

	 */

	if (*simpleName == '\0') {

	    return (Tcl_Namespace *) parentPtr;

	}

        /*

         * Check for a bad namespace name and make sure that the name

	 * does not already exist in the parent namespace.

	 */

        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {

	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

		    "can't create namespace \"", name,

    	    	    "\": already exists", (char *) NULL);

            return NULL;

        }

    }

    /*

     * Create the new namespace and root it in its parent. Increment the

     * count of namespaces created.

     */

    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));

    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));

    strcpy(nsPtr->name, simpleName);

    nsPtr->fullName        = NULL;   /* set below */

    nsPtr->clientData      = clientData;

    nsPtr->deleteProc      = deleteProc;

    nsPtr->parentPtr       = parentPtr;

    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);

    Tcl_MutexLock(&nsMutex);

    numNsCreated++;

    nsPtr->nsId            = numNsCreated;

    Tcl_MutexUnlock(&nsMutex);

    nsPtr->interp          = interp;

    nsPtr->flags           = 0;

    nsPtr->activationCount = 0;

    nsPtr->refCount        = 0;

    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);

    nsPtr->exportArrayPtr  = NULL;

    nsPtr->numExportPatterns = 0;

    nsPtr->maxExportPatterns = 0;

    nsPtr->cmdRefEpoch       = 0;

    nsPtr->resolverEpoch     = 0;

    nsPtr->cmdResProc        = NULL;

    nsPtr->varResProc        = NULL;

    nsPtr->compiledVarResProc = NULL;

    if (parentPtr != NULL) {

        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,

	        &newEntry);

        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);

    }

    /*

     * Build the fully qualified name for this namespace.

     */