"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

ArrayedCollection variableSubclass:#Array

       instanceVariableNames:''

       classVariableNames:''

       poolDictionaries:''

       category:'Collections-Arrayed'

!

Array comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Array.st,v 1.25 1995-05-16 17:05:26 claus Exp $

'!

!Array class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

$Header: /cvs/stx/stx/libbasic/Array.st,v 1.25 1995-05-16 17:05:26 claus Exp $

"

!

documentation

"

    Instances of Array store general objects; the arrays size is fixed, 

    therefore add:/remove: are not allowed. 

    Access to the individual elements is via an integer index. 

    Since Arrays are used very often in the system, some methods have been tuned by

    reimplementing them as primitive.

    Notice that Array is a built-in class (i.e. the VM knows about its

    representation). Therefore it is NOT possible to add named instance 

    variables or change its inheritance. Subclassing is allowed - of course.

    Literal arrays (i.e. array-constants) are entered in source as:

	#( element1 element2 ... element-n)

    where each element must be itself a constant.

    Examples:

	#(1 2 3)               

	#('foo' 2 (1 2) 4)     

	#('foo' #(1 2))        

"

! !

!Array class methodsFor:'queries'!

isBuiltInClass

    "this class is known by the run-time-system"

    ^ self == Array

! !

!Array class methodsFor:'instance creation'!

new:anInteger

    "return an instance of myself with anInteger indexed variables.

     Since this is often called, its worth gibing it an extra ilc-slot.

     Future versions of stc will do this automatically."

    ^ self basicNew:anInteger

!

basicNew:anInteger

    "return an instance of myself with anInteger indexed variables.

     Since Array-creation is so common (all other collections use them),

     it seems worth to have a specially tuned version here."

%{  /* NOCONTEXT */

    OBJ newobj;

    unsigned INT instsize, nInstVars;

    INT nindexedinstvars;

    REGISTER OBJ *op;

    extern OBJ new();

    if (__isSmallInteger(anInteger)) {

	nindexedinstvars = _intVal(anInteger);

	if (nindexedinstvars >= 0) {

	    nInstVars = _intVal(_ClassInstPtr(self)->c_ninstvars);

	    nInstVars += nindexedinstvars;

	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);

	    PROTECT_CONTEXT

	    _qAlignedNew(newobj, instsize, SENDER);

	    UNPROTECT_CONTEXT

	    if (newobj != nil) {

		_InstPtr(newobj)->o_class = self;

#if defined(FAST_ARRAY_MEMSET4)

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

#else

# if !defined(NEGATIVE_ADDRESSES)

		/*

		 * knowing that nil is 0

		 */

#ifdef mips

# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED

# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED

/* seems to be slightly faster */

# define FAST_ARRAY_MEMSET

#endif

#ifdef sparc

# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED

#endif

#  if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)

		op = _InstPtr(newobj)->i_instvars;

		if (nInstVars > 8) {

		    *op++ = nil;    /* for alignment */

		    nInstVars--;

		    while (nInstVars >= 8) {

			*(double *)op = 0.0;

			((double *)op)[1] = 0.0;

			((double *)op)[2] = 0.0;

			((double *)op)[3] = 0.0;

			op += 8;

			nInstVars -= 8;

		    }

		}

		while (nInstVars) {

		    *op++ = 0;

		    nInstVars--;

		}

#  else

#   if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)

		op = _InstPtr(newobj)->i_instvars;

		if (nInstVars > 8) {

		    *op++ = nil;    /* for alignment */

		    nInstVars--;

		    while (nInstVars >= 8) {

			*(long long *)op = 0;

			((long long *)op)[1] = 0;

			((long long *)op)[2] = 0;

			((long long *)op)[3] = 0;

			op += 8;

			nInstVars -= 8;

		    }

		}

		while (nInstVars) {

		    *op++ = 0;

		    nInstVars--;

		}

#   else

#    if defined(FAST_ARRAY_MEMSET)

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

#    else

		op = _InstPtr(newobj)->i_instvars;

		while (nInstVars--)

		    *op++ = nil;

#    endif

#   endif

#  endif

# else

		op = _InstPtr(newobj)->i_instvars;

		while (nInstVars--)

		    *op++ = nil;

# endif

#endif

		RETURN ( newobj );

	    }

	}

    }

