UninterpretedBytes.st
author Stefan Vogel <sv@exept.de>
Mon, 22 Jun 2015 11:24:02 +0200
changeset 18494 41f8a86105f0
parent 18346 c73f81214ed9
child 18366 a6e62e167c32
child 18600 35de4089788f
permissions -rw-r--r--
class: UnixOperatingSystem changed: #syncFileSystem: disable - defined only in glibc 2.14, but we need to support glibc 2.12

"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 1993 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.
"
"{ 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
	      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 (which is a subclass of ByteArray) 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 sid 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). 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 ...
     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)
    "

    "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 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 dont 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:'Compatibility-Squeak'!

copyFromByteArray:aByteArray
    "copy as much as possible from aByteArray"

    self replaceBytesFrom:1 to:(self size min:aByteArray size) with:aByteArray startingAt:1
!

signedLongAt:index
    "return the 4-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    ^ self longAt:index

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongAt:1 put:16rFFFFFFFF.
     b signedLongAt:1
    "

    "Modified: 1.7.1996 / 21:14:38 / cg"
!

signedLongAt:index put:newValue
    "store a 4-bytes value starting at index.
     The index is a smalltalk index (i.e. 1-based).
     The value is in the machines natural byte order."

    ^ self longAt:index put:newValue

    "
     |b|
     b := ByteArray new:4.
     b signedLongAt:1 put:-1.
     b unsignedLongAt:1
    "

    "Modified: 1.7.1996 / 21:14:38 / cg"
! !

!UninterpretedBytes methodsFor:'Compatibility-V''Age'!

uint32At:zeroBasedIndex
    "return the 4-bytes starting at index as (unsigned) Integer.
     The index is a C index (i.e. 0-based).
     The value is retrieved in the machines natural byte order.
     Similar to unsignedLongAt:, except for the index base"

    ^ self unsignedLongAt:zeroBasedIndex+1

    "
     |b|

     b := ByteArray withAll:#(0 0 0 0).
     b uint32At:0 put:16r12345678.
     b uint32At:0.
     b
    "
!

uint32At:zeroBasedIndex put:anInteger
    "set the 4-bytes starting at index to the value given by (unsigned) Integer.
     The index is a C index (i.e. 0-based).
     The value is stored in the machines natural byte order.
     Similar to unsignedLongAt:put:, except for the index base"

    ^ self unsignedLongAt:zeroBasedIndex+1 put:anInteger

    "
     |b|

     b := ByteArray withAll:#(0 0 0 0).
     b uint32At:0 put:16r12345678.
     b
    "
! !

!UninterpretedBytes methodsFor:'accessing-arbitrary-long ints'!

unsignedIntegerAt:index length:n bigEndian:bigEndian
    "return the n-byte unsigned integer starting at index.
     With n=1, this returns the single byte's value,
     n=2, an unsigned short, n=4 an unsigned int etc.
     Useful to extract arbitrary long integers"

    |val|

    val := 0.
    bigEndian ifTrue:[
	index to:index+n-1 do:[:i |
	    val := (val<<8) + (self at:i)
	]
    ] ifFalse:[
	index+n-1 to:index by:-1 do:[:i |
	    val := (val<<8) + (self at:i)
	]
    ].
    ^ val

    "
     |b|
     b := #[ 16r01 16r02 16r03 16r04 16r05 ].
     (b unsignedIntegerAt:2 length:4 bigEndian:false).
     (b unsignedIntegerAt:2 length:4 bigEndian:true).
    "
! !

!UninterpretedBytes methodsFor:'accessing-bytes'!

bcdByteAt:index
    "return the bcd-value for a byte at index in the range 0..99.
     BCD treats nibbles (4-bit) as an encoded decimal number's digits
     (i.e. the value n is encoded as: ((n // 10) * 16) + (n \\ 10)"

    ^ (self byteAt:index) decodeFromBCD

    "
     #[ 16r55 ] bcdByteAt:1
     #[ 16r99] bcdByteAt:1
     #[ 16rAA] bcdByteAt:1
    "

    "Modified (comment): / 26-09-2011 / 11:57:33 / cg"
!

bcdByteAt:index put:aNumber
    "set the byte at index as bcd-value in the range 0..99.
     BCD treats nibbles (4-bit) as an encoded decimal number's digits
     (i.e. the value n is encoded as: ((n // 10) * 16) + (n \\ 10)"

    (aNumber between:0 and:99) ifFalse:[
	self error:'invalid value for BCD encoding'
    ].
    ^ self byteAt:index put:aNumber encodeAsBCD

    "
     (((ByteArray new:1) bcdByteAt:1 put:55; yourself) at:1) hexPrintString
     (((ByteArray new:1) bcdByteAt:1 put:99; yourself) at:1) hexPrintString
     (((ByteArray new:1) bcdByteAt:1 put:100; yourself) at:1) hexPrintString
     (((ByteArray new:1) bcdByteAt:1 put:-1; yourself) at:1) hexPrintString
    "

    "Modified (comment): / 26-09-2011 / 11:57:36 / cg"
!

signedByteAt:index
    "return the byte at index as a signed 8 bit value in the range -128..+127.
     The index is a smalltalk index (i.e. 1-based).
     This may be worth a primitive."

    ^ (self at:index) signExtendedByteValue

    "
     |b|
     b := ByteArray new:2.
     b at:1 put:16rFF.
     b at:2 put:16r7F.
     b signedByteAt:1
    "

    "Modified: / 01-07-1996 / 21:13:53 / cg"
    "Modified (comment): / 26-09-2011 / 11:57:14 / cg"
!

signedByteAt:index put:aSignedByteValue
    "return the byte at index as a signed 8 bit value in the range -128..+127.
     The index is a smalltalk index (i.e. 1-based).
     Return the signedByteValue argument.
     This may be worth a primitive."

    |b "{ Class: SmallInteger }"|

    aSignedByteValue >= 0 ifTrue:[
	b := aSignedByteValue
    ] ifFalse:[
	b := 16r100 + aSignedByteValue
    ].
    self at:index put:b.
    ^ aSignedByteValue

    "
     |b|
     b := ByteArray new:2.
     b signedByteAt:1 put:-1.
     b at:1
    "

    "Modified: / 01-07-1996 / 21:12:37 / cg"
    "Modified (comment): / 26-09-2011 / 11:57:18 / cg"
! !

!UninterpretedBytes methodsFor:'accessing-floats & doubles'!

doubleAt:index
    "return the 8-bytes starting at index as a Float.
     The index is a smalltalk index (i.e. 1-based).
     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|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(double)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(double)-1)) == 0) {
		    double dVal = ((double *)cp)[0];
		    OBJ f;

		    __qMKFLOAT(f, dVal);
		    RETURN (f);
		}
	    }
	}
    }
%}.

    newFloat := Float basicNew.
    1 to:8 do:[:destIndex|
	newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
    ].
    ^ newFloat.

    "
     |b|

     b := ByteArray new:20.
     b doubleAt:1 put:(Float pi).
     Transcript showCR:b.
     Transcript showCR:(b doubleAt:1)
    "
!

doubleAt:index MSB:msb
    "return the 8-bytes starting at index as a Float.
     The index is a smalltalk index (i.e. 1-based).
     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|

    msb == IsBigEndian ifTrue:[
	^ self doubleAt:index.
    ].

    newFloat := Float basicNew.
    1 to:8 do:[:destIndex|
	newFloat basicAt:(9-destIndex) put:(self at:index - 1 + destIndex)
    ].
    ^ newFloat.

    "Created: / 15.5.1998 / 17:21:45 / cg"
!

doubleAt:index put:aFloat
    "store the value of the argument, aFloat into the receiver
     starting at index.
     The index is a smalltalk index (i.e. 1-based).
     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."

    |flt|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(double)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(double)-1)) == 0) {
		    if (__isFloat(aFloat)) {
			((double *)cp)[0] = __floatVal(aFloat);
			RETURN (aFloat);
		    }
		    if (__isShortFloat(aFloat)) {
			((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
			RETURN (aFloat);
		    }
		    if (__isSmallInteger(aFloat)) {
			((double *)cp)[0] = (double)(__intVal(aFloat));
			RETURN (aFloat);
		    }
		}
	    }
	}
    }
