"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1993 by Claus Gittinger

 COPYRIGHT (c) 2018 Jan Vrany

              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.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

ArrayedCollection subclass:#UninterpretedBytes

	instanceVariableNames:''

	classVariableNames:'IsBigEndian'

	poolDictionaries:''

	category:'Collections-Abstract'

!

!UninterpretedBytes primitiveDefinitions!

%{

/*

 * Notice: I am abstract, and my subclasses may be anything.

 * Therefore, the code must always handle the fallback case

 * where the receiver is neither an ExternalBytes nor a ByteArray.

 * (which are, however, the most common)

 *

 * macro to fetch my byte address and size-in-bytes;

 * convenient for inline-C code.

 * (yes, C is bad ...)

 */

#define __fetchBytePointerAndSize__(o, pPtr, pSize) \

    {\

      if (__isNonNilObject(o)) { \

        if (__isByteArrayLike(o)) { \

          *(pPtr) = (unsigned char *)__ByteArrayInstPtr(o)->ba_element; \

          *(pSize) = __byteArraySize(o); \

        } else if (__qIsExternalBytesLike(o)) { \

          OBJ __sz__ = __externalBytesSize(o); \

          if (__isSmallInteger(__sz__)) { \

            *(pSize) = __intVal(__sz__); \

            *(pPtr) = (unsigned char *)(__externalBytesAddress(o)); \

          } else { \

            *(pSize) = 0; \

            *(pPtr) = (unsigned char *)0; \

          } \

        } else { \

            *(pSize) /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(o))->c_ninstvars)); \

            *(pPtr) = (char *)(__InstPtr(self)) + *(pSize) /* nInstBytes */; \

            *(pSize) = __qSize(self) - *(pSize) /* nInstBytes */; \

        } \

      } else { \

        *(pSize) = 0; \

        *(pPtr) = (unsigned char *)0; \

      } \

    }

%}

! !

!UninterpretedBytes class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

 COPYRIGHT (c) 2018 Jan Vrany

              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

"

    UninterpretedBytes provides the common protocol for byte-storage

    containers; concrete subclasses are

        ByteArray (which store the bytes within the Smalltalk object memory)

        String    (knows that the bytes represent characters)

    and

        ExternalBytes (which store the bytes in the malloc-heap).

    UninterpretedBytes itself is abstract, so no instances of it can be created.

    [See also:]

        ByteArray String ExternalBytes

    [author:]

        Claus Gittinger

    [Notice:]

        Notice the confusion due to multiple methods with the same

        functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').

        The reason is that at the time this class was written,

        ST80 did not offer protocol to specify the byteOrder, and

        ST/X provided methods ending in 'MSB:' for this.

        In the meanwhile, VW added protocol ending in 'bigEndian:',

        which has been added here for compatibility.

        (certainly a point, where an ansi-standard will help)

"

! !

!UninterpretedBytes class methodsFor:'initialization'!

initialize

    IsBigEndian := self isBigEndian.

! !

!UninterpretedBytes class methodsFor:'instance creation'!

from:aByteArray

    "return new instance which is a copy of aByteArray"

    |len bytes|

    len := aByteArray size.

    bytes := self new:len.

    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:1.

    ^ bytes

    "

      String from:#[40 41 42]

      String with:#[40 41 42 43 44 45 46 47 48 49 50] from:2 to:5

    "

!

fromHexString:aString

    "decode a byteArray from a hex string (as generated by hexPrintOn:)"

    | sz bytes s hi lo |

    sz := aString size.

    sz == 0 ifTrue:[^ self new].

    sz odd ifTrue:[ ConversionError raiseWith:aString errorString:'invalid hex string (odd size)' ].

    bytes := self new: sz // 2.

    s := aString readStream.

    1 to: sz // 2 do: [ :idx |

        hi := s next digitValue.

        lo := s next digitValue.

        bytes at:idx put: ((hi bitShift:4) bitOr: lo)

    ].

    ^ bytes

    "

     ByteArray fromHexString:'1234FEFF'

     ExternalBytes fromHexString:'1234FEFF'

    "

    "

     |s|

     s := String streamContents:[:s | #[1 2 3] hexPrintOn:s].

     ByteArray fromHexString:s

    "

    "

     Time millisecondsToRun:[

        1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]

     ].

    "

    "Modified (comment): / 28-08-2013 / 20:40:04 / cg"

!

