Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.7
diff -b -c -r1.7 tclBinary.c
*** generic/tclBinary.c	2001/04/04 16:07:20	1.7
--- generic/tclBinary.c	2001/06/04 01:11:50
***************
*** 37,42 ****
--- 37,43 ----
  static int		GetFormatSpec _ANSI_ARGS_((char **formatPtr,
  			    char *cmdPtr, int *countPtr));
  static Tcl_Obj *	ScanNumber _ANSI_ARGS_((unsigned char *buffer, int type));
+ static long		ScanLong _ANSI_ARGS_((unsigned char *buffer, int type));
  static int		SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
  			    Tcl_Obj *objPtr));
  static void		UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
***************
*** 1199,1205 ****
--- 1200,1250 ----
  			    }
  			    valuePtr = ScanNumber(buffer+offset, cmd);
  			    offset += size;
+ #if 1
+ 			} else if ((count == BINARY_ALL)
+ 				&& (cmd != 'd') && (cmd != 'f')) {
+ 			    Tcl_HashTable charReuseTable;
+ 			    Tcl_HashEntry *hPtr;
+ 			    int isNew;
+ 			    long elementVal;
+ 
+ 			    /*
+ 			     * Handle the special case of splitting on every
+ 			     * long value.
+ 			     *
+ 			     * Uses a hash table to ensure that each value has
+ 			     * only one Tcl_Obj instance (multiply-referenced)
+ 			     * in the final list.  This is a *major* win when
+ 			     * splitting on a long bytearray (especially in the
+ 			     * megabyte range!) - DKF/MS
+ 			     */
+ 
+ 			    Tcl_InitHashTable(&charReuseTable,
+ 				    TCL_ONE_WORD_KEYS);
+ 			    count = (length - offset) / size;
+ 			    valuePtr = Tcl_NewObj();
+ 			    src = buffer+offset;
+ 			    for (i = 0; i < count; i++) {
+ 				elementVal = ScanLong(src, cmd);
+ 				hPtr = Tcl_CreateHashEntry(&charReuseTable,
+ 					(char *) elementVal, &isNew);
+ 				if (isNew) {
+ 				    /* Don't need to fiddle with refcount... */
+ 				    elementPtr = Tcl_NewLongObj(elementVal);
+ 				    Tcl_SetHashValue(hPtr,
+ 					    (ClientData) elementPtr);
  				} else {
+ 				    elementPtr =
+ 					(Tcl_Obj*) Tcl_GetHashValue(hPtr);
+ 				}
+ 				src += size;
+ 				Tcl_ListObjAppendElement(NULL, valuePtr,
+ 					elementPtr);
+ 			    }
+ 			    Tcl_DeleteHashTable(&charReuseTable);
+ 			    offset += count*size;
+ #endif
+ 			} else {
  			    if (count == BINARY_ALL) {
  				count = (length - offset) / size;
  			    }
***************
*** 1548,1551 ****
--- 1593,1686 ----
  	}
      }
      return NULL;
+ }
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * ScanNumber --
+  *
+  *	This routine is called by Tcl_BinaryObjCmd to scan a number
+  *	out of a buffer.
+  *
+  * Results:
+  *	Returns a long representing the scanned number.
+  *
+  * Side effects:
+  *	None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ static long
+ ScanLong(buffer, type)
+     unsigned char *buffer;	/* Buffer to scan number from. */
+     int type;			/* Format character from "binary scan" */
+ {
+     long value;
+ 
+     /*
+      * We cannot rely on the compiler to properly sign extend integer values
+      * when we cast from smaller values to larger values because we don't know
+      * the exact size of the integer types.  So, we have to handle sign
+      * extension explicitly by checking the high bit and padding with 1's as
+      * needed.
+      */
+ 
+     switch (type) {
+ 	case 'c': {
+ 	    /*
+ 	     * Characters need special handling.  We want to produce a
+ 	     * signed result, but on some platforms (such as AIX) chars
+ 	     * are unsigned.  To deal with this, check for a value that
+ 	     * should be negative but isn't.
+ 	     */
+ 
+ 	    value = buffer[0];
+ 	    if (value & 0x80) {
+ 		value |= -0x100;
+ 	    }
+ 	    return (long) value;
+ 	}
+ 	case 's': {
+ 	    value = (long) (buffer[0] + (buffer[1] << 8));
+ 	    goto shortValue;
+ 	}
+ 	case 'S': {
+ 	    value = (long) (buffer[1] + (buffer[0] << 8));
+ 	    shortValue:
+ 	    if (value & 0x8000) {
+ 		value |= -0x10000;
+ 	    }
+ 	    return (long) value;
+ 	}
+ 	case 'i': {
+ 	    value = (long) (buffer[0] 
+ 		    + (buffer[1] << 8)
+ 		    + (buffer[2] << 16)
+ 		    + (buffer[3] << 24));
+ 	    goto intValue;
+ 	}
+ 	case 'I': {
+ 	    value = (long) (buffer[3]
+ 		    + (buffer[2] << 8)
+ 		    + (buffer[1] << 16)
+ 		    + (buffer[0] << 24));
+ 	    intValue:
+ 	    /*
+ 	     * Check to see if the value was sign extended properly on
+ 	     * systems where an int is more than 32-bits.
+ 	     */
+ 
+ 	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+ 		value -= (((unsigned int)1)<<31);
+ 		value -= (((unsigned int)1)<<31);
+ 	    }
+ 	    return (long) value;
+ 	}
+ 	default: {
+ 	    panic("binary scan: uncaught bad format string\n");
+ 	    return 0;
+ 	}
+     }
  }