%}.

    flt := aFloat asFloat.
    1 to:8 do:[:srcIndex|
	self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)
    ].
    ^ aFloat
!

doubleAt:index put:aFloat MSB:msb
    "store the value of the argument, aFloat into the receiver
     starting at index.
     The index is a smalltalk index (i.e. 1-based).
     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."

    |flt|

    msb == IsBigEndian ifTrue:[
	^ self doubleAt:index put:aFloat.
    ].

    flt := aFloat asFloat.
    1 to:8 do:[:srcIndex|
	self at:index - 1 + srcIndex put:(flt basicAt:(9-srcIndex))
    ].
    ^ aFloat

    "Created: / 15.5.1998 / 17:22:27 / cg"
    "Modified: / 15.5.1998 / 17:26:29 / cg"
!

floatAt:index
    "return the 4-bytes starting at index as a ShortFloat.
     The index is a smalltalk index (i.e. 1-based).
     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|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(float)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(float)-1)) == 0) {
		    float fVal = ((float *)cp)[0];
		    OBJ f;

		    __qMKSFLOAT(f, fVal);
		    RETURN (f);
		}
	    }
	}
    }
%}.

    newFloat := ShortFloat basicNew.
    1 to:4 do:[:destIndex|
	newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
    ].
    ^ newFloat.
!

floatAt:index MSB:msb
    "return the 4-bytes starting at index as a ShortFloat.
     The index is a smalltalk index (i.e. 1-based).
     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|

    msb == IsBigEndian ifTrue:[
	^ self floatAt:index
    ].

    newFloat := ShortFloat basicNew.
    1 to:4 do:[:destIndex|
	newFloat basicAt:(5-destIndex) put:(self at:index - 1 + destIndex)
    ].
    ^ newFloat.

    "Modified: / 15.5.1998 / 17:20:19 / cg"
    "Created: / 15.5.1998 / 17:20:35 / cg"
!

floatAt:index put:aFloat
    "store the 4 bytes of value of the argument, aFloat into the receiver
     starting at index.
     The index is a smalltalk index (i.e. 1-based).
     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."

    |sflt|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(float)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(float)-1)) == 0) {
		    if (__isShortFloat(aFloat)) {
			((float *)cp)[0] = __shortFloatVal(aFloat);
			RETURN (self);
		    }
		    if (__isFloat(aFloat)) {
			((float *)cp)[0] = (float)__floatVal(aFloat);
			RETURN (self);
		    }
		    if (__isSmallInteger(aFloat)) {
			((float *)cp)[0] = (float)__intVal(aFloat);
			RETURN (self);
		    }
		    // bail out to smalltalk code
		}
	    }
	}
    }
%}.

    sflt := aFloat asShortFloat.
    1 to:4 do:[:srcIndex|
	self at:index - 1 + srcIndex put:(sflt basicAt:srcIndex)
    ].
!

floatAt:index put:aFloat MSB:msb
    "store the 4 bytes of value of the argument, aFloat into the receiver
     starting at index.
     The index is a smalltalk index (i.e. 1-based).
     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."

    |sflt|

    msb == IsBigEndian ifTrue:[
	self floatAt:index put:aFloat.
	^ self.
    ].

    sflt := aFloat asShortFloat.
    1 to:4 do:[:srcIndex|
	self at:index - 1 + srcIndex put:(sflt basicAt:(5-srcIndex))
    ].

    "Created: / 15.5.1998 / 17:20:41 / cg"
!

ieeeDoubleAt:index
    "retrieve the 8 bytes starting at index as a float.
     The index is a smalltalk index (i.e. 1-based).
     The 8 bytes are assumed to be in IEEE floating point single precision
     number format."

    "
     currently, we assume that the machines native number format is already
     IEEE 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 IEEE float numbers, so there should be
     no problem.
    "
    Float isIEEEFormat ifFalse:[self error:'unsupported operation'].

    ^ self doubleAt:index

    "Created: / 5.3.1998 / 10:50:03 / stefan"
!

ieeeDoubleAt:index put:aFloat
    "store the value of the argument, aFloat into the receiver
     The index is a smalltalk index (i.e. 1-based).
     starting at index. Storage is in IEEE floating point double precision format.
     (i.e. 8 bytes are stored)."

    "
     currently, we assume that the machines native number format is already
     IEEE 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 IEEE float numbers, so there should be
     no problem.
    "
    Float isIEEEFormat ifFalse:[self error:'unsupported operation'].

    ^ self doubleAt:index put:aFloat

    "Created: / 5.3.1998 / 10:50:26 / stefan"
!

ieeeFloatAt:index
    "retrieve the 4 bytes starting at index as a float.
     The index is a smalltalk index (i.e. 1-based).
     The 4 bytes are assumed to be in IEEE floating point single precision
     number format."

    "
     currently, we assume that the machines native number format is already
     IEEE 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 IEEE float numbers, so there should be
     no problem.
    "
    ShortFloat isIEEEFormat ifFalse:[self error:'unsupported operation'].

    ^ self floatAt:index

    "Created: / 5.3.1998 / 10:50:45 / stefan"
!

ieeeFloatAt:index put:aFloat
    "store the value of the argument, aFloat into the receiver
     starting at index, which is a smalltalk index (i.e. 1-based).
     Storage is in IEEE 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
     IEEE 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 IEEE float numbers, so there should be
     no problem.
    "
    ShortFloat isIEEEFormat ifFalse:[self error:'unsupported operation'].

    self floatAt:index put:aFloat

    "Created: / 5.3.1998 / 10:51:11 / stefan"
! !

!UninterpretedBytes methodsFor:'accessing-longlongs (64bit)'!

longLongAt:index
    "return the 8-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    |w|

    w := self unsignedLongLongAt:index bigEndian:IsBigEndian.
    (w > (16r7FFFFFFFFFFFFFFF)) ifTrue:[
	^ w - (16r10000000000000000)
    ].
    ^ w

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongLongAt:1 put:16rFFFFFFFFFFFFFFFF.
     (b longLongAt:1)
    "

    "Modified: / 1.7.1996 / 21:11:28 / cg"
    "Created: / 5.3.1998 / 14:40:05 / stefan"
    "Modified: / 5.3.1998 / 14:58:32 / stefan"
!

longLongAt:index bigEndian:msb
    "return the 8-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the given byte order.
     This may be worth a primitive."

    |w|

    w := self unsignedLongLongAt:index bigEndian:msb.
    (w > (16r7FFFFFFFFFFFFFFF)) ifTrue:[
	^ w - (16r10000000000000000)
    ].
    ^ w

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongLongAt:1 put:16rFFFFFFFFFFFFFFFF.
     (b longLongAt:1 msb:true)
    "

    "Modified: / 5.3.1998 / 12:06:28 / stefan"
    "Created: / 5.3.1998 / 14:40:54 / stefan"
    "Modified: / 9.5.1998 / 01:10:59 / cg"
!

longLongAt:byteIndex put:anInteger
    "store a signed longLong (64bit) integer.
     The index is a smalltalk index (i.e. 1-based).
     Same as #signedQuadWordAt:put: - for ST80 compatibility."

    |v|

    v := anInteger.
    anInteger < 0 ifTrue:[
	v := v + 16r10000000000000000
    ].
    ^ self unsignedLongLongAt:byteIndex put:v
!

longLongAt:byteIndex put:anInteger bigEndian:msb
    "store a signed longLong (64bit) integer.
     The index is a smalltalk index (i.e. 1-based).
     Same as #signedQuadWordAt:put: - for ST80 compatibility."

    |v|

    v := anInteger.
    anInteger < 0 ifTrue:[
	v := v + 16r10000000000000000
    ].
    ^ self unsignedLongLongAt:byteIndex put:v bigEndian:msb

    "Created: / 9.5.1998 / 01:10:24 / cg"
    "Modified: / 9.5.1998 / 01:13:34 / cg"
