      *>----------------------------------------------------------------
      *> An instance of Callback stores a message which can be invoked
      *> later. In effect it wraps the block of code for a method inside
      *> an object which you can store or pass to other objects.
      *>
      *> Send the "invoke" message to a Callback instance to execute
      *> the method stored inside it.
      *>
      *>#See the section Using Callbacks.
      *>
      *>!Note
      *> The maximum message length is 30 characters.
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set mfoo
       class-id. Callback data is protected
               inherits from EntryCallback
                  with data.

       special-names.
           call-convention 0 is paramcountcheck
           call-convention 66 is WAPI
           .
        object section.
        class-control.
           EntryCallback is class "entrycll"
           CharacterArray is class "chararry"
           callback is class "callback".

       class-object.

       object-storage section.
      *>----------------------------------------------------------------
      *> Return an instance of Callback with the receiver aReceiver,
      *> the message selector aMessageName and up to six parameters.
      *> When you send this instance the "invoke" message, it invokes
      *> method aMessageName on object aReceiver.
      *>
      *> The parameters p1 to p6 are optional. The addresses of any
      *> parameters you pass into the "new" method are stored in the
      *> Callback instance. When you invoke the Callback instance, the
      *> parameters are passed through to method aMessageName preceeding
      *> the parameters passed through with the "invoke" message.
      *>
      *> If you pass in more than six parameters with the "new" method
      *> then Callback raises an exception.
      *>
      *>#See the section Using Callbacks.
      *>
      *>----------------------------------------------------------------
       method-id. "new".
       local-storage section.

       01 exceptionnumber          pic s9(9) comp-5.
       01 sendObjectHandle         usage object reference.
       01 messageText              pic x(80).
       01 parmPointer              usage pointer.
       01 serverid                 pic x(4) comp-5.


       linkage section.
       01 areceiver            usage object reference.
       01 amessagename         pic x(80).
       01 p1                   usage object reference.
       01 p2                   usage object reference.
       01 p3                   usage object reference.
       01 p4                   usage object reference.
       01 p5                   usage object reference.
       01 p6                   usage object reference.
       01 p7notallowed         usage object reference.

       01 result               usage object reference.
       01 parmDescriptor       pic x.

       procedure division paramcountcheck
                using areceiver amessagename p1 p2 p3 p4 p5 p6
                                       p7notallowed
                                       returning result.
           if address of p7notAllowed not = null
               move 20 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                             returning result
               exit method
           else
               invoke super "basicnew" returning result
               invoke result "initialize" using areceiver
                                                   amessagename
                                                   p1
                                                   p2
                                                   p3
                                                   p4
                                                   p5
                                                   p6
           end-if
           exit method.
       end method "new".
       end class-object.

       Object.

       object-storage section.


       01 receiver             usage object reference.



       01 cacheBlock           pic x(4).

       01 hashValue            pic x(4) comp-5.

      *>----------------------------------------------------------------
      *> PRIVATE. Initialize the new instance of this callback.
      *>----------------------------------------------------------------

       method-id. "initialize".
       local-storage section.
       01 i pic x(4) comp-5.
       01 j                    pic x(4) comp-5.
       01 aString  usage object reference.
       01 aMask                pic x(4) comp-5.
       01 hashDigit            pic x.
       01 hashDigitAsNum redefines hashDigit pic x comp-5.

       linkage section.
       01 p1                   usage object reference.
       01 p2                   usage object reference.
       01 p3                   usage object reference.
       01 p4                   usage object reference.
       01 p5                   usage object reference.
       01 p6                   usage object reference.
       01 areceiver            usage object reference.
       01 amessagename         pic x(80).

       procedure division paramcountcheck
                using areceiver amessagename p1 p2 p3 p4 p5 p6.
           move zero to numParams
           if address of p1 not = null
               set objectParms(1) to p1
               move 1 to numParams
               if address of p2 not = null
                   set objectParms(2) to p2
                   move 2 to numParams
                   if address of p3 not = null
                       set objectParms(3) to p3
                       move 3 to numParams
                       if address of p4 not = null
                           set objectParms(4) to p4
                           move 4 to numParams
                           if address of p5 not = null
                               set objectParms(5) to p5
                               move 5 to numParams
                               if address of p6 not = null
                                   set objectParms(6) to p6
                                   move 6 to numParams
                               end-if
                           end-if
                       end-if
                   end-If
               end-if
           end-if
           move low-values to messagename
           invoke characterArray "withSpaceOrNullTerminator"
                       using amessageName
                   returning aString
           invoke aString "sizeInBytes" returning i
           if i > 79
               move z"callbackmethodnametoolong" to messageName
           else
               invoke aString "getValueZ" returning messageName
               call "CBL_TOLOWER" using messageName by value i
           end-if
           invoke aString "finalize" returning aString
           set receiver to areceiver
           move zero to isInvoked
           exit method.
       end method "initialize".


      *>----------------------------------------------------------------
      *> Invokes the method encapsulated inside this Callback instance.
      *> You can pass up to nine parameters to the "invoke" method,
      *> and they are passed to the encapsulated method in the same
      *> order, following any parameters you specified with the "new"
      *> method. Any return value from the encapsulated method is passed
      *> back in lnkReturnParam.
      *>
      *> The Callback instance raises an exception if you pass through
      *> more than nine parameters.
      *>----------------------------------------------------------------

       method-id. "invoke".
       local-storage section.
       01 procPtr                  procedure-pointer.
       01 lsObject                 usage object reference.
       01 ooreturnptr              usage object reference.
       01 exceptionnumber          pic s9(9) comp-5.
       01 thereceiver              usage object reference.
       01 numparamsplusargs        pic s9(9) comp-5.
       01 i                        pic x(4) comp-5.
       01 theParameters. 
          05 parm              usage pointer occurs maxnumparams.
       01 instData                 pointer.
       01 lsDoneLeave              pic x comp-5.

       linkage section.
       01 lnkreturnparam            usage object reference.
       01 anarg1               usage object reference.
       01 anarg2               usage object reference.
       01 anarg3               usage object reference.
       01 anarg4               usage object reference.
       01 anarg5               usage object reference.
       01 anarg6               usage object reference.
       01 anarg7               usage object reference.
       01 anarg8               usage object reference.
       01 anarg9               usage object reference.
       01 anarg10notallowed    usage object reference.

       procedure division paramcountcheck
                  using anarg1 anarg2 anarg3 anArg4 anArg5
                        anArg6 anArg7 anArg8 anArg9 anArg10NotAllowed
                            returning lnkreturnparam.
           copy "csenter".
           move 0 to lsDoneLeave
           move low-values to theParameters
           if address of lnkreturnparam = null
               set address of lnkreturnparam to address of ooreturnptr
           end-if
           if address of anarg10notallowed not = null
               move 21 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                                             returning lnkreturnparam
           else
               perform varying i from 1 by 1 until i > numParams
                   set parm(i) to address of objectParms(i)
               end-perform
               move numparams to numparamsplusargs
               if address of anarg1 not = null
                   if receiver equal to null
                       set thereceiver to anarg1
                   else
                       set thereceiver to receiver
                       add 1 to numparamsplusargs
                       set parm(numparamsplusargs) to address of anarg1
                   end-if
                   if address of anarg2 not = null
                       add 1 to numparamsplusargs
                       set parm(numparamsplusargs) to address of anarg2
                       if address of anarg3 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg3
                       end-if
                       if address of anarg4 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg4
                       end-if
                       if address of anarg5 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg5
                       end-if
                       if address of anarg6 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg6
                       end-if
                       if address of anarg7 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg7
                       end-if
                       if address of anarg8 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg8
                       end-if
                       if address of anarg9 not = null
                           add 1 to numparamsplusargs
                           set parm(numparamsplusargs) to
                                                      address of anarg9
                       end-if
                   end-if
               else
                   set thereceiver to receiver
               end-if
               add 1 to isInvoked

               *>>> Warning... Following 2 calls are private and should
               *>>> not be used by any other class / programmer as
               *>>> implementation is likely to change.

                call "cobinvoke2"
                   using by value theReceiver
                         by reference messageName
                         by reference hashValue
                         by reference cacheBlock
                         by value 16
                         by reference lnkreturnparam
                         by value parm(1)
                         by value parm(2)
                         by value parm(3)
                         by value parm(4)
                         by value parm(5)
                         by value parm(6)
                         by value parm(7)
                         by value parm(8)
                         by value parm(9)
                         by value parm(10)
                         by value parm(11)
                         by value parm(12)
                         by value parm(13)
                         by value parm(14)
                         by value parm(15)

               subtract 1 from isInvoked
      $if gc not defined
               if requestFinalize and isInvoked = 0
                   move 1 to lsDoneLeave
                   copy "csleave".
                   invoke self "finalize" returning lsObject
               end-if
      $end
           end-if
           if lsDoneLeave = 0
               copy "csleave".
               continue
           end-if
           exit method.
       end method "invoke".
      *>----------------------------------------------------------------
      *> Return the receiver.
      *>----------------------------------------------------------------
       method-id. "getReceiver".
       linkage section.
       01 lnkObject         usage object reference.
       procedure division returning lnkObject.
           set lnkObject to receiver
           exit method.
       end method "getReceiver".


      *>----------------------------------------------------------------
      *> Returns true if lnkCallback is a callback pointing to the same
      *> message and object as this callback.
      *>----------------------------------------------------------------
       method-id. "equal".
       local-storage section.
       01 lsMessage          pic x(81).
       01 lsReceiver         object reference.

       linkage section.
       01 lnkCallback        object reference.
       01 lnkBool            pic x comp-5.
          88 isTrue          value 1.
          88 isFalse         value 0.

       procedure division using lnkCallback returning lnkBool.
           invoke lnkCallback "getMessage" returning lsMessage
           invoke lnkCallback "getReceiver" returning lsReceiver
           if messageName = lsMessage and receiver = lsReceiver
               set isTrue to true
           else
               set isFalse to true
           end-if
           exit method.
       end method "equal".
      *>----------------------------------------------------------------
      *> Reset the cache. Not valid on a second run.
      *>----------------------------------------------------------------

       method-id. "prepareToBeSaved".
       procedure division.
           move low-values to cacheBlock
           exit method.
       end method "prepareToBeSaved".

      $if gc defined

      *>----------------------------------------------------------------
      *> Frees the oops cache.
      *>----------------------------------------------------------------
       method-id. "terminating".
       procedure division.
           call "oopsfreecache" using by value cacheBlock
           invoke super "terminating"
           exit method.
       end method "terminating".

      $else
      *>----------------------------------------------------------------
      *>----------------------------------------------------------------
       method-id. "resetCache".
       procedure division.
           move low-values to cacheBlock
           exit method.
       end method "resetCache".

      *>----------------------------------------------------------------
      *> Destroys the object to which this message is sent. The result
      *> is always set to null. Therefore invoke anObject "finalize"
      *> returning anObject will destroy anObject and set the reference
      *> to null.
      *>----------------------------------------------------------------
       method-id. "finalize".
       linkage section.
       01 lnkObject        usage object reference.
       procedure division returning lnkObject.
           copy "csenter".
           if isInvoked = 0
                copy "csleave".
                call "oopsfreecache" using by value cacheBlock
                invoke super "finalize" returning lnkObject
           else
                set requestFinalize to true
           end-if
           exit method.
       end method "finalize".
      $end
       end object.
       end class callback.
