
      *>----------------------------------------------------------------
      *> A ThreadedCallback is a callback designed for use in
      *> multi-threaded applications.
      *>
      *>#See class "callback".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set mfoo
       class-id. ThreadedCallback data is protected
               inherits from Callback
                  with data.

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

       class-object.

       object-storage section.
       end class-object.

       Object.

       object-storage section.

      *>----------------------------------------------------------------
      *> Invokes the method encapsulated inside this ThreadedCallback
      *> 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 ThreadedCallback instance starts a new thread for each
      *> "invoke" message you send it.
      *>----------------------------------------------------------------

       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. 
          03 filler occurs maxnumparams.
                05 parm              usage pointer.
          03 parmmessagePtr          pointer.
          03 parmreceiver            usage object reference.


       01 instData                 pointer.

        01 param-size           pic x(4) comp-5.
        01 flags                pic x(4) comp-5.
        01 priority             pic s9(9) comp-5.
        01 stack-size           pic x(4) comp-5.
        01 thread-id            pointer.
        01 thread-param         pic x(4) comp-5.
        01 result               pic x(4) 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 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

               move 1 to thread-param
               move length of theParameters to param-size
               move zero to flags
               move zero to priority
               move 0 to stack-size

               set parmMessagePtr to address of messageName
               set parmReceiver to theReceiver
               call "CBL_THREAD_CREATE" using
                             by reference z"MessageHeader"
                             by reference theParameters
                             by value param-size
                             by value flags
                             by value priority
                             by value stack-size
                             by reference thread-id
                     returning result

             *>   if result not = 0
             *>      if result = 1008
             *>           display "Threading not supported"
             *>      else
             *>           display "did not kicked thread off ok"
             *>      end-if
             *>   end-if
                subtract 1 from isInvoked

      $if gc not defined
               if requestFinalize and isInvoked = 0
                   invoke self "finalize" returning lsObject
               end-if
      $end
           end-if
           copy "csleave".
           exit method.
       end method "invoke".
       end object.
       end class ThreadedCallback.