!

quadWordAt:index MSB:msb
    "return the 8-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     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 compressed

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
     (b quadWordAt:1 MSB:false) printStringRadix:16
    "

    "Modified: 5.11.1996 / 14:06:21 / cg"
!

quadWordAt:index put:anInteger MSB:msb
    "set the 8-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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 }"|

    ((anInteger < 0) or:[anInteger > 16rFFFFFFFFFFFFFFFF]) ifTrue:[
	^ self elementBoundsError:anInteger
    ].

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

unsignedLongLongAt:index bigEndian:msb
    "return the 8-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     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 compressed

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
     (b unsignedLongLongAt:1 bigEndian:false) printStringRadix:16
    "

    "Modified: / 5.11.1996 / 14:06:21 / cg"
    "Modified: / 5.3.1998 / 14:04:44 / stefan"
!

unsignedLongLongAt:index put:anInteger
    "set the 8-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF.
     The value is stored in natural byte order."

    ^ self unsignedLongLongAt:index put:anInteger bigEndian:IsBigEndian

    "Created: / 5.3.1998 / 14:44:00 / stefan"
    "Modified: / 5.3.1998 / 15:02:32 / stefan"
!

unsignedLongLongAt:index put:anInteger bigEndian:msb
    "set the 8-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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 }"|

    ((anInteger < 0) or:[anInteger > 16rFFFFFFFFFFFFFFFF]) ifTrue:[
	^ self elementBoundsError:anInteger
    ].

    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 unsignedLongLongAt:1 put:16r0807060504030201 bigEndian:false.
     b inspect
    "

    "Created: / 5.3.1998 / 14:06:02 / stefan"
! !

!UninterpretedBytes methodsFor:'accessing-longs (32bit)'!

doubleWordAt:index
    "return the 4-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order."

    ^ self doubleWordAt:index MSB:IsBigEndian

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4).
     (b doubleWordAt:1) printStringRadix:16
    "

    "Modified: / 5.3.1998 / 14:57:35 / stefan"
!

doubleWordAt:index MSB:msb
    "return the 4-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first, if the msb-arg is true;
     LSB-first otherwise."

    |val
     ival "{ Class: SmallInteger }"
     t    "{ Class: SmallInteger }"
     i    "{ Class: SmallInteger }"
     b1   "{ Class: SmallInteger }"
     b2   "{ Class: SmallInteger }"
     b3   "{ Class: SmallInteger }"
     b4   "{ Class: SmallInteger }"|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
	    unsigned int iVal;

	    if ((idx+(sizeof(int)-1)) < sz) {
		cp += idx;

		if (msb == true) {
#if defined(__MSBFIRST__)
		    if (((INT)cp & (sizeof(int)-1))== 0) {
			/*
			 * aligned
			 */
			iVal = ((unsigned int *)cp)[0];
		    } else
#endif
		    {
			iVal = cp[0];
			iVal = (iVal << 8) | cp[1];
			iVal = (iVal << 8) | cp[2];
			iVal = (iVal << 8) | cp[3];
		    }
		} else {
#if defined(__i386__) || (defined(UNALIGNED_FETCH_OK) && defined(__LSBFIRST__))
		    /*
		     * aligned or not - we dont care
		     * (i386 can fetch unaligned)
		     */
		    iVal = ((unsigned int *)cp)[0];
#else
# if defined(__LSBFIRST__)
		    if (((INT)cp & (sizeof(int)-1))== 0) {
			/*
			 * aligned
			 */
			iVal = ((unsigned int *)cp)[0];
		    } else
# endif
		    {
			iVal = cp[3];
			iVal = (iVal << 8) | cp[2];
			iVal = (iVal << 8) | cp[1];
			iVal = (iVal << 8) | cp[0];
		    }
#endif
		}
#if __POINTER_SIZE__ == 8
		RETURN (__mkSmallInteger(iVal));
#else
		RETURN (__MKUINT(iVal));
#endif
	    }
	}
    }
%}.

    "/ fallBack code - non ByteArray-like receiver
    "/ or funny index

    i := index.
    b1 := self at:i.
    b2 := self at:(i+1).
    b3 := self at:(i+2).
    b4 := self at:(i+3).

    msb ifFalse:[
	t := b4. b4 := b1. b1 := t.
	t := b3. b3 := b2. b2 := t.
    ].
    ival := b1.
    ival := (ival bitShift:8) + b2.
    ival := (ival bitShift:8) + b3.
    val := (ival bitShift:8) + b4.
    ^ val

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4).
     (b doubleWordAt:1 MSB:true) printStringRadix:16.
     (b doubleWordAt:1 MSB:false) printStringRadix:16
    "

!

doubleWordAt:index put:value
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value should be in the range 0 to 16rFFFFFFFF
     (for negative values, the stored value is not defined).
     The value is stored in the machines natural byte order."

    ^ self doubleWordAt:index put:value MSB:IsBigEndian

    "
     |b|
     b := ByteArray new:4.
     b doubleWordAt:1 put:16r04030201.
     b inspect
    "

    "Modified: / 5.3.1998 / 14:57:48 / stefan"
!

doubleWordAt:index put:aNumber MSB:msb
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value must be in the range 0 to 16rFFFFFFFF.
     The value is stored MSB-first if msb is true; LSB-first otherwise."

    |i "{ Class: SmallInteger }" |

    ((aNumber < 0) or:[aNumber > 16rFFFFFFFF]) ifTrue:[
	^ self elementBoundsError:aNumber
    ].

    i := index.
    msb ifTrue:[
	self at:i     put:(aNumber digitAt:4).
	self at:(i+1) put:(aNumber digitAt:3).
	self at:(i+2) put:(aNumber digitAt:2).
	self at:(i+3) put:(aNumber digitAt:1).
    ] ifFalse:[
	self at:i     put:(aNumber digitAt:1).
	self at:(i+1) put:(aNumber digitAt:2).
	self at:(i+2) put:(aNumber digitAt:3).
	self at:(i+3) put:(aNumber digitAt:4).
    ].
    ^ aNumber

    "
     |b|
     b := ByteArray new:8.
     b doubleWordAt:1 put:16r04030201 MSB:true.
     b doubleWordAt:5 put:16r04030201 MSB:false.
     b inspect
    "

    "Modified: / 21.1.1998 / 17:43:34 / cg"
    "Modified: / 5.3.1998 / 11:42:17 / stefan"
!

doubleWordAtDoubleWordIndex:index
    "return the unsigned long at index, anInteger.
     Fetching in the machines natural byte order.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of doubleWord entries.
     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAtDoubleWordIndex:index MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:43:53 / cg"
    "Modified: / 5.3.1998 / 14:58:06 / stefan"
!

doubleWordAtDoubleWordIndex:index MSB:msb
    "return the unsigned long at index, anInteger.
     Fetching is MSB if msb is true, LSB otherwise.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of doubleWord entries.
     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAt:(index - 1 * 4 + 1) MSB:msb

    "Created: / 21.1.1998 / 17:44:07 / cg"
!

doubleWordAtDoubleWordIndex:index put:value
    "set the long at index, anInteger.
     Storing in the machines natural byte order.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of doubleWord entries.
     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAtDoubleWordIndex:index put:value MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:44:13 / cg"
    "Modified: / 5.3.1998 / 14:58:19 / stefan"
!

doubleWordAtDoubleWordIndex:index put:value MSB:msb
    "set the long at index, anInteger.
     Storing is MSB if msb is true, LSB otherwise.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of doubleWord entries.
     (i.e. indices are 1, 2, ...)"

    ^ self doubleWordAt:(index - 1 * 4 + 1) put:value MSB:msb

    "Created: / 21.1.1998 / 17:44:19 / cg"
!

