"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

ArrayedCollection subclass:#UninterpretedBytes

	instanceVariableNames:''

	classVariableNames:'IsBigEndian'

	poolDictionaries:''

	category:'Collections-Abstract'

!

!UninterpretedBytes primitiveDefinitions!

%{

/*

 * Notice: I am abstract, and my subclasses may be anything.

 * Therefore, the code must always handle the fallback case

 * where the receiver is neither an ExternalBytes nor a ByteArray.

 * (which are, however, the most common)

 *

 * macro to fetch my byte address and size-in-bytes;

 * convenient for inline-C code.

 * (yes, C is bad ...)

 */

#define __fetchBytePointerAndSize__(o, pPtr, pSize) \

    {\

      if (__isNonNilObject(o)) { \

	if (__qClass(o) == ByteArray) { \

	  *(pPtr) = (unsigned char *)__ByteArrayInstPtr(o)->ba_element; \

	  *(pSize) = __byteArraySize(o); \

	} else if (__qClass(o) == ExternalBytes) { \

	  OBJ __sz__ = __externalBytesSize(o); \

	  if (__isSmallInteger(__sz__)) { \

	    *(pSize) = __intVal(__sz__); \

	    *(pPtr) = (unsigned char *)(__externalBytesAddress(o)); \

	  } else { \

	    *(pPtr) = (unsigned char *)0; \

	  } \

	} else { \

	    *(pPtr) = (unsigned char *)0; \

	} \

      } else { \

	*(pPtr) = (unsigned char *)0; \

      } \

    }

%}

! !

!UninterpretedBytes class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    UninterpretedBytes provides the common protocol for byte-storage 

    containers; concrete subclasses are 

	ByteArray (which store the bytes within the

		   Smalltalk object memory) 

    and 

	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

    [author:]

	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)

"

! !

!UninterpretedBytes class methodsFor:'instance creation'!

from:aByteArray

    "return new instance which is a copy of aByteArray"

    |len bytes|

    len := aByteArray size.

    bytes := self new:len.

    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:1.

    ^ bytes

    "

      String from:#[40 41 42]

      String with:#[40 41 42 43 44 45 46 47 48 49 50] from:2 to:5

    "

!

