diff options
| -rw-r--r-- | generic/tclObj.c | 344 |
1 files changed, 330 insertions, 14 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index 9301d9d..6bb743f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -206,6 +206,10 @@ static Tcl_ThreadDataKey pendingObjDataKey; * Prototypes for functions defined later in this file: */ +static void FreeHydra(Tcl_Obj *objPtr); +static void DupHydra(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void UpdateStringOfHydra(Tcl_Obj *objPtr); +static int SetHydraFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -243,6 +247,26 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * implementations. */ +#define MAX_HYDRA_CLIENTS 5 +static const Tcl_ObjType tclHydraType = { + "hydra", /* name */ + FreeHydra, /* freeIntRepProc */ + DupHydra, /* dupIntRepProc */ + UpdateStringOfHydra, /* updateStringProc */ + SetHydraFromAny /* setFromAnyProc */ +}; + +#define HydraGetIntRep(objPtr, hydraPtr) \ + (hydraPtr) = (Hydra *)((objPtr)->internalRep.twoPtrValue.ptr1) + +typedef struct HydraClient { + const Tcl_ObjType *typePtr; + Tcl_ObjIntRep internalRep; +} HydraClient; +typedef struct Hydra { + HydraClient client[MAX_HYDRA_CLIENTS]; +} Hydra; + static const Tcl_ObjType oldBooleanType = { "boolean", /* name */ NULL, /* freeIntRepProc */ @@ -1694,6 +1718,167 @@ Tcl_GetStringFromObj( return objPtr->bytes; } +static void +FreeHydra( + Tcl_Obj *objPtr) +{ + int i; + Hydra *hydraPtr; + Tcl_Obj fakeObj; + + memset(&fakeObj, 0, sizeof(fakeObj)); + HydraGetIntRep(objPtr, hydraPtr); + + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + if (hydraPtr->client[i].typePtr) { + fakeObj.internalRep = hydraPtr->client[i].internalRep; + fakeObj.typePtr = hydraPtr->client[i].typePtr; + Tcl_FreeIntRep(&fakeObj); + if (fakeObj.refCount > 0) { + Tcl_Panic("Invalid reference taken to fakeObj while " + "freeing intrep for %s", + hydraPtr->client[i].typePtr->name); + } + + hydraPtr->client[i].typePtr = NULL; + memset(&hydraPtr->client[i].internalRep, 0, sizeof(hydraPtr->client[i].internalRep)); + } + } + + Tcl_Free((char *)hydraPtr); + hydraPtr = objPtr->internalRep.twoPtrValue.ptr1 = NULL; +} + +static void +DupHydra( + Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr) +{ + int i; + Hydra *hydraPtr; + Hydra *hydraCopyPtr; + Tcl_Obj fakeSrcObj, fakeCopyObj; + + HydraGetIntRep(srcPtr, hydraPtr); + + hydraCopyPtr = (Hydra *)Tcl_Alloc(sizeof(Hydra)); + memset(hydraCopyPtr, 0, sizeof(Hydra)); + + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + HydraClient *clientCopyPtr = &hydraCopyPtr->client[i]; + + if (clientPtr->typePtr) { + if (clientPtr->typePtr->dupIntRepProc) { + + memset(&fakeSrcObj, 0, sizeof(fakeSrcObj)); + fakeSrcObj.refCount = 10; + memset(&fakeCopyObj, 0, sizeof(fakeCopyObj)); + fakeCopyObj.refCount = 10; + + fakeSrcObj.internalRep = hydraPtr->client[i].internalRep; + fakeSrcObj.typePtr = hydraPtr->client[i].typePtr; + + /* DANGER? */ + fakeCopyObj.bytes = copyPtr->bytes; + fakeCopyObj.length = copyPtr->length; + fakeSrcObj.typePtr->dupIntRepProc(&fakeSrcObj, &fakeCopyObj); + + if ((fakeSrcObj.refCount != 10) + || (fakeCopyObj.refCount != 10)) { + /* + * This Tcl_ObjType does Dup in a way the hydra + * system cannot handle. Undo, and leave it out + * of the copy. + */ + fakeCopyObj.typePtr = NULL; + } + + if (fakeCopyObj.typePtr) { + clientCopyPtr->typePtr = fakeCopyObj.typePtr; + clientCopyPtr->internalRep = fakeCopyObj.internalRep; + } + + } + } + } + + TclFreeIntRep(copyPtr); /* Paranoia? */ + copyPtr->internalRep.twoPtrValue.ptr1 = hydraCopyPtr; + copyPtr->typePtr = &tclHydraType; +} + +static void +UpdateStringOfHydra( + Tcl_Obj *objPtr) +{ + int i; + Hydra *hydraPtr; + Tcl_Obj fakeObj; + + memset(&fakeObj, 0, sizeof(fakeObj)); + + HydraGetIntRep(objPtr, hydraPtr); + + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + + if (clientPtr->typePtr) { + if (clientPtr->typePtr->updateStringProc) { + fakeObj.internalRep = hydraPtr->client[i].internalRep; + fakeObj.typePtr = hydraPtr->client[i].typePtr; + /* Don't know if this is necessary */ + fakeObj.bytes = NULL; + fakeObj.length = 0; + + fakeObj.typePtr->updateStringProc(&fakeObj); + + if (fakeObj.refCount > 0) { + Tcl_Panic("Invalid reference taken to fakeObj while " + "updating string rep using %s", + hydraPtr->client[i].typePtr->name); + } + + if (TclHasStringRep(&fakeObj)) { /* Not sure about this */ + objPtr->bytes = fakeObj.bytes; + objPtr->length = fakeObj.length; + fakeObj.bytes = NULL; + fakeObj.length = 0; + return; + } + } + } + } + + /* TODO: what? */ + Tcl_Panic("Could not update string rep of hydra: %s", + "No clients capable of regenerating string rep found"); +} + +static int +SetHydraFromAny( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + Hydra *hydraPtr; + + if (objPtr->typePtr == &tclHydraType) { + return TCL_OK; + } + + hydraPtr = (Hydra *)Tcl_Alloc(sizeof(Hydra)); + memset(hydraPtr, 0, sizeof(Hydra)); + + hydraPtr->client[0].typePtr = objPtr->typePtr; + hydraPtr->client[0].internalRep = objPtr->internalRep; + + objPtr->internalRep.twoPtrValue.ptr1 = hydraPtr; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &tclHydraType; + + return TCL_OK; +} + /* *---------------------------------------------------------------------- * @@ -1852,16 +2037,108 @@ Tcl_StoreIntRep( const Tcl_ObjType *typePtr, /* New type for the object */ const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */ { - /* Clear out any existing IntRep ( "shimmer" ) */ - TclFreeIntRep(objPtr); + int i; + Hydra *hydraPtr; + + if (objPtr->typePtr == NULL) { + /* Special case - updating (or clearing) a pure string object */ + if (irPtr) { + objPtr->internalRep = *irPtr; + objPtr->typePtr = typePtr; + } + return; + } + + if (objPtr->typePtr == typePtr) { + /* Special case - updating (or clearing) an objects existing intrep */ + TclFreeIntRep(objPtr); + if (irPtr) { + objPtr->internalRep = *irPtr; + objPtr->typePtr = typePtr; + } + return; + } + + if (objPtr->typePtr != &tclHydraType) { + SetHydraFromAny(NULL, objPtr); + } + + HydraGetIntRep(objPtr, hydraPtr); - /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */ if (irPtr) { - /* Copy the new IntRep into place */ - objPtr->internalRep = *irPtr; + int firstAvailableSlot = -1; + + /* If we have an existing client with a matching type, we need to + * update that intrep even if there is an open slot before it */ + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + + if (clientPtr->typePtr == typePtr) { + Tcl_Obj fakeObj; + + /* Free the matching client intrep, using a fake obj */ + memset(&fakeObj, 0, sizeof(fakeObj)); + fakeObj.typePtr = typePtr; + fakeObj.internalRep = clientPtr->internalRep; + //Tcl_InvalidateStringRep(&fakeObj); + TclFreeIntRep(&fakeObj); + + if (fakeObj.refCount > 0) { + Tcl_Panic("Invalid reference taken to fakeObj while " + "freeing hydra client interp for %s", + typePtr->name); + } + + /* Update the intrep */ + clientPtr->internalRep = *irPtr; + return; + } else if (firstAvailableSlot == -1 && clientPtr->typePtr == NULL) { + /* Record the first available slot in case we need to add this + * intrep there */ + firstAvailableSlot = i; + } + } + + if (firstAvailableSlot > -1) { + HydraClient *clientPtr = &hydraPtr->client[firstAvailableSlot]; + + if (clientPtr->typePtr == NULL) { + /* Found available slot, put this intrep there */ + clientPtr->internalRep = *irPtr; + clientPtr->typePtr = typePtr; + return; + } + } + + /* No available client slots. Upconvert to linked list? */ + Tcl_Panic("Unable to add client intrep for %s to hydra: " + "No slots available", typePtr->name); + } else { + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + + if (clientPtr->typePtr == typePtr) { + Tcl_Obj fakeObj; + + /* Free the matching client intrep, using a fake obj */ + memset(&fakeObj, 0, sizeof(fakeObj)); + fakeObj.typePtr = typePtr; + fakeObj.internalRep = clientPtr->internalRep; + //Tcl_InvalidateStringRep(&fakeObj); + TclFreeIntRep(&fakeObj); + + if (fakeObj.refCount > 0) { + Tcl_Panic("Invalid reference taken to fakeObj while " + "freeing hydra client interp for %s", + typePtr->name); + } - /* Set the type to match */ - objPtr->typePtr = typePtr; + /* Mark the client slot as available */ + clientPtr->typePtr = NULL; + memset(&clientPtr->internalRep, 0, sizeof(clientPtr->internalRep)); + return; + } + } } } @@ -1878,8 +2155,7 @@ Tcl_StoreIntRep( * NULL if no such internal representation exists. * * Side effects: - * Calls the freeIntRepProc of the current Tcl_ObjType, if any. - * Sets the internalRep and typePtr fields to the submitted values. + * None. * *---------------------------------------------------------------------- */ @@ -1889,13 +2165,27 @@ Tcl_FetchIntRep( Tcl_Obj *objPtr, /* Object to fetch from. */ const Tcl_ObjType *typePtr) /* Requested type */ { - /* If objPtr type doesn't match request, nothing can be fetched */ - if (objPtr->typePtr != typePtr) { - return NULL; + if (objPtr->typePtr == typePtr) { + /* Type match! objPtr IntRep is the one sought. */ + return &(objPtr->internalRep); } - /* Type match! objPtr IntRep is the one sought. */ - return &(objPtr->internalRep); + if (objPtr->typePtr == &tclHydraType) { + int i; + Hydra *hydraPtr; + + HydraGetIntRep(objPtr, hydraPtr); + + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + + if (clientPtr->typePtr == typePtr) { + return &(clientPtr->internalRep); + } + } + } + + return NULL; } /* @@ -4694,6 +4984,32 @@ Tcl_RepresentationCmd( Tcl_AppendToObj(descObj, ", no string representation", -1); } + if (objv[1]->typePtr == &tclHydraType) { + int i; + Hydra *hydraPtr; + + Tcl_AppendToObj(descObj, ", with client representations:", -1); + HydraGetIntRep(objv[1], hydraPtr); + for (i=0; i<MAX_HYDRA_CLIENTS; i++) { + HydraClient *clientPtr = &hydraPtr->client[i]; + + if (clientPtr->typePtr == NULL) { + continue; + } + + Tcl_AppendPrintfToObj(descObj, "\n\t%d: %s", i, clientPtr->typePtr->name); + + if (clientPtr->typePtr == &tclDoubleType) { + Tcl_AppendPrintfToObj(descObj, ", internal representation %g", + clientPtr->internalRep.doubleValue); + } else { + Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p", + (void *) clientPtr->internalRep.twoPtrValue.ptr1, + (void *) clientPtr->internalRep.twoPtrValue.ptr2); + } + } + } + Tcl_SetObjResult(interp, descObj); return TCL_OK; } |