!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: deplisttable.gs,v 1.15 2008-01-09 22:50:10 stever Exp $
!
! Superclass Hierarchy:
!   DepListTable, Collection, Object.
!
! class created in idxclasses.topaz
!=========================================================================

removeallmethods DepListTable
removeallclassmethods DepListTable

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

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

txt := (GsDocText new) details:
'A DepListTable is used to hold a global collection of DependencyLists that
 are shared by multiple objects.' .
doc documentClassWith: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: DepListTable
new: size

"Returns a DepListTable with the given size."

| newOne |
newOne := (super new: size) initialize.
^ newOne
%

category: 'Repository Conversion'
method: DepListTable
reinitialize

"Reinitializes a given DepListTable.  This method is to be used only during
 conversion."

self initialize.
%

category: 'Instance Creation'
classmethod: DepListTable
new

"Returns a DepListTable with the default table size."

| newOne |
newOne := self new: 751.
^ newOne
%

! ------------------- Instance methods for DepListTable
category: 'Initialization'
method: DepListTable
initialize

"Initializes a new instance."

| constraintClass |
constraintClass := self class varyingConstraint.
1 to: self _basicSize do: [ :i |
  self at: i put: constraintClass new
].

"No need to use obsoletePathTerms set with strong dependency list references
obsoletePathTerms := IdentitySet new.
"
self changeToSegment: GsIndexingSegment.
%

category: 'Updating'
method: DepListTable
_add: depList

"Replay the addition of the given dependency list to the receiver.
 If there is already an equivalent dependency list in the receiver,
 replace all references to the given dependency list with a reference
 to the dependency list in the table."

| dl bkt |
bkt := self depListBucketFor: depList.
dl := bkt at: depList.

dl == depList
  ifFalse: [ " must replace references "
    depList _replaceReferencesWith: dl
  ].
System redoLog addLargeConflictObject: bkt for: self.
^ true
%

category: 'Updating'
method: DepListTable
remove: depList logging: aBoolean

"Replays the removal of the given dependency list in the receiver.
 Returns whether the removal occurred."

| bkt result |

bkt := self depListBucketFor: depList.
result := bkt remove: depList.

result
  ifTrue: [ 
    aBoolean ifTrue: [ self _logRemovalOf: depList inCollisionBucket: bkt  ].
    System redoLog addLargeConflictObject: bkt for: self.
  ].

^ result
%

category: 'Private'
method: DepListTable
_logAdditionOf: depList inCollisionBucket: collisionBkt

"Logs the addition of the given dependency list in the system redo log."

| logEntry |

logEntry := LogEntry new.
logEntry receiver: self;
    selector: #_add:;
    argArray: #[ depList ].
System redoLog addLogEntry: logEntry
%

category: 'Private'
method: DepListTable
_logRemovalOf: depList inCollisionBucket: collisionBkt

"Logs the removal of the given dependency list in the system redo log."

| logEntry |

logEntry := LogEntry new.
logEntry receiver: self;
  selector: #remove:logging:;
  argArray: #[ depList, false ].
System redoLog addLogEntry: logEntry
%

category: 'Updating'
method: DepListTable
at: depList logging: aBoolean

"Returns the dependency list in the receiver that is equivalent to the
 given dependency list.  If one does not exist, add the given dependency
 list to the receiver and returns the given dependency list.  If the
 collision bucket is updated and aBoolean is true, log the operation
 in the system redo log."

| dl bkt |
( depList == nil _or: [ depList isEmpty ] )
  ifTrue: [ ^ nil ].

bkt := self depListBucketFor: depList.
dl := bkt at: depList.

dl == depList
  ifTrue: [ " new entry was added "
    aBoolean
      ifTrue: [ self _logAdditionOf: depList inCollisionBucket: bkt ].
    depList assignToSegment: self segment.
  ].
System redoLog addLargeConflictObject: bkt for: self.

^ dl
%

category: 'Updating'
method: DepListTable
removeEntriesContaining: arrayOfPathTerms

"Remove all dependency lists from the receiver that have any of the
 path terms contained in the arrayOfPathTerms."

| bkt depLists depList |