longAt:index
    "return the 4-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order,
     therefore, this should only be used for byte-data which is
     only used inside this machine.
     To setup data packets which are to be sent to other machines,
     or stored into a file, always use longAt:MSB: and specify
     a definite byteOrder."

    |w|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(int)-1)) < sz) {
		cp += idx;
#if defined(__i386__)
		/*
		 * aligned or not, we dont care (i386 can do both)
		 */
		{
		    int iVal = ((int *)cp)[0];

		    RETURN (__MKINT(iVal));
		}
#else
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(int)-1)) == 0) {
		    int iVal = ((int *)cp)[0];

# if __POINTER_SIZE__ == 8
		    RETURN (__mkSmallInteger(iVal));
# else
		    RETURN (__MKINT(iVal));
# endif
		}
#endif
	    }
	}
    }
%}.

    w := self unsignedLongAt:index.
    (w > (16r7FFFFFFF)) ifTrue:[
	^ w - (16r100000000)
    ].
    ^ w

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongAt:1 put:16rFFFFFFFF.
     (b longAt:1)
    "

    "Modified: / 1.7.1996 / 21:11:28 / cg"
    "Modified: / 5.3.1998 / 12:06:28 / stefan"
!

longAt:index bigEndian:msb
    "return the 4-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     Depending on msb, the value is retrieved MSB-first or LSB-first.
     This may be worth a primitive."

    |w|

    w := self unsignedLongAt:index bigEndian:msb.
    (w > (16r7FFFFFFF)) ifTrue:[
	^ w - (16r100000000)
    ].
    ^ w

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongAt:1 put:16rFFFFFFFF.
     (b longAt:1)
    "

    "Modified: / 1.7.1996 / 21:11:33 / cg"
    "Created: / 5.3.1998 / 14:02:03 / stefan"
!

longAt:index put:value
    "set the 4-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value is stored in the machines natural byte order.
     This may be worth a primitive.

     This is the ST80 version of #signedDoubleWordAt:put:"

    |v|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;

	    if ((idx+(sizeof(int)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(int)-1)) == 0) {
		    int __v;

		    if (__isSmallInteger(value)) {
			((int *)cp)[0] = __intVal(value);
			RETURN (value);
		    }
		    if (__v = __signedLongIntVal(value)) {
			((int *)cp)[0] = __v;
			RETURN (value);
		    }
		}
	    }
	}
    }
%}.

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := value + 16r100000000
    ].
    self unsignedLongAt:index put:v.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b longAt:1 put:-1.
     (b unsignedLongAt:1) printStringRadix:16
    "

    "Modified: / 1.7.1996 / 21:11:39 / cg"
    "Created: / 5.3.1998 / 10:57:18 / stefan"
!

longAt:byteIndex put:anInteger bigEndian:msb
    "store a signed long (32bit) integer.
     The index is a smalltalk index (i.e. 1-based).
     Same as #signedQuadWordAt:put: - for ST80 compatibility."

    |v|

    v := anInteger.
    anInteger < 0 ifTrue:[
	v := v + 16r100000000
    ].
    ^ self unsignedLongAt:byteIndex put:v bigEndian:msb

    "Created: / 9.5.1998 / 01:10:24 / cg"
    "Modified: / 9.5.1998 / 01:13:34 / cg"
!

pointerAt:index
    "get a pointer starting at index as ExternalAddress.
     The index is a smalltalk index (i.e. 1-based).
     Only aligned accesses are allowed."

%{
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;
	    char *pointer;

	    if ((idx+(sizeof(pointer)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(pointer)-1)) == 0) {
		    pointer = ((char **)cp)[0];
		    RETURN (__MKEXTERNALADDRESS(pointer));
		} else {
#if 0
		    printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
#endif
		}
	    } else {
#if 0
		printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
			idx, (int)(sizeof(pointer)-1), sz);
#endif
	    }
	} else {
#if 0
	    printf("cp is NULL\n");
#endif
	}
    } else {
#if 0
	printf("bad index\n");
#endif
    }
bad:;
%}.

    self primitiveFailed.

    "
     |b|
     b := ByteArray new:(ExternalAddress pointerSize).
     b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
     Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
     Transcript showCR:((b pointerAt:1)).
    "
!

pointerAt:index put:value
    "set the pointer starting at index from the integer or externalAddress value.
     The index is a smalltalk index (i.e. 1-based).
     Only aligned accesses are allowed.
     The value is either an ExternalAddress or ExternalBytes"

%{
    OBJ *pointer;

    if (__isExternalAddressLike(value)) {
	pointer = __externalAddressVal(value);
    } else if (__isExternalBytesLike(value)) {
	pointer = __externalBytesVal(value);
	if (pointer == (OBJ *)0)
	    pointer = 0;
    } else if (value == nil) {
	pointer = 0;
    } else if (__isSmallInteger(value)) {
	pointer = (OBJ *)__intVal(value);
    } else {
	if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
	    goto bad;
	}
    }

    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;

	    if ((idx+(sizeof(pointer)-1)) < sz) {
		cp += idx;
		/*
		 * aligned
		 */
		if (((INT)cp & (sizeof(pointer)-1)) == 0) {
		    ((char **)cp)[0] = (char *) pointer;
		    RETURN (value);
		}
	    }
	}
    }
bad:;
%}.

    self primitiveFailed.

    "
     |b|
     b := ByteArray new:ExternalAddress pointerSize.
     b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
     (b unsignedLongAt:1) printStringRadix:16
    "

    "Modified: / 1.7.1996 / 21:11:39 / cg"
    "Created: / 5.3.1998 / 10:57:18 / stefan"
!

signedDoubleWordAt:index
    "return the 4-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    ^ self signedDoubleWordAt:index MSB:IsBigEndian

    "
     |b|
     b := ByteArray new:4.
     b doubleWordAt:1 put:16rFFFFFFFF.
     (b signedDoubleWordAt:1)
    "
    "
     |b|
     b := ByteArray new:4.
     b signedDoubleWordAt:1 put:-1.
     (b doubleWordAt:1)
    "

    "Modified: 1.7.1996 / 21:11:28 / cg"
!

signedDoubleWordAt:index MSB:msb
    "return the 4-bytes starting at index as a (signed) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first, if the msb-arg is true;
     LSB-first otherwise."

    |val
     ival "{ Class: SmallInteger }"
     t    "{ Class: SmallInteger }"
     i    "{ Class: SmallInteger }"
     b1   "{ Class: SmallInteger }"
     b2   "{ Class: SmallInteger }"
     b3   "{ Class: SmallInteger }"
     b4   "{ Class: SmallInteger }"|

%{
    /*
     * handle the most common cases fast ...
     */
    if (__isSmallInteger(index)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
	    int iVal;

	    if ((idx+(sizeof(int)-1)) < sz) {
		cp += idx;

		if (msb == true) {
#if defined(__MSBFIRST__)
		    if (((INT)cp & (sizeof(int)-1))== 0) {
			/*
			 * aligned
			 */
			iVal = ((int *)cp)[0];
		    } else
#endif
		    {
			iVal = cp[0];
			iVal = (iVal << 8) | cp[1];
			iVal = (iVal << 8) | cp[2];
			iVal = (iVal << 8) | cp[3];
		    }
		} else {
#if defined(__i386__) || (defined(UNALIGNED_FETCH_OK) && defined(__LSBFIRST__))
		    /*
		     * aligned or not - we dont care
		     * (i386 can fetch unaligned)
		     */
		    iVal = ((int *)cp)[0];
#else
# if defined(__LSBFIRST__)
		    if (((INT)cp & (sizeof(int)-1))== 0) {
			/*
			 * aligned
			 */
			iVal = ((int *)cp)[0];
		    } else
# endif
		    {
			iVal = cp[3];
			iVal = (iVal << 8) | cp[2];
			iVal = (iVal << 8) | cp[1];
			iVal = (iVal << 8) | cp[0];
		    }
#endif
		}
#if __POINTER_SIZE__ == 8
		RETURN (__mkSmallInteger(iVal));
#else
		RETURN (__MKINT(iVal));
#endif
	    }
	}
    }
