ByteArray.st
author Claus Gittinger <cg@exept.de>
Fri, 22 Aug 1997 19:56:29 +0200
changeset 2890 fa0418a0f896
parent 2866 0d1b10026aa8
child 2894 344aec8ba014
permissions -rw-r--r--
*** empty log message ***

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

    [warning:]
	read the warning about 'growing fixed size collection'
	in ArrayedCollection's documentation

    [author:]
	Claus Gittinger

    [See also:]
	Array CharacterArray String
"
! !

!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 }"
     sixBits  "{ 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 ..."
	sixBits := (aString at:index) asciiValue.
	sixBits := sixBits bitAnd:16r3F.
	n := sixBits.
        
	sixBits := (aString at:index+1) asciiValue.
	sixBits := sixBits bitAnd:16r3F.
	n := (n bitShift:6) + sixBits.

	sixBits := (aString at:index+2) asciiValue.
	sixBits := sixBits bitAnd:16r3F.
	n := (n bitShift:6) + sixBits.

	sixBits := (aString at:index+3) asciiValue.
	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"
!

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);
	    __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
    "return true if this class is known by the run-time-system.
     Here, true is returned for myself, false for subclasses."

    ^ self == ByteArray

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

!ByteArray methodsFor:'accessing'!

basicAt:index
    "return the indexed instance variable with index, anInteger
     - redefined here to be slighly faster than the default in Object.
     Q: is it worth the extra code ?"

%{  /* NOCONTEXT */

    REGISTER int indx;
    REGISTER OBJ slf;
    REGISTER OBJ cls;
    REGISTER int nIndex;

    if (__isSmallInteger(index)) {
	indx = __intVal(index) - 1;
	slf = self;
	if ((cls = __qClass(slf)) != @global(ByteArray)) {
	    if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
		!= __MASKSMALLINT(BYTEARRAY)) {
		goto fail;
	    }
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	}
	nIndex = __byteArraySize(slf);
	if ((unsigned)indx < (unsigned)nIndex) {
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
	}
    }
  fail: ;
%}.
    ^ super basicAt:index
!

basicAt:index put:value
    "set the indexed instance variable with index, anInteger to value.
     Returns value (sigh).
     - redefined here to be slighly faster than the default in Object.
     Q: is it worth the extra code ?"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    REGISTER OBJ slf;
    REGISTER OBJ cls;

    if (__bothSmallInteger(index, value)) {
	val = __intVal(value);
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
	    indx = __intVal(index) - 1;
	    slf = self;
	    if ((cls = __qClass(slf)) != @global(ByteArray)) {
		if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
		    != __MASKSMALLINT(BYTEARRAY)) {
		    goto fail;
		}
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    }
	    nIndex = __byteArraySize(slf);
	    if ((unsigned)indx < (unsigned)nIndex) {
		__ByteArrayInstPtr(slf)->ba_element[indx] = val;
		RETURN ( value );
	    }
	}
    }
  fail: ;
%}.
    ^ super basicAt:index put:value

    "Modified: 19.4.1996 / 11:14:40 / cg"
!

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;
    REGISTER OBJ slf;
    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {
	indx = __intVal(index) - 1;
	slf = self;
	if ((cls = __qClass(slf)) != @global(ByteArray))
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	nIndex = __byteArraySize(slf);
	if ((unsigned)indx < (unsigned)nIndex) {
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
	}
    }
%}.
    ^ (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;
    REGISTER OBJ slf;
    REGISTER OBJ cls;

    if (__bothSmallInteger(index, value)) {
	val = __intVal(value);
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
	    indx = __intVal(index) - 1;
	    slf = self;
	    if ((cls = __qClass(slf)) != ByteArray)
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __byteArraySize(slf);
	    if ((unsigned)indx < (unsigned)nIndex) {
		__ByteArrayInstPtr(slf)->ba_element[indx] = 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)) != @global(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)) != @global(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)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __qSize(self) - OHDR_SIZE;
	    if ((indx+3) <= nIndex) {
		__ByteArrayInstPtr(self)->ba_element[indx+0-1] = val.u_char[0];
		__ByteArrayInstPtr(self)->ba_element[indx+1-1] = val.u_char[1];
		__ByteArrayInstPtr(self)->ba_element[indx+2-1] = val.u_char[2];
		__ByteArrayInstPtr(self)->ba_element[indx+3-1] = val.u_char[3];
		RETURN ( value );
	    }
	}
    }
  error: ;
%}.
    ^ SubscriptOutOfBoundsSignal raise.

    "
     |b|
     b := ByteArray new:4.
     b doubleWordAt:1 put:16r04030201.
     b inspect
    "
!

doubleWordAt:index put:value MSB:msb
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     The value must be in the range 0 to 16rFFFFFFFF.
     The value is stored MSB-first if msb is true; LSB-first otherwise.
     question: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"

    |t|

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    OBJ cls;

    if (__isSmallInteger(index)) {
	if (__isSmallInteger(value)) {
	    val = __intVal(value);
	} else {
	    val = __longIntVal(value);
	    if (val == 0) goto error;
	}
	indx = __intVal(index);
	if (indx > 0) {
	    if ((cls = __qClass(self)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __qSize(self) - OHDR_SIZE;
	    if ((indx+3) <= nIndex) {
		if (msb == true) {
		    __ByteArrayInstPtr(self)->ba_element[indx+3-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+2-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+0-1] = val & 0xFF;
		} else {
		    __ByteArrayInstPtr(self)->ba_element[indx+0-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+2-1] = val & 0xFF;
		    val >>= 8;
		    __ByteArrayInstPtr(self)->ba_element[indx+3-1] = val & 0xFF;
		}
		RETURN ( value );
	    }
	}
    }
  error: ;
%}.
    ^ SubscriptOutOfBoundsSignal raise.

    "
     |b|
     b := ByteArray new:8.
     b doubleWordAt:1 put:16r04030201 MSB:true.
     b doubleWordAt:5 put:16r04030201 MSB:false.
     b inspect
    "
!

floatAt:index
    "return the 4-bytes starting at index as a Float.
     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|

    newFloat := Float basicNew.
    UninterpretedBytes isBigEndian ifFalse:[
	5 to:8 do:[:destIndex|
	    newFloat basicAt:destIndex put:(self at:index - 5 + destIndex)
	].
    ] ifTrue:[
	1 to:4 do:[:destIndex|
	    newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
	].
    ].
    ^ newFloat.
!

floatAt:index put:aFloat
    "store the 4 bytes of 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."

    UninterpretedBytes isBigEndian ifFalse:[
	5 to:8 do:[:srcIndex|
	    self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex)
	].
    ] ifTrue:[
	1 to:4 do:[:srcIndex|
	    self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex)
	].
    ].
    ^ aFloat
