Array.st
author claus
Tue, 06 Jun 1995 05:56:11 +0200
changeset 357 82091a50055d
parent 356 6c5ce0e1e7a8
child 359 b8df66983eff
permissions -rw-r--r--
.

"
 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.28 1995-06-06 03:52:50 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.28 1995-06-06 03:52:50 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 giving 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);
	    if (_CanDoQuickAlignedNew(instsize)) {
		/*
		 * the most common case
		 */
		_qCheckedAlignedNew(newobj, instsize);
	ok: ;
		_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 );
	    } else {
		/*
		 * a GC will happen ...
		 * have to protect all context stuff
		 * (especially for self, but also for backtrace in case of
		 *  allocation failure)
		 */
		PROTECT_CONTEXT
		_qAlignedNew(newobj, instsize, SENDER);
		UNPROTECT_CONTEXT
		if (newobj != nil) {
		    goto ok;
		}
	    }
	}
    }
%}.
    "
     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) ));
%}
!

size
    "return the number of indexed elements in the receiver.
     Reimplemented here to avoid the additional size->basicSize send
     (which we can do here, since size is obviously not redefined in a subclass).
     This method is the same as basicSize."

%{  /* 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
!

at:index
    "return the indexed instance variable with index, anInteger.
     Reimplemented here to avoid the additional at:->basicAt: send
     (which we can do here, since at: is obviously not redefined in a subclass).
     This method is the same as at:."

%{  /* 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 at: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
!

at:index put:anObject
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
     Reimplemented here to avoid the additional at:put:->basicAt:put: send
     (which we can do here, since at: is obviously not redefined in a subclass).
     This method is the same as at:."

%{  /* 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 at: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);
		    repStopIndex = repStartIndex + (stopIndex - startIndex);
		    if (repStopIndex < repNIndex) {
			src = &(_InstPtr(aCollection)->i_instvars[repStartIndex]);
			dst = &(_InstPtr(self)->i_instvars[startIndex]);
			if (aCollection == self) {
			    /* no need to check stores */
			    /* 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
			    bcopy4(src, dst, count);
#else
# ifdef FAST_MEMCPY
			    bcopy(src, dst, __OBJS2BYTES__(count));
# else
			    while (count--) {
				*dst++ = *src++;
			    }
# endif
#endif
			} else {
			    REGISTER int spc;

			    spc = __qSpace(self);
			    while (count-- > 0) {
				t = *src++;
				*dst++ = t;
				__STORE_SPC(self, t, spc);
			    }
			}
			RETURN ( self );
		    }
		}
	    }
	}
    }
%}
.
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
! !

!Array methodsFor:'queries'!

isLiteral
    "return true, if the receiver can be used as a literal
     (i.e. can be used in constant arrays)"

    "no, subclasses of array are not"
    self class == Array ifFalse:[^ false].

    thisContext isRecursive ifTrue:[^ false].

    self do:[:element |
	element isLiteral ifFalse:[^ false]
    ].
    ^ true
!

refersToLiteral: aLiteral
    self do: [ :el | 
	el == aLiteral ifTrue:[^true].
	el class == Array ifTrue:[
	    (el refersToLiteral: aLiteral) ifTrue: [^true]
	]
    ].
    ^ false

    "
     #(1 2 3) refersToLiteral:#foo  
     #(1 2 3 foo bar baz) refersToLiteral:#foo 
     #(1 2 3 (((bar foo))) bar baz) refersToLiteral:#foo  
    "
! !

!Array methodsFor:'testing'!

includes:anObject
    "return true, if the argument, anObject is contained in the array
     - reimplemented for speed"

    |element|

%{  /* NOCONTEXT */

    /* 
     * first, do a quick check using ==
     * this does not need a context or message send.
     * in many cases this will already find a match
     */
    REGISTER int index;
    REGISTER OBJ o;
    unsigned int nIndex;

    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);

    o = anObject;
    while (index < nIndex) {
	if (_InstPtr(self)->i_instvars[index++] == o) {
	    RETURN ( true );
	}
    }
    if (o == nil) {
	RETURN ( false );
    }
