!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: unorderedcoll.gs,v 1.53 2008-01-09 22:50:20 stever Exp $
! 
! UnorderedColl.gs
!
! Superclass Hierarchy:
!    UnorderedCollection, Collection, Object.
!
!=========================================================================

removeallmethods UnorderedCollection
removeallclassmethods UnorderedCollection

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

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

txt := (GsDocText new) details:
'UnorderedCollection is an abstract class for collections of objects whose
 elements are not logically arranged in any particular order.  The elements are
 also not physically stored in any fixed order.  Any implied ordering at any
 given time is independent of the order in which the elements were added to the
 collection and cannot be relied upon to persist.

 The elements of unordered collections are all of the same kind.  Unless
 restricted further by a subclass, the kind of elements in unordered collections
 is Object.  That is, the class of each element must simply be some kind of
 Object.

 You cannot add nil to any kind of unordered collection.  Attempts to do so have
 no effect.

 UnorderedCollection provides for fast associative access of collection elements
 in searches by means of the use of indexes with selection blocks.
 UnorderedCollection creates each index for an individual instance, where
 specified, and maintains that index thereafter unless it is removed
 explicitly.

 Indexing is done on instance variables, not on values returned by messages.
 When an index path is used as an argument to a method, it is specified by a
 String that consists of instance variable names separated by periods (such as
 the String ''instvar1.instvar2.instvar3'').  The ith name in the String
 corresponds to the ith position in the path.  A path String may include up to
 16 names and is limited to a total of 1024 Characters.

 If aPathString is an empty path (that is, a zero-length String), the method
 operates upon the elements of the receiver itself rather than upon the instance
 variables of those elements.

 For more information about index structures and path expressions, see the
 GemStone Programming Guide.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'For GemStone internal use.' .
doc documentInstVar: #_varyingSize with: txt.

txt := (GsDocText new) details:
'For GemStone internal use.' .
doc documentInstVar: #_numEntries with: txt.

txt := (GsDocText new) details:
'For GemStone internal use.' .
doc documentInstVar: #_indexedPaths with: txt.

txt := (GsDocText new) details:
'For GemStone internal use.' .
doc documentInstVar: #_levels with: txt.

self description: doc.
%

category: 'Private'
classmethod: UnorderedCollection
_isRcIndexLoggingEnabled

""

^ System rcValueCacheAt: #rcIndexLogging otherwise: true.
%

category: 'Private'
classmethod: UnorderedCollection
_enableRcIndexLogging

"System-wide enabling of logging for RC indexes."

System rcValueCache at: #rcIndexLogging put: true
%

category: 'Private'
classmethod: UnorderedCollection
_disableRcIndexLogging

"System-wide disabling of logging for RC indexes
 (only for the life of the transaction)."

System rcValueCache at: #rcIndexLogging put: false
%

category: 'Private'
method: UnorderedCollection
_asCollectionForSorting

"Used by the sorting subsystem."

^ self _asIdentityBag.
%

category: 'Searching'
method: UnorderedCollection
detect: aBlock

"Evaluates aBlock repeatedly, with elements of the receiver as the argument.
 Returns the first element for which aBlock evaluates to true.  If none of the
 receiver's elements evaluates to true, generates an error.  The argument
 aBlock must be a one-argument block.  Uses associative access when the
 argument is a SelectionBlock."

| result |
(aBlock _class == SelectBlock)
    ifTrue:[
        "send value: to the block to create the 4 element
        associative access Array; the argument nil is ignored to
        create the Array, but all SelectBlocks have one argument"
        result := (QueryExecuter on: self)
            _boundQueryDetect: (aBlock queryBlock value: nil).
        result == #_incompletePathTraversal
            ifTrue: [
                ^ self _error: #assocErrNoElementsDetected args: #[aBlock]
            ].
        ^ result
       ].
^ self _detect: aBlock
%
category: 'Searching'
method: UnorderedCollection
_detect: aBlock

| each bag |
bag := self _asIdentityBag.
1 to: bag size do:[:i |
    each := (bag _at: i) .
    (aBlock value: each) ifTrue:[ ^ each ].
].
^ self _error: #assocErrNoElementsDetected args: #[aBlock] .
%


category: 'Searching'
method: UnorderedCollection
detect: aBlock ifNone: exceptionBlock

"Evaluates aBlock repeatedly, with elements of the receiver as the argument.
 Returns the first element for which aBlock has the value true.  If none of the
 receiver's elements has the value true, this evaluates the argument
 exceptionBlock and returns its value.  The argument aBlock must be a
 one-argument block, and exceptionBlock must be a zero-argument block.  Uses
 associative access when the argument is a SelectionBlock."

| each bag result |
(aBlock _class == SelectBlock)
    ifTrue:[
        "send value: to the block to create the 4 element
        associative access Array; the argument nil is ignored to
        create the Array, but all SelectBlocks have one argument"
        result := (QueryExecuter on: self)
            _boundQueryDetect: (aBlock queryBlock value: nil).
        result == #_incompletePathTraversal
            ifTrue: [ ^ exceptionBlock value ].
        ^ result
    ].
bag := self _asIdentityBag.
1 to: bag size do:[:i |
    each := (bag _at: i).
    (aBlock value: each)
        ifTrue:[ ^ each ].
].
^ exceptionBlock value
%

category: 'Searching'
method: UnorderedCollection
reject: aBlock

"Evaluates aBlock with each of the receiver's elements as the argument.
 Stores the values for which aBlock is false into a collection of the same
 class as the receiver, and returns the new collection.  The argument aBlock
 must be a one-argument block.  Uses associative access when the argument is
 SelectionBlock."

| result |
(aBlock _class == SelectBlock)
    ifTrue:[
       "send value: to the block to create the 4 element
        associative access Array; the argument nil is ignored to
        create the Array, but all SelectBlocks have one argument"
        result := (QueryExecuter on: self)
            _boundQueryReject: (aBlock queryBlock value: nil).
        ^ result
    ].
^ self _reject: aBlock
%
category: 'Searching'
method: UnorderedCollection
_reject: aBlock

| each bag result |
bag := self _asIdentityBag.
result:= NscBuilder for: self speciesForSelect new max: bag size.
1 to: bag size do:[:i |
    each := (bag _at: i).
    (aBlock value: each)
        ifFalse:[ result add: each ].
].
^ result completeBag
%


category: 'Searching'
method: UnorderedCollection
select: aBlock

"Evaluates aBlock with each of the receiver's elements as the argument.
 Stores the values for which aBlock is true into a collection of the same
 class as the receiver, and returns the new collection.  The argument aBlock
 must be a one-argument block.  Uses associative access when the argument is a
 SelectionBlock.

 The new collection returned by this method will not retain any indexes of
 the receiver.  If you want to perform indexed selections on the new
 collection, you must build all of the necessary indexes.  The discussion of
 'Transferring Indexes' in the 'Indexed Associative Access' chapter of the
 GemStone Programming Guide describes a technique for doing this."

| result |
(aBlock _class == SelectBlock)
    ifTrue:[
       "send value: to the block to create the 4 element
        associative access Array; the argument nil is ignored to
        create the Array, but all SelectBlocks have one argument"
        result := (QueryExecuter on: self)
            _boundQuerySelect: (aBlock queryBlock value: nil).
        ^ result
    ].
^ self _select: aBlock
%
category: 'Searching'
method: UnorderedCollection
_select: aBlock

| each bag result |
bag := self _asIdentityBag.
result:= NscBuilder for: self speciesForSelect new max: bag size.
1 to: bag size do:[:i |
    each := (bag _at: i) .
    (aBlock value: each) ifTrue:[ result add: each ].
].
^result completeBag
%

category: 'Indexing Support'
method: UnorderedCollection
_hasIndexes

"Returns whether the receiver has any indexes on it."

| result iList |
iList := self _indexedPaths.
result := false.
iList == nil
  ifFalse: [
    2 to: iList size by: 2 do: [ :i |
      (iList at: i) > 0 ifTrue: [ result := true ]
    ]
  ].
^ result
%

category: 'Indexing Support'
method: UnorderedCollection
_hasIncompleteIndexes

"Returns whether the receiver has any incomplete indexes on it.
 If the receiver has incomplete indexes use IndexManager>>removeAllIncompleteIndexesOn:
 to remove the incomplete indexes."

 | iList |
iList := self _indexedPaths.
iList == nil ifTrue: [ ^ false ].
1 to: iList size by: 2 do: [ :i |
  " if it is an incomplete root index ... "
  (((iList at: i + 1) == 1) _and: [ (iList at: i) isComplete not])
      ifTrue: [ ^ true ]
].

^ false
%

category: 'Modification Tracking'
method: UnorderedCollection
_hasTrackingObjects

"Returns true if the receiver is being tracked."

| iList |
iList := self _indexedPaths.
iList == nil
  ifFalse: [
    ^ iList hasTrackingObjects
  ].
^ false
%
category: 'Searching'
method: UnorderedCollection
_idxOccurrencesOf: aValue

