"

 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:aCollection

    ^ ByteArray from:aCollection

    "Created: / 3.4.1998 / 13:29:50 / cg"

    "Modified: / 3.4.1998 / 13:30:12 / cg"

! !

!UninterpretedBytes class methodsFor:'queries'!

isAbstract

    ^ 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:'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       

    "

!

byteAt:index

    "return the byte at index. 

     For ByteArray, this is the same as basicAt:; 

     however, for strings or symbols, this returns a numeric byteValue

     instead of a character."

    ^ self subclassResponsibility

!

byteAt:index put:value

    "set the byte at index. For ByteArray, this is the same as basicAt:put:.

     However, for Strings, this expects a byteValue to be stored."

    ^ self subclassResponsibility

!

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

     machine, some conversion is usually needed."

    |newFloat|

    msb == UninterpretedBytes isBigEndian ifTrue:[

	^ self doubleAt:index.

    ].

    newFloat := Float basicNew.

    1 to:8 do:[:destIndex|

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

    ].

    ^ newFloat.

    "Created: / 15.5.1998 / 17:21:45 / cg"

!

doubleAt:index put:aFloat

    "store the value of the argument, aFloat into the receiver

     starting at index.

     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."

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

		}

	    }

	}

    }

%}.

    1 to:8 do:[:srcIndex|

	self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)

    ].

    ^ aFloat

!

doubleAt:index put:aFloat MSB:msb

    "store the value of the argument, aFloat into the receiver

     starting at index.

     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."

    |flt|

    msb == UninterpretedBytes isBigEndian ifTrue:[

	^ self doubleAt:index put:aFloat.

    ].

    flt := aFloat asFloat.

    1 to:8 do:[: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"

!

floatAt:index

    "return the 4-bytes starting at index as a ShortFloat.

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

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

     therefore this method reads a 4-byte float from the byteArray and returns

     a float object which keeps an 8-byte double internally.

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

     float representation and order - 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(float)-1)) < sz) {

		cp += idx;

		/*

		 * aligned

		 */

		if (((INT)cp & (sizeof(float)-1)) == 0) {

		    float fVal = ((float *)cp)[0];

		    OBJ f;

		    __qMKSFLOAT(f, fVal);

		    RETURN (f);

		}

	    }

	}

    }

%}.

    newFloat := ShortFloat basicNew.

    1 to:4 do:[:destIndex|

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

    ].

    ^ newFloat.

!

floatAt:index MSB:msb

    "return the 4-bytes starting at index as a ShortFloat.

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

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

     therefore this method reads a 4-byte float from the byteArray and returns

     a float object which keeps an 8-byte double internally.

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

     float representation and order - if the bytearray originated from another

     machine, some conversion is usually needed."

    |newFloat|

    msb == UninterpretedBytes isBigEndian ifTrue:[

	^ self floatAt:index

    ].

    newFloat := ShortFloat basicNew.

    1 to:4 do:[: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"

!

floatAt:index put:aFloat

    "store the 4 bytes of value of the argument, aFloat into the receiver

     starting at index.

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