diff -r 606cbaa20296 -r 593f73e7c52c ByteArray.st --- a/ByteArray.st Wed Nov 15 17:06:25 1995 +0100 +++ b/ByteArray.st Wed Nov 15 18:08:15 1995 +0100 @@ -10,8 +10,6 @@ hereby transferred. " -'From Smalltalk/X, Version:2.10.8 on 15-nov-1995 at 04:06:23' ! - ArrayedCollection variableByteSubclass:#ByteArray instanceVariableNames:'' classVariableNames:'' @@ -21,6 +19,20 @@ !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. @@ -42,26 +54,68 @@ " ! -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.37 1995-11-15 03:06:32 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.38 1995-11-15 17:08:15 cg Exp $' ! ! !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 @@ -141,62 +195,6 @@ ^ 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). 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) - - " ! ! !ByteArray class methodsFor:'binary storage'! @@ -222,6 +220,32 @@ !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" @@ -253,32 +277,6 @@ ^ super basicAt:index put:value ! -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 -! - byteAt:index "return the byte at index. For ByteArray, this is the same as basicAt:; @@ -338,261 +336,34 @@ ^ super basicAt:index put:value ! -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; +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." - 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 */ + |newFloat| - 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 + newFloat := Float basicNew. + 1 to:8 do:[:destIndex| + newFloat basicAt:destIndex put:(self at:index - 1 + destIndex) ]. - ^ SubscriptOutOfBoundsSignal raise. - - " - |b| - b := ByteArray new:4. - b wordAt:1 put:16r0102. - b wordAt:3 put:16r0304. - b inspect - " + ^ newFloat. ! -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 - " -! - -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 +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." - " - |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 + 1 to:8 do:[:srcIndex| + self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) ]. - ^ 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 - " + ^ aFloat ! doubleWordAt:index @@ -804,6 +575,170 @@ " ! +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." @@ -920,198 +855,261 @@ " ! -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." +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 }"| - |l - bIdx "{ Class: SmallInteger }" - delta "{ Class: SmallInteger }"| + w := self wordAt:index. + (w > 16r7FFF) ifTrue:[ + ^ w - 16r10000 + ]. + ^ w - l := LargeInteger basicNew numberOfDigits:8. - msb ifTrue:[ - bIdx := index + 7. - delta := -1 - ] ifFalse:[ - bIdx := index. - delta := 1 + " + |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 ]. - 1 to:8 do:[:i | - l digitAt:i put:(self basicAt:bIdx). - bIdx := bIdx + delta - ]. - ^ l normalize + ^ w " |b| - - b := ByteArray withAll:#(1 2 3 4 5 6 7 8). - (b quadWordAt:1 MSB:false) printStringRadix:16 + b := ByteArray new:2. + b wordAt:1 put:16rFFFF. + b signedWordAt:1 " ! -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." +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." - |bIdx "{ Class: SmallInteger }" - delta "{ Class: SmallInteger }"| + |v| - msb ifTrue:[ - bIdx := index + 7. - delta := -1 + value > 0 ifTrue:[ + v := value ] ifFalse:[ - bIdx := index. - delta := 1 + v := 16r10000 + value ]. - 1 to:8 do:[:i | - self basicAt:bIdx put:(anInteger digitAt:i). - bIdx := bIdx + delta. - ]. - ^ anInteger + self wordAt:index put:v. + ^ value " |b| - b := ByteArray new:8. - b quadWordAtIndex:1 put:16r0807060504030201 MSB:false. + 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 " ! -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." +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 */ - |newFloat| + REGISTER int indx; + int nIndex; + union { + char u_char[2]; + unsigned short u_ushort; + } val; + OBJ cls; - 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. + 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. ! -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." +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; - 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. + 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. ! -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." +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 */ - 1 to:8 do:[:srcIndex| - self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) - ]. - ^ aFloat -! + REGISTER int indx; + int nIndex; + int v; + union { + char u_char[2]; + unsigned short u_ushort; + } val; + OBJ cls; -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." + 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. " - 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. + |b| + b := ByteArray new:4. + b wordAt:1 put:16r0102. + b wordAt:3 put:16r0304. + b inspect " - ^ 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." +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. " - 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. + |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 " - ^ 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:'binary storage'! @@ -1262,15 +1260,6 @@ ^ 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." @@ -1365,217 +1354,19 @@ 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'! -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 @@ -1735,51 +1526,217 @@ 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 ! ! !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 - " -! - -displayString - ^ self storeString - - "Created: 25.10.1995 / 13:33:26 / cg" -! - asPackedString "ST-80 compatibility: encode the receiver into an ascii String with 6bits encoded per character. Each group of 6 bits is encoded @@ -1822,6 +1779,47 @@ 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'! @@ -1878,57 +1876,33 @@ " ! -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." +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)" - |result l| - -%{ /* STACK: 400 */ +%{ /* NOCONTEXT */ REGISTER unsigned char *cp; - REGISTER int len; - unsigned char flags[256]; - static struct inlineCache nw = _ILC1; - extern OBJ ByteArray; + REGISTER int index, max; + int len; if (__qClass(self) == ByteArray) { - memset(flags, 0, sizeof(flags)); + max = 0; + index = 0; len = __qSize(self) - OHDR_SIZE; cp = &(_ByteArrayInstPtr(self)->ba_element[0]); - - /* for each used byte, set flag */ - while (len > 0) { - flags[*cp] = 1; + while (++index <= len) { + if (*cp > max) max = *cp; 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 ); + RETURN ( _MKSMALLINT(max) ); } -%} -. - ^ self asSet +%}. + ^ super max " - #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues + #[1 2 3 1 2 3 1 2 19] max " ! @@ -1982,33 +1956,57 @@ " ! -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)" +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." -%{ /* NOCONTEXT */ + |result l| + +%{ /* STACK: 400 */ REGISTER unsigned char *cp; - REGISTER int index, max; - int len; + REGISTER int len; + unsigned char flags[256]; + static struct inlineCache nw = _ILC1; + extern OBJ ByteArray; if (__qClass(self) == ByteArray) { - max = 0; - index = 0; + memset(flags, 0, sizeof(flags)); len = __qSize(self) - OHDR_SIZE; cp = &(_ByteArrayInstPtr(self)->ba_element[0]); - while (++index <= len) { - if (*cp > max) max = *cp; + + /* for each used byte, set flag */ + while (len > 0) { + flags[*cp] = 1; cp++; + len--; } - RETURN ( _MKSMALLINT(max) ); + /* 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 ); } -%}. - ^ super max +%} +. + ^ self asSet " - #[1 2 3 1 2 3 1 2 19] max + #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues " ! !