merge trunk

generic/tclBinary.c

@@ -57,9 +57,12 @@
 
 static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr);
+static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
 static int		FormatNumber(Tcl_Interp *interp, int type,
 			    Tcl_Obj *src, unsigned char **cursorPtr);
 static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
 static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
 			    size_t *countPtr, int *flagsPtr);
 static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
@@ -245,10 +248,10 @@ static const EnsembleImplMap decodeMap[] = {
  * over which bytearray values can be useful in the meanwhile.
  */
 
-const Tcl_ObjType tclPureByteArrayType = {
+static const Tcl_ObjType properByteArrayType = {
     "bytearray",
-    FreeByteArrayInternalRep,
-    DupByteArrayInternalRep,
+    FreeProperByteArrayInternalRep,
+    DupProperByteArrayInternalRep,
     UpdateStringOfByteArray,
     NULL
 };
@@ -284,6 +287,13 @@ typedef struct {
 #define SET_BYTEARRAY(irPtr, baPtr) \
 		(irPtr)->twoPtrValue.ptr1 = (baPtr)
 
+int
+TclIsPureByteArray(
+    Tcl_Obj * objPtr)
+{
+    return objPtr->typePtr == &properByteArrayType;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -410,7 +420,7 @@ Tcl_SetByteArrayObj(
     }
     SET_BYTEARRAY(&ir, byteArrayPtr);
 
-    Tcl_StoreIntRep(objPtr, &tclPureByteArrayType, &ir);
+    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
 }
 
 /*
@@ -438,13 +448,13 @@ Tcl_GetByteArrayFromObj(
 				 * array of bytes in the ByteArray object. */
 {
     ByteArray *baPtr;
-    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
 
     if (irPtr == NULL) {
 	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	if (irPtr == NULL) {
 	    SetByteArrayFromAny(NULL, objPtr);
-	    irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
 	    if (irPtr == NULL) {
 		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	    }
@@ -492,12 +502,12 @@ Tcl_SetByteArrayLength(
 	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
     }
 
-    irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
     if (irPtr == NULL) {
 	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	if (irPtr == NULL) {
 	    SetByteArrayFromAny(NULL, objPtr);
-	    irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
 	    if (irPtr == NULL) {
 		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	    }
@@ -544,7 +554,7 @@ SetByteArrayFromAny(
     ByteArray *byteArrayPtr;
     Tcl_ObjIntRep ir;
 
-    if ((objPtr->typePtr == &tclPureByteArrayType)
+    if ((objPtr->typePtr == &properByteArrayType)
 	    || (objPtr->typePtr == &tclByteArrayType)) {
 	return TCL_OK;
     }
@@ -564,7 +574,7 @@ SetByteArrayFromAny(
 
     SET_BYTEARRAY(&ir, byteArrayPtr);
     Tcl_StoreIntRep(objPtr,
-	    improper ? &tclByteArrayType : &tclPureByteArrayType, &ir);
+	    improper ? &tclByteArrayType : &properByteArrayType, &ir);
     return TCL_OK;
 }
 
@@ -589,7 +599,14 @@ static void
 FreeByteArrayInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    Tcl_Free(GET_BYTEARRAY(&(objPtr->internalRep)));
+    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
+}
+
+static void
+FreeProperByteArrayInternalRep(
+    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
+{
+    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
 }
 
 /*
@@ -618,7 +635,7 @@ DupByteArrayInternalRep(
     ByteArray *srcArrayPtr, *copyArrayPtr;
     Tcl_ObjIntRep ir;
 
-    srcArrayPtr = GET_BYTEARRAY(&(srcPtr->internalRep));
+    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
     length = srcArrayPtr->used;
 
     copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
@@ -627,7 +644,28 @@ DupByteArrayInternalRep(
     memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
 
     SET_BYTEARRAY(&ir, copyArrayPtr);
-    Tcl_StoreIntRep(copyPtr, srcPtr->typePtr, &ir);
+    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
+}
+
+static void
+DupProperByteArrayInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+{
+    size_t length;
+    ByteArray *srcArrayPtr, *copyArrayPtr;
+    Tcl_ObjIntRep ir;
+
+    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
+    length = srcArrayPtr->used;
+
+    copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
+    copyArrayPtr->used = length;
+    copyArrayPtr->allocated = length;
+    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
+
+    SET_BYTEARRAY(&ir, copyArrayPtr);
+    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
 }
 
 /*
@@ -652,7 +690,7 @@ UpdateStringOfByteArray(
     Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
 				 * update. */
 {
-    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
     ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
     unsigned char *src = byteArrayPtr->bytes;
     size_t i, length = byteArrayPtr->used;
@@ -722,12 +760,12 @@ TclAppendBytesToByteArray(
 	return;
     }
 
-    irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
     if (irPtr == NULL) {
 	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	if (irPtr == NULL) {
 	    SetByteArrayFromAny(NULL, objPtr);
-	    irPtr = TclFetchIntRep(objPtr, &tclPureByteArrayType);
+	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
 	    if (irPtr == NULL) {
 		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
 	    }

generic/tclInt.h

@@ -2679,7 +2679,6 @@ MODULE_SCOPE void *tclTimeClientData;
 MODULE_SCOPE const Tcl_ObjType tclBignumType;
 MODULE_SCOPE const Tcl_ObjType tclBooleanType;
 MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
-MODULE_SCOPE const Tcl_ObjType tclPureByteArrayType;
 MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
 MODULE_SCOPE const Tcl_ObjType tclDoubleType;
 MODULE_SCOPE const Tcl_ObjType tclIntType;
@@ -4571,8 +4570,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
  *----------------------------------------------------------------
  */
 
-#define TclIsPureByteArray(objPtr) \
-	((objPtr)->typePtr==&tclPureByteArrayType)
+MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 #define TclIsPureDict(objPtr) \
 	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
 #define TclFetchIntRep(objPtr, type) \