"Returns the number of occurrences of the given value in the receiver."

^ self occurrencesOf: aValue
%

category: 'Private'
method: UnorderedCollection
_asIdentityBag

"Returns the receiver."

^ self
%

category: 'Adding'
method: UnorderedCollection
add: anObject withOccurrences: anInteger

"Includes anObject as an element of the receiver anInteger number of times.
 Generates an error if anObject is not a kind of the Bag's element kind."

self subclassResponsibility: #add:withOccurrences:
%

category: 'Searching'
method: UnorderedCollection
includes: anObject

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

self subclassResponsibility: #includes:
%

category: 'Searching'
method: UnorderedCollection
includesIdentical: anObject

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

self subclassResponsibility: #includesIdentical:
%

category: 'Searching'
method: UnorderedCollection
includesValue: anObject

"Returns true if the receiver contains an object of the same value as the
 argument, anObject.  Returns false otherwise.  (Compare with includes:,
 which is based on identity.)"

self subclassResponsibility: #includesValue:
%

category: 'Searching'
method: UnorderedCollection
occurrencesOf: anObject

"Returns the number of the receiver's elements that are identical (==) to
 anObject."

self subclassResponsibility: #occurrencesOf:
%

category: 'Removing'
method: UnorderedCollection
removeIfPresent: anObject

"Removes anObject from the receiver and returns anObject.  If anObject is
 present several times in the receiver, only one occurrence is removed.
 Returns nil if anObject is missing from the receiver."

self remove: anObject ifAbsent: [ ^ nil ].
^ anObject.
%

category: 'Removing'
method: UnorderedCollection
removeAllPresent: aCollection

"Removes from the receiver one occurrence of each element of aCollection that is
 also an element of the receiver.  Differs from removeAll: in that, if some
 elements of aCollection are not present in the receiver, no error is generated.
 Returns aCollection."

aCollection do: [ :anElement |
  self removeIfPresent: anElement
  ].

^ aCollection
%

category: 'Clustering'
method: UnorderedCollection
clusterDepthFirst

"Clusters the receiver and its named and unnamed instance variables in
 depth-first order. Returns true if the receiver has already been clustered
 during the current transaction; returns false otherwise."

self clusterIndexes.
^ super clusterDepthFirst
%

category: 'Accessing the Class Format'
classmethod: UnorderedCollection
firstPublicInstVar

"Returns the index of the first user-visible instance variable defined in this
 class, regardless of whether or not this class actually has user-visible
 instance variables."

^ 5
%

category: 'Indexing Support'
method: UnorderedCollection
_indexedPaths

"Private.  For use only by the indexing subsystem.

 Returns the indexed paths for the receiver."

^ _indexedPaths
%

category: 'Indexing Support'
method: UnorderedCollection
_clearIndexList

"Private.  Sets the indexed paths for the receiver to nil."

self _indexedPaths: nil
%

category: 'Storing and Loading'
classmethod: UnorderedCollection
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into a new instance of the receiver.
 Returns the new instance."

| size inst |
size := passiveObj readSize.
inst := self new.
inst loadFrom: passiveObj size: size.
^inst
%

category: 'Storing and Loading'
method: UnorderedCollection
basicLoadFrom: passiveObj size: varyingSize

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into the receiver."

"This method is similar to basicLoadFrom:, but is used for objects whose size
 is not known when they are first instantiated (such as an IdentitySet)."

passiveObj hasRead: self.
^ self basicLoadFromNoRead: passiveObj size: varyingSize .
%

category: 'Storing and Loading'
method: UnorderedCollection
basicLoadFromNoRead: passiveObj size: varyingSize

"Private."

varyingSize == 0 ifTrue: [
  "Old NSC format had no named instance variable section.  A zero-length NSC in
   the old format might read instance variables from an enclosing object if
   there were not a special delimiter that could be reliably found."
  passiveObj checkForBagMark ifFalse: [
    passiveObj checkForInstVarMark ifFalse: [
      ^self
    ].
  ].
].
(passiveObj readNamedIV) ifFalse: [
  "old NSC format with no named instance variables"
  ^self loadVaryingFrom: passiveObj size: varyingSize
].
self loadNamedIVsFrom: passiveObj.
self loadVaryingFrom: passiveObj size: varyingSize.
%

category: 'Storing and Loading'
method: UnorderedCollection
basicWriteTo: passiveObj

"Converts the receiver to its passive form and writes that information on
 passiveObj."

| s cls ivs c |
  "store my structure on the given passiveObj"
  cls := self class.
  passiveObj writeClass: cls.

  ivs := cls _instVarNames.

  passiveObj writeSize: (s := self size) .

  cls firstPublicInstVar to: cls instSize do: [:i |
    (self shouldWriteInstVar: (ivs at: i)) ifTrue: [
      passiveObj writeObject: (self instVarAt: i) named: (ivs at: i)
    ].
  ].

  passiveObj writeBagMark.
  passiveObj endNamedInstVars.

  c := 0.
  self do: [ :x |
    passiveObj writeObject: x.
    c := c + 1.
    c > 99 ifTrue: [
      passiveObj lf.
      c := 0.
    ].
  ].
  passiveObj cr
%

category: 'Storing and Loading'
method: UnorderedCollection
loadFrom: passiveObj size: varyingSize

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into the receiver."

"This method is similar to loadFrom:, but is used for objects whose size
 is not known when they are first instantiated (such as an IdentitySet)."

^self basicLoadFrom: passiveObj size: varyingSize
%

category: 'Storing and Loading'
method: UnorderedCollection
loadNamedIVsFrom: passiveObj

"Reads named instance variables from the given passive object.  The first
 instance variable should already have been parsed and be available in the
 passiveObj argument."

| name offset nameSym |

[ name := passiveObj ivName.
  name ~~ nil ifTrue: [
    nameSym := Symbol _existingWithAll: name .
    nameSym ~~ nil ifTrue:[
      offset := self class _ivOffsetOf: nameSym.
      offset ~~ nil ifTrue:[ self instVarAt: offset put: passiveObj ivValue ]
             ifFalse:[ self obsoleteInstVar: nameSym value: passiveObj ivValue].
    ]
    ifFalse:[
      self obsoleteInstVar: name value: passiveObj ivValue
    ].
    passiveObj readNamedIV
  ]
  ifFalse: [
    false
  ]
] untilFalse.

passiveObj checkForBagMark.
passiveObj skipNamedInstVars.
%

category: 'Storing and Loading'
method: UnorderedCollection
loadVaryingFrom: passiveObj size: varyingSize

"Reads the varying part of the receiver from the given passive object.
 Does not record the receiver as having been read.  Does not read the
 receiver's named instance variables, if any."

1 to: varyingSize do: [:i |
  self add: (passiveObj readObject)
].
%

category: 'Error Handling'
method: UnorderedCollection
_raiseIndexingError: errArray

"Raises an error that was due to updating indexes.  Information
 about the error is contained in the given error Array."

| errNum indexesModified |

