/* * genobject.c -- * * This file implements the routines that maintain the * GenObject Tcl object type. * * Copyright (c) 2000-2003 JYL Software, Inc. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE, EVEN IF * JYL SOFTWARE INC. IS MADE AWARE OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "genobject.h" #include "genintrep.h" /* * Functions for the GenObj Tcl object type: */ static void DupGenObject _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *destPtr)); static void FreeGenObject _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetGenObject _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static void UpdateGenObject _ANSI_ARGS_((Tcl_Obj *objPtr)); /* * Initialize the GenObject Tcl object type. */ static void InitGenObjectType _ANSI_ARGS_(()); /* * These procedures are for the interposition on the cmdName Tcl * object type: */ static void DupGenCmd _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *destPtr)); static void FreeGenCmd _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetGenCmdFrmAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* * The GenObject Tcl object type: */ static Tcl_ObjType GenObjectType = { "GenObject", FreeGenObject, /* Release a GenObject object. */ DupGenObject, /* Copies a GenObject objct into an * existing Tcl object of arbitrary * type. */ UpdateGenObject, /* Retrieve the string representation of * a GenObject object. */ SetGenObject /* Change the value of an existing GenObject * object. */ }; /* * Save the old CmdType information for the interposition. o */ static Tcl_ObjType oldCmdType; static Tcl_ObjType *cmdTypePtr = NULL; static int cmdTypeInterposed = 0; /* *---------------------------------------------------------------------- * * Genobj_Init -- * * This procedure initializes the GenObject package in an interpreter. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ GENOBJ_DLL int Genobj_Init(Tcl_Interp *interp) { InitGenObjectType(); return TCL_OK; } /* *---------------------------------------------------------------------- * * Genobj_SafeInit -- * * This procedure initializes the GenObject package in a * safe interpreter. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ GENOBJ_DLL int Genobj_SafeInit(Tcl_Interp *interp) { InitGenObjectType(); return TCL_OK; } /* *--------------------------------------------------------------------------- * * GO_GetInternalRep -- * * Retrieves the internal representation associated with this * Tcl_Obj *. Checks if the GO object is of the supplied extension * and returns NULL otherwise. * * Results: * The associated internal representation or NULL. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void * GO_GetInternalRep(Tcl_Obj *objPtr, GO_Extension *extPtr) { GO_InternalRep *ptr2; if ((objPtr->typePtr != &GenObjectType) && (objPtr->typePtr != cmdTypePtr)) { return NULL; } ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; if (ptr2->extension != extPtr) { return NULL; } return ptr2->data; } /* *--------------------------------------------------------------------------- * * GO_GetUncheckedInternalRep -- * * Retrieves the internal representation associated with this * Tcl_Obj *. Does not check whether the internal representation * is of any specific GO_Extension. * * Results: * The associated internal representation or NULL. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void * GO_GetUncheckedInternalRep(Tcl_Obj *objPtr) { GO_InternalRep *ptr2; if ((objPtr->typePtr != &GenObjectType) && (objPtr->typePtr != cmdTypePtr)) { return NULL; } ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; return ptr2->data; } /* *---------------------------------------------------------------------- * * GO_MakeGenObject -- * * Makes a Tcl_Obj whose type is the GenObject Tcl object type and * whose private data is the data passed in. * * Extensions using GenObject should ony call this to create new * instances. Extensions should not attempt to create GenObject * instances themselves by manually putting them together. * * Results: * A new Tcl_Obj with the right type and internal representation. * * Side effects: * Creates a new Tcl_Obj instance. */ GENOBJ_DLL Tcl_Obj * GO_MakeGenObject(GO_Extension *extPtr, void *data, Tcl_Interp *interp) { GO_InternalRep *ptr2 = NewGenObjectInternalRep(extPtr, interp, data); Tcl_Obj *objPtr = Tcl_NewObj(); /* * Initialize it has an invalid string representation. */ objPtr->bytes = NULL; objPtr->length = 0; /* * Attach the type representation. */ objPtr->typePtr = &GenObjectType; /* * Store the internal representation in the ptr2 field, a convention * that makes it possible to distinguish "our" objects when they're * converted to/from GenObject Tcl objects and preserve the internal * representation. */ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2; /* * Ensure the internal representation is propertly refcounted. */ GenObjectIncrRefcount(ptr2); /* * Update the string representation. */ UpdateGenObject(objPtr); /* * Make the Tcl command corresponding to this GenObject instance. */ GenObjectMakeTclCommand(ptr2); /* * Finally return the new Tcl_Obj object. */ return objPtr; } /* *---------------------------------------------------------------------- * * InitGenObjectType -- * * Initializes (registers) the GenObject Tcl object type and sets up * the interposition on the CmdType Tcl object type so that GenObject * objects will be preserved when an object is converted to a command. * * Results: * None. * * Side effecs: * Registers the GenObject Tcl object type and hijacks the CmdName * Tcl object type. * *---------------------------------------------------------------------- */ static void InitGenObjectType() { /* * Prevent this routine from doing the work multiple times. */ if (cmdTypeInterposed) { return; } cmdTypeInterposed = 1; /* * Register our type. */ Tcl_RegisterObjType(&GenObjectType); /* * Save the current CmdType object type and insert our own to interpose * on it so that GenObject objects are preserved when they're converted * to commands (i.e. when they're used as command names). * * The second assignment line below copies the current contents of the * cmdType object type into the save area. */ cmdTypePtr = Tcl_GetObjType("cmdName"); oldCmdType = *cmdTypePtr; /* * Update the cmdName object type in-place with our functionality. */ cmdTypePtr->freeIntRepProc = FreeGenCmd; cmdTypePtr->dupIntRepProc = DupGenCmd; cmdTypePtr->setFromAnyProc = SetGenCmdFrmAny; /* * At this point, the hijack is complete. Now any conversions from/to * cmdName objects will route through our functionality. */ } /* *---------------------------------------------------------------------- * * DupGenObject -- * * Copies a GenObject object into another object. * * Results: * None. * * Side effects: * Increments the refcount for the GenObject object's internal * representation and smashes the other object's internal rep. */ static void DupGenObject(Tcl_Obj *srcPtr, Tcl_Obj *destPtr) { GO_InternalRep *ptr2 = (GO_InternalRep *) srcPtr->internalRep.twoPtrValue.ptr2; if (ptr2 == NULL) { Tcl_Panic("INTERNAL ERROR: Null ptr2"); } GenObjectIncrRefcount(ptr2); destPtr->typePtr = srcPtr->typePtr; destPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2; } /* *---------------------------------------------------------------------- * * FreeGenObject -- * * Frees the GenObject object and if it is the last reference for the * shared internal representation, the internal representation is also * freed. * * Results: * None. * * Side effects: * The Tcl_Obj passed in no longer is a valid reference to the * internal representation. * *---------------------------------------------------------------------- */ static void FreeGenObject(Tcl_Obj *objPtr) { GO_InternalRep *ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; /* * Decrement the reference count on the internal representation. */ GenObjectDecrRefcount(ptr2); } /* *---------------------------------------------------------------------- * * SetGenObject -- * * No conversion of other objects to GenObject objects is possible, * so this function always returns a TCL error. * * Results: * Always returns TCL_ERROR. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int SetGenObject(Tcl_Interp *interp, Tcl_Obj *objPtr) { /* * If an interpreter was given, leave an error message. */ if (interp != NULL) { Tcl_ResetResult(interp); Tcl_SetStringObj(Tcl_GetObjResult(interp), "cannot convert to GenObject", -1); } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * UpdateGenObject -- * * Update the string representation of a GenObject Tcl object. * * Results: * None. * * Side effects: * Updates the string representation of the given Tcl_Obj object. * *---------------------------------------------------------------------- */ static void UpdateGenObject(Tcl_Obj *objPtr) { char *buf; GO_InternalRep *ptr2; /* * Get the internal representation of the GenObject object. */ ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; /* * Check that the namelen field of the extension is initialized. * If not, auto-initialize it to the length of the name field. */ if (ptr2->extension->namelen == -1) { ptr2->extension->namelen = strlen(ptr2->extension->name); } /* * We allocate the buffer here. It will be freed when the string * representation changes or the object is deleted. */ buf = (char *) Tcl_Alloc((unsigned) (ptr2->extension->namelen + 32) * sizeof(char)); sprintf(buf, "%s0x%x", ptr2->extension->name, objPtr); /* * Update the string representation: */ objPtr->bytes = buf; objPtr->length = strlen(buf); /* * Store the name of this object in the internal representation also, * as a convenience for debugging, etc. */ ptr2->name = buf; } /* *---------------------------------------------------------------------- * * DupGenCmd -- * * Initializes the internal representation of a cmdName object so * that it preserves the internal representation of a GenObject * object. * * Results: * None. * * Side effects: * The internal representation of dupPtr is set to a GenObject * object corresponding to srcPtr's internal representation and * the refcount on the internal representation is incremented. * *---------------------------------------------------------------------- */ static void DupGenCmd(Tcl_Obj *srcPtr, Tcl_Obj *destPtr) { VOID *ptr2 = srcPtr->internalRep.twoPtrValue.ptr2; /* * Copy the standard parts of the dupPtr to the destPtr: */ (oldCmdType.dupIntRepProc) (srcPtr, destPtr); /* * If it is a GenObject object (assumed by having a non-NULL ptr2 * value) then duplicate it. */ if (ptr2 != NULL) { DupGenObject(srcPtr, destPtr); } } /* *---------------------------------------------------------------------- * * FreeGenCmd -- * * Frees the internal representation for the GenObject object. * * Results: * None. * * Side effects: * Decrements the refcount and frees the internal representation * if this is the last reference. * *---------------------------------------------------------------------- */ static void FreeGenCmd(Tcl_Obj *objPtr) { /* * If the ptr2 field is set it must be a GenObject object so we * can use the GenObject object API to decrement its reference count: */ if (objPtr->internalRep.twoPtrValue.ptr2 != NULL) { FreeGenObject(objPtr); } /* * Call the old command type freeIntRepProc. */ (oldCmdType.freeIntRepProc)(objPtr); } /* *---------------------------------------------------------------------- * * SetGenCmdFrmAny -- * * Attempts to generate a command object from an arbitrary type. * This routine wraps around the standard cmdName setFromAny * procedure. If the old type was a GenObject it copies the handle * into the cmdName typed object so that it can be restored later. * This way the internal representation is not lost when the object * is converted to a cmdName (when a GenObject is used as a command). * * Results: * The return value is a standard Tcl result. If an error occurs * during the conversion, an error message is left in the interpreter * result if the given interpreter is non-NULL. * * Side effects: * If no error occurs, a GenObject object internal representation may * be stored as objPtr's internal representation and the object's * reference count may be incremented. * *---------------------------------------------------------------------- */ static int SetGenCmdFrmAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { int result; GO_InternalRep *ptr2; #ifdef DEBUG if (interp == NULL) { Tcl_Panic("SetGenCmdFrmAny 0x%x called with NULL interp\n", objPtr); } #endif if (objPtr->typePtr == &GenObjectType) { /* * This is a GenObject object. Save ptr2 while doing the conversion * so that it can be restored afterwards once the object has been * converted to a cmdName. * * This case occurs in the following code: * * set x [someCmdCreatingaGenObject] * $x arg1 arg2 */ /* * First of all update the string representation. */ if (objPtr->bytes == NULL) { UpdateGenObject(objPtr); } /* * Save the GenObject internal representation. */ ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; /* * Check if the object migrated out of its creating interpreter. * If it is from another interpreter, then we convert it to a * regular cmdName and lose the internal representation (shame). */ if (ptr2->interp != interp) { result = (oldCmdType.setFromAnyProc) (interp, objPtr); if (result == TCL_OK) { objPtr->internalRep.twoPtrValue.ptr2 = NULL; } return result; } /* * It's from this interpreter, so preserve the internal representation. */ GenObjectIncrRefcount(ptr2); objPtr->typePtr = NULL; result = (oldCmdType.setFromAnyProc)(interp, objPtr); if (result == TCL_OK) { objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2; GenObjectDecrRefcount(ptr2); } } else if ((objPtr->typePtr == cmdTypePtr) && (objPtr->internalRep.twoPtrValue.ptr2 != NULL)) { /* * The object is a command and has a non-NULL ptr2 value. We assume * it is one of our GenObject commands. This case occurs when the * command is used in a namespace where it does not yet appear in * the name cache. * * We increment the refcount for the GenObject object and hold onto it * because the conversion is going to decrement the refcount. Then * after the conversion we stick the GenObject object back in ptr2 so * that the command can find the object to operate on. */ ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2; /* * Check if the object migrated out of its interpreter. If it is * from a different interpreter, then we convert it to a regular * cmdName and lose the internal representation (shame). */ if (ptr2->interp != interp) { result = (oldCmdType.setFromAnyProc) (interp, objPtr); if (result == TCL_OK) { objPtr->internalRep.twoPtrValue.ptr2 = NULL; } return result; } /* * It's from our interpreter, so preserve the internal representation. */ GenObjectIncrRefcount(ptr2); result = (oldCmdType.setFromAnyProc) (ptr2->interp, objPtr); if (result == TCL_OK) { objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2; /* * NOTE: * ----- * * DO NOT call GenObjectDecrRefcount(ptr2) because the * above setFromAnyProc call already did so. * * If the result is not TCL_OK then this object is messed up. * Should we call GenObjectDecrRefcount(ptr2) in that case? */ } } else { /* * It is some other type. Convert it to a cmdName and ensure that * ptr2 is NULL so we do not assume it is a GenObject object. */ result = (oldCmdType.setFromAnyProc) (interp, objPtr); if (result == TCL_OK) { objPtr->internalRep.twoPtrValue.ptr2 = NULL; } } return result; }