"
 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-Indexed'
!

ByteArray comment:'

COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

ByteArrays store integers in the range 0..255
unlike Smalltalk/80, my ByteArrays have fixed size - may change

$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.8 1994-02-25 12:54:53 claus Exp $

written spring 89 by claus
'!

!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:'resizing'!

grow:sizeIncr
    "report an error - ByteArrays cannot grow"

    self fixedSizeError
! !

!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. use, when contents will be set anyway shortly after."

%{  /* NOCONTEXT */
    OBJ newobj;
    INT instsize, nInstVars, nindexedinstvars;
    REGISTER OBJ *op;
    extern OBJ new();

    if (_isSmallInteger(anInteger)) {
        nindexedinstvars = _intVal(anInteger);
        if (nindexedinstvars >= 0) {
            nInstVars = _intVal(_ClassInstPtr(self)->c_ninstvars);
            if ((_intVal(_ClassInstPtr(self)->c_flags) & ARRAYMASK) == BYTEARRAY) {
                instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(char);
                PROTECT_CONTEXT
                _qNew(newobj, instsize, SENDER);
                UNPROTECT_CONTEXT
                if (newobj) {
                    _InstPtr(newobj)->o_class = self;
#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
                    RETURN ( newobj );
                }
            }
        }
    }
%}
.
    (anInteger isMemberOf:SmallInteger) ifTrue:[
        (anInteger < 0) ifTrue:[
            self error:'bad (negative) argument to new'
        ] ifFalse:[
            ObjectMemory allocationFailureSignal raise.
        ].
        ^ nil
    ].
    ^ self basicNew:anInteger

! !

!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 ((cls = _qClass(self)) != ByteArray)
            indx += _intVal(_ClassInstPtr(cls)->c_ninstvars) * sizeof(OBJ);
        nIndex = _qSize(self) - OHDR_SIZE;
        if ((indx > 0) && (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 (_isSmallInteger(index) && _isSmallInteger(value)) {
        val = _intVal(value);
        if ((val >= 0) && (val <= 255)) {
            indx = _intVal(index);
            if ((cls = _qClass(self)) != ByteArray)
                indx += _intVal(_ClassInstPtr(cls)->c_ninstvars) * sizeof(OBJ);
            nIndex = _qSize(self) - OHDR_SIZE;
            if ((indx > 0) && (indx <= nIndex)) {
                _ByteArrayInstPtr(self)->ba_element[indx - 1] = val;
                RETURN ( value );
            }
        }
    }
%}
.
    ^ super basicAt:index put:value
!

byteAt:index
    "return the byte at index
     - for ST-80 compatibility"

    ^ self at:index
!

byteAt:index put:aByteValuedInteger
    "return the byte at index
     - for ST-80 compatibility"

    ^ self at:index put:aByteValuedInteger
!

wordAt:index
    "return the 2-bytes starting at index as an (unsigned) Integer.
     Question: should it be signed ?"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    extern OBJ _makeLarge();

    if (_isSmallInteger(index)) {
        indx = _intVal(index);
        if (_qClass(self) != ByteArray)
            indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) * sizeof(OBJ);
        nIndex = _qSize(self) - OHDR_SIZE;
        if ((indx > 0) && ((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.
     Question: should it be signed ?"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    extern OBJ _makeLarge();

    if (_isSmallInteger(index) && _isSmallInteger(value)) {
        indx = _intVal(index);
        if (_qClass(self) != ByteArray)
            indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) * sizeof(OBJ);
        nIndex = _qSize(self) - OHDR_SIZE;
        if ((indx > 0) && ((indx+1) <= nIndex)) {
            val = _intVal(value);
            if ((val >= 0) && (val <= 0xFFFF)) {
                _ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
                val >>= 8;
                _ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
                RETURN ( value );
            }
        }
    }
%}
.
    (value < 0) ifTrue:[
        ^ self elementBoundsError
    ].
    self at:index put:(value \\ 256).
    self at:index + 1 put:(value // 256).
    ^ value
!

signedWordAt:index
    "return the 2-bytes starting at index as a signed Integer."

    |w|

    w := self wordAt:index.
    (w > 16r7FFF) ifTrue:[
        ^ w - 16r10000
    ].
    ^ w

    "
    |b|
    b := ByteArray new:4.
    b signedWordAt:1 put:-1.
    b wordAt:1
    "
!

signedWordAt:index put:value
    "set the 2-bytes starting at index from the signed Integer value."

    value > 0 ifTrue:[
        ^ self wordAt:index put:value
    ].
    ^ self wordAt:index put:(16r10000 + value)
!

doubleWordAt:index
    "return the 4-bytes starting at index as an (unsigned) Integer.
     question: should it be signed ?"

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    extern OBJ _makeLarge();

    if (_isSmallInteger(index)) {
        indx = _intVal(index);
        if (_qClass(self) != ByteArray)
            indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) * sizeof(OBJ);
        nIndex = _qSize(self) - OHDR_SIZE;
        if ((indx > 0) && ((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) );
            }
        }
    }
%}
.
    ^ ((self wordAt:index+2) * (256 *256)) + (self wordAt:index)
!