indexesModified := errArray at: 1.
errNum := errArray at: 2.
errArray removeFrom: 1 to: 2.
indexesModified
  ifTrue: [
    ^ System
        signal: (ErrorSymbols at: #rtErrPreventingCommit)
        args: errArray
        signalDictionary: GemStoneError
  ]
  ifFalse: [
    ^ System
        signal: errNum
        args: errArray
        signalDictionary: GemStoneError
  ]
%

category: 'Repository Conversion'
method: UnorderedCollection
getIndexInfo

"Returns indexing information for the receiver."

| iList indexObj path kind lastConstraint result |
  result := Array new.
  iList := self _indexedPaths.
  1 to: iList size by: 2 do: [ :i |
  indexObj := iList at: i.
  (iList at: i + 1) == 1
    ifTrue: [
      " path is first arg "
      path := indexObj pathComponentsString41.

      " kind is true if identity index, false if equality index "
      kind := indexObj isIdentityIndex.

      " for equality indexes, lastConstraint is second argument "
      kind
        ifFalse: [ 
	  lastConstraint := indexObj lastElementClass41.  
	  (lastConstraint == SmallInteger)
	    ifTrue: [ lastConstraint := Integer ].
	  ].

      result add: (Array with: self with: path with: kind with: lastConstraint).
      ].
    ].
  ^ result.
%

category: 'Repository Conversion'
method: UnorderedCollection
rebuildIndexes: indexInfo

"Rebuilds the indexes."

" Interim conversion: need method declaration, but commented out..
 
| path kind lastConstraint newLastConstraint |

  path := indexInfo at: 2.
  kind := indexInfo at: 3.
  lastConstraint := indexInfo at: 4.

  kind
    ifTrue: [
      self createIdentityIndexOn: path
      ]
    ifFalse: [
      newLastConstraint := lastConstraint _correspondingNewClass.
      self createEqualityIndexOn: path withLastElementClass: newLastConstraint
      ].
"
%
category: 'Repository Conversion'
method: UnorderedCollection
convRemoveIndexes

"Private. Removes the indexes for the receiver. This method is to be used
 only during Repository Conversion."

self _clearIndexList.
%

category: 'Private'
method: UnorderedCollection
_finishShallowCopy

"Private."

_indexedPaths := nil
%

category: 'Copying'
method: UnorderedCollection
copy

"Returns a copy of the receiver that shares the receiver's public instance
 variables but has no indexes."

| result |
result := super copy .
result _finishShallowCopy .
^ result
%

category: 'Accessing'
method: UnorderedCollection
instVarAt: aSmallInteger

"If the receiver has a publicly accessible named instance variable at
 index aSmallInteger, this returns its value.  Generates an error if
 aSmallInteger is not a SmallInteger or is out of bounds, or if the
 receiver has no publicly accessible named instance variables."

(UnorderedCollection instSize >= aSmallInteger _and:
[ 1 <= aSmallInteger ])
  ifTrue:[ ^ nil ].

^ super instVarAt: aSmallInteger
%

category: 'Updating'
method: UnorderedCollection
instVarAt: anIndex put: aValue

"Stores the argument aValue in the instance variable indicated by anIndex and
 returns aValue. Generates an error if (1) anIndex is not a SmallInteger,
 (2) anIndex is out of bounds or (3) if the receiver has no publicly accessible
 named instance variables."

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

(UnorderedCollection instSize < anIndex) ifTrue:[
  ^ super instVarAt: anIndex put: aValue
].
^ self _errorIndexOutOfRange: anIndex
%

category: 'Testing'
method: UnorderedCollection
_isIdentityBag

"Return whether the receiver is an identity-based collection."

^ false
%

category: 'Instance Migration'
method: UnorderedCollection
migrateFrom: anotherObject instVarMap: otherivi

"(R) Takes information from the given object and puts it in the receiver.  This
 message is sent to an object when its class is being migrated to another class
 to account for changes in a schema.  The otherivi argument is a precalculated
 indirection table associating the receiver's instance variables with instance
 variables in the other object.  If a table entry is 0, the other object is
 assumed not to have that instance variable.

 This method should be augmented to perform other necessary initializations in
 the receiver."

| otherClass varyingConstraint |

super migrateFrom: anotherObject instVarMap: otherivi.

"if no elements in anotherObject, no need to check varying constraint "
anotherObject size == 0
  ifTrue: [ ^ self ].

otherClass := anotherObject class.
varyingConstraint := self class varyingConstraint.

otherClass isNonByteVarying
  ifTrue: [
    (otherClass varyingConstraint isSubclassOf: varyingConstraint)
      ifTrue: [ " no need to perform constraint checking "
        anotherObject do: [ :anElement | self add: anElement ].
        ]
      ifFalse: [ "otherwise check varying constraint"
        anotherObject do: [ :anElement | | newElement |
          " see if self can contain anElement "
          (anElement isKindOf: varyingConstraint)
            ifTrue: [ self add: anElement ]
            ifFalse: [
              "if not, see if anElement can be converted (or an error raised)"
              newElement :=
                anotherObject invalidElementConstraintWhenMigratingInto: self
                  for: anElement.
              "if anElement was converted, add it to the receiver"
              newElement ~~ anElement ifTrue: [ self add: newElement ].
              ]
          ]
        ]
    ].

^ self.
%

category: 'Repository Conversion'
method: UnorderedCollection
getIndexInfoVersion: versionNum

"Returns indexing information for the receiver."

| iList indexObj path kind lastConstraint result |
  result := Array new.
  iList := self _indexedPaths.
  1 to: iList size by: 2 do: [ :i |
  indexObj := iList at: i.
  (iList at: i + 1) == 1
    ifTrue: [
      " path is first arg "
      path := indexObj pathComponentsStringVersion: versionNum.

      " kind is true if identity index, false if equality index "
      kind := indexObj isIdentityIndex.

      " for equality indexes, lastConstraint is second argument "
      kind
        ifFalse: [
          lastConstraint := indexObj lastElementClassVersion: versionNum.
          (lastConstraint == SmallInteger)
            ifTrue: [ lastConstraint := Integer ].
          ].

      result add: (Array with: self with: path with: kind with: lastConstraint).
      ].
    ].
  ^ result.
%

category: 'Auditing'
method: UnorderedCollection
invalidReferenceAudit
"For an explanation of this method, refer to the comments in the method
 UnorderedCollection>>invalidReferenceAuditWithRepair:"
	^self invalidReferenceAuditWithRepair: false
%

category: 'Auditing'
method: UnorderedCollection
invalidReferenceAuditWithRepair: aBool

"Audit and optionally repair UnorderedCollections which incorrectly reference objects
 previously removed from the collection.  In releases prior to 6.0.1, GemStone bug
 #27404 would, in rare cases, cause objects removed from a large UnorderedCollection
 to be referenced even though the removal operation was successful and the
 object no longer appeared in the collection.

 If aBool is false, an audit is performed and the collection is not modified.
 If aBool is true, any invalid references in the collection are also repaired.

 Returns the number of unique objects which are incorrectly referenced by the
 receiver."
<primitive: 570>
  self _primitiveFailed: #invalidReferenceAuditWithRepair:.
%

category: 'Auditing'
method: UnorderedCollection
repairInternalStructures
"For an explanation of this method, refer to the comments in the method
 UnorderedCollection>>auditInternalStructuresWithRepair:"

^self auditInternalStructuresWithRepair: true
%

category: 'Auditing'
method: UnorderedCollection
auditInternalStructuresWithRepair: aBoolean
"Audit and optionally repair the internal structures of the receiver.
 If aBoolean is true, errors will be fixed as they are detected, but
 the transaction is not automatically committed and a commit after this
 method returns is required.  If aBoolean is false, the audit is 
 read-only operation and no objects are modified.  Invalid reference 
 errors found and repaired by the invalidReferenceAuditWithRepair:
 method are also detected and repaired by this method.

 Answers a Boolean indicating if the collection is free of errors. 
 true means the collection passed the audit, false means the audit
 detected one or more errors.

 This primitive prints many messages to stdout and is intended to
 be run from a linked topaz session."

<primitive: 574>
^self _primitiveFailed: #auditInternalStructuresWithRepair:
%

category: 'Auditing'
method: UnorderedCollection
auditInternalStructures
"See the method auditInternalStructuresWithRepair: aBoolean for
 more information on this method."

^self auditInternalStructuresWithRepair: false
%

category: 'Accessing Indexes'
method: UnorderedCollection
identityIndexedPaths

"Returns an Array of Strings, each of which represents a path for which an
 identity index exists in the receiver.  Each path originates with the elements
 of the receiver."

| anArray |
anArray := Array new.
self _indexedPaths == nil
  ifTrue: [
    ^ anArray
  ].

self _indexedPaths indexObjectsAndOffsetsDo:[ :indexObj :offset | | pathString|
  indexObj isIdentityIndex
    ifTrue: [
      pathString := indexObj pathComponentsStringStartingAt: offset.
      (anArray includesValue: pathString)
        ifFalse: [ anArray addLast: pathString ]
    ]
    ifFalse: [
      (self _isRangeable: indexObj lastElementClass)
        ifTrue: [
          pathString := indexObj pathComponentsStringStartingAt: offset.
          indexObj isComplete
            ifFalse: [ pathString add: ' (incomplete)' ].
          (anArray includesValue: pathString)
            ifFalse: [ anArray addLast: pathString ]
        ]
    ]
].
^ anArray
%

category: 'ObsoleteIDX - Updating Indexes'
method: UnorderedCollection
createIdentityIndexOn: aPathString commitInterval: anInteger

"Creates an identity index on aPathString.  Generates an error if aPathString
 is not a path for the element kind of the receiver or if any term of the path
 except the last term is not constrained."

"If an error occurs during index creation, it may not be possible to commit the
 current transaction later."

"transactional behavior is now controlled by the class IndexManager"
self halt: 'no longer supported'.

^ self createIdentityIndexOn: aPathString
%
category: 'Indexing Support'
method: UnorderedCollection
_checkIndexPathExpression: aPathString

"Raises an error if the given path expression (an Array of Strings), is
 not valid; otherwise returns the receiver."

^self _getLastElementConstraintOnPath: aPathString 
   onError: 
     [:parentClass:pathName |
      (parentClass == Object) ifTrue: [ ^ self ].
      ^ self _error: #rtErrPathNotTraversable
               args: #[ parentClass, pathName ]
     ]
%
category: 'Updating Indexes'
method: UnorderedCollection
removeIncompleteIndex

"If there is an incomplete index, clean it up. In general this method should not be used, a better way to remove
 incomplete indexes is to use IndexManager>>removeAllIncompleteIndexesOn:"

| indexObj |

[ | systm |
  systm := System .
  systm abortTransaction.
  indexObj := self _findIncompleteIndex.
  indexObj == nil
    ifTrue: [ ^ self ].
  self _undoIndexCreation: indexObj pathTerm: indexObj _findFirstUnsharedPathTerm.
  systm commitTransaction.
] untilTrue.
%

category: 'Updating Indexes - Private'
method: UnorderedCollection
_findIncompleteIndex

"Returns an index that is incomplete, or nil if not found."

| iList |
iList := self _indexedPaths.
iList == nil
  ifTrue: [ ^ nil ].

" for each index on the NSC ... "
1 to: iList size by: 2 do: [ :i |
  " only look at the index if the receiver is the root "
  (iList at: i + 1) == 1
    ifTrue: [
      " see if the index is complete "
      (iList at: i) isComplete
        ifFalse: [ ^ iList at: i ]
    ]
].
^ nil
%

category: 'Indexing Support'
method: UnorderedCollection
getLastElementConstraintOnPath: aPathString

"Returns the class that is the last constraint class along the given path
 string.  If any of the classes that are traversed is not constrained on the
 given instance variable name, nil is returned."

^self _getLastElementConstraintOnPath: aPathString onError: [:parentClass:pathName | ^nil]
%

category: 'Indexing Support'
method: UnorderedCollection
_getLastElementConstraintOnPath: aPathString onError: errorBlock

"Returns the class that is the last constraint class along the given path
 string.  If any of the classes that are traversed is not constrained on the
 given instance variable name, evaluate errorBlock with last valid class and 
 pathName."

| parentClass tmpClass pathArray |
pathArray := aPathString asArrayOfPathTerms.

" if path is empty string, then just use the constraint on unnamed variables "
(pathArray size == 1 _and: [ (pathArray at: 1) == #'' ] )
  ifTrue: [ ^ self class elementConstraint ].

tmpClass := self class elementConstraint.
pathArray do: [ :pathName |
  
  parentClass := tmpClass.
  tmpClass := (tmpClass _constraintOn: pathName).
  tmpClass == nil
    ifTrue: [ ^ errorBlock value: parentClass value: pathName ]
].
^ tmpClass
%

category: 'Indexing Support'
method: UnorderedCollection
_isRangeable: aClass

"Returns whether the given class should have an equality index created when an
 identity index is requested."

^ aClass _isSpecial _and: [ (aClass isSubclassOf: AbstractCharacter) not ]
%

category: 'Updating Indexes - Private'
method: UnorderedCollection
_calculateIndexDictionarySize: indexPathLength

"Heuristic for determining size of index dictionary root."

| sz  |
"One entry in dictionary for each element/pathTerm key and a bucket load factor of 2/3."
sz := (self size * indexPathLength) // 
       ((RcIndexDictionary defaultBasicSize * 2) // 
        (RcIndexBucket entrySize * 3)).
sz := sz max: RcIndexDictionary defaultBasicSize.
self _setIndexDictionaryCreationSize: (Integer _selectedPrimeGreaterThan: sz).
%

category: 'Indexing Support'
method: UnorderedCollection
_getIndexDictionary

"Returns the index dictionary that is shared by all indexes.  If there are no
 indexes, create an index dictionary."

| iList iDict |
iList := self _indexedPaths.
iList == nil
  ifTrue: [
    iDict := RcIndexDictionary new: self _getIndexDictionaryCreationSize.
  ]
  ifFalse: [
    1 to: iList size by: 2 do: [ :i |
      " only use the index dictionary if the receiver is the root
        NSC of the index "
      ( (iList at: i + 1) == 1 _and:
      [ (iList at: i) indexDictionary ~~ nil ] )
        ifTrue: [ ^ (iList at: i) indexDictionary ]
    ].
    iDict := RcIndexDictionary new: self _getIndexDictionaryCreationSize.
  ].
					"deleted moveToDisk"
iDict changeToSegment: GsIndexingSegment.

^ iDict
%

category: 'Indexing Support'
method: UnorderedCollection
_getIndexDictionaryCreationSize

"Returns the basic size of an index dictionary when a new one is
 being created."

^ System
  rcValueCacheAt: #indexDictionarySize
  for: self
  otherwise: RcIndexDictionary defaultBasicSize.
%

! fix statement with no effect with fix 34213
category: 'Indexing Support'
method: UnorderedCollection
_setIndexDictionaryCreationSize: aNumber

"Sets the basic size of an index dictionary when a new one is being created.
 This will only be in effect for the life of the transaction.
 Returns self.  "

aNumber _validateClass: Number.
System
  rcValueCacheAt: #indexDictionarySize
  put: aNumber
  for: self.

%

category: 'Indexing Support'
method: UnorderedCollection
_indexedPaths: anIndexList

"Private.  For use only by the indexing subsystem.

 Sets the indexed paths for the receiver."

<primitive: 361>
self _primitiveFailed: #_indexedPaths: .
self _uncontinuableError
%

category: 'Adding'
method: UnorderedCollection
_updateIndexesForAdditionOf: anObject logging: aBoolean

"anObject is being added to the receiver.  Update any indexes if necessary.
 Returns true if the index objects were modified correctly; otherwise returns
 an Array containing error information."

<primitive: 901>
| mapInfo rootTerms pathTerm doLogging iList i sz num val prevTerm hasIndex |

iList := self _indexedPaths.
" first handle modification tracking "
hasIndex := false.
1 to: iList size by: 2 do: [ :j |
  (iList at: j + 1) > 0
    ifTrue: [ hasIndex := true ]
    ifFalse: [
      (iList at: j + 1) == 0
        ifTrue: [ (iList at: j) adding: anObject to: self ]
    ]
].

hasIndex
  ifFalse: [
    System _disableProtectedMode.
    ^ true
  ].

[
	System _bypassReadAuth: true.
	" if the indexes are not committed, do not need to log "
	doLogging := iList isCommitted _and: [ UnorderedCollection _isRcIndexLoggingEnabled ].

	rootTerms := iList rootTerms.
	sz := rootTerms size.

	Exception
	  category: nil
	  number: nil
	  do: [ :ex :cat :num :args | | txt |
	    " get the text for the raised error "
	    txt := cat textForError: num args: args.
	    " returns Array containing err info "
	    ^ #[ true " indicating indexing objects may have been modified ",
	      num,
	      txt ]
	].

	" now make a pass through the root path terms "
	i := 1.
	[ i <= sz _and: [ i <= rootTerms size ] ] whileTrue: [
	  pathTerm := rootTerms at: i.

	  pathTerm _isObsoletePathTerm
	    ifFalse: [

	      " see if the receiver is participating as a set-valued instance variable "
	      pathTerm offset == 1
	        ifTrue: [ num := 1 ]
	        ifFalse: [
	"XXX likely to be set-valued related code"
	          " get the path term before the set-valued path term "
	          prevTerm := pathTerm getParentTerm.
	          pathTerm indicatesIndexOnNscElements
	            ifFalse: [ prevTerm := prevTerm getParentTerm ].

	          val := pathTerm getIndexDictionary
	            at: self
	            term: prevTerm
	            otherwise: nil.
	          " if not found, then mappings have already been added "
	          nil == val
	            ifTrue: [ num := 0 ]
	            ifFalse: [
	              (BucketValueBag _hasInstance: val)
	                ifTrue: [ num := val size ]
	                ifFalse: [ num := 1 ]
	            ]
	        ].

	        " if the index is on elements of the NSC, go ahead and update the indexes "
	        pathTerm indicatesIndexOnNscElements
	          ifTrue: [
	            pathTerm updateBtree ~~ nil
	              ifTrue: [
	                (pathTerm _checkBtreeComparisonWith: anObject)
	                  ifFalse: [
	                    i > 1
	                      ifTrue: [
	                        " indexing objects have been modified, prevent commits "
	                        anObject _error: #rtErrRangeEqualityIndexInvalidClassKindForBtree
	                          args: #[ pathTerm updateBtree lastElementClass ]
	                      ]
	                      ifFalse: [
	                        ^ #[ false,  " indicating no indexing objects were modified "
	                          (ErrorSymbols at: #rtErrRangeEqualityIndexInvalidClassKindForBtree),
	                          anObject,
	                          pathTerm updateBtree lastElementClass ]
	                      ]
	                  ]
	              ].

	            num timesRepeat: [
	              pathTerm addDirectMappingFor: anObject logging: doLogging
            ]
	          ]
	          ifFalse: [
	                " get all the mapping info first (this detects any errors
	                  along the path before any changes are made to the indexes) "
	                mapInfo := pathTerm
	                  getMappingInfoFor: anObject
	                  ifObject: nil
	                  atOffset: 0
	                  replaceWith: nil.

	                " if the result is not a map info object, it is an Array
	                  used for error information "
	                (mapInfo _class == MappingInfo)
	                  ifFalse: [
	                    i > 1
	                      ifTrue: [ | errArgs |
	                        " indexing objects have been modified, prevent commits "
	                        errArgs := Array new.
	                        3 to: mapInfo size do: [ :j | errArgs add: (mapInfo at: j) ].
	                        System signal: (mapInfo at: 2) args: errArgs signalDictionary: GemStoneError.
	                      ].
	                    ^ mapInfo
	                  ].

	                " now update dependency lists, index dictionary, B-trees "
	                num timesRepeat: [
	                  mapInfo pathTerm addMappingsUsing: mapInfo logging: doLogging
	                ]
	            ]
	    ].
	  i := i + 1
	].
] ensure: [ 
	System _bypassReadAuth: false.
	System _disableProtectedMode.
].

^ true
%

category: 'Removing'
method: UnorderedCollection
_updateIndexesForRemovalOf: anObject

"anObject is being removed from the receiver.  Update the indexes if
 necessary.  This method is invoked prior to removal of anObject
 from the receiver. "

<primitive: 901>
| depList pathTerm rootTerms lastOne iList aSet sz i indexObj offset
currSize origSize prevTerm val num doLogging hasIndex |

" if it is not an RcIdentityBag, anObject may not be in the receiver "
( self class isNsc _and: [ (self includes: anObject) not ] )
  ifTrue: [
    System _disableProtectedMode.
    ^ self
  ].

iList := self _indexedPaths.
" first handle modification tracking "
hasIndex := false.
1 to: iList size by: 2 do: [ :j |
  (iList at: j + 1) > 0
    ifTrue: [ hasIndex := true ]
    ifFalse: [
      (iList at: j + 1) == 0
        ifTrue: [ (iList at: j) removing: anObject from: self ]
    ]
].

hasIndex
  ifFalse: [
    System _disableProtectedMode.
    ^ self
  ].

[
	System _bypassReadAuth: true.
	Exception
	  category: nil
	  number: nil
	  do: [ :ex :cat :num :args | | txt |
	  " get the text for the raised error "
	  txt := cat textForError: num args: args.
	  " check for recursive signal "
	  num == (ErrorSymbols at: #rtErrPreventingCommit)
	    ifTrue: [ " remove this exception and resignal "
	      ex resignal: cat number: num args: args
	    ]
	    ifFalse: [ " append additional message to the end of text "
	      txt _error: #rtErrPreventingCommit
	    ]
	  ].

	" get the removed object's dependency list "
	depList := DependencyList for: anObject.

	" see if another occurrence of anObject is in the index objects "
	lastOne := self _isLastOccurrenceInIndexObjects: anObject.

	doLogging := UnorderedCollection _isRcIndexLoggingEnabled.
	origSize := iList size.

	rootTerms := iList rootTerms.
	sz := rootTerms size.
	i := 1.
	" for each unique path on which there is an index "
	[ i <= sz _and: [ i <= rootTerms size ] ] whileTrue: [
	  pathTerm := rootTerms at: i.
	  " see if the path term is still a root term and is not obsolete "
	  ((iList rootTerms includesIdentical: pathTerm) _and:
	  [ pathTerm _isObsoletePathTerm not ])
	    ifTrue: [
	      " see if the receiver is participating as a set-valued instance variable "
	"XXX set-valued"
	      pathTerm offset == 1
	        ifTrue: [ num := 1 ]
	        ifFalse: [
	          " get the path term before the set-valued path term "
	          prevTerm := pathTerm getParentTerm.
	          pathTerm indicatesIndexOnNscElements
	            ifFalse: [ prevTerm := prevTerm getParentTerm ].

	          val := pathTerm getIndexDictionary
	            at: self
	            term: prevTerm
	            otherwise: nil.
	          " if not found, then mappings have already been removed "
	          nil == val
	            ifTrue: [ num := 0 ]
	            ifFalse: [
	              (BucketValueBag _hasInstance: val)
	                ifTrue: [ num := val size ]
	                ifFalse: [ num := 1 ]
	            ]
	        ].

	      " see if this index is on the elements of the NSC "
	      pathTerm indicatesIndexOnNscElements
	        ifTrue: [
	          num timesRepeat: [
	            pathTerm removeDirectMappingFor: anObject logging: doLogging.
	          ].

	          ( depList ~~ nil _and: [ pathTerm needsDepList ] )
	            ifTrue: [ DependencyList removePathTerm: pathTerm for: anObject ]
	        ]
	        ifFalse: [
	          nil == anObject
	            ifFalse: [ 
	              num - 1 timesRepeat: [
	                pathTerm removeMappingsFor: anObject
	                  lastOne: false
	                  logging: doLogging
	              ].
	              pathTerm removeMappingsFor: anObject
	                lastOne: lastOne
	                logging: doLogging
	            ].
	          ( depList ~~ nil _and: [ lastOne ] )
	            ifTrue: [ DependencyList removePathTerm: pathTerm for: anObject ]
	        ].
	    ].
	  i := i + 1
	].

	currSize := iList size.
	i := 1.
	[ i <= origSize _and: [ i <= currSize ] ] whileTrue: [
	  indexObj := iList at: i.
	  offset := iList at: i + 1.
	  " see if receiver participates as a set-valued instance variable "
	"XXX set-valued"
	  (offset > 1 _and: [ indexObj isComplete ])
	    ifTrue: [
	      " lazy initialization of aSet (in case we don't ever need it) "
	      aSet == nil
	        ifTrue: [ aSet := IdentitySet new ].
	      " get the previous path term (the one with an asterisk) "
	      pathTerm := indexObj at: offset - 1.
	      " only update the dictionary if we haven't already done it "
	      (aSet includesIdentical: pathTerm)
	        ifFalse: [
	          aSet add: pathTerm.
	          " see how many entries exist "
	          val := indexObj indexDictionary
	            at: self
	            term: pathTerm getParentTerm
	            otherwise: nil.

	          " if not found, then mappings have already been removed "
	          nil == val
	            ifTrue: [ num := 0 ]
	            ifFalse: [
	              (BucketValueBag _hasInstance: val)
	                ifTrue: [ num := val size ]
	                ifFalse: [ num := 1 ]
	            ].

	          num timesRepeat: [
	            " remove dictionary entry for anObject -> NSC "
	            indexObj indexDictionary
	              removeKey: anObject
	              value: self
	              term: pathTerm
	              logging: doLogging
	          ]
	        ]
	    ].
	  i := i + 2
	].
] ensure: [ 
	System _bypassReadAuth: false.
	System _disableProtectedMode.
].
%

category: 'Updating Indexes - Private'
method: UnorderedCollection
_lockForIndexCreation

"Locks the receiver to prevent concurrent users from invalidating index
 creation."

| lockList |
lockList := Array with: self.
self _indexDictionary ~~ nil
  ifTrue: [
    self _indexDictionary _doCollisionBuckets: [ :cb | lockList add: cb ]
  ].
System writeLockAll: lockList ;
   addAllToCommitOrAbortReleaseLocksSet: lockList.
%

category: 'Indexing Support'
method: UnorderedCollection
_findIndexesWithPath: pathArray

"Returns an Array of index objects whose path components are the same as
 represented by the path string.  This method only considers those indexes that
 are defined with the receiver as the root NSC."

| anArray iList |
iList := self _indexedPaths.
iList == nil
  ifTrue: [ ^ Array new ].

anArray := Array new.
" for each index on the NSC ... "
1 to: iList size by: 2 do: [ :i |
  " only look at the index if the receiver is the root "
  (iList at: i + 1) == 1
    ifTrue: [
      " if the index is on the same path, add it to the Array "
      ((iList at: i) hasIndexOnPath: pathArray)
        ifTrue: [ anArray addLast: (iList at: i) ]
    ]
].
^ anArray
%

category: 'Indexing Support'
method: UnorderedCollection
_getConstraintsOnPath: pathArray

"Returns an Array of Classes consisting of the constraint on unnamed instance
 variables of the receiver, followed by the constraints for each instance
 variable in pathArray (an Array of Strings).  If any of the Classes that are
 traversed is not constrained on the given instance variable name, the
 remaining constraints in the Array are nil."

| tmpClass constraintArray pathName sz |
sz := pathArray size.
constraintArray := Array new: sz.

" if path is empty string, then just use the constraint on unnamed variables "
(sz == 1 _and: [ (pathArray at: 1) == #'' ] )
  ifTrue: [
    constraintArray at: 1 put: self class elementConstraint.
    ^ constraintArray
  ].

" get constraint on unnamed variables for root NSC "
tmpClass := self class elementConstraint.
1 to: sz do: [ :i |
  constraintArray at: i put: tmpClass.
  pathName := pathArray at: i.
  tmpClass == nil
    ifFalse: [
      tmpClass isNsc
        ifTrue: [ tmpClass := tmpClass elementConstraint ]
        ifFalse: [ tmpClass := (tmpClass _constraintOn: pathName) ]
    ].
].
^ constraintArray
%

category: 'Indexing Support'
method: UnorderedCollection
_getIndexList

"Returns the index list for the receiver.  If one does not exist, create it."

| iList |
iList := self _indexedPaths.
iList == nil
  ifTrue: [
    iList := IndexList new.
    self _indexedPaths: iList.
							"deleted moveToDisk"
    iList changeToSegment: GsIndexingSegment.
  ].

^ iList
%

category: 'Modification Tracking'
method: UnorderedCollection
_setModificationTrackingTo: tracker

"Adds the given tracker to the receiver's indexedPaths and dependency lists."

"Must set indexedPaths first so tracker is not invoked for instance variable
 modification."
self _getIndexList addTracker: tracker.

super _setModificationTrackingTo: tracker.
%

category: 'Modification Tracking'
method: UnorderedCollection
_clearModificationTrackingTo: tracker

"Remove the given tracker from the receiver's indexedPaths and dependency lists."

"Must clear depmap entry first, so we don't get notified about IV changes"
super _clearModificationTrackingTo: tracker.

self _getIndexList removeTracker: tracker for: self.

%

category: 'Updating Indexes - Private'
method: UnorderedCollection
_removeAllRootIndexes: rootIndexes hasNonRootIndex: hasNonRootIndex

"Removes all root indexes on the receiver."

| array roots |

hasNonRootIndex
  ifTrue: [
    " only remove root indexes "
    1 to: rootIndexes size do: [ :i |
      self _removeIndex: (rootIndexes at: i)
    ].
    " if the receiver still has implicit indexes ... "
    self _indexedPaths == nil
      ifFalse: [ 
        | iList |
        iList := self _indexedPaths.
        1 to: iList size by:2 do: [:i |
           | iObj |
           iObj := iList at: i.
           (iObj isComplete _and: [ (iList at: i + 1) > 0 ])
             ifTrue: [ 
               " and they are complete...."
               ^ self _indexParticipationInfo 
             ].
         ].
      ]
  ]
  ifFalse: [
    array := Array new.
    roots := self _indexedPaths rootTerms.
    1 to: roots size do: [ :i |
      (roots at: i) _thisAndAllChildTermsInto: array
    ].

    " this will clean up dependency tags and nil out the index list "
    self _cleanUpDependencies.

    " remove dependency lists from global table that are no longer needed "
    SharedDependencyLists removeEntriesContaining: array.
  ].
%

category: 'Indexing Support'
method: UnorderedCollection
_indexParticipationInfoInto: array

"Returns an Array of pairs:  the root NSC and the path string that describes
 the path traversed from the root to reach the receiver."

| iList indexObj pathString included |
iList := self _indexedPaths.
1 to: iList size by: 2 do: [ :i |
  (iList at: i + 1) > 1
    ifTrue: [
      indexObj := iList at: i.
      pathString := indexObj _partialPathComponentsStringUpTo: (iList at: i + 1).
      included := false.
      1 to: array size by: 2 do: [ :j |
        ( indexObj nscRoot == (array at: j) _and:
        [ (array at: j + 1) = pathString ] )
          ifTrue: [ included := true ]
      ].
      included
        ifFalse: [
          array add: indexObj nscRoot.
          array add: pathString
        ]
    ]
].
^ super _indexParticipationInfoInto: array
%

category: 'Updating Indexes - Private'
method: UnorderedCollection
_cleanUpDependencies

"The receiver is having all of its indexes removed.  Remove dependency
 list entries for objects along the path of the indexes."

| rootTerms bag prevObj obj iList |
iList := self _indexedPaths.
rootTerms := iList rootTerms.

prevObj := #_incompletePathTraversal.
bag := self _asIdentityBag.
1 to: bag size do: [ :i |
  obj := bag _at: i.
  (obj == prevObj)
    ifFalse: [
      1 to: rootTerms size do: [ :j |
        (rootTerms at: j) cleanupDependencyListFor: obj
      ]
    ].
  prevObj := obj
].

iList hasTrackingObjects
  ifTrue: [ iList removeAllIndexesFor: self ]
  ifFalse: [ self _indexedPaths: nil ].

" resize the Array of path terms to avoid object audit errors "
rootTerms size: 0.
%

category: 'Indexing Support'
method: UnorderedCollection
_putInWriteSet

"In some cases, it is necessary to put an NSC with indexes into the write set
 explicitly.  For example, when NO_RW_CHECKS concurrency mode is enabled, index
 creation should put the NSC in the write set to ensure that other transactions
 do not commit additions to the NSC successfully (and thus corrupting the
 internal indexing objects).  This method puts the receiver in the write set by
 writing the _indexedPaths."

self _indexedPaths: self _indexedPaths
%

category: 'Indexing Support'
method: UnorderedCollection
_isLastOccurrenceInIndexObjects: anObject

"Returns true if the given object is maintained in the indexing objects for one
 occurrence."

| rootTerms pathTerm key val tmpList val2 num parentTerm |
rootTerms := self _indexedPaths rootTerms.
" find a path term with a mapping in the index dictionary "
1 to: rootTerms size do: [ :i |
  pathTerm := rootTerms at: i.
  pathTerm _isObsoletePathTerm
    ifFalse: [
      pathTerm isRangeEqualityIndexLastPathTerm
        ifTrue: [
          pathTerm offset == 1
            ifTrue: [ 
              " if index directly on NSC elements or anObject is nil "
              ( pathTerm indicatesIndexOnNscElements _or: [ nil == anObject ] )
                ifTrue: [ key := anObject ]
                ifFalse: [ key := pathTerm _nextObjectFor: anObject ].
              tmpList := IdentityBag new.

              pathTerm updateBtree btreeRoot _findAllValuesForIdenticalKey: key into: tmpList.
              ^ (tmpList occurrencesOf: anObject) <= 1
            ]
            ifFalse: [
              pathTerm := pathTerm getParentTerm.
              val := pathTerm updateDict at: anObject term: pathTerm otherwise: nil.
              " see if more than one mapping "
              (BucketValueBag _hasInstance: val)
                ifTrue: [ ^ (val occurrencesOf: self) <= 1]
                ifFalse: [ ^ true ]
            ]
        ]
        ifFalse: [
          " get key to look up in index dictionary "
          ( pathTerm indicatesIndexOnNscElements _or: [ nil == anObject ] )
            ifTrue: [ key := anObject ]
            ifFalse: [ key := pathTerm _nextObjectFor: anObject ].
          " look up the mapping in the index dictionary "
          val := pathTerm updateDict at: key term: pathTerm otherwise: nil.
          " see if more than one mapping "
          (BucketValueBag _hasInstance: val)
            ifTrue: [
              (num := val occurrencesOf: anObject) <= 1
                ifTrue: [ ^ true ]
                ifFalse: [
                  " see if multiple occurrences are due to more than one object
                    referencing self "
                  " if there is a parent term, it is a SetValuedPathTerm "
                  parentTerm := pathTerm getParentTerm.
                  parentTerm == nil
                    ifTrue: [ ^ false ].

                val2 := pathTerm updateDict at: anObject term: parentTerm otherwise: nil.
                (BucketValueBag _hasInstance: val2)
                  ifTrue: [ ^ (val2 occurrencesOf: self) == num ]
                  ifFalse: [ ^ false ]
                ]
            ]
            ifFalse: [ ^ true ]
        ]
    ]
].
" if we get this far, there are only incomplete indexes "
^ true
%

category: 'Indexing Support'
method: UnorderedCollection
_isLastOccurrenceInIndexObjectsFor: anObject
  "Returns true if the given object is maintained in the indexing objects for one
   occurrence. For identitySet and Set this method can be overridden to return true."
^self _isLastOccurrenceInIndexObjects: anObject
%

category: 'Indexing Support'
method: UnorderedCollection
_indexDictionary

"Returns the index dictionary that is shared by all indexes.  If there are no
 indexes, returns nil."

| iList |
iList := self _indexedPaths.
iList == nil
  ifTrue: [ ^ nil ]
  ifFalse: [
    1 to: iList size by: 2 do: [ :i |
      ( (iList at: i + 1) == 1 _and:
      [ (iList at: i) indexDictionary ~~ nil ] )
        ifTrue: [ ^ (iList at: i) indexDictionary ]
    ].
    ^ nil
  ]
%

category: 'ObsoleteIDX - Updating Indexes'
method: UnorderedCollection
createEqualityIndexOn: aPathString commitInterval: anInteger

"Creates an equality index on aPathString.  Generates an error if aPathString
 is not a path for the element kind of the receiver or if any term of the path
 is not constrained."

"If an error occurs during index creation, it may not be possible to commit the
 current transaction later."

"transactional behavior is now controlled by the class IndexManager"
self halt: 'no longer supported'.

^ self createEqualityIndexOn: aPathString
%
category: 'Updating Indexes'
method: UnorderedCollection
createEqualityIndexOn: aPathString withLastElementClass: aClass commitInterval: anInteger

"Creates an equality index on the path specified by aPathString.  The equality
 index will be ordered according to the sort provided comparison operators
 provided by aClass."

"Note: An error occurring during index creation may cause the
 current transaction to be unable to commit."

"transactional behavior is now controlled by the class IndexManager"
self halt: 'no longer supported'.

^ self createEqualityIndexOn: aPathString
  withLastElementClass: aClass
%
category: 'Updating Indexes'
method: UnorderedCollection
createRcEqualityIndexOn: aPathString

"Creates an equality index on aPathString.  Generates an error if aPathString
 is not a path for the element kind of the receiver or if any term of the path
 is not constrained."

"If an error occurs during index creation, it may not be possible to commit the
 current transaction later."

| lastConstraint |

self _checkIndexPathExpression: aPathString.

" get the constraint of the last element along the path
( will raise an error if path is not constrained) "
lastConstraint := self getLastElementConstraintOnPath: aPathString.
lastConstraint == nil
  ifTrue: [^ self _error: #rtErrBagNoConstraintAlongPath args: #[ aPathString ]].

^ self 
     createRcEqualityIndexOn: aPathString
     withLastElementClass: lastConstraint
%
category: 'Accessing Indexes'
method: UnorderedCollection
equalityIndexedPaths

"Returns an Array of Strings, each of which represents a path for which an
 equality index exists in the receiver.  Each path originates with the elements
 of the receiver."

| anArray |
anArray := Array new.
self _indexedPaths == nil
  ifTrue: [
    ^ anArray
  ].
self _indexedPaths indexObjectsAndOffsetsDo: [ :indexObj :offset | | str |
  indexObj isRangeEqualityIndex
    ifTrue: [
      str := indexObj pathComponentsStringStartingAt: offset.
      indexObj isComplete
        ifFalse: [ str add: ' (incomplete)' ].
      (anArray includesValue: str)
        ifFalse: [ anArray addLast: str ]
    ]
].
^ anArray
%
category: 'Accessing Indexes'
method: UnorderedCollection
equalityIndexedPathsAndConstraints

"Returns an Array containing info about equality indexes.  The Array consists of
 String/Class pairs.  The string represents a path of the receiver's element
 kind for which an equality index exists in the receiver.  The class is the
 constraint on the last element in the path."

| anArray |
anArray := Array new.
self _indexedPaths == nil
    ifTrue: [
        ^ anArray
    ].
self _indexedPaths indexObjectsAndOffsetsDo: [ :indexObj :offset |
    indexObj isRangeEqualityIndex
        ifTrue: [
            anArray addLast: (indexObj pathComponentsStringStartingAt: offset).
            anArray addLast: indexObj lastElementClass
        ]
].
^ anArray
%
category: 'Accessing Indexes'
method: UnorderedCollection
kindsOfIndexOn: aPathString

"Returns a Symbol that indicates the kinds of indexes into the receiver that
 exist on aPathString: #identity, #equality, #equalityAndIdentity, or #none
 (either aPathString is not a path for the element kind of the receiver, or no
 indexes into the receiver exist on aPathString)."

| pathList pathArray |

self _indexedPaths == nil
    ifTrue: [
        ^ #none
    ].

pathList := #[].
pathArray := aPathString asArrayOfPathTerms.
self _indexedPaths indexObjectsAndOffsetsDo: [ :indexObj :offset |
    ( offset <= indexObj size _and:
    [ pathArray size > (indexObj size - offset) _and:
    [ indexObj hasIndexOnPath: pathArray startingAt: offset ] ] )
        ifTrue: [ pathList add: indexObj ].
].

pathList size == 2
    ifTrue: [
        ^ #equalityAndIdentity
    ].

pathList size == 1
    ifTrue: [
        pathList first isRangeEqualityIndex
            ifTrue: [
                ( self _isRangeable: pathList first lastElementClass )
                    ifTrue: [
                        ^ #equalityAndIdentity
                    ]
                    ifFalse: [
                        ^ #equality
                    ]
            ]
            ifFalse: [
                ^ #identity
            ]
    ].

self _indexedPaths ~~ nil
    ifTrue: [
        (self _indexedPaths _numberOfCommonPathTermsForPathArray: pathArray) == pathArray size
            ifTrue: [
                ^ #identity
            ]
            ifFalse: [
                ^ #none
            ]
    ].

^ #none
%
category: 'Clustering'
method: UnorderedCollection
clusterIndexes

"Clusters internal indexing objects using the current default ClusterBucket."

self _clusterIndexes
%

category: 'Clustering'
method: UnorderedCollection
_clusterIndexes

"Clusters indexing objects.  This may cause concurrency conflicts on
 internal indexing objects.  Returns the receiver."

| iList |
(iList := self _indexedPaths) == nil
  ifTrue: [ 
    ^ self 
  ].

" cluster the index dictionary "
self _indexDictionary ~~ nil
  ifTrue: [ self _indexDictionary clusterDepthFirst ].

" cluster each index object "
1 to: iList size by: 2 do: [ :j |
  (iList at: j) _isIndexObject
    ifTrue: [ (iList at: j) clusterDepthFirst ]
].
%

category: 'Indexing Audit'
method: UnorderedCollection
_quickCheckIndexes

"Verifies that the index objects are present. This method is does 
 not catch most types of index corruption. The return values are 
 messages that no indexes are present, or that indexes are okay. 
 Any errors found will result in an unhandled exception. 
 
 This method is unsupported, but is provided for customer support."

| prevObj |

self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

"execute minor code over all the path terms"
self _indexedPaths rootTerms do: 
  [:rootTerm |
  (rootTerm _thisAndAllChildTerms) do:
     [:aTerm | 
     aTerm indicatesNsc
       ifFalse: [aTerm isRangeEqualityIndexLastPathTerm]]].

prevObj := #_incompletePathTraversal.
self do: 
  [ :obj | 
  obj ~~ prevObj
     ifTrue: [ obj _indexParticipationInfo].
  prevObj := obj].

^'Indexes are OK'
%

category: 'Updating Indexes'
method: UnorderedCollection
progressOfIndexCreation

"Returns a String that describes the progress of an index creation that is
 underway."

| indexObj cnt str lf |

indexObj := self _findIncompleteIndex.
( indexObj == nil _or:
" get the current offset of enumeration through the NSC "
[ (cnt := indexObj progress) == nil ] )
  ifTrue: [ 
    ^ 'No index creation is in progress.' 
  ].

str := String new.
lf := Character lf.
str add: lf; add: 'Creating index on <';
  add: indexObj pathComponentsString; add: $>; add: lf;
  add: 'During enumeration of collection, finished ';
  add: cnt asString; add: ' out of ';
  add: self size asString; add: ' total elements.'.

indexObj isRangeEqualityIndex
  ifTrue: [
    " get the current offset of enumeration through the n-way merge "
    cnt := indexObj nwayMergeProgress.
    cnt ~~ nil
      ifTrue: [
        str add: lf; add: 'During n-way merge, finished ';
          add: cnt asString; add: ' elements'; add: lf.
      ]
  ].

^ str
%

category: 'ObsoleteIDX - Indexing Audit'
method: UnorderedCollection
_incrementalAuditIndexes: start to: end

"Verifies that the index objects are consistent. Scans only the objects in the range 
 from start to end, inclusive. This may take a while. A better option is to use
 _fastAuditIndexes. Returns a string that describes any inconsistencies found.  
 This method is currently unsupported, but is provided for customer support." 

| roots sz aString prevObj nscBuilder index |
self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

roots := self _indexedPaths rootTerms.
sz := roots size.
aString := String new.

" audit by traversing the tree of path terms for each element "
prevObj := #_incompletePathTraversal.
nscBuilder := NscBuilder
  for: IdentityBag new
  max: NscBuilder maxSize.
index := 1.
self do: [ :obj | 
  ((index >= start) _and: [index <= end]) ifTrue: [
    obj ~~ prevObj
      ifTrue: [ | oCount |
        oCount := self occurrencesOf: obj . 
        1 to: sz do: [ :j | | rootTerm |
          rootTerm := roots at: j.
          rootTerm auditObject: obj
            occurrences: oCount 
            on: aString
            builder: nscBuilder.
          nscBuilder _resetForAudit.
        ]
      ].
    prevObj := obj.
  ].
  index := index + 1.
  (index > end)
    ifTrue: [
      aString isEmpty
        ifTrue: [ aString := 'Indexes are OK' ].
      ^ aString
    ].
].
"0 element nsc case"
aString isEmpty
  ifTrue: [ aString := 'Indexes are OK' ].
^ aString
%

category: 'Indexing Audit'
method: UnorderedCollection
_fastAuditIndexes

"Verifies that the index objects are consistent.
 Returns a string that describes any inconsistencies found.  This method
 is currently unsupported, but is provided for customer support." 

| str1 str2 success |

self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

str1 := self _fastAuditIdentityIndexes.
str2 := self _fastAuditEqualityIndexes.
success := 'Indexes are OK'.

str1 = success
  ifTrue: [
    str2 = success
      ifTrue: [ ^success ].
    ^str2
  ].
str2 = success
  ifTrue: [ ^str1 ].
^ str1 + str2
%

category: 'Indexing Audit'
method: UnorderedCollection
_fastAuditIdentityIndexes

"Verifies that the identity index objects are consistent. When run in
 conjunction with _fastAuditEqualityIndexes a complete audit is performed.
 Returns a string that describes any inconsistencies found.  This method
 is currently unsupported, but is provided for customer support." 

| roots sz aString |

self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

roots := self _indexedPaths rootTerms.
sz := roots size.

aString := String new.

1 to: sz do: [ :j |
    | rootTerm indexDictionary |
  rootTerm := roots at: j.
  indexDictionary := rootTerm getIndexDictionary.
  indexDictionary ~~ nil
    ifTrue: [ 
      indexDictionary auditNsc: self for: rootTerm on: aString.
      indexDictionary auditEntriesForNsc: self for: rootTerm on: aString.
    ].
].

aString isEmpty
  ifTrue: [ aString := 'Indexes are OK' ].

^ aString
%

category: 'Indexing Audit'
method: UnorderedCollection
_fastAuditEqualityIndexes

"Verifies that the equality index objects are consistent. When run in
 conjunction with _fastAuditIdentityIndexes a complete audit is performed.
 Returns a string that describes any inconsistencies found.  This method
 is currently unsupported, but is provided for customer support." 

| roots sz btreeCounts aString |

self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

roots := self _indexedPaths rootTerms.
sz := roots size.

btreeCounts := Array new.
aString := String new.

1 to: sz do: [ :j |
  | rootTerm resultArray |
  rootTerm := roots at: j.
  resultArray := rootTerm auditNsc: self
                          on: aString
                          level: 1.
  btreeCounts add: resultArray.
].

1 to: sz do: [ :j |
    | rootTerm |
  rootTerm := roots at: j.
  self do: [ :obj | 
    rootTerm auditNscCounts: self
      for: obj
      on: aString
      count: (btreeCounts at: j).
  ].
].

self _auditBtreeCounts: btreeCounts on: aString.

aString isEmpty
  ifTrue: [ aString := 'Indexes are OK' ].

^ aString
%

category: 'Indexing Audit'
method: UnorderedCollection
_auditBtreeCounts: btreeCounts on: aString

"Private.  Unsupported method for GemStone Technical Support."

btreeCounts do: [:each |
  (each class == Array)
    ifTrue: [
      self _auditBtreeCounts: each on: aString.
    ]
    ifFalse: [
      "must be a 0, or there is a problem with index structure"
      each ~~ 0
        ifTrue: [
              aString add: Character lf;
                  add: ' -- The number of entries in a Btree does not match the number of entries in the base collection (extra elements in either the base collection or btree).';
                  add: Character lf
        ].
    ].
].
%

category: 'Indexing Audit'
method: UnorderedCollection
auditIndexes

"Verifies that the index objects are consistent.
 Returns a string that describes any inconsistencies found.

 Since #_fastAuditIndexes proviides a significant improvement 
 in speed over tthe older (pre 2.1) algorithms, it is recommended
 that this method be used on a regular basis to ensure index structure
 integrity. 

 If the audit returns errors, the indexes should be dropped and rebuilt 
 and the incident should be reported to Gemstone support for analysis.
" 

^self _fastAuditIndexes
%

category: 'Indexing Audit'
method: UnorderedCollection
_auditIndexes

"Verifies that the index objects are consistent.
 Returns a string that describes any inconsistencies found.  This method
 is currently unsupported, but is provided for customer support." 

^self _fastAuditIndexes
%

category: 'ObsoleteIDX - Indexing Audit'
method: UnorderedCollection
_oldAuditIndexes

"Verifies that the index objects are consistent. _fastAuditIndexes is 
 recommended over _oldAuditIndexes, because it is much, much faster and
 just as accurate.

 Returns a string that describes any inconsistencies found.  This method
 is currently unsupported, but is provided for customer support." 

^self _incrementalAuditIndexes: 1 to: self size
%

category: 'ObsoleteIDX - Indexing Audit'
method: UnorderedCollection
_quickCheckIndexes

"Verifies that the index objects are present. This method is does 
 not catch most types of index corruption. The return values are 
 messages that no indexes are present, or that indexes are okay. 
 Any errors found will result in an unhandled exception. 
 
 This method is unsupported, but is provided for customer support."

| prevObj |

self _indexedPaths == nil
  ifTrue: [
    ^ 'No indexes are present.'
  ].

"execute minor code over all the path terms"
self _indexedPaths rootTerms do: 
  [:rootTerm |
  (rootTerm _thisAndAllChildTerms) do:
     [:aTerm | 
     aTerm indicatesNsc
       ifFalse: [aTerm isRangeEqualityIndexLastPathTerm]]].

prevObj := #_incompletePathTraversal.
self do: 
  [ :obj | 
  obj ~~ prevObj
     ifTrue: [ obj _indexParticipationInfo].
  prevObj := obj].

^'Indexes are OK'
%

category: 'Indexing Audit'
method: UnorderedCollection
_auditIndexDictionary

"Verifies that the index dictionary component of the indexing structure 
 for this collection is consistent.  Returns a string that describes any 
 inconsistencies found.  This method is unsupported, but is provided for 
 customer support.  This method is intended to be used for audit when 
 problems specific to the index dictionary are suspected; for general
 audit on the indexes use _auditIndexes" 

^ self _fastAuditIdentityIndexes
%

category: 'Indexing Audit'
method: UnorderedCollection
_auditIndexBtree

"Verifies that the B-tree component of the indexing structure for 
 this collection is consistent.  Returns a string that describes any 
 inconsistencies found.  This method is unsupported, but is provided for 
 customer support.  This method is intended to be used for audit when 
 problems specific to the btrees are suspected; for general audit on the 
 indexes use _auditIndexes" 

^ self _fastAuditEqualityIndexes
%

category: 'Searching'
method: UnorderedCollection
selectAsStream: aBlock

"Same functionality as select: except that the result is returned as a
 RangeIndexReadStream rather than an IdentitySet.  The select block is limited
 in the following ways:

 * The select block may only contain a single predicate.
 * The predicate must contain one path expression.
 * An equality index must exist for the path expression.

 To use the stream that this method returns most effectively, avoid modifying
 both the receiver of this message and the selected objects returned by the
 stream as long as the stream is being accessed.  Changes that alter the
 equality index can cause stream access failures."

| result |
(aBlock _class == SelectBlock)
    ifTrue:[
       "send value: to the block to create the 4 element
        associative access Array; the argument nil is ignored to
        create the Array, but all SelectBlocks have one argument"
        result := (QueryExecuter on: self)
            _boundQuerySelectAsStream: (aBlock queryBlock value: nil).
        ^ result
    ].
^ self _error: #rtErrBagOnlySelectBlockAllowed
%

category: 'Testing'
method: UnorderedCollection
_isLarge

"Returns true if the object is implemented as a tree of private smaller objects"

^ _levels > 0
%

category: 'Testing'
method: UnorderedCollection
_levels

"If the object is implemented as a tree of private smaller objects, returns
 the depth of the tree not including the leaf nodes, otherwise returns 0.

 The result will be a SmallInteger >= 0"

^ _levels 
%

category: 'Indexing Support'
method: UnorderedCollection
_findRangeIndexWithPath: pathArray

"Returns a range equality index whose path components are the same as
 represented by the pathArray (Array of strings)."

| index iList |
iList := self _indexedPaths.
iList == nil
  ifTrue: [ ^ nil ].

" for each index on the NSC ... "
1 to: iList size by: 2 do: [ :i |
  index := iList at: i.
  ( index _isIndexObject _and:
  [ index isRangeEqualityIndex _and:
  [ index hasIndexOnPath: pathArray ] ] )
    ifTrue: [ ^ index ]
].
^ nil
%
category: 'Updating Indexes'
method: UnorderedCollection
createEqualityIndexOn: aPathString

"Creates an equality index on aPathString.  Generates an error if aPathString
 is not a path for the element kind of the receiver or if any term of the path
 is not constrained."

"If an error occurs during index creation, it may not be possible to commit the
 current transaction later."

| lastConstraint |

self _checkIndexPathExpression: aPathString.

" get the constraint of the last element along the path
( will raise an error if path is not constrained) "
lastConstraint := self getLastElementConstraintOnPath: aPathString.
lastConstraint == nil
  ifTrue: [^ self _error: #rtErrBagNoConstraintAlongPath args: #[ aPathString ]].

^ self 
     createEqualityIndexOn: aPathString
     withLastElementClass: lastConstraint
%
category: 'Repository Conversion'
method: UnorderedCollection
fixRefsAfterConversion

"Default UnorderedCollection method for fixing references 
 LargePositiveInteger and LargeNegativeInteger instances that can
 now be represented as a SmallInteger and Floats and SmallFloats 
 which can now be represented as a SmallDouble."

|myClass array aBagOrSet|

(System _testIf: self isIn: 45)
	ifTrue:[^false]. "already fixed this one"

"Fix inst var refs first"
self fixInstVarRefsAfterConversion.

"now handle the rest of it"
aBagOrSet := self select:[:e| e needsFixingAfterConversion].
1 to: aBagOrSet _basicSize do:[:n| |obj|
	obj := aBagOrSet _at: n.
	self remove: obj.
	obj := obj + 0.
	self add: obj.
].
System _add: self to: 45.
^true
%