depLists := Array new.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.

  depLists size: 0.
  " build Array of dependency lists to remove "
  1 to: bkt size do: [ :j |
    depList := bkt _at: j.
    (depList containsAnyOf: arrayOfPathTerms)
      ifTrue: [ depLists add: depList ]
  ].

  1 to: depLists size do: [ :j |
    depList := depLists at: j.
    (self remove: depList logging: true)
    "  continue policy of not raising an error during index removal "
    "  ifFalse: [ self _error: #rtErrKeyNotFound args: #[ depList ] ] ".

    " resize dependency list to avoid object audit errors "
    depList size: 0.
  ].
  bkt resizeIfNecessary.
].

" avoid object audit errors "
arrayOfPathTerms size: 0.
%

category: 'Accessing'
method: DepListTable
size

"Returns the number of entries in the receiver."

| num collisionBkt systm |
num := 0.
systm := System .
systm _addEntireObjectToRcReadSet: self.
1 to: self _basicSize do: [ :i |
    collisionBkt := self _at: i.
    systm _addRootObjectToRcReadSet: collisionBkt.
    num := num + collisionBkt size
].
^ num
%

category: 'Accessing'
method: DepListTable
depListBucketFor: depList

"Returns the bucket where the given depList would be found."

<primitive: 524>
self _primitiveFailed: #depListBucketFor: .
self _uncontinuableError
%

category: 'Statistics'
method: DepListTable
statistics

"Returns a Dictionary containing statistics that can be useful in determining
 the performance of the dependency list table."

| bkt dict bktCnt maxBkt sizes cntDict sz total str phySize |
cntDict := KeyValueDictionary new.
dict := SymbolDictionary new.
maxBkt := self _at: 1.
bktCnt := 0.
sizes := 0.
phySize := self physicalSize.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.

  sz := bkt size.
  sz > 0
    ifTrue: [

      total := cntDict at: sz ifAbsent: [ cntDict at: sz put: 0 ].
      cntDict at: sz put: total + 1.

      bktCnt := bktCnt + 1.
      sizes := sizes + sz.
      " check for max bucket "
      sz > maxBkt size
        ifTrue: [ maxBkt := bkt ].
    ].
  phySize := phySize + bkt physicalSize.
].
dict at: #RootSize put: self _basicSize.
dict at: #TotalBuckets put: bktCnt.
dict at: #LargestBucketSize put: maxBkt size.
dict at: #PhysicalSize put: phySize.

