      $set repository(update on checking on)
      *-----------------------------------------------------------------

       class-id. CharString as "String" inherits Base.

       repository.
           class Base    as  "base"
           .

       factory.

      *---------------------------------------------
      *
      * newString: Allocates a new object reference and invokes
      *            initNewString to allocate memory for the string
      *
      *---------------------------------------------

       method-id. "newString".
       linkage section.
       01 lk-string         pic x any length.
       01 new-object        object reference CharString.
       procedure division using lk-string returning new-object.
           invoke super "new" returning new-object
           invoke new-object "initstring" using lk-string.
           exit method
           .
       end method "newString".

       end factory.

      *-----------------------------------------------------------------

       object.
 
       working-storage section.
       1 string-length binary-long unsigned.
       1 string-char   typedef pic x.
       1 string-ptr    usage pointer string-char.

      *---------------------------------------------
      *
      * Private method
      *
      * initnewstring: Allocates memory for a new string
      *
      *---------------------------------------------

       method-id. "initString".
       local-storage section.
       01 alloc-flags binary-long unsigned value 0.
       linkage section.
       01 lk-string pic x any length.
       01 lk-tmp    pic x.
       procedure division using lk-string.
           move function length(lk-string) to string-length

           call "CBL_ALLOC_MEM" using string-ptr
                                by value string-length
                                         alloc-flags

           set address of lk-tmp to string-ptr
           move lk-string to lk-tmp(1:string-length)
           exit method
           .
        end method "initString".

      *---------------------------------------------
      *
      * Private method
      *
      * getPointer: return the pointer pointing to the string
      *
      *---------------------------------------------

       method-id. "getPointer".
       linkage section.
       1 lk-string-ptr usage pointer string-char.
       procedure division returning lk-string-ptr.
           set lk-string-ptr to string-ptr
           exit method
           .
       end method "getPointer".

   
      *---------------------------------------------
      *
      * getlength: get length of string
      *
      *---------------------------------------------

       method-id. "getLength".
       linkage section.
       1 lk-length usage binary-long unsigned.
       procedure division returning lk-length.
           move string-length to lk-length
           exit method.
       end method "getLength".

      *---------------------------------------------
      * 
      * isequal: return 1 if two string objects are equal
      *          return 0 if they are not equal
      *
      *---------------------------------------------
        
       method-id. "isequal".
       local-storage section.
       01 string-ptr1 usage pointer string-char.
       01 string-len1 binary-long unsigned.
       01 count1      binary-long unsigned value 0.
       linkage section.
       01 lk-string-object usage object reference CharString.
       01 lk-isEqual binary-char.
       procedure division using by value lk-string-object
                          returning lk-isEqual.

           set string-ptr1 to lk-string-object::"getpointer"
           move lk-string-object::"getlength" to string-len1

           if string-len1 = string-length
               if string-char(count1:string-len1) at string-ptr1 not =
                  string-char(count1:string-length) at string-ptr
                   move 1 to lk-isEqual
               else
                   move 0 to lk-isEqual
               end-if
           else
               move 0 to lk-isEqual
           end-if
           exit method

       end method "isequal".

      *---------------------------------------------
      *
      * finalize: free memory allocated for the string
      *
      *---------------------------------------------

       method-id. "finalize".
       local-storage section.
       01 ret-status binary-short.
       procedure division.
           call "CBL_FREE_MEM" using string-ptr
               returning ret-status.
           exit program
       end method "finalize".

      *---------------------------------------------
      *
      * display: display the string with no line feed
      *
      *---------------------------------------------

       method-id. "display".
       local-storage section.
       linkage section.
       01 char-string pic x.
       procedure division.
           set address of char-string to string-ptr
           display char-string(1:string-length) with no advancing
           exit method
       end method "display".

      *---------------------------------------------
      *
      * displaynl: display the string with line feed
      *
      *---------------------------------------------

       method-id. "displayNl".
       procedure division.
           display string-char(1:string-length) at string-ptr
           exit method
       end method "displayNl".

       end object.
 
       end class CharString.
