"{ Encoding: utf8 }"

"

 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.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

ArrayedCollection variableSubclass:#Array

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Collections-Arrayed'

!

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

"

!

documentation

"

    Instances of Array store general objects;

    an array's size is fixed, therefore add:/remove: are not allowed.

    (actually, #add: is implemented for compatibility with smalltalks which

     provide it, but it is very slow and outputs an annoying warning message...)

    Access to the individual elements is via an integer index,

    using the well-known access messages #at: and #at:put:.

    Since Arrays are used very often in the system (either directly or a data-container

    of more complex collection classes), some methods have been tuned by reimplementing

    them as primitives. Also, the compiler inline-codes some operations

    (especially: the above accessing messages).

    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 Arrays inheritance.

    However, subclassing is allowed of course

    - even with added named instance variables.

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

	#( element1 element2 ... element-N)

    where each element must be itself a literal constant.

    Array, symbol and byteArray constants within an array can be written

    without the initial #-character.

    In addition, true, false and nil are also allowed as array-literal.

    Examples:

      #(1 2 3)                -> 3 elements: 1, 2 and 3

      #('foo' 2 (1 2))        -> 3 elements: a String, 2 and anotherArray

      #('foo' #(1 2) #foo)    -> 3 elements: a String, another array and a symbol

      #('foo' (1 2) foo)      -> same as above

      #(nil true #true)       -> 3 elements: nil, true and a symbol (watch out)

      #(two [3 3 3] (4 4 4))  -> 3 elements: a symbol, a byteArray and another array

    Also, a syntactic sugar piece allows for Array instances to be created dynamcially

    at runtime with the brace syntax:

	{ expr1 . expr2 . ... . expr-N }

    where each expr-i evaluates to an element of the new array instance.

    Notice that the expressions are separated by a period.

    Semantically, this is equivalent to ``Array with:expr1 with:expr2 ... with:expr-N''

    Examples:

	{ 1 . 2 . 3 }         -> a new 3 element array; similar to #( 1 2 3 ),

				 but in contrast, a new array instance is created

	{

	    { 'foo' . [ Transcript showCR:'foo' ] } .

	    { 'bar' . [ Transcript showCR:'bar' ] }

	    { 'baz' . [ Transcript showCR:'baz' ] }

	}

			      -> a new 3 element array, consisting of 3 new

				 2-element array instances, consisting of a string

				 and a block each

    [memory requirements:]

	OBJ-HEADER + (size * ptr-size)

    [warning:]

	read the warning about 'growing fixed size collection'

	in ArrayedCollection's documentation

    [author:]

	Claus Gittinger

    [see also:]

	OrderedCollection

	ByteArray FloatArray DoubleArray IntegerArray BitArray

	CharacterArray String

"

! !

!Array class methodsFor:'instance creation'!

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

    unsigned INT instsize;

    INT nindexedinstvars;

    REGISTER OBJ *op;

    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)) {     /* OBJECT ALLOCATION */

		/*

		 * the most common case

		 */

		__qCheckedAlignedNew(newobj, instsize);

	ok: ;

		__InstPtr(newobj)->o_class = self;

		__qSTORE(newobj, self);

#if (POINTER_SIZE == 4) && defined(memset4) && defined(FAST_ARRAY_MEMSET4)

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

#else

# if !defined(NEGATIVE_ADDRESSES)

		/*

		 * knowing that nil is 0

		 */

#  ifdef __sparc__

#   define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED

#  endif

#  ifdef __VMS__

#   define FAST_ARRAY_MEMSET_LONGLONG_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 (POINTER_SIZE == 4) && defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)

#    ifdef INT64

#     define LONGLONG INT64

#    else

#     define LONGLONG long long

#    endif

		op = __InstPtr(newobj)->i_instvars;

		if (nInstVars > 8) {

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

		    nInstVars--;

		    while (nInstVars >= 8) {

			*(LONGLONG *)op = 0;

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

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

			((LONGLONG *)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;

#     if (POINTER_SIZE == 4) && defined(INT64)

		while (nInstVars > 1) {

		    *((INT64 *)op) = 0;

		    nInstVars -= 2;

		    op += 2;

		}

#     endif

		while (nInstVars >= 8) {

		    nInstVars -= 8;

		    op[0] = nil; op[1] = nil;

		    op[2] = nil; op[3] = nil;

		    op[4] = nil; op[5] = nil;

		    op[6] = nil; op[7] = nil;

		    op += 8;

		}

		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__

		newobj = __STX___new((INT)instsize);

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

!

new:anInteger

    "return an instance of myself with anInteger indexed variables.

     Redefined here to save a few cycles when executed.

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

      Future versions of stc will do this automatically.)"

    ^ self basicNew:anInteger

    "Modified: 23.4.1996 / 15:52:15 / cg"

! !

!Array class methodsFor:'queries'!

isBuiltInClass

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

     Here, true is returned for myself, false for subclasses."

    ^ self == Array

    "Modified: 23.4.1996 / 15:55:06 / cg"

! !

!Array methodsFor:'accessing'!

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 when arriving here, #at: is obviously not

      redefined in a subclass).

     This method is the same as basicAt:."

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (index.isSmallInteger()) {

	return context._RETURN( self.basicAt(index.intValue() ));

    }

#else

    REGISTER INT indx;

    REGISTER OBJ slf;

    REGISTER unsigned INT nIndex;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index) - 1;

	slf = self;

	cls = __qClass(slf);

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

	if (cls == Array) {

	    fetch:

	    if ((unsigned INT)indx < (unsigned INT)nIndex) {

	        RETURN ( __InstPtr(slf)->i_instvars[indx] );

	    }

	    goto badIndex;

	}

	if (indx < 0) goto badIndex;

	indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);	

	goto fetch;

    }