bktCnt > 0
  ifTrue: [ dict at: #AvgEntriesPerBucket put: (sizes // bktCnt) ]
  ifFalse: [ dict at: #AvgEntriesPerBucket put: 0 ].

str := String new.
(cntDict keys sortAscending: #'') do: [ :i |
  str add: i asString; add: ' -> ';
    add: (cntDict at: i) asString; add: Character lf
].
dict at: #Histogram put: str.

^ dict
%

category: 'Adding'
method: DepListTable
add: newObject

""
self shouldNotImplement: #add:
%

category: 'Private'
method: DepListTable
_selectiveAbort

"Abort the collision buckets."

super _selectiveAbort.
1 to: self _basicSize do: [ :i | (self _at: i) _selectiveAbort ]
%

category: 'Enumerating'
method: DepListTable
do: aBlock

"For each dependency list in the receiver, evaluates the one-argument block
 aBlock with the dependency list as the argument."

aBlock _validateClass: BlockClosure.
1 to: self _basicSize do: [ :i |
  (self _at: i) do: aBlock
]
%

category: 'Accessing'
method: DepListTable
allEntries

"Returns an IdentitySet containing the receiver's entries."

| entries bkt |
entries := IdentitySet new.
System _addEntireObjectToRcReadSet: self.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.
  1 to: bkt size do: [ :j |
    entries add: (bkt _at: j).
  ]
].
^ entries
%

category: 'Private'
method: DepListTable
_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.  Selectively abort the receiver and then attempt to replay the
 operations maintained in the System redo log.  Returns true if all the
 operations could be replayed; otherwise returns false."

| result |
result := self _abortAndReplay: conflictObjects.
^ result
%

category: 'Clustering'
method: DepListTable
clusterDepthFirst

"This method clusters the receiver.  Returns true if the receiver has
 already been clustered during the current transaction; returns false
 otherwise."

| result |
self cluster
  ifTrue: [ result := true ]
  ifFalse: [
    " obsoletePathTerms cluster. "
    1 to: self _basicSize do: [ :i | (self _at: i) cluster ].
    result := false
  ].
^ result
%

category: 'Hashing'
method: DepListTable
rebuildTable: newSize

"Rebuilds the table by saving the current state, initializing and changing
 the size of the table, and adding the entries saved back to the table.
 This method is intended to be used by the system administrator when the
 table has become too large.  If it is invoked directly by an application,
 concurrency conflicts may result."

| depLists origSize constraintClass |
(newSize <= 0)
  ifTrue: [
    newSize _error: #rtErrArgNotPositive .
    ^ self
  ].

" get all entries "
depLists := self allEntries.

origSize := self _basicSize.
" reset each bucket to be empty "
1 to: origSize do: [ :i | (self _at: i) reset ].

super size: newSize.

newSize > origSize
  ifTrue: [ " growing the table "
    constraintClass := self class varyingConstraint.
    (origSize + 1) to: newSize do: [ :i |
      super at: i put: constraintClass new
    ]
  ].

" now add the entries back to the table "
1 to: depLists size do: [ :i |
  self at: (depLists _at: i) logging: false
].

self changeToSegment: GsIndexingSegment.
%

category: 'Updating'
method: DepListTable
addObsoletePathTerm: aPathTerm

"Adds the given path term to the set of obsolete path terms."

" obsoletePathTerms add: aPathTerm "
%

category: 'Printing'
method: DepListTable
printOn: aStream

"Prints a string representation of the receiver on the given stream."

aStream nextPutAll: 'SharedDependencyLists'
%

category: 'Updating'
method: DepListTable
removeEntriesContainingTracker: aTracker

"Find each dependency list in the receiver that contains a tracker,
 and remove it from the receiver.  Return an Array of dependency lists
 that were removed."

| bkt depLists depList tmpList |

depLists := Array new.
tmpList := Array new.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.

  tmpList size: 0.
  " build Array of dependency lists to remove "
  1 to: bkt size do: [ :j |
    depList := bkt _at: j.
    (depList includesIdentical: aTracker)
      ifTrue: [ tmpList add: depList ]
  ].

  tmpList isEmpty
    ifFalse: [
      1 to: tmpList size do: [ :j |
        (self remove: (tmpList at: j) logging: true)
          ifFalse: [ self _error: #rtErrKeyNotFound args: #[ depList ] ].
      ]
    ].

  depLists addAll: tmpList.
].

^ depLists
%

category: 'Updating'
method: DepListTable
_removeAllTrackingOf: aTracker

"Remove the receiver from all dependency lists.  The receiver will
 no longer be notified when objects are modified, and may become
 eligible for garbage collection."

| entries depList |
entries := self removeEntriesContainingTracker: aTracker.
1 to: entries size do: [ :i |
  depList := entries at: i.
  depList _removeCompletelyPathTerm: aTracker.
  self at: depList logging: false.
].
%

category: 'Audit'
method: DepListTable
_auditEntries

"Check that all dependency lists are in their buckets in the right order."

| bkt str depList prevDepList lf |
lf := Character lf.
str := String new.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.
  bkt size > 1
    ifTrue: [
      prevDepList := bkt _at: 1.
      2 to: bkt size do: [ :j |
        depList := bkt _at: j.
        depList < prevDepList
          ifTrue: [
            str add: 'In bucket at offset '; add: i asString;
              add: ' depList at: '; add: j asString;
              add: ' is out of order'; add: lf
          ].
        prevDepList := depList.
      ]
  ]
].
str size == 0
  ifTrue: [ ^ 'SharedDependencyLists are ok' ].
^ str
%

category: 'Auditing'
method: DepListTable
_resortEntriesLogging: aString

"Resort all entries in the receiver that need it.  Append a record of
what was done on the given string."

| cnt depList bkt needsSorting empties zeros |
cnt := 0.
zeros := 0.
needsSorting := Array new.
empties := Array new.
1 to: self _basicSize do: [ :i |
  bkt := self _at: i.
  needsSorting size: 0.
  empties size: 0.
  " find entries that need sorting "
  1 to: bkt size do: [ :j |
    (depList := bkt _at: j) size == 0
      ifTrue: [ empties add: depList ]
      ifFalse: [
        depList _needsSorting
          ifTrue: [ needsSorting add: depList ].
      ]
  ].

  zeros := zeros + empties size.
  " remove empty dependency lists "
  1 to: empties size do: [ :j | bkt remove: (empties _at: j) ].

  cnt := cnt + needsSorting size.
  " remove, resort, then reinsert them "
  1 to: needsSorting size do: [ :j | (needsSorting _at: j) _sortEntries: bkt ].
].

