      
      *>----------------------------------------------------------------
      *> An SortedCollection provides indexed storage of elements.
      *> Elements are stored in an order determined by a sort method.
      *> By default, elements are stored in ascending order, although
      *> you can provide your own sort method by sending the
      *> collection the "setSortMethod". A SortedCollection provides
      *> the same methods for accessing elements as an
      *> OrderedCollection. A SortedCollection expands to accommodate
      *> new elements if you add more than the initially specified size.
      *>
      *>#See the section Using Collections.
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set linkcount(150) mfoo
       class-id. sortedcollection data is protected
		     inherits from dynamicArrayedCollection with data.


	object section.
	class-control.
	   dynamicArrayedCollection is class "dynarray"
	   sortedcollection is class "srtdclln"
	   Orderedcollection is class "ordrdcll"
	   CharacterArray is class "chararry"
	   callback is class "callback".

       class-object.

       object-storage section.

      *>----------------------------------------------------------------
      *> Return an instance of a SortedCollection containing the
      *> elements of aCollection in an order defined by the default sort
      *> method (lnkreceiver / lnkSelector)
      *>----------------------------------------------------------------
       method-id. "withAllandSortMethod".
       local-storage section.

       01 atemplate            usage object reference.
       01 asize                pic s9(9) comp-5.

       linkage section.
       01 anewcollection       usage object reference.
       01 lnkselector          pic x(80).
       01 lnkreceiver          usage object reference.
       01 acollection          usage object reference.

       procedure division using acollection lnkreceiver
						lnkselector
			  returning anewcollection.
	   invoke acollection "size" returning asize
	   invoke acollection "template" returning atemplate
	   invoke self "ofValues" using atemplate asize
				       returning anewcollection
	   invoke anewcollection "setSortMethod" using lnkreceiver
						       lnkselector
	   invoke anewcollection "addAll" using acollection
	   exit method.
       end method "withAllandSortMethod".

       end class-object.

       Object.

       object-storage section.


      *>>---------------------------------------------------------------
      *>> The implementor of the method.
      *>>---------------------------------------------------------------
       01 methodimplementor      usage object reference value null.
       01 methodName             pic x(80).
       01 cacheBlock             pointer.
       01 hashValue              pic x(4) comp-5.
       01 callbackType           pic x comp-5.
          88 isMethodCallback    value 0.
          88 isEntryCallback     value 1.

      *>----------------------------------------------------------------
      *> Create a CallBack based on the parameters lnkReceiver and
      *> lnkSelector to represent the method used to determine
      *> the sort order of the elements.
      *>----------------------------------------------------------------
       method-id. "setSortMethod".
       01 i pic x(4) comp-5.
       01 j                    pic x(4) comp-5.
       01 aMask                pic x(4) comp-5.
       01 aString              usage object reference.                  
       01 hashDigit            pic x.
       01 hashDigitAsNum redefines hashDigit pic x comp-5.

       linkage section.
       01 lnkselector          pic x(80).
       01 lnkreceiver          usage object reference.

       procedure division using lnkreceiver lnkselector.
	   invoke characterArray "withSpaceOrNullTerminator"
		       using lnkSelector
		   returning aString
	   invoke aString "sizeInBytes" returning i
	   if i > 79
               move z"callbackmethodnametoolong" to methodName
	   else
               invoke aString "getValueZ" returning methodName
	       call "CBL_TOLOWER" using methodName by value i
	   end-if
           set isMethodCallback to true

	   invoke aString "finalize" returning aString
	   set methodimplementor to lnkreceiver
           if cacheBlock not = null
                call "oopsfreecache" using by value cacheBlock
                set cacheBlock to null
           end-if
	   invoke self "resort"
	   exit method.
       end method "setSortMethod".

      *>----------------------------------------------------------------
      *> Create a CallBack based on the parameters lnkReceiver and
      *> lnkSelector to represent the method used to determine
      *> the sort order of the elements.
      *>----------------------------------------------------------------
       method-id. "setSortEntry".
       01 i pic x(4) comp-5.
       01 j                    pic x(4) comp-5.
       01 aMask                pic x(4) comp-5.
       01 aString              usage object reference.                  
       01 hashDigit            pic x.
       01 hashDigitAsNum redefines hashDigit pic x comp-5.
       01 result               pic x(4) comp-5.
       01 exceptionNumber      pic x(4) comp-5.

       linkage section.
       01 lnkselector          pic x(80).

       procedure division using lnkselector.
	   invoke characterArray "withSpaceOrNullTerminator"
		       using lnkSelector
		   returning aString
	   invoke aString "sizeInBytes" returning i
	   if i > 80
               move 33 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                             returning result
	   else
               move spaces to methodName
               invoke aString "getValue" returning methodName
	   end-if
           set isEntryCallback to true
	   invoke aString "finalize" returning aString
	   set methodimplementor to null
           if cacheBlock not = null
                call "oopsfreecache" using by value cacheBlock
                set cacheBlock to null
           end-if
	   invoke self "resort"
	   exit method.
       end method "setSortEntry".


      *>----------------------------------------------------------------
      *> PRIVATE. Used to initialize the instance variables for new
      *> instances of SortedCollection.
      *>----------------------------------------------------------------
       method-id. "initialize".
       local-storage section.
       01 anObject             usage object reference.
       01 messageSelector      pic x(80).
       linkage section.
       01 lnktemplate          usage object reference.
       01 lnksize              pic s9(9) comp-5.
       01 lnkstride             pic s9(9) comp-5.

       procedure division using lnksize lnktemplate lnkstride.
	   invoke super "initialize" using lnksize lnktemplate lnkstride
	   move "defaultSortMethod " to messageselector           
	   invoke self "setSortMethod" using self messageSelector
	   exit method.
       end method "initialize".

      *>----------------------------------------------------------------
      *> Store anElement within this SortedCollection. The position
      *> where this is stored depends on anElement's relation to the
      *> other elements and the sort method.
      *>----------------------------------------------------------------
       method-id. "add".
       local-storage section.
       01 i                    pic s9(9) comp-5.

       linkage section.
       01 anelement            COLLECTABLE.

       procedure division using anelement.
	   invoke self "indexForInserting" using anelement
					    returning i
	   invoke super "insertBeforeIndex" using anelement i
	   exit method.
       end method "add".
      *>----------------------------------------------------------------
      *> Add all the elements of aCollection to this collection, and
      *> then resort.
      *>----------------------------------------------------------------
       method-id. "addAll".
       local-storage section.

       01 acallback         usage object reference.
       01 messageselector   pic x(80).
       01 bool              pic x comp-5.
	   88 istrue           value 1.
	   88 isfalse          value 0.

       linkage section.
       01 acollection          usage object reference.
       procedure division using acollection.
	   invoke self "isCompatible" using acollection
				       returning bool
	   if istrue
	       move "addNoSort" to messageselector
	       invoke callback "new" using self messageselector
				 returning acallback
	       invoke acollection "do" using acallback
	       invoke self "resort"
	   else
	       invoke self "compatibilityError"
	   end-if
	   exit method.
       end method "addAll".

      *>----------------------------------------------------------------
      *> Add an element to a sorted collection without inserting it
      *> into the correct sort order. It is generally more efficient
      *> if you are adding a number of elements to add without inserting
      *> into correct position then ask the collection to resort itself.
      *> As soon as you have finished adding elements you should invoke
      *> the resort method. Invoking any other methods on the collection
      *> without doing the resort has undefined behavior.
      *>#See the method "resort".
      *>----------------------------------------------------------------
       method-id. "addNoSort".
       linkage section.
       01 anelement             COLLECTABLE.

       procedure division using anelement.
	   invoke super "add" using anelement
	   exit method.
       end method "addNoSort".
      *>----------------------------------------------------------------
      *> Raise an exception as SortedCollections should not implement
      *> this method.
      *>----------------------------------------------------------------
       method-id. "atPut".
       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.

       procedure division using anindex anelement.
	   invoke self "shouldNotImplement"
	   exit method.
       end method "atPut".
      *>----------------------------------------------------------------
      *> Sorts the whole collection according to the sortBlock
      *>----------------------------------------------------------------
       method-id. "reSort".
       local-storage section.
       01 j                    pic s9(9) comp-5.
       01 i                    pic s9(9) comp-5.
       01 aptr                 pointer.
       01 aptr2                pointer.
       01 aptr3                pointer.

       procedure division.
	   move collectionStride to i
	   multiply 2 by i
	   invoke self "malloc" using i returning aPtr
	   set aptr2 to aptr
	   set aptr2 up by collectionStride

           compute i = (firstindex - 1) * collectionstride + 1 
                       
           compute j = (lastindex - 1) * collectionstride + 1                        
	   
	   invoke self "sort" using i j
				   by value aPtr
				   by value aPtr2

	   invoke self "dealloc" using aptr
	   exit method.
       end method "reSort".
      *>---------------------------------------------------------------
      *> PRIVATE. Sorts the whole collection according to
      *> the sortMethod.
      *>---------------------------------------------------------------
       method-id. "sort".
       local-storage section.
       01 procPtr              usage procedure-pointer.
       01 mid                  pic s9(9)  comp-5.
       01 temp                 pic s9(9)  comp-5.
       01 k                    pic s9(9)  comp-5.
       01 j                    pic s9(9) comp-5.
       01 i                    pic s9(9) comp-5.
       01 n                    pic s9(9) comp-5.
       01 bool                 pic x comp-5.
	   88 istrue            value 1.
	   88 isfalse           value 0.
       01 sortStatus           pic x comp-5.
	   88 finishedSort      value 1.
	   88 notfinishedSort   value 0.
       01 instData                 pointer.

       linkage section.
       01 anelement2           COLLECTABLE.
       01 anelement3           COLLECTABLE.
       01 toindex              pic s9(9) comp-5.
       01 fromindex            pic s9(9) comp-5.
       01 instanceData         pic x.
       procedure division using fromindex toindex
				   anelement2 anElement3.
                *>>> No need to add calls for gc as this method essentially
                *>>> just re-orders the elements and does not created any
                *>>> additional references.

	   move fromindex to i
	   move toindex to j
	   set notfinishedSort to true
        set address of instanceData to collptr
	perform with test after until finishedSort
	   subtract i from j giving n
	   if n <= collectionStride
	       set finishedSort to true
	       if n = collectionStride
		   move  instancedata(j:collectionstride)
                                to anelement2(1:collectionStride)
                   if isMethodCallback
                       call "cobinvoke2"
                            using by value methodImplementor
                             by reference methodName
                             by reference hashValue
                             by reference cacheBlock
                             by value 3
                             by reference bool
                             by reference anelement2
                             by reference
                                   instancedata(i:collectionstride)
                   else
                       call methodName using
                             by reference anelement2
                             by reference
                                   instancedata(i:collectionstride)
                       returning bool
                   end-if
		   if isTrue
		       move instancedata(i:collectionstride) to
                                anElement3(1:collectionStride)
		       move instancedata(j:collectionstride) to
				instancedata(i:collectionstride)
                       move anElement3(1:collectionStride) to
				instancedata(j:collectionstride)
		   end-if
	       end-if
	   else
	       move i to mid
	       add j to mid
	       subtract 2 from mid
	       divide 2 into mid
	       divide collectionStride into mid

               *>>Compute mid = ((i - 1) +
               *>>             (j - 1)) /
	       *>>             (collectionStride * 2)
	       multiply collectionStride by mid

	       add 1 to mid

	       move instancedata(mid:collectionstride) to
                                         anelement2(1:collectionStride)
	       move instancedata(i:collectionstride) to
		    instancedata(mid:collectionstride)
	       move i to n, k
	       perform with test after until n >= j
		   add collectionStride to n
                   if isMethodCallback
                       call "cobinvoke2"
                        using by value methodImplementor
                         by reference methodName
                         by reference hashValue
                         by reference cacheBlock
                         by value 3
                         by reference bool        
                         by reference instancedata(n:collectionstride)
                         by reference anelement2
                   else
                       call methodName using
                         by reference instancedata(n:collectionstride)
                         by reference anelement2
                       returning bool
                   end-if
		   if isTrue
		       add collectionStride to k
		       if k not = n
			   move instancedata(n:collectionstride) to
                                anElement3(1:collectionStride)
			   move instancedata(k:collectionstride) to
				instancedata(n:collectionstride)
                           move anElement3(1:collectionStride) to 
				instancedata(k:collectionstride)

		       end-if
		   end-if
	       end-perform
	       move instancedata(k:collectionstride) to
		   instancedata(i:collectionstride)
               move anElement2(1:collectionStride)
                         to instancedata(k:collectionstride)
	       if mid < k
		   add collectionStride to k giving temp
		   invoke self "sort" using temp j
					    anElement2
					    anElement3
		   move k to j
		   subtract collectionStride from j
	       else
		   subtract collectionStride from k giving temp
		   invoke self "sort" using i temp
					    anElement2
					    anElement3
		   move k to i
		   add collectionStride to i
	       end-if
	   end-if
       end-perform
       exit method.


       end method "sort".
      *>----------------------------------------------------------------
      *> PRIVATE. Returns an index which represents the index position
      *> before which anElement should be inserted.
      *>----------------------------------------------------------------
       method-id. "indexForInserting".
       local-storage section.
       01 procPtr              usage procedure-pointer.
       01 anobject            usage object reference.
       01 realindex           pic s9(9) comp-5.
       01 bool                pic x comp-5.
	   88 istrue           value 1.
	   88 isfalse          value 0.
       01 k                    pic s9(9)  comp-5.
       01 j                    pic s9(9) comp-5.
       01 i                    pic s9(9) comp-5.
       01 aBuffer              pic x(20).
       01 instData                 pointer.
       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.
       01 instanceData         pic x.
       procedure division using anelement returning anindex.
	   move firstindex to i
	   move lastindex to j

                *>>> No need to add calls for gc as this method essentially
                *>>> just examines the elements and does not created any
                *>>> additional references.

           *>> compute k = (i + j) / 2
           move i to k
           add j to k
           divide 2 into k
           set address of instanceData to collptr
	   perform until i > j
               compute realindex = (k - 1) * collectionstride + 1
               if isMethodCallback
                   call "cobinvoke2"
                        using by value methodImplementor
                         by reference methodName
                         by reference hashValue
                         by reference cacheBlock
                         by value 3
                         by reference bool      
                         by reference
                                instancedata(realindex:collectionstride)
                         by reference anElement
               else
                   call methodName using
                         by reference
                                instancedata(realindex:collectionstride)
                         by reference anElement
                       returning bool
               end-if
	       if istrue
		   compute i = k + 1
	       else
		   compute j = k - 1
	       end-if
               *>> compute k = (i + j) / 2
               move i to k
               add j to k
               divide 2 into k

	   end-perform.
	   add 1 to i
	   subtract firstindex from i
	   move i to anindex
	   exit method.
       end method "indexForInserting".
      *>----------------------------------------------------------------
      *> PRIVATE. Describes the default order for instances of sorted
      *> collections. This method ensures that elements are stored in
      *> ascending order. Due to the fact that this collection has to
      *> work out what it is storing it would be more efficient if the
      *> user of SortedCollections implemented his own sort block. This
      *> would be particularly noticeable if the user was storing
      *> intrinsic types.
      *>----------------------------------------------------------------
       method-id. "defaultSortMethod".
       linkage section.
       01 anelement2            COLLECTABLE.
       01 anelement             COLLECTABLE.
       01 lnkbool                 pic x comp-5.
	   88 lnkistrue           value 1.
	   88 lnkisfalse          value 0.
       procedure division using anelement anelement2 returning lnkbool.
	   if collectiontemplate equal to null
	      invoke anElement as object "lessThanOrEqual"
				       using anELement2
				   returning lnkbool
	   else
	      invoke anElement as collectiontemplate
		   "lessThanOrEqualbyLengthValue"
			      using collectionstride anelement2
		       returning lnkbool
	   end-if
	   exit method.
       end method "defaultSortMethod".

      *>----------------------------------------------------------------
      *> Return OrderedCollection as the species of SortedCollections
      *>----------------------------------------------------------------
       method-id. "species".
       linkage section.
       01 lnkclass             usage object reference.

       procedure division returning lnkclass.
	   set lnkClass to OrderedCollection
	   exit method.
       end method "species".
      *>----------------------------------------------------------------
      *> Raise an exception as SortedCollections should not implement
      *> this method.
      *>----------------------------------------------------------------
       method-id. "insertAllAfter".
       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anewcollection       usage object reference.
       01 acollection          usage object reference.

       procedure division using anindex acollection
			    returning anewcollection.
	   invoke self "shouldNotImplement"
	   exit method.
       end method "insertAllAfter".
      *>----------------------------------------------------------------
      *> Place anElement at every indexable  position of this
      *> SequencedCollection
      *>----------------------------------------------------------------
       method-id. "atAllPut".
       local-storage section.
       01 thissize             pic s9(9) comp-5.

       linkage section.
       01 anelement            COLLECTABLE.

       procedure division  using anelement.
	   invoke self "size" returning thissize
	   invoke self "removefirst" using thissize
	   perform thissize times
	       invoke self "add" using anelement
	   end-perform
	   exit method.
       end method "atAllPut".
      *>----------------------------------------------------------------
      *> Replace all the occurrences of anElement between the indices
      *> fromIndex and toIndex with anElement2.
      *>----------------------------------------------------------------
       method-id. "replaceAll".
       local-storage section.
       01 i                    pic s9(9) comp-5.
       01 j                       pic s9(9) comp-5.

       linkage section.
       01 toindex              pic s9(9) comp-5.
       01 anelement2           COLLECTABLE.
       01 fromindex            pic s9(9) comp-5.
       01 anelement            COLLECTABLE.

       procedure division using anelement anelement2
					  fromindex toindex.
	   invoke self "firstIndexOf" using anelement
						 fromindex
						 toindex
				       returning i
	   perform until i = 0
	       invoke self "removeAtIndex" using i
				       returning anelement
	       invoke self "add" using anelement2
	       move i to j
	       add 1 to j
	       invoke self "firstIndexOf" using anelement
						     j
						     toindex
					   returning i
	   end-perform
	   exit method.
       end method "replaceAll".

       method-id. "firstIndexOf".
       local-storage section.
       01 procPtr              usage procedure-pointer.
       01 anobject            usage object reference.
       01 realindex           pic s9(9) comp-5.
       01 bool                pic x comp-5.
	   88 istrue           value 1.
	   88 isfalse          value 0.

       01 lsBool               pic x comp-5.
	   88 isEqual           value 1.
	   88 isNotEqual        value 0.

       01 aptr                 pointer.
       01 k                    pic s9(9)  comp-5.
       01 j                    pic s9(9) comp-5.
       01 i                    pic s9(9) comp-5.
       01 lowerLimit           pic s9(9) comp-5.
       01 upperLimit           pic s9(9) comp-5.

       01 instData             pointer.

       linkage section.
       01 lnkFirst             pic x(4) comp-5.
       01 lnkLast              pic x(4) comp-5.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.
       01 instanceData         pic x.
       procedure division using anelement lnkFirst lnkLast
			returning anindex.

                *>>> No need to add calls for gc as this method essentially
                *>>> just examines the elements and does not created any
                *>>> additional references.

           move lnkFirst to i
           move lnkLast to j
	   add firstIndex to i j
	   subtract 1 from i j
           if i > lastIndex or lnkFirst > lnkLast
                move zero to anIndex
                exit method
           end-if
           if j > lastIndex
                move lastIndex to j
           end-if
	   set isNotEqual to true
           *>> compute k = (i + j) / 2
           move i to k
           add j to k
           divide 2 into k

           move i to lowerLimit
           move j to upperLimit
           set address of instanceData to collptr
	   perform until i > j 
               compute realindex = (k - 1) * collectionstride + 1
                                   
		if IsNotEqual
                    if isMethodCallback
                       call "cobinvoke2"
                        using by value methodImplementor
                         by reference methodName
                         by reference hashValue
                         by reference cacheBlock
                         by value 3
                         by reference bool        
                         by reference
                                instancedata(realindex:collectionstride)
                         by reference anElement
                    else
                       call methodName using
                         by reference
                                instancedata(realindex:collectionstride)
                         by reference anElement
                       returning bool
                    end-if


		   if istrue
			compute i = k + 1
		   else
			compute j = k - 1
		   end-if

                   *>> compute k = (i + j) / 2
                   move i to k
                   add j to k
                   divide 2 into k

		end-if
	   end-perform.
           if k >= lowerLimit and <= upperLimit
           
                compute realindex = (k - 1) * collectionstride + 1
                                   

                if collectionTemplate = null
                     invoke anElement AS OBJECT "equal" using
                        instancedata(realindex:collectionstride)
                              returning lsBool
                else
                     if anElement(1:collectionStride) = 
                        instancedata(realindex:collectionstride)
                        move 1 to lsBool
                     else
			move zero to lsBool
                     end-if
                end-if
           

                if isEqual
                        move k to anIndex
                        subtract firstIndex from anIndex
                        move 1 to lsBool
                        add 1 to anIndex
                        perform until anIndex < lnkFirst or lsBool = 0
                                        or anIndex = 0
                                subtract 1 from anindex
                                if anIndex >= lnkFirst and anIndex > 0
                                   invoke self "isAt"
                                        using anElement anIndex
                                   returning lsBool
                                end-if
                        end-perform
                        add 1 to anIndex
                else
                        move zero to anIndex
                end-if
           else
                move zero to anIndex
           end-if
	   exit method.
       end method "firstIndexOf".

      *>----------------------------------------------------------------
      *>----------------------------------------------------------------
       method-id. "resetCache".
       procedure division.
           Move NULL to cacheBlock
           exit method.
       end method "resetCache".

      *>----------------------------------------------------------------
      *>----------------------------------------------------------------
       method-id. "finalize".
       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           if cacheBlock not = null
               call "oopsfreecache" using by value cacheBlock
           end-if
           invoke super "finalize" returning lnkObject
	   exit method.
       end method "finalize".

       end object.
       end class sortedcollection.
