      $set mfoo
      $set linkcount(500) localcount(500)
      *>----------------------------------------------------------------
      *> A DBCSCharacterArray stores strings as objects. It differs from
      *> Characterarray as it is legal to store double-byte characters.
      *> It is illegal to create instances of DBCSCharacterArray in a
      *> single-byte environment.
      *>
      *> In a double-byte character environment you can create
      *> DBCSCharacterArrays using the same class methods as
      *> CharacterArray (for example, "withLengthValue").
      *>
      *> If you insert a double-byte character into an instance of
      *> CharacterArray, the CharacterArray becomes an instance of
      *> a DBCSCharacterArray.
      *>
      *>#See class "chararry".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
       class-id. DBCScharacterarray data is protected
               inherits from Dependent with data.

       class-control.
           DBCScharacterarray is class "dbcsarry"
           Dependent is class "dependnt"
           orderedcollection is class "ordrdcll"
           cobolpicx is class "picx"
           characterarray is class "chararry"
           callback is class "callback"
           bag is class "bag"
           recursiveSet is class  "recurset"
           sortedCollection is class "srtdclln"
           array is class "array"
           cobolcomp5 is class "comp5"
           valueSet is class "valueset"
           identitySet is class "iset".

       working-storage section.

       01 maxBytesPerChar          pic x(4) comp-5 value 2.

       class-object.

       object-storage section.

      *>----------------------------------------------------------------
      *> getSBCSClass returns the class used for dbcs environments
      *>----------------------------------------------------------------
       method-id. "getSBCSClass".
       local-storage section.
       linkage section.
       01 lnkClass            usage object reference.

       procedure division returning lnkClass.
            set lnkClass to CharacterArray
            exit program.
       end method "getSBCSClass".

      *>----------------------------------------------------------------
      *> getDBCSClass returns the class used for dbcs environments
      *>----------------------------------------------------------------
       method-id. "getDBCSClass".
       local-storage section.
       linkage section.
       01 lnkClass            usage object reference.

       procedure division returning lnkClass.

            set lnkClass to DBCSCharacterArray
            exit program.
       end method "getDBCSClass".

      *>----------------------------------------------------------------
      *> Raise an exception as "ofReferences" is illegal for a
      *> DBCScharacterArray.
      *>----------------------------------------------------------------
       method-id. "ofReferences".
       linkage section.
       01 lnkCharSize       pic s9(9) comp-5.
       01 lnkobject         usage object reference.

       procedure division using lnkCharSize returning lnkobject.
           invoke self "shouldNotImplement" returning lnkobject
           exit method.
       end method "ofReferences".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array of length lnkCharSize and
      *> value indicated by lnkValue. lnkCharSize is specified in
      *> characters.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withLengthValue".

       local-storage section.

       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.
       01 lnkObject            usage object reference.
       01 lnkValue.
          03 lnkByte           pic x.

       procedure division using lnkCharSize lnkValue
                            returning lnkObject.

           invoke self "new" using lnkCharSize returning lnkObject
           invoke lnkobject "setValue" using lnkValue
           exit method.
       end method "withLengthValue".

      *>------------------------------------------------------------
      *> Determine the number of characters within lnkValue and
      *> by searching for the last non space or non null character
      *> within the buffer.
      *> Return a DBCS Character Array of its calculated character
      *> length.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "fromBuffer".

       local-storage section.
       01 DBCSSpace            pic xx.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteCharacter               value 1.
          88 doubleByteCharacter               value 2.
       01 byteSize                 pic x(4) comp-5.
       01 charSize                 pic x(4) comp-5.
       01 lastcharSize             pic x(4) comp-5.
       01 exceptionNumber          pic s9(9) comp-5.
       01 lsClass                  usage object reference.


       linkage section.
       01 lnkByteSize              pic s9(9) comp-5.
       01 lnkValue                 pic x.
       01 lnkObject                usage object reference.

       procedure division using lnkByteSize lnkValue
                      returning lnkObject.
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           move zero to byteSize
           move zero to charSize
           move zero to lastCharSize
           perform until byteSize >= lnkByteSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkValue
                           stringStartPosition
                           stringOffset
                           charLengthInBytes

               add 1 to charSize
               if (singleByteCharacter and
                   (lnkValue(stringOffset:1) not = space and
                    lnkValue(stringOffset:1) not = x"00")) or
                    (doubleByteCharacter and
                     lnkValue(stringOffset:2) not = DBCSSpace)
                   move charSize to lastCharSize
               end-if

               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
               add charLengthInBytes to byteSize


           end-perform

           if byteSize > lnkByteSize
              *>>
              *>>   We have a Double-Byte-Character which has been split
              *>>   into two! Raise an exception.
              *>>
              move 91 to exceptionNumber
              invoke self "raiseException" using exceptionNumber
                           returning lnkObject
           else
              invoke self "getSBCSClass" returning lsClass
              invoke lsClass "withLengthValue"
                           using lastcharSize
                                 lnkValue
                       returning lnkObject
           end-if
           exit method.
       end method "fromBuffer".

      *>------------------------------------------------------------
      *> Determine the number of characters within lnkValue and
      *> return a DBCS Character Array of its calculated character
      *> length.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "withByteLengthValue".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 byteSize                 pic x(4) comp-5.
       01 charSize                 pic x(4) comp-5.
       01 exceptionNumber          pic s9(9) comp-5.

       linkage section.
       01 lnkByteSize              pic s9(9) comp-5.
       01 lnkValue                 pic x.
       01 lnkObject                usage object reference.

       procedure division using lnkByteSize lnkValue
                      returning lnkObject.

           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           move zero to byteSize
           move zero to charSize
           perform until byteSize >= lnkByteSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkValue
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
               add charLengthInBytes to byteSize
               add 1 to charSize
           end-perform
           if byteSize > lnkByteSize
          *>>
          *>>   We have a Double-Byte-Character which has been split
          *>>   into two! Raise an exception.
          *>>
               move 91 to exceptionNumber
               invoke self "raiseException" using exceptionNumber
                           returning lnkObject
           else
               invoke self "new" using charSize returning lnkObject
               invoke lnkobject "setValue" using lnkValue
           exit method.
       end method "withByteLengthValue".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array of length lnkCharSize.
      *> lnkCharSize is specified in characters.
      *>
      *> Warning: This method should only be used within a Double-Byte
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withLength".
       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.
       01 lnkObject            usage object reference.

       procedure division using lnkCharSize returning lnkObject.
           invoke self "new" using lnkCharSize returning lnkObject
           exit method.
       end method "withLength".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array from a x"00" character
      *> terminated string lnkString.
      *>
      *> Warning: This method should only be used witin a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withValue".

       local-storage section.
       01 lsClass                  usage object reference.
       01 charSize             pic s9(9) comp-5.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.
          88 singleByteCharacter               value 1.
          88 doubleByteCharacter               value 2.
       01 LoopStatus           pic x comp-5.
          88 continueLoop                      value 0.
          88 terminateLoop                     value 1.

       linkage section.
       01 lnkValue.
          03 lnkByte           pic x.
       01 lnkObject            usage object reference.

       procedure division using lnkValue returning lnkObject.
           move zero to charSize
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           set continueLoop to true
           perform until terminateLoop
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkValue
                                                   StringStartPosition
                                                   StringOffset
                                                   CharLengthInBytes
               if singleByteCharacter
                   if lnkValue(stringOffset:1) = x"00"
                       set terminateLoop to True
                   else
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                       add 1 to charSize
                   end-if
               else
                   add charLengthInBytes to stringOffset
                   add charLengthInBytes to stringStartPosition
                   add 1 to charSize
               end-if
           end-perform
           invoke self "getSBCSClass" returning lsClass
           invoke lsClass "withLengthValue"
                           using charSize
                                 lnkValue
                       returning lnkObject
           exit method.
       end method "withValue".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array from a space character
      *> terminated string lnkString.
      *>
      *> Warning: This method should only be used witin a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withSpaceTerminator".

       local-storage section.
       01 lsClass                  usage object reference.
       01 charSize             pic s9(9) comp-5.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.
          88 singleByteCharacter               value 1.
          88 doubleByteCharacter               value 2.
       01 DBCSSpace            pic xx.
       01 LoopStatus           pic x comp-5.
          88 continueLoop                      value 0.
          88 terminateLoop                     value 1.

       linkage section.
       01 lnkValue             pic x.
       01 lnkObject            usage object reference.

       procedure division using lnkValue returning lnkObject.
           invoke self "getDBCSSpace" returning DBCSSpace
           move zero to charSize
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           set continueLoop to true
           perform until terminateLoop
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkValue
                                                   StringStartPosition
                                                   StringOffset
                                                   CharLengthInBytes
               if singleByteCharacter
                   if lnkValue(stringOffset:1) = space
                       set terminateLoop to True
                   else
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                       add 1 to charSize
                   end-if
               else
                   if lnkValue(stringOffset:2) = DBCSSpace
                       set terminateLoop to True
                   else
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                       add 1 to charSize
                   end-if
               end-if
           end-perform
           invoke self "getSBCSClass" returning lsClass
           invoke lsClass "withLengthValue"
                           using charSize
                                 lnkValue
                       returning lnkObject
           exit method.
       end method "withSpaceTerminator".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array from a space or null
      *> terminated string lnkString.
      *>
      *> Warning: This method should only be used witin a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withSpaceOrNullTerminator".

       local-storage section.
       01 lsClass                  usage object reference.
       01 charSize             pic s9(9) comp-5.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.
          88 singleByteCharacter               value 1.
          88 doubleByteCharacter               value 2.
       01 DBCSSpace            pic xx.
       01 LoopStatus           pic x comp-5.
          88 continueLoop                      value 0.
          88 terminateLoop                     value 1.

       linkage section.
       01 lnkValue             pic x.
       01 lnkObject            usage object reference.

       procedure division using lnkValue returning lnkObject.
           invoke self "getDBCSSpace" returning DBCSSpace
           move zero to charSize
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           set continueLoop to true
           perform until terminateLoop
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkValue
                                                   StringStartPosition
                                                   StringOffset
                                                   CharLengthInBytes
               if singleByteCharacter
                   if lnkValue(stringOffset:1) = space or
                      lnkValue(stringOffset:1) = x"00"
                       set terminateLoop to True
                   else
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                       add 1 to charSize
                   end-if
               else
                   if lnkValue(stringOffset:2) = DBCSSpace
                       set terminateLoop to True
                   else
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                       add 1 to charSize
                   end-if
               end-if
           end-perform
           invoke self "getSBCSClass" returning lsClass
           invoke lsClass "withLengthValue"
                           using charSize
                                 lnkValue
                       returning lnkObject
           exit method.
       end method "withSpaceOrNullTerminator".
      *>----------------------------------------------------------------
      *> Return a DBCS Character Array containing low-values.
      *> lnkCharSize is the size in characters.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "new".

       local-storage section.
       01 byteSize             pic s9(9) comp-5.

       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.
       01 lnkobject            usage object reference.

      *>>---------------------------------------------------------------
      *>> Creates a new DBCS character array which is twice the size in
      *>> bytes as the number of characters passed. This allows the DBCS
      *>> character array to hold the maximum allowed number of Double-
      *>> Byte-Characters without the need for it to grow.
      *>>---------------------------------------------------------------

       procedure division using lnkCharSize returning lnkObject.
           if lnkCharSize < zero
               invoke self "invalidParameter" returning lnkObject
           else
               multiply lnkCharSize by maxBytesPerChar
                 giving byteSize
               add 1 to byteSize *>> Assume a NULL at the end

               invoke self "newIndexedInstance" using byteSize
                               returning lnkObject
               invoke lnkObject "initialize" using lnkCharSize
           end-if
           exit method.
       end method "new".
      *>----------------------------------------------------------------
      *> Return a DBCSCharacterArray, where lnkCharSize is size in
      *> characters. Here for compatability with the Character Array
      *> class.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character enviornment.
      *>----------------------------------------------------------------
       method-id. "ofValues".
       linkage section.
       01 lnkCharsize       pic s9(9) comp-5.
       01 lnktemplate       usage object reference.
       01 lnkobject         usage object reference.

       procedure division using lnktemplate lnkCharsize
                           returning lnkobject.
           invoke self "new" using lnkCharSize returning lnkobject
           exit method.
       end method "ofValues".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array which contains the same
      *> characters as the DBCS Character Array lnkObject.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>----------------------------------------------------------------
       method-id. "withAll".
       linkage section.
       01 lnkobject         usage object reference.
       01 lnknewstring      usage object reference.

       procedure division using lnkobject returning lnknewstring.
           invoke lnkobject "basiccopy" returning lnknewstring.
           exit method.
       end method "withAll".
      *>------------------------------------------------------------
      *> Return true if one or more Double-Byte-Characters are
      *> contained within the first lnkByteSize bytes of lnkValue.
      *>------------------------------------------------------------
       Method-id. "isDBCSStringByteLengthValue".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteCharacter                   value 1.
          88 doubleByteCharacter                   value 2.

       linkage section.
       01 lnkByteSize              pic s9(9) comp-5.
       01 lnkValue.
          03 lnkByte               pic x occurs 0 to maxNumberBytes
                                       depending on lnkByteSize.
       01 lnkBool                  pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.

       procedure division using lnkByteSize lnkValue
                      returning lnkBool.

           move zero to lnkBool.
           move 1 to stringStartPosition
           move 1 to stringOffset
           set singleByteCharacter to True
           perform until doubleByteCharacter or
                         StringOffset > lnkByteSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkValue
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
           if singleByteCharacter
               set isFalse to True
           else
               set isTrue to True
           end-if
           subtract 1 from CharLengthInBytes giving lnkBool
           exit method.
       end method "isDBCSStringByteLengthValue".
      *>------------------------------------------------------------
      *> Return true if one or more Double-Byte-Characters are
      *> contained within the first lnkCharSize characters of lnkValue.
      *>------------------------------------------------------------
       Method-id. "isDBCSStringLengthValue".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteCharacter                   value 1.
          88 doubleByteCharacter                   value 2.
       01 charSize                 pic s9(9) comp-5.

       linkage section.
       01 lnkCharSize              pic s9(9) comp-5.
       01 lnkValue.
          03 lnkByte               pic xx.
       01 lnkBool                  pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.

       procedure division using lnkCharSize lnkValue
                      returning lnkBool.

           move zero to lnkBool.
           move 1 to stringStartPosition
           move 1 to stringOffset
           set singleByteCharacter to True
           move zero to charSize
           perform until doubleByteCharacter or
                         charSize = lnkCharSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkValue
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
               add 1 to charSize
           end-perform
           if singleByteCharacter
               set isFalse to True
           else
               set isTrue to True
           end-if
           exit method.
       end method "isDBCSStringLengthValue".
      *>------------------------------------------------------------
      *> Return 2 if lnkChar is a Double-Byte character, 1 if lnkChar
      *> is a Single-Byte character.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "charLengthInBytes".

       local-storage section.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.

       linkage section.
       01 lnkChar              pic x(2).
       01 lnkCharLengthInBytes pic x(4) comp-5.
          88 lnkSingleByteChar                 value 1.
          88 lnkDoubleByteChar                 value 2.

       procedure division using lnkChar
                          returning lnkCharLengthInBytes.
           move 1 to stringStartPosition
           move 1 to stringOffset
           move 1 to charLengthInBytes
           call "CBL_CLASSIFY_DBCS_CHAR" using lnkChar
                                               stringStartPosition
                                               stringOffset
                                               charLengthInBytes
           move charLengthInBytes to lnkCharLengthInBytes
           exit method.
       end method "charLengthInBytes".
      *>-------------------------------------------------------------
      *> PRIVATE. Returns the string Value for a Double-Byte space
      *> Character.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "getDBCSSpace".

       local-storage section.
       01 DBCSSpace                pic x(2).

       linkage section.
       01 lnkDBCSSpace              pic x(2).

      *>> At the moment, this method has a predetermined DBCS space
      *>> value, but may be enhanced at a later time.

       procedure division returning lnkDBCSSpace.
           move x"8140" to DBCSSpace
           move DBCSSpace to lnkDBCSSpace
           exit method.
       end method "getDBCSSpace".
      *>------------------------------------------------------------
      *> Return the number of characters within a string given its
      *> length in bytes.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "stringLengthInChars".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.

       linkage section.
       01 lnkString.
          03 lnkChar               pic x occurs 0 to maxNumberBytes
                                       depending on lnkByteSize.
       01 lnkByteSize              pic x(4) comp-5.
       01 lnkCharSize              pic x(4) comp-5.

       procedure division using lnkString lnkByteSize
                          returning lnkCharSize.
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           move zero to lnkCharSize
           perform until stringOffset > lnkByteSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkString
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
               add 1 to lnkCharSize
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
           exit method.
       end method "StringLengthInChars".
      *>------------------------------------------------------------
      *> Return the number of bytes within a string given its
      *> length in characters.
      *>
      *> Warning: This method should only be used within a Double-Byte-
      *>          Character environment.
      *>------------------------------------------------------------
       Method-id. "stringLengthInBytes".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 byteSize                 pic x(4) comp-5.
       01 charSize                 pic x(4) comp-5.

       linkage section.
       01 lnkString                pic x.
       01 lnkCharSize              pic x(4) comp-5.
       01 lnkByteSize              pic x(4) comp-5.

       procedure division using lnkString lnkCharSize
                          returning lnkByteSize.
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           move zero to lnkByteSize
           move zero to CharSize
           perform until CharSize = lnkCharSize
               call "CBL_CLASSIFY_DBCS_CHAR" using
                           lnkString
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
               add charLengthInBytes to lnkByteSize
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
               add 1 to CharSize
           end-perform
           exit method.
       end method "StringLengthInBytes".

       end class-object.

       Object.

       object-storage section.

       01 instanceData.
         03 indexedDataOffset        pic x(4) comp-5.
         03 storageRequirements      pic x(4) comp-5.
         03 numberOfCharacters       pic x(4) comp-5.

       01 ooiteratorflag pic x comp-5.
           88 ooquit   value 1.
           88 oonoquit value 0.
      *>--------------------------------------------------------------
      *> PRIVATE. Return a pointer to a newly allocated area of memory
      *> capable of storing one characters in bytes.
      *>--------------------------------------------------------------
       method-id. "allocateElement".

       local-storage section.
       01 flags                    pic x(4) comp-5.
       01 byteSize                 pic s9(9) comp-5.
       01 exceptionNumber          pic s9(9) comp-5.

       linkage section.
       01 lnkPtr                   usage pointer.

       procedure division returning lnkPtr.
           move maxBytesPerChar to byteSize
           call "oopsallocmemory" using by value byteSize
                        returning lnkPtr
           exit method
       end method "allocateElement".
      *>--------------------------------------------------------------
      *> PRIVATE. Return a pointer to a newly allocated area of memory
      *> capable of storing lnkNumberOfCharacters in bytes.
      *>--------------------------------------------------------------
       method-id. "allocateElements".

       local-storage section.
       01 byteSize                 pic x(4) comp-5.
       01 exceptionNumber          pic s9(9) comp-5.

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

       procedure division using lnkNumberOfCharacters returning lnkPtr.
           multiply maxBytesPerChar by lnkNumberOfCharacters
                   giving byteSize
           call "oopsallocmemory" using by value byteSize
                        returning lnkPtr
           exit method
       end method "allocateElements".

      *>----------------------------------------------------------------
      *> Returns the address of this characterArray
      *>----------------------------------------------------------------
       method-id. "getAddress".
       linkage section.
       01 lnkPtr        POINTER.
       procedure division returning lnkPtr.
           set lnkPtr to address of instancedata
                     (indexeddataoffset + 1 : )
           exit method.
       end method "getAddress".

      *>----------------------------------------------------------------
      *> Return true if the receiver is a DBCS Character Array,
      *> otherwise answer false
      *>----------------------------------------------------------------
       method-id. "isDBCScharacterArray".

       linkage section.
       01 lnkBool                  pic x comp-5.
           88 lnkIsTrue                        value 1.
           88 lnkIsFalse                       value 0.

       procedure division returning lnkBool.
           set lnkIsTrue to true
           exit method.
       end method "isDBCScharacterArray".
      *>----------------------------------------------------------------
      *> Return true if the this DBCS Character Array contains one or
      *> more DBCS characters, otherwise answer false.
      *>----------------------------------------------------------------
       method-id. "containsDBCScharacters".

       local-storage section.
       01 byteSize             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 "sizeInBytes" returning byteSize
           invoke selfClass "isDBCSstringByteLengthValue"
                   using byteSize
                         instanceData(indexedDataOffset + 1:byteSize)
               returning lnkBool
           exit method.
       end method "containsDBCScharacters".

      *>----------------------------------------------------------------
      *> Return a character Array object which holds the value of this
      *> DBCS character Array enclosed within quotes.
      *>----------------------------------------------------------------

       method-id. "description".

       local-storage section.

       01 charSize             pic x(4) comp-5.
       01 byteSize             pic x(4) comp-5.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkCharacterArray    usage object reference.
       01 lnkQuotationValue    pic x.

       procedure division returning lnkCharacterArray.
      *>>
      *>> Get the value of this Character Array and enclose
      *>> it within quotes.
      *>>
           invoke self "sizeInBytes" returning byteSize
           add 2 to byteSize
           invoke self "malloc" using byteSize returning aPtr
           set address of lnkQuotationValue to aPtr
           move '"' to lnkQuotationValue(1:1)
           invoke self "getValue"
                       returning lnkQuotationValue(2:byteSize)
           move '"' to lnkQuotationValue(byteSize:1)
      *>>
      *>> Create a new character Array to hold the quotation value.
      *>>
           invoke self "size" returning charSize
           add 2 to charSize
           invoke selfClass "withLengthValue"
                       using charSize
                             lnkQuotationValue
                   returning lnkCharacterArray
           invoke self "dealloc" using aPtr
           exit method.
       end method "description".

      *>----------------------------------------------------------------
      *> PRIVATE. Answer true if the receiver is sequenced, else answer
      *> false
      *>----------------------------------------------------------------
       method-id. "isSequenced".

       linkage section.
       01 lnkBool                  pic x comp-5.
           88 lnkIsTrue                        value 1.
           88 lnkIsFalse                       value 0.

       procedure division returning lnkBool.
           set lnkIsTrue to true
           exit method.
       end method "isSequenced".
      *>----------------------------------------------------------------
      *> Fill the DBCS character array with the character held within
      *> lnkCharacter.
      *>----------------------------------------------------------------
       method-id. "atAllPut".

       local-storage section.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.
       01 stringCharSize       pic s9(9) comp-5.
       01 charIndexPosition    pic s9(9) comp-5.
       01 indexOffset          pic x(4) comp-5.

       linkage section.
       01 lnkCharacter         pic xx.

      *>>
      *>> This method does not use the "atPut" method for performance
      *>> reasons.
      *>>
       procedure division using lnkCharacter.
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           add 1 to indexedDataOffset giving indexOffset
           call "CBL_CLASSIFY_DBCS_CHAR" using lnkCharacter
                                               stringStartPosition
                                               stringOffset
                                               charLengthInBytes
           perform varying charIndexPosition from 1 by 1
             until charIndexPosition > numberOfCharacters
               move lnkCharacter(1:charLengthInBytes) to
                    instanceData(indexOffset:charLengthInBytes)
               add charLengthInBytes to indexOffset
           end-perform
           multiply charLengthInBytes by numberOfCharacters
               giving storageRequirements
           move x"00" to
             instanceData(indexedDataOffset + 1 + storageRequirements:1)
           exit method.
       end method "atAllPut".
      *>----------------------------------------------------------------
      *> Return the first character in the DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "first".

       local-storage section.
       01 charIndexPosition        pic s9(9) comp-5.

       linkage section.
       01 lnkCharacter             pic xx.

       procedure division returning lnkCharacter.
           move 1 to charIndexPosition
           invoke self "at" using charIndexPosition
                        returning lnkCharacter
           exit method.
       end method "first".
      *>----------------------------------------------------------------
      *> Return the last character in the DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "last".

       local-storage section.
       01 stringCharSize           pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.

       linkage section.
       01 lnkCharacter             pic xx.

       procedure division returning lnkCharacter.
           invoke self "size" returning stringCharSize
           move stringCharSize to charIndexPosition
           invoke self "at" using charIndexPosition
                        returning lnkCharacter
           exit method.
       end method "last".
      *>----------------------------------------------------------------
      *> Return the index character position of the first occurrence of
      *> lnkCharacter within the DBCS Character Array after the
      *> lnkStartCharIndexPosition and before lnkEndCharIndexPosition.
      *>
      *> If lnkCharacter is not found within the specified character
      *> index ranges, then return zero.
      *>----------------------------------------------------------------
       method-id. "firstIndexOf".

       local-storage section.
       01 stringCharSize               pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.
       01 tempCharIndexPosition        pic s9(9) comp-5.
       01 searchCharLengthInBytes      pic x(4) comp-5.
       01 comparisonCharacter          pic x(2).
       01 comparisonCharLengthInBytes  pic x(4) comp-5.

       linkage section.
       01 lnkCharacter                 pic xx.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkCharIndexPosition         pic s9(9) comp-5.

       procedure division using lnkCharacter
                                lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                      returning lnkCharIndexPosition.

      *>>
      *>> Initialise lnkCharIndexPosition to zero, indicating that no
      *>> match has yet been made.
      *>>
           move zero to lnkCharIndexPosition
      *>>
      *>> Obtain the DBCS Character Array size in characters.
      *>>
           invoke self "size" returning stringCharSize
      *>>
      *>> Ensure that the start and end character index positions
      *>> have a value of at least 1.
      *>>
           if lnkStartCharIndexPosition < 1
               move 1 to lnkStartCharIndexPosition
           end-if
           if lnkEndCharIndexPosition < 1
               move 1 to lnkEndCharIndexPosition
           end-if
       *>>
       *>> If the start character index position is greater than
       *>> the end character index position, then swap them around.
       *>>
           if lnkStartCharIndexPosition > lnkEndCharIndexPosition
               move lnkStartCharIndexPosition to tempCharIndexPosition
               move lnkEndCharIndexPosition to lnkStartCharIndexPosition
               move tempCharIndexPosition to lnkEndCharIndexPosition
           end-if
       *>>
       *>> If the start character index position is greater than the
       *>> character size of the DBCS Character Array, then end
       *>> processing returning zero within lnkCharIndexPosition.
       *>>
       *>> Otherwise, attempt to find the lnkCharacter within the
       *>> specified character index ranges of the DBCS Character
       *>> Array.
       *>>
           if lnkStartCharIndexPosition <= StringCharSize
       *>>
       *>> If the end character index position is greater than the
       *>> size of the DBCS Character Array, then reset it to the
       *>> DBCS Character Array's size.
       *>>
               if lnkEndCharIndexPosition > StringCharSize
                   move stringCharSize to lnkEndCharIndexPosition
               end-if
       *>>
       *>> Obtain lnkCharacter's actual size in bytes.
       *>>
               invoke selfClass "charLengthInBytes" using lnkCharacter
                                     returning searchCharLengthInBytes
       *>>
       *>> Search each character within the character index range
       *>> until either all the range has been searched, or a matching
       *>> character has been found.
       *>>
               perform varying CharIndexPosition
                 from lnkStartCharIndexPosition by 1
                 until charIndexPosition > lnkEndCharIndexPosition or
                       lnkCharIndexPosition not = zero
                   invoke self "at" using charIndexPosition
                                returning comparisonCharacter
        *>>
        *>> Compare the character at the searched indexed character
        *>> position with that of lnkCharacter.
        *>>
                   invoke selfClass "charLengthInBytes"
                             using comparisonCharacter
                         returning comparisonCharLengthInBytes
                   if lnkCharacter(1:searchCharLengthInBytes) =
                      comparisonCharacter(1:comparisonCharLengthInBytes)
                       move charIndexPosition to lnkCharIndexPosition
                   end-if
               end-perform
           end-if
           exit method.
       end method "firstIndexOf".
      *>----------------------------------------------------------------
      *> Return the index character position of the first occurrence of
      *> lnkCharacter within the DBCS Character Array after the
      *> lnkStartCharIndexPosition and before lnkEndCharIndexPosition.
      *>
      *> If lnkCharacter is not found within the specified character
      *> index ranges, then return zero.
      *>----------------------------------------------------------------
       method-id. "firstIndexOfIdentity".

       linkage section.
       01 lnkCharacter                 pic xx.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkCharIndexPosition         pic s9(9) comp-5.

       procedure division using lnkCharacter
                                lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                      returning lnkCharIndexPosition.

           invoke self "firstIndexOf" using lnkCharacter
                                            lnkStartCharIndexPosition
                                            lnkEndCharIndexPosition
                                  returning lnkCharIndexPosition
           exit method.
       end method "firstIndexOfIdentity".
      *>----------------------------------------------------------------
      *> Return the index character position of the last occurrence of
      *> lnkCharacter within the DBCS Character Array after the
      *> lnkStartCharIndexPosition and before lnkEndCharIndexPosition.
      *>
      *> If lnkCharacter is not found within the specified character
      *> index ranges, then return zero.
      *>----------------------------------------------------------------
       method-id. "lastIndexOf".

       local-storage section.
       01 stringCharSize               pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.
       01 tempCharIndexPosition        pic s9(9) comp-5.
       01 searchCharLengthInBytes      pic x(4) comp-5.
       01 comparisonCharacter          pic x(2).
       01 comparisonCharLengthInBytes  pic x(4) comp-5.

       linkage section.
       01 lnkCharacter                 pic xx.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkCharIndexPosition         pic s9(9) comp-5.

       procedure division using lnkCharacter
                                lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                      returning lnkCharIndexPosition.

      *>>
      *>> Initialise lnkCharIndexPosition to zero, indicating that no
      *>> match has yet been made.
      *>>
           move zero to lnkCharIndexPosition
      *>>
      *>> Obtain the DBCS Character Array size in characters.
      *>>
           invoke self "size" returning stringCharSize
      *>>
      *>> Ensure that the start and end character index positions
      *>> have a value of at least 1.
      *>>
           if lnkStartCharIndexPosition < 1
               move 1 to lnkStartCharIndexPosition
           end-if
           if lnkEndCharIndexPosition < 1
               move 1 to lnkEndCharIndexPosition
           end-if
       *>>
       *>> If the start character index position is greater than
       *>> the end character index position, then swap them around.
       *>>
           if lnkStartCharIndexPosition > lnkEndCharIndexPosition
               move lnkStartCharIndexPosition to tempCharIndexPosition
               move lnkEndCharIndexPosition to lnkStartCharIndexPosition
               move tempCharIndexPosition to lnkEndCharIndexPosition
           end-if
       *>>
       *>> If the start character index position is greater than the
       *>> character size of the DBCS Character Array, then end
       *>> processing returning zero within lnkCharIndexPosition.
       *>>
       *>> Otherwise, attempt to find the lnkCharacter within the
       *>> specified character index ranges of the DBCS Character
       *>> Array.
       *>>
           if lnkStartCharIndexPosition <= StringCharSize
       *>>
       *>> If the end character index position is greater than the
       *>> size of the DBCS Character Array, then reset it to the
       *>> DBCS Character Array's size.
       *>>
               if lnkEndCharIndexPosition > StringCharSize
                   move stringCharSize to lnkEndCharIndexPosition
               end-if
       *>>
       *>> Obtain lnkCharacter's actual size in bytes.
       *>>
               invoke selfClass "charLengthInBytes"
                           using lnkCharacter
                       returning searchCharLengthInBytes
       *>>
       *>> Search each character backwards through the character index
       *>> range until either all the range has been searched, or a
       *>> matching character has been found.
       *>>
               perform varying CharIndexPosition
                 from lnkEndCharIndexPosition by -1
                 until CharIndexPosition < lnkStartCharIndexPosition or
                       lnkCharIndexPosition not = zero
                   invoke self "at" using charIndexPosition
                                returning comparisonCharacter
                   invoke selfClass "charLengthInBytes"
                               using comparisonCharacter
                           returning comparisonCharLengthInBytes
        *>>
        *>> Compare the character at the searched indexed character
        *>> position with that of lnkCharacter.
        *>>
                   if lnkCharacter(1:searchCharLengthInBytes) =
                      comparisonCharacter(1:comparisonCharLengthInBytes)
                       move charIndexPosition to lnkCharIndexPosition
                   end-if
               end-perform
           end-if
           exit method.
       end method "lastIndexOf".
      *>----------------------------------------------------------------
      *> Replace all the occurrences of lnkOldCharacter within the
      *> DBCS Character Array with lnkNewCharacter, provided that they
      *> are within the specified character index ranges.
      *>----------------------------------------------------------------
       method-id. "replaceAll".

       local-storage section.
       01 startCharIndexPosition       pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.

       linkage section.
       01 lnkOldCharacter              pic xx.
       01 lnkNewCharacter              pic xx.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.

       procedure division using lnkOldCharacter
                                lnkNewCharacter
                                lnkStartCharIndexPosition
                                lnkEndCharIndexPosition.

           move lnkStartCharIndexPosition to startCharIndexPosition
           invoke self "firstIndexOf" using lnkOldCharacter
                                            startCharIndexPosition
                                            lnkEndCharIndexPosition
                                  returning charIndexPosition

           perform until charIndexPosition = zero
               invoke self "atPut" using charIndexPosition
                                         lnkNewCharacter
               add 1 to charIndexPosition giving startCharIndexPosition
               invoke self "firstIndexOf" using lnkOldCharacter
                                                startCharIndexPosition
                                                lnkEndCharIndexPosition
                                      returning charIndexPosition
           end-perform
           exit method.
       end method "replaceAll".
      *>----------------------------------------------------------------
      *> Replace the characters of this DBCS Character Array between
      *> the ranges specified by lnkStartCharIndexPosition and
      *> lnkEndCharIndexPosition with the contents of
      *> lnkReplaceCharacterArray, starting starting from index
      *> lnkReplaceCharIndexPosition.
      *>----------------------------------------------------------------
       method-id. "replaceSubCollection".

       local-storage section.
       01 aPtr                         usage pointer.
       01 replaceCharSize              pic s9(9) comp-5.
       01 replaceRangeCharSize         pic s9(9) comp-5.
       01 rangeCharSize                pic s9(9) comp-5.
       01 subCharIndexPosition         pic s9(9) comp-5.
       01 replaceCharIndexPosition     pic s9(9) comp-5.
       01 exceptionNumber              pic s9(9) comp-5.
       01 aBool                        pic x comp-5.
          88 isFalse                                   value 0.
          88 isTrue                                    value 1.

       linkage section.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkReplaceCharacterArray     usage object reference.
       01 lnkReplaceCharIndexPosition  pic s9(9) comp-5.

       01 lnkCharacter.
          03 lnkByte                   pic x occurs 0 to maxNumberBytes
                                    depending on maxBytesPerChar.

       procedure division using lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                                lnkReplaceCharacterArray
                                lnkReplaceCharIndexPosition.

           invoke self "isCompatible" using lnkReplaceCharacterArray
                                   returning aBool

           if isTrue
               invoke lnkReplaceCharacterArray "size"
                       returning replaceCharSize
               subtract lnkReplaceCharIndexPosition from
                        replaceCharSize giving
                        replaceRangeCharSize
               add 1 to replaceRangeCharSize
               subtract lnkStartCharIndexPosition from
                        lnkEndCharIndexPosition giving
                        rangeCharSize
               add 1 to rangeCharSize

               if rangeCharSize > replaceRangeCharSize
                       move 4 to exceptionnumber
                       invoke self "raiseException"
                           using exceptionNumber
               else
                   if lnkReplaceCharacterArray = self and
                      lnkStartCharIndexPosition >
                      lnkReplaceCharIndexPosition
                       add lnkReplaceCharIndexPosition to rangeCharSize
                           giving replaceCharIndexPosition
                       add lnkStartCharIndexPosition to rangeCharSize
                           giving subCharIndexPosition
                       invoke self "malloc" using maxBytesPerChar
                           returning aPtr
                       set address of lnkCharacter to aPtr
                       perform rangeCharSize times
                           subtract 1 from replaceCharIndexPosition
                           subtract 1 from subCharIndexPosition
                           invoke lnkReplaceCharacterArray "at"
                                   using replaceCharIndexPosition
                               returning lnkCharacter
                           invoke self "atPut"
                               using subCharIndexPosition
                                     lnkCharacter
                       end-perform
                       invoke self "dealloc" using aPtr
                   else
                       invoke self "malloc" using maxBytesPerChar
                           returning aPtr
                       set address of lnkCharacter to aPtr
                       move lnkReplaceCharIndexPosition to
                            replaceCharIndexPosition
                       move lnkStartCharIndexPosition to
                            subCharIndexPosition
                       perform rangeCharSize times
                           invoke lnkReplaceCharacterArray "at"
                                   using replaceCharIndexPosition
                               returning lnkCharacter
                           invoke self "atPut"
                               using subCharIndexPosition
                                     lnkCharacter
                           add 1 to replaceCharIndexPosition
                           add 1 to subCharIndexPosition
                       end-perform
                       invoke self "dealloc" using aPtr
                   end-if
               end-if
           else
               invoke self "compatibilityError"
           end-if
           exit method.
       end method "replaceSubCollection".
      *>----------------------------------------------------------------
      *> Return the number of occurrences of lnkCharacter that
      *> the DBCS Character Array contains.
      *>----------------------------------------------------------------
       method-id. "occurrencesOf".

       local-storage section.
       01 stringCharSize           pic s9(9) comp-5.
       01 startCharIndexPosition   pic s9(9) comp-5.
       01 endCharIndexPosition     pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.

       linkage section.
       01 lnkCharacter             pic xx.
       01 lnkCharacterOccurrences  pic s9(9) comp-5.

       procedure division using lnkCharacter
                      returning lnkCharacterOccurrences.

           move zero to lnkCharacterOccurrences
           invoke self "size" returning stringCharSize
           move 1 to startCharIndexPosition
           move stringCharSize to endCharIndexPosition
           invoke self "firstindexOf" using lnkCharacter
                                            startCharIndexPosition
                                            endCharIndexPosition
                                  returning charIndexPosition

           perform until charIndexPosition = zero
               add 1 to lnkCharacterOccurrences
               add 1 to charIndexPosition giving startCharIndexPosition
               invoke self "firstIndexOf" using lnkCharacter
                                                startCharIndexPosition
                                                endCharIndexPosition
                                      returning charIndexPosition
           end-perform
           exit method.
       end method "occurrencesOf".
      *>----------------------------------------------------------------
      *> Raise an exception as elements cannot be removed from DBCS
      *> Character Array.
      *>----------------------------------------------------------------
       method-id. "remove".

       local-storage section.
       01 exceptionNumber      pic s9(9) comp-5.

       linkage section.
       01 anObject             usage object reference.

       procedure division using anObject.
           move 5 to exceptionNumber
           invoke self "raiseException" using exceptionNumber
           exit method.
       end method "remove".
      *>----------------------------------------------------------------
      *> Return the total number of characters capable of being stored
      *> within this DBCS character array.
      *>----------------------------------------------------------------
       method-id. "capacity".

       linkage section.
       01 lnkCharSize              pic s9(9) comp-5.

       procedure division returning lnkCharSize.
           invoke self "size" returning lnkCharSize.
           exit method.
       end method "capacity".
      *>----------------------------------------------------------------
      *> Cause this DBCS Character Array to become larger in size.
      *>----------------------------------------------------------------
       method-id. "grow".

       local-storage section.
       01 basicGrowStatus          pic x comp-5.
           88 basicGrowFailed                      value 0.
           88 basicGrowPassed                      value 1.

       01 newCharSize              pic s9(9) comp-5.

       procedure division.
      *>>
      *>> Add a small constant to the existing size, allowing small
      *>> DBCS Character Array's to grow more quickly.
      *>>
           add 10 to numberOfCharacters giving newCharSize
      *>>
      *>> Double the size of the slightly increased DBCS Character
      *>> Array.
      *>>
           multiply newCharSize by 2 giving newCharSize
           invoke self "growTo" using newCharSize
                                   returning basicGrowStatus
           exit method.
       end method "grow".
      *>----------------------------------------------------------------
      *> Increase or decrease the character size of this DBCS Character
      *> Array to the new size giving by lnkNewCharSize.
      *>----------------------------------------------------------------
       method-id. "growTo".

       local-storage section.
       01 basicGrowStatus          pic x comp-5.
          88 basicGrowFailed                       value 0.
          88 basicGrowOk                           value 1.

       01 oldCharSize              pic s9(9) comp-5.
       01 oldByteSize              pic s9(9) comp-5.
       01 newByteSize              pic s9(9) comp-5.
       01 oldInstanceDataByteSize  pic s9(9) comp-5.
       01 newInstanceDataByteSize  pic s9(9) comp-5.
       01 byteOffset               pic s9(9) comp-5.
       01 byteSizeGrowth           pic s9(9) comp-5.
       01 charSizeDifference       pic s9(9) comp-5.
       01 exceptionNumber          pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.

       linkage section.
       01 lnkNewCharSize           pic x(4) comp-5.
       01 lnkDefaultReturn         usage object reference.

       procedure division using lnkNewCharSize
                      returning lnkDefaultReturn.

           multiply lnkNewCharSize by maxBytesPerChar
                   giving newByteSize.

           invoke self "basicGrow" using newByteSize
                               returning basicGrowStatus

           if basicGrowOk
               move numberOfCharacters to oldCharSize
               multiply oldCharSize by maxBytesPerChar
                   giving oldByteSize
               add indexedDataOffset to oldByteSize
                   giving oldInstanceDataByteSize
               add indexedDataOffset to newByteSize
                   giving newInstanceDataByteSize

               if newInstanceDataByteSize > oldInstanceDataByteSize
                   move oldInstanceDataByteSize to byteOffset
                   subtract oldInstanceDataByteSize from
                            newInstanceDataByteSize giving
                            byteSizeGrowth
                   move low-values to
                            instanceData(byteOffset:byteSizeGrowth)
                   move lnkNewCharSize to numberOfCharacters
                   subtract oldCharSize from lnkNewCharSize
                       giving charSizeDifference
                   add charSizeDifference to storageRequirements
               else
                   move lnkNewCharSize to numberOfCharacters
                   move 1 to stringStartPosition
                   move 1 to stringOffset
                   move zero to charLengthInBytes
                   add 1 to indexedDataOffset giving byteOffset
                   move zero to storageRequirements
                   perform varying charIndexPosition from 1 by 1
                     until charIndexPosition > lnkNewCharSize
                       call "CBL_CLASSIFY_DBCS_CHAR" using
                           instanceData(byteOffset:1)
                           stringStartPosition
                           stringOffset
                           charLengthInBytes
                       add charLengthInBytes to storageRequirements
                       add charLengthInBytes to byteOffset
                   end-perform
               end-if
               set lnkDefaultReturn to self
           else
               move 32 to exceptionNumber
               invoke self "raiseException" using exceptionNumber
                                        returning lnkDefaultReturn
           end-if
           exit method.
       end method "growTo".
      *>----------------------------------------------------------------
      *> PRIVATE. Causes the Indexed Data portion of this DBCS Character
      *> Array to grow to the size of lnkByteSize bytes. The primitive
      *> "OOPSGROW" must never be called directly, therefore, all grow
      *> operations must be performed through the use of this or a
      *> similar method.
      *>----------------------------------------------------------------
       method-id. "basicGrow".
       local-storage section.
       01 lsOldIndexedDataOffset  pic s9(9) comp-5.
       01 i                       pic s9(9) comp-5.
       01 lsSize                  pic s9(9) comp-5.
       01 additionalBytes         pic s9(9) comp-5.

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

       procedure division using lnksize returning lnkbool.
           if lnksize < zero
               invoke self "invalidParameter" returning lnkbool
           else
           *>> Code below has been inserted for components

               call "oopsindexeddataoffset" using selfClass
                                    returning lsOldIndexeddataoffset
               call "oopsindexeddataoffset" using Dependent
                                    returning i
               subtract i from lsOldIndexeddataoffset
               subtract lsOldIndexeddataoffset from indexedDataOffset
                   giving additionalBytes
               add additionalBytes to lnkSize giving lsSize

               call "oopsgrow" using self lsSize returning lnkbool
           end-if
           exit method.
       end method "basicGrow".
      *>----------------------------------------------------------------
      *> PRIVATE. Called when object becomes a component
      *>----------------------------------------------------------------
       method-id. "becomeComponent".
       local-storage section.
       01 lsDataPointer       pointer.
       01 lsIndexedDataSize   pic s9(9) comp-5.
       01 lsDynamicDataOffset pic s9(9) comp-5.
       01 lsInstanceDataSize  pic s9(9) comp-5.
       01 lsAddOffset         pic s9(9) comp-5.
       01 lsDestOffset        pic s9(9) comp-5.
       01 lsVisibleOffset     pic s9(9) comp-5.
       01 lsSrcOffset         pic s9(9) comp-5.
       01 i                   pic s9(9) comp-5.

       linkage section.
       01 lnkID                pic x.

       procedure division.
           call "oopsgetaddress" using self
                                       lsDataPointer
                                       lsInstanceDataSize
                                       lsVisibleOffset
           call "oopsindexeddataoffset" using selfClass
                              returning lsDynamicDataOffset

           compute lsAddOffset = lsInstanceDataSize -
                                 lsDynamicDataOffset -
                                 storageRequirements
           set address of lnkID to lsDataPointer
           compute lsDestOffset = indexedDataOffset + lsAddOffset + 1
           compute lsSrcOffset = indexedDataOffset + 1
           perform varying i from storageRequirements by -1
                   until i = 0
               move lnkID(lsSrcOffset + i: 1) to
                  lnkID(lsDestOffset + i : 1)
           end-perform
           add lsAddOffset to indexedDataOffset
           invoke super "becomeComponent"
           exit method.
       end method "becomeComponent".
      *>----------------------------------------------------------------
      *> 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 DBCSCharacterArray
           exit method.
       end method "template".
      *>----------------------------------------------------------------
      *> Return true if this DBCS Character Array and lnkCollection are
      *> compatible. Any instance method that takes a collection as a
      *> parameter must be compatible with the receiver of the message.
      *> An exception will be raised if the collections are
      *> incompatible.
      *>----------------------------------------------------------------
       method-id. "isCompatible".
       linkage section.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.
       01 lnkCollection        usage object reference.
       procedure division using lnkCollection returning lnkBool.
           invoke lnkCollection "containsCharacters" returning lnkBool
           exit method.
       end method "isCompatible".
      *>----------------------------------------------------------------
      *> Return true if lnkCollection is Character Array compatible,
      *> otherwise false is returned instead.
      *>----------------------------------------------------------------
       method-id. "containsCharacters".
       linkage section.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       01 lnkCollection        usage object reference.

       procedure division using lnkCollection returning lnkBool.
           set lnkIsTrue to true.
           exit method.
       end method "containsCharacters".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array which is a subset of this
      *> one determined by the indices lnkStartCharIndexPosition and
      *> lnkEndCharIndexPosition.
      *>----------------------------------------------------------------
       method-id. "copyFromTo".

       local-storage section.
       01 newCharSize                  pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.

       linkage section.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkNewCharacterArray         usage object reference.

       procedure division using lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                      returning lnkNewCharacterArray.

           subtract lnkStartCharIndexPosition from
                    lnkEndCharIndexPosition giving
                    newCharSize
           add 1 to newCharSize
           invoke self "copyEmptyWithSize" using newCharSize
                                       returning lnkNewCharacterArray
           move 1 to charIndexPosition
           invoke lnkNewCharacterArray "replaceSubCollection"
                   using charIndexPosition
                         newCharSize
                         self
                         lnkStartCharIndexPosition
           exit method.
       end method "copyFromTo".
      *>----------------------------------------------------------------
      *> Return a new character array, lnkNewCharArray. This contains
      *> the contents of this character array, but with all
      *> occurrences of lnkSearchCharArray's contents replaced by the
      *> contents of lnkReplacementCharArray.
      *>----------------------------------------------------------------
       method-id. "copyReplaceAll".

       local-storage section.
       01 charIndexPosition            pic s9(9) comp-5.
       01 startCharIndexPosition       pic s9(9) comp-5.
       01 endCharIndexPosition         pic s9(9) comp-5.
       01 selfCharIndexPosition        pic s9(9) comp-5.
       01 charSize                     pic s9(9) comp-5.
       01 searchCharSize               pic s9(9) comp-5.
       01 replaceCharSize              pic s9(9) comp-5.
       01 newCharSize                  pic s9(9) comp-5.
       01 occurrenceCount              pic s9(9) comp-5.
       01 searchOccurrences            pic s9(9) comp-5.
       01 searchStartCharIndexPosition pic s9(9) comp-5.
       01 searchCharIndexPosition      pic s9(9) comp-5.
       01 byteSize                     pic s9(9) comp-5.
       01 aTemplate                    usage object reference.
       01 aStorageCollection           usage object reference.

       linkage section.
       01 lnkSearchCharArray           usage object reference.
       01 lnkReplaceCharArray          usage object reference.
       01 lnkNewCharArray              usage object reference.

       procedure division using lnkSearchCharArray
                                lnkReplaceCharArray
                      returning lnkNewCharArray.

       *>>
       *>> Obtain the character sizes of this DBCS Character Array,
       *>> the search Character Array and the replacement Character
       *>> Array.
       *>>
           invoke self "size" returning charSize
           invoke lnkSearchCharArray "size" returning searchCharSize
           invoke lnkReplaceCharArray "size" returning replaceCharSize

       *>>
       *>> Calculate the total number of times which lnkSearchCharArray
       *>> occurs within this DBCS Character Array. The initial search
       *>> checks that at least one occurrence lnkSearchCharArray
       *>> exists.
       *>>
           move zero to searchOccurrences
           move 1 to searchStartCharIndexPosition
           invoke self "indexOfSubCollection"
                   using lnkSearchCharArray
                         searchStartCharIndexPosition
               returning searchCharIndexPosition

           move 4 to byteSize
           invoke cobolcomp5 "newClass"
                       using byteSize
                   returning aTemplate
           invoke orderedcollection "ofValues"
                       using aTemplate
                             byteSize
                   returning aStorageCollection

       *>>
       *>> Continue the search for all remaining occurrences of
       *>> lnkSearchCharArray within this DBCS Character Array,
       *>> placing the character index position of the each
       *>> occurrence in the storage ordered collection.
       *>>
           perform until searchCharIndexPosition = zero
               invoke aStorageCollection "add"
                       using searchCharIndexPosition
               add 1 to searchOccurrences
               add searchCharIndexPosition to searchCharSize
                       giving searchStartCharIndexPosition
               invoke self "indexOfSubCollection"
                       using lnkSearchCharArray
                             searchStartCharIndexPosition
                   returning searchCharIndexPosition
           end-perform

       *>>
       *>> Calculate the character size of the new Character Array.
       *>> It will be the character size of this DBCS Character Array
       *>> plus multiple occurrences of the difference in size between
       *>> the replacement Character Array and that of the search
       *>> Character Array. Create the new Character Array of the
       *>> calculated size.
       *>>

           compute newCharSize = charSize + searchOccurrences *
                                 ( replaceCharSize - searchCharSize )

           invoke self "copyEmptyWithSize" using newCharsize
                                        returning lnkNewCharArray

       *>>
       *>> Using this DBCS Character Array as the base, copy its
       *>> contents to the lnkNewCharArray, exchanging all the
       *>> occurrences of lnkSearchCharArray with lnkReplaceCharArray.
       *>> This DBCS Character Array will be unaffected, but
       *>> lnkNewCharArray will hold the result of this operation.
       *>>
           move 1 to selfCharIndexPosition
           move 1 to startCharIndexPosition
           perform varying occurrenceCount from 1 by 1
               until occurrenceCount > searchOccurrences
               invoke aStorageCollection "at" using occurrenceCount
                      returning searchCharIndexPosition
               compute endCharIndexPosition =
                   startCharIndexPosition + searchCharIndexPosition -
                   selfCharIndexPosition - 1
               move selfCharIndexPosition to charIndexPosition
               invoke lnkNewCharArray "replaceSubCollection" using
                       startCharIndexPosition
                       endCharIndexPosition
                       self
                       charIndexPosition
               add 1 to endCharIndexPosition
                       giving startCharIndexPosition
               compute endCharIndexPosition =
                   startCharIndexPosition + replaceCharSize - 1
               move 1 to charIndexPosition
               invoke lnkNewCharArray "replaceSubCollection" using
                       startCharIndexPosition
                       endCharIndexPosition
                       lnkReplaceCharArray
                       charIndexPosition
               add 1 to endCharIndexPosition
                       giving startCharIndexPosition
               compute selfCharIndexPosition =
                   searchCharIndexPosition + searchCharSize
           end-perform
           move newCharSize to endCharIndexPosition
           move selfCharIndexPosition to charIndexPosition
           invoke lnkNewCharArray "replaceSubCollection" using
                       startCharIndexPosition
                       endCharIndexPosition
                       self
                       charIndexPosition
           invoke aStorageCollection "finalize"
                   returning aStorageCollection
           exit method.
       end method "copyReplaceAll".
      *>----------------------------------------------------------------
      *> Return a copy of this DBCS Character Array with the characters
      *> between lnkStartCharIndexPosition and lnkEndCharIndexPosition
      *> replaced by the contents of a Character Array lnkCharArray.
      *>----------------------------------------------------------------
       method-id. "copyReplace".

       local-storage section.
       01 charSize                     pic s9(9) comp-5.
       01 arrayCharSize                pic s9(9) comp-5.
       01 newCharSize                  pic s9(9) comp-5.
       01 startCharIndexPosition       pic s9(9) comp-5.
       01 endCharIndexPosition         pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.

       linkage section.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkEndCharIndexPosition      pic s9(9) comp-5.
       01 lnkCharArray                 usage object reference.
       01 lnkNewCharArray              usage object reference.

       procedure division using lnkStartCharIndexPosition
                                lnkEndCharIndexPosition
                                lnkCharArray
                      returning lnkNewCharArray.

           invoke lnkCharArray "size" returning arrayCharSize
           invoke self "size" returning charSize

           compute newCharSize =
               charSize + ArrayCharSize - (lnkEndCharIndexPosition -
               lnkStartCharIndexPosition + 1)

           invoke self "copyEmptyWithSize" using newCharSize
                                       returning lnkNewCharArray

           move 1 to startCharIndexPosition
           move 1 to charIndexPosition
           subtract 1 from lnkStartCharIndexPosition
                   giving endCharIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                   using startCharIndexPosition
                         endCharIndexPosition
                         self
                         charIndexPosition

           move lnkStartCharIndexPosition to startCharIndexPosition
           add ArrayCharSize to endCharIndexPosition
           move 1 to charIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                     using startCharIndexPosition
                           endCharIndexPosition
                           lnkCharArray
                           charIndexPosition

           add 1 to endCharIndexPosition giving startCharIndexPosition
           move newCharSize to endCharIndexPosition
           add 1 to lnkEndCharIndexPosition giving charIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                      using startCharIndexPosition
                            endCharIndexPosition
                            self
                            charIndexPosition
           exit method.
       end method "copyReplace".
      *>----------------------------------------------------------------
      *> Return a new Character Array which is a copy of this one,
      *> with an additional character specified within lnkCharacter
      *> tagged to its end.
      *>----------------------------------------------------------------
       method-id. "copyWith".

       local-storage section.
       01 startCharIndexPosition   pic s9(9) comp-5.
       01 charSize                 pic s9(9) comp-5.
       01 newCharSize              pic s9(9) comp-5.

       linkage section.
       01 lnkCharacter.
          03 lnkByte               pic x occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkNewCharArray          usage object reference.

       procedure division using lnkCharacter returning lnkNewCharArray.

           invoke self "size" returning charSize
           add 1 to charSize giving newCharSize
           invoke self "copyEmptyWithSize" using newCharSize
                                       returning lnkNewCharArray

           move 1 to startCharIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                   using startCharIndexPosition
                         charSize
                         self
                         startCharIndexPosition

           invoke lnkNewCharArray "atPut" using newCharSize lnkCharacter
           exit method.
       end method "copyWith".
      *>----------------------------------------------------------------
      *> Return a new Character Array which is a copy of this one
      *> except that all occurrences of the character specifed by
      *> lnkRemoveChar will have been removed.
      *>----------------------------------------------------------------
       method-id. "copyWithOut".

       local-storage section.
       01 aPtr                     usage pointer.
       01 charOccurrences          pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.
       01 newCharIndexPosition     pic s9(9) comp-5.
       01 charSize                 pic s9(9) comp-5.
       01 newCharSize              pic s9(9) comp-5.
       01 aBool                    pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.

       linkage section.
       01 lnkRemoveCharacter.
           03 lnkRemoveByte        pic x occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkNewCharArray          usage object reference.

       01 lnkCharacter.
           03 lnkByte              pic x occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkRemoveCharacter
                      returning lnkNewCharArray.

           invoke self "occurrencesOf" using lnkRemoveCharacter
                                   returning charOccurrences

           invoke self "size" returning charSize
           subtract charOccurrences from charSize giving newCharSize
           invoke self "copyEmptyWithSize" using newCharSize
                                       returning lnkNewCharArray
           invoke self "malloc" using maxBytesPerChar
                            returning aPtr
           set address of lnkCharacter to aPtr
           move 1 to newCharIndexPosition
           perform varying charIndexPosition from 1 by 1
             until charIndexPosition > charSize
               invoke self "isAt" using lnkRemoveCharacter
                                        charIndexPosition
                              returning aBool
               if isFalse
                   invoke self "at" using charIndexPosition
                                returning lnkCharacter
                   invoke lnkNewCharArray "atPut"
                           using newCharIndexPosition
                                 lnkCharacter
                   add 1 to newCharIndexPosition
               end-if
           end-perform
           invoke self "dealloc" using aPtr
           exit method.
       end method "copyWithOut".
      *>----------------------------------------------------------------
      *> Return the character index position (lnkCharIndexPosition) of
      *> the first occurrence of the string contents of the search
      *> character array (lnkSearchCharacterArray), starting the search
      *> at a specified character position (lnkStartCharIndexPosition)
      *> within this DBCS character array.
      *>
      *> If lnkSearchCharacterArray is not found within this DBCS
      *> Character Array, then zero will be returned.
      *>----------------------------------------------------------------
       method-id. "indexOfSubCollection".

       local-storage section.
       01 aPtr                         usage pointer.
       01 exceptionNumber              pic s9(9) comp-5.
       01 searchCharSize               pic s9(9) comp-5.
       01 searchByteSize               pic s9(9) comp-5.
       01 indexOffset                  pic x(4) comp-5.
       01 charIndexPosition            pic x(4) comp-5.
       01 stringStartPosition          pic 9(4) comp.
       01 stringOffset                 pic 9(4) comp.
       01 charLengthInBytes            pic 9(2) comp.
       01 aBool                        pic x comp-5.
          88 isFalse                                   value 0.
          88 isTrue                                    value 1.

       linkage section.
       01 lnkSearchCharacterArray      usage object reference.
       01 lnkStartCharIndexPosition    pic s9(9) comp-5.
       01 lnkCharIndexPosition         pic s9(9) comp-5.

       01 lnkSearchString.
          03 lnkSearchByte             pic x  occurs 0 to maxNumberBytes
                                           depending on searchByteSize.


       procedure division using lnkSearchCharacterArray
                                lnkStartCharIndexPosition
                      returning lnkCharIndexPosition.

           invoke self "isCompatible" using lnkSearchCharacterArray
                                  returning aBool

           if isTrue
               move zero to lnkCharIndexPosition
               invoke lnkSearchCharacterArray "size"
                   returning searchCharSize
               if searchCharSize = zero
                   move 11 to exceptionnumber
                   invoke self "raiseException"
                               using exceptionNumber
                           returning lnkCharIndexPosition
               else
                   invoke lnkSearchCharacterArray "sizeInBytes"
                       returning searchByteSize
                   invoke self "malloc" using searchByteSize
                                    returning aPtr
                   set address of lnkSearchString to aPtr
                   invoke lnkSearchCharacterArray "getValue"
                           returning lnkSearchString
                   add 1 to indexedDataOffset giving indexOffset
                   move 1 to stringStartPosition
                   move 1 to stringOffset
                   move zero to charLengthInBytes
                   perform varying charIndexPosition from 1 by 1
                     until charIndexPosition > numberOfCharacters or
                           charIndexPosition + searchCharSize - 1
                           > numberOfCharacters or
                           lnkCharIndexPosition not = zero
                       if charIndexPosition >=
                          lnkStartCharIndexPosition and
                          instanceData(indexOffset:searchByteSize) =
                          lnkSearchString
                           move charIndexPosition to
                                lnkCharIndexPosition
                       else
                           call "CBL_CLASSIFY_DBCS_CHAR" using
                               instanceData(indexedDataOffset + 1:
                               storageRequirements)
                               stringStartPosition
                               stringOffset
                               charLengthInBytes
                           add charLengthInBytes to stringOffset
                           add charLengthInBytes to stringStartPosition
                           add charLengthInBytes to indexOffset
                       end-if
                   end-perform
                   invoke self "dealloc" using aPtr
               end-if
           else
               invoke self "compatibilityError"
                           returning lnkCharIndexPosition
           end-if
           exit method.
       end method "indexOfSubCollection".
      *>----------------------------------------------------------------
      *> Return a new collection of the same species as this collection.
      *> aMessage should be a CallBack pointing to a method which
      *> expects an element as a parameter and will return 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.
      *> For more information see the topic Collection Iterator Methods
      *> in the on-line documentation.
      *>----------------------------------------------------------------
       method-id. "collect".

       local-storage section.
       01 copyCharacterArray   usage object reference.
       01 aPtr                 usage pointer.
       01 otherPtr             usage pointer.
       01 charIndexPosition    pic s9(9) comp-5.

       linkage section.
       01 lnkCallBack          usage object reference.
       01 lnkCharacterArray    usage object reference.

       01 lnkCharacter.
           03 lnkByte          pic x  occurs 0 to maxnumberbytes
                                     depending on maxBytesPerChar.
       01 lnkOtherCharacter.
           03 lnkOtherByte     pic x  occurs 0 to maxnumberbytes
                                     depending on maxBytesPerChar.

       procedure division using lnkCallBack
                      returning lnkCharacterArray.

           invoke self "copyEmpty" returning lnkCharacterArray
           set oonoquit to true
           invoke self "malloc" using maxBytesPerChar
                            returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "malloc" using maxBytesPerChar
                            returning otherPtr
           set address of lnkOtherCharacter to otherPtr
           invoke self "copy" returning copyCharacterArray
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > numberOfCharacters
               invoke copyCharacterArray "at"
                 using charIndexPosition
                 returning lnkCharacter
               invoke lnkCallBack "invoke" using lnkCharacter
                                   returning lnkOtherCharacter
               invoke lnkCharacterArray "atPut"
                   using charIndexPosition lnkOtherCharacter
           end-perform
           invoke copyCharacterArray "finalize"
                   returning copyCharacterArray
           set oonoquit to true
           invoke self "dealloc" using aPtr
           invoke self "dealloc" using OtherPtr
           exit method.
       end method "collect".
      *>----------------------------------------------------------------
      *> Send aMessage for each element within this collection,
      *> passing the element to the invoked method until one of the
      *> elements causes lnkMessage to return true.
      *> aMessage should be a CallBack pointing to a method which
      *> expects an element as a parameter and will return a pic x
      *> comp-5.
      *> If the CallBack returns True (that is 1), then the index of
      *> the element that caused this is returned in anindex and
      *> lnkMessage is not sent to any more elements.
      *> If no element causes lnkMessage to return true then zero is
      *> returned.
      *>----------------------------------------------------------------
       method-id. "findFirst".

       local-storage section.
       01 charIndexPosition    pic s9(9) comp-5.
       01 aPtr                 usage pointer.
       01 aBool                pic x comp-5.
          88 isFalse                           value 0.
          88 isTrue                            value 1.

       linkage section.
       01 lnkCallBack          usage object reference.
       01 lnkCharIndexPosition pic s9(9) comp-5.

       01 lnkString.
          03 lnkByte            pic x occurs 0 to maxnumberbytes
                                   depending on storageRequirements.

       procedure division using lnkCallBack
                      returning lnkCharIndexPosition.

           set isFalse to true
           invoke self "malloc" using storageRequirements returning aPtr
           set address of lnkString to aPtr
           move zero to lnkCharIndexPosition
           perform varying charIndexPosition from 1 by 1
             until charIndexPosition > numberOfCharacters or
                   lnkCharIndexPosition not = zero
               invoke self "at" using charIndexPosition
                            returning lnkString
               invoke lnkCallBack "invoke" using lnkString
                                       returning aBool
               if isTrue
                   move charIndexPosition to lnkCharIndexPosition
               end-if
           end-perform
           invoke self "dealloc" using aPtr
           exit method.
       end method "findFirst".
      *>----------------------------------------------------------------
      *> Send aMessage passing each element in turn as a parameter,
      *> but in reverse order, and return the index position of the
      *> first element that causes the result of the message to
      *> evaluate to true.
      *>----------------------------------------------------------------
       method-id. "findLast".

       local-storage section.
       01 charIndexPosition    pic s9(9) comp-5.
       01 aPtr                 usage pointer.
       01 aBool                pic x comp-5.
          88 isFalse                           value 0.
          88 isTrue                            value 1.

       linkage section.
       01 lnkCallBack          usage object reference.
       01 lnkCharIndexPosition pic s9(9) comp-5.

       01 lnkString.
          03 lnkByte            pic x occurs 0 to maxnumberbytes
                                   depending on storageRequirements.

       procedure division using lnkCallBack
                      returning lnkCharIndexPosition.

           set isFalse to true
           invoke self "malloc" using storageRequirements returning aPtr
           set address of lnkString to aPtr
           move zero to lnkCharIndexPosition
           perform varying charIndexPosition
             from numberOfCharacters by -1
             until charIndexPosition = zero or
                   lnkCharIndexPosition not = zero
               invoke self "at" using charIndexPosition
                            returning lnkString
               invoke lnkCallBack "invoke" using lnkString
                                       returning aBool
               if isTrue
                   move charIndexPosition to lnkCharIndexPosition
               end-if
           end-perform
           invoke self "dealloc" using aPtr
           exit method.
       end method "findLast".
      *>----------------------------------------------------------------
      *> Instance method "keysAndDatado" repeatedly sends a message
      *> for each element passing the index and the element as
      *> parameters.
      *> lnkCallBack should be a CallBack pointing to a method which
      *> expects a pic x(4) comp-5 and a character as parameters.
      *> For more information see the topic Collection Iterator Methods
      *> in the on-line documentation.
      *>----------------------------------------------------------------
       method-id. "keysAndDatado".
       local-storage section.
       01 returnPtr            usage pointer.
       01 aPtr                 usage pointer.
       01 charIndexPosition    pic s9(9) comp-5.
       01 charSize             pic s9(9) comp-5.
       01 copyCharacterArray   usage object reference.

       linkage section.
       01 lnkCallBack          usage object reference.

       01 lnkReturnBuffer.
           03 lnkReturnByte    pic x occurs 0 to maxNumberBytes
                                   depending on maxBytesPerChar.
       01 lnkCharacter.
           03 lnkByte          pic x  occurs 0 to maxNumberBytes
                                   depending on maxBytesPerChar.

       procedure division using lnkCallBack.
           invoke self "size" returning charSize
           set oonoquit to true
           invoke self "malloc" using maxBytesPerChar
                            returning returnPtr
           set address of lnkReturnBuffer to returnPtr
           invoke self "malloc" using maxBytesPerChar
                            returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "copy" returning copyCharacterArray
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > charSize
               invoke copyCharacterArray "at"
                       using charIndexPosition
                   returning lnkCharacter
               invoke lnkCallBack "invoke"
                       using CharIndexPosition
                             lnkCharacter
                   returning lnkReturnBuffer
           end-perform
           invoke copyCharacterArray "finalize"
                   returning copyCharacterArray
           set oonoquit to true
           invoke self "dealloc" using aPtr
           invoke self "dealloc" using returnPtr
           exit method.
       end method "keysAndDatado".
      *>----------------------------------------------------------------
      *> Destroy the DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "deepFinalize".

       linkage section.
       01 lnkNullObject    usage object reference.

       procedure division returning lnkNullObject.

           invoke self "finalize" returning lnkNullObject
           exit method.
       end method "deepFinalize".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array of the specified character
      *> size.
      *>
      *> lnkCharSize is the length in characters.
      *>----------------------------------------------------------------
       method-id. "copyEmptyWithSize".

       local-storage section.
       01 lsClass              usage object reference.
       01 dummyTemplate        usage object reference.

       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.
       01 lnkNewCharArray      usage object reference.

       procedure division using lnkCharSize returning lnkNewCharArray.
           set dummyTemplate to null
           invoke self "getSBCSClass" returning lsClass
           invoke lsClass "ofValues"
                           using dummyTemplate
                                 lnkCharSize
                       returning lnkNewCharArray
           exit method.
       end method "copyEmptyWithSize".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array of the same size as this
      *> DBCS Character Array, but with empty contents.
      *>----------------------------------------------------------------
       method-id. "copyEmpty".

       linkage section.
       01 lnkCharacterArray    usage object reference.

       procedure division returning lnkCharacterArray.
           invoke self "copyEmptyWithSize" using numberOfCharacters
                       returning lnkCharacterArray
           exit method.
       end method "copyEmpty".
      *>----------------------------------------------------------------
      *> Return true if this DBCS Character Array has nothing stored
      *> within it, otherwise returns false.
      *>----------------------------------------------------------------
       method-id. "isEmpty".

       linkage section.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       procedure division returning lnkBool.
           if storageRequirements = zero
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           exit method.
       end method "isEmpty".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array with the same contents as
      *> this one, except with its characters in reverse order.
      *>----------------------------------------------------------------
       method-id. "reverse".

       local-storage section.
       01 aPtr                     usage pointer.
       01 charIndexPosition        pic s9(9) comp-5.
       01 otherCharIndexPosition   pic s9(9) comp-5.

       linkage section.
       01 lnkNewCharacterArray     usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x  occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division returning lnkNewCharacterArray.

           invoke self "malloc" using maxBytesPerChar
                            returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "copyEmpty" returning lnkNewCharacterArray
           move 1 to otherCharIndexPosition
           perform varying charIndexPosition from numberOfCharacters
             by -1 until charIndexPosition = zero
               invoke self "at" using charIndexPosition
                            returning lnkCharacter
               invoke lnkNewCharacterArray "atPut"
                   using otherCharIndexPosition
                         lnkCharacter
               add 1 to otherCharIndexPosition
           end-perform
           invoke self "dealloc" using aPtr
           exit method.
       end method "reverse".
      *>----------------------------------------------------------------
      *> Invoke a callback passing each character of this DBCS
      *> Character Array in turn as a parameter.
      *> lnkCallBack should be a CallBack pointing to a method which
      *> expects a character as a parameter.
      *> For more information see the topic Collection Iterator Methods
      *> in the on-line documentation.
      *>----------------------------------------------------------------
       method-id. "do".

       local-storage section.
       01 charIndexPosition        pic s9(9) comp-5.
       01 charSize                 pic s9(9) comp-5.
       01 aPtr                     usage pointer.
       01 aReturnPtr               usage pointer.
       01 copiedCharArray          usage object reference.

       linkage section.
       01 lnkCallBack              usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkReturnBuffer.
          03 lnkReturnByte         pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkCallBack.

           invoke self "malloc" using maxBytesPerChar returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "malloc" using maxBytesPerChar
                            returning aReturnPtr
           set address of lnkReturnBuffer to aReturnPtr

           invoke self "size" returning charSize
           set oonoquit to true
           invoke self "copy" returning copiedCharArray
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > charSize
               invoke copiedCharArray "at" using charIndexPosition
                                       returning lnkCharacter
               invoke lnkCallBack "invoke" using lnkCharacter
                                      returning lnkReturnBuffer
           end-perform
           set oonoquit to true
           invoke copiedCharArray "finalize" returning copiedCharArray
           invoke self "dealloc" using aPtr
           invoke self "dealloc" using aReturnPtr
           exit method.
       end method "do".
      *>----------------------------------------------------------------
      *> Invoke a callback passing each character of this DBCS
      *> Character Array in turn as a parameter.
      *>----------------------------------------------------------------
       method-id. "doWithOutCopy".

       local-storage section.
       01 charIndexPosition        pic s9(9) comp-5.
       01 charSize                 pic s9(9) comp-5.
       01 aPtr                     usage pointer.
       01 aReturnPtr               usage pointer.

       linkage section.
       01 lnkCallBack              usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkReturnBuffer.
          03 lnkReturnByte         pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkCallBack.

           invoke self "malloc" using maxBytesPerChar returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "malloc" using maxBytesPerChar
                            returning aReturnPtr
           set address of lnkReturnBuffer to aReturnPtr

           invoke self "size" returning charSize
           set oonoquit to true
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > charSize
               invoke self "at" using charIndexPosition
                                       returning lnkCharacter
               invoke lnkCallBack "invoke" using lnkCharacter
                                      returning lnkReturnBuffer
           end-perform
           set oonoquit to true
           invoke self "dealloc" using aPtr
           invoke self "dealloc" using aReturnPtr
           exit method.
       end method "doWithOutCopy".
      *>----------------------------------------------------------------
      *> Return a new Character Array lnkNewCharArray.
      *> lnkCallBAck should be a CallBack pointing to a method which
      *> expects a character as a parameter and will return a pic x comp-5.
      *> "select" passes each character of this DBCS Character Array,
      *> in turn to the CallBack.
      *> If the CallBack returns True (that is 1), then the element is
      *> placed in lnkNewCharArray.
      *> For more information see the topic Collection Iterator Methods
      *> in the on-line documentation.
      *>----------------------------------------------------------------
       method-id. "select".

       local-storage section.
       01 aPtr                     usage pointer.
       01 copiedCharArray          usage object reference.
       01 workCharArray            usage object reference.
       01 charSize                 pic s9(9) comp-5.
       01 workCharSize             pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.
       01 startCharIndexPosition   pic s9(9) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 aBool                    pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.

       linkage section.
       01 lnkCallBack              usage object reference.
       01 lnkNewCharArray          usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkCallBack returning lnkNewCharArray.

           invoke self "malloc" using maxBytesPerChar returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "copy" returning copiedCharArray
           invoke self "size" returning charSize
           invoke self "copyEmptyWithSize" using charSize
                                        returning workCharArray
           move zero to workCharSize
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           set oonoquit to true
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > charSize
               invoke self "at" using charIndexPosition
                            returning lnkCharacter
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkCharacter
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes

               invoke lnkCallBack "invoke"
                           using lnkCharacter(1:charLengthInBytes)
                       returning aBool

               if isTrue
                   add 1 to workCharSize
                   invoke workCharArray "atPut"
                           using workCharSize
                                 lnkCharacter(1:charLengthInBytes)
               end-if
           end-perform

           invoke copiedCharArray "finalize" returning copiedCharArray

           set oonoquit to true
           invoke self "copyEmptyWithSize" using workCharSize
                                        returning lnkNewCharArray

           move 1 to startCharIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                   using startCharIndexPosition
                         workCharSize
                         workCharArray
                         startCharIndexPosition

           invoke workCharArray "finalize" returning workCharArray
           invoke self "dealloc" using aPtr
           exit method.
       end method "select".
      *>----------------------------------------------------------------
      *> Return a new Character Array lnkNewCharArray.
      *> lnkCallback should be a CallBack pointing to a method which
      *> expects a character as a parameter and will return a pic x comp-5.
      *> "reject" passes each character of this DBCS Character Array,
      *> in turn to the CallBack.
      *> If the CallBack returns False (that is 0), then the element is
      *> placed in lnkNewCharArray.
      *> For more information see the topic Collection Iterator Methods
      *> in the on-line documentation.
      *>----------------------------------------------------------------
       method-id. "reject".

       local-storage section.
       01 aPtr                     usage pointer.
       01 copiedCharArray          usage object reference.
       01 workCharArray            usage object reference.
       01 charSize                 pic s9(9) comp-5.
       01 workCharSize             pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.
       01 startCharIndexPosition   pic s9(9) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 aBool                    pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.

       linkage section.
       01 lnkCallBack              usage object reference.
       01 lnkNewCharArray          usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkCallBack returning lnkNewCharArray.

           invoke self "malloc" using maxBytesPerChar returning aPtr
           set address of lnkCharacter to aPtr
           invoke self "copy" returning copiedCharArray
           invoke self "size" returning charSize
           invoke self "copyEmptyWithSize" using charSize
                                        returning workCharArray
           move zero to workCharSize
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           set oonoquit to true
           perform varying charIndexPosition from 1 by 1
             until ooquit or charIndexPosition > charSize
               invoke self "at" using charIndexPosition
                            returning lnkCharacter
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkCharacter
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes

               invoke lnkCallBack "invoke"
                           using lnkCharacter(1:charLengthInBytes)
                       returning aBool

               if isFalse
                   add 1 to workCharSize
                   invoke workCharArray "atPut"
                           using workCharSize
                                 lnkCharacter(1:charLengthInBytes)
               end-if
           end-perform

           invoke copiedCharArray "finalize" returning copiedCharArray

           set oonoquit to true
           invoke self "copyEmptyWithSize" using workCharSize
                                        returning lnkNewCharArray

           move 1 to startCharIndexPosition
           invoke lnkNewCharArray "replaceSubcollection"
                   using startCharIndexPosition
                         workCharSize
                         workCharArray
                         startCharIndexPosition

           invoke workCharArray "finalize" returning workCharArray
           invoke self "dealloc" using aPtr
           exit method.
       end method "reject".
      *>----------------------------------------------------------------
      *> Send a CallBack lnkCallBack for each character within this DBCS
      *> Character Array passing the character to the invoked method
      *> until one of these characters causes a status of True to occur.
      *> Return the character which caused this to occur. If no element
      *> causes a status of True to occurthen raise an appropriate
      *> exception.
      *>----------------------------------------------------------------
       method-id. "detect".

       local-storage section.
       01 aCallBack            usage object reference.
       01 messageName          pic x(80).
       01 exceptionNumber      pic s9(9) comp-5.
       01 aPtr                 usage pointer.
       01 numberOfParameters   pic x(4) comp-5.
       01 foundFlag4           pic x(4) comp-5.
       01 foundFlag            pic x comp-5.
          88 notfound                          value 0.
          88 found                             value 1.

       linkage section.
       01 lnkCallBack          usage object reference.
       01 lnkCharacter.
          03 lnkByte           pic x occurs 1 to maxNumberBytes
                                   depending on maxBytesPerChar.

       procedure division using lnkCallBack returning lnkCharacter.

           move "detectBM" to messageName
           move low-values to lnkCharacter
           set aPtr to address of lnkCharacter
           move 0 to foundFlag4
           invoke callBack "new" using self
                                       messageName
                                       lnkCallBack
                                       aPtr
                                       foundFlag4
                             returning aCallBack

           invoke self "do" using aCallBack
           move 3 to numberOfParameters
           invoke aCallBack "getParameter" using numberOfParameters
                                       returning foundFlag4
           move foundflag4 to foundflag
           invoke aCallBack "finalize" returning aCallBack
           if notFound
               move 12 to exceptionNumber
               invoke self "raiseException" using exceptionNumber
                                        returning lnkCharacter
           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 isFalse                                   value 0.
          88 isTrue                                    value 1.

       linkage section.
       01 lnkCallBack              usage object reference.
       01 lnkPtr                   usage pointer.

       01 lnkFoundFlag             pic x(4) comp-5.
          88 lnkNotFound                               value 0.
          88 lnkFound                                  value 1.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.
       01 lnkMemoryCharacter.
           03 lnkMemorybyte        pic x occurs 1 to maxNumberBytes
                                       depending on maxBytesPerChar.

       procedure division using lnkCallBack
                                lnkPtr
                                lnkFoundFlag
                                lnkCharacter.

           invoke lnkCallBack "invoke" using lnkCharacter
                                   returning aBool

           if isTrue
               set lnkFound to true
               set ooquit to true
               set address of lnkMemoryCharacter to lnkPtr
               move lnkCharacter to lnkMemoryCharacter
           end-if
           exit method.
       end method "detectBM".
      *>----------------------------------------------------------------
      *> Invoke a callback passing each character of this DBCS
      *> Character Array in reverse order as a parameter.
      *>----------------------------------------------------------------
       method-id. "reverseDo".

       local-storage section.
       01 collectionElement        pic s9(9) comp-5.
       01 collectionSize           pic s9(9) comp-5.
       01 copiedCollection         usage object reference.
       01 nullObject               usage object reference.
       01 elementData              pic xx.
       01 returnBuffer             pic xx.

       linkage section.
       01 lnkCallBack              usage object reference.

       procedure division using lnkCallBack.

           invoke self "size" returning collectionSize
           set oonoquit to true
           invoke self "copy" returning copiedCollection
           perform varying collectionElement from collectionSize by -1
             until collectionElement = zero or ooquit
               invoke copiedCollection "at" using collectionElement
                                        returning elementData
               invoke lnkCallBack "invoke" using elementData
                                      returning returnBuffer
           end-perform
           set oonoquit to true
           invoke copiedCollection "finalize" returning nullObject
           exit method.
       end method "reverseDo".
      *>----------------------------------------------------------------
      *> Cause the message lnkCallBack to be sent for each character of
      *> this DbcsCharacterArray.
      *> lnkCallBack should be a CallBack pointing to a method which
      *> expects two elements as parameters.
      *> Each time the callback is invoked, the first parameter will
      *> be the element from this collection, and the second
      *> parameter will be the corresponding element from
      *> lnkOtherCharacterarray.
      *> If lnkOtherCharacterarray is of different size to this
      *> DbcsCharacterArray then raise an exception.
      *>----------------------------------------------------------------
       method-id. "withDo".

       local-storage section.
       01 copyCharacterArray       usage object reference.
       01 copyOtherCharacterArray  usage object reference.
       01 aPtr                     usage pointer.
       01 otherPtr                 usage pointer.
       01 returnPtr                usage pointer.
       01 exceptionNumber          pic s9(9) comp-5.
       01 otherCharSize            pic s9(9) comp-5.
       01 charIndexPosition        pic s9(9) comp-5.
       01 byteSize                 pic s9(9) comp-5.

       linkage section.
       01 lnkOtherCharacterArray   usage object reference.
       01 lnkCallBack              usage object reference.

       01 lnkCharacter.
          03 lnkByte               pic x occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkOtherCharacter.
          03 lnkOtherByte          pic x occurs 0 to maxNumberBytes
                                       depending on maxBytesPerChar.

       01 lnkReturnBuffer.
          03 lnkReturnByte         pic x occurs 0 to maxNumberBytes
                                       depending on byteSize.

       procedure division using lnkOtherCharacterArray lnkCallBack.

           invoke lnkOtherCharacterArray "size"
               returning otherCharSize

       *>>
       *>> The DBCS Character Array must be the same character size
       *>> as the other Character Array
       *>>
           if otherCharSize not = numberOfCharacters
               move 6 to exceptionNumber
               invoke self "raiseException" using exceptionNumber
           else
               invoke self "malloc" using maxBytesPerChar
                                returning aPtr
               set address of lnkCharacter to aPtr
               invoke self "malloc" using maxBytesPerChar
                                returning otherPtr
               set address of lnkOtherCharacter to otherPtr
               multiply numberOfCharacters by maxBytesPerChar
                                giving byteSize
               invoke self "malloc" using byteSize
                                returning returnPtr
               set address of lnkReturnBuffer to returnPtr
               invoke self "copy"
                                returning copyCharacterArray
               invoke lnkOtherCharacterArray "copy"
                                returning copyOtherCharacterArray
               set oonoquit to true
               perform varying charIndexPosition from 1 by 1
                   until charIndexPosition > numberOfcharacters or
                         ooquit
                   invoke copyCharacterArray "at"
                               using charIndexPosition
                               returning lnkCharacter
                   invoke copyOtherCharacterArray "at"
                               using charIndexPosition
                               returning lnkOtherCharacter
                   invoke lnkcallBack "invoke" using lnkCharacter
                                                     lnkOtherCharacter
                                           returning lnkReturnBuffer
               end-perform
               set oonoquit to true
               invoke self "dealloc" using aPtr
               invoke self "dealloc" using otherPtr
               invoke self "dealloc" using returnPtr
               invoke copyCharacterArray "finalize"
                       returning copyCharacterArray
               invoke copyOtherCharacterArray "finalize"
                       returning copyOtherCharacterArray
           end-if
           exit method.
       end method "withDo".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array which will hold the
      *> characters of this DBCS Character Array with all the characters
      *> of another Character Array lnkOtherCharArray inserted
      *> immediately after character index position specified by
      *> lnkInsertCharIndexPosition.
      *>----------------------------------------------------------------
       method-id. "insertAllAfter".

       local-storage section.
       01 charSize                     pic s9(9) comp-5.
       01 otherCharSize                pic s9(9) comp-5.
       01 newCharSize                  pic s9(9) comp-5.
       01 startCharIndexPosition       pic s9(9) comp-5.
       01 endCharIndexPosition         pic s9(9) comp-5.
       01 charIndexPosition            pic s9(9) comp-5.

       linkage section.
       01 lnkInsertCharIndexPosition   pic s9(9) comp-5.
       01 lnkOtherCharArray            usage object reference.
       01 lnkNewCharArray              usage object reference.

       procedure division using lnkInsertCharIndexPosition
                                lnkOtherCharArray
                      returning lnkNewCharArray.

           invoke self "size" returning charSize
           invoke lnkOtherCharArray "size" returning otherCharSize
           add charSize to otherCharSize giving newCharSize
           invoke self "copyEmptyWithSize" using newCharSize
                                       returning lnkNewCharArray

           move 1 to startCharIndexPosition
           move lnkInsertCharIndexPosition to endCharIndexPosition
           move 1 to charIndexPosition
           invoke lnkNewCharArray "replaceSubCollection"
                   using startCharIndexPosition
                         endCharIndexPosition
                         self
                         charIndexPosition

           add 1 to lnkInsertCharIndexPosition
                   giving startCharIndexPosition
           add otherCharSize to startCharIndexPosition
                       giving endCharIndexPosition
           subtract 1 from endCharIndexPosition
           move 1 to charIndexPosition
           invoke lnkNewCharArray "replaceSubCollection"
                   using startCharIndexPosition
                         endCharIndexPosition
                         lnkOtherCharArray
                         charIndexPosition

           add 1 to endCharIndexPosition giving startCharIndexPosition
           move newCharSize to endCharIndexPosition
           add 1 to lnkInsertCharIndexPosition giving charIndexPosition
           invoke lnkNewCharArray "replaceSubCollection"
                   using startCharIndexPosition
                         endCharIndexPosition
                         self
                         charIndexPosition

           exit method.
       end method "insertAllAfter".
      *>----------------------------------------------------------------
      *> Return true if this DBCS Character Array includes lnkCharacter
      *> otherwise return false.
      *>----------------------------------------------------------------
       method-id. "includes".

       local-storage section.
       01 charSize             pic s9(9) comp-5.
       01 charIndexPosition    pic s9(9) comp-5.

       linkage section.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       01 lnkCharacter.
          03 lnkByte           pic x occurs 1 to maxNumberBytes
                                   depending on maxBytesPerChar.

       procedure division using lnkCharacter returning lnkBool.

           invoke self "size" returning charSize
           set lnkIsFalse to true
           perform varying charIndexPosition from 1 by 1
             until lnkIsTrue or charIndexPosition > charSize
               invoke self "isAt" using lnkCharacter charIndexPosition
                              returning lnkBool
           end-perform
           exit method.
       end method "includes".
      *>----------------------------------------------------------------
      *> PRIVATE. Used to initialize the attributes of newly created
      *> instances of DBCS Character Array.
      *>
      *> lnkCharSize is the length in characters.
      *>
      *>----------------------------------------------------------------
       method-id. "initialize".

       local-storage section.
       01 parentOffset         pic x(4) comp-5.

       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.

       procedure division using lnkCharSize.
           call "oopsindexeddataoffset" using selfClass
                                    returning indexeddataoffset
           call "oopsindexeddataoffset" using Dependent
                                    returning parentOffset
           subtract parentOffset from indexedDataOffset
           move lnkCharSize to storageRequirements
           move lnkCharSize to numberOfCharacters

           exit method.
       end method "initialize".

      *>------------------------------------------------------------
      *> Return the character at lnkCharIndexPosition.
      *>----------------------------------------------------------
       Method-id. "at".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 charCount                pic x(4) comp-5.
       01 indexOffset              pic x(4) comp-5.

       linkage section.
       01 lnkCharIndexPosition     pic s9(9) comp-5.
       01 lnkChar.
          03 lnkByte               pic x occurs 0 to maxNumberBytes
                                       depending on charLengthInBytes.

       procedure division using lnkCharIndexPosition returning lnkChar.
           if lnkCharIndexPosition < 1 or
              lnkCharIndexPosition > numberOfCharacters
               invoke self "errorInBounds" returning lnkChar
           else
               move 1 to stringStartPosition
               move 1 to stringOffset
               move zero to charLengthInBytes
               add 1 to indexedDataOffset giving indexOffset
               perform varying charCount from 1 by 1
                 until charCount > lnkCharIndexPosition
                   call "CBL_CLASSIFY_DBCS_CHAR" using
                     instanceData(indexOffset:storageRequirements)
                     stringStartPosition
                     stringOffset
                     charLengthInBytes
                   add charLengthInBytes to stringOffset
                   add charLengthInBytes to stringStartPosition
               end-perform
               subtract charLengthInBytes from stringOffset
               add stringOffset to indexedDataOffset giving indexOffset
               move instancedata(indexOffset:charLengthInBytes) to
                           lnkChar(1:charLengthInBytes)
           end-if
           exit method.
       end method "at".

      *>------------------------------------------------------------
      *> Return the character at lnkCharIndexPosition and also
      *> return the size of the character in bytes.
      *>----------------------------------------------------------
       Method-id. "atAndByteLength".

       local-storage section.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 charCount                pic x(4) comp-5.
       01 indexOffset              pic x(4) comp-5.

       linkage section.
       01 lnkCharIndexPosition     pic s9(9) comp-5.
       01 lnkChar.
          03 lnkByte               pic x occurs 0 to maxNumberBytes
                                       depending on charLengthInBytes.
       01 lnkByteLength            pic x(4) comp-5.

       procedure division using lnkCharIndexPosition
                                lnkChar
                                lnkByteLength.
           if lnkCharIndexPosition < 1 or
              lnkCharIndexPosition > numberOfCharacters
               invoke self "errorInBounds" returning lnkChar
           else
               move 1 to stringStartPosition
               move 1 to stringOffset
               move zero to charLengthInBytes
               add 1 to indexedDataOffset giving indexOffset
               perform varying charCount from 1 by 1
                 until charCount > lnkCharIndexPosition
                   call "CBL_CLASSIFY_DBCS_CHAR" using
                     instanceData(indexOffset:storageRequirements)
                     stringStartPosition
                     stringOffset
                     charLengthInBytes
                   add charLengthInBytes to stringOffset
                   add charLengthInBytes to stringStartPosition
               end-perform
               subtract charLengthInBytes from stringOffset
               add stringOffset to indexedDataOffset giving indexOffset
               move instancedata(indexOffset:charLengthInBytes) to
                           lnkChar(1:charLengthInBytes)
               move charLengthInBytes to lnkByteLength
           end-if
           exit method.
       end method "atAndByteLength".

      *>----------------------------------------------------------------
      *> PRIVATE. Returns true if lnkCharacter is at the character index
      *> position lnkCharIndexPosition, otherwise returns false.
      *>----------------------------------------------------------------
       method-id. "isat".

       local-storage section.
       01 aPtr                 usage pointer.
       01 stringStartPosition  pic 9(4) comp.
       01 stringOffset         pic 9(4) comp.
       01 charLengthInBytes    pic 9(2) comp.
       01 byteSize             pic 9(2) comp.
       01 otherByteSize        pic 9(2) comp.

       linkage section.
       01 lnkCharacter.
          03 lnkByte           pic x occurs 0 to maxNumberBytes
                                   depending on maxBytesPerChar.

       01 lnkCharIndexPosition pic s9(9) comp-5.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       01 lnkOtherCharacter.
          03 lnkOtherByte      pic x occurs 0 to maxNumberBytes
                                   depending on maxBytesPerChar.

       procedure division using lnkCharacter lnkCharIndexPosition
                      returning lnkBool.

           invoke self "malloc" using maxBytesPerChar returning aPtr
           set address of lnkOtherCharacter to aPtr
           invoke self "at" using lnkCharIndexPosition
                   returning lnkOtherCharacter
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           call "CBL_CLASSIFY_DBCS_CHAR" using lnkCharacter
                                               stringStartPosition
                                               stringOffset
                                               charLengthInBytes
           move charLengthInBytes to byteSize
           call "CBL_CLASSIFY_DBCS_CHAR" using lnkOtherCharacter
                                               stringStartPosition
                                               stringOffset
                                               charLengthInBytes
           move charLengthInBytes to otherByteSize
           if byteSize = otherByteSize
               if lnkCharacter(1:byteSize) =
                  lnkOtherCharacter(1:otherByteSize)
                   set lnkIsTrue to true
               else
                   set lnkIsFalse to true
               end-if
           else
               set lnkIsFalse to true
           end-if
           invoke self "dealloc" using aPtr
           exit method.
       end method "isat".


      *>---------------------------------------------------------------
      *> Store lnkNewChar at position lnkCharIndexPosition. Raise an
      *> exception if anIndex is outside the bounds of the array.
      *>
      *>---------------------------------------------------------------
       method-id. "atPut".

       local-storage section.
       01 aPtr                     usage pointer.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
       01 charCount                pic x(4) comp-5.
       01 indexOffset              pic x(4) comp-5.
       01 oldBytePosition          pic x(4) comp-5.
       01 newBytePosition          pic x(4) comp-5.
       01 oldByteLength            pic x(4) comp-5.
       01 newByteLength            pic x(4) comp-5.
       01 oldCharLengthInBytes     pic x(4) comp-5.
       01 newCharLengthInBytes     pic x(4) comp-5.
       01 byteIndexPosition        pic x(4) comp-5.
       01 newStorageRequirements   pic x(4) comp-5.
       01 byteStorageDifference    pic s9(9) comp-5.

       linkage section.
       01 lnkCharIndexPosition     pic s9(9) comp-5.
       01 lnkNewChar               pic xx.

       01 lnkNewString.
          03 lnkNewByte            pic x occurs 0 to maxNumberBytes
                                   depending on newStorageRequirements.

       procedure division using lnkCharIndexPosition lnkNewChar.
           if lnkCharIndexPosition < 1 or
              lnkCharIndexPosition > NumberOfCharacters
               invoke self "errorInBounds"
           else
       *>>
       *>> Initialisation.
       *>>
               add 1 to StorageRequirements
                       giving newStorageRequirements
               invoke self "malloc" using newStorageRequirements
                                    returning aPtr
               set address of lnkNewString to aPtr
       *>>
       *>> Locate the byte position of the character to be replaced,
       *>> and determine its length in bytes.
       *>>
               move 1 to stringStartPosition
               move 1 to stringOffset
               move zero to charLengthInBytes
               add 1 to indexedDataOffset giving indexOffset
               perform varying charCount from 1 by 1
                 until charCount > lnkCharIndexPosition
                   call "CBL_CLASSIFY_DBCS_CHAR" using
                     instancedata(indexOffset:storageRequirements)
                     stringStartPosition
                     stringOffset
                     charLengthInBytes
                   add charLengthInBytes to stringOffset
                   add charLengthInBytes to stringStartPosition
               end-perform
               move charLengthInBytes to OldCharLengthInBytes
               subtract charLengthInBytes from stringOffset
                                          giving byteIndexPosition
       *>>
       *>> Determine the length in bytes of the new replacement
       *>> character.
       *>>
               move 1 to stringStartPosition
               move 1 to stringOffset
               move zero to charLengthInBytes
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkNewChar
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes
               move charLengthInBytes to newCharLengthInBytes
       *>>
       *>> Move all the characters before the replacement character,
       *>> to the new string.
       *>>
               move indexOffset to oldBytePosition
               subtract 1 from byteIndexPosition giving oldByteLength
               move 1 to newBytePosition
               move oldByteLength to newByteLength
               move instanceData(oldBytePosition:oldByteLength) to
                   lnkNewString(newBytePosition:newByteLength)
               add oldByteLength to oldBytePosition
       *>>
       *>> Move the new replacement character to the new string.
       *>>
               add newByteLength to newBytePosition
               move newCharLengthInBytes to newByteLength
               move lnkNewChar(1:newByteLength) to
                    lnkNewString(newBytePosition:newByteLength)
       *>>
       *>> Ignore the character which will be replaced.
       *>>
               add oldCharLengthInBytes to oldBytePosition
       *>>
       *>> Move all the characters after the replacement character,
       *>> to the new string.
       *>>
               add newByteLength to newBytePosition
               compute oldByteLength = storageRequirements +
                                       indexedDataOffset -
                                       oldBytePosition + 1
               move oldByteLength to newByteLength
               move instanceData(oldBytePosition:oldByteLength) to
                    lnkNewString(newBytePosition:newByteLength)
       *>>
       *>> Calculate the new storage requirements.
       *>>
               subtract oldCharLengthInBytes from newCharLengthInBytes
                       giving byteStorageDifference
               add byteStorageDifference to storageRequirements
       *>>
       *>> Update the old DBCS character array using the new string
       *>>
               move lnkNewString(1:storageRequirements) to
                       instanceData(indexOffset:storageRequirements)
       *>>
       *>> De-allocate used memory.
       *>>
               invoke self "dealloc" using aPtr
               move x"00" to
                 instancedata
                     (indexeddataoffset + storageRequirements + 1: 1)

           end-if
           exit method.
       end method "atPut".
      *>----------------------------------------------------------------
      *> Return self as this is already an Array.
      *>----------------------------------------------------------------
       method-id. "asArray".

       linkage section.
       01 lnkArrayObject       usage object reference.

       procedure division returning lnkArrayObject.
           invoke self "basicCopy" returning lnkArrayObject
           exit method.
       end method "asArray".
      *>----------------------------------------------------------------
      *> Delimits the character array by white space and places each
      *> delimited string element into an Array of references. White
      *> space in this method, is defined as being any single-byte
      *> character with an ascii value that is less than or equal to 32
      *> (space), or the double-byte space value.
      *>----------------------------------------------------------------
       method-id. "asArrayOfSubstrings".

       local-storage section.
       01 lsClass                  usage object reference.
       01 lsByteSize                   pic s9(9) comp-5.
       01 lsCharSize                   pic s9(9) comp-5.
       01 lsPtr                        usage pointer.
       01 lsCollectionSize             pic s9(9) comp-5.
       01 lsOrderedCollectionObject    usage object reference.
       01 lsSearchStatus               pic x comp-5.
          88 lsSearchForNonNoiseChar               value 0.
          88 lsSearchForNoiseChar                  value 1.
       01 lsWordStart                  pic s9(9) comp-5.
       01 lsWordByteLength             pic s9(9) comp-5.
       01 lsWordCharLength             pic s9(9) comp-5.
       01 lsCharIndex                  pic s9(9) comp-5.
       01 lsByteIndex                  pic s9(9) comp-5.
       01 lsWordObject                 usage object reference.
       01 lsCharLengthInBytes          pic s9(9) comp-5.
          88 lsSingleByteChar                      value 1.
          88 lsDoubleByteChar                      value 2.
       01 lsDBspace                    pic x(2).
       01 lsSBCSClass                  usage object reference.

       linkage section.
       01 lnkArrayObject               usage object reference.
       01 lnkRealString.
          03 lnkRealChar               pic x occurs 0 to maxNumberBytes
                                         depending on lsByteSize.

       procedure division returning lnkArrayObject.
           invoke self "sizeInBytes"
                       returning lsByteSize
           invoke self "malloc"
                           using lsByteSize
                       returning lsPtr
           set address of lnkRealString to lsPtr
           invoke self "getValue"
                       returning lnkRealString
           move 10 to lsCollectionSize

           invoke selfclass "getDBCSspace"
                       returning lsDBspace
           invoke OrderedCollection "ofReferences"
                           using lsCollectionSize
                       returning lsOrderedCollectionObject
           invoke self "size"
                       returning lsCharSize
           set lsSearchForNonNoiseChar to true
           move zero to lsWordByteLength
           move zero to lsWordCharLength
           move 1 to lsByteIndex
           invoke self "getSBCSClass" returning lsSBCSClass
           perform varying lsCharIndex from 1 by 1
             until lsCharIndex > lsCharSize
               invoke lsClass "charLengthInBytes"
                           using lnkRealString(lsByteIndex:1)
                       returning lsCharLengthInBytes
               if lsSearchForNonNoiseChar
                   if lsSingleByteChar
                       if lnkRealString(lsByteIndex:1)
                         = space or x"00"
                           continue
                       else
                           move lsByteIndex to lsWordStart
                           add 1 to lsWordCharLength
                           add 1 to lsWordByteLength
                           set lsSearchForNoiseChar to true
                       end-if
                   else
                       if lnkRealString(lsByteIndex:2) = lsDBspace
                           continue
                       else
                           move lsByteIndex to lsWordStart
                           add 1 to lsWordCharLength
                           add 2 to lsWordByteLength
                           set lsSearchForNoiseChar to true
                       end-if
                   end-if
               else
                   if lsSingleByteChar
                       if lnkRealString(lsByteIndex:1) = space or x"00"
                           set lsSearchForNonNoiseChar to true
                           invoke lsSBCSClass "withLengthValue"
                                           using lsWordCharLength
                                                 lnkRealString(
                                                   lsWordStart:
                                                   lsWordByteLength)
                                       returning lsWordObject
                           invoke lsOrderedCollectionObject "add"
                                           using lsWordObject
                           move zero to lsWordByteLength
                           move zero to lsWordCharLength
                       else
                           add 1 to lsWordByteLength
                           add 1 to lsWordCharLength
                       end-if
                   else
                       if lnkRealString(lsByteIndex:2) = lsDBspace
                           set lsSearchForNonNoiseChar to true
                           invoke lsSBCSClass "withLengthValue"
                                           using lsWordCharLength
                                                 lnkRealString(
                                                   lsWordStart:
                                                   lsWordByteLength)
                                       returning lsWordObject
                           invoke lsOrderedCollectionObject "add"
                                           using lsWordObject
                           move zero to lsWordByteLength
                           move zero to lsWordCharLength
                       else
                           add 2 to lsWordByteLength
                           add 1 to lsWordCharLength
                       end-if
                   end-if
               end-if
               add lsCharLengthInBytes to lsByteIndex
           end-perform
           if lsWordCharLength = zero
               continue
           else
               invoke self "getsbcsclass" returning lsClass
               invoke lsclass "withLengthValue"
                               using lsWordCharLength
                                     lnkRealString(lsWordStart:
                                       lsWordByteLength)
                           returning lsWordObject
               invoke lsOrderedCollectionObject "add"
                               using lsWordObject
           end-if
           invoke lsOrderedCollectionObject "asArray"
                       returning lnkArrayObject
           invoke lsOrderedCollectionObject "finalize"
                       returning lsOrderedCollectionObject
           invoke self "dealloc"
                           using lsPtr
           exit method.
       end method "asArrayOfSubstrings".
      *>---------------------------------------------------------------
      *> Raise an exception as elements cannot be added to instances of
      *> DBCS Character Array.
      *>---------------------------------------------------------------
       method-id. "add".

       local-storage section.
       01 exceptionNumber      pic s9(9) comp-5.

       linkage section.
       01 lnkvoidParam        pic x.

       procedure division using lnkvoidParam.
           move 1 to exceptionNumber
           invoke self "raiseException" using exceptionnumber
           exit method.
       end method "add".
      *>----------------------------------------------------------------
      *> Return a new Character Array of the same species, size and
      *> contents.
      *>----------------------------------------------------------------
       method-id. "deepcopy".

       linkage section.
       01 lnkNewCharacterArray usage object reference.

       procedure division returning lnkNewCharacterArray.
           invoke self "copy" returning lnkNewCharacterArray
           exit method.
       end method "deepcopy".
      *>------------------------------------------------------------
      *> Return the DBCS Character Array size in bytes.
      *>------------------------------------------------------------
       Method-id. "sizeInBytes".

       linkage section.
       01 lnkByteSize          pic x(4) comp-5.

       procedure division returning lnkByteSize.
           move storageRequirements to lnkByteSize.
           exit method.
       end method "sizeInBytes".
      *>------------------------------------------------------------
      *> Return the size of the DBCS Character Array in characters.
      *>------------------------------------------------------------
       Method-id. "size".

       linkage section.
       01 lnkCharSize          pic s9(9) comp-5.

       procedure division returning lnkCharSize.
           move numberOfCharacters to lnkCharSize
           exit method.
       end method "size".
      *>----------------------------------------------------------------
      *> Return True if the DBCS Character Array indicated by
      *> lnkcompareValue and lnkCompareCharLength is Equal to this DBCS
      *> Character Array else return False.
      *>
      *> lnkCompareCharLength is the length in characters.
      *>----------------------------------------------------------------
       method-id. "equalbyLengthValue".

       local-storage section.
       01 charCount                pic x(4) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.

       linkage section.
       01 lnkCompareValue.
           03 lnkByte              pic x.

       01 lnkBool                   pic x comp-5.
           88  lnkIsFalse                          value 0.
           88  lnkIsTrue                           value 1.

       01 lnkCompareCharLength     pic x(4) comp-5.

       procedure division using lnkCompareCharLength lnkCompareValue
                          returning lnkBool.

           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           perform varying charCount from 1 by 1
             until charCount > lnkCompareCharLength
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkCompareValue
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
           subtract 1 from stringOffset
           if lnkCompareValue(1:stringOffset) =
              instanceData(indexedDataOffset + 1:storageRequirements)
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           exit method.
       end method "equalbyLengthValue".
      *>----------------------------------------------------------------
      *> Return +1 if this DBCS Character Array is greater than
      *>           lnkArray.
      *> Return -1 if this DBCS Character Array is less than lnkArray.
      *> Return  0 if this DBCS Character Array is equal to lnkArray.
      *>----------------------------------------------------------------
       method-id. "compareTo".

       local-storage section.
       01 compareByteLength    pic x(4) comp-5.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkCompareValue.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                       depending on compareByteLength.
       01 lnkArray             usage object reference.
       01 lnkResult            pic s9(9) comp-5.
           88  lnkGreaterThan value  1.
           88  lnkLessThan    value -1.
           88  lnkEqual       value  0.

       procedure division using lnkArray returning lnkResult.
           invoke lnkArray "sizeInBytes" returning compareByteLength
           invoke self "malloc" using compareByteLength
                                returning aPtr
           set address of lnkCompareValue to aPtr
           invoke lnkArray "getValue" returning lnkCompareValue
           if instancedata(indexedDataOffset + 1:
                             storageRequirements)  < lnkCompareValue
               set lnkLessThan to true
           else
               if instancedata(indexeddataoffset + 1:
                             storagerequirements) > lnkCompareValue
                   set lnkGreaterThan to true
               else
                   set lnkEqual to true
               end-if
           end-if
           invoke self "dealloc" using aPtr
           exit method.
       end method "compareTo".
      *>----------------------------------------------------------------
      *> Return True if this Character Array is greater than the
      *> Character Array indicated by lnkCompareValue and
      *> lnkCompareCharLength else return False.
      *>
      *> lnkCompareCharLength is the length in characters.
      *>----------------------------------------------------------------
       method-id. "greaterThanByLengthValue".

       local-storage section.
       01 charCount                pic x(4) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.

       linkage section.
       01 lnkCompareValue.
          03 lnkByte           pic x.

       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       01 lnkCompareCharLength pic x(4) comp-5.

       procedure division using lnkCompareCharLength lnkCompareValue
                          returning lnkBool.

           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           perform varying charCount from 1 by 1
             until charCount > lnkCompareCharLength
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkCompareValue
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
           subtract 1 from stringOffset
           if instancedata(indexedDataOffset + 1:storageRequirements) >
              lnkCompareValue(1:stringOffset)
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           exit method.
       end method "greaterThanByLengthValue".
      *>----------------------------------------------------------------
      *> Return true if the value of this DBCS Character Array is less
      *> than or equal to the value of lnkArray.
      *>----------------------------------------------------------------
       method-id. "lessThanOrEqual".

       local-storage section.
       01 CompareByteLength        pic x(4) comp-5.
       01 aPtr                     usage pointer.

       linkage section.
       01 lnkCompareValue.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on CompareByteLength.

       01 lnkArray                 usage object reference.
       01 lnkBool                  pic x comp-5.
          88 lnkIsFalse                            value 0.
          88 lnkIsTrue                             value 1.

       procedure division using lnkArray returning lnkBool.
           invoke lnkArray "sizeInBytes" returning CompareByteLength
           invoke self "malloc" using compareByteLength returning aPtr
           set address of lnkCompareValue to aPtr
           invoke lnkArray "getValue" returning lnkCompareValue
           if instanceData(indexedDataOffset + 1:
                           storageRequirements) <= lnkCompareValue
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           invoke self "dealloc" using aPtr
           exit method.
       end method "lessThanOrEqual".
      *>----------------------------------------------------------------
      *> Return true if the value of this DBCS Character Array is
      *> greater than or equal to the value of lnkArray.
      *>----------------------------------------------------------------
       method-id. "greaterThanOrEqual".

       local-storage section.
       01 compareByteLength    pic x(4) comp-5.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkCompareValue.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                   depending on compareByteLength.

       01 lnkArray             usage object reference.
       01 lnkBool              pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       procedure division using lnkArray returning lnkBool.
           invoke lnkArray "sizeInBytes" returning compareByteLength
           invoke self "malloc" using compareByteLength returning aPtr
           set address of lnkCompareValue to aPtr
           invoke lnkArray "getValue" returning lnkCompareValue
           if instanceData(indexedDataOffset + 1:
                       storageRequirements) >= lnkCompareValue
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           invoke self "dealloc" using aPtr
           exit method.
       end method "greaterThanOrEqual".
      *>----------------------------------------------------------------
      *> Return True if the DBCS Character Array indicated by
      *> lnkCompareValue and lnkCompareCharLength is Equal to this DBCS
      *> Character Array else return False. However the comparison
      *> ignores the case of the characters.
      *>
      *> lnkCompareCharLength is the number of characters to compare.
      *>----------------------------------------------------------------
       method-id. "equalsIgnoreCasebyLengthValue".

       local-storage section.
       01 copyAnObject             usage object reference.

       linkage section.
       01 lnkCompareValue.
          03 lnkByte               pic x.

       01 lnkCompareCharLength     pic x(4) comp-5.

       01 lnkBool                   pic x comp-5.
          88 lnkIsFalse                            value 0.
          88 lnkIsTrue                             value 1.


       procedure division using lnkCompareCharLength lnkCompareValue
                          returning lnkBool.

           invoke selfClass "withLengthValue" using lnkCompareCharLength
                                                    lnkCompareValue
                                          returning copyAnObject
           invoke self "equalsIgnoreCase" using copyAnObject
                                      returning lnkBool.
           invoke copyAnObject "finalize" returning copyAnObject
           exit method.
       end method "equalsIgnoreCasebyLengthValue".
      *>-------------------------------------------------------------
      *> Return True if this DBCScharacterArray is less than the
      *> CharacterArray indicated by lnkCompareValue and
      *> lnkCompareCharLength, otherwise returns False.
      *>-------------------------------------------------------------
       method-id. "lessThanByLengthValue".

       local-storage section.
       01 charCount                pic x(4) comp-5.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.

       linkage section.
       01 lnkCompareValue      pic xx.

       01 lnkBool               pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       01 lnkCompareCharLength pic x(4) comp-5.

       procedure division using lnkCompareCharLength lnkCompareValue
                      returning lnkBool.

           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           perform varying charCount from 1 by 1
             until charCount > lnkCompareCharLength
               call "CBL_CLASSIFY_DBCS_CHAR" using lnkCompareValue
                                                   stringStartPosition
                                                   stringOffset
                                                   charLengthInBytes
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
           subtract 1 from stringOffset
           if instancedata(indexeddataoffset + 1:storagerequirements) <
                 lnkCompareValue(1:stringOffset)
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           exit method.
       end method "lessThanByLengthValue".
      *>----------------------------------------------------------------
      *> Set the value of this DBCS Character Array to lnkString.
      *>----------------------------------------------------------------
       method-id. "setValue".

       local-storage section.
       01 byteSize         pic s9(9) comp-5.

       linkage section.
       01 lnkString.
           03 lnkByte      pic x occurs 1 to maxNumberBytes
                               depending on byteSize.

       procedure division using lnkString.
           invoke selfClass "stringLengthInBytes"
                   using lnkString
                         numberOfCharacters
               returning byteSize
           move lnkString to
               instanceData(indexedDataOffset + 1:byteSize)
           move byteSize to storageRequirements
           exit method.
       end method "setValue".
      *>----------------------------------------------------------------
      *> Concatenate this DBCS Character Array with the DBCS Character
      *> Array lnkobject returning the resulting new string in lnkObject
      *>----------------------------------------------------------------
       method-id. "concat".

       local-storage section.
       01 ObjectByteSize       pic s9(9) comp-5.
       01 NewObjectByteSize    pic s9(9) comp-5.
       01 NewObjectCharSize    pic s9(9) comp-5.
       01 aBool                pic x comp-5.
          88 isFalse                               value 0.
          88 isTrue                                value 1.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkWorkingString1.
          03 lnkByte1          pic x occurs 1 to maxnumberbytes
                                   depending on NewObjectByteSize.

       01 lnkNewString         usage object reference.
       01 lnkObject            usage object reference.

       procedure division using lnkObject returning lnkNewString.
           invoke self "isCompatible" using lnkObject
                       returning aBool
           if isTrue
               invoke lnkObject "sizeInBytes" returning ObjectByteSize
               add ObjectByteSize to storageRequirements
                   giving NewObjectByteSize
               invoke self "malloc"
                       using NewObjectByteSize
                   returning aPtr
               set address of lnkWorkingString1 to aPtr
               move instanceData(indexedDataOffset + 1:
                    storageRequirements) to
                    lnkWorkingString1(1:storageRequirements)
               invoke lnkObject "getValue"
                   returning lnkWorkingString1(storagerequirements + 1:
                             ObjectByteSize)
               invoke selfClass "stringLengthInChars"
                       using lnkWorkingString1 NewObjectByteSize
                   returning NewObjectCharSize
               invoke selfClass "withLengthValue"
                           using NewObjectCharSize
                                 lnkWorkingString1
                       returning lnknewstring
               invoke self "dealloc" using aptr
           else
               invoke self "compatiblityError" returning lnkNewString
           end-if
           exit method.
       end method "concat".
      *>----------------------------------------------------------------
      *> Return the value of this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "getValue".
       linkage section.
       01 lnkString.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                   depending on storageRequirements.

       procedure division returning lnkString.
           move instanceData(indexedDataOffset + 1:storageRequirements)
               to lnkString
           exit method.
       end method "getValue".

      *>----------------------------------------------------------------
      *> Returns the first lnksize bytes of this characterarray
      *>----------------------------------------------------------------
       method-id. "getValueWithSize".
       linkage section.
       01 lnksize          pic 9(9) comp-5.
       01 lnkstring        pic x.
        
       procedure division using lnksize returning lnkstring.
           if storagerequirements < lnksize
             move instancedata(indexedDataOffset + 1
                       : storagerequirements)
               to lnkstring(1 : lnksize)
           else
             move instancedata(indexedDataOffset + 1 : lnksize)
               to lnkstring(1 : lnksize)
           end-if
           exit method.
       end method "getValueWithSize".

      *>----------------------------------------------------------------
      *> Returns the lnksize bytes of this characterarray starting
      *> at position lnkoffset.
      *>----------------------------------------------------------------
       method-id. "getValueWithSizeAtPosition".
       linkage section.
       01 lnksize          pic 9(9) comp-5.
       01 lnkoffset        pic 9(9) comp-5.
       01 lnkstring        pic x.
       procedure division using lnkoffset lnksize returning lnkstring.
           if storagerequirements < lnksize + lnkoffset - 1
             move instancedata(indexedDataOffSet +
                           lnkoffset : storagerequirements)
               to lnkstring(1 : lnksize)
           else
             move instancedata(indexedDataOffset +
                           lnkoffset : lnksize)
               to lnkstring(1 : lnksize)
           end-if
           exit method.
       end method "getValueWithSizeAtPosition".

      *>----------------------------------------------------------------
      *> Returns the value of this character array as null terminated.
      *> Warning: If the buffer lnkstring is not large enough to hold
      *> the value in the characterarray plus one byte for the null,
      *> then data corruption will occur. Invoking the method
      *> "sizeinbytes" will enable you to check if the buffer is
      *> large enough.
      *>----------------------------------------------------------------
       method-id. "getValueZ".
       linkage section.
       01 lnkstring     pic x.
       procedure division returning lnkstring.
           move instancedata(indexedDataOffset + 1:storagerequirements)
               to lnkstring(1:storagerequirements)
           move x"00" to lnkString(storageRequirements + 1: 1)
           exit method.
       end method "getValueZ".

      *>----------------------------------------------------------------
      *> Return the value of this DBCS Character Array as a parameter.
      *> e.g. null terminated.
      *>
      *>----------------------------------------------------------------
       method-id. "asParameter".
       linkage section.
       01 lnkString.
           03 abyte        pic x occurs 1 to maxNumberBytes
                           depending on storageRequirements.

       procedure division returning lnkString.
           move instanceData
                     (indexedDataOffset + 1:storageRequirements)
               to lnkstring
           move x"00" to lnkString(storageRequirements + 1:1)
           exit method.
       end method "asParameter".
      *>----------------------------------------------------------------
      *> Display this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "display".
       procedure division.
           display instanceData
                 (indexedDataOffset + 1:storageRequirements)
                 with no advancing
           exit method.
       end method "display".
      *>----------------------------------------------------------------
      *> Creates a new DBCS Character Array which is a lowercase
      *> version of the current DBCS Character Array.
      *>
      *> lnkNewString holds the Object Reference of the lowercase
      *> DBCS Character array; this is returned.
      *>----------------------------------------------------------------
       method-id. "asLowercase".

       local-storage section.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkWorkingString1.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                   depending on storageRequirements.

       01 lnkNewString         usage object reference.

       procedure division returning lnkNewString.
           invoke self "malloc" using storageRequirements
                            returning aPtr
           set address of lnkWorkingString1 to aPtr
           invoke self "getValue" returning lnkWorkingString1
           call "CBL_TOLOWER" using lnkWorkingString1
                               by value storageRequirements
           invoke selfClass "withLengthValue" using numberOfCharacters
                                                    lnkWorkingString1
                                       returning lnkNewString
           invoke self "dealloc" using aPtr
           exit method.
       end method "asLowercase".
      *>----------------------------------------------------------------
      *> Return an ordered collection of DBCS Character Arrays which
      *> represents each separate line of this character array, where
      *> lines are delimited by linefeed characters, x"0A".
      *>----------------------------------------------------------------
       method-id. "asSeparateLines".

       working-storage section.
       01 lineFeedCharacter    pic x value x"0A".

       local-storage section.
       01 lsClass                  usage object reference.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteCharacter                   value 1.
          88 doubleByteCharacter                   value 2.

       01 stringLength             pic s9(9) comp-5.
       01 stringStartOfLine        pic s9(9) comp-5.
       01 initialCollectionSize    pic s9(9) comp-5.
       01 characterCount           pic s9(9) comp-5.
       01 aLine                    usage object reference.
       01 lsSBCSClass              usage object reference.

       linkage section.
       01 lnkCollection            usage object reference.

       procedure division returning lnkCollection.
      *>>
      *>> Initialise the collection size to 5.
      *>>
           move 5 to initialCollectionSize
           invoke orderedCollection "ofReferences"
               using initialCollectionSize returning lnkCollection
      *>>
      *>>-------------------------------------------------------------
      *>> Search the DBCS Character Array delimited by the linefeed
      *>> character, creating a new Character Array for each delimited
      *>> string, storing its object reference within a collection.
      *>> The collection object reference is returned.
      *>>--------------------------------------------------------------
      *>>
           move 1 to stringStartOfLine
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to charLengthInBytes
           move zero to characterCount
           invoke self "getsbcsclass" returning lsSBCSClass
           perform until stringOffset > storageRequirements
               call "CBL_CLASSIFY_DBCS_CHAR" using
                   instanceData(indexedDataOffset + 1:
                                storageRequirements)
                   stringStartPosition
                   stringOffset
                   CharLengthInBytes
      *>>
      *>> Only take an action on single-byte linefeed characters.
      *>>
               if singleByteCharacter
                   if instanceData(indexedDataOffset + stringOffset:1) =
                     LineFeedCharacter
                       subtract stringStartOfLine from stringOffset
                           giving stringLength
      *>>
      *>> Create a character array of the delimited string, storing
      *>> its object reference within a collection.
      *>>
                       if characterCount = zero
                           continue
                       else
                           invoke lsSBCSClass "withLengthValue"
                               using characterCount
                                     instancedata(indexedDataOffset +
                                     stringStartOfLine:StringLength)
                           returning aLine
                           invoke lnkCollection "add"
                               using aLine
                       end-if
       *>>
       *>> Reposition the string delimiter pointer.
       *>>
                       add 1 stringOffset giving stringStartOfLine
                       move zero to characterCount
                   else
                       add 1 to characterCount
                   end-if
               else
                   add 1 to characterCount
               end-if
       *>>
       *>> Reposition the character array pointer.
       *>>
               add charLengthInBytes to stringOffset
               add charLengthInBytes to stringStartPosition
           end-perform
       *>>
       *>> The last string within the DBCS character array may not have
       *>> a linefeed delimiter. Therefore, a character array must still
       *>> be created for it, and its object reference storing within
       *>> the collection.
       *>>
           if stringStartOfLine <= storageRequirements
               compute stringLength = storageRequirements -
                                      stringStartOfLine + 1
               if characterCount = zero
                   continue
               else
                   invoke self "getsbcsclass" returning lsClass
                   invoke lsClass "withLengthValue"
                               using characterCount
                                     instanceData(indexedDataOffset +
                                     stringStartOfLine:stringLength)
                           returning aline
                   invoke lnkCollection "add"
                               using aLine
               end-if
           end-if
           exit method.
       end method "asSeparateLines".
      *>----------------------------------------------------------------
      *> Return a new DBCS Character Array which is an uppercase
      *> version of the current DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asUppercase".
       local-storage section.
       01 aPtr                 usage pointer.
       linkage section.
       01 lnkWorkingString1.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                   depending on storageRequirements.
       01 lnkNewString         usage object reference.

       procedure division returning lnkNewString.
           invoke self "malloc" using storageRequirements
                            returning aPtr
           set address of lnkWorkingString1 to aPtr
           invoke self "getValue" returning lnkWorkingString1
           call "CBL_TOUPPER" using lnkWorkingString1
                           by value storageRequirements
           invoke selfClass "withLengthValue" using numberOfCharacters
                                                    lnkWorkingString1
                                          returning lnkNewString
           invoke self "dealloc" using aPtr
           exit method.
       end method "asUppercase".
      *>----------------------------------------------------------------
      *> Return an instance of cobolpicx which has the same value as
      *> this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asPicx".

       local-storage section.
       01 aClass               usage object reference.
       01 charSize             pic x(4) comp-5.

       linkage section.
       01 lnkNewString         usage object reference.

       procedure division returning lnkNewString.
           invoke self "size" returning charSize
           invoke cobolPicX "newClass" using charSize
                                   returning aClass
           invoke aClass "withValue" using instanceData
                         (indexedDataOffset + 1:storageRequirements)
                   returning lnkNewString
           exit method.
       end method "asPicx".
      *>----------------------------------------------------------------
      *> Return a new Character Array which is stripped of all its
      *> leading and trailing space characters.
      *>----------------------------------------------------------------
       method-id. "trimBlanks".

       local-storage section.
       01 lsClass                  usage object reference.
       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteCharacter                   value 1.
          88 doubleByteCharacter                   value 2.

       01 DBCSSpace                pic x(2).
       01 CharacterType            pic x(4) comp-5.
          88 noCharactersFound                     value 1.
          88 nonSpaceCharacterFound                value 2.

       01 pseudoStringStart        pic x(4) comp-5.
       01 pseudoStringEnd          pic x(4) comp-5.
       01 pseudoByteSize           pic x(4) comp-5.
       01 pseudoCharSize           pic x(4) comp-5.

       linkage section.
       01 lnkobject                usage object reference.

       procedure division returning lnkobject.
      *>>
      *>> Check for leading space characters.
      *>>
           move 1 to stringStartPosition
           move 1 to stringOffset
           move zero to CharLengthInBytes
           set noCharactersFound to True
           invoke selfClass "getDBCSSpace" returning DBCSSpace
           perform until nonSpaceCharacterFound or
                         stringOffset > storageRequirements
               call "CBL_CLASSIFY_DBCS_CHAR" using
                 instanceData(indexedDataOffset + 1:storageRequirements)
                 stringStartPosition
                 stringOffset
                 CharLengthInBytes
               if singleByteCharacter
                   if instanceData(indexedDataOffset + stringOffset:1)
                     = space
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                   else
                       set nonSpaceCharacterFound to true
                   end-if
               else
                   if instanceData(indexedDataOffset + stringOffset:2)
                     = DBCSSpace
                       add charLengthInBytes to stringOffset
                       add charLengthInBytes to stringStartPosition
                   else
                       set nonSpaceCharacterFound to true
                   end-if
               end-if
           end-perform
           move stringOffset to pseudoStringStart
       *>>
       *>> Check for trailing space characters.
       *>>
           if nonSpaceCharacterFound
               set noCharactersFound to true
       *>>     move 1 to stringStartPosition *>> start from last pos.
               move storageRequirements to stringOffset
               move zero to charLengthInBytes
               perform until nonSpaceCharacterFound
                   call "CBL_CLASSIFY_DBCS_CHAR" using
                     instanceData(indexedDataOffset + 1:
                       storageRequirements)
                     stringStartPosition
                     stringOffset
                     CharLengthInBytes
                   if singleByteCharacter
                       if instanceData(indexedDataOffset +
                         stringOffset:1) = space
                           subtract 1 from stringOffset
                       else
                           set nonSpaceCharacterFound to true
                       end-if
                   else
                       if instanceData(indexedDataOffset +
                         stringOffset:2) = DBCSSpace
       *>>
       *>> The stringOffset has already been adjusted to the first
       *>> byte of the Double-Byte Character.
       *>>
                           subtract 1 from stringOffset
                       else
       *>>
       *>> Ensure that both of the bytes of the Double-Byte Character
       *>> are included.
       *>>
                           add 1 to stringOffset
                           set nonSpaceCharacterFound to true
                       end-if
                   end-if
               end-perform
               move stringOffset to pseudoStringEnd
       *>>
       *>> Determine the number of characters between the
       *>> pseudoStringStart and the pseudoStringEnd
       *>>
               move 1 to StringStartPosition
               move zero to CharLengthInBytes
               move zero to pseudoCharSize
               compute pseudoByteSize = pseudoStringEnd -
                                        pseudoStringStart + 1
               move pseudoStringStart to stringOffset
               perform until stringOffset > pseudoStringEnd
                   call "CBL_CLASSIFY_DBCS_CHAR" using
                     instanceData(indexedDataOffset + 1:
                       storageRequirements)
                     stringStartPosition
                     stringOffset
                     CharLengthInBytes
                   add CharLengthInBytes to stringOffset
                   add 1 to pseudoCharSize
               end-perform
           else
               move zero to pseudoCharSize
               move zero to pseudoByteSize
           end-if
           invoke self "getsbcsclass" returning lsClass
           invoke lsClass "withLengthValue"
             using pseudoCharSize
                   instanceData(indexedDataOffset + pseudoStringStart:
                     pseudoByteSize)
             returning lnkObject
           exit method.
       end method "trimBlanks".
      *>----------------------------------------------------------------
      *> Return True if this DBCS Character Array is less than the
      *> DBCS Character Array lnkArray else return False.
      *>----------------------------------------------------------------
       method-id. "lessThan".

       local-storage section.
       01 compareByteLength        pic x(4) comp-5.
       01 aPtr                     usage pointer.

       linkage section.
       01 lnkCompareValue.
           03 lnkByte              pic x occurs 1 to maxNumberBytes
                                       depending on compareByteLength.
       01 lnkCharacterArray        usage object reference.
       01 lnkBool                  pic x comp-5.
          88 lnkIsFalse                            value 0.
          88 lnkIsTrue                             value 1.

       procedure division using lnkCharacterArray returning lnkBool.
           invoke lnkCharacterArray "sizeInBytes"
               returning compareByteLength
           invoke self "malloc" using CompareByteLength returning aPtr
           set address of lnkCompareValue to aPtr
           invoke lnkCharacterArray "getValue" returning lnkCompareValue
           if instanceData(indexedDataOffset + 1:
                             storageRequirements) < lnkCompareValue
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           invoke self "dealloc" using aPtr
           exit method.
       end method "lessThan".
      *>----------------------------------------------------------------
      *> Return True if this DBCS Character Array is greater than the
      *> DBCS Character Array lnkArray else return False.
      *>----------------------------------------------------------------
       method-id. "greaterThan".

       local-storage section.
       01 compareByteLength        pic x(4) comp-5.
       01 aPtr                     usage pointer.

       linkage section.
       01 lnkCompareValue.
          03 lnkByte               pic x occurs 1 to maxNumberBytes
                                       depending on compareByteLength.

       01 lnkCharacterArray        usage object reference.

       01 lnkBool                  pic x comp-5.
          88 lnkIsFalse                            value 0.
          88 lnkIsTrue                             value 1.

       procedure division using lnkCharacterArray returning lnkBool.
           invoke lnkCharacterArray "sizeInBytes"
                   returning compareByteLength
           invoke self "malloc" using compareByteLength returning aPtr
           set address of lnkCompareValue to aPtr
           invoke lnkCharacterArray "getValue" returning lnkCompareValue
           if instanceData(indexedDataOffset + 1:
                             storageRequirements)  > lnkCompareValue
               set lnkIsTrue to true
           else
               set lnkIsFalse to true
           end-if
           invoke self "dealloc" using aptr
           exit method.
       end method "greaterThan".
      *>----------------------------------------------------------------
      *> Return true is this object is an indexed instance
      *>----------------------------------------------------------------
       method-id. "isIndexed".
       linkage section.
       01 lnkbool               pic x comp-5.
       procedure division returning lnkbool.
           move 1 to lnkBool
           exit method.
       end method "isIndexed".
      *>----------------------------------------------------------------
      *> Return storage requirements for this object
      *>----------------------------------------------------------------
       method-id. "getStorageRequirements".
       linkage section.
       01 lnkRequirements       pic s9(9) comp-5.
       procedure division returning lnkRequirements.
           multiply numberOfCharacters by 2
                                   giving lnkRequirements
           exit method.
       end method "getStorageRequirements".
      *>----------------------------------------------------------------
      *> Return a copy of this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "copy".
       linkage section.
       01 result               usage object reference.

       procedure division returning result.
           invoke super "basicCopy" returning result
           exit method.
       end method "Copy".
      *>----------------------------------------------------------------
      *> Return true if lnkAnotherString is equal to this
      *> DBCS Character Array, otherwise false is returned.
      *>----------------------------------------------------------------
       method-id. "equal".

       local-storage section.
       01 anotherStringSize        pic x(4) comp-5.
       01 aPtr                     usage pointer.

       linkage section.
       01 lnkAnotherString         usage object reference.
       01 lnkString.
           03 lnkByte              pic x occurs 1 to maxNumberBytes
                                    depending on anotherStringSize.
       01 lnkBool                  pic x comp-5.
          88 isNotEqual                        value 0.
          88 isEqual                           value 1.

       procedure division using lnkAnotherString returning lnkBool.
           invoke lnkAnotherString "sizeInBytes"
                   returning anotherStringSize
           invoke self "malloc" using anotherStringSize returning aPtr
           set address of lnkString to aPtr
           invoke lnkAnotherString "getValue" returning lnkString
           if lnkString = instanceData
                (indexedDataOffset + 1:storageRequirements)
               set isEqual to true
           else
               set isNotEqual to true
           end-if
           invoke self "dealloc" using aptr
           exit method.
       end method "equal".
      *>----------------------------------------------------------------
      *> Return TRUE if the receiver is equal to lnkObject, else answer
      *> FALSE. The comparison is not case sensitive.
      *>
      *>----------------------------------------------------------------
       method-id. "equalsIgnoreCase".

       local-storage section.
       01 nullObject           usage object reference.
       01 copySelf             usage object reference.
       01 copyObject           usage object reference.

       linkage section.
       01 lnkObject            usage object reference.
       01 lnkBool               pic x comp-5.
          88 lnkIsFalse                        value 0.
          88 lnkIsTrue                         value 1.

       procedure division using lnkObject
                      returning lnkBool.
           invoke self "asUpperCase" returning copySelf
           invoke lnkObject "asUpperCase" returning copyObject
           invoke copySelf "equal" using copyObject
                                    returning lnkbool
           invoke copySelf "finalize" returning nullObject
           invoke copyObject "finalize" returning nullObject
           exit method.
       end method "equalsIgnoreCase".
      *>----------------------------------------------------------------
      *> Move the contents of lnkString to thisString. if lnkString is
      *> longer than this string it is truncated if it is shorter
      *> then this string is space filled.
      *>----------------------------------------------------------------
       method-id. "moveValue".

       local-storage section.
       01 charSize             pic s9(9) comp-5.
       01 byteSize             pic s9(9) comp-5.
       01 stringCharSize       pic s9(9) comp-5.
       01 stringByteSize       pic s9(9) comp-5.
       01 aPtr                 usage pointer.

       linkage section.
       01 lnkStringObject      usage object reference.
       01 lnkMoveString.
           03 lnkByte          pic x occurs 1 to maxNumberBytes
                                   depending on stringByteSize.

       procedure division using lnkStringObject.
           invoke lnkStringObject "size" returning stringCharSize
           invoke self "size" returning charSize
           invoke lnkStringObject "sizeInBytes" returning stringByteSize
           invoke self "malloc" using stringByteSize returning aPtr
           set address of lnkMoveString to aPtr
           invoke lnkStringObject "getValue" returning lnkMoveString
           if stringCharSize > charSize
               invoke selfClass "stringLengthInBytes"
                           using lnkMoveString
                                 charSize
                       returning byteSize
           else
               compute byteSize = charSize - stringCharSize +
                                  stringByteSize
           end-if
           move byteSize to storageRequirements
           move lnkMoveString to instanceData(indexedDataOffset + 1:
                                        storageRequirements)
           invoke self "dealloc" using aptr
           exit method.
       end method "moveValue".
      *>---------------------------------------------------------------
      *> Reset the contents of this string so it has the same contents
      *> as lnkStringObject.
      *>----------------------------------------------------------------
       method-id. "resetValue".

       local-storage section.
       01 stringByteSize       pic x(4) comp-5.
       01 stringCharSize       pic x(4) comp-5.
       01 anObject             usage object reference.

       linkage section.
       01 lnkStringObject      usage object reference.

       procedure division using lnkStringObject.
           invoke lnkStringObject "sizeInBytes" returning stringByteSize
           invoke lnkStringObject "size" returning stringCharSize
           invoke self "growTo" using stringCharSize returning anObject
           invoke lnkStringObject "getValue"
                   returning instanceData(indexedDataOffset + 1 :
                              stringByteSize)
           move stringCharSize to numberOfCharacters
           move stringByteSize to storageRequirements
           exit method.
       end method "resetValue".
      *>----------------------------------------------------------------
      *> Return the hash value of this Character Array.
      *>
      *>----------------------------------------------------------------
       method-id. "hash".

       local-storage section.
       01 aChar                    pic x.
       01 numChar redefines aChar  pic x comp-5.
       01 indexedOffset            pic x(4) comp-5.
       01 hashLoop                 pic x(4) comp-5.
       01 characterType            pic x(4) comp-5.
          88 noCharactersFound                 value 1.
          88 nonSpaceFound                     value 2.

       01 stringStartPosition      pic 9(4) comp.
       01 stringOffset             pic 9(4) comp.
       01 charLengthInBytes        pic 9(2) comp.
          88 singleByteChar                    value 1.
          88 doubleByteChar                    value 2.

       01 DBCSSpace                pic x(2).

       linkage section.
       01 lnkHashValue             pic s9(9) comp-5.

       procedure division returning lnkHashValue.
           move zero to lnkHashValue
           move 1 to stringStartPosition
           move storageRequirements to stringOffset
           move zero to charLengthInBytes
           set noCharactersFound to true
           add 1 to indexedDataOffset giving indexedOffset
           invoke selfClass "getDBCSSpace" returning DBCSSpace
           perform until nonSpaceFound or stringOffset = zero
               call "CBL_CLASSIFY_DBCS_CHAR" using
                 instancedata(indexedOffset:storageRequirements)
                 stringStartPosition
                 stringOffset
                 charLengthInBytes
               if singleByteChar
                   if instancedata(indexedDataOffset + stringOffset:1) =
                     space
                       subtract 1 from stringOffset
                   else
                       set nonSpaceFound to true
                   end-if
               else
                   if instancedata
                     (indexedDataOffset + StringOffset:2)
                      = DBCSSpace
       *>> stringOffset has already adjusted to the 1st byte of DBC.
                       subtract 1 from stringOffset
                   else
       *>> ensure both characters of DBC are included in the hash value.
                       add 1 to stringOffset
                       set nonSpaceFound to true
                   end-if
               end-if
           end-perform
           move stringOffset to hashLoop
           perform varying hashLoop from StringOffset by -1
             until hashLoop = zero
              move instanceData(indexedDataOffset + hashLoop:1) to aChar
              compute lnkHashValue = lnkHashValue * 47 + numChar
           end-perform
           if lnkHashValue < 0
               compute lnkHashValue = - lnkHashValue
           end-if
           exit method.
       end method "hash".
      *>----------------------------------------------------------------
      *> Quit the lowest level of iteration over DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "quitIteration".

       procedure division.
           set ooquit to true
           exit method.
       end method "quitIteration".


      *>----------------------------------------------------------------
      *> Return an instance of Bag with the same elements as this
      *> DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asBag".

       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           invoke Bag "withAll" using self returning lnkObject
           exit method.
       end method "asBag".
      *>----------------------------------------------------------------
      *> Return an instance of ValueSet with the same elements as this
      *> DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asValueSet".

       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           invoke ValueSet "withAll" using self returning lnkObject
           exit method.
       end method "asValueSet".
      *>----------------------------------------------------------------
      *> Return an instance of OrderedCollection with the same elements
      *> as this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asOrderedCollection".

       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           invoke OrderedCollection  "withAll" using self
                   returning lnkObject
           exit method.
       end method "asOrderedCollection".
      *>----------------------------------------------------------------
      *> Return an instance of IdentitySet with the same elements as
      *> this DBCS Character Array.
      *>----------------------------------------------------------------
       method-id. "asIdentitySet".

       linkage section.
       01 lnkObject            usage object reference.

       procedure division returning lnkObject.
           invoke IdentitySet "withAll" using self
                   returning lnkObject
           exit method.
       end method "asIdentitySet".
      *>----------------------------------------------------------------
      *> Return an instance of SortedCollection with the same elements
      *> as this DBCS Character Array. The sort order is determined by
      *> the sort method identified by lnkReceiver and lnkMessage.
      *>----------------------------------------------------------------
       method-id. "asSortedCollectionWithSort".

       linkage section.
       01 lnkObject            usage object reference.
       01 lnkMessage           pic x(80).
       01 lnkReceiver          usage object reference.

       procedure division using lnkReceiver lnkMessage
                           returning lnkObject.

           invoke sortedcollection "withAllandSortMethod" using
                                 self lnkReceiver lnkMessage
                        returning lnkObject
           exit method.
       end method "asSortedCollectionWithSort".
      *>----------------------------------------------------------------
      *> Return an instance of SortedCollection with the same elements
      *> as this DBCS Character Array. The sort order is determined by
      *> the default sort method.
      *>----------------------------------------------------------------
       method-id. "asSortedCollection".

       linkage section.
       01 lnkObject        usage object reference.

       procedure division returning lnkObject.
           invoke SortedCollection "withAll" using self
                   returning lnkObject
           exit method.
       end method "asSortedCollection".
      *>----------------------------------------------------------------
      *> Return an instance of SortedCollection with the same elements
      *> as this DBCS Character Array. 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 lnkObject            usage object reference.

       procedure division returning lnkObject.
           invoke SortedCollection "withAll" using self
                   returning lnkObject
           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".

      *>----------------------------------------------------------------
      *> Taking a Null terminated string returning a new string object
      *> which is the this string and the parameter concatenated.
      *>----------------------------------------------------------------
       method-id. "concatZ".
       local-storage section.
       01 lsClass                  usage object reference.
       01 lsString             usage object reference.

       linkage section.
       01 lnkString            pic x.
       01 lnkNewString         usage object reference.

       procedure division using lnkString returning lnkNewString.
           invoke self "getsbcsclass" returning lsClass
           invoke lsClass "withValue" using lnkString
                       returning lsString
           invoke self "concat" using lsString
                       returning lnkNewString
           invoke lsString "finalize" returning lsString
           exit program.
       end method "concatZ".

      *>----------------------------------------------------------------
      *> Assumes contents of this character array are numbers and
      *> returns the comp5 equivalent.
      *>----------------------------------------------------------------
       method-id. "asCOMP5".
       local-storage section.
       01 digit        pic 9.
       01 factor       pic x(4) comp-5.
       01 i            pic x(4) comp-5.
       linkage section.
       01 lnkComp5     pic s9(9) comp-5.
       procedure division returning lnkComp5.
           move 1 to factor
           move 0 to lnkComp5
           perform varying i from storageRequirements by -1 until i = 0
               move instancedata (i + indexedDataOffset :1) to digit
               compute lnkComp5 = lnkComp5 + (digit * factor)
               multiply 10 by factor
           end-perform
           exit method.
       end method "asCOMP5".

      *>----------------------------------------------------------------
      *> Assumes contents of this character array are hex numbers and
      *> returns the comp5 equivalent.
      *>----------------------------------------------------------------
       method-id. "asHEX".
       local-storage section.
       01 digit        pic x.
       01 digitByte redefines digit pic x comp-5.
       01 tempByte     pic x comp-5.
       01 factor       pic x(4) comp-5.
       01 i            pic x(4) comp-5.
       linkage section.
       01 lnkComp5     pic 9(9) comp-5.
       procedure division returning lnkComp5.
           move 1 to factor
           move 0 to lnkComp5
           perform varying i from storageRequirements by -1 until i = 0
               move instancedata (i + indexedDataOffset:1) to digit
               if digit >= "A"
                  subtract 39 from digitByte
               end-if
               move 15 to tempByte
               call "CBL_AND" using tempByte
                                    digitByte
                              by value 1
               compute lnkComp5 = lnkComp5 + (digitByte * factor)
               multiply 16 by factor
           end-perform
           exit method.
       end method "asHEX".

      *>----------------------------------------------------------------
      *> Assumes contents of this character array are numbers and
      *> returns the comp5 equivalent as an instance of COBOLComp5.
      *>----------------------------------------------------------------
       method-id. "asCOMP5Object".
       local-storage section.
       01 lsComp5       pic x(4) comp-5.
       linkage section.
       01 lnkComp5     usage object reference.
       procedure division returning lnkComp5.
           invoke self "asComp5" returning lsComp5
           invoke CObolCOmp5 "withValue" using lsComp5
                        returning lnkComp5
           exit method.
       end method "asCOMP5Object".

      *>----------------------------------------------------------------
      *> Returns a new string which will convert this string from an 
      *> external filename to an internal one. This means a filename
      *> surrounded with quotes with have them stripped.
      *>----------------------------------------------------------------
       method-id. "asInternalFilename".
       local-storage section.
       01 lsClass                  usage object reference.
       01 filenameOut           pic x(256).
       01 lsPtr                 pointer.
       01 lsNumBytes            pic x(4) comp-5.
       01 lsLength              pic x(4) comp-5.
       01 func                  pic x comp-x.
       linkage section.
       01 lnkFilename           usage object reference.
       procedure division returning lnkFilename.
           invoke self "sizeInBytes" returning lsNumBytes
           move 2 to func
           invoke self "getAddress" returning lsPtr
           move low-values to filenameOut
           call "CBL_FILENAME_CONVERT" using func
                                        by value lsPtr
                                        by reference fileNameOut
                                        by value lsNumBytes
                                        by value 255
                returning lsLength
           invoke self "getsbcsclass" returning lsClass
           invoke lsClass "withValue" using fileNameOut
                                returning lnkFileName
           exit method.
       end method "asInternalFilename".


      *>----------------------------------------------------------------
      *> 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       pic xx.
       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".



      *>----------------------------------------------------------------
      *> getSBCSClass returns the class used for dbcs environments
      *>----------------------------------------------------------------
       method-id. "getSBCSClass".
       local-storage section.
       linkage section.
       01 lnkClass            usage object reference.

       procedure division returning lnkClass.
            invoke selfclass "getsbcsclass" returning lnkClass
            exit program.
       end method "getSBCSClass".

      *>----------------------------------------------------------------
      *> getDBCSClass returns the class used for dbcs environments
      *>----------------------------------------------------------------
       method-id. "getDBCSClass".
       local-storage section.
       linkage section.
       01 lnkClass            usage object reference.

       procedure division returning lnkClass.
            invoke selfclass "getdbcsclass" returning lnkClass
            exit program.
       end method "getDBCSClass".
       end object.
       end class DBCScharacterArray.
