Artifact [9d2f560834]
Not logged in

Artifact 9d2f560834702f4d4881c982ccc2bc2ed036b177:


/*
 * javaObj.c --
 *
 *	This file implements the routines that maintain the correspondence
 *	between TclObject instances and Tcl_Obj * references.
 *
 * Copyright (c) 1997 by 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: javaObj.c,v 1.17 2002/12/31 20:16:27 mdejong Exp $
 */

#include "java.h"
#include "javaNative.h"

static void		DupJavaCmdInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *dupPtr);
static void		DupTclObject(Tcl_Obj *srcPtr, Tcl_Obj *destPtr);
static void		FreeJavaCmdInternalRep(Tcl_Obj *objPtr);
static void		FreeTclObject(Tcl_Obj *objPtr);
static int		SetJavaCmdFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetTclObject(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateTclObject(Tcl_Obj *objPtr);

static void
ThrowNullPointerException(
    JNIEnv *env,		/* Java environment pointer. */
    char *msg)			/* Message to include in exception. */
{
    jclass nullClass = (*env)->FindClass(env,
	    "java/lang/NullPointerException");
    if (!msg) {
	msg = "Invalid CObject.";
    }
    (*env)->ThrowNew(env, nullClass, msg);
    (*env)->DeleteLocalRef(env, nullClass);
}

/*
 * TclObject type information.
 */

Tcl_ObjType tclObjectType = {
     "TclObject",
     FreeTclObject,
     DupTclObject,
     UpdateTclObject,
     SetTclObject
};

/*
 * Pointer to old cmdType information.
 */

static Tcl_ObjType oldCmdType;
static Tcl_ObjType *cmdTypePtr = NULL;
static Tcl_ObjType *listTypePtr = NULL;

/*
 * Mutex to serialize access to cmdTypePtr.
 */

static Tcl_Mutex cmdTypePtrLock;


/*
 *----------------------------------------------------------------------
 *
 * JavaObjInit --
 *
 *	Initialize the JavaObj module.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Registers the TclObject type and hijacks the cmdName type.
 *
 *----------------------------------------------------------------------
 */

void
JavaObjInit()
{
    /*
     * The JavaObjInit method could get called
     * from multiple threads. We only want to
     * init the object type once.
     */

    Tcl_MutexLock(&cmdTypePtrLock);

    if (cmdTypePtr == NULL) {
        Tcl_RegisterObjType(&tclObjectType);

        /*
         * Interpose on the "cmdName" type to preserve
         * java objects.
         */

        cmdTypePtr = (Tcl_ObjType *) Tcl_GetObjType("cmdName");
        oldCmdType = *cmdTypePtr;
        cmdTypePtr->freeIntRepProc = FreeJavaCmdInternalRep;
        cmdTypePtr->dupIntRepProc = DupJavaCmdInternalRep;
        cmdTypePtr->setFromAnyProc = SetJavaCmdFromAny;

        /*
         * Grab a pointer to the Tcl list type.
         */

        listTypePtr = (Tcl_ObjType *) Tcl_GetObjType("list");
    }

    Tcl_MutexUnlock(&cmdTypePtrLock);
}

/*
 *----------------------------------------------------------------------
 *
 * printString --
 *
 *	Dump the string representation of an object to stdout. This
 *	function is purely for debugging purposes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
printString(
    JNIEnv *env,		/* Java environment. */
    jobject object)
{
    JavaInfo* jcache = JavaGetCache();
    jstring string = (*env)->CallObjectMethod(env, object, jcache->toString);
    const char *str = (*env)->GetStringUTFChars(env, string, NULL);
    printf("toString: %x '%s'\n", (unsigned int) object, str);
    (*env)->ReleaseStringUTFChars(env, string, str);
    (*env)->DeleteLocalRef(env, string);
}

/*
 *----------------------------------------------------------------------
 *
 * DupTclObject --
 *
 *	Copy the internal rep for a TclObject.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Increments the reference count on the TclObject.  Creates a
 *	new global reference to the object.
 *
 *----------------------------------------------------------------------
 */