!

ieeDoubleAt:index
    "retrieve the 8 bytes starting at index as a float.
     The 8 bytes are assumed to be in IEE floating point single precision
     number format."

    "
     currently, we assume that the machines native number format is already
     IEE format - we need some more code here whenever ST/X is ported
     to an IBM 370 or old VAX etc.
     To date, all supported systems use IEE float numbers, so there should be
     no problem.
    "
    ^ self doubleAt:index
!

ieeDoubleAt:index put:aFloat
    "store the value of the argument, aFloat into the receiver
     starting at index. Storage is in IEE floating point double precision format.
     (i.e. 8 bytes are stored)."

    "
     currently, we assume that the machines native number format is already
     IEE format - we need some more code here whenever ST/X is ported
     to an IBM 370 or old VAX etc.
     To date, all supported systems use IEE float numbers, so there should be
     no problem.
    "
    ^ self doubleAt:index put:aFloat
!

ieeFloatAt:index
    "retrieve the 4 bytes starting at index as a float.
     The 4 bytes are assumed to be in IEE floating point single precision
     number format."

    "
     currently, we assume that the machines native number format is already
     IEE format - we need some more code here whenever ST/X is ported
     to an IBM 370 or old VAX etc.
     To date, all supported systems use IEE float numbers, so there should be
     no problem.
    "
    ^ self floatAt:index
!

ieeFloatAt:index put:aFloat
    "store the value of the argument, aFloat into the receiver
     starting at index. Storage is in IEE floating point single precision format.
     (i.e. 4 bytes are stored). Since ST/X floats are really doubles, the low-
     order 4 bytes of the precision is lost."

    "
     currently, we assume that the machines native number format is already
     IEE format - we need some more code here whenever ST/X is ported
     to an IBM 370 or old VAX etc.
     To date, all supported systems use IEE float numbers, so there should be
     no problem.
    "
    ^ self floatAt:index put:aFloat
!

quadWordAt:index MSB:msb
    "return the 8-bytes starting at index as an (unsigned) Integer.
     Depending on msb, the value is retrieved MSB or LSB-first."

    |l 
     bIdx  "{ Class: SmallInteger }"
     delta "{ Class: SmallInteger }"|

    l := LargeInteger basicNew numberOfDigits:8.
    msb ifTrue:[
	bIdx := index + 7.
	delta := -1
    ] ifFalse:[
	bIdx := index.
	delta := 1
    ].
    1 to:8 do:[:i |
	l digitAt:i put:(self basicAt:bIdx).
	bIdx := bIdx + delta
    ].
    ^ l compressed

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
     (b quadWordAt:1 MSB:false) printStringRadix:16  
    "

    "Modified: 5.11.1996 / 14:06:21 / cg"
!

quadWordAt:index put:anInteger MSB:msb
    "set the 8-bytes starting at index from the (unsigned) Integer value.
     The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF.
     Depending on msb, the value is stored MSB-first or LSB-first."

    |bIdx  "{ Class: SmallInteger }"
     delta "{ Class: SmallInteger }"|

    msb ifTrue:[
	bIdx := index + 7.
	delta := -1
    ] ifFalse:[
	bIdx := index.
	delta := 1
    ].
    1 to:8 do:[:i |
	self basicAt:bIdx put:(anInteger digitAt:i).
	bIdx := bIdx + delta.
    ].
    ^ anInteger

    "
     |b|
     b := ByteArray new:8.
     b quadWordAtIndex:1 put:16r0807060504030201 MSB:false.
     b inspect
    "
!

signedByteAt:index
    "return the byte at index as a signed 8 bit value.
     This may be worth a primitive."

    ^ (self at:index) signExtendedByteValue

"/    |b "{ Class: SmallInteger }"|
"/
"/    b := self at:index.
"/    (b > 16r7F) ifTrue:[
"/        ^ b - 16r100
"/    ].
"/    ^ b

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

signedDoubleWordAt:index
    "return the 4-bytes starting at index as a signed Integer.
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    |w|

    w := self doubleWordAt:index.
    (w > (16r7FFFFFFF)) ifTrue:[
	^ w - (16r100000000)
    ].
    ^ w

"
    w := self doubleWordAt:index.
    (w > 16r7FFFFFFF) ifTrue:[
	^ w - 16r100000000
    ].
    ^ w
"

    "
     |b|
     b := ByteArray new:4.
     b doubleWordAt:1 put:16rFFFFFFFF.
     (b signedDoubleWordAt:1)    
    "

    "Modified: 1.7.1996 / 21:11:28 / cg"
!

signedDoubleWordAt:index MSB:msb
    "return the 4-bytes starting at index as a signed Integer.
     Depending on msb, the value is retrieved MSB-first or LSB-first.
     This may be worth a primitive."

    |w|

    w := self doubleWordAt:index MSB:msb.
    (w > (16r7FFFFFFF)) ifTrue:[
	^ w - (16r100000000)
    ].
    ^ w
"
    w := self doubleWordAt:index.
    (w > 16r7FFFFFFF) ifTrue:[
	^ w - 16r100000000
    ].
    ^ w
"

    "
     |b|
     b := ByteArray new:4.
     b doubleWordAt:1 put:16rFFFFFFFF.
     (b signedDoubleWordAt:1)    
    "

    "Modified: 1.7.1996 / 21:11:33 / cg"
!

signedDoubleWordAt:index put:value
    "set the 4-bytes starting at index from the signed Integer value.
     The value is stored in the machines natural byte order.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := value + 16r100000000
    ].
    self doubleWordAt:index put:v.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b signedDoubleWordAt:1 put:-1.
     (b doubleWordAt:1) printStringRadix:16   
    "

    "Modified: 1.7.1996 / 21:11:39 / cg"
!

signedDoubleWordAt:index put:value MSB:msb
    "set the 4-bytes starting at index from the signed Integer value.
     Depending on msb, the value is stored MSB-first or LSB-first.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := value + 16r100000000
    ].
    self doubleWordAt:index put:v MSB:msb.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b signedDoubleWordAt:1 put:-1.
     (b doubleWordAt:1) printStringRadix:16   
    "

    "Modified: 1.7.1996 / 21:11:46 / cg"
