*** tclBinary.c.orig	Sun Oct 23 15:01:29 2005
--- tclBinary.c	Thu Feb 22 17:57:42 2007
***************
*** 111,116 ****
--- 111,118 ----
  				 * array. */
      int allocated;		/* The amount of space actually allocated
  				 * minus 1 byte. */
+     int offset;			/* the offset from the start of the allocated
+ 				 * to the real data */
      unsigned char bytes[4];	/* The array of bytes.  The actual size of
  				 * this field depends on the 'allocated' field
  				 * above. */
***************
*** 278,283 ****
--- 280,286 ----
      byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
      byteArrayPtr->used = length;
      byteArrayPtr->allocated = length;
+     byteArrayPtr->offset = 0;
      memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
  
      objPtr->typePtr = &tclByteArrayType;
***************
*** 316,322 ****
      if (lengthPtr != NULL) {
  	*lengthPtr = baPtr->used;
      }
!     return (unsigned char *) baPtr->bytes;
  }
  
  /*
--- 319,325 ----
      if (lengthPtr != NULL) {
  	*lengthPtr = baPtr->used;
      }
!     return (unsigned char *) baPtr->bytes + baPtr->offset;
  }
  
  /*
***************
*** 356,374 ****
      }
  
      byteArrayPtr = GET_BYTEARRAY(objPtr);
!     if (length > byteArrayPtr->allocated) {
! 	newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
  	newByteArrayPtr->used = length;
! 	newByteArrayPtr->allocated = length;
  	memcpy((VOID *) newByteArrayPtr->bytes,
! 		(VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
  	ckfree((char *) byteArrayPtr);
  	byteArrayPtr = newByteArrayPtr;
  	SET_BYTEARRAY(objPtr, byteArrayPtr);
      }
      Tcl_InvalidateStringRep(objPtr);
      byteArrayPtr->used = length;
!     return byteArrayPtr->bytes;
  }
  
  /*
--- 359,392 ----
      }
  
      byteArrayPtr = GET_BYTEARRAY(objPtr);
!     if (length > byteArrayPtr->allocated - byteArrayPtr->offset) {
!         /* if enough space has not previously been allocated, then 
!          * allocate twice the requested size so that subsequent 
!          * extensions do not need to reallocate and copy
!          */ 
! 	newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length*2));
  	newByteArrayPtr->used = length;
! 	newByteArrayPtr->allocated = length*2;
! 	newByteArrayPtr->offset = 0;
  	memcpy((VOID *) newByteArrayPtr->bytes,
! 		(VOID *) byteArrayPtr->bytes + byteArrayPtr->offset, 
! 		(size_t) byteArrayPtr->used);
  	ckfree((char *) byteArrayPtr);
  	byteArrayPtr = newByteArrayPtr;
  	SET_BYTEARRAY(objPtr, byteArrayPtr);
+     } else if (length < byteArrayPtr->offset) {
+         /* if the requested length is less than the current offset, 
+          * move the (requested) live data to the front of the allocated space
+          * without changing the allocation
+          */
+         memmove((VOID *) byteArrayPtr->bytes,
+                 (VOID *) byteArrayPtr->bytes + byteArrayPtr->offset,
+                 (size_t) length);
+         byteArrayPtr->offset=0;
      }
      Tcl_InvalidateStringRep(objPtr);
      byteArrayPtr->used = length;
!     return byteArrayPtr->bytes + byteArrayPtr->offset;
  }
  
  /*
***************
*** 412,417 ****
--- 430,436 ----
  
  	byteArrayPtr->used = dst - byteArrayPtr->bytes;
  	byteArrayPtr->allocated = length;
+ 	byteArrayPtr->offset = 0;
  
  	if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
  	    (*typePtr->freeIntRepProc)(objPtr);
***************
*** 478,484 ****
      copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
      copyArrayPtr->used = length;
      copyArrayPtr->allocated = length;
!     memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
  	    (size_t) length);
      SET_BYTEARRAY(copyPtr, copyArrayPtr);
  
--- 497,504 ----
      copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
      copyArrayPtr->used = length;
      copyArrayPtr->allocated = length;
!     copyArrayPtr->offset = 0;
!     memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes + srcArrayPtr->offset,
  	    (size_t) length);
      SET_BYTEARRAY(copyPtr, copyArrayPtr);
  
***************
*** 518,524 ****
      ByteArray *byteArrayPtr;
  
      byteArrayPtr = GET_BYTEARRAY(objPtr);
!     src = byteArrayPtr->bytes;
      length = byteArrayPtr->used;
  
      /*
--- 538,544 ----
      ByteArray *byteArrayPtr;
  
      byteArrayPtr = GET_BYTEARRAY(objPtr);
!     src = byteArrayPtr->bytes + byteArrayPtr->offset;
      length = byteArrayPtr->used;
  
      /*
***************
*** 579,584 ****
--- 599,605 ----
      char *format;		/* Pointer to current position in format
  				 * string. */
      Tcl_Obj *resultPtr;		/* Object holding result buffer. */