%}
.
%{
    /* 
     * then do a slow(er) check using =
     */
    REGISTER int index;
    unsigned int nIndex;
    static struct inlineCache eq = _ILC1;

    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);

    while (index < nIndex) {
	element = _InstPtr(self)->i_instvars[index++];
	if (element != nil) {
	    if ((*eq.ilc_func)(anObject,
			       @symbol(=),
			       CON_COMMA nil,&eq,
			       element)==true) {
		RETURN ( true );
	    }
	}
    }
%}.
    ^ false
!

indexOf:anElement startingAt:start
    "search the array for anElement; return index if found, 0 otherwise
     - reimplemented for speed"

    |element|
%{
    REGISTER int index;
    unsigned int nIndex, nInsts;
    static struct inlineCache eq = _ILC1;

    if (__isSmallInteger(start)) {
	index = _intVal(start) - 1;
	if (index >= 0) {
	    nInsts = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
	    index += nInsts;
	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
	    if (anElement != nil) {
		while (index < nIndex) {
		    element = _InstPtr(self)->i_instvars[index++];
		    if (element != nil) {
			if ((element == anElement) 
			 || ((*eq.ilc_func)(anElement,
					    @symbol(=), 
					    CON_COMMA nil,&eq,
					    element) == true)) {
			    RETURN ( __MKSMALLINT(index - nInsts) );
			}
		    }
		}
	    } else {
		/* search for nil */
		while (index < nIndex) {
		    if (_InstPtr(self)->i_instvars[index++] == nil) {
			RETURN ( __MKSMALLINT(index - nInsts) );
		    }
		}
	    }
	}
    }
%}.
    ^ 0
!

identityIndexOf:anElement startingAt:start
    "search the array for anElement; return index if found, 0 otherwise
     - reimplemented for speed"

%{  /* NOCONTEXT */

    REGISTER int index;
    REGISTER OBJ el;
    REGISTER OBJ *op;
    REGISTER unsigned int nIndex;
    int nInsts;

    if (__isSmallInteger(start)) {
	index = _intVal(start) - 1;
	if (index >= 0) {
	    nInsts = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
	    index += nInsts;
	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
	    el = anElement;
	    op = & (_InstPtr(self)->i_instvars[index]);
	    while (index++ < nIndex) {
		if (*op++ == el) {
		    RETURN ( __MKSMALLINT(index - nInsts) );
		}
	    }
	    RETURN ( __MKSMALLINT(0) );
	}
    }
%}.
    ^ super identityIndexOf:anElement startingAt:start
!

identityIndexOf:anElement or:alternative 
    "search the array for anElement or alternative; 
     return the index of anElement if found, or the index of anAlternative,
     if not found. If anAlternative is also not found, return 0.
     This is a special interface for high-speed searching in an array
     and at the same time searching for an empty slot.
     Do not use this method for your application classes, since it is
     not portable (i.e. other smalltalks do not offer this)"

%{  /* NOCONTEXT */

    REGISTER int index;
    REGISTER OBJ o, el1, el2;
    REGISTER OBJ *op;
    REGISTER unsigned int nIndex;
    int altIndex = 0;
    int nInsts;

    index = 0;
    nInsts = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
    index += nInsts;
    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    el1 = anElement; el2 = alternative; 
    op = & (_InstPtr(self)->i_instvars[index]);
    while (index++ < nIndex) {
	if ((o = *op++) == el1) {
	    RETURN ( __MKSMALLINT(index - nInsts) );
	}
	if (o == el2) {
	    if (altIndex == 0) {
		altIndex = index;
	    }
	}
    }
    RETURN ( __MKSMALLINT(altIndex) );
%}

    "
     #(1 2 3 4 5 6 7 8 9) identityIndexOf:3 or:5
     #(1 2 0 4 5 6 7 8 9) identityIndexOf:3 or:5
     #(1 2 0 4 5 6 7 3 9) identityIndexOf:3 or:5
     #(1 2 3 4 5 nil 7 3 9) identityIndexOf:3 or:nil 
     #(1 2 nil 4 5 6 7 3 9) identityIndexOf:3 or:nil 
     #(1 2 nil 4 5 6 7 8 9) identityIndexOf:3 or:nil 
     #() identityIndexOf:3 or:nil 
     #(1 2) identityIndexOf:3 or:nil 
    "
