hg/stx-libbasic: comparison UninterpretedBytes.st

equal deleted inserted replaced

-:1af2ba83c4de
+:c73f81214ed9
 documentation
 "
 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
+	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
+	Notice the confusion due to multiple methods with the same
-functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
+	functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
-The reason is that at the time this class was written,
+	The reason is that at the time this class was written,
-ST80 sid not offer protocol to specify the byteOrder, and
+	ST80 sid not offer protocol to specify the byteOrder, and
-ST/X provided methods ending in 'MSB:' for this.
+	ST/X provided methods ending in 'MSB:' for this.
-In the meanwhile, VW added protocol ending in 'bigEndian:',
+	In the meanwhile, VW added protocol ending in 'bigEndian:',
-which has been added here for compatibility.
+	which has been added here for compatibility.
-(certainly a point, where an ansi-standard will help)
+	(certainly a point, where an ansi-standard will help)
 "
 ! !
 !UninterpretedBytes class methodsFor:'initialization'!
 sz odd ifTrue:[ ConversionError raiseWith:aString errorString:'invalid hex string (odd size)' ].
 bytes := self new: sz // 2.
 s := aString readStream.
 1 to: sz // 2 do: [ :idx |
-hi := s next digitValue.
+	hi := s next digitValue.
-lo := s next digitValue.
+	lo := s next digitValue.
-bytes at:idx put: ((hi bitShift:4) bitOr: lo)
+	bytes at:idx put: ((hi bitShift:4) bitOr: lo)
 ].
 ^ bytes
 "
 ByteArray fromHexString:'1234FEFF'
 s := String streamContents:[:s | #[1 2 3] hexPrintOn:s].
 ByteArray fromHexString:s
 "
 "
 Time millisecondsToRun:[
-1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
+	1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
 ].
 "
 "Modified (comment): / 28-08-2013 / 20:40:04 / cg"
 !
 6bits are encoded per character. The argument, aString must be a multiple
 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 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 }"
 stop     "{ Class: SmallInteger }"
 "the size modulo 3 is encoded in the last character, if it is in the
 range 97 .. otherwise, its exact."
 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 ...
