!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: rcidentitybag.gs,v 1.26 2008-01-09 22:50:13 stever Exp $
!
! Superclass Hierarchy:
!   RcIdentityBag, IdentityBag, UnorderedCollection, Collection, Object.
!
!=========================================================================

! class created in idxclasses.topaz

removeallmethods RcIdentityBag
removeallclassmethods RcIdentityBag

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

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

txt := (GsDocText new) details:
'An RcIdentityBag is a special kind of IdentityBag that provides for concurrent
 handling of an individual instance by multiple sessions.  Any or all of those
 sessions can modify the single instance.  When that happens, RcIdentityBag also
 reduces the transaction conflicts that can arise among those sessions when they
 attempt to commit the instance to GemStone.'.
doc documentClassWith: txt.

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

self description: doc.
%

! ------------------- Class methods for RcIdentityBag
! default number of buckets changed to fix 31160 
category: 'Instance Creation'
classmethod: RcIdentityBag
new

"Returns a new RcIdentityBag that can handle 
 at least 10 user sessions, plus the default system gems (1 admin gc,
 1 reclaim gc, 1 page manager, 1 symbol creation gem) ,
 plus the global components."

^ self new: 14
%
category: 'Instance Creation'
classmethod: RcIdentityBag
new: initialNumberOfUsers

"Returns a new RcIdentityBag with a size that supports initialNumberOfUsers
 concurrent sessions plus the global components.
 The new RcIdentityBag will handle more users, but will only have 
 subcomponents initially created for initialNumberOfUsers.  
 Don't forget to include allowance for
 system gems ( 3 sessions plus the number of reclaim gc gems configured)."

| newOne |
newOne := self basicNew initialize: (initialNumberOfUsers + 1) * 2.
^ newOne initializeComponents
%
category: 'Private'
classmethod: RcIdentityBag
_componentConstraint

"Returns the class of objects with which to populate the 'components' Array."