%}.

    "/ fallBack code - non ByteArray-like receiver
    "/ or funny index

    i := index.
    b1 := self at:i.
    b2 := self at:(i+1).
    b3 := self at:(i+2).
    b4 := self at:(i+3).

    msb ifFalse:[
	t := b4. b4 := b1. b1 := t.
	t := b3. b3 := b2. b2 := t.
    ].
    ival := b1.
    ival := (ival bitShift:8) + b2.
    ival := (ival bitShift:8) + b3.
    val := (ival bitShift:8) + b4.

    (val > (16r7FFFFFFF)) ifTrue:[
	^ val - (16r100000000)
    ].
    ^ val

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4).
     (b signedDoubleWordAt:1 MSB:true) printStringRadix:16.
     (b signedDoubleWordAt:1 MSB:false) printStringRadix:16
    "

!

signedDoubleWordAt:index put:value
    "set the 4-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value is stored in the machines natural byte order.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := value + 16r100000000
    ].
    self doubleWordAt:index put:v.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b signedDoubleWordAt:1 put:-1.
     (b doubleWordAt:1) printStringRadix:16
    "

    "Modified: 1.7.1996 / 21:11:39 / cg"
!

signedDoubleWordAt:index put:value MSB:msb
    "set the 4-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     Depending on msb, the value is stored MSB-first or LSB-first.
     This may be worth a primitive."

    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := value + 16r100000000
    ].
    self doubleWordAt:index put:v MSB:msb.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b signedDoubleWordAt:1 put:-1.
     (b doubleWordAt:1) printStringRadix:16
    "

    "Modified: 1.7.1996 / 21:11:46 / cg"
!

unsignedLongAt:index
    "return the 4-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     Subclasses may redefine this for better performance.
     Same as doubleWordAt: for protocol completeness"

    ^ self doubleWordAt:index

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4).
     (b unsignedLongAt:1) printStringRadix:16
    "

    "Created: / 5.3.1998 / 11:56:53 / stefan"
    "Modified: / 5.3.1998 / 14:58:48 / stefan"
!

unsignedLongAt:index bigEndian:msb
    "return the 4-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first, if the msb-arg is true;
     LSB-first otherwise.
     Subclasses may redefine this for better performance.
     Same as doubleWordAt:MSB: for protocol completeness"

    ^ self doubleWordAt:index MSB:msb

    "
     |b|

     b := ByteArray withAll:#(1 2 3 4).
     (b unsignedLongAt:1 bigEndian:true) printStringRadix:16.
     (b unsignedLongAt:1 bigEndian:false) printStringRadix:16
    "

    "Modified: / 21.1.1998 / 17:42:30 / cg"
    "Created: / 5.3.1998 / 11:46:05 / stefan"
!

unsignedLongAt:index put:value
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value should be in the range 0 to 16rFFFFFFFF
     (for negative values, the stored value is not defined).
     The value is stored in the machines natural byte order.
     Subclasses may redefine this for better performance.
     Same as doubleWordAt:put: for protocol completeness"

    ^ self doubleWordAt:index put:value

    "
     |b|
     b := ByteArray new:4.
     b unsignedLongAt:1 put:16r04030201.
     b inspect
    "

    "Created: / 5.3.1998 / 11:57:44 / stefan"
    "Modified: / 5.3.1998 / 14:58:59 / stefan"
!

unsignedLongAt:index put:aNumber bigEndian:msb
    "set the 4-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The value must be in the range 0 to 16rFFFFFFFF.
     The value is stored MSB-first if msb is true; LSB-first otherwise.
     Subclasses may redefine this for better performance.
     Same as doubleWordAt:put:MSB: for protocol completeness"

    ^ self doubleWordAt:index put:aNumber MSB:msb

    "
     |b|
     b := ByteArray new:8.
     b unsignedLongAt:1 put:16r04030201 bigEndian:true.
     (b unsignedLongAt:1 bigEndian:false) printStringRadix:16
    "

    "Modified: / 21.1.1998 / 17:43:34 / cg"
    "Created: / 5.3.1998 / 11:43:53 / stefan"
    "Modified: / 5.3.1998 / 11:47:30 / stefan"
! !

!UninterpretedBytes methodsFor:'accessing-shorts (16bit)'!

shortAt:index
    "return the 2-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive.
     This is the ST80 equivalent of #signedWordAt:"

    ^ (self unsignedShortAt:index) signExtendedShortValue

    "
     |b|
     b := ByteArray new:2.
     b unsignedShortAt:1 put:16rFFFF.
     b shortAt:1
    "

    "Modified: / 1.7.1996 / 21:14:38 / cg"
    "Created: / 5.3.1998 / 10:59:57 / stefan"
    "Modified: / 5.3.1998 / 23:39:38 / stefan"
!

shortAt:index bigEndian:msb
    "return the 2-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first, if the msb-arg is true;
     LSB-first otherwise.
     This is the ST80 equivalent of #signedWordAt:"

    ^ (self unsignedShortAt:index bigEndian:msb) signExtendedShortValue

    "
     |b|
     b := ByteArray new:2.
     b unsignedShortAt:1 put:16rFFFF.
     b shortAt:1
    "

    "Modified: / 1.7.1996 / 21:14:38 / cg"
    "Created: / 5.3.1998 / 23:41:21 / stefan"
!

shortAt:index put:value
    "set the 2-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The stored value must be in the range -32768 .. +32676.
     The value is stored in the machines natural byteorder.
     This may be worth a primitive.
     This is the ST80 equivalent of #signedWordAt:put:"


    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := 16r10000 + value
    ].
    self unsignedShortAt:index put:v bigEndian:IsBigEndian.
    ^ value

    "
     |b|
     b := ByteArray new:6.
     b shortAt:1 put:-1.
     b shortAt:3 put:-2.
     b shortAt:5 put:0.
     b inspect
    "

    "Modified: / 1.7.1996 / 21:12:07 / cg"
    "Created: / 5.3.1998 / 11:02:05 / stefan"
!

shortAt:index put:value bigEndian:bigEndian
    "set the 2-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The stored value must be in the range -32768 .. +32676.
     The value is stored in the byteorder given by bigEndian.
     This may be worth a primitive."


    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := 16r10000 + value
    ].
    self unsignedShortAt:index put:v bigEndian:bigEndian.
    ^ value

    "
     |b|
     b := ByteArray new:4.
     b shortAt:1 put:1 bigEndian:true.
     b shortAt:3 put:1 bigEndian:false.
     b inspect
    "

    "Modified: / 1.7.1996 / 21:12:07 / cg"
    "Created: / 5.3.1998 / 11:02:05 / stefan"
!

signedWordAt:index
    "return the 2-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order.
     This may be worth a primitive."

    ^ (self wordAt:index) signExtendedShortValue

    "
     |b|
     b := ByteArray new:2.
     b wordAt:1 put:16rFFFF.
     b signedWordAt:1
    "

    "Modified: 1.7.1996 / 21:14:38 / cg"
!

signedWordAt:index MSB:msb
    "return the 2-bytes starting at index as a signed Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first if the msb-arg is true,
     LSB-first otherwise.
     This may be worth a primitive."

    ^ (self wordAt:index MSB:msb) signExtendedShortValue

    "
     |b|
     b := ByteArray new:2.
     b wordAt:1 put:16r0080.
     b signedWordAt:1 MSB:true.
     b signedWordAt:1 MSB:false.
    "

    "Modified: 1.7.1996 / 21:15:57 / cg"
!

signedWordAt:index put:value
    "set the 2-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The stored value must be in the range -32768 .. +32676.
     The value is stored in the machines natural byteorder.
     This may be worth a primitive.
     This is the ST80 equivalent of #signedWordAt:put:"


    |v|

    value >= 0 ifTrue:[
	v := value
    ] ifFalse:[
	v := 16r10000 + value
    ].
    self unsignedShortAt:index put:v.
    ^ value

    "
     |b|
     b := ByteArray new:6.
     b shortAt:1 put:-1.
     b shortAt:3 put:-2.
     b shortAt:5 put:0.
     b inspect
    "

    "Modified: / 1.7.1996 / 21:12:07 / cg"
    "Modified: / 5.3.1998 / 11:01:30 / stefan"