!

signedWordAt:index
    "return the 2-bytes starting at index as a signed Integer.
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    ^ (self wordAt:index) signExtendedShortValue

"/    |w "{ Class: SmallInteger }"|
"/
"/    w := self wordAt:index.
"/    (w > 16r7FFF) ifTrue:[
"/        ^ w - 16r10000
"/    ].
"/    ^ w

    "
     |b|
     b := ByteArray new:2.
     b wordAt:1 put:16rFFFF.
     b signedWordAt:1  
    "

    "Modified: 1.7.1996 / 21:14:38 / cg"
!

signedWordAt:index MSB:msb
    "return the 2-bytes starting at index as a signed Integer.
     The value is retrieved MSB-first if the msb-arg is true,
     LSB-first otherwise.
     This may be worth a primitive."

    ^ (self wordAt:index MSB:msb) signExtendedShortValue

"/    |w "{ Class: SmallInteger }"|
"/
"/    w := self wordAt:index MSB:msb.
"/    (w > 16r7FFF) ifTrue:[
"/        ^ w - 16r10000
"/    ].
"/    ^ w

    "
     |b|
     b := ByteArray new:2.
     b wordAt:1 put:16r0080.
     b signedWordAt:1 MSB:true.  
     b signedWordAt:1 MSB:false.  
    "

    "Modified: 1.7.1996 / 21:15:57 / cg"
!

signedWordAt:index put:value
    "set the 2-bytes starting at index from the signed Integer value.
     The stored value must be in the range -32768 .. +32676.
     The value is stored in the machines natural byteorder.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := 16r10000 + value
    ].
    self wordAt:index put:v.
    ^ value

    "
     |b|
     b := ByteArray new:6.
     b signedWordAt:1 put:-1.
     b signedWordAt:3 put:-2.
     b signedWordAt:5 put:0.
     b inspect
    "

    "Modified: 1.7.1996 / 21:12:07 / cg"
!

signedWordAt:index put:value MSB:msb
    "set the 2-bytes starting at index from the signed Integer value.
     The stored value must be in the range -32768 .. +32676.
     The value is stored MSB-first, if the msb-arg is true;
     LSB-first otherwise.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := 16r10000 + value
    ].
    self wordAt:index put:v MSB:msb.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b signedWordAt:1 put:-1.
     b signedWordAt:3 put:-2.
     b inspect
    "

    "Modified: 1.7.1996 / 21:12:13 / cg"
!

stringAt:index size:count
    "extract a string, given initial index and number of characters (bytes)"

    ^ (self copyFrom:index to:(index + count - 1)) asString

    "Modified: 9.9.1996 / 15:28:08 / cg"
    "Created: 9.9.1996 / 15:28:48 / cg"
!

wordAt:index
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The value is retrieved in the machines natural byte order
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    union {
	char u_char[2];
	unsigned short u_ushort;
    } val;
    OBJ cls;

    if (__isSmallInteger(index)) {
	indx = __intVal(index);
	if (indx > 0) {
	    if ((cls = __qClass(self)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __byteArraySize(self);
	    if ((indx+1) <= nIndex) {
		val.u_char[0] = __ByteArrayInstPtr(self)->ba_element[indx-1];
		val.u_char[1] = __ByteArrayInstPtr(self)->ba_element[indx-1+1];
		RETURN ( __MKSMALLINT(val.u_ushort) );
	    }
	}
    }
%}.
    ^ SubscriptOutOfBoundsSignal raise.
!

wordAt:index MSB:msb
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The value is retrieved MSB (high 8 bits at lower index) if msb is true;
     LSB-first (i.e. low 8-bits at lower byte index) if its false.
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    OBJ cls;

    if (__isSmallInteger(index)) {
	indx = __intVal(index);
	if (indx > 0) {
	    if ((cls = __qClass(self)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __byteArraySize(self);
	    if ((indx+1) <= nIndex) {
		if (msb == true) {
		    val = __ByteArrayInstPtr(self)->ba_element[indx-1];
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx-1+1];
		} else {
		    val = __ByteArrayInstPtr(self)->ba_element[indx+1-1];
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx-1];
		}
		RETURN ( __MKSMALLINT(val) );
	    }
	}
    }
%}.
    ^ SubscriptOutOfBoundsSignal raise.
!

wordAt:index put:value
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The stored value must be in the range 0 .. 16rFFFF. 
     The value is stored in the machines natural byteorder.
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int v;
    union {
	char u_char[2];
	unsigned short u_ushort;
    } val;
    OBJ cls;

    if (__bothSmallInteger(index, value)) {
	indx = __intVal(index);
	if (indx > 0) {
	    if ((cls = __qClass(self)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __byteArraySize(self);
	    if ((indx+1) <= nIndex) {
		val.u_ushort = v = __intVal(value);
		if ((v & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
		    __ByteArrayInstPtr(self)->ba_element[indx-1] = val.u_char[0];
		    __ByteArrayInstPtr(self)->ba_element[indx-1+1] = val.u_char[1];
		    RETURN ( value );
		}
	    }
	}
    }
%}.
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
	^ self elementBoundsError
    ].
    ^ SubscriptOutOfBoundsSignal raise.

    "
     |b|
     b := ByteArray new:4.
     b wordAt:1 put:16r0102.
     b wordAt:3 put:16r0304.
     b inspect  
    "
!

wordAt:index put:value MSB:msb
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The stored value must be in the range 0 .. 16rFFFF. 
     The value is stored LSB-first (i.e. the low 8bits are stored at the
     lower index) if msb is false, MSB-first otherwise.
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    OBJ cls;

    if (__bothSmallInteger(index, value)) {
	indx = __intVal(index);
	if (indx > 0) {
	    if ((cls = __qClass(self)) != @global(ByteArray))
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __byteArraySize(self);
	    if ((indx+1) <= nIndex) {
		val = __intVal(value);
		if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
		    if (msb == true) {
			__ByteArrayInstPtr(self)->ba_element[indx-1+1] = val & 0xFF;
			__ByteArrayInstPtr(self)->ba_element[indx-1] = (val>>8) & 0xFF;
		    } else {
			__ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
			__ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF;
		    }
		    RETURN ( value );
		}
	    }
	}
    }