| constraintClass |
constraintClass := (self _constraintOn: #components) varyingConstraint.
constraintClass == Object
  ifTrue: [ constraintClass := IdentityBag ].
^ constraintClass
%
category: 'Accessing the Class Format'
classmethod: RcIdentityBag
firstPublicInstVar

^ 6
%
! ------------------- Instance methods for RcIdentityBag
category: 'Set Arithmetic'
method: RcIdentityBag
* anIdentityBag

"Intersection.  Returns a kind of IdentityBag containing only the
 elements that are present in both the receiver and the argument.

 The class of the result is the class of the argument. If the argument is a
 kind of RcIdentityBag, the result is an IdentityBag.

 If the result is a kind of IdentitySet, then each element that occurs in both
 the receiver and the argument occurs exactly once in the result.  If the result
 is an IdentityBag and if an element occurs m times in the receiver and n
 times in the argument, then the result contains the lesser of m or n
 occurrences of that element."

(anIdentityBag _isRcIdentityBag _or: [ anIdentityBag _isIdentityBag not ])
  ifTrue: [ ^ self _asIdentityBag _primIntersect: anIdentityBag _asIdentityBag ]
  ifFalse: [ ^ self _asIdentityBag _primIntersect: anIdentityBag ]
%
category: 'Set Arithmetic'
method: RcIdentityBag
+ anIdentityBag

"Union.  Returns a kind of IdentityBag containing exactly the elements
 that are present in either the receiver or the argument.

 The class of the result is the class of the argument. If the argument is a
 kind of RcIdentityBag, the result is an IdentityBag.

 If the result is a kind of IdentitySet, then each element that occurs in
 either the receiver or the argument occurs exactly once in the result. If the
 result is a kind of IdentityBag, and if an element occurs m times in the
 receiver and n times in the argument, then the result contains m + n
 occurrences of that element."

(anIdentityBag _isRcIdentityBag _or: [ anIdentityBag _isIdentityBag not ])
  ifTrue: [ ^ self _asIdentityBag _primUnion: anIdentityBag _asIdentityBag ]
  ifFalse: [ ^ self _asIdentityBag _primUnion: anIdentityBag ]
%
category: 'Set Arithmetic'
method: RcIdentityBag
- anIdentityBag

"Difference.  Returns an IdentityBag containing exactly those elements of the
 receiver that have a greater number of occurrences in the receiver than in the
 argument.  If an element occurs m times in the receiver and n times in the
 argument (where m >= n), then the result will contain m - n occurrences of that
 element."

(anIdentityBag _isRcIdentityBag _or: [ anIdentityBag _isIdentityBag not ])
  ifTrue: [ ^ self asIdentityBag _primDifference: anIdentityBag _asIdentityBag ]
  ifFalse: [ ^ self asIdentityBag _primDifference: anIdentityBag ]
%
category: 'Comparing'
method: RcIdentityBag
= anRcIdentityBag

"Verifies that the receiver and anRcIdentityBag are of the same class, then uses
 the semantics of IdentityBag comparison for the elements in the RcIdentityBag."

| systm |
systm := System .
systm _addRootObjectToRcReadSet: self.
self == anRcIdentityBag ifTrue:[ ^ true ].
anRcIdentityBag class == self class
    ifFalse: [ ^ false ].
systm _addEntireObjectToRcReadSet: components.
^ self _asIdentityBag = anRcIdentityBag _asIdentityBag
%
category: 'Adding'
method: RcIdentityBag
add: newObject

"Add the object to the the RcIdentityBag.  Returns newObject."

newObject == nil ifTrue:[ ^ self "ignore nils" ].
(newObject isKindOf: self class varyingConstraint) ifFalse: [
    self _error: #objErrConstraintViolation 
      args: #[ newObject, self class varyingConstraint, newObject class ]
  ].

self add: newObject logging: true.
^ newObject.
%
category: 'Adding'
method: RcIdentityBag
add: newObject logging: aBoolean

"Adds newObject to the current session's addition Bag in the RcIdentityBag.  If
 aBoolean is true, logs the addition to the redo log.  Returns the receiver."

<primitive: 901>
self _add: newObject logging: aBoolean.
System _disableProtectedMode.
%
category: 'Adding'
method: RcIdentityBag
add: anObject withOccurrences: anInteger

"Add the object to the RcIdentityBag the given number of times.  Returns the
 receiver."

anObject == nil ifTrue:[ ^ self "ignore nils" ].
(anObject isKindOf: self class varyingConstraint) ifFalse: [
    self _error: #objErrConstraintViolation 
      args: #[ anObject, self class varyingConstraint, anObject class ]
  ].

1 to: anInteger do: [ :i | self add: anObject logging: true ]
%

! fixed 34436 , changed return value
category: 'Adding'
method: RcIdentityBag
addAll: aCollection

"Adds the collection of objects to the the RcIdentityBag.
 Returns aCollection ."

self addAll: (Array new addAll: aCollection; yourself) logging: true.
^ aCollection
%
category: 'Adding'
method: RcIdentityBag
addAll: aCollection logging: aBoolean

"Adds the elements of aCollection to the current session's addition Bag.  If
 aBoolean is true, logs the addition to the redo log.  Returns the receiver."

<primitive: 901>
self _addAll: aCollection logging: aBoolean.
System _disableProtectedMode.
%
category: 'Converting'
method: RcIdentityBag
asIdentityBag

"Returns a Bag that consists of objects in this RcIdentityBag.  Note that each
 invocation of this message returns a new Bag."

^ self _asIdentityBag copy
%
category: 'Accessing'
method: RcIdentityBag
at: offset

"Returns the element of the receiver that is currently located at logical
 position offset.

 The elements of an RcIdentityBag are inherently unordered, and can change
 position (offset) when the RcIdentityBag is altered.  Thus, after an
 RcIdentityBag is altered, a given element may reside at a different offset than
 before, and a given offset may house a different element.  You should not infer
 an ordering for an RcIdentityBag's elements when you access them by offset.

 This method is useful primarily as a code optimizer for iterating over all the
 elements of an RcIdentityBag (using a loop that runs the offset from 1 to the
 size of the RcIdentityBag).  The RcIdentityBag must not change during the
 iteration.  But the iteration may run faster than it would if you use other
 alternatives, such as the do: method."

| addBag remBag diffSz cumulativeSz prevSz currOffset obj |
cumulativeSz := 0.
1 to: components size by: 2 do: [ :i |
  (addBag := components at: i) ~~ nil
    ifTrue: [
      remBag := components at: i + 1.
      diffSz := addBag size - remBag size.
      prevSz := cumulativeSz.
      cumulativeSz := cumulativeSz + diffSz.
      " see if this pair contains the object at the logical offset "
      cumulativeSz >= offset
        ifTrue: [
          currOffset := offset - prevSz.
          1 to: addBag size do: [ :j |
            obj := addBag at: j.
            (addBag occurrencesOf: obj) > (remBag occurrencesOf: obj)
              ifTrue: [
                currOffset == 1
                  ifTrue: [ ^ obj ].
                currOffset := currOffset - 1
              ]
          ]
        ]
    ]
].
self _error: #objErrBadOffsetIncomplete args: #[offset]
%
category: 'Support'
method: RcIdentityBag
centralizeSessionElements

"Place the elements of inactive session components in the global Bag.  This
 may cause concurrency conflict if another session performs this operation, or
 if a new session modifies the RcIdentityBag."

| inactiveSessions globalAddBag systm |
inactiveSessions := self _getInactiveSessionIndexes.
" treat this session as inactive "
inactiveSessions add: self _thisSessionAdditionIndex.

globalAddBag := self _globalAddBag.
systm := System .
systm _addRootObjectToRcReadSet: self.
systm _addEntireObjectToRcReadSet: components.
inactiveSessions do: [ :i | | addBag |
    addBag := components _rcAt: i.
    addBag ~~ nil
        ifTrue: [
            " apply any removals that have occurred for that session's elements "
            self _processRemovalBagFor: i logging: true.

            " put all additions in the global Bag "
            globalAddBag addAll: addBag.
            " remove all from the sessions addition Bag "
            addBag removeAll: addBag.
            System _addEntireObjectToRcReadSet: addBag.
        ]
].
systm redoLog addConflictObject: components for: self.
%
category: 'Support'
method: RcIdentityBag
cleanupBag

"Iterate through all inactive session bags and process their removal Bags.
 This may cause conflict if a new session modifies the receiver."

| sessionIndex inactiveSessions |
inactiveSessions := self _getInactiveSessionIndexes.

" treat this session as inactive if there are enough component Bags "
sessionIndex := self _thisSessionAdditionIndex.
sessionIndex <= super _basicSize
    ifTrue: [ inactiveSessions add: self _thisSessionAdditionIndex ].

" treat the global session as inactive "
inactiveSessions add: 1.

System _addRootObjectToRcReadSet: self;
	_addEntireObjectToRcReadSet: components.
inactiveSessions do: [ :i |
    " apply any removals that have occurred for that session's elements "
    self _processRemovalBagFor: i logging: true.
    " perform an _rcAt: to place nodes in the RC read set "
    components _rcAt: i
]
%
category: 'Clustering'
method: RcIdentityBag
cluster

"Clusters an object using the current default ClusterBucket.  Has no effect and
 returns true if the receiver was previously clustered in the current
 transaction; otherwise returns false after clustering the receiver."

System _addRootObjectToRcReadSet: self.
super cluster
  ifTrue: [ ^ true ].

System _addEntireObjectToRcReadSet: components.
components cluster.
self _doSessionBags: [ :addBag :removeBag |
  addBag cluster.
  removeBag cluster.
].
^ false
%
! fixed 31223
category: 'Clustering'
method: RcIdentityBag
clusterDepthFirst

"Clusters the receiver and its contents in depth-first order.  Returns true if
 the receiver has already been clustered during the current transaction; returns
 false otherwise.  This operation may cause concurrency conflicts with other
 sessions."

System _addRootObjectToRcReadSet: self.
super cluster
  ifTrue: [ ^ true ].

self clusterIndexes.

System _addEntireObjectToRcReadSet: components.
components cluster.
self _doSessionBags: [ :addBag :removeBag |
  addBag clusterDepthFirst.
  removeBag clusterDepthFirst.
].
^ false
%
! fixed 31081
category: 'Copying'
method: RcIdentityBag
copy

"Returns a copy of the receiver.  A copy must not include any indexes that
 exist on the receiver."

| newOne comps |
newOne := super copy.
newOne _finishShallowCopy.      	
comps := components copy.
1 to: comps size do: [ :i |
  comps at: i put: (comps at: i) copy
].
newOne _components: comps.
^ newOne
%
category: 'Support'
method: RcIdentityBag
distributeSessionElements

"Distributes the elements of inactive session components across all inactive
 session components.  This could lessen the chance of conflicts that must be
 resolved at commit time.  This may cause concurrency conflict if another
 session performs this operation or if a new session modifies the receiver."

| inactiveSessions numberInactive numPerBag
remainder totalToDistribute extras deficientSessions |

inactiveSessions := self _getInactiveSessionIndexes.
" treat this session as inactive "
inactiveSessions add: self _thisSessionAdditionIndex.
" treat the global session as inactive "
inactiveSessions add: 1.

deficientSessions := IdentityBag new.
extras := IdentityBag new.

numberInactive := inactiveSessions size.
totalToDistribute := 0.

System _addRootObjectToRcReadSet: self;
    _addEntireObjectToRcReadSet: components.

" pass1: for each inactive session, process its removal Bag and
  calculate total number that will be distributed "
inactiveSessions do: [ :i | | addBag |
    (addBag := components _rcAt: i) == nil
        ifTrue: [ self _createComponentBagsFor: i ]
        ifFalse: [
            self _processRemovalBagFor: i logging: true.
            totalToDistribute := totalToDistribute + addBag size
        ]
].
numPerBag := totalToDistribute // numberInactive.
remainder := totalToDistribute \\ numberInactive.

" pass2: perform removals to inactive addition Bags
  that have more than numPerBag "
inactiveSessions do: [ :i | | delta addBag |
    delta := (addBag := components at: i) size - numPerBag.

    (delta > 0) "session contains more than numPerBag "
        ifTrue: [ | amount |
            remainder > 0
                ifTrue: [
                    amount := delta - 1.
                    remainder := remainder - 1
                ]
                ifFalse: [ amount := delta ].

            extras addAll: (self _removeAny: amount from: addBag)
        ]
        ifFalse: [ deficientSessions add: i ]
].

" pass3: perform additions to inactive addition Bags that were
  previously deficient in the number of elements "
deficientSessions do: [ :i | | amount addBag |
    addBag := components at: i.
    remainder > 0
        ifTrue: [
            amount := numPerBag + 1.
            remainder := remainder - 1
        ]
        ifFalse: [ amount := numPerBag ].
    addBag addAll: (self _removeAny: amount - addBag size from: extras)
]
%
category: 'Enumerating'
method: RcIdentityBag
do: aBlock

"Enumerates over all elements in the RcIdentityBag, executing aBlock with each
 element as the argument.  Returns the receiver."

| b |
b := self _asIdentityBag.
1 to: b size do: [ :i | aBlock value: (b _at: i) ]
%
category: 'Auditing'
method: RcIdentityBag
doInvalidReferenceAuditWithRepair: aBoolean

"For an explanation of this method, refer to the comments in the method
 UnorderedCollection>>invalidReferenceAuditWithRepair:"
	|total|
	total := self  invalidReferenceAuditWithRepair: aBoolean.
	1 to: components size do:[:n| |aBag|
		 (aBag := components at: n) ~~ nil
			ifTrue:[total := total + (aBag invalidReferenceAuditWithRepair: aBoolean).].
	].
^total
%
category: 'Comparing'
method: RcIdentityBag
hash

"Returns an Integer hash code for the receiver.

 Warning:  This is a computationally expensive operation."

^ self _asIdentityBag hash
%
category: 'Searching'
method: RcIdentityBag
includes: anObject

"Returns true if anObject is present in any session component of the 
 RcIdentityBag."

^self includesIdentical: anObject

%
category: 'Searching'
method: RcIdentityBag
includesIdentical: anObject

"Returns true if anObject is present in any session component of the 
 RcIdentityBag."

System _addRootObjectToRcReadSet: self ;
  _addEntireObjectToRcReadSet: components.
self _doSessionBags: [ :addBag :removeBag |
    (addBag _rcIncludes: anObject)
        ifTrue: [
            removeBag isEmpty
                ifTrue: [
                    System _addRootObjectToRcReadSet: removeBag.
                    ^ true
                ].
            (addBag _rcOccurrencesOf: anObject) >
            (removeBag _rcOccurrencesOf: anObject)
                ifTrue: [ ^ true ]
        ]
].
^ false
%
category: 'Searching'
method: RcIdentityBag
includesValue: anObject

"Returns true if anObject is present in any session component of the
 RcIdentityBag.  Uses equality comparison."

System _addRootObjectToRcReadSet: self.
System _addEntireObjectToRcReadSet: components.
self _doSessionBags: [ :addBag :removeBag |
    (addBag _rcIncludesValue: anObject)
        ifTrue: [
            removeBag isEmpty
                ifTrue: [
                    System _addRootObjectToRcReadSet: removeBag.
                    ^ true
                ].
            ((addBag _rcDifference: removeBag) includesValue: anObject)
                ifTrue: [ ^ true ]
        ]
].
^ false
%
category: 'Initialization'
method: RcIdentityBag
initialize: aSize

"Initializes a new instance."

components := (self class _constraintOn: #components) new: aSize.
%
category: 'Initialization'
method: RcIdentityBag
initializeComponents

"Create subcomponents for all available session IDs.  This can avoid
 initial concurrency conflict when many sessions add an object to the
 RcIdentityBag for the first time."

1 to: components size by: 2 do: [ :i |
  (components at: i) == nil
    ifTrue: [ self _createComponentBagsFor: i ]
]
%
category: 'Auditing'
method: RcIdentityBag
invalidReferenceAudit
"For an explanation of this method, refer to the comments in the method
 UnorderedCollection>>invalidReferenceAuditWithRepair:"
	^self doInvalidReferenceAuditWithRepair: false. "audit only, no repair"
%
category: 'Auditing'
method: RcIdentityBag
invalidReferenceRepair
"For an explanation of this method, refer to the comments in the method
 UnorderedCollection>>invalidReferenceAuditWithRepair:"
	^self doInvalidReferenceAuditWithRepair: true. "audit and repair"
%
category: 'Accessing'
method: RcIdentityBag
maxSessionId

"Returns the maximum sessionId that can be used with this RcIdentityBag."

System _addRootObjectToRcReadSet: self.
System _addEntireObjectToRcReadSet: components.
^ components size
%
category: 'Searching'
method: RcIdentityBag
occurrencesOf: anObject

"Returns the number of occurrences of anObject in all session components of
 the RcIdentityBag."

^ self _asIdentityBag occurrencesOf: anObject
%
! reimplement printOn: to fix 31686
category: 'Formatting'
method: RcIdentityBag
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

| count sz myCls anObj |

myCls := self class .
aStream nextPutAll: myCls name describeClassName .
aStream nextPutAll: '( ' .
count := 1 .
sz := self size .
1 to: sz do:[:idx |
  aStream position > 700 ifTrue:[
    "prevent infinite recursion when printing cyclic structures, and
     limit the size of result when printing large collections."
    aStream nextPutAll: '...)' .
    ^ self
    ] .
  anObj := self at: idx .
  anObj printOn: aStream .
  count < sz ifTrue:[ aStream nextPutAll: ', ' ].
  count := count + 1 .
  ].
aStream nextPut: $) .
%
category: 'Removing'
method: RcIdentityBag
remove: anObject

"Removes anObject from the receiver.  If anObject is present several times in
 the receiver, only one occurrence is removed.  Generates an error if anObject
 is not in the receiver."

(self _privateRemove: anObject logging: true)
    ifFalse: [ ^ self _errorNotFound: anObject ]
%
category: 'Removing'
method: RcIdentityBag
remove: anObject ifAbsent: aBlock

"Removes anObject from the receiver.  If anObject is present several times in
 the receiver, only one occurrence is removed.  If anObject is not in the
 receiver, this method evaluates aBlock and returns its value.  The argument
 aBlock must be a zero-argument block."

(self _privateRemove: anObject logging: true)
    ifFalse: [ ^ aBlock value ]
%
category: 'Removing'
method: RcIdentityBag
removeAll: aCollection

"Removes one occurrence of each element of aCollection from the receiver and
 returns the receiver.  Generates an error if any element of aCollection is not
 present in the receiver."

aCollection size == 0
  ifTrue: [ ^ self ].
self _removeAll: aCollection logging: true
%
category: 'Removing'
method: RcIdentityBag
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 the receiver."

aCollection == self
    ifTrue: [ aCollection asBag do: [ :obj | self removeIfPresent: obj ] ]
    ifFalse: [ aCollection do: [ :obj | self removeIfPresent: obj ] ]
%
category: 'Removing'
method: RcIdentityBag
removeIfPresent: anObject

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

(self _privateRemove: anObject logging: true)
    ifFalse: [ ^ nil ]
%
category: 'Accessing'
method: RcIdentityBag
size

"Returns the number of elements contained in the RcIdentityBag.  First checks
 the RC value cache, and if not there, calculate it."

| sz |
sz := System rcValueCacheAt: #size for: self otherwise: nil.
sz == nil
    ifTrue: [ sz := self _calculateSize ].
^ sz
%
category: 'Sorting'
method: RcIdentityBag
sortAscending: aSortSpec

"Returns an Array containing the elements of the receiver, sorted in ascending
 order, as determined by the values of the instance variables represented by
 aSortSpec."

| bag result |
" install an exception to make sure the cached Bag's index list is made nil "
Exception
    category: nil
    number: nil
    do: [ :ex :cat :num :args |
        bag _indexedPaths: nil.
        ex resignal: cat number: num args: args
    ].
" get the cached Bag "
bag := self _asIdentityBag.
" let the cached Bag take advantage of indexes if they exist "
bag _indexedPaths: self _indexedPaths.
" now do the sort "
result := bag sortAscending: aSortSpec.
" reset the cached Bag's index list "
bag _indexedPaths: nil.
^ result
%
category: 'Sorting'
method: RcIdentityBag
sortDescending: aSortSpec

"Returns an Array containing the elements of the receiver, sorted in descending
 order, as determined by the values of the instance variables represented by
 aSortSpec."

| bag result |
" install an exception to make sure the cached Bag's index list is made nil "
Exception
    category: nil
    number: nil
    do: [ :ex :cat :num :args |
        bag _indexedPaths: nil.
        ex resignal: cat number: num args: args
    ].
" get the cached Bag "
bag := self _asIdentityBag.
" let the cached Bag take advantage of indexes if they exist "
bag _indexedPaths: self _indexedPaths.
" now do the sort "
result := bag sortDescending: aSortSpec.
" reset the cached Bag's index list "
bag _indexedPaths: nil.
^ result
%
category: 'Sorting'
method: RcIdentityBag
sortWith: aSortPairArray

"Returns an Array containing the elements of the receiver, sorted according to
 the contents of aSortPairArray."

| bag result |
" install an exception to make sure the cached Bag's index list is made nil "
Exception
    category: nil
    number: nil
    do: [ :ex :cat :num :args |
        bag _indexedPaths: nil.
        ex resignal: cat number: num args: args
    ].
" get the cached Bag "
bag := self _asIdentityBag.
" let the cached Bag take advantage of indexes if they exist "
bag _indexedPaths: self _indexedPaths.
" now do the sort "
result := bag sortWith: aSortPairArray.
" reset the cached Bag's index list "
bag _indexedPaths: nil.
^ result
%
category: 'Searching'
method: RcIdentityBag
speciesForCollect

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

^ RcIdentityBag
%
category: 'Query Support'
method: RcIdentityBag
speciesForSelect

"Returns the class to use to select and reject queries."

^ IdentityBag
%
category: 'Adding'
method: RcIdentityBag
_add: newObject logging: aBoolean

"Adds newObject to the current session's addition Bag in the RcIdentityBag.  If
 aBoolean is true, logs the addition to the redo log.  Returns the receiver."

| bag sz addIndex result |
" update any indexes if necessary "
newObject == nil ifTrue:[ ^ self ].
_indexedPaths ~~ nil
  ifTrue: [
    result := self _updateIndexesForAdditionOf: newObject logging: aBoolean.
    " if result is not true, it is an Array containing error information "
    result == true
      ifFalse: [ ^ self _raiseIndexingError: result ]
  ].

" add the new object to the current session's addition Bag "
addIndex := self _thisSessionAdditionIndex.
System _addRootObjectToRcReadSet: self.
bag := components _rcAt: addIndex.
bag == nil
    ifTrue: [ bag := self _createComponentBagsFor: addIndex ].

bag add: newObject.
System _addEntireObjectToRcReadSet: bag.
" put components -> RcIdentityBag in conflictObjects dictionary so that
  we can resolve conflict if there is W-W conflict "
System redoLog addConflictObject: components for: self.

aBoolean
  ifTrue: [
    self _logAdditionOf: newObject.
  ].

" apply any removals that have occurred "
self _processRemovalBagFor: self _thisSessionAdditionIndex logging: aBoolean.

aBoolean ifFalse: [ ^ true ].

" if the receiver's asBag has been cached, update the cache "
bag := System rcValueCacheAt: #asBag for: self otherwise: nil.
bag == nil
    ifFalse: [ bag add: newObject ].

sz := System rcValueCacheAt: #size for: self otherwise: nil.
sz == nil
    ifFalse: [ System rcValueCacheAt: #size put: (sz + 1) for: self ].

^ true
%

! for 34436 , changed comments to match behavio
category: 'Adding'
method: RcIdentityBag
_addAll: aCollection logging: aBoolean

"Adds the collection of objects to the current session's addition Bag.  If
 aBoolean is true, logs the addition to the redo log.  
 Returns true if successful .
 Note that aCollection is always an Array copy of the original collection that
 was used in RcIdentityBag>>addAll: ."

| bag sz addIndex myConstraint obj result |

" update any indexes if necessary "
_indexedPaths ~~ nil
  ifTrue: [
    1 to: aCollection size do: [ :i |
      result := self _updateIndexesForAdditionOf: (aCollection _at: i)
        logging: aBoolean.
      " if result is not true, it is an Array containing error information "
      result == true
        ifFalse: [ ^ self _raiseIndexingError: result ]
    ]
  ].

" add the new object to the current session's addition Bag "
addIndex := self _thisSessionAdditionIndex.
System _addRootObjectToRcReadSet: self.
bag := components _rcAt: addIndex.
bag == nil
  ifTrue: [ bag := self _createComponentBagsFor: addIndex ].

" see if we can determine validity by looking at elementKinds "
myConstraint := self class elementConstraint.
(aCollection class elementConstraint isSubclassOf: myConstraint)
  ifTrue: [ bag addAll: aCollection  ]
  ifFalse: [ " have to look at individual elements "
    1 to: aCollection size do: [ :i |
      obj := aCollection _at: i.
      ( (obj isKindOf: myConstraint) _or: [ obj == nil ] )
        ifTrue: [ bag add: obj ]
        ifFalse: [
          self _error: #objErrConstraintViolation
            args: #[ obj, myConstraint, obj class ]
        ]
    ]
  ].

System _addEntireObjectToRcReadSet: bag.

" put components -> RcIdentityBag in conflictObjects dictionary so that
we can resolve conflict if there is W-W conflict "
System redoLog addConflictObject: components for: self.
aBoolean ifTrue: [ self _logAddAllOf: aCollection ].

" apply any removals that have occurred "
self _processRemovalBagFor: self _thisSessionAdditionIndex logging: aBoolean.

aBoolean ifFalse: [ ^ true ].

" if the receiver's asBag has been cached, update the cache "
bag := System rcValueCacheAt: #asBag for: self otherwise: nil.
bag == nil
  ifFalse: [ bag addAll: aCollection ].

sz := System rcValueCacheAt: #size for: self otherwise: nil.
sz == nil
  ifFalse: [
    System rcValueCacheAt: #size put: (sz + aCollection size) for: self
  ].

^ true
%
category: 'Private'
method: RcIdentityBag
_asCollectionForSorting

"Returns an IdentityBag that can be used for sorting."

^ self _asIdentityBag
%
category: 'Converting'
method: RcIdentityBag
_asIdentityBag

"Returns a Bag that consists of objects in this RcIdentityBag.  First check the
 RC value cache and if not there, then create the Bag.  Note that each
 invocation of this message returns the same Bag."

| bag |
bag := System rcValueCacheAt: #asBag for: self otherwise: nil.
bag == nil
    ifTrue: [ bag := self _createAsBag ].
^ bag
%
category: 'Accessing'
method: RcIdentityBag
_at: offset

"Private."

^ self at: offset
%
category: 'Accessing'
method: RcIdentityBag
_basicSize

"Returns the logical size of the receiver."

^ self size
%
category: 'Accessing'
method: RcIdentityBag
_calculateSize

"Calculate the number of elements contained in the RcIdentityBag and place it in
 the RC value cache.  Returns the size."

| sz addBag removeBag |
sz := 0.
System _addRootObjectToRcReadSet: self.
System _addEntireObjectToRcReadSet: components.
1 to: components size by: 2 do: [ :i |
    (addBag := components at: i) ~~ nil
        ifTrue: [
            removeBag := components at: i + 1.
            sz := sz + addBag size - removeBag size.
            System _addRootObjectToRcReadSet: addBag.
            System _addRootObjectToRcReadSet: removeBag
        ]
].
System rcValueCacheAt: #size put: sz for: self.
^ sz
%
category: 'Updating'
method: RcIdentityBag
_components: componentArray

""

components := componentArray
%
category: 'Converting'
method: RcIdentityBag
_createAsBag

"Creates a Bag that consists of objects that have been added minus the objects
 that have been removed, and place it in the RC value cache.  Returns the Bag."

| aBag |
" aBag := self class varyingConstraint new."
aBag := self speciesForSelect new.
System _addRootObjectToRcReadSet: self.
System _addEntireObjectToRcReadSet: components.
self _doSessionBags: [ :addBag :removeBag |
    removeBag isEmpty
        ifTrue: [
            System _addRootObjectToRcReadSet: removeBag.
            System _addEntireObjectToRcReadSet: addBag.
            aBag addAll: addBag
        ]
        ifFalse: [ aBag addAll: (addBag _rcDifference: removeBag) ].
].
System rcValueCacheAt: #asBag put: aBag for: self.
^ aBag
%
category: 'Private'
method: RcIdentityBag
_createComponentBagsFor: addIndex

"Create the additionBag and removalBag for the session whose components begin
 at the given addIndex.  Returns the additionBag."

| addBag remBag constraintClass |
constraintClass := self class _componentConstraint.

addBag := constraintClass new.
addBag assignToSegment: self segment.
components at: addIndex put: addBag.

remBag := constraintClass new.
remBag assignToSegment: self segment.
components at: addIndex + 1 put: remBag.

^ addBag
%
category: 'Private'
method: RcIdentityBag
_deferredGciUpdateWith: valueArray

"Private."

components == nil
  ifTrue: [ self initialize: 10 ].
1 to: valueArray size do:[:j |
  self add: (valueArray at: j)
  ].
%
category: 'Enumerating'
method: RcIdentityBag
_doSessionBags: aBlock

"Enumerate over all session components, executing aBlock with the current
 session's addition Bag and removal Bag as arguments."

| addBag |
1 to: components size by: 2 do: [ :i |
    (addBag := components at: i) ~~ nil
        ifTrue: [ aBlock value: addBag value: (components at: i + 1) ]
]
%
category: 'Private'
method: RcIdentityBag
_gbsTraversalCallback
  "Needed for initial mapping case. See bug 31058."
  ^'RcIdentityBag>>_gbsTraversalCallback: This string should be ignored on the client.'
%
category: 'Instance Initialization'
method: RcIdentityBag
_gciInitialize

"Private."

components == nil
  ifTrue: [ self initialize: 10 ].
%
category: 'Support'
method: RcIdentityBag
_getInactiveSessionIndexes

"Returns a set of integer indexes into the RcIdentityBag session components for
 sessions that are not active.  The current session nor the global session
 components are considered active."

| allSessions rcBagSize |
rcBagSize := components size.
allSessions := IdentitySet new.
3 to: rcBagSize by: 2 do: [ :i | allSessions add: i ].

" get the current sessions and calculate the index "
System currentSessions do: [ :id | | index |
    index := self _indexForSessionId: id.
    (index <= rcBagSize) ifTrue: [ allSessions remove: index ]
].

^ allSessions
%
category: 'Private'
method: RcIdentityBag
_globalAddBag

"Returns the global addition Bag for the receiver.  Create one if it does not
 exist."

| globalAddBag |
System _addRootObjectToRcReadSet: self.
globalAddBag := components _rcAt: 1.
globalAddBag == nil
    ifTrue: [ globalAddBag := self _createComponentBagsFor: 1 ].
^ globalAddBag
%
category: 'Private'
method: RcIdentityBag
_indexForSessionId: id

"Returns the index of the given session ID's addition Bag."

| index |
id _validateClass: SmallInteger.
id < 0 ifTrue: [ ^ self _errorIndexOutOfRange: id ].
index := (2 * id) + 1.
index > components size
    ifTrue: [ components size: index + 1 ].
^ index
%
category: 'Testing'
method: RcIdentityBag
_isRcIdentityBag

"Returns true; the receiver is an RcIdentityBag."

^ true
%
category: 'Locking Support'
method: RcIdentityBag
_lockableValues

"Returns a kind of object usable as an argument to _lockAll: primitives."

^ self _asIdentityBag
%
category: 'Adding'
method: RcIdentityBag
_logAddAllOf: aCollection

"Creates a log entry for adding all of the given collection."

| logEntry |
logEntry := LogEntry new.
logEntry receiver: self;
    selector: #_addAll:logging:;
    argArray: #[ aCollection, false ].
System redoLog addLogEntry: logEntry
%
category: 'Adding'
method: RcIdentityBag
_logAdditionOf: anObject

"Create a log entry for adding the given object."

| logEntry |
logEntry := LogEntry new.
logEntry receiver: self;
    selector: #_add:logging:;
    argArray: #[ anObject, false ].
System redoLog addLogEntry: logEntry
%
category: 'Removing'
method: RcIdentityBag
_logRemovalOf: anObject inRemovalBag: aRemovalBag

"Creates a log entry for removing the given object.  The removal Bag is the
 object on which a conflict may occur.  Returns the receiver."

| logEntry |
logEntry := LogEntry new.
logEntry receiver: self;
    selector: #_privateRemove:logging:;
    argArray: #[ anObject, false ].
System redoLog addLogEntry: logEntry forConflictObject: aRemovalBag
%
category: 'Removing'
method: RcIdentityBag
_logRemoveAllOf: aCollection

"Creates a log entry for removing all of the given collection."

| logEntry |
logEntry := LogEntry new.
logEntry receiver: self;
    selector: #_removeAll:logging:;
    argArray: #[ aCollection, false ].
System redoLog addLogEntry: logEntry
%
category: 'Removing'
method: RcIdentityBag
_privateRemove: anObject fromRemovalBag: removalBag logging: aBoolean

"Adds anObject to the given removal Bag, performing any logging and updating
 the caches if necessary."

<primitive: 901>
| bag sz |

" update any indexes if necessary "
_indexedPaths ~~ nil
    ifTrue: [ self _updateIndexesForRemovalOf: anObject ].

" log the removal "
aBoolean
    ifTrue: [ self _logRemovalOf: anObject inRemovalBag: removalBag ].

" add it to the current session's removal Bag "
removalBag add: anObject.

aBoolean
    ifFalse: [
        System _disableProtectedMode.
        ^ self
    ].

" if the receiver's asBag has been cached, update the cache "
bag := System rcValueCacheAt: #asBag for: self otherwise: nil.
bag == nil
    ifFalse: [ bag remove: anObject ifAbsent: [ System clearRcValueCache ] ].

sz := System rcValueCacheAt: #size for: self otherwise: nil.
sz == nil
    ifFalse: [ System rcValueCacheAt: #size put: (sz - 1) for: self ].

System _disableProtectedMode.
%
category: 'Removing'
method: RcIdentityBag
_privateRemove: anObject logging: aBoolean

"Returns true if the object was removed; false if the object was not present."

| myAddBag myRemoveBag |
System _addRootObjectToRcReadSet: self.
myAddBag := components _rcAt: self _thisSessionAdditionIndex.
myRemoveBag := components _rcAt: self _thisSessionRemovalIndex.

" put components -> RcIdentityBag in conflictObjects dictionary so that
we can resolve conflict if there is W-W conflict "
System redoLog addConflictObject: components for: self.

" first see if the object is in the current session's addition Bag "
( myAddBag ~~ nil _and:
[ (myAddBag _rcIncludes: anObject) _and:
[ (myAddBag occurrencesOf: anObject) >
  (myRemoveBag _rcOccurrencesOf: anObject) ] ] )
    ifTrue: [
        self _privateRemove: anObject fromRemovalBag: myRemoveBag logging: aBoolean.
        " now process any removals on the addition Bag "
        self _processRemovalBagFor: self _thisSessionAdditionIndex logging: aBoolean.
        ^ true
    ]
    ifFalse: [
        " check other sessions' addition Bags "
        self _doSessionBags: [ :addBag :removeBag |
            " if more have been added than removed ... "
            ((addBag _rcIncludes: anObject) _and:
            [ (addBag occurrencesOf: anObject) >
              (removeBag _rcOccurrencesOf: anObject) ] )
                ifTrue: [
                    self _privateRemove: anObject fromRemovalBag: removeBag logging: aBoolean.
                    ^ true
                ]
        ]
    ].
^ false
%
category: 'Removing'
method: RcIdentityBag
_processRemovalBagFor: sessionId logging: aBoolean

"Apply any removals that were performed on the removal Bag of the given
 session.  Returns the receiver."

| additionBag removalBag |
additionBag := components at: sessionId.
additionBag == nil
    ifTrue: [ ^ self ].

removalBag := components at: sessionId + 1.

removalBag isEmpty
    ifTrue: [
        System _addRootObjectToRcReadSet: removalBag.
        ^ self
    ].

System _addEntireObjectToRcReadSet: additionBag.
System _addEntireObjectToRcReadSet: removalBag.

" put removalBag -> RcIdentityBag in conflictObjects dictionary so that
we can resolve conflict if there is W-W conflict "
System redoLog addConflictObject: removalBag for: self.

additionBag _removeAll: removalBag errIfAbsent: false.
removalBag _removeAll: removalBag errIfAbsent: false.
%
category: 'Removing'
method: RcIdentityBag
_removeAll: aCollection logging: boolean

"Removes one occurrence of each element of aCollection from the receiver and
 returns the receiver.  Generates an error if any element of aCollection is not
 present in the receiver."

| array bag sz |
array := Array new addAll: aCollection; yourself.
1 to: array size do: [ :i |
  " this will not update rcValueCache since logging is false "
  (self _privateRemove: (array at: i) logging: false)
    ifFalse: [ ^ false ]
].

boolean
  ifFalse: [ ^ true ].

" put removeBags in the conflicts dictionary "
self _doSessionBags: [ :addBag :removeBag |
  System redoLog addConflictObject: removeBag for: self.
].

self _logRemoveAllOf: array.

" if the receiver's asBag has been cached, update the cache "
bag := System rcValueCacheAt: #asBag for: self otherwise: nil.
bag == nil
  ifFalse: [ bag removeAll: aCollection ].

sz := System rcValueCacheAt: #size for: self otherwise: nil.
sz == nil
  ifFalse: [
    System rcValueCacheAt: #size put: (sz - array size) for: self
  ].
^ true
%
category: 'Support'
method: RcIdentityBag
_removeAny: numberToRemove from: aBag

"Remove any numberToRemove elements from the given Bag.  Returns the elements
 that are removed."

| removed |
removed := IdentityBag new.
1 to: numberToRemove do: [ :i | removed add: (aBag _at: i) ].
1 to: removed size do: [ :i | aBag remove: (removed at: i) ].
^ removed
%
category: 'Private'
method: RcIdentityBag
_resolveRcConflictsWith: conflictObjects

"A logical write-write conflict has occurred on the receiver.  The objects that
 had the actual physical write-write conflicts are in the conflictObjects
 Array.  Returns whether the conflicts could be successfully resolved."

| myAddBag myRemoveBag addIndex |

" If no objects experienced physical conflict, then just returns "
conflictObjects isEmpty
    ifTrue: [ ^ true ].

" if only had a physical conflict on the root "
( conflictObjects size == 1 _and: [ (conflictObjects at: 1) == self ] )
    ifTrue: [
        System _addRootObjectToRcReadSet: self.
        " keep reference to this session's components "
        addIndex := self _thisSessionAdditionIndex.
        myAddBag := components _rcAt: addIndex.
        myRemoveBag := components _rcAt: addIndex + 1.

        " only abort the root "
        super _selectiveAbort.

        " get index again to grow the root if necessary "
        addIndex := self _thisSessionAdditionIndex.
        " now re-insert the addition and removal Bags "
        components at: addIndex put: myAddBag.
        components at: addIndex + 1 put: myRemoveBag.

        ^ true
    ].

" if an index is present, we currently cannot resolve conflicts "
_indexedPaths ~~ nil
  ifTrue: [ ^ false ].

" otherwise, selectively abort entire RcIdentityBag and replay the operations "
^ self _abortAndReplay: conflictObjects
%
category: 'Private'
method: RcIdentityBag
_selectiveAbort

"In addition to aborting the RcIdentityBag, selectively abort the session
 components.  Returns the receiver."

" if there is an index, do not selectively abort "
_indexedPaths ~~ nil
  ifTrue: [ ^ self ].
super _selectiveAbort.
components _selectiveAbort.
self _doSessionBags: [ :addBag :removeBag |
    addBag _selectiveAbort.
    removeBag _selectiveAbort
]
%
category: 'Private'
method: RcIdentityBag
_thisSessionAdditionIndex

"Returns the index of the current session addition Bag."

^ self _indexForSessionId: System session
%
category: 'Private'
method: RcIdentityBag
_thisSessionRemovalIndex

"Returns the index of the current session removal Bag."

^ self _thisSessionAdditionIndex + 1
%
category: 'Private'
method: RcIdentityBag
_validateRcConflictsWith: conflictObjects
  
"If the only conflict on this object is for the root, then we return true.
 Otherwise return false (to fail the transaction) if the redo log contains
 the selector _privateRemove:logging: since we cannot guarantee success
 if the transaction did a removal from the RcIdentityBag."

" if only had a physical conflict on the root "
( conflictObjects size == 1 _and: [ (conflictObjects at: 1) == self ] )
  ifTrue: [ ^ true ].

^ self _checkLogEntriesForNoSelector: #_privateRemove:logging:
%

category: 'Updating'
method: RcIdentityBag
changeToSegment: segment

"Assigns the receiver and its subcomponents to the given segment."

self assignToSegment: segment.
components assignToSegment: segment.

1 to: components size do: [ :i |
  (components at: i) ~~ nil
    ifTrue: [ (components at: i) assignToSegment: segment ]
]
%

