UninterpretedBytes.st
branchjv
changeset 18120 e3a375d5f6a8
parent 18112 0d7ac9096619
parent 17119 f2e24bf6338d
child 18285 7aab8c3dab19
--- a/UninterpretedBytes.st	Tue Feb 04 21:09:59 2014 +0100
+++ b/UninterpretedBytes.st	Wed Apr 01 10:20:10 2015 +0100
@@ -79,28 +79,28 @@
 "
     UninterpretedBytes provides the common protocol for byte-storage
     containers; concrete subclasses are
-	ByteArray (which store the bytes within the
-		   Smalltalk object memory)
+        ByteArray (which store the bytes within the Smalltalk object memory)
+        String (which is a subclass of ByteArray) knows that the bytes represent characters
     and
-	ExternalBytes (which store the bytes in the malloc-heap).
+        ExternalBytes (which store the bytes in the malloc-heap).
 
     UninterpretedBytes itself is abstract, so no instances of it can be created.
 
     [See also:]
-	ByteArray String ExternalBytes
+        ByteArray String ExternalBytes
 
     [author:]
-	Claus Gittinger
+        Claus Gittinger
 
     [Notice:]
-	Notice the confusion due to multiple methods with the same
-	functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
-	The reason is that at the time this class was written,
-	ST80 sid not offer protocol to specify the byteOrder, and
-	ST/X provided methods ending in 'MSB:' for this.
-	In the meanwhile, VW added protocol ending in 'bigEndian:',
-	which has been added here for compatibility.
-	(certainly a point, where an ansi-standard will help)
+        Notice the confusion due to multiple methods with the same
+        functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
+        The reason is that at the time this class was written,
+        ST80 sid not offer protocol to specify the byteOrder, and
+        ST/X provided methods ending in 'MSB:' for this.
+        In the meanwhile, VW added protocol ending in 'bigEndian:',
+        which has been added here for compatibility.
+        (certainly a point, where an ansi-standard will help)
 "
 ! !
 
@@ -189,8 +189,9 @@
      of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like
      the radix-encoding used in good old PDP11 times ;-)
      ST-80 uses this encoding for Images ...
-     This is very similar (but not equal) to the algorithm used in RFC1421.
-     PS: It took a while to figure that one out ... I dont like it ;-)"
+     This is a base64 encoding, very similar (but not equal) to the algorithm used in RFC1421.
+     PS: It took a while to figure that one out ... 
+     I don't like it ;-)"
 
     |index    "{ Class: SmallInteger }"
      dstIndex "{ Class: SmallInteger }"
@@ -210,47 +211,47 @@
 
     last := aString last codePoint.
     last > 96 ifTrue:[
-	stop := stop - 3 + (last - 96)
+        stop := stop - 3 + (last - 96)
     ].
     bytes := self new:stop.
 
     index := 1. dstIndex := 1.
     [dstIndex <= stop] whileTrue:[
-	"/ take 4 characters ...
-	"/ allow a line break before each group of 4
-	sixBits := (aString at:index) codePoint.
-	[sixBits < 32] whileTrue:[
-	    index := index + 1.
-	    sixBits := (aString at:index) codePoint.
-	].
-	sixBits := sixBits bitAnd:16r3F.
-	n := sixBits.
-
-	"/ self assert:(aString at:index+1) codePoint >= 32.
-	sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
-	n := (n bitShift:6) + sixBits.
-
-	"/ self assert:(aString at:index+2) codePoint >= 32.
-	sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
-	n := (n bitShift:6) + sixBits.
-
-	"/ self assert:(aString at:index+3) codePoint >= 32.
-	sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
-	n := (n bitShift:6) + sixBits.
-
-	index := index + 4.
-
-	"/ now have 24 bits in n
-
-	bytes at:dstIndex put:(n bitShift:-16).
-
-	dstIndex < stop ifTrue:[
-	    bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
-	    dstIndex+2 <= stop ifTrue:[
-		bytes at:dstIndex+2 put:(n bitAnd:16rFF).
-	    ]
-	].
-	dstIndex := dstIndex + 3.
+        "/ take 4 characters ...
+        "/ allow a line break before each group of 4
+        sixBits := (aString at:index) codePoint.
+        [sixBits < 32] whileTrue:[
+            index := index + 1.
+            sixBits := (aString at:index) codePoint.
+        ].
+        sixBits := sixBits bitAnd:16r3F.
+        n := sixBits.
+
+        "/ self assert:(aString at:index+1) codePoint >= 32.
+        sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
+        n := (n bitShift:6) + sixBits.
+
+        "/ self assert:(aString at:index+2) codePoint >= 32.
+        sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
+        n := (n bitShift:6) + sixBits.
+
+        "/ self assert:(aString at:index+3) codePoint >= 32.
+        sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
+        n := (n bitShift:6) + sixBits.
+
+        index := index + 4.
+
+        "/ now have 24 bits in n
+
+        bytes at:dstIndex put:(n bitShift:-16).
+
+        dstIndex < stop ifTrue:[
+            bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
+            dstIndex+2 <= stop ifTrue:[
+                bytes at:dstIndex+2 put:(n bitAnd:16rFF).
+            ]
+        ].
+        dstIndex := dstIndex + 3.
     ].
     ^ bytes
 
