!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: SortBlockNode.gs,v 1.7 2008-01-09 22:50:07 stever Exp $
!
! Superclass Hierarchy:
!   SortBlockNode, 
!   BtreeLeafNode, BtreeNode, Array, SequenceableCollection, Collection,
!   Object.
!
!=========================================================================

expectvalue %String
run
| oldCls newCls |
oldCls := Globals at:#SortBlockNode otherwise: nil .
oldCls == nil ifTrue:[
  BtreeLeafNode _newKernelSubclass: 'SortBlockNode'
    instVarNames: #( #blockSorter #totalElements)
    classVars: #()
    classInstVars: #()
    poolDictionaries: #()
    inDictionary: Globals
    constraints: #()
    instancesInvariant: false
    isModifiable: false
    reservedOop: nil.
  newCls := (Globals at:#SortBlockNode) .
  ^ 'created new class: ' + newCls definition
  ]
ifFalse:[
  ^ 'existing class: ' + oldCls definition
  ]
%

! Remove existing behavior from SortBlockNode

removeallmethods SortBlockNode
removeallclassmethods SortBlockNode

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

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

txt := (GsDocText new) details:
'SortBlockNode is a concrete class that along with the class BlockSorter implements the 
 behavior used to sort collections efficiently. It is an interface to an algorithm based 
 on an efficient merge-sort.'.
doc documentClassWith: txt.

self description: doc.
%

! ------------------- Class methods for SortBlockNode
category: 'Constants'
classmethod: SortBlockNode
initialNumberOfElements

"Returns the number of entries that are allocated when a node is created."
^ 100
%
category: 'Instance Creation'
classmethod: SortBlockNode
new

"Returns a new initialized instance with the correct size."

| newOne |
newOne := self basicNew: (self entrySize * self initialNumberOfElements).
newOne numElements: 0.
newOne totalElements: 0.
^ newOne

%
category: 'Instance Creation'
classmethod: SortBlockNode
new: size

"Returns a new initialized instance with the correct size."

| newOne |
newOne := self basicNew: self entrySize * (size min: self maxNumberOfElements).
newOne numElements: 0.
newOne totalElements: 0.
^ newOne
%
category: 'Sorting Support'
classmethod: SortBlockNode
recalculateSelectionTree: sortNodeArray for: node offsets: offsets

"Recalculate the selection tree based on a change of the minimum entry
 in the given node."

| parent lChild rChild offset1 offset2 newOffset i j currNode |
currNode := node.

[ true ] whileTrue: [
    " get the parent of the node that has changed "
    parent := currNode at: 2.

    lChild := parent at: 3.
    rChild := parent at: 4.
    " get the offset in the receiver of the corresponding run "
    offset1 := lChild at: 1.
    offset2 := rChild at: 1.

    " check if either of the runs are now empty "
    i := offsets at: offset1.
    j := offsets at: offset2.
    i == nil
        ifTrue: [ newOffset := offset2 ]
        ifFalse: [
             j == nil
                 ifTrue: [ newOffset := offset1 ]
                 ifFalse: [
                     ( (sortNodeArray at: offset1)
                         _compareEntryAt: i
                         lessThanNode: (sortNodeArray at: offset2)
                         entryAt: j
                         useValue: true)
                         ifTrue: [ newOffset := offset1 ]
                         ifFalse: [ newOffset := offset2 ]
                 ]
        ].
    parent at: 1 put: newOffset.

    " if no parent, then this is the root "
    (parent at: 2) == nil
        ifTrue: [ ^ self ].

    currNode := parent
]
%
! ------------------- Instance methods for SortBlockNode
category: 'Updating'
method: SortBlockNode
at: aKey put: aValue

"Adds the key/value pair to the node.  Sender must verify that the node is not
 full."

| index |
numElements == 0
  ifTrue: [ index := 1 ]
  ifFalse: [ index := self _binarySearchCoveringKey: aKey totalOrder: false ].

self _insertKey: aKey
  value: aValue
  atIndex: index.

totalElements := totalElements + 1
%
category: 'Accessing'
method: SortBlockNode
blockSorter

"Returns the value of the instance variable 'pathSorter'."

^blockSorter
%
category: 'Updating'
method: SortBlockNode
blockSorter: aBlockSorter

blockSorter := aBlockSorter
%
category: 'Constants'
method: SortBlockNode
entrySize

"Returns the size of an entry with no encryption."

^ 2
%
category: 'Testing'
method: SortBlockNode
isFull

"Returns if the node is full."

^ numElements == self class maxNumberOfElements
%
category: 'Sorting'
method: SortBlockNode
sortInto: anArray startingAt: index

"Insert the values of the receiver into the given Array starting at the
 given index in sorted order.  Returns the number inserted. "

| j obj snarray |
snarray := SortNodeArray.
        j := index.
        " for each value in the receiver ... "
        1 to: (numElements * self entrySize) by: self entrySize do: [ :i |
            " if it is an Array of nodes, then a merge sort is needed "
            (obj := self _at: i) _class == snarray
                ifTrue: [
                    obj sortInto: anArray startingAt: j.
                    j := j + obj totalElements
                ]
                ifFalse: [
                    anArray at: j put: obj.
                    j := j + 1
                ].
        ].
        ^ j - index
 
%
category: 'Accessing'
method: SortBlockNode
totalElements

"Returns the value of the instance variable 'totalElements'."

^totalElements
%
category: 'Updating'
method: SortBlockNode
totalElements: anInteger

totalElements := anInteger
%
category: 'Updating'
method: SortBlockNode
_at: aKey put: aValue forBtree: aBool 

"Adds the key/value pair to the node.  Sender must verify that the node is not
 full.  aBool should always be false."

^ self at: aKey put: aValue
%
category: 'Searching'
method: SortBlockNode
_binarySearchCoveringKey: aKey totalOrder: aBoolean 

"Returns the index for the first entry in which aKey is found utilizing a
 binary search.  This is the first entry whose key >= aKey."

| lowPt midPt highPt entrySize index |

entrySize := self entrySize.
lowPt := 1.
highPt := numElements.
[ lowPt <= highPt ] whileTrue: [
    midPt := (lowPt + highPt) quo: 2.
    index := midPt - 1 * entrySize + 2.

    (self _compareKey: aKey lessThanEntryAt: index)
        ifTrue: [ highPt := midPt - 1 ]
        ifFalse: [ lowPt := midPt + 1 ]
].

(self _compareKey: aKey lessThanEntryAt: index)
    ifFalse: [ ^ index + entrySize - 1 ].

^ index - 1
%
category: 'Comparison Operators'
method: SortBlockNode
_compareEntryAt: index1
lessThanNode: aNode
entryAt: index2
useValue: aBoolean

"Perform a < comparison between the entries at the given indexes.
 The default implementation uses no encryption."

| o1 o2 |
" first compare the keys "
(blockSorter sortBlock value: (o1 := self _at: index1)  value: (o2 := aNode _at: index2))
    ifTrue: [ ^ true ]
    ifFalse: [
        " if using the values and keys are equal, use the OOP of the value "
        ( (blockSorter sortBlock value: o2  value: o1) not)
            ifTrue: [
                ^ (self _at: index1 - 1) identityHash < (aNode _at: index2 - 1) identityHash
            ]
            ifFalse: [ ^ false ]
    ]
%
category: 'Comparison Operators'
method: SortBlockNode
_compareKey: aKey equalToEntryAt: index 

^((self _compareKey: aKey lessThanEntryAt: index) not 
  _and: [ (self _compareKey: aKey greaterThanEntryAt: index) not ])
%
category: 'Comparison Operators'
method: SortBlockNode
_compareKey: aKey greaterThanEntryAt: index

""

^ blockSorter sortBlock value: (self _at: index) value: aKey
%
category: 'Comparison Operators'
method: SortBlockNode
_compareKey: aKey lessThanEntryAt: index

""

^ blockSorter sortBlock value: aKey value: (self _at: index)
%
category: 'Updating'
method: SortBlockNode
_insertDuplicateKey: aKey value: aValue atIndex: insertionIndex

"The given key is already present in the receiver, so insert the entry
 in a secondary sort node (creating it if necessary)."

| val newNode sortArray |

" get the existing value "
val := self _at: insertionIndex.
" see if the value is already sort nodes on the secondary sort path "
val _class == SortNodeArray
  ifTrue: [
    blockSorter _addObject: aValue
      inNodes: val
  ]
  ifFalse: [
    " create sort node for the secondary sort path and put it in a sort Array "
    newNode := (blockSorter sortNodeClass)
      new: self sizeForSecondarySorts.
    newNode blockSorter: blockSorter.
    sortArray := SortNodeArray with: newNode.
    self _basicAt: insertionIndex put: sortArray.

    blockSorter _addObject: aValue
      inNodes: sortArray.

    blockSorter _addObject: val
      inNodes: sortArray.
  ].
%
category: 'Updating'
method: SortBlockNode
_insertKey: aKey
value: aValue
atIndex: insertionIndex

"Insert the key/value pair in the receiver.  The sender of this
 message must verify that the entry will fit in the receiver and
 provide the insertion index."

| lastIndex eSize |
lastIndex := self _lastIndex.
" see if there is more than one sort path remaining and if the given key
is already present in the receiver."
( insertionIndex < lastIndex _and: 
[ self _compareKey: aKey equalToEntryAt: insertionIndex + 1 ])
    ifTrue: [ " duplicate keys "
        ^ self _insertDuplicateKey: aKey value: aValue atIndex: insertionIndex
    ].

eSize := self entrySize .

"move entries down to make room for a new entry, or add room at the end"
self _insertAt: insertionIndex 
     from: nil "insert nils" fromStart: 1 fromEnd: eSize
     numToMoveDown: (numElements * eSize) - insertionIndex + 1 .
            
" add the new entry "
super _basicAt: insertionIndex put: aValue.
super _basicAt: (insertionIndex + 1) put: aKey.

self _insertEncryptionFor: aKey value: aValue startingAt: (insertionIndex + 2).

numElements := numElements + 1
%

!install documentation
run
SortBlockNode installDocumentation.
(SortBlockNode class) removeCategory: 'For Documentation Installation only'.
^true
%