zeros > 0
  ifTrue: [
    aString add: zeros asString; add: ' dependency list(s) were empty.';
      add: Character lf.
  ].

cnt > 0
  ifTrue: [
    aString add: cnt asString;
      add: ' dependency list(s) needed their entries sorted.';
      add: Character lf.
  ].
^ aString
%

category: 'Auditing'
method: DepListTable
findNscsWithIndexes

"Return any indexed NSCs we can find."

| nscs |
nscs := IdentitySet new.
self allEntries do: [ :dl | | pt |
  1 to: dl size by: 2 do: [ :i |
    pt := dl at: i.
    pt size > 0
      ifTrue: [ nscs add: pt getRootNsc ]
  ]
].
^ nscs
%

category: 'Auditing'
method: DepListTable
_repairOutOfOrderBucketsLogging: aString

"Repair any collision buckets that have dependency lists out of order."

| bkt depList ooBkts cnt copy |
ooBkts := Array new.
" first pass, find buckets that need rebuilding "
1 to: self _basicSize do: [ :i |
  (bkt := self _at: i) _hasEntryOutOfOrder
    ifTrue: [ ooBkts add: bkt ]
].
ooBkts size > 0
  ifTrue: [
    aString add: 'Found '; add: ooBkts size asString;
      add: ' bucket(s) that contained entries out of order.'; add: Character lf.

    " second pass, make copies and reset buckets "
    1 to: ooBkts size do: [ :i |
      copy := (bkt := ooBkts at: i) copy.
      bkt reset.
      ooBkts at: i put: copy.
    ].
    " third pass, re-insert entries "
    cnt := 0.
    1 to: ooBkts size do: [ :i |
      bkt := ooBkts at: i.
      1 to: bkt size do: [ :j |
        depList := bkt _at: j.
        (self at: depList logging: false) == depList
          ifFalse: [ cnt := cnt + 1 ]
      ]
    ].
    cnt > 0
      ifTrue: [
        aString add: 'Re-insertion found '; add: cnt asString;
          add: ' equivalent dependency list(s)'; add: Character lf.
      ]
  ].
^ aString
%

category: 'Auditing'
method: DepListTable
_auditAndRepair: aBool

"Search for any dependency lists or collision buckets that have
entries out of order, and repair them.  Perform any repairs needed
and return a string describing the repairs."

| aString nscs |
aString := String new.
self _resortEntriesLogging: aString.
self _repairOutOfOrderBucketsLogging: aString.
aBool
  ifTrue: [
    nscs := self findNscsWithIndexes.
    1 to: nscs size do: [ :i |
      (nscs at: i) _auditAndRepairDepListsLogging: aString
    ]
].
aString size == 0
  ifTrue: [ ^ 'SharedDependencyLists ok' ]
  ifFalse: [
    ^ 'Audit and repair of SharedDependencyLists:
' + aString
  ]
%

unprotectmethods

category: 'Updating'
method: DepListTable
_buildWeakRefSet

"Put each dependency list in the weak references set."

| systm |
systm := System .
1 to: self _basicSize do: [ :i | | bkt |
  bkt := self _at: i.
  1 to: bkt size do: [ :j |
    systm _add: (bkt _at: j) to: 35.
  ]
].
%

category: 'Auditing'
method: DepListTable
auditAndRepair

"Search for any dependency lists or collision buckets that have
entries out of order, and repair them.  Get all dependency
lists by directly enumerating through all dependency lists in the
SharedDependencyLists table.  This method only touches internal
indexing objects, not application objects.  Perform any repairs
needed and return a string describing the repairs."

^ self _auditAndRepair: false
%

category: 'Auditing'
method: DepListTable
fullAuditAndRepair

"Search for any dependency lists or collision buckets that have
entries out of order, and repair them.  Get all dependency
lists by finding all nsc's with indexes that we can, and iterate through
application objects, traversing down each index. path.  This
method performs a superset of the functionality of 'auditAndRepair'.
This can take much more time than 'auditAndRepair', due to the
number of objects fetched.  Perform any repairs needed and return
a string describing the repairs."

^ self _auditAndRepair: true
%

category: 'Updating'
method: DepListTable
changeToSegment: aSegment

"Place the receiver and its collision buckets in the given segment."

1 to: self _basicSize do: [ :i |
  (self _at: i) assignToSegment: aSegment
].
super changeToSegment: aSegment

%