+     Tcl_Obj *varValuePtr=NULL;	/* modifiable object  */
      unsigned char *buffer;	/* Start of result buffer. */
      unsigned char *cursor;	/* Current position within result buffer. */
      unsigned char *maxPos;	/* Greatest position within result buffer that
***************
*** 586,595 ****
      char *errorString, *errorValue, *str;
      int offset, size, length, index;
      static CONST char *options[] = { 
! 	"format",	"scan",		NULL 
      };
      enum options { 
! 	BINARY_FORMAT,	BINARY_SCAN
      };
  
      if (objc < 2) {
--- 607,619 ----
      char *errorString, *errorValue, *str;
      int offset, size, length, index;
      static CONST char *options[] = { 
! 	"format",	"scan",
! 	"set",		"dscan",
! 	NULL 
      };
      enum options { 
! 	BINARY_FORMAT,	BINARY_SCAN,
! 	BINARY_SET,	BINARY_DSCAN
      };
  
      if (objc < 2) {
***************
*** 602,612 ****
      	return TCL_ERROR;
      }
  
      switch ((enum options) index) {
  	case BINARY_FORMAT: {
! 	    if (objc < 3) {
! 		Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
! 		return TCL_ERROR;
  	    }
  
  	    /*
--- 626,676 ----
      	return TCL_ERROR;
      }
  
+     /* handle shared variables for destructive ops */
      switch ((enum options) index) {
+         case BINARY_SET:
+         case BINARY_DSCAN: {
+             Var *varPtr,*arrayPtr;
+             Tcl_Obj *oldValuePtr;
+             varPtr=TclObjLookupVar(interp,objv[2],NULL,TCL_LEAVE_ERR_MSG,"modify",
+                 /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+             if (varPtr == NULL) {
+                 return TCL_ERROR;
+             }
+             oldValuePtr=varPtr->value.objPtr;
+             if (oldValuePtr == NULL) {
+                 varPtr->value.objPtr=Tcl_NewObj();
+                 Tcl_IncrRefCount(varPtr->value.objPtr);
+             } else if (Tcl_IsShared(oldValuePtr)) {
+                 varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+                 Tcl_DecrRefCount(oldValuePtr);
+                 oldValuePtr=varPtr->value.objPtr;
+                 Tcl_IncrRefCount(oldValuePtr);
+             }
+             varValuePtr=varPtr->value.objPtr;
+             TclPtrSetVar(interp,varPtr,arrayPtr,TclGetString(objv[2]),NULL,varValuePtr,TCL_LEAVE_ERR_MSG);
+             break;
+         }
+         default: break;
+     }
+ 
+ 
+     switch ((enum options) index) {
+ 	case BINARY_SET:
  	case BINARY_FORMAT: {
! 
! 	    if ((enum options) index == BINARY_SET) {
! 		if (objc < 4) {
! 		    Tcl_WrongNumArgs(interp, 2, objv, "varName formatString ?arg arg ...?");
! 		    return TCL_ERROR;
! 		}
! 		arg = 4;
! 	    } else {
! 		if (objc < 3) {
! 		    Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
! 		    return TCL_ERROR;
! 		}
! 		arg = 3;
  	    }
  
  	    /*
***************
*** 615,622 ****
  	     * second pass places the formatted data into the buffer.
  	     */
  
! 	    format = Tcl_GetString(objv[2]);
! 	    arg = 3;
  	    offset = 0;
  	    length = 0;
  	    while (*format != '\0') {
--- 679,685 ----
  	     * second pass places the formatted data into the buffer.
  	     */
  
! 	    format = Tcl_GetString(objv[arg-1]);
  	    offset = 0;
  	    length = 0;
  	    while (*format != '\0') {
***************
*** 770,778 ****
  	     * number of bytes and filling with nulls.
  	     */
  
! 	    resultPtr = Tcl_GetObjResult(interp);
! 	    buffer = Tcl_SetByteArrayLength(resultPtr, length);
! 	    memset((VOID *) buffer, 0, (size_t) length);
  
  	    /*
  	     * Pack the data into the result object.  Note that we can skip
--- 833,848 ----
  	     * number of bytes and filling with nulls.
  	     */
  
! 	    if ((enum options) index == BINARY_SET) {
! 		buffer = Tcl_SetByteArrayLength(varValuePtr, length);
!                 Tcl_SetObjResult(interp,varValuePtr);
! 		arg = 4;
! 	    } else {
! 		resultPtr = Tcl_GetObjResult(interp);
! 		buffer = Tcl_SetByteArrayLength(resultPtr, length);
! 		memset((VOID *) buffer, 0, (size_t) length);
! 		arg = 3;
! 	    }
  
  	    /*
  	     * Pack the data into the result object.  Note that we can skip
***************
*** 780,787 ****
  	     * parsed the string once.
  	     */
  
! 	    arg = 3;
! 	    format = Tcl_GetString(objv[2]);
  	    cursor = buffer;
  	    maxPos = cursor;
  	    while (*format != 0) {
--- 850,856 ----
  	     * parsed the string once.
  	     */
  
! 	    format = Tcl_GetString(objv[arg-1]);
  	    cursor = buffer;
  	    maxPos = cursor;
  	    while (*format != 0) {
***************
*** 990,996 ****
  			if (count == BINARY_NOCOUNT) {
  			    count = 1;
  			}
! 			memset(cursor, 0, (size_t) count);
  			cursor += count;
  			break;
  		    }
--- 1059,1067 ----
  			if (count == BINARY_NOCOUNT) {
  			    count = 1;
  			}
! 			if ((enum options) index == BINARY_FORMAT) {
! 			    memset(cursor, 0, (size_t) count);
! 			}
  			cursor += count;
  			break;
  		    }
***************
*** 1024,1043 ****
  	    }
  	    break;
  	}
  	case BINARY_SCAN: {
  	    int i;
  	    Tcl_Obj *valuePtr, *elementPtr;
  	    Tcl_HashTable numberCacheHash;
  	    Tcl_HashTable *numberCachePtr;
  
! 	    if (objc < 4) {
! 		Tcl_WrongNumArgs(interp, 2, objv,
! 			"value formatString ?varName varName ...?");
! 		return TCL_ERROR;
  	    }
  	    numberCachePtr = &numberCacheHash;
  	    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
- 	    buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
  	    format = Tcl_GetString(objv[3]);
  	    cursor = buffer;
  	    arg = 4;
--- 1095,1124 ----
  	    }
  	    break;
  	}
+ 	case BINARY_DSCAN:
  	case BINARY_SCAN: {
  	    int i;
  	    Tcl_Obj *valuePtr, *elementPtr;
  	    Tcl_HashTable numberCacheHash;
  	    Tcl_HashTable *numberCachePtr;
  
! 	    if ((enum options) index == BINARY_DSCAN) {
! 		if (objc < 4) {
! 		    Tcl_WrongNumArgs(interp, 2, objv,
! 			    "varName formatString ?varName varName ...?");
! 		    return TCL_ERROR;
! 		}
! 		buffer = Tcl_GetByteArrayFromObj(varValuePtr, &length);
! 	    } else {
! 		if (objc < 4) {
! 		    Tcl_WrongNumArgs(interp, 2, objv,
! 			    "value formatString ?varName varName ...?");
! 		    return TCL_ERROR;
! 		}
! 		buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
  	    }
  	    numberCachePtr = &numberCacheHash;
  	    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
  	    format = Tcl_GetString(objv[3]);
  	    cursor = buffer;
  	    arg = 4;
***************
*** 1328,1333 ****
--- 1409,1419 ----
  	     */
  
  	    done:
+ 	    if ((enum options) index == BINARY_DSCAN && arg == objc) {
+                 /* move the offset */
+ 	    	GET_BYTEARRAY(varValuePtr)->offset += offset;
+                 Tcl_SetByteArrayLength(varValuePtr, length-offset);
+ 	    }
  	    Tcl_ResetResult(interp);
  	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
  	    DeleteScanNumberCache(numberCachePtr);
