      *>----------------------------------------------------------------
      *> A COBOLComp5 stores a COBOL pic x(n) comp-5 enabling you to
      *> treat data of this type as an object.
      *> A Cobolpicx stores a COBOL pic x(n) enabling you to treat data
      *> of this type as an object.
      *> This class provides the basic comparison operators,
      *> display mechanism and hashing methods for picx items.
      *> Its main use is to provide templates for creating collections
      *> "ofValues", and associations; CharacterArray objects are more
      *> efficient for storing and manipulating strings.
      *>
      *>#See method "newClass" in class "intrnsic".
      *>
      *>#See class "chararry".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set linkcount(150) mfoo localcount(150)
       class-id. cobolpicx data is protected
               inherits from intrinsic with data.



        object section.
        class-control.
           intrinsic is class "intrnsic"
           cobolpicx is class "picx"
           characterarray is class "chararry"
           DBCSCharacterarray is class "dbcsarry"
           ValueSet is class "valueset"
           DBCSCobolPICX is class "dbcspicx"
           OrderedCollection is class "ordrdcll".

       working-storage section.
       01 dbcsEnvironmentStatus    pic x comp-5 external.
           88  isSBCSEnv value 1.
           88  isDBCSEnv value 2.

       class-object.

       object-storage section.

      *>----------------------------------------------------------------
      *> PRIVATE. initialize class data
      *>----------------------------------------------------------------
       method-id. "initializeclass".
       procedure division.
           invoke super "initializeclass"
           move 1 to storagerequirements
           exit method.
       end method "initializeclass".

      *>----------------------------------------------------------------
      *> Return true if this type of collection contains characters
      *>----------------------------------------------------------------
       method-id. "containsCharacters".
       linkage section.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       01 acollection          usage object reference.

       procedure division returning lnkbool.
           set lnkIsTrue to true
           exit method.
       end method "ContainsCharacters".

      *>----------------------------------------------------------------
      *> Return an instance of a picx with the length lnkLength and
      *> value lnkValue
      *>----------------------------------------------------------------
       method-id. "withLengthValue".
       local-storage section.
       01 aClass           usage object reference.
       linkage section.
       01 lnkstring         usage object reference.
       01 lnklength         pic x(4) comp-5.
       01 lnkvalue.
           03 aByte pic x occurs 1 to maxNumberBytes
                                   depending on lnkLength.
       procedure division using lnklength lnkvalue returning lnkstring.
           invoke self "newClass" using lnklength returning aclass
           invoke aclass "WithValue" using lnkvalue
                                           returning lnkstring
           exit method.
       end method "withLengthValue".
      *>----------------------------------------------------------------
      *> Return an instance of a picx with the length lnkLength. The
      *> value is set to low-values.
      *>----------------------------------------------------------------
       method-id. "withLength".
       local-storage section.
       01 aclass            usage object reference.

       linkage section.
       01 lnkstring         usage object reference.
       01 lnklength         pic x(4) comp-5.

       procedure division using lnklength returning lnkstring.
           invoke self "newClass" using lnklength returning aclass
           invoke aclass "new" returning lnkstring
           exit method.
       end method "withLength".
      *>----------------------------------------------------------------
      *> Return the base class CobolPICX for any clone of CobolPICX.
      *>----------------------------------------------------------------
       method-id. "baseClass".
       linkage section.
       01 lnkclass          usage object reference.

       procedure division returning lnkclass.
           set lnkclass to cobolpicx
           exit method.
       end method "baseClass".

       end class-object.

       Object.

       object-storage section.
      *>----------------------------------------------------------------
      *> Return True if the cobolPICX (indicated by compareValue and
      *> compareLength) is Equal to this CobolPICX else return False.
      *>----------------------------------------------------------------
       method-id. "equalbyLengthValue".
       local-storage section.
       01 sReq            pic x(4) comp-5.
       01 compareValueByteLength    pic x(4) comp-5.

       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   compareValueByteLength.
       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.
       01 comparelength        pic x(4) comp-5.

       procedure division using comparelength comparevalue
                                            returning lnkbool.
           move compareLength to compareValueByteLength
           invoke self "sizeInBytes" returning sReq
           if comparevalue = instancedata(1: sReq)
               set lnkistrue to true
           else
               set lnkisfalse to true
           end-if
           exit method.
       end method "equalbyLengthValue".

      *>----------------------------------------------------------------
      *> Return True if the cobolPICX (indicated by compareValue and
      *> compareLength) is Equal to this CobolPICX else return False.
      *> However the comparison ignores the case of the characters.
      *>----------------------------------------------------------------
       method-id. "equalsIgnoreCasebyLengthValue".
       local-storage section.

       01 temp                  usage object reference.
       01 copyanobject             usage object reference.
       01 aclass                   usage object reference.
       01 sourceobject             usage object reference.
       01 sclass                   usage object reference.
       01 sReq pic x(4) comp-5.
       01 work pic x(11).

       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.
       01 comparelength        pic x(4) comp-5.
       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.

       procedure division using comparelength comparevalue
                  returning lnkbool.
	   invoke self "getValue" returning work

	   invoke self "sizeInBytes" returning sReq

           invoke selfclass "newClass" using sReq
                                   returning sclass
           invoke sclass "withValue" using instancedata(1:sReq)
                                   returning sourceobject

           invoke selfclass "newClass" using comparelength
                                   returning aclass
           invoke aclass "withValue" using comparevalue
                                   returning copyanobject

           invoke sourceobject "equalsIgnoreCase" 
			   using copyanobject returning lnkbool.

           invoke copyanobject "finalize" returning temp
           invoke sourceobject "finalize" returning temp
           exit method.
       end method "equalsIgnoreCasebyLengthValue".
      *>----------------------------------------------------------------
      *> Return True if this CobolPICX is less than the CobolPICX
      *> indicated by compareValue and compareLength else return False.
      *>----------------------------------------------------------------
       method-id. "lessThanByLengthValue".
       local-storage section.
       01 sReq            pic x(4) comp-5.
       01 compareValueByteLength    pic x(4) comp-5.

       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   compareValueByteLength.
       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.
       01 comparelength        pic x(4) comp-5.

       procedure division using comparelength comparevalue
                                         returning lnkbool.
           move compareLength to compareValueByteLength
           invoke self "sizeInBytes" returning sReq
           if  instancedata(1: sReq) < comparevalue
               set lnkistrue to true
           else
               set lnkisfalse to true
           end-if
           exit method.
       end method "lessThanByLengthValue".

      *>----------------------------------------------------------------
      *> Return 1 if this cobolpicx is greater than anArray.
      *> Return -1 if this cobolpicx is less than anArray.
      *> Return 0 if this cobolpicx is equal to anArray.
      *>----------------------------------------------------------------
       method-id. "compareTo".
       local-storage section.

       01 comparelength       pic x(4) comp-5.
       01 aptr                usage pointer.
       01 storageRequirements pic x(4) comp-5.

       linkage section.
       01 comparevalue.
           03 abyte            pic x occurs 1 to maxnumberbytes
                                       depending on comparelength.
       01 anarray              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 anarray returning lnkResult.
           invoke anarray "sizeInBytes" returning compareLength
           invoke self "sizeInBytes" returning storageRequirements
           invoke self "malloc" using compareLength returning aptr
           set address of comparevalue to aptr
           invoke anarray "getValue" returning compareValue
           if instancedata(1:storagerequirements)  < comparevalue
               set lnkLessThan to true
           else
               if instancedata(1:storagerequirements) > comparevalue
                   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 CobolPICX is greater than the CobolPICX
      *> indicated by compareValue and compareLength else return False.
      *>----------------------------------------------------------------
       method-id. "greaterThanByLengthValue".
       local-storage section.
       01 sReq            pic x(4) comp-5.
       01 compareValueByteLength    pic x(4) comp-5.
       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   compareValueByteLength.
       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.
       01 comparelength        pic x(4) comp-5.

       procedure division using comparelength comparevalue
                                                  returning lnkbool.

           invoke DBCSCharacterArray "StringLengthInBytes"
                               using CompareValue
                                     CompareLength
                               returning compareValueByteLength
           invoke self "sizeInBytes" returning sReq
           if  instancedata(1: sReq) > comparevalue
               set lnkistrue to true
           else
               set lnkisfalse to true
           end-if
           exit method.
       end method "greaterThanByLengthValue".
      *>----------------------------------------------------------------
      *> Return True if this CobolPICX is greater than or equal to
      *> the CobolPICX indicated by compareValue and compareLength else
      *> return False.
      *>----------------------------------------------------------------
       method-id. "greaterThanOrEqualByLengthValue".
       local-storage section.
       01 sReq            pic x(4) comp-5.
       01 compareValueByteLength    pic x(4) comp-5.
       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   compareValueByteLength.
       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.
       01 comparelength        pic x(4) comp-5.

       procedure division using comparelength comparevalue
                                                  returning lnkbool.

           move compareLength to compareValueByteLength

           invoke self "sizeInBytes" returning sReq
           if  instancedata(1: sReq) >= comparevalue
               set lnkistrue to true
           else
               set lnkisfalse to true
           end-if
           exit method.
       end method "greaterThanOrEqualByLengthValue".
      *>----------------------------------------------------------------
      *> Return a new string stripped of all leading and trailing spaces
      *> If this method was invoked with an INVOKE AS a static will be
      *> returned, otherwise an object reference will be returned.
      *>----------------------------------------------------------------
       method-id. "trimBlanks".
       local-storage section.

       01 comparelength            pic x(4) comp-5.
       01 j                        pic x(4) comp-5.
       01 i                        pic x(4) comp-5.
       01 b                        pic x(4) comp-5.
       01 sReq                     pic x(4) comp-5.

       linkage section.
       01 newstring                   object reference.
       01 comparevalue redefines newstring.
           03 abyte      pic x occurs 0 to maxnumberbytes depending on
                                   comparelength.

       procedure division returning newstring.
           move 1 to b
           invoke self "sizeInBytes" returning sReq
           perform varying i from 1 by 1
             until instancedata(i:b) not = space or i > sReq
           end-perform
           perform varying j from sReq by -1
             until instancedata(j:b) not = space or j = 1
           end-perform
           add j to b
           subtract i from b
           if self equal to null
               move sReq to compareLength
               move instancedata(i:b) to comparevalue
           else
               move objectReferenceSize to compareLength
               invoke cobolpicx "withLengthValue" using b
                           instancedata(i:b) returning newstring
           end-if.
           exit method
       end method "trimBlanks".
      *>----------------------------------------------------------------
      *> Return self (or the intrinsic value) as it is already a PICX
      *>----------------------------------------------------------------
       method-id. "asPICX".
       local-storage section.
       01 comparelength        pic x(4) comp-5.
       01 sReq                       pic x(4) comp-5.

       linkage section.
       01 objectaspicx               pic x(objectReferenceSize).
       01 newobject               object reference.
       01 comparevalue redefines newobject.
           03 abyte               pic x occurs 1 to maxnumberbytes
                                   depending on comparelength.

       procedure division returning newobject.
           invoke self "sizeInBytes" returning sReq
           if self equal to null
               move sReq to comparelength
               move instancedata(1 : sReq) to comparevalue
           else
               invoke self "basicCopy" returning newobject
           end-if.
           exit method
       end method "asPICX".

      *>----------------------------------------------------------------
      *> Return the hash value of this CobolPICX.
      *>----------------------------------------------------------------
       method-id. "hash".
       local-storage section.

       01 achar                    pic x.
       01 numchar redefines achar  pic x comp-5.
       01 y                        pic x(4) comp-5.
       01 j                        pic x(4) comp-5.
       01 i                        pic x(4) comp-5.
       01 sReq            pic x(4) comp-5.

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

       procedure division returning ahashvalue.
           move zero to ahashvalue
           move 1 to j
           invoke self "sizeInBytes" returning sReq
           perform varying i from sReq by -1
              until i = zero or
                    instancedata(i:j) not  = space
           end-perform
           move i to y
           perform varying i from y by -1 until i = zero
               move instancedata(i:j) to achar
               compute ahashvalue = ahashvalue * 47 + numchar
           end-perform
           if ahashvalue < 0
               compute ahashvalue = - ahashvalue
           end-if
           exit method.
       end method "hash".

      *>----------------------------------------------------------------
      *> Display the value of this CobolPICX.
      *>----------------------------------------------------------------
       method-id. "display".
       local-storage section.
       01 sReq            pic x(4) comp-5.
       procedure division.
           invoke self "sizeInBytes" returning sReq
           display instancedata(1 : sReq) with no advancing
           exit method.
       end method "display".
      *>----------------------------------------------------------------
      *> Replace the contents of the receiver at the index
      *> position anIndex with lnkChar.
      *>----------------------------------------------------------------
       method-id. "atPut".
       local-storage section.

       01 exceptionnumber          pic x(4) comp-5.
       01 b                        pic x(4) comp-5.
       01 sReq                     pic x(4) comp-5.
       01 aNewString               usage object reference.
       01 charLength               pic x(4) comp-5.
       linkage section.
       01 anindex                  pic x(4) comp-5.
       01 lnkchar                  pic x.

       procedure division using anindex lnkchar.
           invoke self "sizeInBytes" returning sReq
           if anindex > sReq or anindex < 1
               move 3 to exceptionnumber
               invoke self "RaiseException" using exceptionnumber
           else
               if not isSBCSEnv
                   invoke DBCSCharacterArray "charLengthInBytes"
                                             using lnkChar
                                         returning charLength
                   if charLength = 1
                       move 1 to b
                       move lnkchar to instancedata(anindex : b)
                   else
                       invoke DBCSCobolPICX "withLengthValue"
                                               using sReq
                                                     instanceData
                                           returning aNewString
                       invoke aNewString "atPut" using anIndex
                                                       lnkchar
                       if self = null
                           invoke aNewString "getValue"
                               returning instanceData
                       else
                           invoke self "becomes" using aNewString
                       end-if
                       invoke aNewString "finalize" returning aNewString
                   end-if
               else
                   move 1 to b
                   move lnkchar to instancedata(anindex : b)
               end-if
           end-if
           exit method.
       end method "atPut".
      *>----------------------------------------------------------------
      *> Return the contents of the receiver at the index
      *> position anIndex .
      *>----------------------------------------------------------------
       method-id. "at".
       local-storage section.

       01 exceptionnumber          pic x(4) comp-5.
       01 b                        pic x(4) comp-5.
       01 sReq            pic x(4) comp-5.

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

       procedure division using anindex returning lnkchar.
           invoke self "sizeInBytes" returning sReq
           if anindex > sReq or anindex < 1
               move 3 to exceptionnumber
               invoke self "RaiseException" using exceptionnumber
                                             returning lnkchar
           else
               move 1 to b
               move instancedata(anindex:b) to lnkchar
           end-if
           exit method
       end method "at".

      *>----------------------------------------------------------------
      *> Return a string containing the receiver with alphabetic
      *> characters in upper case.
      *> If this method was invoked with an INVOKE AS a static will be
      *> returned, otherwise an object reference will be returned.
      *>----------------------------------------------------------------
       method-id. "asUpperCase".
       local-storage section.

       01 aptr                     usage pointer.
       01 comparelength            pic x(4) comp-5.
       01 sReq            pic x(4) comp-5.

       linkage section.
       01 astring.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   sReq.
       01 newstring                   object reference.
       01 comparevalue redefines newstring.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.

       procedure division returning newstring.
           invoke self "sizeInBytes" returning sReq
           if self equal to null
               move sReq to comparelength
               move instancedata(1: sReq) to comparevalue
               call "CBL_TOUPPER" using comparevalue
                               by value sReq
               exit method
           else
               move objectReferenceSize to compareLength
               invoke self "malloc" using sReq
                                   returning aptr
               set address of astring to aptr
               move instancedata(1:sReq) to aString
               call "CBL_TOUPPER" using astring
                               by value sReq

               invoke selfClass "WithValue" using aString
                         returning newstring
               invoke self "dealloc" using aptr
               exit method
           end-if.
       end method "asUpperCase".
      *>----------------------------------------------------------------
      *> Return TRUE if the receiver is equal to anObject, else return
      *> FALSE. The comparison is not case sensitive.
      *>----------------------------------------------------------------
       method-id. "equalsIgnoreCase".
       local-storage section.
       01 comparelength   pic x(4) comp-5.
       01 sReq            pic x(4) comp-5.
       01 aptr            usage pointer.
       01 aptr2           usage pointer.
       01 numChars        pic x(4) comp-5.

       linkage section.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.

       01 copyOfInstanceData.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   sReq.

       01 lnkbool          pic x comp-x.
           88  lnkistrue  value 1.
           88  lnkisfalse value 0.

       01 anobject         usage object reference.

       procedure division using anobject returning lnkbool.
           invoke anObject "sizeInBytes" returning compareLength
           invoke self "sizeInBytes" returning sReq
           if sReq = compareLength
               invoke self "malloc" using compareLength returning aptr
               invoke self "malloc" using sReq returning aptr2
               set address of copyOfInstanceData to aptr2
               set address of compareValue to aptr
               invoke anObject "getValue" returning compareValue
               move instancedata(1:sReq) to copyOfInstanceData
               call "CBL_TOUPPER" using comparevalue
                               by value compareLength
               call "CBL_TOUPPER" using copyOfInstanceData
                               by value sReq
               if compareValue = copyOfInstanceData
                  set lnkisTrue to true
               else
                  set lnkisFalse to true
               end-if
               invoke self "dealloc" using aptr
               invoke self "dealloc" using aptr2
           else
               set lnkisFalse to true
           end-if
           exit method.
       end method "equalsIgnoreCase".
      *>----------------------------------------------------------------
      *> Return the index position of the first occurrence of anObject
      *> (starting the search at anIndex) in the receiver. If no such
      *> element is found, answer zero
      *>----------------------------------------------------------------
       method-id. "indexOfString".
       local-storage section.

       01 exceptionnumber          pic x(4) comp-5.
       01 aptr   usage pointer.
       01 bool                     pic x comp-x.
           88 istrue  value 1.
           88 isfalse value 0.
       01 i                        pic x(4) comp-5.
       01 comparelength            pic x(4) comp-5.
       01 sReq            pic x(4) comp-5.

       linkage section.
       01 anindex          pic x(4) comp-5.
       01 anindex2         pic x(4) comp-5.
       01 anobject         usage object reference.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.

       procedure division using anobject anindex returning anindex2.
           invoke self "size" returning compareLength
           if anindex < 1 or anindex > compareLength
               move 3 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                             returning anindex2
           else
               invoke anObject "sizeInBytes" returning compareLength
               invoke self "sizeInBytes" returning sReq
               invoke self "malloc" using compareLength returning aptr
               set address of comparevalue to aptr
               invoke anobject "getValue" returning compareValue
               set isfalse to true
               perform varying i from anindex by 1
                   until (sReq - i  + 1) < compareLength
                   if instancedata(i:compareLength) = comparevalue
                       set istrue to true
                       exit perform
                   end-if
               end-perform
               if isfalse
                   move zero to i
               end-if
               move i to anindex2
               invoke self "dealloc" using aptr
           end-if

           exit method.
       end method "indexOfString".
      *>----------------------------------------------------------------
      *> Return a new string as a result of concatenating this picx with
      *> anObject. If this method was invoked with an INVOKE AS
      *> a static will be returned, otherwise an object reference will
      *> be returned.
      *>----------------------------------------------------------------
       method-id. "concat".
       local-storage section.

       01 comparelength       pic x(4) comp-5.
       01 comparelength2      pic x(4) comp-5.
       01 comparelength3      pic x(4) comp-5.
       01 aptr                usage pointer.
       01 bptr                usage pointer.
       01 sReq            pic x(4) comp-5.

       linkage section.
       01 newstring              object reference.
       01 comparevalue2 redefines newstring.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength2.
       01 anobject         usage object reference.
       01 comparevalue.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.
       01 comparevalue3.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength3.

       procedure division using anobject returning newstring.
           invoke anobject "sizeInBytes" returning compareLength
           invoke self "malloc" using compareLength returning aptr
           set address of comparevalue to aptr
           invoke anobject "getValue" returning compareValue
           move zero to compareLength2
           add compareLength to compareLength2
           invoke self "sizeInBytes" returning sReq
           add sReq to compareLength2
           if self equal to null
               move instancedata(1: sReq) to
                   comparevalue2(1:sReq)
               move comparevalue to
                comparevalue2(sReq + 1 : compareLength)
           else
               move compareLength2 to compareLength3
               invoke self "malloc" using compareLength3 returning bptr
               set address of comparevalue3 to bptr
               move instancedata(1: sReq) to
                       comparevalue3(1:sReq)
               move comparevalue to
                 comparevalue3(sReq + 1 : compareLength)
               move objectReferenceSize to compareLength2
               invoke anObject "size" returning compareLength
               add compareLength to sReq giving compareLength3
               invoke cobolpicx "withLengthValue" using compareLength3
                                                        compareValue3
                                              returning newstring
               invoke self "dealloc" using bptr
           end-if
           invoke self "dealloc" using aptr
           exit method.
       end method "concat".
      *>----------------------------------------------------------------
      *> Return a string containing the receiver with alphabetic
      *> characters in lower case.
      *> If this method was invoked with an INVOKE AS a static will be
      *> returned, otherwise an object reference will be returned.
      *>----------------------------------------------------------------
       method-id. "asLowerCase".
       local-storage section.
       01 comparelength  pic x(4) comp-5.
       01 aptr   usage pointer.
       01 sReq            pic x(4) comp-5.

       linkage section.
       01 astring.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   sReq.
       01 newstring                   object reference.
       01 comparevalue redefines newstring.
           03 abyte      pic x occurs 1 to maxnumberbytes depending on
                                   comparelength.

       procedure division returning newstring.
           invoke self "sizeInBytes" returning sReq
           if self equal to null
               move sReq to comparelength
               move instancedata(1: sReq) to comparevalue
               call "CBL_TOLOWER" using comparevalue
                               by value sReq
           else
               move objectReferenceSize to compareLength
               invoke self "malloc" using sReq
                                returning aptr
               set address of astring to aptr
               move instancedata(1:sReq) to aString
               call "CBL_TOLOWER" using astring
                               by value sReq

               invoke selfClass "WithValue" using aString
                         returning newstring
               invoke self "dealloc" using aptr
           end-if.
           exit method
       end method "asLowerCase".
      *>----------------------------------------------------------------
      *> Return an instance of a character array which has the same
      *> value as this cobolpicx.
      *>----------------------------------------------------------------
       method-id. "asCharacterArray".
       local-storage section.
       01 sReq            pic x(4) comp-5.

       linkage section.
       01 lnknewstring      usage object reference.

       procedure division returning lnknewstring.
           invoke self "size" returning sReq
           invoke characterarray "withLengthValue" using sReq
                     instancedata (1 : )
               returning lnknewstring
           exit method.
       end method "asCharacterArray".
      *>----------------------------------------------------------------
      *> Return an ordered collection of cobolpicx's which
      *> represents each separate line of this cobolpicx.
      *>----------------------------------------------------------------
       method-id. "asSeparateLines".
       working-storage section.
       01 linefeed.
           03 intlinefeed pic x comp-5 value 10.

       local-storage section.
       01 temp                     usage object reference.
       01 stringlength             pic x(4) comp-5.
       01 startofline              pic x(4) comp-5.
       01 i                        pic x(4) comp-5.
       01 aline                    usage object reference.
       01 sReq                     pic x(4) comp-5.

       linkage section.
       01 lnkcollection     usage object reference.

       procedure division returning lnkcollection.
           move 5 to i
           invoke orderedcollection "ofReferences" using i
                                               returning lnkcollection
           move 1 to startofline
           invoke self "sizeInBytes" returning sReq
           perform varying i from 1 by 1 until i > sReq
               if instancedata(i : 1) = linefeed
                   compute stringlength = i - startofline
                   if stringlength = zero
                       continue
                   else
                       invoke cobolpicx "withLengthValue"
                                       using stringlength
                                             instancedata(startofline:
                                             stringlength)
                                   returning aline
                       invoke lnkcollection "add"
                                       using aline
                   end-if
                   move i to startofline
                   add 1 to startofline
               end-if
           end-perform
           if startofline <= sReq
               if instancedata(startofline : 1) not = linefeed
                   compute stringlength = sReq - startofline + 1
                   if stringlength = zero
                       continue
                   else
                       invoke cobolpicx "withLengthValue"
                                       using stringlength
                                             instancedata(startofline:
                                             stringlength)
                                   returning aline
                       invoke lnkcollection "add"
                                       using aline
                   end-if
               end-if
           end-if
           exit method.
       end method "asSeparateLines".

      *>----------------------------------------------------------------
      *> Set the Value of this Intrinsic
      *>----------------------------------------------------------------
       method-id. "setValue".
       local-storage section.
       01 sReq                     pic x(4) comp-5.
       01 aNewString               usage object reference.
       01 lsBool                   pic x comp-5.
           88  isTrue  value 1.
           88  isFalse value 0.
       linkage section.
       01 avalue.
           03 abyte      pic x  occurs 0 to maxnumberbytes
                               depending on sReq.

       procedure division using aValue.
           invoke self "sizeInBytes" returning sReq
           if not isSBCSEnv
               invoke dbcsCharacterArray "isDBCSStringLengthValue"
                       using sReq
                             aValue
                   returning lsBool
               if isFalse
                   move avalue to instancedata(1 : sReq)
               else
                  invoke DBCSCobolPICX "withLengthValue"
                                           using sReq
                                                 aValue
                                       returning aNewString
                   if self = null
                       invoke aNewString "getValue"
                               returning instanceData
                   else
                       invoke self "becomes" using aNewString
                   end-if
                   invoke aNewString "finalize" returning aNewString
               end-if
           else
               move avalue to instancedata(1 : sReq)
           end-if
           exit method.
       end method "setValue".

      *>----------------------------------------------------------------
      *> Return true if this type of collection contains characters
      *>----------------------------------------------------------------
       method-id. "containsCharacters".
       linkage section.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       01 acollection          usage object reference.

       procedure division returning lnkbool.
           set lnkIsTrue to true
           exit method.
       end method "ContainsCharacters".

      *>----------------------------------------------------------------
      *> Return the value as the description for this intrinsic
      *>----------------------------------------------------------------
       method-id. "description".
       local-storage section.
       01 tmpString    usage object reference.
       linkage section.
       01 astring        usage object reference.
       procedure division returning aString.
           invoke self "asCharacterArray" returning tmpstring
           invoke tmpString "description" returning aString
           invoke tmpString "finalize" returning tmpString
           exit method.
       end method "description".

       end object.
       end class cobolpicx.
