      *>----------------------------------------------------------------
      *> DOCS-ROOT.
      *>  Collection is an abstract class, which represents common
      *>  behavior for all collection classes. It also provides
      *>  methods to convert one class of collection to another.
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set localcount(150) mfoo linkcount(200)
       class-id. Collection is abstract data is protected
               inherits from dependent with data.

        object section.
        class-control.
           Dependent is class "dependnt"
           collection is class "collectn"
           callback is class "callback"
           ValueSet is class "valueset"
           Identityset is class "iset"
           characterarray is class "chararry"
           bag is class "bag"
           orderedcollection is class "ordrdcll"
           CobolCOMP5 is class "comp5"
           Array is class "array"
           recursiveSet is class "recurset"
           sortedCollection is class "srtdclln".
       working-storage section.

       class-object.

       object-storage section.

      *>----------------------------------------------------------------
      *> Creates a new instance of a collection with the same members as
      *> aCollection.
      *>----------------------------------------------------------------
       method-id. "withAll".
       local-storage section.
       01 i                    pic s9(9) comp-5.
       01 atemplate            usage object reference.
       linkage section.
       01 anewcollection       usage object reference.
       01 acollection          usage object reference.

       procedure division using acollection
                      returning anewcollection.
           invoke acollection "template" returning atemplate
           invoke acollection "size" returning i
           invoke self "ofValues" using atemplate i
                              returning anewcollection
           invoke anewcollection "addAll" using acollection
           exit method.
       end method "withAll".

       end class-object.

       Object.

       object-storage section.

       01 ObjectStatus                pic x comp-5.
                88 storingObjects       value 1.
                88 notStoringObjects    value 0.

       78 bufferSize       value 36.

       01 COLLECTABLE is typedef.
           03 abyte  pic x(objectreferencesize).

       01 collPtr                       POINTER COLLECTABLE.

      *>>---------------------------------------------------------------
      *>> The length of the elements within the collection
      *>>---------------------------------------------------------------
       01 collectionstride              pic x(4) comp-5 value 0.

                          

      *>>---------------------------------------------------------------
      *>> Determines whether objects or a particular class of intrinsic
      *>> types are being stored. Has the value of NULL if objects are
      *>> being stored otherwise it stores the class of the intrinsic to
      *>> be stored within this collection
      *>>---------------------------------------------------------------

       01 collectiontemplate           usage object reference
               value null.

      *>>---------------------------------------------------------------
      *>> Specifies how many elements are stored within the collection
      *>>---------------------------------------------------------------

       01 numberelements               pic x(4) comp-5 value 0.

      *>>---------------------------------------------------------------
      *>> Specifies how many bytes are required for the whole collection
      *>>---------------------------------------------------------------

       01 storagerequirements          pic x(4) comp-5 value 0.

       01 ooiteratorflag pic x comp-5.
           88 ooquit   value 1.
           88 oonoquit value 0.

      *>----------------------------------------------------------------
      *> PRIVATE. Return the template which indicates what Class of
      *> elements are being stored within this collection. If the value
      *> returned is NULL then the collection is storing objects.
      *>----------------------------------------------------------------
       method-id. "template".
       linkage section.
       01 lnktemplate          usage object reference.

       procedure division returning lnktemplate.
           set lnktemplate to collectiontemplate
           exit method.
       end method "template".


      *>--------------------------------------------------------------
      *> PRIVATE. Return a pointer to a newly allocated peice of
      *> memory which is lnkSize * collectnStride bytes large.
      *>--------------------------------------------------------------
       method-id. "AllocateElements".
       local-storage section.
       01 flags        pic x(4) comp-5.
       01 i            pic x(4) comp-5.

       linkage section.
       01 lnkSize           pic x(4) comp-5.
       01 lnkPtr            usage pointer.

       procedure division using lnkSize returning lnkPtr.
           move lnkSize to i
           multiply collectionStride by i
           call "oopsallocmemory" using by value i
                                returning lnkPtr
           exit method
       end method "AllocateElements".

      *>--------------------------------------------------------------
      *> PRIVATE. Return a pointer to a newly allocated peice of
      *> memory which is collectnstride bytes large.
      *>--------------------------------------------------------------
       method-id. "AllocateElement".
       linkage section.
       01 lnkPtr            usage pointer.

       procedure division returning lnkPtr.
           call "oopsallocmemory" using by value collectionStride
                                returning lnkPtr
           exit method
       end method "AllocateElement".


      *>----------------------------------------------------------------
      *> PRIVATE. Returns the storage requirements for this collection.
      *>----------------------------------------------------------------
       method-id. "getStorageRequirements".
       linkage section.
       01 lnkRequirements  pic x(4) comp-5.
       procedure division returning lnkRequirements.
           move storageRequirements to lnkRequirements
           exit method.
       end method "getStorageRequirements".
      *>----------------------------------------------------------------
      *> PRIVATE. Causes the indexed portion of this collection to grow
      *> to a size of lnkSize bytes. The primitive "OOPSGROW" must never
      *> be called directly therefore all grow operations must be
      *> performed through use of this or a similar method.
      *>----------------------------------------------------------------
       method-id. "basicGrow".
       local-storage section.
       01 lsNewPtr                pointer.

       linkage section.
       01 lnksize                 pic s9(9) comp-5.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.

       01 lnkNewData              pic x.
       01 lnkOldData              pic x.
       procedure division using lnksize returning lnkbool.
           if lnksize < zero
               invoke self "invalidParameter" returning lnkbool
           else
               invoke self "malloc" using lnksize
                                returning lsNewPtr
               if lsNewPtr = null
                   move zero to lnkBool
               else
                   set address of lnkNewData to lsNewPtr
                   set address of lnkOldData to collptr
                   move lnkOldData(1:storageRequirements)
                                to lnkNewData(1:lnksize)
                   invoke self "dealloc" using collptr
                   set collptr to lsNewptr
                   move 1 to lnkBool
               end-if
           end-if
           exit method.
       end method "basicGrow".
      *>----------------------------------------------------------------
      *> PRIVATE. Returns true if anElement is at the real index
      *> position anIndex otherwise returns false.
      *>----------------------------------------------------------------
       method-id. "isat".
       local-storage section.
       01 lsBuffer             pic x(bufferSize).
       01 aptr                 pointer.
       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 lnkbool              pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       01 anelement2           COLLECTABLE.
       01 anelement            COLLECTABLE.

       procedure division using anelement anindex
                          returning lnkbool.
           if collectionStride > bufferSize
               invoke self "allocateElement" returning aptr
               set address of anelement2 to aptr
           else
               move low-values to lsBuffer
               set address of anElement2 to address of lsBuffer
           end-if
           invoke self "atNoGC" using anindex returning anElement2
           if collectiontemplate equal to null
               invoke anelement2 as object "equal" using anelement
                                  returning lnkbool
           else
               if anelement2(1:collectionStride)
                         = anelement(1:collectionStride)
                   set lnkistrue to true
               else
                   set lnkisfalse to true
               end-if
           end-if

           if collectionStride > bufferSize
               invoke self "dealloc" using aptr
           end-if
           exit method.
       end method "isat".

      *>----------------------------------------------------------------
      *> Return true if this collection and aCollection are compatible.
      *> Any instance method that takes a collection as a parameter must
      *> be compatible with the receiver of the message, otherwise an
      *> exception will be raised.
      *>----------------------------------------------------------------
       method-id. "isCompatible".
       local-storage section.
       01 type1                usage object reference.
       01 type2                usage object reference.
       01 exceptionnumber      pic s9(9) comp-5.
       linkage section.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       01 acollection          usage object reference.

       procedure division using acollection
                        returning lnkbool.
           invoke self "template" returning type1
           invoke acollection "template" returning type2
           if type1 not equal to type2
               set lnkisfalse to true
           else
               set lnkistrue to true
           end-if
           exit method.
       end method "isCompatible".
      *>----------------------------------------------------------------
      *> Return true (1) if this object is an indexed instance.
      *>----------------------------------------------------------------
       method-id. "isIndexed".
       linkage section.
       01 lnkbool               pic 9 comp-5.
       procedure division returning lnkbool.
           move 1 to lnkBool
           exit method.
       end method "isIndexed".
      *>----------------------------------------------------------------
      *> Return true (1) if this collection has nothing stored in it,
      *> otherwise returns false (0).
      *>----------------------------------------------------------------
       method-id. "isEmpty".
       local-storage section.
       01 asize                pic s9(9) comp-5.
       linkage section.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       procedure division returning lnkbool.
           invoke self "size" returning asize
           if asize = zero
               set lnkistrue to true
           else
               set lnkisfalse to true
           end-if
           exit method.
       end method "isEmpty".
      *>----------------------------------------------------------------
      *> Returns the number of times anElement occurs within this
      *> collection.
      *>----------------------------------------------------------------
       method-id. "occurrencesOf".
       local-storage section.

       01 asize                pic s9(9) comp-5.
       01 k                    pic s9(9) comp-5.
       01 j                    pic s9(9) comp-5.

       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.

       procedure division using anelement
                                   returning anindex.
           move 1 to j
           invoke self "size" returning asize
           invoke self "firstindexOf" using anelement j asize
                                       returning k
           move zero to anindex
           perform until k = 0
               add 1 to anindex
               move k to j
               add 1 to j
               invoke self "firstindexOf" using anelement j asize
                                       returning k
           end-perform
           exit method.
       end method "occurrencesOf".
      *>----------------------------------------------------------------
      *> Raise an exception as this should be implemented by a subclass
      *> of Collection.
      *>----------------------------------------------------------------
       method-id. "add".
       local-storage section.
       01 exceptionnumber      pic s9(9) comp-5.
       linkage section.
       01 anelement            COLLECTABLE.

       procedure division using anelement.
           move 7 to exceptionnumber
           invoke self "raiseException" using exceptionnumber
           exit method.
       end method "add".
      *>----------------------------------------------------------------
      *> If aCollection is compatible with this collection then add all
      *> the elements in aCollection to this collection; otherwise raise
      *> an exception.
      *>----------------------------------------------------------------
       method-id. "addAll".
       local-storage section.

       01 amessage             usage object reference.
       01 abool                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 abool
           if istrue
               invoke callback "new" using self z"add"
                                     returning amessage
               invoke acollection "do" using amessage
               invoke amessage "finalize" returning amessage
           else
               invoke self "compatibilityError"
           end-if
           exit method.
       end method "addAll".


      $if gc defined
      *>----------------------------------------------------------------
      *> De-allocate memory for collection.
      *>----------------------------------------------------------------
       method-id. "terminating".
       procedure division.
           invoke self "decreaseReferences"
           if collptr not = null
                invoke self "dealloc" using collptr
           end-if
           invoke super "terminating"
           exit method.
       end method "terminating".

      *>----------------------------------------------------------------
      *> Release references if there are any.
      *>----------------------------------------------------------------
       method-id. "decreaseReferences".
       local-storage section.
       01 lsBool                pic x comp-5.
        88 storingObjects          value 1.
        88 notstoringObjects       value 0.
       procedure division.
           if collectionTemplate = null
                if collptr not = null
                        call "oopstablerelease"
                                using by value numberelements
                                      by value collectionStride
                                       by value collptr
                end-if
                
           else
                invoke collectionTemplate "storingObjects"
                                returning lsBool
                if storingObjects
                     invoke self "decreaseStaticReferences"
                end-if
           end-if
           exit method.
       end method "decreaseReferences".

      *>----------------------------------------------------------------
      *> Release static references if there are any.
      *>----------------------------------------------------------------
       method-id. "decreaseStaticReferences".
       local-storage section.
       01 i             pic x(4) comp-5.
       01 lsPtr         pointer.
       01 capacity      pic x(4) comp-5.

       linkage section.
       01 lnkElement    COLLECTABLE.
       procedure division.
           invoke self "allocateElement" returning lsPtr
           set address of lnkElement to lsPtr
           invoke self "size" returning capacity
           perform varying i from 1 by 1 until i > capacity
                invoke self "AtNoGC" using i
                                returning lnkElement
                invoke lnkElement as collectionTemplate
                                 "decreaseReferences"
           end-perform
           invoke self "dealloc" using lsPtr
           exit method.
       end method "decreaseStaticReferences".

      $else

      *>----------------------------------------------------------------
      *> Destroys the collection but not the objects stored within
      *> the collection.
      *>----------------------------------------------------------------
       method-id. "finalize".
       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           if collptr not = null
                invoke self "dealloc" using collptr
           end-if
           invoke super "finalize" returning lnkObject
           exit method.
       end method "finalize".
      $end

      *>----------------------------------------------------------------
      *> Raise an exception as this should be implemented by a subclass
      *> of collection.
      *>----------------------------------------------------------------
       method-id. "remove".
       local-storage section.
       01 exceptionnumber      pic s9(9) comp-5.

       linkage section.
       01 anelement            COLLECTABLE.

       procedure division using anelement.
           move 7 to exceptionnumber
           invoke self "raiseException" using exceptionnumber
           exit method.
       end method "remove".
      *>----------------------------------------------------------------
      *> If aCollection is compatible with this collection then remove
      *> all the elements in aCollection from this collection; otherwise
      *> raise an exception.
      *>----------------------------------------------------------------
       method-id. "removeAll".
       local-storage section.
       01 amessage             usage object reference.
       01 abool                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 abool
           if istrue
               invoke callback "new" using self z"remove"
                                     returning amessage
               invoke acollection "do" using amessage
               invoke amessage "finalize" returning amessage
           else
               invoke self "compatibilityError"
           end-if
           exit method.
       end method "removeAll".
      *>----------------------------------------------------------------
      *> Returns true (1) if this collection includes anElement,
      *> otherwise returns false (0).
      *>----------------------------------------------------------------
       method-id. "includes".
       local-storage section.

       01 asize                pic s9(9) comp-5.
       01 i                    pic s9(9) comp-5.

       linkage section.
       01 lnkbool              pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       01 anelement            COLLECTABLE.

       procedure division using anelement returning lnkbool.
           invoke self "size" returning asize
           set lnkisfalse to true
           perform varying i from 1 by 1 until i > asize or lnkistrue
               invoke self "isAt" using anelement i
                                   returning lnkbool
           end-perform
           exit method.
       end method "includes".
      *>----------------------------------------------------------------
      *> PRIVATE. Used to initialize instance variables for new
      *> instances
      *>----------------------------------------------------------------
       method-id. "initialize".
       local-storage section.
       01 lsSize                 pic x(4) comp-5.
       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.
           move lnkSize to storagerequirements numberelements
           move lnkStride to collectionstride
           multiply lnkStride by storagerequirements
           set collectiontemplate to lnkTemplate
           add 1 to storagerequirements giving lsSize
           invoke self "malloc" using lsSize
                        returning collPtr
      $if gc defined
           invoke collectionTemplate "storingObjects"
                        returning objectStatus
      $end
           exit method.
       end method "initialize".
      *>----------------------------------------------------------------
      *> Returns a new collection of the same species as this
      *> collection. aMessage is a Callback to a method which expects an
      *> element as a parameter and returns an element of the same
      *> type as the elements in this collection.
      *>
      *> "collect" passes each element of the collection to the Callback.
      *> Each element returned by the Callback is placed in the new
      *> collection.
      *>
      *>#See the section Iterating Collections.
      *>----------------------------------------------------------------
       method-id. "collect".
       local-storage section.
       01 aptr                 pointer.
       01 aMessage             usage object reference.

       linkage section.
       01 lnkmessage           usage object reference.
       01 anewcollection       usage object reference.
       01 lnkPicx              pic x.

       procedure division using lnkmessage returning anewcollection.
           invoke self "copyEmpty" returning anewcollection
           invoke self "allocateElement" returning aptr
           invoke callback "new" using self z"collectBM"
                                       lnkmessage anewcollection
                                       aptr
                             returning amessage
           invoke self "do" using amessage
           invoke amessage "finalize" returning aMessage
      $if gc defined
           if collectiontemplate = null
                set address of lnkPicx to aptr
                call "oopsrelease" using
                        by value 1
                        by value lnkPicx(1:objectreferencesize)
           else
                if storingObjects
                    invoke lnkPicx(1:collectionStride) AS
                                 collectionTemplate "decreaseReferences"
                end-if
           end-if
      $end
           invoke self  "dealloc" using aptr
           exit method.
       end method "collect".
      *>----------------------------------------------------------------
      *> PRIVATE.Callback used to implement collect
      *>----------------------------------------------------------------
       method-id. "collectBM".
       linkage section.
       01 lnkmessage           usage object reference.
       01 anewcollection       usage object reference.
       01 anelement            COLLECTABLE.
       01 anelement2           COLLECTABLE.
       01 lnkptr1              usage pointer.

       procedure division using lnkmessage anewcollection
                                lnkptr1 anelement.
           set address of anElement2 to lnkptr1
           invoke lnkmessage "invoke" using anelement
                                       returning anelement2
           invoke anewcollection "add" using anelement2
           exit method.
       end method "collectBM".
      *>----------------------------------------------------------------
      *> Returns a new collection of the same species and size, and
      *> ready to store the same kind of elements as this collection.
      *>----------------------------------------------------------------
       method-id. "copyEmpty".
       local-storage section.
       01 j                    pic s9(9) comp-5.

       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke self "size" returning j
           invoke self "copyEmptyWithSize" using j
                                            returning anewcollection
           exit method.
       end method "copyEmpty".
      *>----------------------------------------------------------------
      *> Returns a copy of this collection, with a copy of all the
      *> elements in the collection.
      *>----------------------------------------------------------------
       method-id. "deepcopy".
       local-storage section.
       01 abm              usage object reference.

       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           if collectiontemplate = null
               invoke self "copyEmpty" returning anewcollection
               invoke callback "new" using self z"deepCopyBM"
                                       anewcollection
                             returning abm
               invoke self "do" using abm
               invoke abm "finalize" returning abm
           else
               invoke self "copy" returning anewcollection
           end-if
           exit method.
       end method "deepcopy".
      *>----------------------------------------------------------------
      *> PRIVATE. Copy a member of this collection and add it to the new
      *> collection.
      *>----------------------------------------------------------------
       method-id. "deepcopyBM".
       local-storage section.
       01 anobject             usage object reference.

       linkage section.
       01 anewcollection       usage object reference.
       01 anelement            usage object reference.

       procedure division using anewcollection anelement.
           invoke anelement "copy" returning anobject
           invoke anewcollection "add" using anobject
           exit method.
       end method "deepcopyBM".

      *>----------------------------------------------------------------
      *> PRIVATE. Deepfinalize anElement with depth lnkDepth.
      *>----------------------------------------------------------------
       method-id. "deepfinalizeBM".
       local-storage section.
       01 anobject             usage object reference.

       linkage section.
       01 lnkDepth             pic x(4) comp-5.
       01 anelement            usage object reference.

       procedure division using lnkDepth anelement.
           invoke anelement "deepFinalizeWithDepth"
                   using lnkDepth
               returning anobject
           exit method.
       end method "deepfinalizeBM".
      *>----------------------------------------------------------------
      *> Destroys this collection, and all the elements in it, going
      *> down lnkDepth levels. For example, with lnkDepth set to 1, the
      *> collection is finalized, and all the elements in it are
      *> finalized. With lnkDepth set to 2, any elements in the
      *> collection which were themselves collections, also deepFinalize
      *> those elements.
      *>----------------------------------------------------------------
       method-id. "deepfinalizeWithDepth".

       local-storage section.
       01 abm              usage object reference.
       01 temp             usage object reference.
       01 lsNewDepth       pic x(4) comp-5.
       linkage section.
       01 defaultreturn        usage object reference.
       01 lnkDepth             pic x(4) comp-5.

       procedure division using lnkDepth returning defaultreturn.
           if collectiontemplate = null and lnkDepth > 0
               subtract 1 from lnkDepth giving lsNewDepth
               invoke callback "new" using self z"deepFinalizeBM"
                                           lsNewDepth
                             returning abm
               invoke self "do" using abm
               invoke abm "finalize" returning abm
           end-if
           invoke self "finalize" returning defaultreturn
           exit method.
       end method "deepfinalizeWithDepth".
      *>----------------------------------------------------------------
      *> Returns a new collection of the same species and ready to store
      *> the same kind of elements as this collection. However create it
      *> with a different size (lsSize).
      *>----------------------------------------------------------------
       method-id. "copyEmptyWithSize".
       local-storage section.
       01 aclass               usage object reference.

       linkage section.
       01 lnksize                 pic s9(9) comp-5.
       01 anewcollection       usage object reference.

       procedure division using lnksize  returning anewcollection.
           invoke self "species" returning aclass
           invoke aclass "ofValues" using collectiontemplate
                                 lnksize
                       returning anewcollection
           exit method.
       end method "copyEmptyWithSize".
      *>----------------------------------------------------------------
      *> Returns a new collection of the same species as this
      *> collection. lnkMessage should be a Callback pointing to a
      *> method which expects an element as a parameter and will return
      *> a pic x comp-5. "select" passes each element of the collection
      *> to the Callback. If the Callback returns True (that is 1), then
      *> the element is placed in the new collection.
      *>
      *>#See the section Iterating Collections.
      *>----------------------------------------------------------------
       method-id. "select".
       local-storage section.

       01 amessage             usage object reference.

       linkage section.
       01 lnkmessage             usage object reference.
       01 anewcollection       usage object reference.

       procedure division using lnkmessage
                             returning anewcollection.
           invoke self "copyEmpty" returning anewcollection
           invoke callback "new" using self z"selectBM"
                                       lnkmessage anewcollection
                                 returning amessage
           invoke self "do" using amessage
           exit method.
       end method "select".
      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement select.
      *>----------------------------------------------------------------
       method-id. "selectBM".
       local-storage section.
       01 abool                pic x comp-5.
           88  istrue          value 1.
           88  isfalse         value 0.

       linkage section.
       01 lnkmessage           usage object reference.
       01 lnkNewcollection     usage object reference.
       01 lnkelement           COLLECTABLE.
       procedure division using lnkmessage lnkNewcollection
                                           lnkelement.
           invoke lnkmessage "invoke" using lnkelement returning abool
           if istrue
               invoke lnkNewcollection "add" using lnkelement
           end-if
           exit method.
       end method "selectBM".
      *>----------------------------------------------------------------
      *> Returns a new collection of the same species as this
      *> collection. lnkMessage is a Callback pointing to a method which
      *> expects an element as a parameter and returns a pic x comp-5.
      *> "reject" passes each element of the collection to the Callback.
      *> If the Callback returns false (0), then the element is
      *> placed in the new collection.
      *>
      *>#See the section Iterating Collections.
      *>
      *>----------------------------------------------------------------
       method-id. "reject".
       local-storage section.
       01 amessage             usage object reference.


       linkage section.
       01 lnkmessage           usage object reference.
       01 lnknewcollection       usage object reference.

       procedure division using lnkmessage
                             returning lnknewcollection.
           invoke self "copyEmpty" returning lnknewcollection
           invoke callback "new" using self z"rejectBM"
                                       lnkmessage lnknewcollection
                             returning amessage
           invoke self "do" using amessage
           exit method.
       end method "reject".
      *>----------------------------------------------------------------
      *> PRIVATE.Callback used to implement reject
      *>----------------------------------------------------------------
       method-id. "rejectBM".
       local-storage section.
       01 abool                pic x comp-5.
           88  istrue          value 1.
           88  isfalse         value 0.

       linkage section.
       01 lnkmessage           usage object reference.
       01 lnknewcollection     usage object reference.
       01 lnkelement           COLLECTABLE.

       procedure division using lnkmessage lnknewcollection lnkelement.
           invoke lnkmessage "invoke" using lnkelement returning abool
           if isfalse
               invoke lnknewcollection "add" using lnkelement
           end-if
           exit method.
       end method "rejectBM".
      *>----------------------------------------------------------------
      *> Sends lnkMessage for each element within this collection,
      *> passing the element to the invoked method until one of the
      *> elements causes lnkMessage to return true (1).
      *> lnkMessage is a Callback pointing to a method which
      *> expects an element as a parameter and returns a pic x
      *> comp-5.
      *> If the Callback returns true (1), then the element that
      *> caused this is returned in lnkElement and lnkMessage is not
      *> sent to any more elements.
      *> If no element causes lnkMessage to return true then an
      *> exception is raised.
      *>----------------------------------------------------------------
       method-id. "detect".
       local-storage section.

       01 amessage             usage object reference.
       01 exceptionnumber      pic s9(9) comp-5.
       01 aptr                 usage pointer.
       01 parameterNo          pic x(4) comp-5.
       01 4bytebool            pic x(4) comp-5.
       01 foundflag           pic x comp-5.
                88  found      value 1.
                88  notfound   value 0.

       linkage section.
       01 lnkmessage           usage object reference.
       01 lnkElement           COLLECTABLE.

       procedure division using lnkmessage returning lnkElement.
           move low-values to lnkElement(1:collectionStride)
           move 0 to 4bytebool
           set aptr to address of lnkElement
           invoke callback "new" using self
                                       z"detectBM"
                                       lnkmessage
                                       aptr
                                       4bytebool
                             returning amessage
           invoke self "do" using amessage
           move 3 to parameterNo
           invoke amessage "getParameter" using parameterNo
                             returning 4bytebool
           move 4bytebool to foundFlag
           invoke amessage "finalize" returning amessage
           if notfound
               move 12 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                        returning lnkElement
           end-if
           exit method.
       end method "detect".
      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement detect
      *>----------------------------------------------------------------
       method-id. "detectBM".
       local-storage section.
       01 abool                pic x comp-5.
           88  istrue          value 1.
           88  isfalse         value 0.

       linkage section.
       01 lnkmessage             usage object reference.
       01 lnkfoundflag           pic x(4) comp-5.
           88  lnkfound          value 1.
           88  lnknotfound       value 0.
       01 anelement2            COLLECTABLE.
       01 anelement             COLLECTABLE.
       01 lnkPtr                usage pointer.

       procedure division using lnkmessage lnkPtr lnkfoundflag
                                                   anelement2.
           invoke lnkmessage "invoke" using anelement2
                                       returning abool
           if istrue
               set lnkfound to true
               set ooquit to true
               set address of anElement to lnkPtr
               move anelement2(1:collectionStride)
                                       to anelement(1:collectionStride)
           end-if
           exit method.
       end method "detectBM".
      *>----------------------------------------------------------------
      *> Raise an exception as this should be implemented in a subclass
      *> of Collection.
      *>----------------------------------------------------------------
       method-id. "doWithOutCopy".
       local-storage section.
       01 exceptionnumber      pic s9(9) comp-5.

       linkage section.
       01 lnkmessage             usage object reference.

       procedure division using lnkmessage.
           move 7 to exceptionnumber
           invoke self "raiseException" using exceptionnumber
           exit method.
       end method "doWithOutCopy".

      *>---------------------------------------------------------------
      *> Sends aMessage for every data item within the collection in
      *> turn, passing that data item as a parameter.
      *> aMessage is a Callback pointing to a method which
      *> expects a data item as a parameter.
      *>
      *>#See the section Iterating Collections.
      *>---------------------------------------------------------------
       method-id. "do".
       local-storage section.
       01 aCopy    usage object reference.

       linkage section.
       01 amessage             usage object reference.

       procedure division using amessage.
           invoke self "copy" returning aCopy
           invoke aCopy "doWithOutCopy" using aMessage
           invoke aCopy "finalize" returning aCopy
           exit method.
       end method "do".
      *>----------------------------------------------------------------
      *> Display the contents of this collection on the screen.
      *>----------------------------------------------------------------
       method-id. "display".
       local-storage section.

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

       procedure division.
           invoke recursiveset "includes" using self
                                      returning abool
           if istrue
               invoke self "displayRecursion"
           else
               invoke recursiveset "add" using self
               set receiver to self
               if collectiontemplate not equal to null
                   move "displayIntrinsicBM" to messageselector
               else
                   move "displayObjectBM" to messageselector
               end-if
               invoke callback "new" using receiver messageselector
                                     returning amessage
               display "(" with no advancing
               invoke self "do" using amessage
               display ")" with no advancing
               invoke amessage "finalize" returning amessage
               invoke recursiveset "remove" using self
           end-if
           exit method.
       end method "display".
      *>----------------------------------------------------------------
      *> Display the keys and the values of this collection on the
      *> screen.
      *>----------------------------------------------------------------
       method-id. "displayKeysAndData".
       local-storage section.
       01 amessage             usage object reference.
       01 receiver             usage object reference.
       01 messageselector      pic x(80).
       01 anobject             usage object reference.
       01 abool                pic x comp-5.
           88  istrue       value 1.
           88  isfalse      value 0.


       procedure division.
           invoke recursiveset "includes" using self
                                      returning abool
           if istrue
               invoke self "displayRecursion"
           else
               invoke recursiveset "add" using self
               set receiver to self
               if collectiontemplate not equal to null
                   move "displayIntrinsicKVBM" to messageselector
               else
                   move "displayObjectKVBM" to messageselector
               end-if
               invoke callback "new" using receiver messageselector
                                     returning amessage
               display "(" with no advancing
               invoke self "keysandDatado" using amessage
               display ")" with no advancing
               invoke amessage "finalize" returning amessage
               invoke recursiveset "remove" using self
           end-if
           exit method.
       end method "displayKeysAndData".
      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement display.
      *>----------------------------------------------------------------

       method-id. "displayIntrinsicBM".
       linkage section.
       01 anelement            COLLECTABLE.

       procedure division using anelement.
           invoke anelement as collectiontemplate "display"
           display " " with no advancing
           exit method.
       end method "displayIntrinsicBM".
      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement displaykeysAndData.
      *>----------------------------------------------------------------
       method-id. "displayIntrinsicKVBM".
       linkage section.
       01 lnkIndex             pic x(4) comp-5.
       01 anelement            COLLECTABLE.

       procedure division using lnkIndex anelement.
           invoke lnkIndex as cobolcomp5 "display"
           display "->" with no advancing
           invoke anelement as collectiontemplate "display"
           display " " with no advancing
           exit method.
       end method "displayIntrinsicKVBM".
      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement display.
      *>----------------------------------------------------------------
       method-id. "displayObjectBM".
       linkage section.
       01 anelement            COLLECTABLE.

       procedure division using anelement.
           invoke anelement as object "display"
           display " " with no advancing
           exit method.
       end method "displayObjectBM".

      *>----------------------------------------------------------------
      *> PRIVATE. Callback used to implement displaykeysAndData
      *>----------------------------------------------------------------
       method-id. "displayObjectKVBM".
       linkage section.
       01 lnkIndex             pic x(4) comp-5.
       01 anelement            COLLECTABLE.

       procedure division using lnkIndex anelement.
           invoke lnkIndex as cobolcomp5 "display"
           display "->" with no advancing
           invoke anelement as object "display"
           display " " with no advancing
           exit method.
       end method "displayObjectKVBM".
      *>----------------------------------------------------------------
      *> Returns a copy of this collection stored as anArray.
      *>----------------------------------------------------------------
       method-id. "asArray".
       linkage section.
       01 anewcollection       usage object reference.
       procedure division returning anewcollection.
           invoke Array "withAll" using self
                   returning anewcollection
           exit method.
       end method "asArray".
      *>----------------------------------------------------------------
      *> Returns an instance of Bag with the same elements as this
      *> collection.
      *>----------------------------------------------------------------
       method-id. "asBag".
       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke Bag "withAll" using self returning anewcollection
           exit method.
       end method "asBag".
      *>----------------------------------------------------------------
      *> Returns an instance of ValueSet with the same elements as this
      *> collection.
      *>----------------------------------------------------------------
       method-id. "asValueSet".
       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke ValueSet "withAll" using self
                                 returning anewcollection
           exit method.
       end method "asValueSet".

      *>----------------------------------------------------------------
      *> Returns an instance of IdentitySet with the same elements as
      *> this collection.
      *>----------------------------------------------------------------
       method-id. "asIdentitySet".
       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke IdentitySet "withAll" using self
                                 returning anewcollection
           exit method.
       end method "asIdentitySet".
      *>----------------------------------------------------------------
      *> Returns an instance of OrderedCollection with the same elements
      *> as this collection.
      *>----------------------------------------------------------------
       method-id. "asOrderedCollection".
       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke OrderedCollection  "withAll" using self
                                           returning anewcollection
           exit method.
       end method "asOrderedCollection".
      *>----------------------------------------------------------------
      *> Returns an instance of SortedCollection with the same elements
      *> as this collection. The sort order is determined by the
      *> sort method identified by lnkReceiver and lnkMessage.
      *>----------------------------------------------------------------
       method-id. "asSortedCollectionWithSort".
       linkage section.
       01 anewcollection       usage object reference.
       01 lnkMessage           pic x(80).
       01 lnkReceiver          usage object reference.

       procedure division using lnkReceiver lnkMessage
                           returning anewcollection.
           invoke sortedcollection "withAllandSortMethod" using
                                 self lnkReceiver lnkMessage
                        returning anewcollection
           exit method.
       end method "asSortedCollectionWithSort".
      *>----------------------------------------------------------------
      *> Return an instance of SortedCollection with the same elements
      *> as this collection. The sort order is determined by the
      *> default sort method.
      *>----------------------------------------------------------------
       method-id. "asSortedCollection".
       linkage section.
       01 anewcollection       usage object reference.


       procedure division returning anewcollection.
           invoke SortedCollection "withAll" using self
                                         returning anewcollection
           exit method.
       end method "asSortedCollection".
      *>----------------------------------------------------------------
      *> Return an instance of SortedCollection with the same elements
      *> as this collection. The sort order is determined by the
      *> default sort method. This method is retained for compatability
      *> you should use asSortedCollection instead.
      *>----------------------------------------------------------------
       method-id. "asDefaultSortedCollection".
       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke SortedCollection "withAll" using self
                                         returning anewcollection
           exit method.
       end method "asDefaultSortedCollection".

      *>---------------------------------------------------------------
      *> PRIVATE. Raise an exception as an index was out of the bounds
      *> for this collection.
      *>---------------------------------------------------------------
       method-id. "errorInBounds".
       local-storage section.
       01 exceptionnumber      pic s9(9) comp-5.
       procedure division.
           move 3 to exceptionnumber
           invoke self "raiseException" using exceptionnumber
           exit method.
       end method "errorInBounds".

      *>----------------------------------------------------------------
      *> Return the total number of elements capable of being stored
      *> within this collection.
      *>----------------------------------------------------------------

       method-id. "capacity".
       linkage section.
       01 lnksize              pic s9(9) comp-5.

       procedure division returning lnksize.
           invoke self "size" returning lnksize.
           exit method.
       end method "capacity".
      *>----------------------------------------------------------------
      *> Return a string which contains each element of this
      *> collection separated by the linefeed character.
      *> Each element must be an instance of CharacterArray.
      *>----------------------------------------------------------------

       method-id. "As0ASeparatedString".
       working-storage section.
       01 aChar pic x value x"0A".
       local-storage section.
       01 anObject     usage object reference.
       01 i            pic x(4) comp-5.
       linkage section.
       01 lnkString     usage object reference.
       procedure division returning lnkString.
           move 1 to i
           invoke CharacterArray "withLengthValue" using i aChar
                           returning anObject
           invoke self "asSeparatedString" using anObject
                           returning lnkString
           invoke anObject "finalize" returning anObject
           exit method.
       end method "As0ASeparatedString".
      *>----------------------------------------------------------------
      *> Convert this collection of CharacterArrays to a single
      *> CharacterArray separated by lnkString.
      *>----------------------------------------------------------------

       method-id. "AsSeparatedString".
       local-storage section.
       01 receiver     usage object reference.
       01 aptr         usage pointer.
       01 aCursor      pic x(4) comp-5.
       01 theSize      pic x(4) comp-5.
       01 aMessage     usage object reference.
       01 fillerSize   pic x(4) comp-5.
       01 numElements  pic x(4) comp-5.
       linkage section.
       01 lnkString    usage object reference.
       01 lnkResult    usage object reference.
       01 lnkRealString.
           03 aChar pic x occurs 1 to maxNumberBytes
                   depending on theSize.
       procedure division using lnkString returning lnkResult.
           set receiver to self
           invoke lnkString "sizeInBytes" returning fillerSize
           invoke self "size" returning numElements
           if numelements = 0 then
               invoke CharacterArray "withLength" using numElements
                   returning lnkResult
               exit method
           end-if
           multiply numElements by fillerSize giving theSize
           invoke callback "new" using receiver "calculateSizeBM "
                                       theSize
                             returning amessage
           invoke self "do" using amessage
           move 1 to theSize
           invoke aMessage "getParameter" using theSize
                                      returning theSize
           invoke amessage "finalize" returning amessage
           invoke self "malloc" using theSize returning aptr
           move 1 to aCursor
           invoke callback "new" using receiver "fillStringBM "
                                       aptr aCursor lnkString
                             returning amessage
           invoke self "do" using amessage
           set address of lnkRealString to aptr
           subtract fillerSize from theSize
           invoke CharacterArray "withByteLengthValue" using theSize
                           lnkRealString
                   returning lnkResult
           invoke amessage "finalize" returning amessage
           invoke self "dealloc" using aptr
           exit method.
       end method "AsSeparatedString".
      *>
      *> PRIVATE.
      *>
       method-id. "calculateSizeBM".
       local-storage section.
       01 aSize        pic x(4) comp-5.
       linkage section.
       01 lnksize              pic s9(9) comp-5.
       01 anElement            usage object reference.
       procedure division using lnksize anElement.
           invoke anElement "sizeInBytes" returning aSize
           add aSize to lnkSize
           exit method.
       end method "calculateSizeBM".
      *>
      *> PRIVATE.
      *>
       method-id. "fillStringBM".
       working-storage section.
       01 aChar            pic x value x"0A".
       local-storage section.
       01 aSize        pic x(4) comp-5.
       linkage section.
       01 lnkRealString        pic x.
       01 anElement            usage object reference.
       01 aCursor              pic x(4) comp-5.
       01 lnkPtr               usage pointer.
       01 lnkString            usage object reference.
       procedure division using lnkPtr acursor lnkString anElement.
           set address of lnkRealString to lnkPtr
           invoke anElement "sizeInBytes" returning aSize
           invoke anElement "getValue" returning
                           lnkRealString(acursor:aSize)
           add aSize to aCursor
           invoke lnkString "sizeInBytes" returning aSize
           invoke lnkString "getValue" returning
                           lnkRealString(aCursor:aSize)
           add aSize to aCursor
           exit method.
       end method "fillStringBM".
      *>----------------------------------------------------------------
      *> Returns the first Index of lnkElement within this collection.
      *>----------------------------------------------------------------

       method-id. "indexOf".
       local-storage section.
       01 lsSize       pic x(4) comp-5.
       01 lsStart      pic x(4) comp-5.
       linkage section.
       01 lnkElement       COLLECTABLE.
       01 lnkIndex         pic x(4) comp-5.
       procedure division using lnkElement returning lnkIndex.
           invoke self "size" returning lsSize
           move 1 to lsStart
           invoke self "firstIndexOf" using lnkElement lsStart lsSize
               returning lnkIndex
           exit method.
       end method "indexOf".
      *>----------------------------------------------------------------
      *> Returns the size of a collection as the hash value.
      *>----------------------------------------------------------------

       method-id. "hash".
       linkage section.
       01 lnksize              pic s9(9) comp-5.
       procedure division returning lnksize.
           invoke self "size" returning lnksize.
           exit method.
       end method "hash".
      *>----------------------------------------------------------------
      *> Quits the lowest level of iteration over this collection.
      *>----------------------------------------------------------------
       method-id. "quitIteration".
       procedure division.
           set ooquit to true
           exit method.
       end method "quitIteration".

      *>----------------------------------------------------------------
      *> Returns true (1) if this type of collection contains characters
      *>----------------------------------------------------------------
       method-id. "containsCharacters".
       linkage section.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.

       procedure division returning lnkbool.
           invoke collectiontemplate "containsCharacters"
                                returning lnkBool
           exit method.
       end method "ContainsCharacters".
      *>----------------------------------------------------------------
      *> PRIVATE. Return a new collection of the same class and size,
      *> and ready to store the same kind of elements as this collection.
      *>----------------------------------------------------------------
       method-id. "copyEmptySameClass".
       local-storage section.
       01 j                    pic s9(9) comp-5.

       linkage section.
       01 anewcollection       usage object reference.

       procedure division returning anewcollection.
           invoke self "size" returning j
           invoke self "copyEmptySameClassWithSize" using j
                                            returning anewcollection
           exit method.
       end method "copyEmptySameClass".
      *>----------------------------------------------------------------
      *> PRIVATE. Return a new collection of the same class, and ready
      *> to store the same kind of elements as this collection.
      *> However create it with a different size (lsSize).
      *>----------------------------------------------------------------
       method-id. "copyEmptySameClassWithSize".
       linkage section.
       01 lnksize                 pic s9(9) comp-5.
       01 anewcollection       usage object reference.

       procedure division using lnksize  returning anewcollection.
           invoke selfclass "ofValues" using collectiontemplate
                                 lnksize
                       returning anewcollection
           exit method.
       end method "copyEmptySameClassWithSize".

      *>----------------------------------------------------------------
      *> Returns a copy of this collection, pointing to the same
      *> elements as this collection (if the elements are objects they
      *> are not copied, and both this collection and the new one have
      *> handles to the same objects).
      *>----------------------------------------------------------------
       method-id. "Copy".
       local-storage section.
       01 lsCopyPtr            pointer.
       01 lsCopySize           pic x(4) comp-5.
       linkage section.
       01 result               usage object reference.
       01 instanceData         pic x.
       01 lnkCopy              pic x.
       procedure division returning result.
           invoke super "basicCopy" returning result
           add 1 to storagerequirements giving lsCopySize
           invoke self "malloc" using lsCopySize returning lsCopyPtr
           set address of lnkCopy to lsCopyPtr
           set address of instanceData to collptr
           move instanceData(1:storageRequirements) to
                lnkCopy(1:storageRequirements)
      $if GC defined
           if collectiontemplate = null
                call "oopstableaddref" using by value numberElements
                                             by value collectionStride
                                             by value collPtr
           end-if
      $end
           invoke result "setCollPtr" using lsCopyPtr
           exit method.
       end method "Copy".

      *>----------------------------------------------------------------
      *> PRIVATE. Set the collection pointer.
      *>----------------------------------------------------------------
       method-id. "SetCollPtr".
       linkage section.
       01 lnkPtr               pointer.
       procedure division using lnkPtr.
           set CollPtr to lnkPtr
           exit method.
       end method "SetCollPtr".


       end object.
       end class collection.