%}.
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
	^ self elementBoundsError
    ].
    ^ SubscriptOutOfBoundsSignal raise.

    "
     |b|
     b := ByteArray new:8.
     b wordAt:1 put:16r0102 MSB:false.
     b wordAt:3 put:16r0304 MSB:false.
     b wordAt:5 put:16r0102 MSB:true.
     b wordAt:7 put:16r0304 MSB:true.
     b inspect  
    "
!

zeroByteStringAt:index maximumSize:count
    "extract a zeroByte-delimited string, given initial index and
     maximum number of characters (bytes)"

    |bytes idx|

    bytes := self copyFrom:index to:(index + count - 1).
    idx := bytes indexOf:0.
    idx ~~ 0 ifTrue:[ bytes := bytes copyTo:idx-1 ].
    ^ bytes asString

    "Created: 9.9.1996 / 15:28:34 / cg"
! !

!ByteArray methodsFor:'binary storage'!

storeBinaryDefinitionOn:stream manager:manager
    "append a binary representation of the receiver onto stream.
     Redefined since ByteArrays are stored with a special type code and
     in a more compact way.
     This is an internal interface for binary storage mechanism."

    |myClass myBasicSize|

    "not, if I have named instance variables"
    (myClass := self class) instSize ~~ 0 ifTrue:[
	^ super storeBinaryDefinitionOn:stream manager:manager
    ].
    manager putIdOfClass:myClass on: stream.
    stream nextNumber:4 put:(myBasicSize := self basicSize).
    stream nextPutBytes:myBasicSize from:self startingAt:1.
"/    stream nextPutAll:(self asByteArray)

    "Modified: 19.3.1997 / 19:52:26 / cg"
! !

!ByteArray methodsFor:'converting'!

asByteArray
    "return the receiver as a byteArray"

    "could be an instance of a subclass..."
    self class == ByteArray ifTrue:[
	^ self
    ].
    ^ super asByteArray

    "
     'hello world' asByteArray 
     #(1 2 3 4 5 6 7) asByteArray 
     #(1 2 256 4 5 6 7) asByteArray 
    "
! !

!ByteArray methodsFor:'copying'!

copyFrom:start to:stop
    "return the subcollection starting at index start, anInteger and ending
     at stop, anInteger.
     - reimplemented here for speed"

%{  /* NOCONTEXT */

    REGISTER unsigned char *srcp;
    REGISTER unsigned char *dstp;
    REGISTER int count;
    int len, index1, index2, sz;
    OBJ newByteArray;

    if (__isByteArray(self)
     && __bothSmallInteger(start, stop)) {
	len = __byteArraySize(self);
	index1 = __intVal(start);
	index2 = __intVal(stop);

	if ((index1 <= index2) && (index1 > 0)) {
	    if (index2 <= len) {
		count = index2 - index1 + 1;
		__PROTECT_CONTEXT__
		sz = OHDR_SIZE + count;
		__qNew(newByteArray, sz);
		__UNPROTECT_CONTEXT__
		if (newByteArray != nil) {
		    __InstPtr(newByteArray)->o_class = ByteArray;
		    dstp = __ByteArrayInstPtr(newByteArray)->ba_element;
		    srcp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;

#ifdef bcopy4
                    if ((((unsigned INT)srcp & 3) == 0)
                     && (((unsigned INT)dstp & 3) == 0)) {
                        /* copy aligned part */
                        int nW = count >> 2;

                        if (count & 3) {
                            nW++;
                        }
                        bcopy4(srcp, dstp, nW);
                        RETURN ( newByteArray );
                    }
#endif /* bcopy4 */

#ifdef FAST_MEMCPY
		    bcopy(srcp, dstp, count);
#else
		    while (count--) {
			*dstp++ = *srcp++;
		    }
#endif
		    RETURN ( newByteArray );
		}
	    }
	}
    }
%}.
    "
     fall back in case of non-integer index or out-of-bound index;
     will eventually lead to an out-of-bound signal raise
    "
    ^ super copyFrom:start to:stop
! !

!ByteArray methodsFor:'filling and replacing'!

from:start to:stop put:aNumber
    "fill part of the receiver with aNumber.
     - reimplemented here for speed"

%{  /* NOCONTEXT */

    REGISTER unsigned char *dstp;
    REGISTER int count, value;
    int len, index1, index2;
    OBJ cls;

    if (__isSmallInteger(aNumber)
     && __bothSmallInteger(start, stop)
     && __isBytes(self)) {
        len = __byteArraySize(self);
        index1 = __intVal(start);
        index2 = __intVal(stop);

        dstp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
        if ((cls = __qClass(self)) != @global(ByteArray)) {
            int nInst;

            nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
            dstp += nInst;
            len -= nInst;
        }

        value = __intVal(aNumber);
        if (((unsigned)value <= 0xFF) /* i.e. (value >= 0) && (value <= 255) */
         && (index1 <= index2) 
         && (index1 > 0)) {
            if (index2 <= len) {
                count = index2 - index1 + 1;

#ifdef memset4
                if (count > 20) {
                    while (((unsigned INT)dstp & 3) != 0) {
                        *dstp++ = value;
                        count--;
                    }
                    {
                        int n4 = count & ~3;
                        int v4, nW;

                        v4 = (value << 8) | value;
                        v4 = (v4 << 16) | v4;
                        nW = n4>>2;
                        memset4(dstp, v4, nW);
                        count -= n4;
                        dstp += n4;
                    }
                    while (count--) {
                        *dstp++ = value;
                    }
                    RETURN (self);
                }
#endif /* memset4 */

#ifdef FAST_MEMSET
                memset(dstp, value, count);
#else
# ifdef UNROLL_LOOPS
                while (count >= 8) {
                    dstp[0] = dstp[1] = dstp[2] = dstp[3] =
                    dstp[4] = dstp[5] = dstp[6] = dstp[7] = value;
                    dstp += 8;
                    count -= 8;
                }
# endif /* UNROLL_LOOPS */
                while (count--) {
                    *dstp++ = value;
                }
#endif
                RETURN (self);
            }
        }
    }
%}.
    "
     fall back in case of non-integer index or out-of-bound index/value;
     will eventually lead to an out-of-bound signal raise
    "
    ^ super from:start to:stop put:aNumber
!

replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
    "replace elements from another collection, which must be a ByteArray
     or String."

%{  /* NOCONTEXT */

    int nIndex, repNIndex;
    int startIndex, stopIndex;
    REGISTER unsigned char *src;
    REGISTER int repStartIndex;
    int repStopIndex, count;
    REGISTER unsigned char *dst;
    OBJ cls;

    if (__isBytes(aCollection)
     && __isBytes(self)
     && __bothSmallInteger(start, stop)
     && __isSmallInteger(repStart)) {
        startIndex = __intVal(start) - 1;
        if (startIndex >= 0) {
            dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
            nIndex = __byteArraySize(self);

            if ((cls = __qClass(self)) != @global(ByteArray)) {
                int nInst;

                nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
                dst += nInst;
                nIndex -= nInst;
            }

            stopIndex = __intVal(stop) - 1;
            count = stopIndex - startIndex + 1;
            if (count == 0) {
                RETURN ( self );
            }

            if ((count > 0) && (stopIndex < nIndex)) {
                repStartIndex = __intVal(repStart) - 1;
                if (repStartIndex >= 0) {
                    repNIndex = __qSize(aCollection) - OHDR_SIZE;
                    src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
                    if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
                        int nInst;

                        nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
                        src += nInst;
                        repNIndex -= nInst;
                    }

                    repStopIndex = repStartIndex + (stopIndex - startIndex);
                    if (repStopIndex < repNIndex) {
                        if (aCollection == self) {
                            /* take care of overlapping copy */
                            if (src < dst) {
                                /* must do a reverse copy */
                                src += count;
                                dst += count;
                                while (count-- > 0) {
                                    *--dst = *--src;
                                }
                                RETURN ( self );
                            }
                        }

#ifdef bcopy4
                        if ((((unsigned INT)src & 3) == 0)
                         && (((unsigned INT)dst & 3) == 0)) {
                            /* copy aligned part */
                            int nW = count >> 2;

                            bcopy4(src, dst, nW);
                            if ((count = count & 3) != 0) {
                                /* copy any remaining part */
                                src += (nW<<2);
                                dst += (nW<<2);
                                while (count--) {
                                    *dst++ = *src++;
                                }
                            }
                            RETURN ( self );
                        }
#endif /* bcopy4 */

#ifdef FAST_MEMCPY
                        bcopy(src, dst, count);
#else
# ifdef UNROLL_LOOPS
                        while (count >= 8) {
                            dst[0] = src[0]; dst[1] = src[1];
                            dst[2] = src[2]; dst[3] = src[3];
                            dst[4] = src[4]; dst[5] = src[5];
                            dst[6] = src[6]; dst[7] = src[7];
                            dst += 8; src += 8;
                            count -= 8;
                        }
# endif /* UNROLL_LOOPS */
                        while (count-- > 0) {
                            *dst++ = *src++;
                        }
#endif
                        RETURN ( self );
                    }
                }
            }
        }
    }
%}.
    "
     fall back in case of non-ByteArray argument,
     or for the error report if any index is invalid
    "
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
!

replaceFrom:start to:stop with:aCollection startingAt:repStart
    "replace elements in the receiver between index start and stop,
     with elements  taken from replacementCollection starting at repStart."

    (aCollection class == self class) ifTrue:[
	^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
    ].
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart

    "Modified: 13.4.1996 / 12:16:46 / cg"
! !

!ByteArray methodsFor:'image manipulation support'!

compressPixels:nBitsPerPixel width:width height:height into:aByteArray mapping:aMapByteArray
    "given the receiver with 8-bit pixels, compress them into aByteArray
     with nBitsPerPixel-depth pixels. The width/height-arguments are needed
     to allow for any padding. On the fly, the source bytes are translated
     using aMapByteArray (if non-nil).
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
     value of n is found in map at:(n + 1).
     Output bits are filled left-to right, i.e. the first byte in the input
     corresponds to the high bit(s) if the first byte in the input.
     This method can be used to convert 8-bit image data to mono, 2-bit and 4-bit 
     bitmaps.
     It can also be used to compress byte-arrays into bitArrays."

%{  /* NOCONTEXT */

    REGISTER unsigned char *src, *dst;
    REGISTER int wrun;
    unsigned char *dstNext;
    unsigned char *dstEnd;
    int bytesPerRow, mask, shift0, shift;
    int w, h, hrun;
    int srcBytes, dstBytes;
    int bitsPerPixel;
    int bits;
    int ncells;
    unsigned char *map;

    if ((__qClass(self) == @global(ByteArray)) 
     && (__qClass(aByteArray) == @global(ByteArray))
     && __isSmallInteger(nBitsPerPixel)
     && __bothSmallInteger(height, width)) {
        if ((aMapByteArray != nil)
         && (__Class(aMapByteArray) == @global(ByteArray))) {
            map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
        } else {
            map = (unsigned char *)0;
        }

        bitsPerPixel = __intVal(nBitsPerPixel);
        w = __intVal(width);
        h = __intVal(height);
        src = __ByteArrayInstPtr(self)->ba_element;
        dst = __ByteArrayInstPtr(aByteArray)->ba_element;
        dstEnd = dst + __byteArraySize(aByteArray);
        switch (bitsPerPixel) {
            case 1:
                mask = 0x01;
                break;
            case 2:
                mask = 0x03;
                break;
            case 4:
                mask = 0x0F;
                break;
            case 8:
                mask = 0xFF;
                break;
            default:
                printf("invalid depth in compressPixels\n");
                goto fail;
        }
        if (map) {
            /*
             * if a map is present, it must have entries for
             * all possible byte-values (i.e. its size must be >= 256)
             */
            if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256) {
                printf("invalid map in compressPixels\n");
                goto fail;
            }
        }

        bytesPerRow = (w * bitsPerPixel + 7) / 8;
        dstBytes = bytesPerRow * h;
        srcBytes = w * h;

        if ((__byteArraySize(self) >= srcBytes)
         && (__byteArraySize(aByteArray) >= dstBytes)) {
            for (hrun=h; hrun; hrun--) {
                dstNext = dst + bytesPerRow;
                bits = 0; shift = 8;
                if (map) {
                    for (wrun=w; wrun; wrun--) {
                        bits = (bits << bitsPerPixel) | (map[*src++] & mask);
                        shift -= bitsPerPixel;
                        if (shift == 0) {
                            if (dst == dstEnd) goto fail;
                            *dst++ = bits;
                            bits = 0; shift = 8;
                        }
                    }
                } else {
                    for (wrun=w; wrun; wrun--) {
                        bits = (bits << bitsPerPixel) | (*src++ & mask);
                        shift -= bitsPerPixel;
                        if (shift == 0) {
                            if (dst == dstEnd) goto fail;
                            *dst++ = bits;
                            bits = 0; shift = 8;
                        }
                    }
                }
                if (shift != 8) {
                    if (dst == dstEnd) goto fail;
                    *dst = bits;
                }
                dst = dstNext;
            }
            RETURN ( self );
        }
    }