! !

!Array methodsFor:'printing & storing'!

displayString
    "return a printed representation of the receiver for displaying"

    |s|

    (self isLiteral) ifTrue:[
	s := WriteStream on:String new.
	s nextPutAll:'#('.
	self do:[:element | s nextPutAll:element displayString. s space].
	s nextPutAll:')'.
	^ s contents
    ].
    ^ super displayString
!

storeOn:aStream
    "append a printed representation of the receiver to aStream,
     which allows reconstructing it via readFrom:.
     Redefined to output a somewhat more user friendly string."

    self isLiteral ifTrue:[
	aStream nextPutAll:'#('.
	self do:[:element | element storeOn:aStream. aStream space].
	aStream nextPutAll:')'
    ] ifFalse:[
	super storeOn:aStream
    ]

    "
     #(1 2 $a 'hello') storeString 
    "
! !

!Array methodsFor:'enumerating'!

do:aBlock
    "evaluate the argument, aBlock for each element in the collection.
     - reimplemented for speed"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    unsigned int nIndex;
    extern OBJ Block;
    static struct inlineCache val = _ILC1;
    REGISTER OBJ rHome;

    index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    if (__isBlockLike(aBlock)
     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
     && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
#ifdef NEW_BLOCK_CALL
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

	    (*codeVal)(aBlock, CON_COMMA  _InstPtr(self)->i_instvars[index]);
	} 
#else
	home = _BlockInstPtr(aBlock)->b_home;
	rHome = home;
	if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
	    /*
	     * home will not move - keep in a fast register
	     */
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

		(*codeVal)(rHome, CON_COMMA  _InstPtr(self)->i_instvars[index]);
	    } 
	} else {
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

		(*codeVal)(home, CON_COMMA  _InstPtr(self)->i_instvars[index]);
	    } 
	} 
#endif
    } else {
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

	    (*val.ilc_func)(aBlock, 
			    @symbol(value:), 
			    CON_COMMA  nil, &val, 
			    _InstPtr(self)->i_instvars[index]);
	} 
    }
%}
.
    ^ self
!

keysAndValuesDo:aBlock
    "evaluate the argument, aBlock for each element in the collection.
     Pass both index and element to the block.
     - reimplemented for speed"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    unsigned int nIndex;
    extern OBJ Block;
    static struct inlineCache val2 = _ILC2;
    REGISTER OBJ rHome;

    index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    if (__isBlockLike(aBlock)
     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
     && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(2))) {
#ifdef NEW_BLOCK_CALL
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

	    (*codeVal)(aBlock, CON_COMMA  __MKSMALLINT(index+1),
					  _InstPtr(self)->i_instvars[index]);
	} 
#else
	home = _BlockInstPtr(aBlock)->b_home;
	rHome = home;
	if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
	    /*
	     * home will not move - keep in a fast register
	     */
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

		(*codeVal)(rHome, CON_COMMA  __MKSMALLINT(index+1),
					     _InstPtr(self)->i_instvars[index]);
	    } 
	} else {
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

		(*codeVal)(home, CON_COMMA  __MKSMALLINT(index+1),
					    _InstPtr(self)->i_instvars[index]);
	    } 
	} 
#endif
    } else {
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);

	    (*val2.ilc_func)(aBlock, 
			    @symbol(value:value:), 
			    CON_COMMA  nil, &val2,
			    __MKSMALLINT(index+1),
			    _InstPtr(self)->i_instvars[index]);
	} 
    }
