.
"
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 comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.25 1995-05-01 21:28:19 claus Exp $
'!
!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.
"
!
version
"
$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.25 1995-05-01 21:28:19 claus Exp $
"
!
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 dens & 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:'queries'!
isBuiltInClass
"this class is known by the run-time-system"
^ self == ByteArray
! !
!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 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 putIdOf: self class on: stream.
stream nextNumber: 4 put: self basicSize.
stream nextPutAll: self asByteArray
! !
!ByteArray class methodsFor:'instance creation'!
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;
extern OBJ new();
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;
if (nInstVars) {
/*
* still have to nil out named instvars ...
*/
#if 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
!
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)
ST-80 uses this encoding for Images ...
PS: I dont like it ;-)"
|index dstIndex stop n sz 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)
"
! !
!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
!
wordAt:index
"return the 2-bytes starting at index as an (unsigned) Integer.
The value is retrieved LSB-first (i.e. low 8-bits at lower byte index).
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) {
val = _ByteArrayInstPtr(self)->ba_element[indx+1-1];
val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1];
RETURN ( _MKSMALLINT(val) );
}
}
}
%}
.
^ ((self at:index+1) * 256) + (self at:index)
!
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 LSB-first - i.e. the low 8bits are stored at the
lower address.
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) */) {
_ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
_ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF;
RETURN ( value );
}
}
}
}
%}
.
(value < 0) ifTrue:[
^ self elementBoundsError
].
self at:index put:(value \\ 256).
self at:index + 1 put:(value // 256).
^ value
"
|b|
b := ByteArray new:4.
b wordAt:1 put:16r0102.
b wordAt:3 put:16r0304.
b inspect
"
!
signedWordAt:index
"return the 2-bytes starting at index as a signed Integer.
The value is retrieved LSB-first (i.e. low 8-bits at lower byte index)"
|w|
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 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 LSB-first (i.e. low 8-bits at lower byte index)"
value > 0 ifTrue:[
^ self wordAt:index put:value
].
^ self wordAt:index put:(16r10000 + value)
"
|b|
b := ByteArray new:4.
b signedWordAt:1 put:-1.
b signedWordAt:3 put:-2.
b inspect
"
!
doubleWordAt:index
"return the 4-bytes starting at index as an (unsigned) Integer.
The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index).
question: 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) {
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) );
}
}
}
/*
* fall through in case of any error
* it will be handled in wordAt: finally
*/
%}
.
^ ((256 * 256) * (self wordAt:index+2)) + (self wordAt:index)
"
|b|
b := ByteArray withAll:#(1 2 3 4).
(b doubleWordAt:1) printStringRadix:16
"
!
doubleWordAt:index put:value
"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 LSB-first (i.e. low 8-bits at lowest byte-index).
question: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
|t|
%{ /* NOCONTEXT */
REGISTER int indx;
int nIndex;
int val;
OBJ cls;
if (__bothSmallInteger(index, value)) {
val = _intVal(value);
if (val >= 0) {
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-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 );
}
}
}
}
%}
.
(value < 0) ifTrue:[
^ self elementBoundsError
].
t := value // (256 * 256).
self wordAt:(index+2) put:t.
self wordAt:(index) put:(value - (256 * 256 * t)).
^ value
"
|b|
b := ByteArray new:4.
b doubleWordAt:1 put:16r04030201.
b inspect
"
!
signedDoubleWordAt:index
"return the 4-bytes starting at index as a signed Integer.
The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index)."
|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 put:value
"set the 4-bytes starting at index from the signed Integer value.
The value is stored LSB-first (i.e. low 8-bits at lowest byte-index)."
value > 0 ifTrue:[
^ self doubleWordAt:index put:value
].
"
stupid: due to an STC bug, cannot currently have LargeInteger
constants - change to code below when fixed ...
"
^ self doubleWordAt:index put:((16r10000000 * 16r10) + value)
"
^ self doubleWordAt:index put:(16r100000000 + value)
"
"
|b|
b := ByteArray new:4.
b signedDoubleWordAt:1 put:-1.
(b doubleWordAt:1) printStringRadix:16
"
!
quadWordAt:index
"return the 8-bytes starting at index as an (unsigned) Integer.
The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index)."
|l bIdx "{ Class: SmallInteger }"|
l := LargeInteger basicNew numberOfDigits:8.
bIdx := index.
1 to:8 do:[:i |
l digitAt:i put:(self basicAt:bIdx).
bIdx := bIdx + 1
].
^ l normalize
"
|b|
b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
(b quadWordAt:1) printStringRadix:16
"
!
quadWordAt:index put:anInteger
"set the 8-bytes starting at index from the (unsigned) Integer value.
The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF.
The value is stored LSB-first (i.e. low 8-bits at lowest byte-index)."
|bIdx "{ Class: SmallInteger }"|
bIdx := index.
1 to:8 do:[:i |
self basicAt:bIdx put:(anInteger digitAt:i).
bIdx := bIdx + 1.
]
"
|b|
b := ByteArray new:8.
b quadWordAtIndex:1 put:16r0807060504030201.
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
!
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
!
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
!
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
! !
!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:'printing & storing'!
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
"
!
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
! !
!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
"
!
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;
extern OBJ ByteArray;
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
"
!
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 new: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
"
!
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
"
! !
!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 >= 0) && (value <= 255)
&& (index1 <= index2)
&& (index1 > 0)) {
if (index2 <= len) {
count = index2 - index1 + 1;
#ifdef FAST_MEMSET
memset(dstp, count, value);
#else
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
!
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
!
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 );
}
}
}
}
}
%}
.
^ super replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
! !
!ByteArray methodsFor:'image manipulation support'!
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
!
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
"
!
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
"
! !