"

 COPYRIGHT (c) 1989 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 variableByteSubclass:#ByteArray

	 instanceVariableNames:''

	 classVariableNames:''

	 poolDictionaries:''

	 category:'Collections-Arrayed'

!

!ByteArray class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 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

"

    ByteArrays store integers in the range 0..255.

    In contrast to normal arrays (which store pointers to their elements),

    byteArrays store the values in a dense & compact way. ByteArrays can

    be used to hold the data for bitmaps, images and other bulk data.

    ByteArrays are also used to store the bytecode-instructions of an

    interpreted method and are used as superclass for Strings.

    ByteArrays can be used as literals i.e. you can enter ByteArray-constants

    as #[ element1 element2 .... elementN] and also use byteArray constants

    as elements in a constant array.

    As in: #( #[1 1 1] #[2 2 2] #[3 3 3])

    If you have to communicate structure-data (in the C-sense) with external

    programs/data-bases, see a companion class (Structure) in the goodies directory.

    It allows the definition of subclasses of ByteArray, which transparently fetch

    and store C-structure fields.

"

! !

!ByteArray class methodsFor:'instance creation'!

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

     PS: It took a while to figure that one out ... I dont like it ;-)"

    |index    "{ Class: SmallInteger }"

     dstIndex "{ Class: SmallInteger }"

     stop     "{ Class: SmallInteger }"

     n                "{ Class: SmallInteger }"

     sz       "{ Class: SmallInteger }"

     lastCharacter bytes|

    sz := aString size.

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

    stop := sz // 4 * 3.

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

     range 97 .. otherwise, its exact."

    lastCharacter := aString last.

    lastCharacter asciiValue > 96 ifTrue:[

	stop := stop - 3 + lastCharacter asciiValue - 96

    ].

    bytes := self new:stop.

    index := 1. dstIndex := 1.

    [dstIndex <= stop] whileTrue:[

	"take 4 characters ..."

	n := (aString at:index) asciiValue - 32.

	n := (n bitShift:6) + ((aString at:index+1) asciiValue - 32).

	n := (n bitShift:6) + ((aString at:index+2) asciiValue - 32).

	n := (n bitShift:6) + ((aString at:index+3) asciiValue - 32).

	n := n bitXor:16r820820.

	index := index + 4.

	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)

    "

!

uninitializedNew:anInteger

    "return a new instance of the receiver with uninitialized

     (i.e. undefined) contents. The indexed elements have any random

     value. However, any named instance variables are still nilled. 

     For use, when contents will be set anyway shortly after - this

     is a bit faster than the regular basicNew:, which clears the bytes.

     Of course, it only makes a difference for very big ByteArrays, such

     as used for images/bitmaps.

     Notice: if you want to port code using uninitializedNew: to another

     smalltalk, you have to add an 'uninitializedNew: -> basicNew:'-calling 

     method to the ByteArray class of the other smalltalk."

%{  /* NOCONTEXT */

    OBJ newobj;

    INT instsize, nInstVars, nindexedinstvars;

    REGISTER OBJ *op;

    if (__isSmallInteger(anInteger)) {

	nindexedinstvars = _intVal(anInteger);

	if (nindexedinstvars >= 0) {

	    if (self == ByteArray) {

		/*

		 * the most common case

		 */

		instsize = OHDR_SIZE + nindexedinstvars;

		if (_CanDoQuickNew(instsize)) {

		    _qCheckedNew(newobj, instsize);

		    _InstPtr(newobj)->o_class = self;

		    RETURN (newobj );

		}

	    }

	    nInstVars = _intVal(_ClassInstPtr(self)->c_ninstvars);

	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;

	    PROTECT_CONTEXT

	    _qNew(newobj, instsize, SENDER);

	    UNPROTECT_CONTEXT

	    if (newobj != nil) {

		_InstPtr(newobj)->o_class = self;

		__qSTORE(newobj, self);

		if (nInstVars) {

		    /*

		     * still have to nil out named instvars ...

		     */

#if defined(memset4) && defined(FAST_OBJECT_MEMSET4)

		    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);

#else

# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)

		    /*

		     * knowing that nil is 0

		     */

		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);

# else

		    op = _InstPtr(newobj)->i_instvars;

		    while (nInstVars--)

			*op++ = nil;

# endif

#endif

		}

		RETURN ( newobj );

	    }

	}

    }

%}

.

    (anInteger isMemberOf:SmallInteger) ifTrue:[

	(anInteger < 0) ifTrue:[

	    ^ self error:'bad (negative) argument to new'

	].

	"

	 memory allocation failed.

	 When we arrive here, there was no memory, even after

	 a garbage collect. This means, that the VM wanted to

	 get some more memory from the Operatingsystem, which

	 was not kind enough to give some.

	"

	^ ObjectMemory allocationFailureSignal raise.

    ].

    ^ self basicNew:anInteger

! !

!ByteArray class methodsFor:'binary storage'!

binaryDefinitionFrom: stream manager: manager

    "get a ByteArray from the binary stream.

     ByteArrays are stored as 4-byte size, followed by the bytes"

    "take care of subclasses ..."

    self == ByteArray ifTrue:[

	^ (stream next: (stream nextNumber: 4))

    ].

    ^ super binaryDefinitionFrom: stream manager: manager

! !

!ByteArray class methodsFor:'queries'!