!

signedWordAt:index put:value MSB:msb
    "set the 2-bytes starting at index from the signed Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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.
     This may be worth a primitive."

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

    "Modified: 1.7.1996 / 21:12:13 / cg"
!

unsignedShortAt:index
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order
     Subclasses may redefine this for better performance.
     This is the ST80 equivalent of #wordAt:"


    ^ self unsignedShortAt:index bigEndian:IsBigEndian

    "Created: / 5.3.1998 / 11:38:25 / stefan"
    "Modified: / 5.3.1998 / 14:59:25 / stefan"
!

unsignedShortAt:index bigEndian:msb
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved MSB-first (high 8 bits at lower index) if msb is true;
     LSB-first (i.e. low 8-bits at lower byte index) if its false)"

    |b1 "{ Class: SmallInteger }"
     b2 "{ Class: SmallInteger }"|

    b1 := self at:index.
    b2 := self at:(index + 1).
    msb ifTrue:[
	^ (b1 bitShift:8) + b2
    ].
    ^ (b2 bitShift:8) + b1

    "Modified: / 21.1.1998 / 17:46:07 / cg"
    "Created: / 5.3.1998 / 11:49:29 / stefan"
!

unsignedShortAt:index put:value
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     The stored value must be in the range 0 .. 16rFFFF.
     The value is stored in the machines natural byteorder."

    ^ self unsignedShortAt:index put:value bigEndian:IsBigEndian

    "
     |b|
     b := ByteArray new:4.
     b unsignedShortAt:1 put:16r0102.
     b unsignedShortAt:3 put:16r0304.
     b inspect
    "

    "Created: / 5.3.1998 / 11:54:52 / stefan"
    "Modified: / 5.3.1998 / 14:59:38 / stefan"
!

unsignedShortAt:index put:value bigEndian:msb
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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"

    |b1 b2
     iVal "{ Class: SmallInteger }"|

    iVal := value.
    ((iVal < 0) or:[iVal > 16rFFFF]) ifTrue:[
	^ self elementBoundsError:iVal
    ].
    msb ifTrue:[
	b1 := ((iVal bitShift:-8) bitAnd:16rFF).
	b2 := (iVal bitAnd:16rFF).
    ] ifFalse:[
	b1 := (iVal bitAnd:16rFF).
	b2 := ((iVal bitShift:-8) bitAnd:16rFF).
    ].
    self at:index   put:b1.
    self at:index+1 put:b2.
    ^ value

    "
     |b|
     b := ByteArray new:8.
     b unsignedShortAt:1 put:16r0102 bigEndian:false.
     b unsignedShortAt:3 put:16r0304 bigEndian:false.
     b unsignedShortAt:5 put:16r0102 bigEndian:true.
     b unsignedShortAt:7 put:16r0304 bigEndian:true.
     b inspect
    "

    "Modified: / 21.1.1998 / 17:48:15 / cg"
    "Modified: / 5.3.1998 / 11:52:28 / stefan"
!

wordAt:index
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     The value is retrieved in the machines natural byte order
     Subclasses may redefine this for better performance."

    ^ self wordAt:index MSB:IsBigEndian

    "Modified: / 5.3.1998 / 14:59:51 / stefan"
!

wordAt:index MSB:msb
    "return the 2-bytes starting at index as an (unsigned) Integer.
     The index is a smalltalk index (i.e. 1-based).
     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:)"

    |b1 "{ Class: SmallInteger }"
     b2 "{ Class: SmallInteger }"|

    b1 := self at:index.
    b2 := self at:(index + 1).
    msb ifTrue:[
	^ (b1 bitShift:8) + b2
    ].
    ^ (b2 bitShift:8) + b1

    "Modified: / 21.1.1998 / 17:46:07 / cg"
!

wordAt:index put:value
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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:)"

    ^ self wordAt:index put:value MSB:IsBigEndian

    "
     |b|
     b := ByteArray new:4.
     b wordAt:1 put:16r0102.
     b wordAt:3 put:16r0304.
     b inspect
    "

    "Modified: / 5.3.1998 / 15:00:03 / stefan"
!

wordAt:index put:value MSB:msb
    "set the 2-bytes starting at index from the (unsigned) Integer value.
     The index is a smalltalk index (i.e. 1-based).
     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:)"

    |b1 b2
     iVal "{ Class: SmallInteger }"|

    iVal := value.
    ((iVal < 0) or:[iVal > 16rFFFF]) ifTrue:[
	^ self elementBoundsError:iVal
    ].
    msb ifTrue:[
	b1 := ((iVal bitShift:-8) bitAnd:16rFF).
	b2 := (iVal bitAnd:16rFF).
    ] ifFalse:[
	b1 := (iVal bitAnd:16rFF).
	b2 := ((iVal bitShift:-8) bitAnd:16rFF).
    ].
    self at:index   put:b1.
    self at:index+1 put:b2.
    ^ value

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

    "Modified: / 21.1.1998 / 17:48:15 / cg"
!

wordAtWordIndex:index
    "return the unsigned short at index, anInteger.
     Fetching in the machines natural byte order.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of word entries.
     (i.e. indices are 1, 2, ...)"

    ^ self wordAtWordIndex:index MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:48:26 / cg"
    "Modified: / 5.3.1998 / 15:00:16 / stefan"
!

wordAtWordIndex:index MSB:msb
    "return the unsigned short at index, anInteger.
     Fetching is MSB if msb is true, LSB otherwise.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of word entries.
     (i.e. indices are 1, 2, ...)"

    ^ self wordAt:(index - 1 * 2 + 1) MSB:msb

    "Created: / 21.1.1998 / 17:48:30 / cg"
!

wordAtWordIndex:index put:value
    "set the short at index, anInteger.
     Storing in the machines natural byte order.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of word entries.
     (i.e. indices are 1, 2, ...)"

    ^ self wordAtWordIndex:index put:value MSB:IsBigEndian

    "Created: / 21.1.1998 / 17:48:34 / cg"
    "Modified: / 5.3.1998 / 15:00:27 / stefan"
!

wordAtWordIndex:index put:value MSB:msb
    "set the short at index, anInteger.
     Storing is MSB if msb is true, LSB otherwise.
     Indices are 1-based and scaled as appropriate to allow
     accessing the memory as an array of word entries.
     (i.e. indices are 1, 2, ...)"

    ^ self wordAt:(index - 1 * 2 + 1) put:value MSB:msb

    "Created: / 21.1.1998 / 17:48:38 / cg"
! !

!UninterpretedBytes methodsFor:'accessing-strings'!

stringAt:index
    "return a string starting at index up to the 0-byte.
     The index is a smalltalk index (i.e. 1-based)."

    |stream i "{ Class: SmallInteger }" c|

    stream := WriteStream on:(String new:40).
    i := index.
    [(c := self byteAt:i) ~~ 0] whileTrue:[
	stream nextPut:(Character value:c).
	i := i + 1.
    ].
    ^ stream contents

    "
      #[71 72 73 74 75 76 77 0] stringAt:1
      #[71 72 73 74 75 76 77 0] stringAt:2
      '1234567890' stringAt:2
    "
!

stringAt:index put:aString
    "copy aString to the externalBytes, starting at index up to
     (and including) the 0-byte (which is always written).
     The index is a smalltalk index (i.e. 1-based)."

    |i "{ Class: SmallInteger }"|

    i := index.
    aString do:[:aChar |
	self byteAt:i put:aChar codePoint.
	i := i + 1.
    ].
    self byteAt:i put:0.
    ^ aString

    "
     |bytes|

     bytes := ExternalBytes new:10.
     bytes stringAt:1 put:'hello'.
     1 to:bytes size do:[:i |
	Transcript showCR:(bytes at:i)
     ].
    "

    "
     (String new:20) stringAt:1 put:'hello'; stringAt:6 put:' world'; yourself
    "

    "Created: / 21.1.1998 / 17:45:02 / cg"