%}.

    "

     arrive here if something went wrong ...

     figure out what it was

    "

    (anInteger isMemberOf:SmallInteger) ifFalse:[

	"

	 the argument is either not an integer,

	 or a LargeInteger (which means that its definitely too big)

	"

	self error:'argument to new: must be Integer'.

	^ nil

    ].

    (anInteger < 0) ifTrue:[

	"

	 the argument is negative,

	"

	self error:'bad (negative) argument to new:'.

	^ nil

    ].

    "

     memory allocation failed.

     When we arrive here, there was no memory, even after

     a garbage collect. 

     This means, that the VM wanted to get some more memory from the 

     Operatingsystem, which was not kind enough to give it.

     Bad luck - you should increase the swap space on your machine.

    "

    ^ ObjectMemory allocationFailureSignal raise.

!

with:one

%{  /* NOCONTEXT */

    if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {

        if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(1))) {

            OBJ newArray;

            _qCheckedAlignedNew(newArray, sizeof(struct __arrayheader) + __OBJS2BYTES__(1));

            _InstPtr(newArray)->o_class = self;

	    _ArrayInstPtr(newArray)->a_element[0] = one;

	    __STORE(newArray, one);

            return newArray;

	}

    }

%}.

    ^ super with:one

!

with:one with:two

%{  /* NOCONTEXT */

    if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {

        if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(2))) {

            OBJ newArray;

            _qCheckedAlignedNew(newArray, sizeof(struct __arrayheader) + __OBJS2BYTES__(2));

            _InstPtr(newArray)->o_class = self;

            _ArrayInstPtr(newArray)->a_element[0] = one;

            _ArrayInstPtr(newArray)->a_element[1] = two;

            __STORE(newArray, one);

            __STORE(newArray, two);

            return newArray;

        }

    }

%}.

    ^ super with:one with:two

!

with:one with:two with:three

%{  /* NOCONTEXT */

    if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {

        if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(3))) {

            OBJ newArray;

            _qCheckedAlignedNew(newArray, sizeof(struct __arrayheader) + __OBJS2BYTES__(3));

            _InstPtr(newArray)->o_class = self;

            _ArrayInstPtr(newArray)->a_element[0] = one;

            _ArrayInstPtr(newArray)->a_element[1] = two;

            _ArrayInstPtr(newArray)->a_element[2] = three;

            __STORE(newArray, one);

            __STORE(newArray, two);

            __STORE(newArray, three);

            return newArray;

        }

    }

%}.

    ^ super with:one with:two with:three

!

with:one with:two with:three with:four

%{  /* NOCONTEXT */

    if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {

        if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(4))) {

            OBJ newArray;

            _qCheckedAlignedNew(newArray, sizeof(struct __arrayheader) + __OBJS2BYTES__(4));

            _InstPtr(newArray)->o_class = self;

            _ArrayInstPtr(newArray)->a_element[0] = one;

            _ArrayInstPtr(newArray)->a_element[1] = two;

            _ArrayInstPtr(newArray)->a_element[2] = three;

            _ArrayInstPtr(newArray)->a_element[3] = four;

            __STORE(newArray, one);

            __STORE(newArray, two);

            __STORE(newArray, three);

            __STORE(newArray, four);

            return newArray;

        }

    }

%}.

    ^ super with:one with:two with:three with:four

! !

!Array methodsFor:'accessing'!

basicSize

    "return the number of indexed elements in the receiver"

%{  /* NOCONTEXT */

    RETURN ( __MKSMALLINT(_arraySize(self) - _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars) ));

%}

!

basicAt:index

    "return the indexed instance variable with index, anInteger

     - added here for speed"

%{  /* NOCONTEXT */

    REGISTER int indx;

    REGISTER unsigned int nIndex;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index) - 1;

	if (indx >= 0) {

	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);

	    if ((cls = __qClass(self)) != Array)

		indx += _intVal(_ClassInstPtr(cls)->c_ninstvars);

	    if (indx < nIndex) {

		RETURN ( _InstPtr(self)->i_instvars[indx] );

	    }

	}

    }

%}

.

    ^ super basicAt:index

!

basicAt:index put:anObject

    "store the 2nd arg, anObject as indexed instvar with index, anInteger.

     - added here for speed"