@@ -345,7 +346,6 @@
     "Modified: / 5.3.1998 / 14:56:22 / stefan"
 ! !
 
-
 !UninterpretedBytes methodsFor:'Compatibility-Squeak'!
 
 copyFromByteArray:aByteArray
@@ -426,6 +426,36 @@
     "
 ! !
 
+!UninterpretedBytes methodsFor:'accessing-arbitrary-long ints'!
+
+unsignedIntegerAt:index length:n bigEndian:bigEndian
+    "return the n-byte unsigned integer starting at index.
+     With n=1, this returns the single byte's value,
+     n=2, an unsigned short, n=4 an unsigned int etc.
+     Useful to extract arbitrary long integers"
+
+    |val|
+
+    val := 0.
+    bigEndian ifTrue:[ 
+        index to:index+n-1 do:[:i |
+            val := (val<<8) + (self at:i)
+        ]
+    ] ifFalse:[ 
+        index+n-1 to:index by:-1 do:[:i |
+            val := (val<<8) + (self at:i)
+        ]
+    ].
+    ^ val
+
+    "
+     |b|
+     b := #[ 16r01 16r02 16r03 16r04 16r05 ].
+     (b unsignedIntegerAt:2 length:4 bigEndian:false).        
+     (b unsignedIntegerAt:2 length:4 bigEndian:true).    
+    "
+! !
+
 !UninterpretedBytes methodsFor:'accessing-bytes'!
 
 bcdByteAt:index
@@ -601,35 +631,45 @@
 
     |flt|
 