!

stringAt:index put:aString size:maxSize
    "copy aString to the externalBytes, starting at index up to either maxSize characters,
     or (and including) the 0-byte, whichever is encountered first.
     The final 0-byte is only written, if the string is shorter than maxSize.
     The index is a smalltalk index (i.e. 1-based)."

    |remaining "{ Class: SmallInteger }"
     i         "{ Class: SmallInteger }"|

    remaining := maxSize.
    remaining <= 0 ifTrue:[^ aString].

    i := index.
    aString do:[:aChar |
	self byteAt:i put:aChar codePoint.
	i := i + 1.
	remaining := remaining - 1.
	remaining <= 0 ifTrue:[^ aString].
    ].
    self byteAt:i put:0.
    ^ aString

    "
     |bytes|

     bytes := ExternalBytes new:10.
     bytes stringAt:1 put:'hello' size:3.
     1 to:bytes size do:[:i |
	Transcript showCR:(bytes at:i)
     ]
    "
    "
     |bytes|

     bytes := ByteArray new:10 withAll:16rFF.
     bytes stringAt:1 put:'he' size:3.
     1 to:bytes size do:[:i |
	Transcript showCR:(bytes at:i)
     ]
    "

    "
     (String new:20) stringAt:1 put:'hello' size:3 ; stringAt:4 put:' world' size:4; yourself
    "


    "Created: / 21.1.1998 / 17:45:02 / cg"
!

stringAt:index size:maxSize
    "return a string starting at index up to maxSize, or a 0-byte.
     The index is a smalltalk index (i.e. 1-based)."

    |stream c
     max "{ Class: SmallInteger }"
     start "{ Class: SmallInteger }"|

    stream := WriteStream on:(String new:maxSize).
    start := index.
    max := start + maxSize - 1.

    start to:max do:[:eachIndex|
	c := self byteAt:eachIndex.
	c == 0 ifTrue:[
	    ^ stream contents
	].
	stream nextPut:(Character value:c).
    ].
    ^ stream contents

    "
      #[71 72 73 74 75 76 77] stringAt:1 size:7
      #[71 72 73 74 75 76 77] stringAt:2 size:6
      '1234567890' stringAt:2 size:6
    "
!

zeroByteStringAt:index maximumSize:count
    "extract a zeroByte-delimited string, given initial index and
     maximum number of characters (bytes).
     The index is a smalltalk index (i.e. 1-based)."

    |bytes idx|

    bytes := self copyFrom:index to:(index + count - 1).
    idx := bytes indexOf:0.
    idx ~~ 0 ifTrue:[ bytes := bytes copyTo:idx-1 ].
    ^ bytes asString

    "Created: 9.9.1996 / 15:28:34 / cg"
! !

!UninterpretedBytes methodsFor:'converting'!

asExternalBytes
    |sz bytes|

    sz := self byteSize.
    bytes := ExternalBytes unprotectedNew:sz.
    bytes replaceBytesFrom:1 to:sz with:self startingAt:1.
    ^ bytes

    "
      #[1 2 3 4 5 6 7] asExternalBytes
      'Hello World' asExternalBytes
      'Hello World' asUnicodeString asExternalBytes
    "
!

asExternalBytesUnprotected
    "Like asExternalBytes, but does not register the bytes so
     bytes are GARBAGE-COLLECTED."

    |bytes sz|

    sz := self byteSize.
    bytes := ExternalBytes unprotectedNew:sz.
    bytes replaceFrom:1 to:sz with:self startingAt:1.
    ^ bytes

    "
     |x|
     x := 'fooBar' asExternalBytesUnprotected.
     ObjectMemory garbageCollect
    "

    "Created: / 05-06-2012 / 14:11:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-11-2013 / 11:42:21 / cg"
!

asUUID
    ^ UUID fromBytes:self
! !

!UninterpretedBytes methodsFor:'filling & replacing'!

replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
    "replace elements from another collection, which must be a ByteArray-
     like collection.

     Notice: This operation modifies the receiver, NOT a copy;
     therefore the change may affect all others referencing the receiver."

%{  /* NOCONTEXT */

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

#ifndef NO_PRIM_BYTEARR
    if ((__isBytes(aCollection) || __isExternalBytesLike(aCollection))
     && (__isBytes(self) || __isWords(self))
     && __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)) != @global(ByteArray)) {
		int nInst;

		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) {
		    if (__isExternalBytesLike(aCollection)) {
			OBJ sz;

			src = __externalAddressVal(aCollection);
			if (src == 0) goto fallBack;

			sz = __externalBytesSize(aCollection);
			if (__isSmallInteger(sz)) {
			    repNIndex = __smallIntegerVal(sz);
			} else {
			    repNIndex = repStopIndex+1; /* always enough */
			}
			src = src + repStartIndex;
		    } else {
			if (__isStringLike(aCollection)) {
			    repNIndex = __stringSize(aCollection);
			} else {
			    repNIndex = __qSize(aCollection) - OHDR_SIZE;
			}
			src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
			if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
			    int nInst;

			    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 bcopy4
			if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) {
			    int nW;

			    /* copy unaligned part */
			    while (count && ((unsigned INT)src & 3)) {
				*dst++ = *src++;
				count--;
			    }

			    if (count > 0) {
				/* copy aligned part */
				nW = count >> 2;
				bcopy4(src, dst, nW);
				if ((count = count & 3) != 0) {
				    /* copy any remaining part */
				    src += (nW<<2);
				    dst += (nW<<2);
				    while (count--) {
					*dst++ = *src++;
				    }
				}
			    }
			    RETURN ( self );
			}
# else
#  if __POINTER_SIZE__ == 8
			if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) {
			    /* copy unaligned part */
			    while (count && ((unsigned INT)src & 7)) {
				*dst++ = *src++;
				count--;
			    }

			    /* copy aligned part */
			    while (count >= 8) {
				((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0];
				dst += 8;
				src += 8;
				count -= 8;
			    }
			    while (count--) {
				*dst++ = *src++;
			    }
			    RETURN ( self );
			}
#  endif /* 64bit */
# endif /* bcopy4 */

# ifdef FAST_MEMCPY
			bcopy(src, dst, count);
# else
#  ifdef __UNROLL_LOOPS__
			while (count >= 8) {
			    dst[0] = src[0]; dst[1] = src[1];
			    dst[2] = src[2]; dst[3] = src[3];
			    dst[4] = src[4]; dst[5] = src[5];
			    dst[6] = src[6]; dst[7] = src[7];
			    dst += 8; src += 8;
			    count -= 8;
			}
#  endif /* __UNROLL_LOOPS__ */
			while (count-- > 0) {
			    *dst++ = *src++;
			}
# endif
			RETURN ( self );
		    }
		}
	    }
	}
    }
fallBack: ;
#endif
%}.
    "
     fall back in case of non-ByteArray argument,
     or for the error report if any index is invalid
    "
    self slowReplaceBytesFrom:start to:stop with:aCollection startingAt:repStart

    "
     #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
	copy
	    replaceFrom:1 to:8
	    with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
	    startingAt:1

     #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
	copy
	    replaceFrom:3 to:10
	    with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
	    startingAt:1

     #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
	copy
	    replaceFrom:3 to:4
	    with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
	    startingAt:1

     #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
	copy
	    replaceFrom:0 to:9
	    with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
	    startingAt:1

     #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
	copy
	    replaceFrom:1 to:10
	    with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
	    startingAt:0
    "
!

replaceBytesFrom:startIndex with:replacementCollection startingAt:repStartIndex
    "replace elements from another collection, which must be
     byte-array-like.

     Notice: This operation modifies the receiver, NOT a copy;
     therefore the change may affect all others referencing the receiver."

    ^ self
	replaceBytesFrom:startIndex
	to:(startIndex + replacementCollection size - repStartIndex)
	with:replacementCollection
	startingAt:repStartIndex

    "
     args:    startIndex            : <integer>
	      replacementCollection : <collection of <bytes> >
	      repStartIndex         : <integer>

     returns: self
    "

    "Created: / 27.7.1998 / 16:56:46 / cg"
    "Modified: / 27.7.1998 / 16:58:38 / cg"