static void
DupTclObject(
    Tcl_Obj *srcPtr,
    Tcl_Obj *destPtr)
{
    jobject object = (jobject)(srcPtr->internalRep.twoPtrValue.ptr2);
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();
    jobject exception;

    /*
     * Clear pending Java exception.
     */

    exception = (*env)->ExceptionOccurred(env);
    if (exception)
        (*env)->ExceptionClear(env);

    /*
     * Add a global reference to represent the new copy.
     */

    object = (*env)->NewGlobalRef(env, object);
    destPtr->typePtr = srcPtr->typePtr;
    destPtr->internalRep.twoPtrValue.ptr2 = (VOID*) object;
    (*env)->CallVoidMethod(env, object, jcache->preserve);
    if ((*env)->ExceptionOccurred(env)) {
        (*env)->ExceptionDescribe(env);
	Tcl_Panic("DupTclObject : exception in TclObject._preserve()");
    }

    /*
     * Rethrow pending Java exception.
     */

    if (exception) {
        (*env)->Throw(env, exception);
        (*env)->DeleteLocalRef(env, exception);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FreeTclObject --
 *
 *	Free the internal representation for a TclObject.
 *	This method is invoked by Tcl when a Tcl_Obj that
 *	wraps a TclObject has its ref count decremented to zero.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Decrements the reference count of the TclObject and frees the
 *	global object reference.
 *
 *----------------------------------------------------------------------
 */

static void
FreeTclObject(
    Tcl_Obj *objPtr)		/* Object to free. */
{
    jobject object = (jobject)(objPtr->internalRep.twoPtrValue.ptr2);
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();
    jobject exception;

    /*
     * Clear pending Java exception.
     */

    exception = (*env)->ExceptionOccurred(env);
    if (exception)
        (*env)->ExceptionClear(env);

    /*
     * Delete the global ref.
     */

    (*env)->CallVoidMethod(env, object, jcache->release);
    if ((*env)->ExceptionOccurred(env)) {
        (*env)->ExceptionDescribe(env);
	Tcl_Panic("FreeTclObject : exception in TclObject._release()");
    }
    (*env)->DeleteGlobalRef(env, object);
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;

    /*
     * Rethrow pending Java exception.
     */

    if (exception) {
        (*env)->Throw(env, exception);
        (*env)->DeleteLocalRef(env, exception);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetTclObject --
 *
 *	No conversion to a TclObject is possible.
 *
 * Results:
 *	Always returns TCL_ERROR.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SetTclObject(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    if (interp) {
	Tcl_ResetResult(interp);
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
		"cannot convert to TclObject", -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateTclObject --
 *
 *	Retrieve the string representation from the TclObject.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the string representation of the Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateTclObject(Tcl_Obj *objPtr)
{
    jstring string;
    jobject object = (jobject)(objPtr->internalRep.twoPtrValue.ptr2);
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();
    jobject exception;

    /*
     * Clear pending Java exception.
     */

    exception = (*env)->ExceptionOccurred(env);
    if (exception)
        (*env)->ExceptionClear(env);

    /*
     * Update Tcl_Obj.bytes to result of TclObject.toString() call.
     */

    string = (*env)->CallObjectMethod(env, object, jcache->toString);
    if ((*env)->ExceptionOccurred(env)) {
        (*env)->ExceptionDescribe(env);
	Tcl_Panic("UpdateTclObject : exception in TclObject.toString()");
    }
    objPtr->bytes = JavaGetString(env, string, &objPtr->length);
    (*env)->DeleteLocalRef(env, string);

    /*
     * Rethrow pending Java exception.
     */

    if (exception) {
        (*env)->Throw(env, exception);
        (*env)->DeleteLocalRef(env, exception);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * JavaGetTclObj --
 *
 *	Retrieve the Tcl_Obj that corresponds to the given Java
 *	TclObject. Creates a new Tcl_Obj of type TclObject with an internal
 *	representation that points at the Java object.
 *
 * Results:
 *	Returns the Tcl_Obj that corresponds to the TclObject.
 *
 * Side effects:
 *	Adds a reference to the TclObject.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj*
JavaGetTclObj(
    JNIEnv *env,		/* Java environment. */
    jobject object)		/* TclObject. */
{
    Tcl_Obj *objPtr;
    jlong objRef;
    JavaInfo* jcache = JavaGetCache();

    if ((*env)->ExceptionOccurred(env)) {
	(*env)->ExceptionDescribe(env);
	Tcl_Panic("JavaGetTclObj : unexpected pending exception");
    }

    objRef = (*env)->CallLongMethod(env, object, jcache->getCObjectPtr);
    if ((*env)->ExceptionOccurred(env)) {
	(*env)->ExceptionDescribe(env);
	Tcl_Panic("JavaGetTclObj : exception in TclObject.getCObjectPtr()");
    }

    if (objRef != 0) {
	/*
	 * This is either a TclList or a CObject, convert to Tcl_Obj*.
	 */

	objPtr = *(Tcl_Obj**)&objRef;

#ifdef TCL_MEM_DEBUG
	if (objPtr->refCount == 0x61616161) {
	    Tcl_Panic("JavaGetTclObj : disposed object");
	}
#endif
    } else {
	/*
	 * This object is of an unknown type so we create a new Tcl object to
	 * hold the object reference.
	 */

	object = (*env)->NewGlobalRef(env, object);
	objPtr = Tcl_NewObj();
	objPtr->bytes = NULL;
	objPtr->typePtr = &tclObjectType;
	objPtr->internalRep.twoPtrValue.ptr2 = (VOID*) object;

	/*
	 * Increment the reference count on the TclObject.
	 */

	(*env)->CallVoidMethod(env, object, jcache->preserve);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaGetTclObj : exception in TclObject._preserve()");
	}
    }
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_CObject_getString --
 *
 *	Retrieve the string representation for an object.
 *
 * Class:     tcl_lang_CObject
 * Method:    getString
 * Signature: (J)Ljava/lang/String;
 *
 * Results:
 *	Returns a new Java string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jstring JNICALL
Java_tcl_lang_CObject_getString(
    JNIEnv *env,		/* Java environment. */
    jclass class,		/* Handle to CObject class. */
    jlong obj)			/* Value of CObject.objPtr. */
{
    Tcl_Obj *objPtr = *(Tcl_Obj **) &obj;
    char *str;
    jstring result;
    int length;

    if (!objPtr) {
	ThrowNullPointerException(env, NULL);
	return NULL;
    }

#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	Tcl_Panic("Java_tcl_lang_CObject_getString : disposed object");
    }
#endif

    /*
     * Convert the string rep into a Unicode string.
     */

    str = Tcl_GetStringFromObj(objPtr, &length);
    if (length > 0) {
	result = (*env)->NewStringUTF(env, str);
    } else {
	result = (*env)->NewString(env, NULL, 0);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_CObject_incrRefCount --
 *
 *	Increment the reference count of the given object.
 *
 * Class:     tcl_lang_CObject
 * Method:    incrRefCount
 * Signature: (J)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_CObject_incrRefCount(
    JNIEnv *env,		/* Java environment. */
    jclass class,		/* Handle to CObject class. */
    jlong obj)			/* Value of CObject.objPtr. */
{
    Tcl_Obj *objPtr = *(Tcl_Obj **) &obj;

    if (!objPtr) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    Tcl_IncrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_CObject_decrRefCount --
 *
 *	Decrement the reference count for the given object.
 *
 * Class:     tcl_lang_CObject
 * Method:    decrRefCount
 * Signature: (J)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL Java_tcl_lang_CObject_decrRefCount(
    JNIEnv *env,		/* Java environment. */
    jclass class,		/* Handle to CObject class. */
    jlong obj)			/* Value of CObject.objPtr. */
{
    Tcl_Obj *objPtr = *(Tcl_Obj **) &obj;

    if (!objPtr) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_CObject_makeRef --
 *
 *	Convert the Tcl_Obj into a TclObject.
 *
 * Class:     tcl_lang_CObject
 * Method:    makeRef
 * Signature: (JLtcl/lang/TclObject;)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Modifies the internal representation of the object.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_CObject_makeRef(
    JNIEnv *env,		/* Java environment. */
    jclass class,		/* Handle to CObject class. */
    jlong obj,			/* Value of CObject.objPtr. */
    jobject object)		/* Handle to the TclObject. */
{
    Tcl_Obj *objPtr = *(Tcl_Obj **) &obj;
    Tcl_ObjType *oldTypePtr;
    int non_tclobject_cmd = 0;

    if (!objPtr) {
	ThrowNullPointerException(env, NULL);
	return;
    }

#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	Tcl_Panic("Java_tcl_lang_CObject_makeRef : disposed object");
    }
#endif

    /*
     * Free the old internalRep before setting the new one.
     * Watch for the special case of a command internal rep
     * that does not have a ref to a TclObject. We avoid
     * freeing the internal rep and add a ref in that case.
     */

    if ((objPtr->typePtr == cmdTypePtr) &&
	    (objPtr->internalRep.twoPtrValue.ptr2 == NULL)) {
	non_tclobject_cmd = 1;
    }

    oldTypePtr = (Tcl_ObjType *) objPtr->typePtr;
    if ((oldTypePtr != NULL) &&
	    (oldTypePtr->freeIntRepProc != NULL) &&
	    !non_tclobject_cmd) {
	oldTypePtr->freeIntRepProc(objPtr);
    }

    object = (*env)->NewGlobalRef(env, object);
    if (!non_tclobject_cmd)
	objPtr->typePtr = &tclObjectType;
    objPtr->internalRep.twoPtrValue.ptr2 = (VOID*) object;

    /*
     * Note that we don't change the TclObject ref count or
     * the Tcl_Obj ref count here. We expect that FreeTclObject
     * will be invoked when the ref count of this Tcl_Obj
     * reaches zero, and a CObject begins life with a
     * ref count of 1, so we are covered.
     */
}

/*
 *----------------------------------------------------------------------
 *
 * JavaBreakRef --
 *
 *	Check to see if a Tcl_Obj contains an invalid
 *	ref to a TclObject that has a CObject or TclList
 *	internal rep. This method breaks such a ref by
 *	setting the internal rep for the Tcl_Obj to
 *	a string or list rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Modifies the internal representation of the Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

void
JavaBreakRef(
    JNIEnv *env,		/* Java environment. */
    Tcl_Obj *objPtr)		/* Object to check. */
{
    jobject object;
    int isTclList, isCObject, dummy;
    int inst;
    JavaInfo* jcache = JavaGetCache();

#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	Tcl_Panic("JavaBreakRef : disposed object");
    }
#endif

    if ((objPtr->typePtr == &tclObjectType)
            || ((objPtr->typePtr == cmdTypePtr) &&
                    (objPtr->internalRep.twoPtrValue.ptr2) != NULL)) {
	object = (jobject)(objPtr->internalRep.twoPtrValue.ptr2);
	inst = (*env)->CallIntMethod(env, object, jcache->getCObjectInst);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaBreakRef : exception in TclObject.getCObjectInst()");
	}
	/* Constants returned by getCObjectInst() to indicate type. */
	isCObject = (inst == 1);
	isTclList = (inst == 2);

	if (isTclList) {
	    /*fprintf(stderr, "breaking ref for TclList \"%s\"\n", Tcl_GetString(objPtr));*/
	    Tcl_ListObjLength((Tcl_Interp *) NULL, objPtr, &dummy);
	} else if (isCObject) {
	    /*fprintf(stderr, "breaking ref for String \"%s\"\n", Tcl_GetString(objPtr));*/
	    Tcl_GetCharLength(objPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_CObject_newCObject --
 *
 *	Allocate a new Tcl_Obj with the given string rep.
 *
 * Class:     tcl_lang_CObject
 * Method:    newCObject
 * Signature: (Ljava/lang/String;)J
 *
 * Results:
 *	Returns the address of the new Tcl_Obj with refcount of 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jlong JNICALL
Java_tcl_lang_CObject_newCObject(
    JNIEnv *env,		/* Java environment. */
    jclass class,		/* Handle to CObject class. */
    jstring string)		/* Initial string rep. */
{
    Tcl_Obj *objPtr;
    jlong obj;

    objPtr = Tcl_NewObj();
    if (string) {
	objPtr->bytes = JavaGetString(env, string, &objPtr->length);
    }
    obj = 0;
    *(Tcl_Obj **)&obj = objPtr;
    return obj;
}

/*
 *----------------------------------------------------------------------
 *
 * JavaGetTclObject --
 *
 *	Retrieve the Java TclObject that shadows the given Tcl_Obj.
 *	Creates a new TclObject of type CObject or TclObject that refers
 *	to the given Tcl_Obj, unless the Tcl_Obj is a TclObject already.
 *
 * Results:
 *	Returns a TclObject associated with the Tcl_Obj.
 *
 * Side effects:
 *	May allocate a new local reference in the JVM. Note that
 *	if this routine is not called as a result of a native method
 *	invocation, the caller is responsible for deleting the local
 *	reference explicitly. Will increment the TclObject.refCount
 *	for a newely created CObject wrapper.
 *
 *----------------------------------------------------------------------
 */

jobject
JavaGetTclObject(
    JNIEnv *env,
    Tcl_Obj *objPtr,		/* Object to get jobject for. */
    int *isLocalPtr)		/* 1 if returned handle is a local ref. */
{
    jobject object;
    jlong lvalue;
    JavaInfo* jcache = JavaGetCache();

    if (!objPtr) {
	return NULL;
    }

    /*
     * Make sure the Tcl_Obj does not have
     * an invalid ref to a TclObject that has a
     * CObject or TclList internal rep.
     */

    JavaBreakRef(env, objPtr);

    if ((objPtr->typePtr == &tclObjectType)
	    || ((objPtr->typePtr == cmdTypePtr) &&
		    (objPtr->internalRep.twoPtrValue.ptr2) != NULL)) {
	/*
	 * This object is a reference to a TclObject, so we extract the
	 * jobject.
	 */

	object = (jobject)(objPtr->internalRep.twoPtrValue.ptr2);
	if (isLocalPtr) {
	    *isLocalPtr = 0;
	}
    } else {
	/*
	 *
	 * We should be able to use the following statement below:
	 *
	 *     lvalue = (jlong) objPtr;
	 *
	 * But gcc warns "cast to pointer from integer of different size"
	 * so use an ugly workaround to avoid the compiler warning.
	 * Note that the value is zeroed out before assigning to
	 * handle the case where jlong is 64 while a ptr is 32 bits.
	 */

	lvalue = 0;
	*(Tcl_Obj **)&lvalue = objPtr;

	/*
	 * This object is of an unknown type, so create a new TclObject.
	 * If the Tcl object is a list, then create a TclList.
	 *
	 *    TclObject tobj = TclList.newInstance(long objPtr);
	 *
	 * Otherwise we don't know the type so create a CObject.
	 *
	 *    TclObject tobj = CObject.newInstance(long objPtr);
	 *
	 */

	if (objPtr->typePtr == listTypePtr) {
	    object = (*env)->CallStaticObjectMethod(env, jcache->TclList,
	        jcache->newTclListInstance, lvalue);
	} else {
	    object = (*env)->CallStaticObjectMethod(env, jcache->CObject,
	        jcache->newCObjectInstance, lvalue);
	}

	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaGetTclObject : exception in newInstance()");
	}

	/*
	 * Increment the ref count of the new TclObject so that
	 * it starts life with a ref count of 1. This operation
	 * does not change the ref count of the Tcl_Obj.
	 * We expect to be able to drop a ref to a CObject
	 * with a ref count of 1 without leaking memory in C.
	 */

	(*env)->CallVoidMethod(env, object, jcache->preserve);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaGetTclObject : exception in TclObject._preserve()");
	}

	if (isLocalPtr) {
	    *isLocalPtr = 1;
	}
    }
    return object;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeJavaCmdInternalRep --
 *
 *	Free the internal rep for a java object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Decrements the refcount on a java object, and frees it if
 *	the last reference is gone.
 *
 *----------------------------------------------------------------------
 */

static void
FreeJavaCmdInternalRep(
    Tcl_Obj *objPtr)
{
    jobject jobj = (jobject) objPtr->internalRep.twoPtrValue.ptr2;

    if (jobj) {
	FreeTclObject(objPtr);
    }
    (oldCmdType.freeIntRepProc)(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DupJavaCmdInternalRep --
 *
 *	Initialize the internal representation of a java Tcl_Obj to a
 *	copy of the internal representation of an existing java object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	"dupPtr"s internal rep is set to the java object corresponding to
 *	"srcPtr"s internal rep and the refcount on the java object
 *	in incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupJavaCmdInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    jobject jobj = (jobject) srcPtr->internalRep.twoPtrValue.ptr2;
    (oldCmdType.dupIntRepProc)(srcPtr, dupPtr);
    dupPtr->internalRep.twoPtrValue.ptr2 = jobj;
    if (jobj) {
	DupTclObject(srcPtr, dupPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetJavaCmdFromAny --
 *
 *	Attempt to generate a command object from an arbitrary type.
 *	This routine is a wrapper around the standard cmdName setFromAny
 *	procedure.  If the object holds a reference to a TclObject,
 *	save and restore the reference after the object is converted.
 *
 * Results:
 *	The return value is a standard object Tcl result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SetJavaCmdFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    int result;

    /*
     * Invoke the normal command type routine, but make sure
     * it doesn't free the java object by setting the typePtr
     * to NULL. Note that we have to restore the ptr2 value after
     * the conversion, since it gets set to NULL by setFromAnyProc.
     */

    if ((objPtr->typePtr == &tclObjectType) ||
	    ((objPtr->typePtr == cmdTypePtr) &&
		    (objPtr->internalRep.twoPtrValue.ptr2 != NULL))) {
	VOID *ptr2;
	if (objPtr->bytes == NULL) {
	    UpdateTclObject(objPtr);
	}
	objPtr->typePtr = NULL;
	ptr2 = objPtr->internalRep.twoPtrValue.ptr2;
	result = (oldCmdType.setFromAnyProc)(interp, objPtr);
	objPtr->internalRep.twoPtrValue.ptr2 = ptr2;
    } else {
	result = (oldCmdType.setFromAnyProc)(interp, objPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * JavaIsRef --
 *
 *	Return true if this Tcl_Obj* contains a ref to a TclObject.
 *
 * Results:
 *	1 or 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
JavaIsRef(
    Tcl_Obj *objPtr)		/* Object to check .*/
{
    return ((objPtr->typePtr == &tclObjectType) ||
            ((objPtr->typePtr == cmdTypePtr) &&
                    (objPtr->internalRep.twoPtrValue.ptr2) != NULL));
}

/*
 *----------------------------------------------------------------------
 *
 * JavaObjType --
 *
 *	Return a string that describes the internal rep type for objPtr.
 *
 * Results:
 *	A Tcl_Obj*.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj*
JavaObjType(
    Tcl_Obj *objPtr)		/* Object to check .*/
{
    char *type;
    Tcl_ObjType *stringTypePtr = (Tcl_ObjType *) Tcl_GetObjType("string");

    if (objPtr->typePtr == &tclObjectType)
        type = "tclobject";
    else if ((objPtr->typePtr == cmdTypePtr) &&
            ((objPtr->internalRep.twoPtrValue.ptr2) != NULL))
        type = "cmdtclobject";
    else if (objPtr->typePtr == cmdTypePtr)
        type = "cmd";
    else if (objPtr->typePtr == listTypePtr)
        type = "list";
    else if (objPtr->typePtr == stringTypePtr)
        type = "string";
    else
        type = "unknown";

    return Tcl_NewStringObj(type, -1);
}