fromHexStringWithSeparators:aString

    "read a bytearray from a printed string representation, where

     individual bytes are encoded as two hex digits, optionally separated by whiteSpace.

     See also fromHexString:, which does something similar, but does not allow for spaces"

    ^ self streamContents:[:outStream |

        |inStream h|

        inStream := aString readStream.

        [

            inStream skipSeparators.

            inStream atEnd

        ] whileFalse:[

            h := inStream next:2.

            outStream nextPut:(Integer readFrom:h base:16).

        ].

    ].

    "

     ByteArray fromHexString:'1234FEFF'

     ByteArray fromHexStringWithSeparators:'   12  34 FE FF'

    "

!

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

     Every 6 bit packet is encoded as a character in 32..95.

     Characters below 32 are ignored (so line breaks can be inserted at any place).

     An addition final byte defines how many bytes of the last triple are valid.

     This is somewhat like the radix-encoding used in good old PDP11 times ;-)

     ST-80 uses this encoding for Images ...

     This is a base64 encoding, very similar (but not equal) to the algorithm used in RFC1421.

     PS: It took a while to figure that one out ...

     PPS: I don't like it ;-)"

    |index    "{ Class: SmallInteger }"

     dstIndex "{ Class: SmallInteger }"

     stop     "{ Class: SmallInteger }"

     sixBits  "{ Class: SmallInteger }"

     n        "{ Class: SmallInteger }"

     sz       "{ Class: SmallInteger }"

     last bytes|

    sz := aString size.

    sz == 0 ifTrue:[^ self new].

    sz := sz - (aString count:[:ch | ch codePoint < 32]).

    stop := sz // 4 * 3.

    "the size modulo 3 is encoded in the last character, if it is in the

     range 97 .. otherwise, its exact."

    last := aString last codePoint.

    last > 96 ifTrue:[

        stop := stop - 3 + (last - 96)

    ].

    bytes := self new:stop.

    index := 1. dstIndex := 1.

    [dstIndex <= stop] whileTrue:[

        "/ take 4 characters ...

        "/ allow a line break before each group of 4

        sixBits := (aString at:index) codePoint.

        [sixBits < 32] whileTrue:[

            index := index + 1.

            sixBits := (aString at:index) codePoint.

        ].

        sixBits := sixBits bitAnd:16r3F.

        n := sixBits.

        "/ self assert:(aString at:index+1) codePoint >= 32.

        sixBits := (aString at:index+1) codePoint bitAnd:16r3F.

        n := (n bitShift:6) + sixBits.

        "/ self assert:(aString at:index+2) codePoint >= 32.

        sixBits := (aString at:index+2) codePoint bitAnd:16r3F.

        n := (n bitShift:6) + sixBits.

        "/ self assert:(aString at:index+3) codePoint >= 32.

        sixBits := (aString at:index+3) codePoint bitAnd:16r3F.

        n := (n bitShift:6) + sixBits.

        index := index + 4.

        "/ now have 24 bits in n

        bytes at:dstIndex put:(n bitShift:-16).

        dstIndex < stop ifTrue:[

            bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).

            dstIndex+2 <= stop ifTrue:[

                bytes at:dstIndex+2 put:(n bitAnd:16rFF).

            ]

        ].

        dstIndex := dstIndex + 3.

    ].

    ^ bytes

    "

     ByteArray fromPackedString:(#[1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString)

     ByteArray fromPackedString:((ByteArray new:256) asPackedString)

     ByteArray fromPackedString:((ByteArray new:128) asPackedString)

     ByteArray fromPackedString:((ByteArray new:129) asPackedString)

     ByteArray fromPackedString:((ByteArray new:130) asPackedString)

     ByteArray fromPackedString:((ByteArray new:131) asPackedString)

     ByteArray fromPackedString:((ByteArray new:132) asPackedString)

     ByteArray fromPackedString:((ByteArray new:64) asPackedString)

     0 to:256 do:[:l |

        |orig copy|

        0 to:255 do:[:fill |

            orig := ByteArray new:l withAll:fill.

            copy := ByteArray fromPackedString:(orig asPackedString).

            self assert:(orig = copy).

         ]

     ]

    "

    "Modified: / 6.3.1997 / 15:28:52 / cg"

    "Modified: / 18.12.1997 / 17:17:11 / stefan"

!

uninitializedNew:anInteger

    "return a new instance of the receiver with uninitialized

     (i.e. undefined) contents. The indexed elements have any random

     value. However, any named instance variables are still nilled.

     For use, when contents will be set anyway shortly after - this

     is a bit faster than the regular basicNew:, which clears the bytes.

     Of course, it only makes a difference for very big ByteArrays, such

     as used for images/bitmaps.

     Notice: if you want to port code using uninitializedNew: to another

     smalltalk, you have to add an 'uninitializedNew: -> basicNew:'-calling

     method to the ByteArray class of the other smalltalk."

%{  /* NOCONTEXT */

    OBJ newobj;

    INT instsize, nInstVars, nindexedinstvars;

    REGISTER OBJ *op;

    if (__isSmallInteger(anInteger)) {

        nindexedinstvars = __intVal(anInteger);

        if (nindexedinstvars >= 0) {

            if (self == ByteArray) {

                /*

                 * the most common case

                 */

                instsize = OHDR_SIZE + nindexedinstvars;

                if (__CanDoQuickNew(instsize)) {        /* OBJECT ALLOCATION */

                    __qCheckedNew(newobj, instsize);

                    __InstPtr(newobj)->o_class = self;

                    __qSTORE(newobj, self);

                    RETURN (newobj );

                }

            } else {

                /*

                 * Take care for subclasses like TwoByteString

                 */

                switch (__smallIntegerVal(__ClassInstPtr(self)->c_flags) & ARRAYMASK) {

                case BYTEARRAY:

                    break;

                case WORDARRAY:

                case SWORDARRAY:

                    nindexedinstvars *= 2;

                    break;

                case LONGARRAY:

                case SLONGARRAY:

                    nindexedinstvars *= 4;

                    break;

                default:

                    /* don't know about this array type, delegate to super */

                    goto out;

                }

            }

            nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);

            instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;

            __PROTECT_CONTEXT__

            __qNew(newobj, instsize);   /* OBJECT ALLOCATION */

            __UNPROTECT_CONTEXT__

            if (newobj != nil) {

                __InstPtr(newobj)->o_class = self;

                __qSTORE(newobj, self);

                if (nInstVars) {

                    /*

                     * still have to nil out named instvars ...

                     */

#if defined(memset4) && defined(FAST_OBJECT_MEMSET4)

                    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);

#else

# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)

                    /*

                     * knowing that nil is 0

                     */

                    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);

# else

                    op = __InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

# endif

#endif

                }

                RETURN ( newobj );

            }

        }

    }

