diff options
author | dgp <dgp@users.sourceforge.net> | 2017-09-11 14:44:24 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2017-09-11 14:44:24 (GMT) |
commit | 1f2dbd38f566c8e4f63bec06139aabe9e20dc371 (patch) | |
tree | 0757e489d4101145d14fd2005ee3129a87476323 /generic | |
parent | 12efa27c367cc417a169f6ca40cf0ef5b4afbf7f (diff) | |
download | tcl-1f2dbd38f566c8e4f63bec06139aabe9e20dc371.zip tcl-1f2dbd38f566c8e4f63bec06139aabe9e20dc371.tar.gz tcl-1f2dbd38f566c8e4f63bec06139aabe9e20dc371.tar.bz2 |
Hydra work from Cyan Ogilvie.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 5 | ||||
-rw-r--r-- | generic/tclObj.c | 295 |
2 files changed, 285 insertions, 15 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5a33445..e5b09b8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6141,7 +6141,10 @@ TclNREvalObjEx( iPtr->varFramePtr = iPtr->rootFramePtr; } Tcl_IncrRefCount(objPtr); - codePtr = TclCompileObj(interp, objPtr, invoker, word); + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); + if (codePtr == NULL) { + codePtr = TclCompileObj(interp, objPtr, invoker, word); + } TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); diff --git a/generic/tclObj.c b/generic/tclObj.c index 6e4011e..9ea55e7 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,122 @@ 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) +{ + if (!Tcl_HasStringRep(srcPtr)) { + UpdateStringOfHydra(srcPtr); + } + /* Ensure that duplicates of hydras are pure strings, since the most likely + * situation is that we're being duplicated in order to modify the value, + * which would invalidate the cached intreps */ + return; +} + +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 +1992,104 @@ 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; - /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */ - if (irPtr) { - /* Copy the new IntRep into place */ + if (objPtr->typePtr == NULL) { + /* Special case - updating (or clearing) a pure string object */ + TclFreeIntRep(objPtr); objPtr->internalRep = *irPtr; - - /* Set the type to match */ objPtr->typePtr = typePtr; + return; + } + + if (objPtr->typePtr == typePtr) { + /* Special case - updating (or clearing) an objects existing intrep */ + TclFreeIntRep(objPtr); + objPtr->internalRep = *irPtr; + return; + } + + if (objPtr->typePtr != &tclHydraType) { + SetHydraFromAny(NULL, objPtr); + } + + HydraGetIntRep(objPtr, hydraPtr); + + if (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); + } + + /* Mark the client slot as available */ + clientPtr->typePtr = NULL; + memset(&clientPtr->internalRep, 0, sizeof(clientPtr->internalRep)); + return; + } + } } } @@ -1878,8 +2106,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 +2116,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); + } + + 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); + } + } } - /* Type match! objPtr IntRep is the one sought. */ - return &(objPtr->internalRep); + return NULL; } /* @@ -4694,6 +4935,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; } |