+	"/ take 4 characters ...
-"/ allow a line break before each group of 4
+	"/ allow a line break before each group of 4
-sixBits := (aString at:index) codePoint.
+	sixBits := (aString at:index) codePoint.
-[sixBits < 32] whileTrue:[
+	[sixBits < 32] whileTrue:[
-index := index + 1.
+	    index := index + 1.
-sixBits := (aString at:index) codePoint.
+	    sixBits := (aString at:index) codePoint.
-].
+	].
-sixBits := sixBits bitAnd:16r3F.
+	sixBits := sixBits bitAnd:16r3F.
-n := sixBits.
+	n := sixBits.
-"/ self assert:(aString at:index+1) codePoint >= 32.
+	"/ self assert:(aString at:index+1) codePoint >= 32.
-sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
+	sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
-n := (n bitShift:6) + sixBits.
+	n := (n bitShift:6) + sixBits.
-"/ self assert:(aString at:index+2) codePoint >= 32.
+	"/ self assert:(aString at:index+2) codePoint >= 32.
-sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
+	sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
-n := (n bitShift:6) + sixBits.
+	n := (n bitShift:6) + sixBits.
-"/ self assert:(aString at:index+3) codePoint >= 32.
+	"/ self assert:(aString at:index+3) codePoint >= 32.
-sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
+	sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
-n := (n bitShift:6) + sixBits.
+	n := (n bitShift:6) + sixBits.
-index := index + 4.
+	index := index + 4.
-"/ now have 24 bits in n
+	"/ now have 24 bits in n
-bytes at:dstIndex put:(n bitShift:-16).
+	bytes at:dstIndex put:(n bitShift:-16).
-dstIndex < stop ifTrue:[
+	dstIndex < stop ifTrue:[
-bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
+	    bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
-dstIndex+2 <= stop ifTrue:[
+	    dstIndex+2 <= stop ifTrue:[
-bytes at:dstIndex+2 put:(n bitAnd:16rFF).
+		bytes at:dstIndex+2 put:(n bitAnd:16rFF).
-]
+	    ]
-].
+	].
-dstIndex := dstIndex + 3.
+	dstIndex := dstIndex + 3.
 ].
 ^ bytes
 "
 ByteArray fromPackedString:(#[1 1 1 1] asPackedString)
 OBJ newobj;
 INT instsize, nInstVars, nindexedinstvars;
 REGISTER OBJ *op;
 if (__isSmallInteger(anInteger)) {
-nindexedinstvars = __intVal(anInteger);
+	nindexedinstvars = __intVal(anInteger);
-if (nindexedinstvars >= 0) {
+	if (nindexedinstvars >= 0) {
-if (self == ByteArray) {
+	    if (self == ByteArray) {
-/*
+		/*
-* the most common case
+		 * the most common case
-*/
+		 */
-instsize = OHDR_SIZE + nindexedinstvars;
+		instsize = OHDR_SIZE + nindexedinstvars;
-if (__CanDoQuickNew(instsize)) {        /* OBJECT ALLOCATION */
+		if (__CanDoQuickNew(instsize)) {        /* OBJECT ALLOCATION */
-__qCheckedNew(newobj, instsize);
+		    __qCheckedNew(newobj, instsize);
-__InstPtr(newobj)->o_class = self;
+		    __InstPtr(newobj)->o_class = self;
-__qSTORE(newobj, self);
+		    __qSTORE(newobj, self);
-RETURN (newobj );
+		    RETURN (newobj );
-}
+		}
-} else {
+	    } else {
-/*
+		/*
-* Take care for subclasses like TwoByteString
+		 * Take care for subclasses like TwoByteString
-*/
+		 */
-switch (__smallIntegerVal(__ClassInstPtr(self)->c_flags) & ARRAYMASK) {
+		switch (__smallIntegerVal(__ClassInstPtr(self)->c_flags) & ARRAYMASK) {
-case BYTEARRAY:
+		case BYTEARRAY:
-break;
+		    break;
-case WORDARRAY:
+		case WORDARRAY:
-case SWORDARRAY:
+		case SWORDARRAY:
-nindexedinstvars *= 2;
+		    nindexedinstvars *= 2;
-break;
+		    break;
-case LONGARRAY:
+		case LONGARRAY:
-case SLONGARRAY:
+		case SLONGARRAY:
-nindexedinstvars *= 4;
+		    nindexedinstvars *= 4;
-break;
+		    break;
-default:
+		default:
-/* don't know about this array type, delegate to super */
+		    /* don't know about this array type, delegate to super */
-goto out;
+		    goto out;
-}
+		}
-}
+	    }
-nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
+	    nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
-instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
+	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
-__PROTECT_CONTEXT__
+	    __PROTECT_CONTEXT__
-__qNew(newobj, instsize);   /* OBJECT ALLOCATION */
+	    __qNew(newobj, instsize);   /* OBJECT ALLOCATION */
-__UNPROTECT_CONTEXT__
+	    __UNPROTECT_CONTEXT__
-if (newobj != nil) {
+	    if (newobj != nil) {
-__InstPtr(newobj)->o_class = self;
+		__InstPtr(newobj)->o_class = self;
-__qSTORE(newobj, self);
+		__qSTORE(newobj, self);
-if (nInstVars) {
+		if (nInstVars) {
-/*
+		    /*
-* still have to nil out named instvars ...
+		     * still have to nil out named instvars ...
-*/
+		     */
 #if defined(memset4) && defined(FAST_OBJECT_MEMSET4)
-memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+		    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
 #else
 # if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)
-/*
+		    /*
-* knowing that nil is 0
+		     * knowing that nil is 0
-*/
+		     */
-memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
 # else
-op = __InstPtr(newobj)->i_instvars;
+		    op = __InstPtr(newobj)->i_instvars;
-while (nInstVars--)
+		    while (nInstVars--)
-*op++ = nil;
+			*op++ = nil;
 # endif
 #endif
-}
+		}
-RETURN ( newobj );
+		RETURN ( newobj );
-}
+	    }
-}
+	}
 }
 out:;
 %}.
 ^ self basicNew:anInteger
 !
 u.u_l = 0x87654321;
 if (u.u_c[0] == 0x21) RETURN (false);
 RETURN (true);
 # endif
 #endif