%{  /* NOCONTEXT */

    REGISTER int indx;

    REGISTER unsigned int nIndex;

    OBJ cls;

    if (__isSmallInteger(index)) {

	indx = _intVal(index) - 1;

	if (indx >= 0) {

	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);

	    if ((cls = __qClass(self)) != Array)

		indx += _intVal(_ClassInstPtr(cls)->c_ninstvars);

	    if (indx < nIndex) {

		_InstPtr(self)->i_instvars[indx] = anObject;

		__STORE(self, anObject);

		RETURN ( anObject );

	    }

	}

    }

%}

.

    ^ super basicAt:index put:anObject

! !

!Array methodsFor:'converting'!

asArray

    "return the receiver as an array"

    "could be an instance of a subclass..."

    self class == Array ifTrue:[

	^ self

    ].

    ^ super asArray

! !

!Array methodsFor:'copying'!

copyWith:something

    "return a new collection containing the receivers elements

     and the single new element, newElement. 

     This is different from concatentation, which expects another collection

     as argument, but equivalent to copy-and-addLast.

     Reimplemented for speed if receiver is an Array"

%{

    OBJ nObj, element;

    unsigned int sz;

    unsigned int nIndex;

    REGISTER OBJ *srcP, *dstP;

    REGISTER int spc;

    if (__qClass(self) == Array) {

	sz = __qSize(self) + sizeof(OBJ);

	PROTECT(something);

	_qAlignedNew(nObj, sz, __context);

	UNPROTECT(something);

	if (nObj) {

	    _InstPtr(nObj)->o_class = Array;

	    nIndex = __BYTES2OBJS__(sz - OHDR_SIZE - sizeof(OBJ));

	    /* sorry: must take care of stores ... */

	    srcP = _ArrayInstPtr(self)->a_element;

	    dstP = _ArrayInstPtr(nObj)->a_element;

	    spc = __qSpace(nObj);

	    while (nIndex--) {

		element = *srcP++;

		*dstP++ = element;

		__STORE_SPC(nObj, element, spc);

	    }

	    *dstP = something;

	    __STORE_SPC(nObj, something, spc);

	    RETURN ( nObj );

	}

    }

%}

.

    ^ super copyWith:something

! !

!Array methodsFor:'filling & replacing'!

from:index1 to:index2 put:anObject

    "reimplemented for speed if receiver is an Array"

%{  /* NOCONTEXT */

    REGISTER int index;

    unsigned int nIndex;

    unsigned int endIndex;

    REGISTER OBJ *dst;

    if ((__qClass(self) == Array)

     && __bothSmallInteger(index1, index2)) {

	index = _intVal(index1) - 1;

	if (index >= 0) {

	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);

	    endIndex = _intVal(index2) - 1;

	    if (endIndex < nIndex) {

		dst = &(_InstPtr(self)->i_instvars[index]);

#ifdef memset4

		memset4(dst, anObject, (endIndex-index+1));

		__STORE(self, anObject);

#else

		if ((INT)anObject == 0) {

		    memset(dst, 0, __OBJS2BYTES__(endIndex-index+1));

		} else {

		    for (; index <= endIndex; index++) {

			*dst++ = anObject;

		    }

		    __STORE(self, anObject);

		}

#endif

		RETURN ( self );

	    }

	}

    }

%}

.

    ^ super from:index1 to:index2 put:anObject

!

replaceFrom:start to:stop with:aCollection startingAt:repStart

    "reimplemented for speed if both receiver and aCollection are Arrays"

%{  /* NOCONTEXT */

    unsigned int nIndex;

    unsigned int repNIndex;

    int startIndex, stopIndex;

    REGISTER OBJ *src;

    REGISTER OBJ *dst;

    int repStopIndex;

    REGISTER int repStartIndex;

    REGISTER OBJ t;

    REGISTER int count;

    if ((_ClassInstPtr(__qClass(self))->c_ninstvars == __MKSMALLINT(0))

     && (((t = __Class(aCollection)) == Array) || (t == __qClass(self)))

     && __bothSmallInteger(start, stop)

     && __isSmallInteger(repStart)) {

	startIndex = _intVal(start) - 1;

	if (startIndex >= 0) {

	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);

	    stopIndex = _intVal(stop) - 1;

	    count = stopIndex - startIndex + 1;

	    if (count == 0) {

		RETURN ( self );

	    }

	    if ((count > 0) && (stopIndex < nIndex)) {

		repStartIndex = _intVal(repStart) - 1;

		if (repStartIndex >= 0) {

		    repNIndex = __BYTES2OBJS__(__qSize(aCollection)-OHDR_SIZE);