Artifact Content
Not logged in

Artifact e521e13e4baa1a9cfde65fb4521289d4b347b7d2:


/*
 * javaInterp.c --
 *
 *	This file contains the native method implementations for the
 *	tcl.lang.Interp class.
 *
 * 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: javaInterp.c,v 1.25 2006/07/28 20:53:06 mdejong Exp $
 */

#include <string.h>
#include "java.h"
#include "javaNative.h"

/*
 * Structure used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is
				 * to be invoked. */
    char *errMsg;		/* Error message returned from Tcl command,
				 * or NULL.  Malloc'ed. */
    jobject trace;		/* VarTrace object. */
} JavaTraceInfo;

/*
 * Declaractions for functions used only in this file.
 */

static void		JavaCmdDeleteProc(ClientData clientData);
static int		JavaCmdProc(ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]);
static int		BTestCmd(ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]);
static char *		JavaTraceProc(ClientData clientData,
			    Tcl_Interp *interp,
#ifdef CONST84
			    CONST
#endif
			    char *name1,
#ifdef CONST84
			    CONST
#endif
			    char *name2,
			    int flags);
static void		ThrowNullPointerException(JNIEnv *env, char *msg);


/*
 *----------------------------------------------------------------------
 *
 * ThrowNullPointerException --
 *
 *	Generate a NullPointerException to indicate that a method was
 *	invoked on a dead Interp.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Throws a new exception in the Java VM.  Creates a local
 *	reference so this function can only be called from a native
 *	method implementation.
 *
 *----------------------------------------------------------------------
 */