%}
.
    ^ self
!

reverseDo:aBlock
    "evaluate the argument, aBlock for each element in the collection in reverse order.
     - reimplemented for speed"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    unsigned int nIndex;
    int endIndex;
    extern OBJ Block;
    static struct inlineCache val = _ILC1;

    endIndex = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    if (__isBlockLike(aBlock)
     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
     && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
#ifdef NEW_BLOCK_CALL
	for (index=nIndex-1; index >= endIndex; index--) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
	    (*codeVal)(aBlock, CON_COMMA  _InstPtr(self)->i_instvars[index]);
	} 
#else
	home = _BlockInstPtr(aBlock)->b_home;
	for (index=nIndex-1; index >= endIndex; index--) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
	    (*codeVal)(home, CON_COMMA  _InstPtr(self)->i_instvars[index]);
	} 
#endif
    } else {
	for (index=nIndex=1; index >= endIndex; index--) {
	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
	    (*val.ilc_func)(aBlock, 
			    @symbol(value:), 
			    CON_COMMA  nil, &val, 
			    _InstPtr(self)->i_instvars[index]);
	} 
    }
%}
.
    ^ self
!

from:start to:stop do:aBlock
    "evaluate the argument, aBlock for the elements starting at index start
     up to (and including) stop in the collection.
     - reimplemented for speed"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    REGISTER OBJ rHome;
    int nIndex, nInsts;
    extern OBJ Block;
    static struct inlineCache val = _ILC1;
    int indexLow, indexHigh;

    if (__bothSmallInteger(start, stop)) {
	indexLow = _intVal(start);
	if (indexLow > 0) {
	    indexHigh = _intVal(stop);
	    if (__qClass(self) != Array) {
		nInsts = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
		indexLow += nInsts;
		indexHigh += nInsts;
	    }
	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
	    if (indexHigh <= nIndex) {
		indexLow--;
		indexHigh--;
		if (__isBlockLike(aBlock)
		 && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
		 && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
#ifdef NEW_BLOCK_CALL
		    for (index=indexLow; index <= indexHigh; index++) {
			if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			(*codeVal)(aBlock, CON_COMMA  _InstPtr(self)->i_instvars[index]);
		    } 
#else
		    home = _BlockInstPtr(aBlock)->b_home;
		    rHome = home;
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
			for (index=indexLow; index <= indexHigh; index++) {
			    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			    (*codeVal)(rHome, CON_COMMA  _InstPtr(self)->i_instvars[index]);
			} 
		    } else {
			for (index=indexLow; index <= indexHigh; index++) {
			    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			    (*codeVal)(home, CON_COMMA  _InstPtr(self)->i_instvars[index]);
			} 
		    }
#endif
		} else {
		    for (index=indexLow; index <= indexHigh; index++) {
			if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			(*val.ilc_func) (aBlock, 
					 @symbol(value:), 
					 CON_COMMA  nil, &val, 
					 _InstPtr(self)->i_instvars[index]);
		    } 
		}
	    }
	    RETURN ( self );
	}
    }
%}
.
    ^ super from:start to:stop do:aBlock
!