!

replaceBytesWith:replacementCollection
    "replace elements from another collection, which must be byte-array-like.
     Replace stops at whichever collection is smaller.

     Notice: This operation modifies the receiver, NOT a copy;
     therefore the change may affect all others referencing the receiver."

    ^ self
	replaceBytesFrom:1
	to:(replacementCollection size min:self size)
	with:replacementCollection
	startingAt:1

    "
     (ByteArray new:10) replaceBytesWith:'hello'
     (ByteArray new:10) replaceBytesWith:'hello world bla bla bla'
    "

    "Created: / 09-01-2012 / 16:18:10 / cg"
!

replaceFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
    "replace elements in the receiver between index start and stop,
     with elements  taken from replacementCollection starting at repStart.
     Return the receiver.

     Notice: This operation modifies the receiver, NOT a copy;
     therefore the change may affect all others referencing the receiver."

    self class isBytes ifTrue:[
	((aCollection class == self class)
	 or:[aCollection isByteCollection]) ifTrue:[
	    ^ self replaceBytesFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
	].
    ].
    ^ super replaceFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex

    "
     args:    startIndex            : <integer>
	      stopIndex             : <integer>
	      replacementCollection : <collection of <bytes> >
	      repStartIndex         : <integer>

     returns: self
    "

    "Modified: / 08-05-2012 / 13:23:27 / cg"
! !

!UninterpretedBytes methodsFor:'hashing'!

computeXorHashFrom:startIndex to:endIndex
    "compute and answer the SmallInteger-Hash of the bytes
     from startIndex to endIndex.
     If endindex = 0 or endIndex > size, hash up the size.

     NOTE: startIndex and endIndex are only hints about what should be hashed.
	   In fact, more bytes could be involved in hashing.
	   SO ARRAYS MUST BE EQUAL TO HASH TO THE SAME VALUE"

    |w|

%{
    if (__bothSmallInteger(startIndex, endIndex)) {
	unsigned char *cp;
	INT sz;

	__fetchBytePointerAndSize__(self, &cp, &sz);
	if (cp) {
	    INT sidx = ((unsigned INT)__smallIntegerVal(startIndex)) - 1;
	    INT eidx = ((unsigned INT)__smallIntegerVal(endIndex)) - 1;
	    unsigned char *ep;
	    unsigned INT hash = 0, hash2 = 0, carry;
	    int i;

	    if (eidx < 0 || eidx >= sz) eidx = sz - 1;
	    if (sidx > eidx) sidx = eidx;
	    if (sidx < 0) {
		RETURN(__mkSmallInteger(0));
	    }

	    ep = cp + eidx;
	    cp += sidx;

#if 0
	    /*
	     * On LSB-First (little endian) cpus,
	     * this code does not produce the same result
	     * if the same bytes are at different positions
	     */

	    if ((INT)cp & (sizeof(INT)-1)) {
		/* not aligned */

		for (i=0; cp <= ep; cp++) {
		    hash2 = (hash2 << 8) | *cp;
		    if (++i == sizeof(INT)) {
			hash ^= hash2;
			i = hash2 = 0;
		    }
		}
	    } else {
		/* aligned */
		for (; cp+sizeof(INT) <= ep; cp += sizeof(INT)) {
		    hash ^= *(unsigned INT *)cp;
		}
		for (; cp <= ep; cp++) {
		    hash2 = (hash2 << 8) | *cp;
		}
	    }
#else
	    for (i=0; cp <= ep-sizeof(INT); cp += sizeof(INT)) {
		hash2 = cp[0];
		hash2 = (hash2 << 8) | cp[1];
		hash2 = (hash2 << 8) | cp[2];
		hash2 = (hash2 << 8) | cp[3];
#if __POINTER_SIZE__ == 8
		hash2 = (hash2 << 8) | cp[4];
		hash2 = (hash2 << 8) | cp[5];
		hash2 = (hash2 << 8) | cp[6];
		hash2 = (hash2 << 8) | cp[7];
#endif
		/*
		 * multiply by large prime to scramble bits and
		 * to avoid a 0 result from
		 * #[1 2 3 4 1 2 3 4] computeXorHashFrom:1 to:8.
		 */
		hash ^= (hash * 31415821) ^ hash2;
	    }
	    for (hash2 = 0; cp <= ep; cp++) {
		hash2 = (hash2 << 8) | *cp;
	    }
#endif
	    hash ^= (hash * 31415821) ^ hash2;

	    /*
	     * fold the high bits not fitting into a SmallInteger
	     */
	    carry = hash & ~_MAX_INT;
	    if (carry) {
		hash = (hash & _MAX_INT) ^ (carry >> 8);
	    }

	    RETURN(__mkSmallInteger(hash));
	}
    }
%}.

    ^ self primitiveFailed

    "
     #[1 2 3 4] computeXorHashFrom:1 to:4.
     #[1 2 3 4] computeXorHashFrom:1 to:32.
     #[1 2 3 4] computeXorHashFrom:1 to:0.
     #[1 2 3 4 5] computeXorHashFrom:1 to:4.
     #[1 2 3 4 1 2 3 4] computeXorHashFrom:1 to:8.
     #[1 2 3 4 5 6 7 8] computeXorHashFrom:2 to:8.
     #[2 3 4 5 6 7 8] computeXorHashFrom:1 to:7.
    "
! !

!UninterpretedBytes methodsFor:'image manipulation support'!

copyReverse
    "create a copy of myself with elements reversed in order"

    ^ self copy reverse

    "
     #[1 2 3 4 5] copyReverse
     #[1 2 3 4] copyReverse
    "
! !


!UninterpretedBytes methodsFor:'misc'!

swapLongAt:byteIndex
    "swap the byteOrder of a long.
     The index is a smalltalk index (i.e. 1-based)."

    |t|

    t := self byteAt:byteIndex.
    self byteAt:byteIndex put:(self byteAt:(byteIndex + 3)).
    self byteAt:(byteIndex + 3) put:t.
    t := self byteAt:(byteIndex + 1).
    self byteAt:(byteIndex + 1) put:(self byteAt:(byteIndex + 2)).
    self byteAt:(byteIndex + 2) put:t

    "Created: / 3.4.1998 / 13:37:01 / cg"
! !

!UninterpretedBytes methodsFor:'private'!

slowReplaceBytesFrom:start to:stop with:sourceBytes startingAt:sourceIndex
    "fallback if primitive code fails"

    |srcIdx|

    srcIdx := sourceIndex.
    start to:stop do:[:dstIdx |
	self at:dstIdx put:(sourceBytes at:srcIdx).
	srcIdx := srcIdx + 1
    ].
! !

!UninterpretedBytes methodsFor:'queries'!

defaultElement
    ^ 0
!

sizeInBytes
    "return the number of 8-bit bytes in the receiver.
     This is needed since subclasse may redefine #size (TwoByteString)"

    ^ super size

    "Created: / 5.3.1998 / 10:41:13 / stefan"
! !

!UninterpretedBytes methodsFor:'testing'!

isByteCollection
    "return true, if the receiver has access methods for bytes;
     true is returned here - the method is redefined from Object."

    ^ true
!

isNonByteCollection
    "return true, if the receiver is some kind of collection, but not a String, ByteArray etc.;
     false is returned here - the method is redefined from Collection."

    ^ false
! !

!UninterpretedBytes methodsFor:'visiting'!

acceptVisitor:aVisitor with:aParameter
    "dispatch for visitor pattern; send #visitByteArray:with: to aVisitor."

    ^ aVisitor visitByteArray:self with:aParameter
! !

!UninterpretedBytes class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
! !


UninterpretedBytes initialize!