fromHexString:aString

    "Dolphin compatibility:

     decode a byteArray from a hex string (as generated by hexPrintOn:)"

    |sz       "{ Class: SmallInteger }"

     chars s bytes|

    sz := aString size.

    sz == 0 ifTrue:[^ self new].

    sz odd ifTrue:[self error:'invalid hex string (odd size)'.].

    bytes := self new:(sz // 2).

    s := aString readStream.

    1 to:sz // 2 do:[:idx |

        chars := s next:2.

        bytes at:idx put:(Integer readFrom:chars radix:16).

    ].

    ^ bytes

    "

     ByteArray fromHexString:'1234FEFF'

     ExternalBytes fromHexString:'1234FEFF'

    "

    "

     |s|

     s := String streamContents:[:s | #[1 2 3] hexPrintOn:s].

     ByteArray fromHexString:s

    "

    "Modified: / 6.3.1997 / 15:28:52 / cg"

!

fromPackedString:aString

    "ST-80 compatibility: decode a byteArray from a packed string in which

     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 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 ;-)"

    |index    "{ Class: SmallInteger }"

     dstIndex "{ Class: SmallInteger }"

     stop     "{ Class: SmallInteger }"

     sixBits  "{ Class: SmallInteger }"

     n        "{ Class: SmallInteger }"

     sz       "{ Class: SmallInteger }"

     lastCharacter bytes|

    sz := aString size.

    sz == 0 ifTrue:[^ self new].

    sz := sz - (aString occurrencesOf:Character linefeed).

    sz := sz - (aString occurrencesOf:Character return).

    sz := sz - (aString occurrencesOf:Character tab).

    stop := sz // 4 * 3.

    "the size modulo 3 is encoded in the last character, if its in the

     range 97 .. otherwise, its exact."

    lastCharacter := aString last.

    lastCharacter codePoint > 96 ifTrue:[

        stop := stop - 3 + lastCharacter codePoint - 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.

        sixBits := (aString at:index+1) codePoint.

        sixBits := sixBits bitAnd:16r3F.

        n := (n bitShift:6) + sixBits.

        sixBits := (aString at:index+2) codePoint.

        sixBits := sixBits bitAnd:16r3F.

        n := (n bitShift:6) + sixBits.

        sixBits := (aString at:index+3) codePoint.

        sixBits := sixBits 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

    "

     ByteArray fromPackedString:(#[1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString)

    "

    "Modified: / 6.3.1997 / 15:28:52 / cg"

    "Modified: / 18.12.1997 / 17:17:11 / stefan"

!

with:aByteArray from:start to:stop

    "return new instance with a copy of aByteArray

     beginning at index start up to and including index stop"

    |len bytes|

    len := stop-start+1.

    bytes := self new:len.

    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:start.

    ^ bytes

    "

      String with:#[40 41 42 43 44 45 46 47 48 49 50] from:2 to:5

    "

! !

!UninterpretedBytes class methodsFor:'queries'!

isAbstract

    "Return if this class is an abstract class.

     True is returned for UninterpretedBytes here; false for subclasses.

     Abstract subclasses must redefine again."

    ^ self == UninterpretedBytes

!

isBigEndian

    "return true, if words/shorts store the most-significant

     byte first (MSB), false if least-sign.-first (LSB). 

     I.e. false for vax, intel; true for m68k, sun.

     Notice: UninterpretedBytes isBigEndian

	     this is inlined both by stc and the jit compiler"

%{  /* NOCONTEXT */

#if defined(__MSBFIRST__)

    RETURN (true);

#else

# if defined(__LSBFIRST__)

    RETURN (false);

# else

    /*

     * I dont like ifdefs - you always forget some ...

     * therefore we look into a structure at run-time.

     * (also, there are CPUs around [mips], where the byteorder

     *  is programmable, and which come in different flavours)

     *

     * NOTICE: 

     *    both the JIT and stc may inline this to a 

     *    constant for systems where this is known.

     */

    union {

	unsigned int   u_l;

	char           u_c[sizeof(int)];

    } u;

    u.u_l = 0x87654321;

    if (u.u_c[0] == 0x21) RETURN (false);

    RETURN (true);

# endif

#endif

%}

    "

     UninterpretedBytes isBigEndian

    "

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned, since UninterpretedBytes is the superclass of

     some builtIn classes (ByteArray & ExternalBytes)"

    ^ self == UninterpretedBytes

    "Modified: / 23.4.1996 / 15:56:25 / cg"

    "Modified: / 5.3.1998 / 14:56:22 / stefan"

! !

!UninterpretedBytes methodsFor:'Compatibility-V''Age'!

uint32At:zeroBasedIndex

    "return the 4-bytes starting at index as (unsigned) Integer.

     The index is a C index (i.e. 0-based).

     The value is retrieved in the machines natural byte order.

     Similar to unsignedLongAt:, except for the index base"

    ^ self unsignedLongAt:zeroBasedIndex+1

    "

     |b|

     b := ByteArray withAll:#(0 0 0 0).

     b uint32At:0 put:16r12345678.

     b uint32At:0.

     b

    "

!

uint32At:zeroBasedIndex put:anInteger

    "set the 4-bytes starting at index to the value given by (unsigned) Integer.

     The index is a C index (i.e. 0-based).

     The value is stored in the machines natural byte order.

     Similar to unsignedLongAt:put:, except for the index base"

    ^ self unsignedLongAt:zeroBasedIndex+1 put:anInteger

    "

     |b|

     b := ByteArray withAll:#(0 0 0 0).

     b uint32At:0 put:16r12345678.

     b

    "

! !

!UninterpretedBytes methodsFor:'accessing-bytes'!

bcdByteAt:index

    "return the bcd-value for a byte at index."

    ^ (self byteAt:index) decodeFromBCD

    "

     #[ 16r55 ] bcdByteAt:1   

     #[ 16r99] bcdByteAt:1    

     #[ 16rAA] bcdByteAt:1   

    "

!

bcdByteAt:index put:aNumber

    "set the byte at index as bcd-value."

    (aNumber between:0 and:99) ifFalse:[

        self error:'invalid value for BCD encoding'

    ].

    ^ self byteAt:index put:aNumber encodeAsBCD

    "

     (((ByteArray new:1) bcdByteAt:1 put:55; yourself) at:1) hexPrintString  

     (((ByteArray new:1) bcdByteAt:1 put:99; yourself) at:1) hexPrintString        

     (((ByteArray new:1) bcdByteAt:1 put:100; yourself) at:1) hexPrintString       

     (((ByteArray new:1) bcdByteAt:1 put:-1; yourself) at:1) hexPrintString       

    "

!

signedByteAt:index

    "return the byte at index as a signed 8 bit value.

     The index is a smalltalk index (i.e. 1-based).

     This may be worth a primitive."

    ^ (self at:index) signExtendedByteValue

    "

     |b|

     b := ByteArray new:2.

     b at:1 put:16rFF.

     b at:2 put:16r7F.

     b signedByteAt:1  

    "

    "Modified: 1.7.1996 / 21:13:53 / cg"

!

signedByteAt:index put:aSignedByteValue

    "return the byte at index as a signed 8 bit value.

     The index is a smalltalk index (i.e. 1-based).

     Return the signedByteValue argument.

     This may be worth a primitive."

    |b "{ Class: SmallInteger }"|

    aSignedByteValue >= 0 ifTrue:[

	b := aSignedByteValue

    ] ifFalse:[

	b := 16r100 + aSignedByteValue

    ].

    self at:index put:b.

    ^ aSignedByteValue

    "

     |b|

     b := ByteArray new:2.

     b signedByteAt:1 put:-1.

     b at:1   

    "

    "Modified: 1.7.1996 / 21:12:37 / cg"

! !

!UninterpretedBytes methodsFor:'accessing-floats & doubles'!

doubleAt:index

    "return the 8-bytes starting at index as a Float.

     The index is a smalltalk index (i.e. 1-based).

     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.

     Notice also, that the bytes are expected to be in this machines

     float representation - if the bytearray originated from another

     machine, some conversion is usually needed."

    |newFloat|

%{

    /*

     * handle the most common cases fast ...

     */

    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) {

		    double dVal = ((double *)cp)[0];

		    OBJ f;

		    __qMKFLOAT(f, dVal);

		    RETURN (f);

		}

	    }

	}

    }

%}.

    newFloat := Float basicNew.

    1 to:8 do:[:destIndex|

	newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)

    ].

    ^ newFloat.

    "

     |b|

     b := ByteArray new:20.

     b doubleAt:1 put:(Float pi).

     Transcript showCR:b.

     Transcript showCR:(b doubleAt:1)

    "

!

doubleAt:index MSB:msb

    "return the 8-bytes starting at index as a Float.

     The index is a smalltalk index (i.e. 1-based).

     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.

     Notice also, that the bytes are expected to be in this machines

     float representation - if the bytearray originated from another