out:;

%}.

    ^ self basicNew:anInteger

!

with:aByteArray from:start to:stop

    "return new instance with a copy of aByteArray

     beginning at index start up to and including index stop"

    |len bytes|

    len := stop-start+1.

    bytes := self new:len.

    bytes replaceBytesFrom:1 to:len with:aByteArray startingAt:start.

    ^ bytes

    "

      String with:#[40 41 42 43 44 45 46 47 48 49 50] from:2 to:5

    "

! !

!UninterpretedBytes class methodsFor:'queries'!

isAbstract

    "Return if this class is an abstract class.

     True is returned for UninterpretedBytes here; false for subclasses.

     Abstract subclasses must redefine this again."

    ^ self == UninterpretedBytes

!

isBigEndian

    "return true, if words/shorts store the most-significant

     byte first (MSB), false if least-sign.-first (LSB).

     I.e. false for vax, intel; true for m68k, sun.

     Notice: UninterpretedBytes isBigEndian

             this is inlined both by stc and the jit compiler"

%{  /* NOCONTEXT */

#if defined(__MSBFIRST__)

    RETURN (true);

#else

# if defined(__LSBFIRST__)

    RETURN (false);

# else

    /*

     * I don't like ifdefs - you always forget some ...

     * therefore we look into a structure at run-time.

     * (also, there are CPUs around [mips], where the byteorder

     *  is programmable, and which come in different flavours)

     *

     * NOTICE:

     *    both the JIT and stc may inline this to a

     *    constant for systems where this is known.

     */

    union {

        unsigned int   u_l;

        char           u_c[sizeof(int)];

    } u;

    u.u_l = 0x87654321;

    if (u.u_c[0] == 0x21) RETURN (false);

    RETURN (true);

# endif

#endif

%}.

    ^ false     "/ an arbitrary default

    "

     UninterpretedBytes isBigEndian

    "

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned, since UninterpretedBytes is the superclass of

     some builtIn classes (ByteArray & ExternalBytes)"

    ^ self == UninterpretedBytes

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

    "Modified: / 5.3.1998 / 14:56:22 / stefan"

! !

!UninterpretedBytes methodsFor:'@ OLE Extensions'!

addressAtOffset: index0Based

    "Answer the bytes starting at index0Based (0 based offset)

     as anExternalAddress.  Answer nil if there is no address.

     Notice: Offsets are zero relative."

    | address |

    address := self pointerValueAt: index0Based + 1.

    ^ address = 0

        ifTrue: [ nil ]

        ifFalse: [ ExternalAddress newAddress: address  ]

    "Modified: / 30-03-2016 / 11:00:19 / cg"

!