fail: ;
%}.
    self primitiveFailed

    "Example1:
     compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap
    "
    "
     |inBits outBits|

     inBits := #[0 0 0 0 1 1 1 1
                 0 0 1 1 0 0 1 1
                 0 1 0 1 0 1 0 1
                 1 1 1 1 0 0 0 0].
     outBits := ByteArray new:4.
     inBits compressPixels:1 width:8 height:4
                    into:outBits mapping:nil.
     outBits inspect
    "

    "Example2:
     compress byte-array into a bitArray, translating 99 to 0-bits,
     and 176 to 1-bits. (just a stupid example)
    "
    "
     |inBits outBits map|

     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
     map := ByteArray new:256.
     map at:176+1 put:1.

     outBits := ByteArray new:2.
     inBits compressPixels:1 width:16 height:1 
                    into:outBits mapping:map.
     outBits inspect
    "

    "Example3:
     compress byte-array into a bitArray, translating everything below 128 to 0-bits,
     and 128 to 255 to 1-bits.99 to 0-bits (another stupid example)
    "
    "
     |inBits outBits map|

     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
     map := ByteArray new:256.
     map atAll:(128+1 to:255+1) put:1.

     outBits := ByteArray new:2.
     inBits compressPixels:1 width:16 height:1 
                    into:outBits mapping:map.
     outBits inspect
    "
!

expandPixels:nBitsPerPixel width:width height:height into:aByteArray mapping:aMapByteArray
    "given the receiver with nBitsPerPixel-depth pixels, expand them into
     aByteArray with 8-bit pixels. The width/height-arguments are needed
     to skip any padded src-bits. On the fly, the destination pixels
     are translated using aMapByteArray (if non-nil).
     Input bits are read left-to right, i.e. the first byte in the output
     corresponds to the high bit(s) in the inputs first byte.
     This is used to display mono, 2-bit and 4-bit bitmaps on grey-scale/color
     machines. With nBitsPerPixel==8, this is a translate operation.
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
     value of n is found in map at:(n + 1).
     It can also be used to expand bit-arrays into byteArrays.
     This method is specialized for ByteArray arguments - it will not handle
     anything else."

%{  /* NOCONTEXT */

    REGISTER unsigned char *src, *dst;
    REGISTER int wrun;
    unsigned char *srcNext;
    int bytesPerRow, mask, shift0, shift;
    int w, h, hrun;
    int srcBytes, dstBytes;
    int bitsPerPixel;
    int bits;
    int ncells;
    unsigned char *map;

    if ((__qClass(self) == @global(ByteArray)) 
     && (__qClass(aByteArray) == @global(ByteArray))
     && __isSmallInteger(nBitsPerPixel)
     && __bothSmallInteger(height, width)) {
        if ((aMapByteArray != nil)
         && (__Class(aMapByteArray) == @global(ByteArray))) {
            map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
        } else {
            map = (unsigned char *)0;
        }

        bitsPerPixel = __intVal(nBitsPerPixel);
        w = __intVal(width);
        h = __intVal(height);
        src = __ByteArrayInstPtr(self)->ba_element;
        dst = __ByteArrayInstPtr(aByteArray)->ba_element;
        switch (bitsPerPixel) {
            case 1:
                mask = 0x01;
                break;
            case 2:
                mask = 0x03;
                break;
            case 4:
                mask = 0x0F;
                break;
            case 8:
                mask = 0xFF;
                break;
            default:
                printf("invalid depth in expandPixels\n");
                goto fail;
        }
        ncells = mask + 1;
        if (map) {
            /*
             * if a map is present, it must have the correct size
             * (i.e. 2 raisedTo:nBitsPerPixel)
             */
            if ((__qSize(aMapByteArray) - OHDR_SIZE) < ncells) {
                printf("invalid map in expandPixels\n");
                goto fail;
            }
        }

        bytesPerRow = (w * bitsPerPixel + 7) / 8;
        shift0 = 8 - bitsPerPixel;
        srcBytes = bytesPerRow * h;
        dstBytes = w * h;

        if ((__byteArraySize(self) >= srcBytes)
         && (__byteArraySize(aByteArray) >= dstBytes)) {
            for (hrun=h; hrun; hrun--) {
                srcNext = src + bytesPerRow;
                shift = shift0;
                if (map) {
                    if (shift0 == 0) {
                        /* translate only */
                        for (wrun=w; wrun; wrun--) {
                            bits = *src++;
                            *dst++ = map[bits];
                        }
                    } else {
                        for (wrun=w; wrun; wrun--) {
                            if (shift == shift0) {
                                bits = *src++;
                            }
                            *dst++ = map[(bits >> shift) & mask];
                            shift -= bitsPerPixel;
                            if (shift < 0) {
                                shift = shift0;
                            }
                        }
                    }
                } else {
                    for (wrun=w; wrun; wrun--) {
                        if (shift == shift0) {
                            bits = *src++;
                        }
                        *dst++ = (bits >> shift) & mask;
                        shift -= bitsPerPixel;
                        if (shift < 0) {
                            shift = shift0;
                        }
                    }
                }
                src = srcNext;
            }
            RETURN ( self );
        }
    }
    printf("invalid args\n");

fail: ;
%}.
    self primitiveFailed

    "Example1:
     expand 1-bit-per-pixel bitmap into a 1byte-per-pixel byteArray
    "
    "
     |inBits outBits|

     inBits := #[2r11110000 
                 2r11001100 
                 2r01010101 
                 2r00001111].
     outBits := ByteArray new:(8*4).
     inBits expandPixels:1 width:8 height:4
                    into:outBits mapping:nil.
     outBits inspect
    "

    "Example2:
     expand bit-array into a byteArray, translating 0-bits to 99,
     1-bits to 176. (just a stupid example)
    "
    "
     |inBits outBits|

     inBits := #[2r11110000 2r11001100].
     outBits := ByteArray new:16.
     inBits expandPixels:1 width:16 height:1 
                    into:outBits mapping:#[99 176].
     outBits inspect
    "
