Posted to tcl by cjo at Fri Sep 08 19:29:26 GMT 2017view pretty
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;
}