New routines Tcl_FetchIntRep() and Tcl_StoreIntRep().

4 files changed, 94 insertions, 0 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 2bb49b9..962a563 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2334,6 +2334,14 @@ declare 632 {
     char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
 	    unsigned int numBytes)
 }
+declare 633 {
+    const Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr,
+	    const Tcl_ObjType *typePtr)
+}
+declare 634 {
+    void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
+	    Tcl_ObjIntRep *irPtr)
+}
 
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 7114ad9..609ec86 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1821,6 +1821,13 @@ EXTERN void		Tcl_FreeIntRep(Tcl_Obj *objPtr);
 /* 632 */
 EXTERN char *		Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
 				unsigned int numBytes);
+/* 633 */
+EXTERN const Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr,
+				const Tcl_ObjType *typePtr);
+/* 634 */
+EXTERN void		Tcl_StoreIntRep(Tcl_Obj *objPtr,
+				const Tcl_ObjType *typePtr,
+				Tcl_ObjIntRep *irPtr);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2489,6 +2496,8 @@ typedef struct TclStubs {
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
     void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */
     char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 632 */
+    const Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 633 */
+    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, Tcl_ObjIntRep *irPtr); /* 634 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3785,6 +3794,10 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FreeIntRep) /* 631 */
 #define Tcl_InitStringRep \
 	(tclStubsPtr->tcl_InitStringRep) /* 632 */
+#define Tcl_FetchIntRep \
+	(tclStubsPtr->tcl_FetchIntRep) /* 633 */
+#define Tcl_StoreIntRep \
+	(tclStubsPtr->tcl_StoreIntRep) /* 634 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 2a35539..55426bf 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1812,6 +1812,77 @@ Tcl_InvalidateStringRep(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_StoreIntRep --
+ *
+ *	This function is called to set the object's internal
+ *	representation to match a particular type.
+ *
+ *	It is the caller's responsibility to guarantee that
+ *	the value of the submitted IntRep is in agreement with
+ *	the value of any existing string rep.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ *	Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_StoreIntRep(
+    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
+    const Tcl_ObjType *typePtr,	/* New type for the object */
+    Tcl_ObjIntRep *irPtr)	/* New IntRep for the object */
+{
+    /* Clear out any existing IntRep ( "shimmer" ) */
+    TclFreeIntRep(objPtr);
+
+    /* Copy the new IntRep into place */
+    objPtr->internalRep = *irPtr;
+
+    /* Set the type to match */
+    objPtr->typePtr = typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FetchIntRep --
+ *
+ *	This function is called to retrieve the object's internal
+ *	representation matching a requested type, if any.
+ *
+ * Results:
+ *	A read-only pointer to the associated Tcl_ObjIntRep, or
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const Tcl_ObjIntRep *
+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;
+    }
+
+    /* Type match! objPtr IntRep is the one sought. */
+    return &(objPtr->internalRep);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FreeIntRep --
  *
  *	This function is called to free an object's internal representation.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 775d4ac..2af47b7 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1417,6 +1417,8 @@ const TclStubs tclStubs = {
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
     Tcl_FreeIntRep, /* 631 */
     Tcl_InitStringRep, /* 632 */
+    Tcl_FetchIntRep, /* 633 */
+    Tcl_StoreIntRep, /* 634 */
 };
 
 /* !END!: Do not edit above this line. */