doubleWordAt:index put:value
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     question: should it be signed ?"

    |t|

%{  /* NOCONTEXT */

    REGISTER int indx;
    int nIndex;
    int val;
    extern OBJ _makeLarge();

    if (_isSmallInteger(index) && _isSmallInteger(value)) {
        val = _intVal(value);
        if (val >= 0) {
            indx = _intVal(index);
            if (_qClass(self) != ByteArray)
                indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) * sizeof(OBJ);
            nIndex = _qSize(self) - OHDR_SIZE;
            if ((indx > 0) && ((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 - (t * 256 * 256)).
    ^ value
!

signedDoubleWordAt:index
    "return the 4-bytes starting at index as a signed Integer."

    |w|

    "stupid: due to an STC bug, cannot currently have LargeInteger
     constants - change 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 signedDoubleWordAt:1 put:-1.
    b doubleWordAt:1
    "
!

signedDoubleWordAt:index put:value
    "set the 4-bytes starting at index from the signed Integer value."

    value > 0 ifTrue:[
        ^ self doubleWordAt:index put:value
    ].
    "stupid: due to an STC bug, cannot currently have LargeInteger
     constants - change when fixed ..."
    ^ self doubleWordAt:index put:((16r10000000 * 16r10) + value)
"
    ^ self doubleWordAt:index put:(16r100000000 + value)
"

!

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.
     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.
    UninterpretedBytes isBigEndian ifTrue:[
        5 to:8 do:[:destIndex|
            newFloat basicAt:destIndex put:(self at:index - 5 + destIndex)
        ].
    ] ifFalse:[
        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 ifTrue:[
        5 to:8 do:[:srcIndex|
            self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex)
        ].
    ] ifFalse:[
        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
! !

!ByteArray methodsFor:'converting'!

asByteArray
    "return the receiver as a byteArray"

    "could be an instance of a subclass..."
    self class == ByteArray ifTrue:[
        ^ self
    ].
    ^ super 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)"

    ^ true
!

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

!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;

    if (! _isSmallInteger(aByte)) {
        RETURN ( _MKSMALLINT(0) );
    }

    byteValue = _intVal(aByte);

    if ((byteValue < 0) || (byteValue > 255)) {
        RETURN ( _MKSMALLINT(0) );
    }

    if (_isSmallInteger(start)) {
        index = _intVal(start);
        len = _qSize(self) - OHDR_SIZE;
        cp = &(_ByteArrayInstPtr(self)->ba_element[0]);
        if (_qClass(self) != ByteArray) {
            int nInst;

            nInst = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) * sizeof(OBJ);
            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
!

usedValues
    "return a new ByteArray with all used values (actually a kind of Set);
     needed specially for Image class."

    |result l|

%{  /* STACK: 400 */

    REGISTER unsigned char *cp;
    REGISTER int len;
    unsigned char flags[256];
    static struct inlineCache nw = _ILC1;
    extern OBJ ByteArray, _new_;

    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, _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
!

usageCounts
    "return an array filled with value-counts -
     added for Image handling"

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

maximumValue
    "return the maximum value in the receiver -
     added for sound-player (which needs a fast method for this)"

%{  /* 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) );
    }
%}
.
    self primitiveFailed
! !

!ByteArray methodsFor:'filling and replacing'!

replaceFrom:start to:stop with:aCollection startingAt:repStart
    "reimplemented for speed"

%{  /* NOCONTEXT */

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

    if ((_qClass(self) == ByteArray)
     && (_Class(aCollection) == ByteArray)
     && _isSmallInteger(start)
     && _isSmallInteger(stop)
     && _isSmallInteger(repStart)) {
        startIndex = _intVal(start) - 1;
        if (startIndex >= 0) {
          nIndex = _qSize(self) - OHDR_SIZE;
          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;
              repStopIndex = repStartIndex + (stopIndex - startIndex);
              if (repStopIndex < repNIndex) {
                src = &(_ByteArrayInstPtr(aCollection)->ba_element[repStartIndex]);
                dst = &(_ByteArrayInstPtr(self)->ba_element[startIndex]);

                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
                bcopy(src, dst, count);
#else
                while (count-- > 0) {
                    *dst++ = *src++;
                }
#endif
                RETURN ( self );
              }
            }
          }
        }
    }
%}
.
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
! !

!ByteArray methodsFor:'image manipulation'!

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 = _qSize(self) - OHDR_SIZE;
        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"

%{  /* NOCONTEXT */

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

    if (_qClass(self) == ByteArray) {
        cnt = _qSize(self) - OHDR_SIZE;
        p1 = _ByteArrayInstPtr(self)->ba_element;
        p2 = _ByteArrayInstPtr(self)->ba_element + 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.
     - used to display mono, 2-bit and 4-bit bitmaps on grey-scale/color
       machines"

%{  /* 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)
     && _isSmallInteger(height)
     && _isSmallInteger(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 ((_qSize(aMapByteArray) - OHDR_SIZE) < ncells)
                goto fail;
        }

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

        if (((_qSize(self) - OHDR_SIZE) >= srcBytes)
         && ((_qSize(aByteArray) - OHDR_SIZE) >= 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
! !