isBuiltInClass

    "this class is known by the run-time-system"

    ^ self == ByteArray

! !

!ByteArray methodsFor:'accessing'!

basicAt:index

    "return the indexed instance variable with index, anInteger

     - redefined here to be slighly faster than the default in Object"

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index);

	if (indx > 0) {

	    if ((cls = __qClass(self)) != ByteArray)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    nIndex = __byteArraySize(self);

	    if (indx <= nIndex) {

		RETURN ( _MKSMALLINT(_ByteArrayInstPtr(self)->ba_element[indx - 1]) );

	    }

	}

    }

%}

.

    ^ super basicAt:index

!

basicAt:index put:value

    "set the indexed instance variable with index, anInteger to value

     - redefined here to be slighly faster than the default in Object"

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    int val;

    OBJ cls;

    if (__bothSmallInteger(index, value)) {

	val = _intVal(value);

	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {

	    indx = _intVal(index);

	    if (indx > 0) {

		if ((cls = __qClass(self)) != ByteArray)

		    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

		nIndex = __byteArraySize(self);

		if (indx <= nIndex) {

		    _ByteArrayInstPtr(self)->ba_element[indx - 1] = val;

		    RETURN ( value );

		}

	    }

	}

    }

%}

.

    ^ super basicAt:index put:value

!

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

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index);

	if (indx > 0) {

	    if ((cls = __qClass(self)) != ByteArray)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    nIndex = __byteArraySize(self);

	    if (indx <= nIndex) {

		RETURN ( _MKSMALLINT(_ByteArrayInstPtr(self)->ba_element[indx - 1]) );

	    }

	}

    }

%}

.

    ^ (super basicAt:index) asInteger

!

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

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    int val;

    OBJ cls;

    if (__bothSmallInteger(index, value)) {

	val = _intVal(value);

	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {

	    indx = _intVal(index);

	    if (indx > 0) {

		if ((cls = __qClass(self)) != ByteArray)

		    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

		nIndex = __byteArraySize(self);

		if (indx <= nIndex) {

		    _ByteArrayInstPtr(self)->ba_element[indx - 1] = val;

		    RETURN ( value );

		}

	    }

	}

    }

%}

.

    ^ super basicAt:index put:value

!

doubleAt:index

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

     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|

    newFloat := Float basicNew.

    1 to:8 do:[:destIndex|

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

    ].

    ^ newFloat.

!

doubleAt:index put:aFloat

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

     starting at index.

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

    1 to:8 do:[:srcIndex|

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

    ].

    ^ aFloat

!

doubleWordAt:index

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

     The value is retrieved in the machines natural byte order.

     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    union {

	char u_char[4];

	unsigned u_uint;

    } val;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index);

	if (indx > 0) {

	    if ((cls = __qClass(self)) != ByteArray)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    nIndex = __byteArraySize(self);

	    if ((indx+3) <= nIndex) {

		val.u_char[0] = _ByteArrayInstPtr(self)->ba_element[indx+0-1];

		val.u_char[1] = _ByteArrayInstPtr(self)->ba_element[indx+1-1];

		val.u_char[2] = _ByteArrayInstPtr(self)->ba_element[indx+2-1];

		val.u_char[3] = _ByteArrayInstPtr(self)->ba_element[indx+3-1];

		if ((val.u_uint >= 0) && (val.u_uint <= _MAX_INT)) {

		    RETURN ( _MKSMALLINT(val.u_uint) );

		}

		RETURN ( _MKULARGEINT(val.u_uint) );

	    }

	}

    }

%}.

    ^ SubscriptOutOfBoundsSignal raise.

    "

     |b|

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

     (b doubleWordAt:1) printStringRadix:16   

    "

!

doubleWordAt:index MSB:msb

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

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

     LSB-first otherwise.

     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    int val;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index);

	if (indx > 0) {

	    if ((cls = __qClass(self)) != ByteArray)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    nIndex = __byteArraySize(self);

	    if ((indx+3) <= nIndex) {

		if (msb == true) {

		    val = _ByteArrayInstPtr(self)->ba_element[indx-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+1-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+2-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+3-1];

		} else {

		    val = _ByteArrayInstPtr(self)->ba_element[indx+3-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+2-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+1-1];

		    val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1];

		}

		if ((val >= 0) && (val <= _MAX_INT)) {

		    RETURN ( _MKSMALLINT(val) );

		}

		RETURN ( _MKULARGEINT(val) );

	    }

	}

    }

%}.

    ^ SubscriptOutOfBoundsSignal raise.

    "

     |b|

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

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

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

    "

!

doubleWordAt:index put:value

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

     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.

     Q: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"

    |t|

%{  /* NOCONTEXT */

    REGISTER int indx;

    int nIndex;

    union {

	char u_char[4];

	unsigned u_uint;

    } val;

    OBJ cls;

    if (__isSmallInteger(index)) {

	if (__isSmallInteger(value)) {

	    val.u_uint = _intVal(value);

	} else {

	    val.u_uint = __longIntVal(value);

	    if (val.u_uint == 0) goto error;

	}

	indx = _intVal(index);

	if (indx > 0) {

	    if ((cls = __qClass(self)) != ByteArray)

		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));

	    nIndex = __qSize(self) - OHDR_SIZE;

	    if ((indx+3) <= nIndex) {