-%}
+%}.
+^ false     "/ an arbitrary default
 "
 UninterpretedBytes isBigEndian
 "
 !
 Useful to extract arbitrary long integers"
 |val|
 val := 0.
 bigEndian ifTrue:[
-index to:index+n-1 do:[:i |
+	index to:index+n-1 do:[:i |
-val := (val<<8) + (self at:i)
+	    val := (val<<8) + (self at:i)
-]
+	]
 ] ifFalse:[
-index+n-1 to:index by:-1 do:[:i |
+	index+n-1 to:index by:-1 do:[:i |
-val := (val<<8) + (self at: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'!
 machine, some conversion is usually needed."
 |newFloat|
 msb == IsBigEndian ifTrue:[
-^ self doubleAt:index.
+	^ self doubleAt:index.
 ].
 newFloat := Float basicNew.
 1 to:8 do:[:destIndex|
-newFloat basicAt:(9-destIndex) put:(self at:index - 1 + destIndex)
+	newFloat basicAt:(9-destIndex) put:(self at:index - 1 + destIndex)
 ].
 ^ newFloat.
 "Created: / 15.5.1998 / 17:21:45 / cg"
 !
 %{
 /*
 * handle the most common cases fast ...
 */
 if (__isSmallInteger(index)) {
-unsigned char *cp;
+	unsigned char *cp;
-INT sz;
+	INT sz;
-__fetchBytePointerAndSize__(self, &cp, &sz);
+	__fetchBytePointerAndSize__(self, &cp, &sz);
-if (cp) {
+	if (cp) {
-unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-if ((idx+(sizeof(double)-1)) < sz) {
+	    if ((idx+(sizeof(double)-1)) < sz) {
-cp += idx;
+		cp += idx;
-/*
+		/*
-* aligned
+		 * aligned
-*/
+		 */
-if (((INT)cp & (sizeof(double)-1)) == 0) {
+		if (((INT)cp & (sizeof(double)-1)) == 0) {
-if (__isFloat(aFloat)) {
+		    if (__isFloat(aFloat)) {
-((double *)cp)[0] = __floatVal(aFloat);
+			((double *)cp)[0] = __floatVal(aFloat);
-RETURN (aFloat);
+			RETURN (aFloat);
-}
+		    }
-if (__isShortFloat(aFloat)) {
+		    if (__isShortFloat(aFloat)) {
-((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
+			((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
-RETURN (aFloat);
+			RETURN (aFloat);
-}
+		    }
-if (__isSmallInteger(aFloat)) {
+		    if (__isSmallInteger(aFloat)) {
-((double *)cp)[0] = (double)(__intVal(aFloat));
+			((double *)cp)[0] = (double)(__intVal(aFloat));
-RETURN (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
 !
 doubleAt:index put:aFloat MSB:msb
 machine, some conversion is usually needed."
 |flt|
 msb == IsBigEndian ifTrue:[
-^ self doubleAt:index put:aFloat.
+	^ self doubleAt:index put:aFloat.
 ].
 flt := aFloat asFloat.
 1 to:8 do:[:srcIndex|
-self at:index - 1 + srcIndex put:(flt basicAt:(9-srcIndex))
+	self at:index - 1 + srcIndex put:(flt basicAt:(9-srcIndex))
 ].
 ^ aFloat
 "Created: / 15.5.1998 / 17:22:27 / cg"
 "Modified: / 15.5.1998 / 17:26:29 / cg"
 machine, some conversion is usually needed."
 |newFloat|
 msb == IsBigEndian ifTrue:[
-^ self floatAt:index
+	^ self floatAt:index
 ].
 newFloat := ShortFloat basicNew.
 1 to:4 do:[:destIndex|
-newFloat basicAt:(5-destIndex) put:(self at:index - 1 + destIndex)
+	newFloat basicAt:(5-destIndex) put:(self at:index - 1 + destIndex)
 ].
 ^ newFloat.
 "Modified: / 15.5.1998 / 17:20:19 / cg"
 "Created: / 15.5.1998 / 17:20:35 / cg"
 %{
 /*
 * handle the most common cases fast ...
 */
 if (__isSmallInteger(index)) {
-unsigned char *cp;
+	unsigned char *cp;
-INT sz;
+	INT sz;
-__fetchBytePointerAndSize__(self, &cp, &sz);
+	__fetchBytePointerAndSize__(self, &cp, &sz);
-if (cp) {
+	if (cp) {
-unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-if ((idx+(sizeof(float)-1)) < sz) {
+	    if ((idx+(sizeof(float)-1)) < sz) {
-cp += idx;
+		cp += idx;
-/*
+		/*
-* aligned
+		 * aligned
-*/
+		 */
-if (((INT)cp & (sizeof(float)-1)) == 0) {
+		if (((INT)cp & (sizeof(float)-1)) == 0) {
-if (__isShortFloat(aFloat)) {
+		    if (__isShortFloat(aFloat)) {
-((float *)cp)[0] = __shortFloatVal(aFloat);
+			((float *)cp)[0] = __shortFloatVal(aFloat);
-RETURN (self);
+			RETURN (self);
-}
+		    }
-if (__isFloat(aFloat)) {
+		    if (__isFloat(aFloat)) {
-((float *)cp)[0] = (float)__floatVal(aFloat);
+			((float *)cp)[0] = (float)__floatVal(aFloat);
-RETURN (self);
+			RETURN (self);
-}
+		    }
-if (__isSmallInteger(aFloat)) {
+		    if (__isSmallInteger(aFloat)) {
-((float *)cp)[0] = (float)__intVal(aFloat);
+			((float *)cp)[0] = (float)__intVal(aFloat);
-RETURN (self);
+			RETURN (self);
-}
+		    }
-// bail out to smalltalk code
+		    // 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)
 ].
 !
 floatAt:index put:aFloat MSB:msb
 "store the 4 bytes of value of the argument, aFloat into the receiver
 machine, some conversion is usually needed."
 |sflt|
 msb == IsBigEndian ifTrue:[
-self floatAt:index put:aFloat.
+	self floatAt:index put:aFloat.
-^ self.
+	^ 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))
 ].
 "Created: / 15.5.1998 / 17:20:41 / cg"
 !
 |w|
 w := self unsignedLongLongAt:index bigEndian:IsBigEndian.
 (w > (16r7FFFFFFFFFFFFFFF)) ifTrue:[
-^ w - (16r10000000000000000)
+	^ w - (16r10000000000000000)
 ].
 ^ w
 "
 |b|
 |v|
 value >= 0 ifTrue:[
-v := value
+	v := value
 ] ifFalse:[
-v := 16r10000 + value
+	v := 16r10000 + value
 ].
 self unsignedShortAt:index put:v bigEndian:IsBigEndian.
 ^ value
 "
 ! !
 !UninterpretedBytes class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.101 2015-04-24 12:17:11 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.101 2015-04-24 12:17:11 stefan Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
 ! !
 UninterpretedBytes initialize!

changeset 18346	c73f81214ed9
parent 18284	7887131009f5
child 18366	a6e62e167c32
child 18600	35de4089788f