from:start to:stop reverseDo:aBlock
    "evaluate the argument, aBlock for the elements starting at index start
     up to (and including) stop in the collection. Step in reverse order.
     - reimplemented for speed"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    REGISTER OBJ rHome;
    int nIndex, nInsts;
    extern OBJ Block;
    static struct inlineCache val = _ILC1;
    int indexLow, indexHigh;

    if (__bothSmallInteger(start, stop)) {
	indexLow = _intVal(start);
	if (indexLow > 0) {
	    indexHigh = _intVal(stop);
	    if (__qClass(self) != Array) {
		nInsts = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
		indexLow += nInsts;
		indexHigh += nInsts;
	    }
	    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
	    if (indexHigh <= nIndex) {
		indexLow--;
		indexHigh--;
		if (__isBlockLike(aBlock)
		 && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
		 && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
#ifdef NEW_BLOCK_CALL
		    for (index=indexHigh; index >= indexLow; index--) {
			if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			(*codeVal)(aBlock, CON_COMMA  _InstPtr(self)->i_instvars[index]);
		    } 
#else
		    home = _BlockInstPtr(aBlock)->b_home;
		    rHome = home;
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
			for (index=indexHigh; index >= indexLow; index--) {
			    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			    (*codeVal)(rHome, CON_COMMA  _InstPtr(self)->i_instvars[index]);
			} 
		    } else {
			for (index=indexHigh; index >= indexLow; index--) {
			    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			    (*codeVal)(home, CON_COMMA  _InstPtr(self)->i_instvars[index]);
			} 
		    }
#endif
		} else {
		    for (index=indexHigh; index >= indexLow; index--) {
			if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
			(*val.ilc_func) (aBlock, 
					 @symbol(value:), 
					 CON_COMMA nil, &val, 
					 _InstPtr(self)->i_instvars[index]);
		    } 
		}
	    }
	    RETURN ( self );
	}
    }
%}
.
    ^ super from:start to:stop reverseDo:aBlock
!

nonNilElementsDo:aBlock
    "evaluate the argument, aBlock for each non-nil element"

    |home|
%{
    REGISTER OBJFUNC codeVal;
    REGISTER int index;
    int nIndex;
    extern OBJ Block;
    static struct inlineCache val = _ILC1;
    REGISTER OBJ rHome;
    REGISTER OBJ element;

    index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
    nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
    if (__isBlockLike(aBlock)
     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
     && (_BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
#ifdef NEW_BLOCK_CALL
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interrupt(CONARG);

	    element = _InstPtr(self)->i_instvars[index];
	    if (element != nil)
		(*codeVal)(aBlock, CON_COMMA  element);
	} 
#else
	home = _BlockInstPtr(aBlock)->b_home;
	rHome = home;
	if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
	    /*
	     * home will not move - keep in in a register
	     */
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interrupt(CONARG);

		element = _InstPtr(self)->i_instvars[index];
		if (element != nil)
		    (*codeVal)(home, CON_COMMA  element);
	    } 
	} else {
	    for (; index < nIndex; index++) {
		if (InterruptPending != nil) interrupt(CONARG);

		element = _InstPtr(self)->i_instvars[index];
		if (element != nil)
		    (*codeVal)(home, CON_COMMA  element);
	    }
	} 
#endif
    } else {
	for (; index < nIndex; index++) {
	    if (InterruptPending != nil) interrupt(CONARG);

	    element = _InstPtr(self)->i_instvars[index];
	    if (element != nil)
		(*val.ilc_func)(aBlock, 
				@symbol(value:), 
				CON_COMMA nil, &val, 
				element);
	} 
    }
%}
.
    ^ self
!

traverse:aBlock
    "Evaluate aBlock for every element that is not an Array, 
     and traverse Arrays.
     Implemented here to support better search for selectors in
     literal arrays - might be a good idea to move it up in the collection
     hierarchy, since this may be a useful method for other collections
     as well."

    self do: [:el |
	(el isKindOf: Array)
	    ifTrue: [el traverse: aBlock]
	    ifFalse: [aBlock value: el]]

    "
     example: flattening an Array:

     |s|

     s := WriteStream on:Array new.
     #(1 2 (3 (4 5 (6 7) 8) 9 10) 11 (12 (13)) 14) traverse:[:el | s nextPut:el].
     s contents 
    "
!

addAllTo:aCollection
    "add all elements of the receiver to aCollection.
     return aCollection."

    |stop "{ Class: SmallInteger }"|

    stop := self size.
    1 to:stop do:[:idx |
	aCollection add:(self at:idx)
    ].
    ^ aCollection
! !