static void
ThrowNullPointerException(
    JNIEnv *env,		/* Java environment pointer. */
    char *msg)			/* Message to include in exception. */
{
#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: ThrowNullPointerException()\n");
#endif /* TCLBLEND_DEBUG */

    jclass nullClass = (*env)->FindClass(env,
	    "java/lang/NullPointerException");
    if (!msg) {
	msg = "Invalid interpreter.";
    }
    (*env)->ThrowNew(env, nullClass, msg);
    (*env)->DeleteLocalRef(env, nullClass);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_create --
 *
 *	Create a new Tcl interpreter.  This is the primary entry point
 *	if the Blend extension is loaded by Java.
 *
 * Class:     tcl_lang_Interp
 * Method:    create
 * Signature: ()J
 *
 * Results:
 *	Returns the interp pointer, or NULL if initialization failed.
 *
 * Side effects:
 *	May cause the global java structure to be initialized.
 *
 *----------------------------------------------------------------------
 */

jlong JNICALL
Java_tcl_lang_Interp_create(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj)		/* Handle to Interp object. */
{
    jlong lvalue;
    Tcl_Interp *interp;

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Calling Tcl_CreateInterp()\n");
#endif /* TCLBLEND_DEBUG */

    interp = Tcl_CreateInterp();
    if (JavaSetupJava(env, interp) != TCL_OK) {
	jclass err = (*env)->FindClass(env, "tcl/lang/TclRuntimeError");
	if (err) {
	    (*env)->ThrowNew(env, err, Tcl_GetStringResult(interp));
	    (*env)->DeleteLocalRef(env, err);
	}
	Tcl_DeleteInterp(interp);
	lvalue = 0;
    } else {
	lvalue = 0;
	*(Tcl_Interp**)&lvalue = interp;
    }
    return lvalue;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_init --
 *
 *	Initialize the given interpreter by calling Tcl_Init and
 *	Tclblend_Init.
 *
 * Class:     tcl_lang_Interp
 * Method:    init
 * Signature: (J)I
 *
 * Results:
 *	Returns TCL_OK on success, else TCL_ERROR.
 *
 * Side effects:
 *	Creates new commands, loads init.tcl.
 *
 *----------------------------------------------------------------------
 */

jint JNICALL
Java_tcl_lang_Interp_init(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to interp object. */
    jlong interpPtr)		/* Tcl_Interp pointer. */
{
    Tcl_Interp *interp = *(Tcl_Interp **)&interpPtr;
    jint result;

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Entered Interp.init(%X)\n", interp);
#endif /* TCLBLEND_DEBUG */

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

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Calling Tcl_Init()\n");
#endif /* TCLBLEND_DEBUG */

    if (Tcl_Init(interp) != TCL_OK) {
#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Tcl_Init() returned !OK in Interp.init()\n");
#endif /* TCLBLEND_DEBUG */

	result = TCL_ERROR;
    } else {
	/*
	 * Set up the Blend package.
	 */

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Tcl_Init() returned OK in Interp.init()\n");
#endif /* TCLBLEND_DEBUG */

	interpObj = (*env)->NewGlobalRef(env, interpObj);
	result = JavaInitBlend(env, interp, interpObj);
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_doDispose --
 *
 *	Delete the interpeter associated with this Interp class.
 *
 * Class:     tcl_lang_Interp
 * Method:    doDispose
 * Signature: (J)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_doDispose(
    JNIEnv *env,		/* Java environment. */
    jclass interpClass,		/* Handle to Interp class. */
    jlong interpPtr)		/* Value of Interp.interpPtr. */
{
    Tcl_Interp *interp = *(Tcl_Interp **)&interpPtr;
    jobject interpObj;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    /*
     * Release the Interp instance handle and then clear the assoc data
     * to avoid a recursive call when the interpreter is deleted.
     */

    interpObj = (jobject) Tcl_GetAssocData(interp, "java", NULL);
    (*env)->DeleteGlobalRef(env, interpObj);
    Tcl_SetAssocData(interp, "java", NULL, NULL);
    Tcl_DeleteInterp(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_evalString --
 *
 *	Evaluate the given String object.
 *
 * Class:     tcl_lang_Interp
 * Method:    evalString
 * Signature: (Ljava/lang/String;I)I
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the eval does.
 *
 *----------------------------------------------------------------------
 */

jint JNICALL
Java_tcl_lang_Interp_evalString(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jstring string,		/* String to eval. */
    jint flags)			/* Evaluation flags. */
{
    Tcl_Interp *interp;
    Tcl_Obj *objPtr;
    int result;

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Interp.evalString()\n");
#endif /* TCLBLEND_DEBUG */

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

    interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return 0;
    } else if (!string) {
	ThrowNullPointerException(env, "No string to evaluate.");
	return 0;
    }

    objPtr = Tcl_NewObj();
    objPtr->bytes = JavaGetString(env, string, &objPtr->length);
    Tcl_IncrRefCount(objPtr);

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: cmd is : ->%s<-\n", objPtr->bytes);
#endif /* TCLBLEND_DEBUG */

    if (!flags) {
	result = Tcl_EvalObj(interp, objPtr);
    } else {
	result = Tcl_GlobalEvalObj(interp, objPtr);
    }

    /*
     * A Java exception can't be pending after Tcl code is eval'ed.
     */

    if ((*env)->ExceptionOccurred(env)) {
	(*env)->ExceptionDescribe(env);
	Tcl_Panic("Java_tcl_lang_Interp_evalString : exception pending after eval");
    }

    Tcl_DecrRefCount(objPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_evalTclObject --
 *
 *	Evaluate the given TclObject.
 *
 * Class:     tcl_lang_Interp
 * Method:    evalTclObject
 * Signature: (JLjava/lang/String;I)I
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the eval does.
 *
 *----------------------------------------------------------------------
 */

jint JNICALL
Java_tcl_lang_Interp_evalTclObject(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jlong objRef,		/* Tcl_Obj* */
    jstring string,		/* String */
    jint flags)			/* Evaluation flags. */
{
    Tcl_Interp *interp;
    Tcl_Obj *objPtr;
    int result;

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Interp.evalTclObject()\n");
#endif /* TCLBLEND_DEBUG */

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

    interp = JavaGetInterp(env, interpObj);

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

    /*
     * Get the Tcl_Obj* held in a CObject or TclList,
     * otherwise convert the Java string to a Tcl string.
     */

    if (objRef != 0) {
	objPtr = *(Tcl_Obj**)&objRef;

#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	Tcl_Panic("Java_tcl_lang_Interp_evalTclObject : disposed object");
    }
#endif
    } else {
	if (!string) {
	    ThrowNullPointerException(env, "No string to evaluate.");
	    return 0;
	}

	objPtr = Tcl_NewObj();
	objPtr->bytes = JavaGetString(env, string, &objPtr->length);
    }
    Tcl_IncrRefCount(objPtr);

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: cmd is : ->%s<-\n", objPtr->bytes);
#endif /* TCLBLEND_DEBUG */

    if (!flags) {
	result = Tcl_EvalObj(interp, objPtr);
    } else {
	result = Tcl_GlobalEvalObj(interp, objPtr);
    }

    /*
     * A Java exception can't be pending after Tcl code is eval'ed.
     */

    if ((*env)->ExceptionOccurred(env)) {
	(*env)->ExceptionDescribe(env);
	Tcl_Panic("Java_tcl_lang_Interp_evalTclObject : exception pending after eval");
    }

    Tcl_DecrRefCount(objPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_getResult --
 *
 *	Returns the current interpreter result as a TclObject.
 *
 * Class:     tcl_lang_Interp
 * Method:    getResult
 * Signature: ()Ljava/lang/TclObject;
 *
 * Results:
 *	Returns a newly allocated TclObject.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jobject JNICALL
Java_tcl_lang_Interp_getResult(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj)		/* Handle to Interp object. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    jobject obj;

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

    obj = JavaGetTclObject(env, Tcl_GetObjResult(interp), NULL);
    return obj;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_setResult --
 *
 *	Sets the interpreter result to a TclObject.
 *
 * Class:     tcl_lang_Interp
 * Method:    setResult
 * Signature: (Ltcl/lang/TclObject;)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_setResult__Ltcl_lang_TclObject_2(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jobject result)		/* New result object. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!result) {
	ThrowNullPointerException(env, "Invalid result object.");
	return;
    }
    Tcl_SetObjResult(interp, JavaGetTclObj(env, result));
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_setResult --
 *
 *	Sets the interpreter result to an int.
 *
 * Class:     tcl_lang_Interp
 * Method:    setResult
 * Signature: (I)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_setResult__I(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jint result)		/* New int result. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    /*
     * Tcl will store an integer value in a long, so use
     * a long instead of an int in case Java defines jint
     * as a long.
     */
    long tcl_val = result;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    Tcl_SetObjResult(interp, Tcl_NewLongObj(tcl_val));
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_setResult --
 *
 *	Sets the interpreter result to a boolean.
 *
 * Class:     tcl_lang_Interp
 * Method:    setResult
 * Signature: (Z)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_setResult__Z(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jboolean result)		/* New boolean result. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj((result == JNI_TRUE) ? 1 : 0));
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_resetResult --
 *
 *	Clears the result of the given interpreter.
 *
 * Class:     tcl_lang_Interp
 * Method:    resetResult
 * Signature: ()V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_resetResult(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj)		/* Handle to Interp object. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

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

    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_setVar --
 *
 *	Set a variable to the given object.
 *
 * Class:     tcl_lang_Interp
 * Method:    setVar
 * Signature:  (Ljava/lang/String;Ljava/lang/String;Ltcl/lang/TclObject;I)Ltcl/lang/TclObject;
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May create a new Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

jobject JNICALL
Java_tcl_lang_Interp_setVar(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring part1Str,		/* If part2 is NULL, this is name of scalar
                                 * variable. Otherwise it is the name of
                                 * an array. */
    jstring part2Str,		/* Name of an element within an array, or
				 * NULL. */
    jobject value,		/* New value for variable. */
    jint flags)			/* Various flags that tell how to set value:
				 * any of GLOBAL_ONLY,
				 * NAMESPACE_ONLY, APPEND_VALUE,
				 * LIST_ELEMENT, LEAVE_ERR_MSG, or
				 * PARSE_PART1. */
{
    Tcl_Obj *part1Ptr, *part2Ptr, *valuePtr, *resultPtr;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    jobject obj;

    /*
     * Throw an exception if any of the objects are null.
     */

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return NULL;
    }
    if (!part1Str || !value) {
	ThrowNullPointerException(env, "setVar");
	return NULL;
    }

    /*
     * Get the Tcl_Obj that corresponds to the given TclObject.
     * Note that we need to increment and decrement the valuePtr
     * ref count to deallocate in the case where Tcl_ObjSetVar2
     * appends to the variable but does not increment the
     * ref count of the valuePtr.
     */

    valuePtr = JavaGetTclObj(env, value);
    Tcl_IncrRefCount(valuePtr);

    part1Ptr = Tcl_NewObj();
    part1Ptr->bytes = JavaGetString(env, part1Str, &part1Ptr->length);
    Tcl_IncrRefCount(part1Ptr);

    if (part2Str) {
	part2Ptr = Tcl_NewObj();
	part2Ptr->bytes = JavaGetString(env, part2Str, &part2Ptr->length);
	Tcl_IncrRefCount(part2Ptr);
    } else {
	part2Ptr = NULL;
    }

    resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags);

    Tcl_DecrRefCount(part1Ptr);
    if (part2Str) {
	Tcl_DecrRefCount(part2Ptr);
    }
    Tcl_DecrRefCount(valuePtr);

    /*
     * If the result is the same as the value, return the same TclObject.
     * Otherwise create a new TclObject for the return value.
     */

    if (!resultPtr) {
	JavaThrowTclException(env, interp, TCL_ERROR);
	obj = NULL;
    } else if (resultPtr == valuePtr) {
	obj = value;
    } else {
	obj = JavaGetTclObject(env, resultPtr, NULL);
    }
    return obj;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_getVar --
 *
 *	Get the value of the given variable.
 *
 * Class:     tcl_lang_Interp
 * Method:    getVar
 * Signature: (Ljava/lang/String;Ljava/lang/String;I)Ltcl/lang/TclObject;
 *
 * Results:
 *	Returns the TclObject that corresponds to the value of the
 *	variable.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jobject JNICALL
Java_tcl_lang_Interp_getVar(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring part1Str,		/* If part2 is NULL, this is name of scalar
                                 * variable. Otherwise it is the name of
                                 * an array. */
    jstring part2Str,		/* Name of an element within an array, or
				 * NULL. */
    jint flags)			/* Various flags that tell how to get value:
				 * any of GLOBAL_ONLY,
				 * NAMESPACE_ONLY, LEAVE_ERR_MSG, or
				 * PARSE_PART1. */
{
    Tcl_Obj *part1Ptr, *part2Ptr, *valuePtr;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    jobject obj;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return NULL;
    }
    if (!part1Str) {
	ThrowNullPointerException(env, "getVar");
	return NULL;
    }

    part1Ptr = Tcl_NewObj();
    part1Ptr->bytes = JavaGetString(env, part1Str, &part1Ptr->length);
    Tcl_IncrRefCount(part1Ptr);

    if (part2Str) {
	part2Ptr = Tcl_NewObj();
	part2Ptr->bytes = JavaGetString(env, part2Str, &part2Ptr->length);
	Tcl_IncrRefCount(part2Ptr);
    } else {
	part2Ptr = NULL;
    }

    valuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);

    Tcl_DecrRefCount(part1Ptr);
    if (part2Str) {
	Tcl_DecrRefCount(part2Ptr);
    }

    if (!valuePtr) {
	JavaThrowTclException(env, interp, TCL_ERROR);
	obj = NULL;
    } else {
	obj = JavaGetTclObject(env, valuePtr, NULL);
    }

    return obj;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_unsetVar --
 *
 *	Unset the given variable.
 *
 * Class:     tcl_lang_Interp
 * Method:    unsetVar
 * Signature: (Ljava/lang/String;Ljava/lang/String;I)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_unsetVar(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring part1Str,		/* If part2 is NULL, this is name of scalar
                                 * variable. Otherwise it is the name of
                                 * an array. */
    jstring part2Str,		/* Name of an element within an array, or
				 * NULL. */
    jint flags)			/* Various flags that tell how to get value:
				 * any of GLOBAL_ONLY,
				 * NAMESPACE_ONLY, LEAVE_ERR_MSG, or
				 * PARSE_PART1. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    char *part1, *part2;
    int result;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!part1Str) {
	ThrowNullPointerException(env, "unsetVar");
	return;
    }

    part1 = JavaGetString(env, part1Str, NULL);
    part2 = (part2Str) ? JavaGetString(env, part2Str, NULL) : NULL;

    result = Tcl_UnsetVar2(interp, part1, part2, flags);

    ckfree(part1);
    if (part2) {
	ckfree(part2);
    }
    if (result != TCL_OK) {
	JavaThrowTclException(env, interp, result);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_traceVar --
 *
 *	Add a trace to a variable.
 *
 * Class:     tcl_lang_Interp
 * Method:    traceVar
 * Signature: (Ljava/lang/String;Ljava/lang/String;Ltcl/lang/VarTrace;I)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_traceVar(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring part1Str,		/* Name of scalar variable or array. */
    jstring part2Str,		/* Name of element within array;  null means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    jobject trace,		/* Object to notify when specified ops are
				 * invoked upon varName. */
    jint flags)			/* OR-ed collection of bits, including any
				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY and
				 * TCL_PARSE_PART1. */
{
    int result;
    JavaTraceInfo *traceInfo;
    char *part1, *part2;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!part1Str || !trace) {
	ThrowNullPointerException(env, "traceVar");
	return;
    }

    /*
     * Get the variable name.
     */

    part1 = JavaGetString(env, part1Str, NULL);
    part2 = (part2Str) ? JavaGetString(env, part2Str, NULL) : NULL;

    /*
     * Set the trace.  Note that we have to set TCL_TRACE_UNSETS in order
     * to get notification when the trace is deleted by the interpreter.
     */

    traceInfo = (JavaTraceInfo *) ckalloc(sizeof(JavaTraceInfo));
    traceInfo->flags = flags;
    traceInfo->errMsg = NULL;
    traceInfo->trace = (*env)->NewGlobalRef(env, trace);

    flags |= TCL_TRACE_UNSETS;

    result = Tcl_TraceVar2(interp, part1, part2, flags, JavaTraceProc,
	    (ClientData) traceInfo);

    /*
     * Release the strings and throw an exception if necessary.
     */

    ckfree(part1);
    if (part2) {
	ckfree(part2);
    }
    if (result != TCL_OK) {
	(*env)->DeleteGlobalRef(env, traceInfo->trace);
	ckfree((char *)traceInfo);
	JavaThrowTclException(env, interp, result);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_untraceVar --
 *
 *	Remove a trace from a variable.
 *
 * Class:     tcl_lang_Interp
 * Method:    untraceVar
 * Signature: (Ljava/lang/String;Ljava/lang/String;Ltcl/lang/VarTrace;I)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_untraceVar(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring part1Str,		/* Name of scalar variable or array. */
    jstring part2Str,		/* Name of element within array;  null means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    jobject trace,		/* Object associated with trace. */
    jint flags)			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY and
				 * TCL_PARSE_PART1. */
{
    char *part1, *part2;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    ClientData clientData;
    JavaTraceInfo *tPtr;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!part1Str || !trace) {
	ThrowNullPointerException(env, "untraceVar");
	return;
    }

    /*
     * Get the variable name.
     */

    part1 = JavaGetString(env, part1Str, NULL);
    part2 = (part2Str) ? JavaGetString(env, part2Str, NULL) : NULL;

    /*
     * Search through all of our traces on this variable to
     * see if there's one with the given trace object.  If so, then
     * delete the first one that matches.
     */

    clientData = 0;
    while ((clientData = Tcl_VarTraceInfo2(interp, part1, part2, flags,
	    JavaTraceProc, clientData)) != 0) {
	tPtr = (JavaTraceInfo *) clientData;
	if ((*env)->IsSameObject(env, tPtr->trace, trace)) {
	    Tcl_UntraceVar2(interp, part1, part2, flags | TCL_TRACE_UNSETS,
		    JavaTraceProc, (ClientData) tPtr);
	    if (tPtr->errMsg != NULL) {
		ckfree(tPtr->errMsg);
	    }
	    (*env)->DeleteGlobalRef(env, tPtr->trace);
	    ckfree((char *) tPtr);
	}
    }

    /*
     * Release the strings.
     */

    ckfree(part1);
    if (part2) {
	ckfree(part2);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * JavaTraceProc --
 *
 *	This routine is the wrapper for any trace procedure implemented
 *	in Java.  It converts the command arguments into TclObject values
 *	and then invokes the cmdProc method on the appropriate object.
 *
 * Results:
 *	If no error occurred, returns NULL.
 *
 * Side effects:
 *	Whatever the trace does.
 *
 *----------------------------------------------------------------------
 */

static char *
JavaTraceProc(
    ClientData clientData,	/* Object handle. */
    Tcl_Interp *interp,		/* Current interpreter. */
#ifdef CONST84
    CONST
#endif
    char *name1,		/* Name of scalar or array variable. */
#ifdef CONST84
    CONST
#endif
    char *name2,		/* Element name or NULL. */
    int flags)			/* Operation flags. */
{
    JavaTraceInfo *tPtr = (JavaTraceInfo *) clientData;
    char *result;
    jstring name1Str, name2Str;
    jobject exception, interpObj;
    Tcl_SavedResult state;
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();

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

    result = NULL;
    if (tPtr->errMsg != NULL) {
	ckfree(tPtr->errMsg);
	tPtr->errMsg = NULL;
    }

    if ((tPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {

	interpObj = (jobject) Tcl_GetAssocData(interp, "java", NULL);

	name1Str = (*env)->NewStringUTF(env, name1);
	name2Str = (name2 ? (*env)->NewStringUTF(env, name2)
		: NULL);

	/*
	 * Execute the command.  Be careful to save and restore both the
	 * string and object results from the interpreter passed to the
	 * trace object.  We discard any result generated by the object.
	 */

	Tcl_SaveResult(interp, &state);

	/*
	 * Invoke the command and check for an exception.
	 */

	(*env)->CallVoidMethod(env, tPtr->trace, jcache->traceProc,
		interpObj, name1Str, name2Str, flags);
	exception = (*env)->ExceptionOccurred(env);
	(*env)->ExceptionClear(env);

	(*env)->DeleteLocalRef(env, name1Str);
	if (name2Str) {
	    (*env)->DeleteLocalRef(env, name2Str);
	}

	if (exception) {
	    (*env)->DeleteLocalRef(env, exception);
	    (void) Tcl_GetStringResult(interp);
	    tPtr->errMsg = (char *)
		    ckalloc((unsigned) (strlen(Tcl_GetStringResult(interp)) + 1));
	    strcpy(tPtr->errMsg, Tcl_GetStringResult(interp));
	    result = tPtr->errMsg;
	}

	Tcl_RestoreResult(interp, &state);
    }
    if (flags & TCL_TRACE_DESTROYED) {
	result = NULL;
	if (tPtr->errMsg != NULL) {
	    ckfree(tPtr->errMsg);
	}
	(*env)->DeleteGlobalRef(env, tPtr->trace);
	ckfree((char *) tPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_createCommand --
 *
 *	Create a new Tcl command that is implemented by a Java object.
 *
 * Class:     tcl_lang_Interp
 * Method:    createCommand
 * Signature: (Ljava/lang/String;Ltcl/lang/Command;)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new JavaCommand object to wrap the Java object.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_createCommand(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring nameStr,		/* Name of command to create. */
    jobject cmd)		/* Object that implements the command. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    const char *name;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!nameStr || !cmd) {
	ThrowNullPointerException(env, "createCommand");
	return;
    }

    name = (*env)->GetStringUTFChars(env, nameStr, NULL);
    cmd = (*env)->NewGlobalRef(env, cmd);

    Tcl_CreateObjCommand(interp, (/*UNCONST*/ char *) name, JavaCmdProc,
	    (ClientData) cmd, JavaCmdDeleteProc);

    (*env)->ReleaseStringUTFChars(env, nameStr, name);
}

/*
 *----------------------------------------------------------------------
 *
 * JavaCmdDeleteProc --
 *
 *	Invokes the dispose() method on the command object if the
 *	object implements the Disposable interfaces.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees the global reference for the command object.
 *
 *----------------------------------------------------------------------
 */

static void
JavaCmdDeleteProc(
    ClientData clientData)
{
    jobject cmd = (jobject)clientData;
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();

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

    if ((*env)->IsInstanceOf(env, cmd, jcache->CommandWithDispose)) {
	(*env)->CallVoidMethod(env, cmd, jcache->disposeCmd);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaCmdDeleteProc : exception in CommandWithDispose.disposeCmd()");
	}
    }
    (*env)->DeleteGlobalRef(env, (jobject)clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * JavaCmdProc --
 *
 *	This function is invoked by Tcl for any command that is
 *	implemented by a Java object. This function converts
 *	arguments from C Tcl_Obj refs to Java TclObject refs
 *	and then invokes the Interp.callCommand() API to handle
 *	the details of invoking the Java method and propagating
 *	exceptions.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the command does.
 *
 *----------------------------------------------------------------------
 */

static int
JavaCmdProc(
    ClientData clientData,	/* Command object handle. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    jobject cmd = (jobject)clientData;
    jarray args;
    jobject value, interpObj;
    int i, j, result;
    JNIEnv *env = JavaGetEnv();
    JavaInfo* jcache = JavaGetCache();

    interpObj = (jobject) Tcl_GetAssocData(interp, "java", NULL);

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

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: JavaCmdProc()\n");
#endif /* TCLBLEND_DEBUG */

    /*
     * Construct the argument array. Note that we invoke
     * Tcl_Object._preserve() once for each argument object.
     * This keeps the TclObject.refCount in line with how
     * Tcl works but does not change the Tcl_Obj.refCount of
     * a CObject since Tcl would have already incremented it.
     */

    args = (*env)->NewObjectArray(env, objc, jcache->TclObject, NULL);
    for (i = 0; i < objc; i++) {
	int isLocal;

	/*
	 * Check to see if this Tcl_Obj has already appeared in
	 * the argument array. If it has, we don't want to
	 * call JavaGetTclObject() for it again since that
	 * would create two TclObject wrappers in the CObject case.
	 */

	Tcl_Obj *arg = objv[i];
	for (j = i-1 ; j >= 0 ; j--) {
	    if (arg == objv[j])
	        break;
	}
	if (j >= 0) {
	    value = (*env)->GetObjectArrayElement(env, args, j);
	    isLocal = 1;
	} else {
	    value = JavaGetTclObject(env, objv[i], &isLocal);
	}

	(*env)->SetObjectArrayElement(env, args, i, value);
	(*env)->CallVoidMethod(env, value, jcache->preserve);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaCmdProc : exception in TclObject._preserve()");
	}

	/*
	 * Delete a newly created local ref expliticly since it may have
	 * been created outside of the VM and so will never be garbage
	 * collected.
	 */

	if (isLocal) {
	    (*env)->DeleteLocalRef(env, value);
            /*fprintf(stderr, "created new CObject or TclList for \"%s\" at index %d\n", Tcl_GetString(objv[i]), i);*/
	} else {
	    /*fprintf(stderr, "found existing TclObject \"%s\" at index %d\n", Tcl_GetString(objv[i]), i);*/
	}
    }

    /*
     * Invoke the command by calling Interp.callCommand().
     */

    result = (*env)->CallIntMethod(env, interpObj,
	    jcache->callCommand, cmd, args);

    /*
     * Interp.callCommand() takes special care to not allow
     * a Java exception to be left pending. This is required
     * since Tcl does not know how to clear a pending JNI
     * exception using the catch command.
     */

    if ((*env)->ExceptionOccurred(env)) {
	(*env)->ExceptionDescribe(env);
	Tcl_Panic("JavaCmdProc : Interp.callCommand() raised an Exception");
    }

    /*
     * Cleanup temp TclObject values saved in the objv
     * array after clearing any pending exception.
     * Make sure none of the argument Tcl_Objs have
     * an invalid ref to a TclObject that has a
     * CObject or TclList internal rep. Decrement
     * the ref count for each TclObject argument.
     */

    for (i = 0; i < objc; i++) {
	JavaBreakRef(env, objv[i]);
	value = (*env)->GetObjectArrayElement(env, args, i);
	(*env)->CallVoidMethod(env, value, jcache->release);
	if ((*env)->ExceptionOccurred(env)) {
	    (*env)->ExceptionDescribe(env);
	    Tcl_Panic("JavaCmdProc : exception in TclObject._release()");
	}
	(*env)->DeleteLocalRef(env, value);
    }

    (*env)->DeleteLocalRef(env, args);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_deleteCommand --
 *
 *	Delete the given command.
 *
 * Class:     tcl_lang_Interp
 * Method:    deleteCommand
 * Signature: (Ljava/lang/String;)I
 *
 * Results:
 *	Returns -1 if no command was found, else returns 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jint JNICALL
Java_tcl_lang_Interp_deleteCommand(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring nameStr)		/* Name of command to create. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    const char *name;
    int result;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return -1;
    }
    if (!nameStr) {
	ThrowNullPointerException(env, "deleteCommand");
	return -1;
    }

    name = (*env)->GetStringUTFChars(env, nameStr, NULL);
    result = Tcl_DeleteCommand(interp, (/*UNCONST*/ char*) name);
    (*env)->ReleaseStringUTFChars(env, nameStr, name);

    return (jint) result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_getCommand --
 *
 *	Return a tcl.lang.Command object for a given Tcl command.
 *	This currently only works for Tcl commands implemented in Java.
 *
 * Class:     tcl_lang_Interp
 * Method:    getCommand
 * Signature: (Ljava/lang/String;)Ltcl/lang/Command;
 *
 * Results:
 *	The command procedure of the given command, or null if
 *      the command doesn't exist.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jobject JNICALL
Java_tcl_lang_Interp_getCommand(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring nameStr)		/* Name of command to look for. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    const char *name;
    jobject cmd = NULL;
    Tcl_CmdInfo cmdInfo;

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return NULL;
    }
    if (!nameStr) {
	ThrowNullPointerException(env, "getCommand");
	return NULL;
    }

    name = (*env)->GetStringUTFChars(env, nameStr, NULL);
    if (Tcl_GetCommandInfo(interp, (/*UNCONST*/ char*) name, &cmdInfo)) {
        /* If the command exists, find out if it is a Tcl command implemeneted in Java */

        if (cmdInfo.isNativeObjectProc &&
                cmdInfo.objProc == JavaCmdProc) {
            cmd = (jobject) cmdInfo.objClientData;
	}

        /*
	 * FIXME: Figure out some way to wrap a Tcl command
	 * in a tcl.lang.Command interface so that it can be
	 * invoked directly from Java. We would need to deal
	 * with deletion of commands which might be tricky
	 */
    }
    (*env)->ReleaseStringUTFChars(env, nameStr, name);
    return cmd;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_commandComplete --
 *
 *	Determine if the String cmd is a complete command.
 *
 * Class:     tcl_lang_Interp
 * Method:    commandComplete
 * Signature: (Ljava/lang/String;)Z
 *
 * Results:
 *	Returns true if the command is complete
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

jboolean JNICALL
Java_tcl_lang_Interp_commandComplete(
    JNIEnv *env,		/* Java environment. */
    jclass interpClass,		/* Handle to Interp class. */
    jstring cmdStr)		/* Command string to test */
{
    const char *cmd;
    jboolean result;

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

    cmd = (*env)->GetStringUTFChars(env, cmdStr, NULL);
    result = (Tcl_CommandComplete((/*UNCONST*/ char*) cmd)
	    ? JNI_TRUE : JNI_FALSE);
    (*env)->ReleaseStringUTFChars(env, cmdStr, cmd);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_setErrorCode
 *
 *	Set the errorCode variable to the given string.
 *
 * Class:     tcl_lang_Interp
 * Method:    setErrorCode
 * Signature: (Ltcl/lang/TclObject;)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_setErrorCode(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jobject code)		/* TclObject to use as errorCode value. */
{
    Tcl_Obj *errorObjPtr;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!code) {
	ThrowNullPointerException(env, "setErrorCode");
	return;
    }

    errorObjPtr = JavaGetTclObj(env, code);
    Tcl_SetObjErrorCode(interp, errorObjPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_addErrorInfo --
 *
 *	Add the given string to the errorInfo.
 *
 * Class:     tcl_lang_Interp
 * Method:    addErrorInfo
 * Signature: (Ljava/lang/String;)V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_addErrorInfo(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Handle to Interp object. */
    jstring string)		/* String to add to errorInfo. */
{
    char *str;
    int length;
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!string) {
	ThrowNullPointerException(env, "addErrorInfo");
	return;
    }

    str = JavaGetString(env, string, &length);
    Tcl_AddObjErrorInfo(interp, str, length);
    ckfree(str);
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_backgroundError --
 *
 *	This procedure is invoked to handle errors that occur in Tcl
 *	commands that are invoked in "background" (e.g. from event or
 *	timer bindings) and are implemented in Java.
 *
 * Class:     tcl_lang_Interp
 * Method:    backgroundError
 * Signature: ()V
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The comamnd "bgerror" is invoked later as an idle handler to
 *	process the error, passing it the error message.  If that fails,
 *	then an error message is output on stderr.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_backgroundError(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj)		/* Handle to Interp object. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    Tcl_BackgroundError(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * JavaGetInterp --
 *
 *	Retrieve the C interpreter pointer from a Java Interp object.
 *
 * Results:
 *	Returns the Tcl_Interp *, or NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
JavaGetInterp(
    JNIEnv *env,		/* Java VM environment. */
    jobject interpObj)		/* Interp object. */
{
    jlong interpPtr;
    Tcl_Interp *interp;
    JavaInfo* jcache = JavaGetCache();

    if (!interpObj) {
	return NULL;
    }

    /*
     * Get the Tcl_Interp * from the Interp object.
     */

    interpPtr = (*env)->GetLongField(env, interpObj, jcache->interpPtr);

    /*
     * Copy the pointer out of the jlong.  We have to do it this way since the
     * jlong may be a structure.
     */

    interp = *(Tcl_Interp**)&interpPtr;
    return interp;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_pkgProvide --
 *
 *	Declare a particular version of a package is present
 *	in the interp.
 *
 * Class:     tcl_lang_Interp
 * Method:    pkgProvide
 * Signature: (Ljava/lang/String;Ljava/lang/String;)V
 *
 * Results:
 *	Normally does nothing; if there is already another version
 *	of the package loaded then an error is raised.
 *
 * Side effects:
 *	The interpreter remembers that this package is available,
 *	so that no other version of the package may be provided for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_pkgProvide(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring nameStr,
    jstring versionStr)
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    char *namePtr;
    char *versionPtr;
    int result;

    /*
     * Throw an exception if any of the objects are null.
     */

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return;
    }
    if (!nameStr || !versionStr) {
	ThrowNullPointerException(env, "pkgProvide");
	return;
    }

    namePtr = JavaGetString(env, nameStr, NULL);
    versionPtr = JavaGetString(env, versionStr, NULL);

    /*
     * Call the Tcl function.
     */

    result = Tcl_PkgProvide(interp, namePtr, versionPtr);

    ckfree(namePtr);
    ckfree(versionPtr);

    if (result != TCL_OK) {
	JavaThrowTclException(env, interp, result);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_pkgRequire --
 *
 *	Invokes a Tcl script to provide a package.
 *
 * Class:     tcl_lang_Interp
 * Method:    pkgRequire
 * Signature: (Ljava/lang/String;Ljava/lang/String;Z)Ljava/lang/String;
 *
 * Results:
 *	If successful, returns the version string for the currently
 *	provided version of the package, or generates a TclException
 *	if the package couldn't be loaded.
 *
 * Side effects:
 *	The script from some previous "package ifneeded" command may
 *	be invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

jstring JNICALL
Java_tcl_lang_Interp_pkgRequire(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj,		/* Interp object. */
    jstring nameStr,
    jstring versionStr,
    jboolean exact)
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    char *namePtr;
    char *versionPtr;
#ifdef CONST84
    CONST
#endif
    char *resultPtr;
    int flag;
    jstring string;

    /*
     * Throw an exception if any of the objects are null.
     */

    if (!interp) {
	ThrowNullPointerException(env, NULL);
	return NULL;
    }
    if (!nameStr || !versionStr) {
	ThrowNullPointerException(env, "pkgRequire");
	return NULL;
    }

    namePtr = JavaGetString(env, nameStr, NULL);
    versionPtr = JavaGetString(env, versionStr, NULL);
    flag = (exact == JNI_TRUE) ? 1 : 0;

    /*
     * Call the Tcl function.
     */

    resultPtr = Tcl_PkgRequire(interp, namePtr, versionPtr, flag);

    ckfree(namePtr);
    ckfree(versionPtr);

    if (resultPtr == NULL) {
	JavaThrowTclException(env, interp, TCL_ERROR);
	string = NULL;
    } else {
	string = (*env)->NewStringUTF(env, resultPtr);
    }
    return string;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_createBTestCommand --
 *
 *	Create a Tcl command called "btest", used for
 *	testing and debugging Tcl Blend.
 *
 * Class:     tcl_lang_Interp
 * Method:    Java_tcl_lang_Interp_createBTestCommand
 * Signature: ()V;
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void JNICALL
Java_tcl_lang_Interp_createBTestCommand(
    JNIEnv *env,		/* Java environment. */
    jobject interpObj)		/* Interp object. */
{
    Tcl_Interp *interp = JavaGetInterp(env, interpObj);
    Tcl_CreateObjCommand(interp, "btest",
        BTestCmd, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * BTestCmd --
 *
 *	Object testing method for Tcl Blend.
 *
 * Results:
 *	See impl.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int BTestCmd(
	ClientData clientData,
        Tcl_Interp *interp,
        int objc,
        Tcl_Obj * CONST objv[])
{
    int index;
    static CONST char *options[] = {
	"compcode",
	"isjniexceptionpending",
	"isjobject",
	"refcount",
	"type",
	NULL
    };
    enum options {
	BTEST_COMPCODE,
	BTEST_IS_JNI_EXCEPTION_PENDING,
	BTEST_ISJOBJECT,
	BTEST_REFCOUNT,
	BTEST_TYPE
    };

    if (objc < 2) {
    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
	    &index) != TCL_OK) {
    	return TCL_ERROR;
    }

    switch ((enum options) index) {
	case BTEST_COMPCODE: {
	    int result;
	    Tcl_Obj *objPtr;
	    if (objc < 3 || objc > 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "script");
		return TCL_ERROR;
	    }
	    objPtr = objv[2];
	    Tcl_IncrRefCount(objPtr);
	    result = Tcl_GlobalEvalObj(interp, objPtr);
	    Tcl_DecrRefCount(objPtr);
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
	    break;
	}
	case BTEST_IS_JNI_EXCEPTION_PENDING: {
	    JNIEnv *env;
	    jboolean pending = 0;
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, "");
		return TCL_ERROR;
	    }
	    env = JavaGetEnv();
	    if ((*env)->ExceptionOccurred(env)) {
	        pending = 1;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(pending));
	    break;
	}
	case BTEST_ISJOBJECT: {
	    if (objc < 3 || objc > 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "obj");
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(JavaIsRef(objv[2])));
	    break;
	}
	case BTEST_REFCOUNT: {
	    if (objc < 3 || objc > 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "obj");
		return TCL_ERROR;
	    }
	    /* refCount - 1 to account for the ref added for this method */
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(objv[2]->refCount - 1));
	    break;
	}
	case BTEST_TYPE: {
	    if (objc < 3 || objc > 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "obj");
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, JavaObjType(objv[2]));
	    break;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Java_tcl_lang_Interp_initName --
 *
 *	Init Tcl executable name if it needs it to be done.
 *
 * Class:     tcl_lang_Interp
 * Method:    initName
 * Signature: ()V
 *
 * Results:
 *	Returns a newly allocated TclObject.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef _WIN32
static HINSTANCE hModule = NULL;

int __stdcall
DllMain(HANDLE hinst, DWORD reason, LPVOID reserved)
{
    if (reason == DLL_PROCESS_ATTACH) {
	/* Remember the DLL handle. */
	hModule = hinst;
    }
}
#endif

void JNICALL
Java_tcl_lang_Interp_initName(
    JNIEnv *env,		/* Java environment. */
    jclass interpClass)		/* Handle to Interp class. */
{
#ifdef _WIN32

    /*
     * We are called from the JVM here and are loaded for the second
     * time. In order to allow cleanup of a copied DLL we release
     * the DLL here and hope that the Tcl core will perform the
     * final unload and cleanup later.
     */

    if (hModule != NULL) {
	FreeLibrary(hModule);
	hModule = NULL;
    }

#else

    CONST char * name;

    /*
     * Recent versions of Tcl require a call to Tcl_FindExecutable
     * before creating/initializing interps, or Tcl will crash.
     * When Tcl Blend is loaded into an existing Tcl interp,
     * the executable name is already set. When Tcl Blend is
     * loaded into an existing JVM, we need to set an
     * executable name that makes some sort of sense. Note that
     * the Win32 version of Tcl_FindExecutable() ignores the
     * executable name you pass and looks up the original name
     * of the executable using Win32 APIs. Pass "java" as the
     * name of the executable for Unix systems.
     */

#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Checking Tcl_GetNameOfExecutable()\n");
#endif /* TCLBLEND_DEBUG */

    name = Tcl_GetNameOfExecutable();

    if (name == NULL) {
#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Executable name not known, calling Tcl_FindExecutable()\n");
#endif /* TCLBLEND_DEBUG */

        Tcl_FindExecutable("java");
        name = Tcl_GetNameOfExecutable();
#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Done Calling Tcl_FindExecutable()\n");
    fprintf(stderr, "TCLBLEND_DEBUG: Tcl exectable name is now \"%s\"\n", name);
#endif /* TCLBLEND_DEBUG */

        TclBlendTrace("Called Tcl_FindExecutable");
    } else {
#ifdef TCLBLEND_DEBUG
    fprintf(stderr, "TCLBLEND_DEBUG: Executable name is already known (%s)\n", name);
#endif /* TCLBLEND_DEBUG */

        TclBlendTrace("Skipped Calling Tcl_FindExecutable");
    }
#endif
    return;
}