!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: array.gs,v 1.16 2008-01-09 22:50:08 stever Exp $
!
! Superclass Hierarchy:
!   Array, SequenceableCollection, Collection, Object.
!
!=========================================================================
removeallmethods Array
removeallclassmethods Array

category: 'For Documentation Installation only'
classmethod: Array
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'Array is a concrete subclass of SequenceableCollection that capitalizes upon
 the indexability of its elements.  An Array permits its elements to be placed
 in any order, but once placed, it retains the order until changed explicitly.
 Integer indexes are often used to access elements directly, randomly, or in
 alternate or unpredictable orders not necessarily related to the sequence of
 the elements as placed in the collection.  Thus, an index is often used as
 the address for an element.

 Uninitialized Array elements are nil.' .
doc documentClassWith: txt.

self description: doc.
%

category: 'Subclass Creation'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
classInstVars: anArrayOfClassInstVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
instancesInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Backward Compatibility'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
classInstVars: anArrayOfClassInstVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
description: aDescription
isInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Subclass Creation'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
classInstVars: anArrayOfClassInstVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
newVersionOf: oldClass
instancesInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Backward Compatibility'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
classInstVars: anArrayOfClassInstVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
newVersionOf: oldClass
description: aDescription
isInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Backward Compatibility'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
isInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Backward Compatibility'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
inClassHistory: aClassHistory
description: aDescription
isInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Backward Compatibility'
classmethod: Array
byteSubclass: aString
classVars: anArrayOfClassVars
classInstVars: anArrayOfClassInstVars
poolDictionaries: anArrayOfPoolDicts
inDictionary: aDictionary
inClassHistory: aClassHistory
description: aDescription
isInvariant: invarBoolean

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Filein Support'
classmethod: Array
_newKernelByteSubclass: clsName
classVars: classVarArg
poolDictionaries: poolDicts
inDictionary: aDict
instancesInvariant: aBool
reservedOop: aReservedOop

"Disallowed for Array and its subclasses."

^ self _error: #classErrByteSubclass
%

category: 'Comparing'
method: Array
hasIdenticalContents: anArray

"Returns true if all of the following conditions are true:

 1.  The receiver and anArray are of the same class.
 2.  The two Arrays are the same size.
 3.  The corresponding elements of the receiver and anArray are equal.

 Returns false otherwise."

<primitive: 612 >

self _primitiveFailed: #hasIdenticalContents.
self _uncontinuableError
%

category: 'Copying'
method: Array
copyFrom: index1 to: index2 into: aSeqColl startingAt: destIndex

"(R) Copies the elements of the receiver between index1 and index2, inclusive,
 into aSeqColl starting at destIndex, overwriting the previous contents.  If
 aSeqColl is the same object as the receiver, the source and destination blocks
 may overlap."

<primitive: 608 >