!

invert
    "invert all bytes - used with image manipulations
     written as a primitive for speed.
     Q: is this really needed ?"

%{  /* NOCONTEXT */

    REGISTER unsigned char *dst;
    REGISTER unsigned long *ldst;
    REGISTER int cnt;

    if (__qClass(self) == @global(ByteArray)) {
	cnt = __byteArraySize(self);
	dst = __ByteArrayInstPtr(self)->ba_element;
	if (! ((INT)dst & (sizeof(long)-1))) {
	    ldst = (unsigned long *)dst;
	    while (cnt > 16) {
		ldst[0] = ~(ldst[0]);
		ldst[1] = ~(ldst[1]);
		ldst[2] = ~(ldst[2]);
		ldst[3] = ~(ldst[3]);
		ldst += 4;
		cnt -= 16;
	    }
	    while (cnt >= sizeof(long)) {
		*ldst = ~(*ldst);
		ldst++;
		cnt -= sizeof(long);
	    }
	    dst = (unsigned char *)ldst;
	}
	while (cnt--) {
	    *dst = ~(*dst);
	    dst++;
	}
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

reverse
    "reverse the order of my elements inplace - 
     written as a primitive for speed on image manipulations (mirror)"

%{  /* NOCONTEXT */

    REGISTER unsigned char *p1, *p2;
    REGISTER int cnt;
    REGISTER unsigned t;
    OBJ cls;

    if (__qClass(self) == @global(ByteArray)) {
        cnt = __byteArraySize(self);
        p1 = __ByteArrayInstPtr(self)->ba_element;
        p2 = p1 + cnt - 1;
        while (p1 < p2) {
            t = *p1;
            *p1++ = *p2;
            *p2-- = t;
        }
        RETURN ( self );
    }
%}.
    ^ super reverse

    "
     #[1 2 3 4 5] reverse
     #[1 2 3 4] reverse
    "
!

swapBytes
    "swap bytes inplace - 
     written as a primitive for speed on image grabbing (if display order is different)"

%{  /* NOCONTEXT */

    REGISTER unsigned char *p;
    REGISTER int cnt;
    REGISTER unsigned t;

    if (__qClass(self) == @global(ByteArray)) {
	cnt = __byteArraySize(self);
	cnt = cnt & ~1; /* make it even */
	p = __ByteArrayInstPtr(self)->ba_element;
	while (cnt > 0) {
	    t = p[0];
	    p[0] = p[1];
	    p[1] = t;
	    p += 2;
	    cnt -= 2;
	}
	RETURN ( self );
    }
%}.
    ^ super swapBytes "/ rubbish - there is no one currenly

    "
     #[1 2 3 4 5 6 7 8 9 10] copy swapBytes 
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapBytes  
    "
!

swapLongs
    "swap long bytes inplace - any partial longs at the end
     are not swapped.
     written as a primitive for speed on image grabbing 
     (if display order is different)"

%{  /* NOCONTEXT */

    REGISTER unsigned char *p;
    REGISTER int cnt;
    REGISTER unsigned t;

    if (__qClass(self) == @global(ByteArray)) {
        cnt = __byteArraySize(self);
        cnt = cnt & ~3; /* make it even */
        p = __ByteArrayInstPtr(self)->ba_element;
        while (cnt > 0) {
            t = p[0];
            p[0] = p[3];
            p[3] = t;
            t = p[1];
            p[1] = p[2];
            p[2] = t;
            p += 4;
            cnt -= 4;
        }
        RETURN ( self );
    }
%}.
    ^ super swapLongs "/ rubbish - there is no one currenly

    "
     #[1 2 3 4 5 6 7 8 9] copy swapLongs 
     #[1 2 3 4 5 6 7 8 9 10] copy swapLongs 
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapLongs  
     #[1 2 3 4 5 6 7 8 9 10 11 12] copy swapLongs  
    "
! !

!ByteArray methodsFor:'printing & storing'!

asPackedString
    "ST-80 compatibility: encode the receiver into an ascii String
     with 6bits encoded per character. Each group of 6 bits is encoded
     as a corresponding character (32+value) and the resulting string
     is returned. The resulting string is always a multiple of 4 (since
     24 is the lcm of 6 and 8) and the number of remaining characters is
     encoded in the last character.
     ST-80 uses this encoding for Images ...
     PS: I dont like it ;-)"

    |outStream 
     index     "{ Class:SmallInteger}"
     nextIndex "{ Class:SmallInteger}"
     stop      "{ Class:SmallInteger}"
     n         "{ Class:SmallInteger}"
     mod       "{ Class:SmallInteger}"|

    outStream := WriteStream on:String new.
    index := 1. 
    stop := self size.
    [index <= stop] whileTrue:[
	"take 3 source bytes"
	n := (self at:index) bitShift:16.
	(index < stop) ifTrue:[
	    nextIndex := index + 1.
	    n := n bitOr:((self at:nextIndex) bitShift:8).
	    (nextIndex < stop) ifTrue:[
		n := n bitOr:(self at:(index + 2)).
	    ].
	].

	"took me a while to find that one out ..."
	n := n bitXor:16r820820.

	outStream nextPut:(Character value:(n bitShift:-18) + 32).
	outStream nextPut:(Character value:((n bitShift:-12) bitAnd:16r3F) + 32).
	outStream nextPut:(Character value:((n bitShift:-6) bitAnd:16r3F) + 32).
	outStream nextPut:(Character value:(n bitAnd:16r3F) + 32).
	index := index + 3.
    ].
    (mod := stop \\ 3) ~~ 0 ifTrue:[
	outStream position:(outStream position - 1).
	outStream nextPut:(Character value:(mod + 96)).
    ].
    ^ outStream contents

    "Modified: 12.11.1996 / 15:45:02 / cg"
!

displayString
    "return a printed representation of the receiver for displaying"

    ^ self storeString

    "Created: 25.10.1995 / 13:33:26 / cg"
    "Modified: 22.4.1996 / 12:54:06 / cg"
!

storeOn:aStream
    "append a printed representation from which the receiver can be
     reconstructed to aStream. (reimplemented to make it look better)"

    |first|

    self class == ByteArray ifTrue:[    "/ care for subclasses
	aStream nextPutAll:'#['.
	first := true.
	self do:[:byte | 
	    first ifFalse:[aStream space]
		  ifTrue:[first := false].
	    byte storeOn:aStream.
	].
	aStream nextPutAll:']'.
	^ self
    ].
    ^ super storeOn:aStream

    "
     #[1 2 3 4 5] storeOn:Transcript   

     #[1 2 3 4 5] storeString            
     #[1 2 3 4 5] displayString         
     #[1 2 3 4 5] printString         
    "

    "Modified: 7.3.1996 / 15:11:44 / cg"
! !

!ByteArray methodsFor:'queries'!

indexOf:aByte startingAt:start
    "return the index of the first occurrence of the argument, aByte
     in the receiver starting at start, anInteger; return 0 if not found.
     - reimplemented here for speed"

%{  /* NOCONTEXT */

    REGISTER unsigned char *cp;
    REGISTER int index, byteValue;
    REGISTER int len;
    OBJ cls;

    if (__isSmallInteger(aByte) &&__isBytes(self)) {
	byteValue = __intVal(aByte);

	if (byteValue & ~0xFF /* i.e. (byteValue < 0) || (byteValue > 255) */) {
	    /*
	     * searching for something which cannot be found
	     */
	    RETURN ( __MKSMALLINT(0) );
	}

	if (__isSmallInteger(start)) {
	    index = __intVal(start);
	    len = __byteArraySize(self);
	    cp = __ByteArrayInstPtr(self)->ba_element;
	    if ((cls = __qClass(self)) != @global(ByteArray)) {
		int nInst;

		nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		cp += nInst;
		len -= nInst;
	    }
	    cp += index - 1;
	    while (index <= len) {
		if (*cp == byteValue) {
		    RETURN ( __MKSMALLINT(index) );
		}
		index++;
		cp++;
	    }
	    RETURN ( __MKSMALLINT(0) );
	}
    }
%}.
    ^ super indexOf:aByte startingAt:start

    "
     #[1 2 3 4 5 6 7 8 9 0 1 2 3 4 5] indexOf:0 
    "
!

isLiteral
    "return true, if the receiver can be used as a literal
     (i.e. can be used in constant arrays)"

    "/ no, simply returning true here is a mistake:
    "/ it could be a subclass of ByteArray 
    "/ (of which the compiler does not know at all ...)

    ^ self class == ByteArray

    "Modified: 22.4.1996 / 12:55:30 / cg"
!

max
    "return the maximum value in the receiver -
     redefined to speedup image processing and sound-player 
     (which need a fast method for this on byteArrays)"

%{  /* NOCONTEXT */

    REGISTER unsigned char *cp;
    REGISTER int index, max;
    int len;

    if (__qClass(self) == @global(ByteArray)) {
	max = 0;
	index = 0;
	len = __qSize(self) - OHDR_SIZE;
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
	while (++index <= len) {
	    if (*cp > max) max = *cp;
	    cp++;
	}
	RETURN ( __MKSMALLINT(max) );
    }
%}.
    ^ super max

    "
     #[1 2 3 1 2 3 1 2 19] max 
    "
! !

!ByteArray methodsFor:'special queries'!

usageCounts
    "return an array filled with value-counts -
     This is needed in the bitmap/image classes to get info on color usage.
     (i.e. to build up a histogram of color usage within an image)."

    |counts|

    counts := Array basicNew:256.

%{  /* STACK: 2000 */

    REGISTER unsigned char *cp;
    REGISTER int nByte;
    REGISTER int index;
    int icounts[256];

    if ((__qClass(self) == @global(ByteArray)) && __isArray(counts)) {
	/*
	 * zero counts
	 */
	for (index=0; index<256; index++) {
	    icounts[index] = 0;
	}

	/*
	 * count
	 */
	nByte = __qSize(self) - OHDR_SIZE;
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
	while (nByte--) {
	    icounts[*cp++]++;
	}

	/*
	 * make it real counts
	 */
	for (index=0; index<256; index++) {
	    __ArrayInstPtr(counts)->a_element[index] = __MKSMALLINT(icounts[index]);
	}
	RETURN ( counts );
    }
%}
.
    self primitiveFailed

    "
     #[1 2 3 1 2 3 1 2 250 251 250 251 255] usageCounts 
    "
!

usedValues
    "return a new ByteArray with all used values (actually a kind of Set);
     This is needed specially in the bitmap/Imageclasses to find used colors 
     of an image."

%{  /* STACK: 400 */

    REGISTER unsigned char *cp;
    unsigned char *endp;
    REGISTER int len;
    OBJ result;
    union {
        unsigned char flags[256];
        int toForceAlignmentOfFlags;
    } f;

#ifdef TO_BE_MEASURED
    int coverage = 0;
#endif

    if (__qClass(self) == @global(ByteArray)) {
        memset(f.flags, 0, sizeof(f.flags));
        len = __qSize(self) - OHDR_SIZE;
        cp = &(__ByteArrayInstPtr(self)->ba_element[0]);

        /* for each used byte, set flag */
        while (len > 0) {
#ifdef TO_BE_MEASURED
            unsigned  byte;

            byte = *cp;
            if (! f.flags[byte]) {
                f.flags[byte] = 1;
                coverage++;
                if (coverage == 256) {
                    /* no need to scan rest */
                    break;
                }
            }
#else
            f.flags[*cp] = 1;
#endif
            cp++;
            len--;
        }

        /* count 1's */
        len = 0;
        for (cp=f.flags, endp=f.flags+256; cp < endp;) {
            if ( *((unsigned int *)cp)) {
                if (cp[0]) len++;
                if (cp[1]) len++;
                if (cp[2]) len++;
                if (cp[3]) len++;
            }
            cp += 4;
        }

        /* create ByteArray of used values */
        result = __BYTEARRAY_UNINITIALIZED_NEW_INT(len);
        if (result) {
            cp = __ByteArrayInstPtr(result)->ba_element;
            for (len=0; len < 256; len++) {
                if (f.flags[len]) 
                    *cp++ = len;
            }
            RETURN ( result );
        }
    }
%}.
    ^ self asIdentitySet asByteArray

    "
     #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues 
    "
! !

!ByteArray class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.84 1997-08-22 17:56:29 cg Exp $'
! !