badIndex: ;

#endif /* not SCHTEAM */

%}.

"/    ^ super at:index

    ^ super basicAt:index   "/ knowing that super-#at: does #basicAt:

!

at:index put:anObject

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

     Returns anObject (sigh).

     Reimplemented here to avoid the additional at:put:->basicAt:put: send

     (which we can do here, since when arriving here, #atput:: is obviously not

      redefined in a subclass).

     This method is the same as basicAt:put:."

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (index.isSmallInteger()) {

	self.basicAt_put(index.intValue(), anObject);

	return context._RETURN( anObject );

    }

#else

    REGISTER INT indx;

    REGISTER OBJ slf;

    REGISTER unsigned INT nIndex;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index) - 1;

	slf = self;

        cls = __qClass(slf);

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

	if (cls == Array) {

	    store:

            if ((unsigned INT)indx < (unsigned INT)nIndex) {

	        __InstPtr(slf)->i_instvars[indx] = anObject;

	        __STORE(slf, anObject);

	        RETURN ( anObject );

	    }

	    goto badIndex;

	}

	if (indx < 0) goto badIndex;

	indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);	

	goto store;

    }

badIndex: ;

#endif /* not SCHTEAM */

%}.

"/    ^ super at:index put:anObject

    ^ super basicAt:index put:anObject  "/ knowing that super-#at:put: does #basicAt:put:

    "Modified: 19.4.1996 / 11:16:42 / cg"

!

basicAt:index

    "return the indexed instance variable with index, anInteger

     - added here for speed"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (index.isSmallInteger()) {

	return context._RETURN( self.basicAt(index.intValue() ));

    }

#else

    REGISTER INT indx;

    REGISTER OBJ slf;

    REGISTER unsigned INT nIndex;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index) - 1;

	slf = self;

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

	if ((cls = __qClass(slf)) != Array) {

	    if (indx < 0) goto badIndex;

	    indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);

	}

	if ((unsigned INT)indx < (unsigned INT)nIndex) {

	    RETURN ( __InstPtr(slf)->i_instvars[indx] );

	}

    }

badIndex: ;

#endif /* not SCHTEAM */

%}.

    ^ super basicAt:index

!

basicAt:index put:anObject

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

     Returns anObject (sigh).

     - added here for speed"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    if (index.isSmallInteger()) {

	self.basicAt_put(index.intValue(), anObject);

	return context._RETURN( anObject );

    }

#else

    REGISTER INT indx;

    REGISTER OBJ slf;

    REGISTER unsigned INT nIndex;

    REGISTER OBJ cls;

    if (__isSmallInteger(index)) {

	indx = __intVal(index) - 1;

	slf = self;

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

	if ((cls = __qClass(slf)) != Array) {

	    if (indx < 0) goto badIndex;

	    indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);

	}

	if ((unsigned INT)indx < (unsigned INT)nIndex) {

	    __InstPtr(slf)->i_instvars[indx] = anObject;

	    __STORE(slf, anObject);

	    RETURN ( anObject );

	}

    }

badIndex: ;

#endif /* not SCHTEAM */

%}.

    ^ super basicAt:index put:anObject

    "Modified: 19.4.1996 / 11:14:26 / cg"

! !

!Array methodsFor:'converting'!

asArray

    "return the receiver as an array - that's the receiver itself.

     Notice: Use asNewArray, if you intent to modify the returned collection."

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

    self class == Array ifTrue:[

	^ self

    ].

    ^ super asArray