added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
"
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) {
_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)) != 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 normalize
"
|b|
b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
(b quadWordAt:1 MSB:false) printStringRadix:16
"
!
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
"
!
signedDoubleWordAt:index
"return the 4-bytes starting at index as a signed Integer.
The value is retrieved in the machines natural byte order."
|w|
"
stupid: due to an STC bug, cannot currently have LargeInteger
constants - change to code below when fixed ...
"
w := self doubleWordAt:index.
(w > (16r7FFFFFF * 16r10 + 16rF)) ifTrue:[
^ w - (16r10000000 * 16r10)
].
^ w
"
w := self doubleWordAt:index.
(w > 16r7FFFFFFF) ifTrue:[
^ w - 16r100000000
].
^ w
"
"
|b|
b := ByteArray new:4.
b doubleWordAt:1 put:16rFFFFFFFF.
(b signedDoubleWordAt:1)
"
!
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."
|w|
"
stupid: due to an STC bug, cannot currently have LargeInteger
constants - change to code below when fixed ...
"
w := self doubleWordAt:index MSB:msb.
(w > (16r7FFFFFF * 16r10 + 16rF)) ifTrue:[
^ w - (16r10000000 * 16r10)
].
^ w
"
w := self doubleWordAt:index.
(w > 16r7FFFFFFF) ifTrue:[
^ w - 16r100000000
].
^ w
"
"
|b|
b := ByteArray new:4.
b doubleWordAt:1 put:16rFFFFFFFF.
(b signedDoubleWordAt:1)
"
!
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."
|v|
value > 0 ifTrue:[
v := value
] ifFalse:[
"
stupid: due to an STC bug, cannot currently have LargeInteger
constants - change to code below when fixed ...
"
v := value + (16r10000000 * 16r10)
"//// v := value + 16r100000000
].
self doubleWordAt:index put:v.
^ value
"
|b|
b := ByteArray new:4.
b signedDoubleWordAt:1 put:-1.
(b doubleWordAt:1) printStringRadix:16
"
!
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."
|v|
value > 0 ifTrue:[
v := value
] ifFalse:[
"
stupid: due to an STC bug, cannot currently have LargeInteger
constants - change to code below when fixed ...
"
v := value + (16r10000000 * 16r10)
"//// 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
"
!
signedWordAt:index
"return the 2-bytes starting at index as a signed Integer.
The value is retrieved in the machines natural byte order."
|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
"
!
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"
|w "{ Class: SmallInteger }"|
w := self wordAt:index MSB:msb.
(w > 16r7FFF) ifTrue:[
^ w - 16r10000
].
^ w
"
|b|
b := ByteArray new:2.
b wordAt:1 put:16rFFFF.
b signedWordAt:1
"
!
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."
|v|
value > 0 ifTrue:[
v := value
] ifFalse:[
v := 16r10000 + value
].
self wordAt:index put:v.
^ value
"
|b|
b := ByteArray new:4.
b signedWordAt:1 put:-1.
b signedWordAt:3 put:-2.
b inspect
"
!
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"
|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
"
!
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)) != 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)) != 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)) != 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)) != 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
"
! !
!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."
"not, if I have named instance variables"
self class instSize ~~ 0 ifTrue:[
^ super storeBinaryDefinitionOn:stream manager:manager
].
manager putIdOfClass:(self class) on: stream.
stream nextNumber:4 put:(self basicSize).
stream nextPutAll:(self asByteArray)
! !
!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 */
#if !defined(FAST_MEMCPY)
REGISTER unsigned char *srcp;
#endif
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, SENDER);
__UNPROTECT_CONTEXT__
if (newByteArray != nil) {
_InstPtr(newByteArray)->o_class = ByteArray;
dstp = _ByteArrayInstPtr(newByteArray)->ba_element;
#ifdef FAST_MEMCPY
bcopy(_ByteArrayInstPtr(self)->ba_element + index1 - 1, dstp, count);
#else
srcp = _ByteArrayInstPtr(self)->ba_element + index1 - 1;
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;
int nInst;
OBJ cls;
if (__isSmallInteger(aNumber)
&& __bothSmallInteger(start, stop)) {
len = __byteArraySize(self);
index1 = _intVal(start);
index2 = _intVal(stop);
dstp = _ByteArrayInstPtr(self)->ba_element + index1 - 1;
if ((cls = __qClass(self)) != ByteArray) {
nInst = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
dstp += nInst;
len -= nInst;
}
value = _intVal(aNumber);
if (((value & ~0xFF) == 0) /* i.e. (value >= 0) && (value <= 255) */
&& (index1 <= index2)
&& (index1 > 0)) {
if (index2 <= len) {
count = index2 - index1 + 1;
#ifdef FAST_MEMSET
memset(dstp, count, value);
#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
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;
int nInst;
if (__isBytes(aCollection)
&& __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)) != ByteArray) {
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)) != ByteArray) {
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 FAST_MEMCPY
# ifdef bcopy4
if (((src & 3) == 0)
&& ((dst & 3) == 0)) {
/* copy aligned part */
bcopy4(src, dst, count//4);
/* copy rest */
if (count & 3) {
src += (count & ~3);
dst += (count & ~3);
count = count & 3;
while (count--) {
*dst++ = *src++;
}
}
} else
# endif /* bcopy4 */
bcopy(src, dst, count);
#else
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 from another collection"
(aCollection class == self class) ifTrue:[
^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
].
^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
! !
!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;
int bytesPerRow, mask, shift0, shift;
int w, h, hrun;
int srcBytes, dstBytes;
int bitsPerPixel;
int bits;
int ncells;
unsigned char *map;
if ((__qClass(self) == ByteArray)
&& (__qClass(aByteArray) == ByteArray)
&& __isSmallInteger(nBitsPerPixel)
&& __bothSmallInteger(height, width)) {
if ((aMapByteArray != nil)
&& (__Class(aMapByteArray) == 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:
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)
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) {
*dst++ = bits;
bits = 0; shift = 8;
}
}
} else {
for (wrun=w; wrun; wrun--) {
bits = (bits << bitsPerPixel) | (*src++ & mask);
shift -= bitsPerPixel;
if (shift == 0) {
*dst++ = bits;
bits = 0; shift = 8;
}
}
}
if (shift != 8) {
*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) == ByteArray)
&& (__qClass(aByteArray) == ByteArray)
&& __isSmallInteger(nBitsPerPixel)
&& __bothSmallInteger(height, width)) {
if ((aMapByteArray != nil)
&& (__Class(aMapByteArray) == 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:
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)
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) {
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 );
}
}
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) == ByteArray) {
cnt = __byteArraySize(self);
dst = _ByteArrayInstPtr(self)->ba_element;
if (! ((int)dst & (sizeof(long)-1))) {
ldst = (unsigned long *)dst;
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 order of 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) == ByteArray) {
cnt = __byteArraySize(self);
p1 = _ByteArrayInstPtr(self)->ba_element;
p2 = p1 + cnt - 1;
while (cnt > 0) {
t = *p1;
*p1++ = *p2;
*p2-- = t;
cnt-=2;
}
RETURN ( self );
}
%}.
^ super 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) == 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 -
written as a primitive for speed on image grabbing (if display order is different)"
%{ /* NOCONTEXT */
REGISTER unsigned char *p;
REGISTER int cnt;
REGISTER unsigned t1, t2;
if (__qClass(self) == 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}"
stop "{ Class:SmallInteger}"
n "{ 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:[
n := n bitOr:((self at:(index + 1)) bitShift:8).
(index + 1 < 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.
].
stop \\ 3 ~~ 0 ifTrue:[
outStream position:(outStream position - 1).
outStream nextPut:(Character value:(stop \\ 3 + 96)).
].
^ outStream contents
!
displayString
^ self storeString
"Created: 25.10.1995 / 13:33:26 / cg"
!
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
!
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:[
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
"
! !
!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)) {
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)) != 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
"
!
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) == 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
"
!
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) == 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
in an image."
|result l|
%{ /* STACK: 400 */
REGISTER unsigned char *cp;
REGISTER int len;
unsigned char flags[256];
static struct inlineCache nw = _ILC1;
if (__qClass(self) == ByteArray) {
memset(flags, 0, sizeof(flags));
len = __qSize(self) - OHDR_SIZE;
cp = &(_ByteArrayInstPtr(self)->ba_element[0]);
/* for each used byte, set flag */
while (len > 0) {
flags[*cp] = 1;
cp++;
len--;
}
/* count 1's */
len = 0;
for (cp=flags+255; cp >= flags; cp--)
if (*cp) len++;
/* create ByteArray of used values */
result = (*nw.ilc_func)(ByteArray,
@symbol(new:),
CON_COMMA nil, &nw,
_MKSMALLINT(len));
if (__Class(result) == ByteArray) {
cp = &(_ByteArrayInstPtr(result)->ba_element[0]);
for (len=0; len < 256; len++) {
if (flags[len])
*cp++ = len;
}
}
RETURN ( result );
}
%}
.
^ self asSet
"
#[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.44 1996-02-02 19:20:45 cg Exp $'
! !