(index1 > index2)
  ifTrue:[ index1 _error: #rtErrBadCopyFromTo args: #[index2]].

(index1 < 1) ifTrue:[ self _errorIndexOutOfRange: index1].

(index2 > self size) ifTrue:[ self _errorIndexOutOfRange: index2].

aSeqColl _validateClass: SequenceableCollection.
((destIndex < 1) _or: [(destIndex > (aSeqColl size + 1))])
  ifTrue:[ aSeqColl _errorIndexOutOfRange: destIndex].

^super copyFrom: index1 to: index2 into: aSeqColl startingAt: destIndex
%

! insertAll: aSeqColl at: anIndex  inherited from SequenceableCollection

category: 'Copying'
method: Array
_insertAt: destOffset 
from: anArray 
fromStart: startOffset
fromEnd: endOffset 
numToMoveDown: numToMove 

"Intended for use in manipulating objects which are nodes of B-trees or
 similar structures.
 
 Inserts the portion of anArray from startOffset to endOffset
 into the receiver beginning at destOffset.  

 If anArray is nil, then  (endOffset - startOffset + 1) nils are
 inserted into the receiver.

 The indexable instance variables of the receiver from destOffset to 
 (destOffset + numToMove) are moved towards the end of the receiver by 
 the amount (endOffset - startOffset + 1).
 The receiver must be a small object.

 If the receiver must be grown, it will be grown by 10 times the number
 of OOPs inserted up to a max of 500 oops. The receiver will not be
 grown larger than the max size of a small object. If the number of 
 inserted oops alone will cause the object to be larger than the max
 size of a small object, then an error will be generated.

 Generates an error if any of the arguments imply the receiver must be 
 grown to be a large object, or if destOffset is beyond the end of
 the receiver."

<primitive: 605 >

| numInserted newSize |

anArray ~~ nil ifTrue:[ anArray _validateClass: Array ].

(destOffset < 1 _or:[ destOffset > self _basicSize] )
   ifTrue:[ self _errorIndexOutOfRange: destOffset] .
(startOffset < 1) ifTrue:[ self _errorIndexOutOfRange: startOffset] .
(endOffset < 1)   ifTrue:[ self _errorIndexOutOfRange: endOffset] .
(numToMove < 0)   ifTrue:[ self _errorIndexOutOfRange: numToMove] .
(endOffset < startOffset) ifTrue:[ self _errorIndexOutOfRange: endOffset ].
(anArray ~~ nil _and: [startOffset > anArray _basicSize]) ifTrue:[ anArray _errorIndexOutOfRange: startOffset].
(anArray ~~ nil _and: [endOffset > anArray _basicSize]) ifTrue:[ anArray _errorIndexOutOfRange: endOffset].

numInserted := endOffset - startOffset + 1 .

newSize := destOffset + numInserted + numToMove .
newSize > 2034 "virtual machine constant OBJ_OOPS_SIZE" ifTrue:[ 
  self _error: #objErrMaxSize args:#[ 2034 "virtual machine constant", newSize ].
  ].

self _primitiveFailed: #_insertAt:from:fromStart:fromEnd:numToMoveDown:
%

category: 'Copying'
method: Array
_largeInsertAt: destOffset 
from: anArray 
fromStart: startOffset
fromEnd: endOffset 
numToMoveDown: numToMove 

"Intended for use in manipulating objects which are nodes of B-trees or
 similar structures. Similar to primitive 605, except that with this
 primitive objects will be grown to large objects if necessary.
 
 Inserts the portion of anArray from startOffset to endOffset
 into the receiver beginning at destOffset.  

 If anArray is nil, then  (endOffset - startOffset + 1) nils are
 inserted into the receiver.

 The indexable instance variables of the receiver from destOffset to 
 (destOffset + numToMove) are moved towards the end of the receiver by 
 the amount (endOffset - startOffset + 1).
 The receiver may be a small or large object.

 If the receiver must be grown, it will be grown by 10 times the number
 of OOPs inserted up to a max of 500 oops.

 Generates an error if destOffset is beyond the end of the receiver."

<primitive: 552 >

anArray ~~ nil ifTrue:[ anArray _validateClass: Array ].

(destOffset < 1 _or:[ destOffset > self _basicSize] )
   ifTrue:[ self _errorIndexOutOfRange: destOffset] .
(startOffset < 1) ifTrue:[ self _errorIndexOutOfRange: startOffset] .
(endOffset < 1)   ifTrue:[ self _errorIndexOutOfRange: endOffset] .
(numToMove < 0)   ifTrue:[ self _errorIndexOutOfRange: numToMove] .
(endOffset < startOffset) ifTrue:[ self _errorIndexOutOfRange: endOffset ].
(anArray ~~ nil _and: [startOffset > anArray _basicSize]) ifTrue:[ anArray _errorIndexOutOfRange: startOffset].
(anArray ~~ nil _and: [endOffset > anArray _basicSize]) ifTrue:[ anArray _errorIndexOutOfRange: endOffset].

self _primitiveFailed: #_largeInsertAt:from:fromStart:fromEnd:numToMoveDown:
%

category: 'Searching'
method: Array
includesIdentical: anObject

"(R) Returns true if anObject is identical to one of the elements of the
 receiver.  Returns false otherwise."

<primitive: 59>
self _primitiveFailed: #includesIdentical:
%

category: 'Searching'
method: Array
_indexOfIdentical: anObject

"Private.  Returns the index of the first element in the receiver that is
 identical to the argument.  If the receiver does not have any elements that are
 identical to the argument, returns zero."

<primitive: 494>
self _primitiveFailed: #_indexOfIdentical:
%

category: 'Searching'
method: Array
includes: anObject

"(R) Returns true if anObject is equal to one of the elements of the receiver.
 Returns false otherwise."

"Note: In GemStone 4.1, this method returned true only if one of the elements of
 the receiver was identical to anObject. For functionality similar to that
 provided by GemStone 4.1, use #includesIdentical:."

1 to: self size do: [ :j | anObject = (self at:j) ifTrue: [ ^true ]].
^false
%

category: 'Searching'
method: Array
includesValue: anObject

"(R) Returns true if anObject is equal to one of the elements of the receiver.
 Returns false otherwise."

^ self includes: anObject
%

category: 'Adding'
method: Array
add: newObject

"(R) Makes newObject one of the receiver's elements and returns newObject.  The
 new element is actually added as the last element of the receiver.  This
 method is equivalent to #addLast:."

"Note: In GemStone 4.1, this method returned the receiver."

<primitive: 203>
self _primitiveFailed: #add: .
self _uncontinuableError
%

category: 'Adding'
method: Array
addAll: aCollection

"(R) Adds all of the elements of aCollection to the receiver and returns
 aCollection."

"Note: In GemStone 4.1, (1) this method returned the receiver and (2) if the 
 argument was a kind of AbstractDictionary, this method added all the 
 Associations of the key/value pairs stored in the argument."

| collectionSize |

(self == aCollection) ifTrue: [ ^ self addAll: (aCollection copy) ].

(aCollection isKindOf: SequenceableCollection) 
  ifTrue: [
    collectionSize := aCollection size.
    (collectionSize ~~ 0) ifTrue:[ 
      self insertAll: aCollection at: (self size + 1) 
      ].
    ^ aCollection.
    ]
  ifFalse: [
    ((aCollection isKindOf: IdentityBag) 
       _and: [ aCollection _isRcIdentityBag not ]) 
      ifTrue:[
        self _addAllFromNsc: aCollection .
        ^ aCollection.
        ]
      ifFalse: [
        aCollection do: [:each | self add: each ].
        ^ aCollection.
        ]
    ]
%

category: 'Adding'
method: Array
addLast: newObject

"Adds newObject as the last element of the receiver and returns newObject."

"Note: In GemStone 4.1, this method returned the receiver."

<primitive: 203>
self _primitiveFailed: #addLast: .
self _uncontinuableError
%

category: 'Adding'
method: Array
_addAllFromNsc: aBag

""

<primitive: 202>
self _primitiveFailed: #_addAllFromNsc: .
self _uncontinuableError
%

! removeFrom:to inherited from SequenceableCollection

category: 'Removing'
method: Array
_deleteNoShrinkFrom: startIndex to: stopIndex

"The elements of the receiver from startIndex to stopIndex are
 deleted from the receiver.  And the tail of the receiver is filled with
 (stopIndex - startIndex + 1) number of nils.
 
 The size of the receiver is not changed.

 Both startIndex and stopIndex must be positive integers not larger
 than the size of the receiver, with startIndex <= stopIndex."

<primitive: 602 >

(stopIndex < startIndex)
ifTrue:
   [ ^ startIndex _error: #rtErrBadCopyFromTo args: #[stopIndex]].
((stopIndex > self size) _or: [(stopIndex < 1)])
   ifTrue: [ ^ self _errorIndexOutOfRange: stopIndex].
(startIndex < 1)
   ifTrue: [ ^ self _errorIndexOutOfRange: startIndex].
^ self _primitiveFailed: #_deleteNoShrinkFrom:to:
%

category: 'Decompiling without Sources'
method: Array
_asSource

""

| result word lineLength LF |
self isInvariant ifFalse:[ self _error: #rtErrObjVariant ] .
result := String new .
LF := Character lf .
result addAll: ' #( ' .
lineLength := result size .
1 to: self size do:[:j |
  word := (self at: j) _asSource .
  result addAll: word .
  result add: $  .
  lineLength := lineLength + word size + 1 .
  lineLength > 80 ifTrue:[
    result add: LF ; add: $  .
    lineLength := 1 .
    ].
  ].
result addAll: ') ' .
^ result .
%

category: 'Repository Conversion'
method: Array
convertToSymbolSet

"Converts the contents of the Array to those required in GemStone 5.0.
 The receiver is expected to be an Array of Symbols or Strings, the
 result is a SymbolSet."

| aSymSet |

aSymSet := SymbolSet new.
self do: [ :anElement | aSymSet add: (anElement asSymbol)].
aSymSet assignToSegment: self segment .
^ aSymSet.
%

category: 'Repository Conversion'
method: Array
convertInstVarNames

"Converts the contents of the Array to those required in GemStone 5.0.
 Replaces each element of the receiver with the result of sending
 convertTo5 to that element. (The receiver in this case will always be
 the instVarNames array). Returns the receiver."

1 to: self size do:
    [ :i || oldSym newSym |
    ((newSym := (oldSym := self at: i) convertTo5) isKindOf: Symbol)
        ifTrue: [self _unsafeAt: i put: newSym]
        ifFalse: 
            [(newSym respondsTo: #asSymbol)
                 ifTrue: [self _unsafeAt: i put: newSym asSymbol]
                 ifFalse: [self convertInstVarNamesError: oldSym badResult: newSym]]]
%
category: 'Repository Conversion'
method: Array
convertInstVarNamesError: oldSym badResult: newSym

    self error: 
        'The old instance variable, (OOP: ', 
            oldSym asOop asString, 
                ', Class: ', 
                    oldSym class name asString, 
                        ') was not converted to a kind of Symbol (OOP: ',
                            newSym asOop asString,
                                ', Class: ',
                                    newSym class name asString,
                                        ')'
%

category: 'Repository Conversion'
method: Array
convertPoolDictionaries

"Converts the contents of the Array to those required in GemStone 5.0.
 Replaces each element of the receiver with the result of sending
 convertPoolDictionary to that element.  (The receiver in this case will 
 always be the pool dictionaries Array).  Returns the receiver."

1 to: self size do: [ :i |
  (self at: i) convertPoolDictionary.
  ].
%

category: 'Repository Conversion'
method: Array
convertConstraints

"Returns an Array with the contents of the receiver."

| newArray selfSize |

selfSize := self size.
newArray := Array new: (selfSize).

1 to: selfSize do: [ :i |
  newArray at: i put: (self at: i)
  ].
newArray assignToSegment: self segment .
self isInvariant ifTrue:[ newArray immediateInvariant ].
^ newArray.
%

category: 'Private'
method: Array
_buildWeakRefSet

"Adds the receiver to the weakRefObjs hiddenSet."

System _add: self to: 35.
^self
%

category: 'Private'
method: Array
_finalize: anObj at: offset

"Finalizes the reference to object anObject by substituting nil."

self at: offset put: nil.
^true
%

category: 'Enumerating'
method: Array
speciesForCollect

"Returns a class, an instance of which should be used as the result
 of collect: or other projections applied to the receiver."

"added to fix bug 12566"

^ Array
%

category: 'Private'
method: Array
_deleteNoShrinkFrom: startIndex to: stopIndex anchorTailSize: tailSize

"Same as _deleteNoShrinkFrom: startIndex to: stopIndex except the last
tailSize objects remain in the tail of the array.  The size of the receiver does not change
and the gap created by the delete operation is filled with nils. 

This method can fail for the following reasons:
-receiver participates in an index.
-receiver is a large object.
-the delete operation requested would delete any part of the tail
 
 The size of the receiver is not changed.

 Both startIndex and stopIndex must be positive integers not larger
 than the size of the receiver, with startIndex <= stopIndex.  "

<primitive: 617 >

(stopIndex < startIndex)
ifTrue:
   [ ^ startIndex _error: #rtErrBadCopyFromTo args: #[stopIndex]].
((stopIndex > self size) _or: [(stopIndex < 1)])
   ifTrue: [ ^ self _errorIndexOutOfRange: stopIndex].
(startIndex < 1)
   ifTrue: [ ^ self _errorIndexOutOfRange: startIndex].
(stopIndex > (self size - tailSize) )
   ifTrue: [ ^ self _errorIndexOutOfRange: tailSize].

^ self _primitiveFailed: #_deleteNoShrinkFrom:to:anchorTailSize:
%

category: 'Private'
classmethod: Array
_encodingForStringDensity

  "Number of characters encoded per SmallInteger by <primitive: 542>."

^ 7
%

category: 'Private'
classmethod: Array
_insertEncodingForString: aString arraySize: aSmallInteger

  "Encode the given string into SmallIntegers and place them in a new 
   instance of Array. Used for user-defined indexing support. 

   Note: if there are null characters in the encoded string they will be 
      effectively ignored during encoding and the decoded string will 
      not match the encoded string."

  <primitive: 542>

  aString  _validateClass: String .
  aSmallInteger _validateClass: SmallInteger .
  ^ self _primitiveFailed: #_insertEncodingForString:arraySize:

%
category: 'Private'
method: Array
compareStartingAt: anIndex to: anArray startingAt: anotherIndex

  "Compare the elements of the receiver starting at <anIndex> to <anArray>
   starting at <anotherIndex>. Note that it is assumed that the objects
   in each slot of the receiver and <anArray> are SmallIntegers encoded 
   from strings produced by <primitive: 542>, however, it is not a 
   requirement, since each element is compared using identity."

  <primitive: 628 >
  ^ self _primitiveFailed: #compareStartingAt:to:startingAt:
%
category: 'Private'
method: Array
at: anIndex compareWithEncodedStringArray: encodedStringArray startingAt: stringOffset opCode: anOpCode

 "Compares, in order starting at anIndex, if the contents of the receiver
  are less than/greater than the contents of anArray, starting at stringOffset.
  The elements of both collections must be SmallIntegers. The SmallIntegers 
  represents strings encoded using <primitive: 542>.

    op code == 0 means less than
    op code == 1 means greater than"

  <primitive: 629 >
  ^ self _primitiveFailed: #at:compareWithEncodedStringArray:startingAt:opCode:
%

category: 'Private'
method: Array
at: anIndex greaterThanEncodedStringArray: encodedStringArray startingAt: arrayOffset
  "Compares, in order starting at anIndex, if the contents of the receiver are greater 
   than the contents of anArray, starting at stringOffset. The elements of both 
   collections must be SmallIntegers. The SmallIntegers represent encoded string for 
   index. The string was encoded using <primitive: 542>."

  ^self at: anIndex
        compareWithEncodedStringArray: encodedStringArray
        startingAt: arrayOffset
	opCode: 1.
%
category: 'Private'
method: Array
at: anIndex lessThanEncodedStringArray: encodedStringArray startingAt: arrayOffset
   "Compares, in order starting at anIndex, if the contents of the receiver
    are less than the contents of anArray, starting at stringOffset.
    The elements of both collections must be SmallIntegers. The SmallIntegers represent 
    encoded string for index. The string was encoded using <primitive: 542>."

  ^self at: anIndex
	compareWithEncodedStringArray: encodedStringArray
	startingAt: arrayOffset
	opCode: 0.
%
category: 'Private'
method: Array 
_decodeKeyAt: keyIdx decoding: numToDecode into: aString
  "Decode <numToDecode> SmallIntegers from the receiver into <aString> as 
   encoded by <primitive: 542>.

   Note: if there are null characters in the encoded string they will be 
      effectively ignored during encoding and the decoded string will 
      not match the encoded string."

  <primitive: 631 >
  aString  _validateClass: String .
  numToDecode _validateClass: SmallInteger .
  keyIdx _validateClass: SmallInteger .
  ^ self _primitiveFailed: #_decodeKeyAt:decoding:into:
%
category: 'Private'
method: Array
at: anIndex compareEqualNoCaseWithEncodedStringArray: encodedStringArray startingAt: stringOffset

 "Compares without regard to case, in order starting at anIndex, if the contents of the receiver
  are equal to the encoded contents of <encodedStringArray>, starting at stringOffset. The elements of both 
  collections must be SmallIntegers. The SmallIntegers represents strings encoded using 
  <primitive: 542>."

  <primitive: 632 >
  ^self _primitiveFailed: #at:compareEqualNoCaseWithEncodedStringArray:startingAt:
%
category: 'Private'
method: Array
at: anIndex caseInsensitiveEquals: encodedStringArray

 "Compares without regard to case, in order starting at anIndex, if the contents of the receiver
  are equal to the encoded contents of <encodedStringArray>. The elements of both 
  collections must be SmallIntegers. The SmallIntegers represents strings encoded using 
  <primitive: 542>."

  ^self at: anIndex compareEqualNoCaseWithEncodedStringArray: encodedStringArray startingAt: 1.
%
category: 'Private'
method: Array
at: anIndex caseSensitiveEquals: encodedStringArray

 "Compares without regard to case, in order starting at anIndex, if the contents of the receiver
  are equal to the encoded contents of <encodedStringArray>. The elements of both 
  collections must be SmallIntegers. The SmallIntegers represents strings encoded using 
  <primitive: 542>."

  ^self compareStartingAt: anIndex to: encodedStringArray startingAt: 1
%
category: 'Obsolete Private'
method: Array
at: anIndex caseInsenstiveEquals: encodedStringArray

  "Mispelled method name, kept for backward compatability"

^self at: anIndex caseInsensitiveEquals: encodedStringArray
%
category: 'Obsolete Private'
method: Array
at: anIndex caseSenstiveEquals: encodedStringArray

  "Mispelled method name, kept for backward compatability"

^self compareStartingAt: anIndex caseSensitiveEquals: encodedStringArray
%
