Posted to tcl by cjo at Mon Sep 11 14:01:43 GMT 2017view raw

  1. diff --git a/generic/tclBasic.c b/generic/tclBasic.c
  2. index 5a33445..e5b09b8 100644
  3. --- a/generic/tclBasic.c
  4. +++ b/generic/tclBasic.c
  5. @@ -6141,7 +6141,10 @@ TclNREvalObjEx(
  6. iPtr->varFramePtr = iPtr->rootFramePtr;
  7. }
  8. Tcl_IncrRefCount(objPtr);
  9. - codePtr = TclCompileObj(interp, objPtr, invoker, word);
  10. + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
  11. + if (codePtr == NULL) {
  12. + codePtr = TclCompileObj(interp, objPtr, invoker, word);
  13. + }
  14.  
  15. TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
  16. objPtr, INT2PTR(allowExceptions), NULL);
  17. diff --git a/generic/tclDecls.h b/generic/tclDecls.h
  18. index 59d83b8..282e70b 100644
  19. --- a/generic/tclDecls.h
  20. +++ b/generic/tclDecls.h
  21. @@ -1836,6 +1836,8 @@ EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr,
  22. const Tcl_ObjIntRep *irPtr);
  23. /* 636 */
  24. EXTERN int Tcl_HasStringRep(Tcl_Obj *objPtr);
  25. +/* 637 */
  26. +EXTERN void Tcl_FreeOtherIntReps(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
  27.  
  28. typedef struct {
  29. const struct TclPlatStubs *tclPlatStubs;
  30. @@ -2508,6 +2510,7 @@ typedef struct TclStubs {
  31. Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 634 */
  32. void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 635 */
  33. int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 636 */
  34. + void (*tcl_FreeOtherIntReps) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 637 */
  35. } TclStubs;
  36.  
  37. extern const TclStubs *tclStubsPtr;
  38. @@ -3812,6 +3815,8 @@ extern const TclStubs *tclStubsPtr;
  39. (tclStubsPtr->tcl_StoreIntRep) /* 635 */
  40. #define Tcl_HasStringRep \
  41. (tclStubsPtr->tcl_HasStringRep) /* 636 */
  42. +#define Tcl_FreeOtherIntReps \
  43. + (tclStubsPtr->tcl_FreeOtherIntReps) /* 636 */
  44.  
  45. #endif /* defined(USE_TCL_STUBS) */
  46.  
  47. diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
  48. index f4e15a6..e4b06bc 100644
  49. --- a/generic/tclDictObj.c
  50. +++ b/generic/tclDictObj.c
  51. @@ -959,6 +959,7 @@ Tcl_DictObjPut(
  52. return TCL_ERROR;
  53. }
  54.  
  55. + Tcl_FreeOtherIntReps(dictPtr, &tclDictType);
  56. TclInvalidateStringRep(dictPtr);
  57. hPtr = CreateChainEntry(dict, keyPtr, &isNew);
  58. Tcl_IncrRefCount(valuePtr);
  59. diff --git a/generic/tclExecute.c b/generic/tclExecute.c
  60. index 8389bef..728e52c 100644
  61. --- a/generic/tclExecute.c
  62. +++ b/generic/tclExecute.c
  63. @@ -9742,8 +9742,13 @@ TclGetSrcInfoForPc(
  64. ECL *locPtr = NULL;
  65. int srcOffset, i;
  66. Interp *iPtr = (Interp *) *codePtr->interpHandle;
  67. - Tcl_HashEntry *hePtr =
  68. - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
  69. + Tcl_HashEntry *hePtr;
  70. +
  71. + if (!iPtr->lineBCPtr) {
  72. + fprintf(stderr, "TclGetSrcInfoForPc: iPtr->lineBCPtr is invalid\n");
  73. + return;
  74. + }
  75. + hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
  76.  
  77. if (!hePtr) {
  78. return;
  79. diff --git a/generic/tclListObj.c b/generic/tclListObj.c
  80. index c33b95e..6e81a23 100644
  81. --- a/generic/tclListObj.c
  82. +++ b/generic/tclListObj.c
  83. @@ -66,7 +66,13 @@ const Tcl_ObjType tclListType = {
  84. } while (0)
  85.  
  86. #define ListResetIntRep(objPtr, listRepPtr) \
  87. - Tcl_FetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)
  88. + do { \
  89. + Tcl_ObjIntRep *irPtr; \
  90. + Tcl_FreeOtherIntReps((objPtr), &tclListType); \
  91. + irPtr = Tcl_FetchIntRep((objPtr), &tclListType); \
  92. + irPtr->twoPtrValue.ptr1 = (listRepPtr); \
  93. + irPtr->twoPtrValue.ptr2 = NULL; \
  94. + } while (0)
  95.  
  96. #ifndef TCL_MIN_ELEMENT_GROWTH
  97. #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
  98. @@ -1257,7 +1263,7 @@ TclLindexFlat(
  99. int index, listLen = 0;
  100. Tcl_Obj **elemPtrs = NULL, *sublistCopy;
  101.  
  102. - /*
  103. + /* TODO hydra: is this still necessary if shimmering is no longer an issue?
  104. * Here we make a private copy of the current sublist, so we avoid any
  105. * shimmering issues that might invalidate the elemPtr array below
  106. * while we are still using it. See test lindex-8.4.
  107. diff --git a/generic/tclObj.c b/generic/tclObj.c
  108. index 6e4011e..8bf69ce 100644
  109. --- a/generic/tclObj.c
  110. +++ b/generic/tclObj.c
  111. @@ -206,6 +206,10 @@ static Tcl_ThreadDataKey pendingObjDataKey;
  112. * Prototypes for functions defined later in this file:
  113. */
  114.  
  115. +static void FreeHydra(Tcl_Obj *objPtr);
  116. +static void DupHydra(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
  117. +static void UpdateStringOfHydra(Tcl_Obj *objPtr);
  118. +static int SetHydraFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  119. static int ParseBoolean(Tcl_Obj *objPtr);
  120. static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  121. static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  122. @@ -243,6 +247,26 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  123. * implementations.
  124. */
  125.  
  126. +#define MAX_HYDRA_CLIENTS 5
  127. +static const Tcl_ObjType tclHydraType = {
  128. + "hydra", /* name */
  129. + FreeHydra, /* freeIntRepProc */
  130. + DupHydra, /* dupIntRepProc */
  131. + UpdateStringOfHydra, /* updateStringProc */
  132. + SetHydraFromAny /* setFromAnyProc */
  133. +};
  134. +
  135. +#define HydraGetIntRep(objPtr, hydraPtr) \
  136. + (hydraPtr) = (Hydra *)((objPtr)->internalRep.twoPtrValue.ptr1)
  137. +
  138. +typedef struct HydraClient {
  139. + const Tcl_ObjType *typePtr;
  140. + Tcl_ObjIntRep internalRep;
  141. +} HydraClient;
  142. +typedef struct Hydra {
  143. + HydraClient client[MAX_HYDRA_CLIENTS];
  144. +} Hydra;
  145. +
  146. static const Tcl_ObjType oldBooleanType = {
  147. "boolean", /* name */
  148. NULL, /* freeIntRepProc */
  149. @@ -1694,6 +1718,175 @@ Tcl_GetStringFromObj(
  150. return objPtr->bytes;
  151. }
  152.  
  153. +static void
  154. +FreeHydra(
  155. + Tcl_Obj *objPtr)
  156. +{
  157. + int i;
  158. + Hydra *hydraPtr;
  159. + Tcl_Obj fakeObj;
  160. +
  161. + memset(&fakeObj, 0, sizeof(fakeObj));
  162. + fakeObj.refCount = 10;
  163. + HydraGetIntRep(objPtr, hydraPtr);
  164. +
  165. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  166. + HydraClient *clientPtr = &hydraPtr->client[i];
  167. +
  168. + if (clientPtr->typePtr) {
  169. + if (clientPtr->typePtr->freeIntRepProc) {
  170. + fakeObj.internalRep = hydraPtr->client[i].internalRep;
  171. + fakeObj.typePtr = hydraPtr->client[i].typePtr;
  172. + Tcl_FreeIntRep(&fakeObj);
  173. +
  174. + if (fakeObj.refCount != 10) {
  175. + Tcl_Panic("Invalid reference taken to fakeObj while "
  176. + "freeing intrep for %s",
  177. + hydraPtr->client[i].typePtr->name);
  178. + }
  179. + }
  180. +
  181. + hydraPtr->client[i].typePtr = NULL;
  182. + memset(&hydraPtr->client[i].internalRep, 0, sizeof(hydraPtr->client[i].internalRep));
  183. + }
  184. + }
  185. +
  186. + Tcl_Free((char *)hydraPtr);
  187. + hydraPtr = objPtr->internalRep.twoPtrValue.ptr1 = NULL;
  188. +}
  189. +
  190. +static void
  191. +DupHydra(
  192. + Tcl_Obj *srcPtr,
  193. + Tcl_Obj *copyPtr)
  194. +{
  195. + int i;
  196. + Hydra *hydraPtr;
  197. + Hydra *hydraCopyPtr;
  198. + Tcl_Obj fakeSrcObj, fakeCopyObj;
  199. +
  200. + if (Tcl_HasStringRep(srcPtr) && srcPtr->bytes == &tclEmptyString) {
  201. + return;
  202. + }
  203. +
  204. + memset(&fakeSrcObj, 0, sizeof(fakeSrcObj));
  205. + fakeSrcObj.refCount = 10;
  206. + memset(&fakeCopyObj, 0, sizeof(fakeCopyObj));
  207. + fakeCopyObj.refCount = 10;
  208. +
  209. + HydraGetIntRep(srcPtr, hydraPtr);
  210. +
  211. + hydraCopyPtr = (Hydra *)Tcl_Alloc(sizeof(Hydra));
  212. + memset(hydraCopyPtr, 0, sizeof(*hydraCopyPtr));
  213. +
  214. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  215. + HydraClient *clientPtr = &hydraPtr->client[i];
  216. + HydraClient *clientCopyPtr = &hydraCopyPtr->client[i];
  217. +
  218. + if (clientPtr->typePtr) {
  219. + if (clientPtr->typePtr->dupIntRepProc) {
  220. + fakeCopyObj.typePtr = NULL;
  221. + fakeSrcObj.internalRep = hydraPtr->client[i].internalRep;
  222. + fakeSrcObj.typePtr = hydraPtr->client[i].typePtr;
  223. +
  224. + fakeSrcObj.typePtr->dupIntRepProc(&fakeSrcObj, &fakeCopyObj);
  225. +
  226. + if (fakeSrcObj.refCount != 10) {
  227. + Tcl_Panic("Invalid reference taken to fakeSrcObj while "
  228. + "duplicating intrep for %s",
  229. + hydraPtr->client[i].typePtr->name);
  230. + }
  231. + if (fakeCopyObj.refCount != 10) {
  232. + Tcl_Panic("Invalid reference taken to fakeCopyObj while "
  233. + "duplicating intrep for %s",
  234. + hydraPtr->client[i].typePtr->name);
  235. + }
  236. +
  237. + if (clientCopyPtr->internalRep.twoPtrValue.ptr1 || clientCopyPtr->internalRep.twoPtrValue.ptr2) {
  238. + clientCopyPtr->internalRep = fakeCopyObj.internalRep;
  239. + clientCopyPtr->typePtr = fakeCopyObj.typePtr;
  240. + }
  241. + }
  242. + }
  243. + }
  244. +
  245. + TclFreeIntRep(copyPtr); /* Paranoia? */
  246. + copyPtr->internalRep.twoPtrValue.ptr1 = hydraPtr;
  247. + copyPtr->typePtr = &tclHydraType;
  248. +}
  249. +
  250. +static void
  251. +UpdateStringOfHydra(
  252. + Tcl_Obj *objPtr)
  253. +{
  254. + int i;
  255. + Hydra *hydraPtr;
  256. + Tcl_Obj fakeObj;
  257. +
  258. + memset(&fakeObj, 0, sizeof(fakeObj));
  259. + fakeObj.refCount = 10;
  260. +
  261. + HydraGetIntRep(objPtr, hydraPtr);
  262. +
  263. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  264. + HydraClient *clientPtr = &hydraPtr->client[i];
  265. +
  266. + if (clientPtr->typePtr) {
  267. + if (clientPtr->typePtr->updateStringProc) {
  268. + fakeObj.internalRep = hydraPtr->client[i].internalRep;
  269. + fakeObj.typePtr = hydraPtr->client[i].typePtr;
  270. + /* Don't know if this is necessary */
  271. + fakeObj.bytes = NULL;
  272. + fakeObj.length = 0;
  273. +
  274. + fakeObj.typePtr->updateStringProc(&fakeObj);
  275. +
  276. + if (fakeObj.refCount != 10) {
  277. + Tcl_Panic("Invalid reference taken to fakeObj while "
  278. + "updating string rep using %s",
  279. + hydraPtr->client[i].typePtr->name);
  280. + }
  281. +
  282. + if (TclHasStringRep(&fakeObj)) { /* Not sure about this */
  283. + objPtr->bytes = fakeObj.bytes;
  284. + objPtr->length = fakeObj.length;
  285. + fakeObj.bytes = NULL;
  286. + fakeObj.length = 0;
  287. + return;
  288. + }
  289. + }
  290. + }
  291. + }
  292. +
  293. + /* TODO: what? */
  294. + Tcl_Panic("Could not update string rep of hydra: %s",
  295. + "No clients capable of regenerating string rep found");
  296. +}
  297. +
  298. +static int
  299. +SetHydraFromAny(
  300. + Tcl_Interp *interp,
  301. + Tcl_Obj *objPtr)
  302. +{
  303. + Hydra *hydraPtr;
  304. +
  305. + if (objPtr->typePtr == &tclHydraType) {
  306. + return TCL_OK;
  307. + }
  308. +
  309. + hydraPtr = (Hydra *)Tcl_Alloc(sizeof(Hydra));
  310. + memset(hydraPtr, 0, sizeof(Hydra));
  311. +
  312. + hydraPtr->client[0].typePtr = objPtr->typePtr;
  313. + hydraPtr->client[0].internalRep = objPtr->internalRep;
  314. +
  315. + objPtr->internalRep.twoPtrValue.ptr1 = hydraPtr;
  316. + objPtr->internalRep.twoPtrValue.ptr2 = NULL;
  317. + objPtr->typePtr = &tclHydraType;
  318. +
  319. + return TCL_OK;
  320. +}
  321. +
  322. /*
  323. *----------------------------------------------------------------------
  324. *
  325. @@ -1852,16 +2045,125 @@ Tcl_StoreIntRep(
  326. const Tcl_ObjType *typePtr, /* New type for the object */
  327. const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */
  328. {
  329. - /* Clear out any existing IntRep ( "shimmer" ) */
  330. - TclFreeIntRep(objPtr);
  331. + int i;
  332. + Hydra *hydraPtr;
  333.  
  334. - /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
  335. - if (irPtr) {
  336. - /* Copy the new IntRep into place */
  337. + if (objPtr->typePtr == NULL) {
  338. + /* Special case - updating (or clearing) a pure string object */
  339. + TclFreeIntRep(objPtr);
  340. objPtr->internalRep = *irPtr;
  341. -
  342. - /* Set the type to match */
  343. objPtr->typePtr = typePtr;
  344. + return;
  345. + }
  346. +
  347. + if (objPtr->typePtr == typePtr) {
  348. + /* Special case - updating (or clearing) an object's existing intrep */
  349. + TclFreeIntRep(objPtr);
  350. + if (irPtr) {
  351. + objPtr->internalRep = *irPtr;
  352. + } else {
  353. + memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
  354. + }
  355. + return;
  356. + }
  357. +
  358. + if (objPtr->typePtr != &tclHydraType) {
  359. + SetHydraFromAny(NULL, objPtr);
  360. + }
  361. +
  362. + HydraGetIntRep(objPtr, hydraPtr);
  363. +
  364. + if (irPtr) {
  365. + int firstAvailableSlot = -1;
  366. +
  367. + /* If we have an existing client with a matching type, we need to
  368. + * update that intrep even if there is an open slot before it */
  369. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  370. + HydraClient *clientPtr = &hydraPtr->client[i];
  371. +
  372. + if (clientPtr->typePtr == typePtr) {
  373. + if (irPtr) {
  374. + /* In the case where we are updating an intrep for a type we
  375. + * already have, take that as a sign that the value has changed
  376. + * ([incr], [lset], [append], etc), and free all the others.
  377. + * Since we will be left with a single intrep, drop back to a
  378. + * simple object (non-hydra) */
  379. + Tcl_FreeIntRep(objPtr);
  380. + objPtr->internalRep = *irPtr;
  381. + objPtr->typePtr = typePtr;
  382. + } else {
  383. + if (clientPtr->typePtr->freeIntRepProc) {
  384. + /* Free the matching client intrep, using a fake obj */
  385. + Tcl_Obj fakeObj;
  386. +
  387. + memset(&fakeObj, 0, sizeof(fakeObj));
  388. + fakeObj.refCount = 10;
  389. + fakeObj.typePtr = typePtr;
  390. + fakeObj.internalRep = clientPtr->internalRep;
  391. + TclFreeIntRep(&fakeObj);
  392. +
  393. + if (fakeObj.refCount != 10) {
  394. + Tcl_Panic("Invalid reference taken to fakeObj while "
  395. + "freeing hydra client interp for %s",
  396. + typePtr->name);
  397. + }
  398. + }
  399. +
  400. + /* Mark the client slot as available */
  401. + clientPtr->typePtr = NULL;
  402. + memset(&clientPtr->internalRep, 0, sizeof(clientPtr->internalRep));
  403. + return;
  404. + }
  405. + return;
  406. + } else if (firstAvailableSlot == -1 && clientPtr->typePtr == NULL) {
  407. + /* Record the first available slot in case we need to add this
  408. + * intrep there */
  409. + firstAvailableSlot = i;
  410. + }
  411. + }
  412. +
  413. + if (firstAvailableSlot > -1) {
  414. + HydraClient *clientPtr = &hydraPtr->client[firstAvailableSlot];
  415. +
  416. + if (clientPtr->typePtr == NULL) {
  417. + /* Found available slot, put this intrep there */
  418. + clientPtr->internalRep = *irPtr;
  419. + clientPtr->typePtr = typePtr;
  420. + return;
  421. + }
  422. + }
  423. +
  424. + /* No available client slots. Upconvert to linked list? */
  425. + Tcl_Panic("Unable to add client intrep for %s to hydra: "
  426. + "No slots available", typePtr->name);
  427. + } else {
  428. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  429. + HydraClient *clientPtr = &hydraPtr->client[i];
  430. +
  431. + if (clientPtr->typePtr == typePtr) {
  432. + if (clientPtr->typePtr->freeIntRepProc) {
  433. + /* Free the matching client intrep, using a fake obj */
  434. + Tcl_Obj fakeObj;
  435. +
  436. + memset(&fakeObj, 0, sizeof(fakeObj));
  437. + fakeObj.refCount = 10;
  438. + fakeObj.typePtr = typePtr;
  439. + fakeObj.internalRep = clientPtr->internalRep;
  440. + TclFreeIntRep(&fakeObj);
  441. +
  442. + if (fakeObj.refCount != 10) {
  443. + Tcl_Panic("Invalid reference taken to fakeObj while "
  444. + "freeing hydra client interp for %s",
  445. + typePtr->name);
  446. + }
  447. + }
  448. +
  449. + /* Mark the client slot as available */
  450. + clientPtr->typePtr = NULL;
  451. + memset(&clientPtr->internalRep, 0, sizeof(clientPtr->internalRep));
  452. + return;
  453. + }
  454. + }
  455. }
  456. }
  457.  
  458. @@ -1878,8 +2180,7 @@ Tcl_StoreIntRep(
  459. * NULL if no such internal representation exists.
  460. *
  461. * Side effects:
  462. - * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
  463. - * Sets the internalRep and typePtr fields to the submitted values.
  464. + * None.
  465. *
  466. *----------------------------------------------------------------------
  467. */
  468. @@ -1889,13 +2190,27 @@ Tcl_FetchIntRep(
  469. Tcl_Obj *objPtr, /* Object to fetch from. */
  470. const Tcl_ObjType *typePtr) /* Requested type */
  471. {
  472. - /* If objPtr type doesn't match request, nothing can be fetched */
  473. - if (objPtr->typePtr != typePtr) {
  474. - return NULL;
  475. + if (objPtr->typePtr == typePtr) {
  476. + /* Type match! objPtr IntRep is the one sought. */
  477. + return &(objPtr->internalRep);
  478. }
  479.  
  480. - /* Type match! objPtr IntRep is the one sought. */
  481. - return &(objPtr->internalRep);
  482. + if (objPtr->typePtr == &tclHydraType) {
  483. + int i;
  484. + Hydra *hydraPtr;
  485. +
  486. + HydraGetIntRep(objPtr, hydraPtr);
  487. +
  488. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  489. + HydraClient *clientPtr = &hydraPtr->client[i];
  490. +
  491. + if (clientPtr->typePtr == typePtr) {
  492. + return &(clientPtr->internalRep);
  493. + }
  494. + }
  495. + }
  496. +
  497. + return NULL;
  498. }
  499.  
  500. /*
  501. @@ -1922,6 +2237,43 @@ Tcl_FreeIntRep(
  502. TclFreeIntRep(objPtr);
  503. }
  504.  
  505. +void
  506. +Tcl_FreeOtherIntReps(
  507. + Tcl_Obj *objPtr,
  508. + const Tcl_ObjType *typePtr)
  509. +{
  510. + if (objPtr->typePtr == NULL || objPtr->typePtr == typePtr) {
  511. + return;
  512. + }
  513. +
  514. + if (objPtr->typePtr == &tclHydraType) {
  515. + int i;
  516. + Hydra *hydraPtr;
  517. + Tcl_Obj fakeObj;
  518. +
  519. + HydraGetIntRep(objPtr, hydraPtr);
  520. + memset(&fakeObj, 0, sizeof(fakeObj));
  521. +
  522. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  523. + HydraClient *clientPtr = &hydraPtr->client[i];
  524. +
  525. + if (clientPtr->typePtr != NULL && clientPtr->typePtr != typePtr) {
  526. + if (clientPtr->typePtr->freeIntRepProc) {
  527. + fakeObj.typePtr = clientPtr->typePtr;
  528. + fakeObj.internalRep = clientPtr->internalRep;
  529. + fakeObj.typePtr->freeIntRepProc(&fakeObj);
  530. + }
  531. + clientPtr->typePtr = NULL;
  532. + memset(&clientPtr->internalRep, 0, sizeof(clientPtr->internalRep));
  533. + }
  534. + }
  535. +
  536. + /* Convert back to a plain object of type typePtr */
  537. + objPtr->internalRep = fakeObj.internalRep;
  538. + objPtr->typePtr = typePtr;
  539. + Tcl_Free((char *)hydraPtr);
  540. + }
  541. +}
  542. /*
  543. *----------------------------------------------------------------------
  544. *
  545. @@ -4694,6 +5046,32 @@ Tcl_RepresentationCmd(
  546. Tcl_AppendToObj(descObj, ", no string representation", -1);
  547. }
  548.  
  549. + if (objv[1]->typePtr == &tclHydraType) {
  550. + int i;
  551. + Hydra *hydraPtr;
  552. +
  553. + Tcl_AppendToObj(descObj, ", with client representations:", -1);
  554. + HydraGetIntRep(objv[1], hydraPtr);
  555. + for (i=0; i<MAX_HYDRA_CLIENTS; i++) {
  556. + HydraClient *clientPtr = &hydraPtr->client[i];
  557. +
  558. + if (clientPtr->typePtr == NULL) {
  559. + continue;
  560. + }
  561. +
  562. + Tcl_AppendPrintfToObj(descObj, "\n\t%d: %s", i, clientPtr->typePtr->name);
  563. +
  564. + if (clientPtr->typePtr == &tclDoubleType) {
  565. + Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
  566. + clientPtr->internalRep.doubleValue);
  567. + } else {
  568. + Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
  569. + (void *) clientPtr->internalRep.twoPtrValue.ptr1,
  570. + (void *) clientPtr->internalRep.twoPtrValue.ptr2);
  571. + }
  572. + }
  573. + }
  574. +
  575. Tcl_SetObjResult(interp, descObj);
  576. return TCL_OK;
  577. }
  578. diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
  579. index 1ef1957..506d2f7 100644
  580. --- a/generic/tclStringRep.h
  581. +++ b/generic/tclStringRep.h
  582. @@ -84,9 +84,21 @@ typedef struct {
  583. #define stringAttemptRealloc(ptr, numChars) \
  584. (String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
  585. #define GET_STRING(objPtr) \
  586. - ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
  587. + ((String *) ((Tcl_FetchIntRep((objPtr), &tclStringType))->twoPtrValue.ptr1))
  588. #define SET_STRING(objPtr, stringPtr) \
  589. - ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
  590. + do { \
  591. + Tcl_ObjIntRep *irPtr; \
  592. + Tcl_FreeOtherIntReps((objPtr), &tclStringType); \
  593. + irPtr = Tcl_FetchIntRep((objPtr), &tclStringType); \
  594. + if (irPtr == NULL) { \
  595. + Tcl_ObjIntRep newIr; \
  596. + newIr.twoPtrValue.ptr1 = (void *) (stringPtr); \
  597. + newIr.twoPtrValue.ptr2 = NULL; \
  598. + Tcl_StoreIntRep((objPtr), &tclStringType, &newIr); \
  599. + } else { \
  600. + irPtr->twoPtrValue.ptr1 = (void *) (stringPtr); \
  601. + } \
  602. + } while (0)
  603.  
  604. /*
  605. * Local Variables:
  606. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
  607. index 8ff6291..449464a 100644
  608. --- a/generic/tclStubInit.c
  609. +++ b/generic/tclStubInit.c
  610. @@ -1531,6 +1531,7 @@ const TclStubs tclStubs = {
  611. Tcl_FetchIntRep, /* 634 */
  612. Tcl_StoreIntRep, /* 635 */
  613. Tcl_HasStringRep, /* 636 */
  614. + Tcl_FreeOtherIntReps, /* 637 */
  615. };
  616.  
  617. /* !END!: Do not edit above this line. */
  618. diff --git a/generic/tclVar.c b/generic/tclVar.c
  619. index 4c3d4a1..fa65be4 100644
  620. --- a/generic/tclVar.c
  621. +++ b/generic/tclVar.c
  622. @@ -5564,10 +5564,13 @@ DupLocalVarName(
  623. Tcl_Obj *namePtr;
  624.  
  625. LocalGetIntRep(srcPtr, index, namePtr);
  626. - if (!namePtr) {
  627. - namePtr = srcPtr;
  628. + if (namePtr) {
  629. + LocalSetIntRep(dupPtr, index, namePtr);
  630. + } else {
  631. + dupPtr->typePtr = NULL;
  632. + dupPtr->internalRep.twoPtrValue.ptr1 = NULL;
  633. + dupPtr->internalRep.twoPtrValue.ptr2 = NULL;
  634. }
  635. - LocalSetIntRep(dupPtr, index, namePtr);
  636. }
  637.  
  638. /*