"

 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.

"

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) = (char *)__ByteArrayInstPtr(o)->ba_element; \

	  *(pSize) = __byteArraySize(o); \

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

	  OBJ __sz__ = __externalBytesSize(o); \

	  if (__isSmallInteger(__sz__)) { \

	    *(pSize) = __intVal(__sz__); \

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

	  } else { \

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

	  } \

	} else { \

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

	} \

      } else { \

	*(pPtr) = (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:'initialization'!

checkByteOrder

    "initialize our current byteOrder.

     Must be called at system init time and on snapshot restart"

    IsBigEndian := self isBigEndian.

    "Created: / 5.3.1998 / 14:51:41 / stefan"

!

initialize

    "get the byte order"

    self checkByteOrder.

    "want to be informed when returning from snapshot"

    ObjectMemory dependents addDependent:self

    "Created: / 5.3.1998 / 14:46:31 / stefan"

    "Modified: / 5.3.1998 / 14:53:28 / stefan"

!

update:something with:aParameter from:changedObject

    "handle image restarts and reget the byte order"

    (something == #returnFromSnapshot) ifTrue:[

        self checkByteOrder.

    ]

    "Created: / 5.3.1998 / 14:55:13 / stefan"

! !

!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'!

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

%{  /* NOCONTEXT */

    /*

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

%}

    "

     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'!

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

!

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

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

        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

!

doubleWordAt:index

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

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

     The value is retrieved in the machines natural byte order.

     Subclasses may redefine this for better performance.

     OBSOLETE: please use longAt: / unsignedLongAt:"

%{

    /*

     * handle the most common cases fast ...

     */

    if (__isSmallInteger(index)) {

        char *cp;

        int sz;

        __fetchBytePointerAndSize__(self, &cp, &sz);

        if (cp) {

            unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

            if ((idx+(sizeof(int)-1)) < sz) {

                cp += idx;

                /*

                 * aligned

                 */

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

                    int iVal = ((int *)cp)[0];

                    RETURN (__MKUINT(iVal));

                }

            }

        }

    }

%}.

    ^ self doubleWordAt:index MSB:IsBigEndian

    "

     |b|

     b := ByteArray withAll:#(1 2 3 4).

     (b doubleWordAt:1) printStringRadix:16   

    "

    "Modified: / 5.3.1998 / 14:57:35 / stefan"

!

doubleWordAt:index MSB:msb

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

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

     The value is retrieved MSB-first, if the msb-arg is true;

     LSB-first otherwise.

     Subclasses may redefine this for better performance."

    |val 

     ival "{ XXClass: SmallInteger }"

     i    "{ Class: SmallInteger }"

     b1   "{ Class: SmallInteger }"

     b2   "{ Class: SmallInteger }"

     b3   "{ Class: SmallInteger }"

     b4   "{ Class: SmallInteger }"|

    i := index.

    b1 := self at:i.

    b2 := self at:(i+1).

    b3 := self at:(i+2).

    b4 := self at:(i+3).

    msb ifTrue:[

        ival := b1.

        ival := (ival bitShift:8) + b2.

        ival := (ival bitShift:8) + b3.

        val := (ival bitShift:8) + b4.

    ] ifFalse:[

        ival := b4.

        ival := (ival bitShift:8) + b3.

        ival := (ival bitShift:8) + b2.

        val := (ival bitShift:8) + b1.

    ].

    ^ val

    "

     |b|

     b := ByteArray withAll:#(1 2 3 4).

     (b doubleWordAt:1 MSB:true) printStringRadix:16.   

     (b doubleWordAt:1 MSB:false) printStringRadix:16   

    "

    "Modified: / 21.1.1998 / 17:42:30 / cg"

!

doubleWordAt:index put:value

    "set the 4-bytes starting at index from the (unsigned) Integer value.

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

     The value should be in the range 0 to 16rFFFFFFFF

     (for negative values, the stored value is not defined).

     The value is stored in the machines natural byte order.

     Subclasses may redefine this for better performance."

    ^ self doubleWordAt:index put:value MSB:IsBigEndian

    "

     |b|

     b := ByteArray new:4.

     b doubleWordAt:1 put:16r04030201.

     b inspect

    "

    "Modified: / 5.3.1998 / 14:57:48 / stefan"

!

doubleWordAt:index put:aNumber MSB:msb

    "set the 4-bytes starting at index from the (unsigned) Integer value.

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

     The value must be in the range 0 to 16rFFFFFFFF.

     The value is stored MSB-first if msb is true; LSB-first otherwise.

     Subclasses may redefine this for better performance."

    |i "{ Class: SmallInteger }" |

    ((aNumber < 0) or:[aNumber > 16rFFFFFFFF]) ifTrue:[

        ^ self elementBoundsError

    ].

    i := index.

    msb ifTrue:[

        self at:i     put:(aNumber digitAt:4).

        self at:(i+1) put:(aNumber digitAt:3).

        self at:(i+2) put:(aNumber digitAt:2).

        self at:(i+3) put:(aNumber digitAt:1).

    ] ifFalse:[

        self at:i     put:(aNumber digitAt:1).

        self at:(i+1) put:(aNumber digitAt:2).

        self at:(i+2) put:(aNumber digitAt:3).

        self at:(i+3) put:(aNumber digitAt:4).

    ].

    ^ aNumber

    "

     |b|

     b := ByteArray new:8.

     b doubleWordAt:1 put:16r04030201 MSB:true.

     b doubleWordAt:5 put:16r04030201 MSB:false.

     b inspect

    "

    "Modified: / 21.1.1998 / 17:43:34 / cg"

    "Modified: / 5.3.1998 / 11:42:17 / stefan"

!

doubleWordAtDoubleWordIndex:index

    "return the unsigned long at index, anInteger. 

     Fetching in the machines natural byte order.

     Indices are 1-based and scaled as appropriate to allow

     accessing the memory as an array of doubleWord entries.

     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAtDoubleWordIndex:index MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:43:53 / cg"

    "Modified: / 5.3.1998 / 14:58:06 / stefan"

!

doubleWordAtDoubleWordIndex:index MSB:msb

    "return the unsigned long at index, anInteger. 

     Fetching is MSB if msb is true, LSB otherwise.

     Indices are 1-based and scaled as appropriate to allow

     accessing the memory as an array of doubleWord entries.

     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAt:(index - 1 * 4 + 1) MSB:msb

    "Created: / 21.1.1998 / 17:44:07 / cg"

!

doubleWordAtDoubleWordIndex:index put:value

    "set the long at index, anInteger. 

     Storing in the machines natural byte order.

     Indices are 1-based and scaled as appropriate to allow

     accessing the memory as an array of doubleWord entries.

     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAtDoubleWordIndex:index put:value MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:44:13 / cg"