      *>----------------------------------------------------------------
      *> A SignedCobolcomp5 stores a signed COBOL pic x(n) comp-5
      *> enabling you to treat data of this type as an object.
      *>
      *>#See class "comp5".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set mfoo localcount(100)
       class-id. SignedCobolComp5 data is protected
               inherits from CobolComp5 with data.


        object section.
        class-control.
           intrinsic is class "intrnsic"
           CobolComp is class "comp5"
           SignedCobolComp5 is class "scomp5"
           cobolcompx is class "compx"
           cobolcomp5 is class "comp5"
           characterarray is class "chararry"
           cobolpicx is class "picx".

       working-storage section.
       78 maxsize       value 8.
       01 endian5 pic s9(9) comp-5 value 1.
       01 endianX pic x(4) comp-x redefines endian5.
       01 whatEnd pic x comp-5.
           88 highEnd value 1.
           88 lowEnd value 0.

       class-object.

       object-storage section.


      *>----------------------------------------------------------------
      *> Return SignedCobolComp5 as the baseclass for all clones of the class
      *> SignedCobolComp5
      *>----------------------------------------------------------------
       method-id. "baseClass".
       linkage section.
       01 lnkclass          usage object reference.

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

      *>----------------------------------------------------------------
      *> PRIVATE. Determine what type of chip we are running on by
      *> testing which end of a comp-5 is set when assigning it to 1.
      *>----------------------------------------------------------------
       method-id. "reset".
       procedure division.
           if endianX = 1
               set lowEnd to true
           else
               set highEnd to true
           end-if
           exit method.
       end method "reset".

      *>----------------------------------------------------------------
      *> PRIVATE. Returns 0 if running on a low-end chip (which means
      *> comp-5 and comp-x are the same). Returns 1 if running on a
      *> high-end chip (eg Intel)
      *>----------------------------------------------------------------
       method-id. "testComp5Order".
       linkage section.
       01  lnkflag pic x comp-5.
       procedure division returning lnkflag.
           move whatEnd to lnkflag
           exit method.
       end method "testComp5Order".


       end class-object.

       Object.

       object-storage section.

      *>----------------------------------------------------------------
      *> Return True if this SignedCobolComp5 is less than the
      *> SignedCobolComp5 indicated by compareValue and compareLength
      *> else return False.
      *>----------------------------------------------------------------
       method-id. "lessThanByLengthValue".
       local-storage section.

       01 arealcomp5-1           pic s9(9) comp-5.
       01 realcomp5bytes1        pic x(4) redefines arealcomp5-1.
       01 arealcomp5-2           pic s9(9) comp-5.
       01 realcomp5bytes2        pic x(4) redefines arealcomp5-2.
       01 sReq                   pic s9(9) comp-5.
       linkage section.
       01 comparevalue.
           03 abyte      pic x  occurs 0 to maxsize
                               depending on comparelength.
       01 bool           pic x comp-5.
           88  istrue  value 1.
           88  isfalse value 0.
       01 comparelength  pic s9(9) comp-5.

       procedure division using comparelength comparevalue
                                               returning bool.
           move zero to arealcomp5-1 arealcomp5-2
           invoke selfclass "sizeInBytes" returning sReq
           if highEnd
               move instancedata(1 : sReq) to realcomp5bytes1(1 : sReq)
               move comparevalue to realcomp5bytes2(1 : comparelength)
           else
               move instancedata(1 : sReq) to realcomp5bytes1
                   (maxSize - sReq + 1 : sReq)
               move comparevalue to realcomp5bytes2
                   (maxSize - compareLength + 1 : comparelength)
           end-if
           if arealcomp5-1 < arealcomp5-2
               set istrue to true
           else
               set isfalse to true
           end-if
           exit method.
       end method "lessThanByLengthValue".


      *>----------------------------------------------------------------
      *> PRIVATE.
      *>----------------------------------------------------------------
       method-id. "streamOutCPT".
       local-storage section.
       01 realComp5            pic s9(9) comp-5.
       01 realcomp5bytes       pic x(4) redefines realcomp5.
       01 dispComp5            pic +9(10).
       01 lsSize               pic x(4) comp-5.
       linkage section.
       01 lnkStream            usage object reference.

       procedure division using lnkStream.
           move instancedata(1 : 4) to realcomp5bytes(1 : 4)
           move realComp5 to dispComp5
           move 11 to lsSize
           invoke lnkStream "WriteNoIndent" using lsSize dispComp5
           exit method.
       end method "streamOutCPT".
      *>----------------------------------------------------------------
      *> Return True if this SignedCobolComp5 is greater than the SignedCobolComp5
      *> indicated by compareValue and compareLength else return False.
      *>----------------------------------------------------------------
       method-id. "greaterThanByLengthValue".
       local-storage section.

       01 arealcomp5-1           pic s9(9) comp-5.
       01 realcomp5bytes1        pic x(4) redefines arealcomp5-1.
       01 arealcomp5-2           pic s9(9) comp-5.
       01 realcomp5bytes2        pic x(4) redefines arealcomp5-2.
       01 sReq                   pic s9(9) comp-5.

       linkage section.
       01 comparevalue.
           03 abyte      pic x  occurs 0 to maxsize
                               depending on comparelength.
       01 bool           pic x comp-5.
           88  istrue  value 1.
           88  isfalse value 0.
       01 comparelength  pic s9(9) comp-5.

       procedure division using comparelength comparevalue
                                                  returning bool.
           move zero to arealcomp5-1 arealcomp5-2
           invoke selfclass "sizeInBytes" returning sReq
           if highEnd
               move instancedata(1 : sReq) to realcomp5bytes1(1 : sReq)
               move comparevalue to realcomp5bytes2(1 : comparelength)
           else
               move instancedata(1 : sReq) to realcomp5bytes1
                       (maxSize - sReq + 1 : sReq)
               move comparevalue to realcomp5bytes2
                       (maxSize - compareLength + 1 : comparelength)
           end-if
           if arealcomp5-1 > arealcomp5-2
               set istrue to true
           else
               set isfalse to true
           end-if
           exit method.
       end method "greaterThanByLengthValue".

      *>----------------------------------------------------------------
      *> Convert this comp-5 to a picx representation with no leading
      *> zeroes
      *>----------------------------------------------------------------

       method-id. "asPicX".
       local-storage section.

       01 asize                  pic s9(9) comp-5.
       01 adisplayfield          pic 9(18).
       01 aDisplayPicx           pic x(18).
       01 arealcomp5-1           pic s9(9) comp-5.
       01 realcomp5bytes1        pic x(4) redefines arealcomp5-1.
       01 i                      pic s9(9) comp-5.
       01 s                      pic s9(9) comp-5.
       01 sReq                   pic s9(9) comp-5.

       linkage section.
       01 lnkstring               usage object reference.

       procedure division returning lnkstring.
           move zero to arealcomp5-1
           invoke selfclass "sizeInBytes" returning sReq
           if highEnd
               move instancedata(1 : sReq) to realcomp5bytes1(1 : sReq)
           else
               move instancedata(1 : sReq) to realcomp5bytes1
                   (maxSize - sReq + 1 : sReq)
           end-if
           move arealcomp5-1 to adisplayfield
           perform varying i from 1 by 1 until i > 18 or
                                 adisplayfield(i:1) not = 0
           end-perform
           if i > 18
               move 1 to asize
               move 18 to i
           else
               compute asize = 18 - i + 1
           end-if
           if arealcomp5-1 < 0
                move "-" to aDisplayPicx
                move 2 to s
                add 1 to asize
           else
                move 1 to s
           end-if
           move adisplayfield(i : asize) to aDisplayPicx(s:)
           invoke cobolpicx "withLengthValue" using asize
                                                adisplayPicx                                  
                            returning lnkstring
           exit method.
       end method "asPicX".
      *>----------------------------------------------------------------
      *> Convert this comp-5 to a characterArray representation with
      *> no leading zeroes
      *>----------------------------------------------------------------

       method-id. "asCharacterArray".
       local-storage section.

       01 asize                  pic s9(9) comp-5.
       01 adisplayfield          pic 9(18).
       01 arealcomp5-1           pic s9(9) comp-5.
       01 realcomp5bytes1        pic x(4) redefines arealcomp5-1.
       01 i                      pic s9(9) comp-5.
       01 sReq                   pic s9(9) comp-5.
       01 aDisplayPicx           pic x(18).
       01 s                      pic s9(9) comp-5.

       linkage section.
       01 lnkstring               usage object reference.

       procedure division returning lnkstring.
           move zero to arealcomp5-1
           invoke selfclass "sizeInBytes" returning sReq
           if highEnd
               move instancedata(1 : sReq) to realcomp5bytes1(1 : sReq)
           else
               move instancedata(1 : sReq) to realcomp5bytes1
                   (maxSize - sReq + 1 : sReq)
           end-if
           move arealcomp5-1 to adisplayfield
           perform varying i from 1 by 1 until i > 18 or
                                 adisplayfield(i:1) not = 0
           end-perform
           if i > 18
               move 1 to asize
               move 18 to i
           else
               compute asize = 18 - i + 1
           end-if
           if arealcomp5-1 < 0
                move "-" to aDisplayPicx
                move 2 to s
                add 1 to asize
           else
                move 1 to s
           end-if
           move adisplayfield(i : asize) to aDisplayPicx(s:)
           invoke cobolpicx "withLengthValue" using asize
                                                adisplayPicx                                  
                            returning lnkstring
           exit method.
       end method "asCharacterArray".


       end object.
       end class SignedCobolComp5.
