      *>----------------------------------------------------------------
      *> Instances of Behavior are Object COBOL classes. Behavior
      *> provides basic behavior for Object COBOL class objects.
      *> Behavior is the Object COBOL metaclass, and Object COBOL
      *> applications do not send messages directly to Behavior itself.
      *>
      *> However, all Object COBOL classes respond to the methods
      *> defined as instance methods of Behavior, and you can use any
      *> of the public methods defined here.
      *> For example, you could send the "allInstances" method to any
      *> class to get a collection of all the instances of that class
      *> currently instantiated.
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------

      $set mfoo linkcount(200)
       class-id. Behavior data is protected
               inherits from base with data.
      *>----------------------------------------------------------------
      *>
      *> The source code for 16 and 32 bit behavior is different. This
      *> is the source code for the 32 bit version.
      *>
      *>----------------------------------------------------------------

        object section.
        class-control.
           Base is class "base"
           behavior is class "behavior"
           OrderedCollection is class "ordrdcll"
           Callback is class "callback"
           CharacterArray is class "chararry".

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

       class-object.
       object-storage section.
       end class-object.

       Object.

       object-storage section.

      *>----------------------------------------------------------------
      *> PRIVATE. Called by the OOPS runtime when everything is ready to
      *> be executed.
      *>----------------------------------------------------------------

       method-id. "readyforapplicationstart".
       procedure division.
           invoke self "isDBCSEnvironment"
                       returning DBCSEnvironmentStatus
           add 1 to DBCSEnvironmentStatus
           exit method.
       end method "readyforapplicationstart".

      *>----------------------------------------------------------------
      *> Return an ordered collection containing all the instances of
      *> this class.
      *>----------------------------------------------------------------

       method-id. "allInstances".
       local-storage section.
       01 ptr                  usage pointer.
       01 anObject             usage object reference.
       01 i                    pic x(4) comp-5.

       linkage section.
       01 allInstances.
      $if COBOL-64BIT defined
           03 numInstances     pic x(8) comp-5.
      $else
           03 numInstances     pic x(4) comp-5.
      $end
           03 anInstance       usage object reference.
       01 result               usage object reference.

       procedure division returning result.
           call "oopsgetallinstances" using self returning ptr
           set address of allInstances to ptr
           invoke OrderedCollection "ofReferences" using numInstances
                           returning result
           perform varying i from 1 by 1 until i > numInstances
               invoke result "add" using allInstances(i *
                   length of result + 1 : length of result)
                               returning anObject
           end-perform
           call "oopsfree" using by value ptr
           exit method.
       end method "allInstances".
      *>----------------------------------------------------------------
      *> Return a string which contains the description of this object.
      *>----------------------------------------------------------------
       method-id. "Description".       
       local-storage section.
       01 lsString             usage object reference.
       01 i                       pic x(4) comp-5.
       01 j                    pic x(4) comp-5.
       01 lsmsgfh               object reference.
       linkage section.

       01 lnkString            usage object reference.
       procedure division returning lnkString.
           invoke self "registerBaseMessageFile"
                                returning lsmsgfh
      *>> LNG 4: "the class %s"
           invoke self "name" returning lsString
           move 2 to i
           move 4 to j
           invoke lsmsgfh "getmessage" using i j lsstring
                   returning lnkString
           invoke lsString "finalize" returning lsString
           invoke lsmsgfh "finalize" returning lsmsgfh
           exit method.
       end method "Description".
      *>----------------------------------------------------------------
      *> Return self as the base Class for a class (unless the class is
      *> a cloned class).
      *>----------------------------------------------------------------

       method-id. "baseclass".
       linkage section.
       01 classhandle usage object reference.
       procedure division returning classhandle.
           set classhandle to self
           exit method.
       end method "baseclass".
      *>----------------------------------------------------------------
      *> Return the name of this class.
      *>----------------------------------------------------------------
       method-id. "Name".
       local-storage section.
       01 aclassname           pic x(30).
       linkage section.
       01 aString              usage object reference.
       procedure division returning aString.
           move spaces to aclassname
           call "oopsclassname" using self aclassname
           invoke characterArray "withSpaceTerminator"
                                           using aclassname
                   returning aString
           exit method.
       end method "Name".

      *>----------------------------------------------------------------
      *> Return true is this object is a class otherwise return false.
      *>----------------------------------------------------------------
       method-id. "isClass".
       linkage section.
       01 lnkbool               pic 9 comp-5.
       procedure division returning lnkbool.
           move 1 to lnkBool
           exit method.
       end method "isClass".

      *>----------------------------------------------------------------
      *>Return a collection of the immediateSubclasses of this class.
      *>----------------------------------------------------------------
       method-id. "immediatesubclasses".
       local-storage section.

       01 allclasses   usage object reference.
       01 acallback    usage object reference.
       01 allextclassdata    usage object reference.
       01 amethodname  pic x(80).
       01 result   usage object reference.
       01 anObject usage object reference.
       linkage section.
       01 lnkimmediatesubclasses usage object reference.

       procedure division returning lnkimmediatesubclasses.
           invoke self "allClasses" returning allClasses
           set anObject to NULL
           move "isImmediateSubclass " to amethodname
           invoke callback "new" using anObject amethodname self
                   returning acallback
           invoke allclasses "select" using  acallback
                   returning lnkimmediatesubclasses
           exit method.
       end method "immediatesubclasses".
      *>----------------------------------------------------------------
      *> Return true if lnkClass is the superclass of this class.
      *>----------------------------------------------------------------
       method-id. "isimmediatesubclass".
       local-storage section.
       01 superclass       usage object reference.
       linkage section.
       01 anobjectid   usage object reference.
       01 lnkclass   usage object reference.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       procedure division using lnkclass returning lnkbool.
           invoke self "superclass" returning superclass
           if superclass = lnkClass
               set lnkisTrue to true
           else
               set lnkisFalse to true
           end-if
           exit method.
       end method "isimmediatesubclass".

      *>----------------------------------------------------------------
      *> Return true if lnkClass is the a superclass of this class.
      *>----------------------------------------------------------------
       method-id. "isSubclass".
       local-storage section.
       01 superclass       usage object reference.
       linkage section.
       01 anobjectid   usage object reference.
       01 lnkclass   usage object reference.
       01 lnkbool                pic x comp-5.
           88  lnkistrue          value 1.
           88  lnkisfalse         value 0.
       procedure division using lnkclass returning lnkbool.
           invoke self "superclass" returning superclass
           set lnkIsFalse to true
           perform until superclass = null or superclass = lnkClass
               invoke superclass "superclass" returning superclass
           end-perform
           if superclass = lnkClass
               set lnkisTrue to true
           else
               set lnkisFalse to true
           end-if
           exit method.
       end method "isSubclass".

      *>----------------------------------------------------------------
      *> Return the superclass of this class.
      *>----------------------------------------------------------------
       method-id. "superclass".
       local-storage section.
       01 superclass       usage object reference.
       linkage section.
       01 lnkclass  usage object reference.
       01 anobjectid   usage object reference.

       procedure division returning lnkclass.
           call "oopsgetsuperclass" using self superClass
           set lnkClass to superclass
           exit method.
       end method "superclass".
      *>----------------------------------------------------------------
      *> Return the number of Objects in the current OO System.
      *>----------------------------------------------------------------
       method-id. "GetNumberOfObjects".
       local-storage section.
       01 oops-version-string      pic x(40).

       linkage section.

       01 lnkNumObjects        pic x(4) comp-5.
       procedure division returning lnkNumObjects.
           call "oopsgetobjectcount" using self
                                     returning lnkNumObjects
           exit method.
       end method "GetNumberOfObjects".
      *>----------------------------------------------------------------
      *>Return a collection of methods supported by the instance of
      *>this class. For example if allMethods was sent to the class
      *>Array a list of all the instance methods implemented within the
      *>class array would be returned.
      *>----------------------------------------------------------------
       method-id. "allmethods".
       local-storage section.
       01 ptr                  usage pointer.
       01 j                    pic x(4) comp-5.
       01 methodStart          pic x(4) comp-5.
       01 methodSize           pic x(4) comp-5.
       01 methodName           usage object reference.
       linkage section.
       01 aMethodList          usage object reference.
       01 allMethods.
      $if COBOL-64BIT defined
           03 numMethods       pic x(8) comp-5.
      $else
           03 numMethods       pic x(4) comp-5.
      $end
           03 methods          pic x.
       procedure division returning aMethodList.
           call "oopsgetmethodnames" using self returning ptr
           set address of allMethods to ptr
           invoke OrderedCollection "ofReferences" using numMethods
                       returning aMethodList.
           move zero to methodSize
                        methodStart
           perform varying j from 1 by 1 until j > numMethods
               add methodSize to methodStart
               add 1 to methodStart
               invoke CharacterArray "withSpaceTerminator"
                                           using methods(methodStart:)
                       returning methodName
               invoke methodName "sizeInBytes" returning methodSize
               invoke aMethodList "add" using methodName
           end-perform
           call "oopsfree" using by value ptr
           exit method.
       end method "allmethods".
      *>----------------------------------------------------------------
      *>Returns true if an instance of this class implements lnkMessage
      *>Otherwise false will be returned
      *>----------------------------------------------------------------
       method-id. "implements".
       local-storage section.
       01 allMethods  usage object reference.
       01 aMethodName usage object reference.
       01 anObject    usage object reference.
       linkage section.
       01 lnkMessage   usage object reference.
       01 lnkBool      pic x comp-5.

       procedure division  using lnkMessage returning lnkBool.
           invoke self "allmethods" returning allMethods
           invoke lnkMessage "asLowerCase" returning aMethodName
           invoke allMethods "includes" using amethodName
                                    returning lnkBool
           invoke aMethodName "finalize" returning anObject
           invoke allMethods "deepFinalize" returning anObject
           exit method.
       end method "implements".


      *>----------------------------------------------------------------
      *> Return an indexed instance with an indexed size of lnkNewSize
      *> bytes.
      *>----------------------------------------------------------------
       method-id. "newIndexedInstance".
       local-storage section.
       01 exceptionNumber      pic x(4) comp-5.
       linkage section.
       01 lnkNewSize    pic x(4) comp-5.
       01 lnkCollection usage object reference.
       procedure division using lnkNewSize returning lnkCollection.
           call "oopsnewindexedinstance" using self lnknewsize
                                         returning lnkcollection

           if lnkcollection equal to null
               move 23 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                        returning lnkcollection
           end-if
           exit method.
       end method "newIndexedInstance".
      *>----------------------------------------------------------------
      *> PRIVATE.  Returns an instance of the receiver.
      *>----------------------------------------------------------------
       method-id. "privatenew".
       local-storage section.
       01 exceptionnumber      pic x(4) comp-5.

       linkage section.
       01 result               usage object reference.

       procedure division returning result.
           call "oopsnewinstance" using self returning result
           if result equal to null
               move 23 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                            returning result
           end-if
           exit method.
       end method "privatenew".

      *>----------------------------------------------------------------
      *> Return an instance of the receiver.
      *>----------------------------------------------------------------
       method-id. "new".
       local-storage section.
       01 exceptionnumber      pic x(4) comp-5.

       linkage section.
       01 result               usage object reference.

       procedure division returning result.
           call "oopsnewinstance" using self returning result
           if result equal to null
               move 23 to exceptionnumber
               invoke self "raiseException"
                                            using exceptionnumber
                                            returning result
           end-if
           exit method.
       end method "new".
      *>----------------------------------------------------------------
      *> Return an instance of the receiver.
      *>----------------------------------------------------------------
       method-id. "basicnew".
       local-storage section.

       01 newobject            usage object reference.
       01 exceptionnumber      pic x(4) comp-5.

       linkage section.
       01 voidparam            usage object reference.
       01 result               usage object reference.

       procedure division returning result.
           call "oopsnewinstance" using self returning newobject
           if newobject equal to null
                move 23 to exceptionnumber
                invoke self "raiseException" using exceptionnumber
                                        returning result
           else
               set result to newobject
           end-if
           exit method.
       end method "basicnew".
      *>----------------------------------------------------------------
      *> Return true if this class responds to the message lnkMessage.
      *>----------------------------------------------------------------
       method-id. "respondsTo".
       local-storage section.

       01 aclass       usage object reference.

       linkage section.
       01 lnkBool       pic x comp-5.
           88  doesrespondTo  value 1.
           88  doesnotrespond value 0.
       01 lnkMessage    usage object reference.

       procedure division using lnkMessage returning lnkBool.
           set doesnotrespond to true
           set aClass to self
           perform with test after until aclass = null or doesrespondTo
               invoke aClass "implements" using lnkMessage
                                   returning lnkBool
               invoke aClass "superclass" returning aclass
           end-perform
       end method "respondsTo".
      *>----------------------------------------------------------------
      *>Return the filename of this class.
      *>----------------------------------------------------------------
       method-id. "getFileName".
       local-storage section.
       01 fileName pic x(255).
       linkage section.
       01 aFileName            usage object reference.
       procedure division returning aFileName.
           call "oopsgetclassfilename" using self filename
           invoke CharacterArray "withSpaceTerminator" using filename
                           returning aFileName
           exit method.
       end method "getFileName".
      *>----------------------------------------------------------------
      *> Empty initialization method for classes.
      *>----------------------------------------------------------------
       method-id. "initializeClass".
       procedure division.
           exit method.
       end method "initializeClass".
      *>----------------------------------------------------------------
      *> Empty initialization method for extension classes.
      *>----------------------------------------------------------------
       method-id. "initializeClassExtension".
       procedure division.
           exit method.
       end method "initializeClassExtension".
      *>----------------------------------------------------------------
      *> Return an ordered collection of all the Cobol classes.
      *>----------------------------------------------------------------

       method-id. "allClasses".
       local-storage section.
       01 anObject             usage object reference.
       01 ptr          pointer.
       01 i            pic x(4) comp-5.

       linkage section.
       01 allClasses.
       $if COBOL-64BIT defined
           03 numClasses       pic x(8) comp-5.
       $else
           03 numClasses       pic x(4) comp-5.
       $end
           03 aClass           usage object reference.

       01 result               usage object reference.

       procedure division returning result.
           call "oopsgetallclasses"  returning ptr
           set address of allClasses to ptr
           invoke OrderedCollection "ofReferences" using numClasses
                           returning result
           perform varying i from 1 by 1 until i > numClasses
               invoke result "add" using allClasses(i * length of result
                                       + 1 : length of result)
                               returning anObject
           end-perform
           call "oopsfree" using by value ptr
           exit method.
       end method "allClasses".
      *>----------------------------------------------------------------
      *>Return the handle of the class given the filename which
      *>implements the class. The filename should be null terminated.
      *>----------------------------------------------------------------

       method-id. "handlefromfilename".
       local-storage section.
       01 lsFilename pic x(256).
       01 i          pic x(4) comp-5.
       linkage section.
       01 lnkClass usage object reference.
       01 lnkFilename pic x(60).
       procedure division using lnkFilename returning lnkClass.
           call lnkFileName
           perform varying i from 1 by 1
                        until lnkFileName(i:1) = space or
                              lnkFileName(i:1) = x"00"
           end-perform
           move lnkFileName(1: i - 1) to lsFileName
           move x"00" to lsFileName(i:1)
           call "oopsgetclassobject" using lsFileName
               returning lnkClass
           exit method.
       end method "handlefromfilename".

      *>----------------------------------------------------------------
      *>Return the handle of the class given the filename and class
      *>name these values should be null terminated.
      *>----------------------------------------------------------------

       method-id. "handlefromfilenameAndClassName".
       local-storage section.
       01 lsFilename pic x(256).
       01 i          pic x(4) comp-5.
       linkage section.
       01 lnkClass usage object reference.
       01 lnkFilename      pic x(255).
       01 lnkClassName     pic x(255).
       procedure division using lnkFilename lnkClassName
                            returning lnkClass.
           perform varying i from 1 by 1
                        until lnkFileName(i:1) = space or
                              lnkFileName(i:1) = x"00"
           end-perform
           move lnkFileName(1: i - 1) to lsFileName
           move x"00" to lsFileName(i:1)

           call "oopsgetclassobject" using lsFileName
                           returning lnkClass
           exit method.
       end method "handlefromfilenameAndClassName".

      $if gc  defined  

      *>----------------------------------------------------------------
      *> PRIVATE. Destroys the object to which this message is sent.
      *> Terminate is currently not allowed for classes.
      *>----------------------------------------------------------------

       method-id. "terminating".
       local-storage section.
       01 i           pic x(4) comp-5.
       01 anObject    usage object reference.

       procedure division.
           move 104 to i
           invoke self "raiseException" using i returning anObject
           exit method.
       end method "terminating".

      $else

      *>----------------------------------------------------------------
      *> PRIVATE. Destroys the object to which this message is sent.
      *> Finalize is currently not allowed for classes.
      *>----------------------------------------------------------------

       method-id. "finalize".
       local-storage section.
       01 i           pic x(4) comp-5.
       01 anObject    usage object reference.
       linkage section.
       01 result               usage object reference.

       procedure division returning result.
           move 104 to i
           invoke self "raiseException" using i returning anObject
           set result to null
           exit method.
       end method "finalize".

      $end

      *>----------------------------------------------------------------
      *> PRIVATE. Get the Domain Object for this object.
      *> As domains are determined by inheritance, the domain class
      *> should contain the domain's implementation of this method.
      *> Here, we just raise an exception.
      *>----------------------------------------------------------------

       method-id. "GetDomainObject".
       local-storage section.
       01 i           pic x(4) comp-5.
       01 anObject    usage object reference.
       linkage section.
       01 result               usage object reference.

       procedure division returning result.
           move 105 to i
           invoke self "raiseException" using i returning anObject
           set result to null
           exit method.
       end method "GetDomainObject".

      *>----------------------------------------------------------------
      *> Return true this is a metaclass.
      *>----------------------------------------------------------------
       method-id. "isMetaClass".
       local-storage section.
       linkage section.
       01 lnkBool        pic x comp-5.
       procedure division returning lnkBool.
            move 1 to lnkBool
            exit program.
       end method "isMetaClass".
       end object.
       end class behavior.