-    flt := aFloat asFloat.
 %{
     /*
      * handle the most common cases fast ...
      */
-    if (__isSmallInteger(index) && __isFloat(flt)) {
-	unsigned char *cp;
-	INT sz;
-
-	__fetchBytePointerAndSize__(self, &cp, &sz);
-	if (cp) {
-	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
-	    if ((idx+(sizeof(double)-1)) < sz) {
-		cp += idx;
-		/*
-		 * aligned
-		 */
-		if (((INT)cp & (sizeof(double)-1)) == 0) {
-		    ((double *)cp)[0] = __floatVal(flt);
-		    RETURN (aFloat);
-		}
-	    }
-	}
+    if (__isSmallInteger(index)) {
+        unsigned char *cp;
+        INT sz;
+
+        __fetchBytePointerAndSize__(self, &cp, &sz);
+        if (cp) {
+            unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+
+            if ((idx+(sizeof(double)-1)) < sz) {
+                cp += idx;
+                /*
+                 * aligned
+                 */
+                if (((INT)cp & (sizeof(double)-1)) == 0) {
+                    if (__isFloat(aFloat)) {
+                        ((double *)cp)[0] = __floatVal(aFloat);
+                        RETURN (aFloat);
+                    }
+                    if (__isShortFloat(aFloat)) {
+                        ((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
+                        RETURN (aFloat);
+                    }
+                    if (__isSmallInteger(aFloat)) {
+                        ((double *)cp)[0] = (double)(__intVal(aFloat));
+                        RETURN (aFloat);
+                    }
+                }
+            }
+        }
     }
 %}.
 
+    flt := aFloat asFloat.
     1 to:8 do:[:srcIndex|
-	self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)
+        self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)
     ].
     ^ aFloat
 !
@@ -744,38 +784,47 @@
 
     |sflt|
 
-    sflt := aFloat asShortFloat.
 %{
     /*
      * handle the most common cases fast ...
      */
-    if (__isSmallInteger(index) && __isShortFloat(sflt)) {
-	unsigned char *cp;
-	INT sz;
-
-	__fetchBytePointerAndSize__(self, &cp, &sz);
-	if (cp) {
-	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
-	    if ((idx+(sizeof(float)-1)) < sz) {
-		cp += idx;
-		/*
-		 * aligned
-		 */
-		if (((INT)cp & (sizeof(float)-1)) == 0) {
-		    ((float *)cp)[0] = __shortFloatVal(sflt);
-
-		    RETURN (aFloat);
-		}
-	    }
-	}
+    if (__isSmallInteger(index)) {
+        unsigned char *cp;
+        INT sz;
+
+        __fetchBytePointerAndSize__(self, &cp, &sz);
+        if (cp) {
+            unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+
+            if ((idx+(sizeof(float)-1)) < sz) {
+                cp += idx;
+                /*
+                 * aligned
+                 */
+                if (((INT)cp & (sizeof(float)-1)) == 0) {
+                    if (__isShortFloat(aFloat)) {
+                        ((float *)cp)[0] = __shortFloatVal(aFloat);
+                        RETURN (self);
+                    }
+                    if (__isFloat(aFloat)) {
+                        ((float *)cp)[0] = (float)__floatVal(aFloat);
+                        RETURN (self);
+                    }
+                    if (__isSmallInteger(aFloat)) {
+                        ((float *)cp)[0] = (float)__intVal(aFloat);
+                        RETURN (self);
+                    }
+                    // bail out to smalltalk code
+                }
+            }
+        }
     }
 %}.
 
+    sflt := aFloat asShortFloat.
     1 to:4 do:[:srcIndex|
-	self at:index - 1 + srcIndex put:(sflt basicAt:srcIndex)
+        self at:index - 1 + srcIndex put:(sflt basicAt:srcIndex)
     ].
-    ^ aFloat
 !
 
 floatAt:index put:aFloat MSB:msb
@@ -790,14 +839,14 @@
     |sflt|
 
     msb == UninterpretedBytes isBigEndian ifTrue:[
-	^ self floatAt:index put:aFloat
+        self floatAt:index put:aFloat.
+        ^ self.
     ].
 
     sflt := aFloat asShortFloat.
     1 to:4 do:[:srcIndex|
-	self at:index - 1 + srcIndex put:(sflt basicAt:(5-srcIndex))
+        self at:index - 1 + srcIndex put:(sflt basicAt:(5-srcIndex))
     ].
-    ^ aFloat
 
     "Created: / 15.5.1998 / 17:20:41 / cg"
 !
@@ -878,7 +927,7 @@
     "
     ShortFloat isIEEEFormat ifFalse:[self error:'unsupported operation'].
 
-    ^ self floatAt:index put:aFloat
+    self floatAt:index put:aFloat
 
     "Created: / 5.3.1998 / 10:51:11 / stefan"
 ! !
@@ -3016,6 +3065,7 @@
 !UninterpretedBytes methodsFor:'visiting'!
 
 acceptVisitor:aVisitor with:aParameter
+    "dispatch for visitor pattern; send #visitByteArray:with: to aVisitor."
 
     ^ aVisitor visitByteArray:self with:aParameter
 ! !
@@ -3023,10 +3073,10 @@
 !UninterpretedBytes class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.95 2013-12-01 12:23:49 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.100 2014-11-26 08:38:03 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.95 2013-12-01 12:23:49 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.100 2014-11-26 08:38:03 cg Exp $'
 ! !