       copy "chararry.if".
       copy "base.if".
      *>----------------------------------------------------------------
      *> Extends Base class. Contains those methods which need to be
      *> compiled with the "typecheck" directive.
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
       Class-id. eBase extend Base with data.

       special-names.
           call-convention 0 is paramcountcheck
           call-convention 66 is WAPI
           .

       Object section.

       Class-control.
           Base is class "base"
           Callback is class "callback"
           CharacterArray is class "chararry"
           cobolcomp5 is class "comp5"
           ExceptionManager is class "exptnmgr"
           DelegateManager is class "delegate"
           IdentitySet is class "iset"
           Event is class "event"
           Dictionary is class "dictinry"
           IdentityDictionary is class "idictnry"
           SystemDictionary is class "systemd"
           OrderedCollection is class "ordrdcll"
           CobolComp5Association is class "compasoc"
           PicXToObject is class "picxtoob"
           Association is class "associtn"
           MessageFileHandler is class "msgfh".

      $if debug defined
       working-storage section.
       01 acquiregroup.
                03 filler pic x(10) value "Acquiring".
                03 dispNum      pic 999999999.
                03 filler       pic x value x"00".

       01 releasegroup.
                03 filler pic x(10) value "Releasing".
                03 dispNum      pic 999999999.
                03 filler       pic x value x"00".

       01 Closegroup.
                03 filler pic x(10) value "Closing".
                03 dispNum      pic 999999999.
                03 filler       pic x value x"00".

       01 Opengroup.
                03 filler pic x(10) value "Opening".
                03 dispNum      pic 999999999.
                03 filler       pic x value x"00".

      $end  

       thread-local-storage section.
       01  errorText                    pic x(32).
       01  errorTextAdditional          pic x(32).



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


      *>----------------------------------------------------------------
      *> Report an error for this instance using ErrNumber, and a 
      *> collection of text strings giving additional information about 
      *> the cause of the error. 
      *> This method would typically be invoked from a user defined 
      *> exception handler which has received an exception it does not 
      *> want to handle itself, in order to pass the exception to another 
      *> exception handler.
      *>----------------------------------------------------------------
       method-id. "raiseExceptionWithTextCollection".
       local-storage section.
       01 lsResult             usage object reference.
       linkage section.
       01 result               usage object reference.
       01 errnumber            pic x(4) comp-5.
       01 lnktextcollection    usage object reference.

       procedure division paramcountcheck
                          using errnumber
                                lnktextcollection
                      returning result.
           if address of result = null
               set address of result to address of lsResult
           end-if
           if self equal to null
               invoke ExceptionManager "raisestatic" using
                                            selfclass
                                            errnumber
                                            lnktextcollection
                                        returning result
           else
               invoke ExceptionManager "raise" using
                                            self
                                            errnumber
                                            lnktextcollection
                                        returning result
           end-if
           exit method.
       end method "raiseExceptionWithTextCollection".


      *>----------------------------------------------------------------
      *> Report an error for this instance using ErrNumber, and up to
      *> six text strings giving additional information about the cause
      *> of the error. This method will create an ordered collection to
      *> hold the text strings, and pass it to a user defined exception
      *> handler if one has been registered.
      *>----------------------------------------------------------------
       method-id. "raiseExceptionWithText".
       local-storage section.
       01 lsResult             usage object reference.
       01 lsordcll               usage object reference.
       01 lssize               pic x(4) comp-5.
       linkage section.
       01 result               usage object reference.
       01 errnumber            pic x(4) comp-5.
       01 lnkstring1               usage object reference.
       01 lnkstring2           usage object reference.
       01 lnkstring3           usage object reference.
       01 lnkstring4           usage object reference.
       01 lnkstring5           usage object reference.
       01 lnkstring6           usage object reference.

       procedure division paramcountcheck
                          using errnumber
                                lnkstring1
                                lnkstring2
                                lnkstring3
                                lnkstring4
                                lnkstring5
                                lnkstring6
                      returning result.
           if address of result = null
               set address of result to address of lsResult
           end-if
           if address of lnkstring1 = null then
               set lsordcll to null
           else
               move 6 to lssize
               invoke OrderedCollection "ofReferences"
                                       using lssize
                                   returning lsordcll
               invoke lsordcll "add" using lnkstring1
               if address of lnkstring2 not = null then
                 invoke lsordcll "add" using lnkstring2
                 if address of lnkstring3 not = null then
                   invoke lsordcll "add" using lnkstring3
                   if address of lnkstring4 not = null then
                     invoke lsordcll "add" using lnkstring4
                     if address of lnkstring5 not = null then
                       invoke lsordcll "add" using lnkstring5
                       if address of lnkstring6 not = null then
                         invoke lsordcll "add" using lnkstring6
                       end-if
                     end-if
                   end-if
                 end-if
               end-if
           end-if
           if self equal to null
               invoke ExceptionManager "raisestatic" using
                                            selfclass
                                            errnumber
                                            lsordcll
                                        returning result
           else
               invoke ExceptionManager "raise" using
                                            self
                                            errnumber
                                            lsordcll
                                        returning result
           end-if
           exit method.
       end method "raiseExceptionWithText".

      *>----------------------------------------------------------------
      *> Report an error for this instance using ErrNumber, and up to
      *> six null-terminated text strings giving additional information
      *> about the cause of the error. This method will create an
      *> ordered collection to hold the text strings, and pass it to a
      *> user defined exception handler if one has been registered.
      *>----------------------------------------------------------------
       method-id. "raiseExceptionWithTextZ".
       local-storage section.
       01 lsResult             usage object reference.
       01 lsordcll             usage object reference.
       01 lssize               pic x(4) comp-5.
       01 lsstring             usage object reference.
       linkage section.
       01 result               usage object reference.
       01 errnumber            pic x(4) comp-5.
       01 lnkstring1           usage object reference.
       01 lnkstring2           usage object reference.
       01 lnkstring3           usage object reference.
       01 lnkstring4           usage object reference.
       01 lnkstring5           usage object reference.
       01 lnkstring6           usage object reference.

       procedure division paramcountcheck
                          using errnumber
                                lnkstring1
                                lnkstring2
                                lnkstring3
                                lnkstring4
                                lnkstring5
                                lnkstring6
                      returning result.
           if address of result = null
               set address of result to address of lsResult
           end-if
           if address of lnkstring1 = null then
               set lsordcll to null
           else
               move 6 to lssize
               invoke OrderedCollection "ofReferences"
                                       using lssize
                                   returning lsordcll
               invoke CharacterArray "withvalue" using lnkstring1
                        returning lsString
               invoke lsordcll "add" using lsString
               if address of lnkstring2 not = null then
                   invoke CharacterArray "withvalue"
                               using lnkstring2
                               returning lsString
                   invoke lsordcll "add" using lsString
                   if address of lnkstring3 not = null then
                       invoke CharacterArray "withvalue"
                               using lnkstring3
                               returning lsString
                       invoke lsordcll "add" using lsString
                       if address of lnkstring4 not = null then
                           invoke CharacterArray "withvalue"
                               using lnkstring4
                               returning lsString
                           invoke lsordcll "add" using lsString
                           if address of lnkstring5 not = null then
                               invoke CharacterArray "withvalue"
                                   using lnkstring5
                                   returning lsString
                               invoke lsordcll "add" using lsString
                               if address of lnkstring6 not = null then
                                   invoke CharacterArray "withvalue"
                                       using lnkstring6
                                       returning lsString
                                   invoke lsordcll "add" using lsString
                               end-if
                           end-if
                       end-if
                   end-if
               end-if
           end-if
           if self equal to null
               invoke ExceptionManager "raisestatic" using
                                            selfclass
                                            errnumber
                                            lsordcll
                                        returning result
           else
               invoke ExceptionManager "raise" using
                                            self
                                            errnumber
                                            lsordcll
                                        returning result
           end-if
           exit method.
       end method "raiseExceptionWithTextZ".

      *>------------------------------------------------------------
      *> PRIVATE. Write a trace record
      *>------------------------------------------------------------
       Method-id. "writeTrace".

       local-storage section.
       01  lsTraceRecord       object reference.
       01  lsParameter         object reference.
       01  lsTraceData         pic x(256).
       01  lsSize              pic s9(9) comp-5.

       linkage section.
       01  lnkParameter1       pic x.
       01  lnkParameter2       pic x.
       01  lnkParameter3       pic x.
       01  lnkParameter4       pic x.
       01  lnkParameter5       pic x.
       01  lnkParameter6       pic x.
       01  lnkParameter7       pic x.
       01  lnkParameter8       pic x.
       01  lnkParameter9       pic x.

       procedure division paramcountcheck
                          using lnkParameter1
                                lnkParameter2
                                lnkParameter3
                                lnkParameter4
                                lnkParameter5
                                lnkParameter6
                                lnkParameter7
                                lnkParameter8
                                lnkParameter9
                                .
               if address of lnkParameter1 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter1
                       returning lsTraceRecord
               end-if
               if address of lnkParameter2 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter2 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter3 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter3 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter4 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter4 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter5 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter5 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter6 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter6 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter7 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter7 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               if address of lnkParameter8 not = null
                   invoke CharacterArray "withSpaceOrNullTerminator"
                       using lnkParameter8 returning lsParameter
                   invoke self "concatTrace" using lsTraceRecord
                                                   lsParameter
               end-if
               invoke lsTraceRecord "sizeInBytes" returning lsSize
               if lsSize > 255
                   raise exception traceRecordTooLong
               else
                   invoke lsTraceRecord "asParameter"
                       returning lsTraceData
                   invoke self "trace" using lsTraceData
           exit method.
       end method "writeTrace".

      *>----------------------------------------------------------------
      *> Report an error for this instance using ErrNumber. This will
      *> call a user defined exception handler if one has been
      *> registered.
      *>----------------------------------------------------------------
       method-id. "raiseException".
       local-storage section.
       01 lsResult               usage object reference.
       01 nulobjref              usage object reference.

       linkage section.
       01 result               usage object reference.
       01 errnumber            pic x(4) comp-5.

       procedure division paramcountcheck
                        using errnumber returning result.
           if address of result = null
               set address of result to address of lsResult
           end-if
           set nulobjref to null
           if self equal to null
               invoke ExceptionManager "raisestatic" using selfclass
                                                           errnumber
                                                           nulobjref
                                                 returning result
           else
               invoke ExceptionManager "raise" using self errnumber
                                                           nulobjref
                                                    returning result
           end-if
           exit method.
       end method "raiseException".

      *>----------------------------------------------------------------
      *> Raises an exception as receiver does not understand the message
      *> sent to it. You would not normally raise this message directly.
      *> However you can override it to change the default behavior.
      *>----------------------------------------------------------------
       method-id. "doesNotUnderstand".
       local-storage section.
       01 anErrorMessage       pic x(160).
       01 exceptionnumber      pic x(4) comp-5.
       01 aDelegate            usage object reference.
       01 tmpObject            usage object reference.
       01 anerrorclassname     pic x(30).

       linkage section.
       01 p1       pic x.
       01 p2       pic x.
       01 p3       pic x.
       01 p4       pic x.
       01 p5       pic x.
       01 p6       pic x.
       01 p7       pic x.
       01 result   pic x.
       procedure division using p1 p2 p3 p4 p5 p6 p7 returning result.
           invoke delegateManager "getDelegateFor" using self
               returning aDelegate
           if aDelegate = null
               move 24 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
                               returning tmpObject
           else
               move spaces to anerrormessage
               call "oopserrordetails" using self,
                                         anerrorclassname,
                                         anerrormessage
               invoke aDelegate anErrorMessage using p1 p2 p3 p4
                            p5 p6 p7 returning result
           exit method.
       end method "doesNotUnderstand".

      *>------------------------------------------------------------
      *> Sends the signal lnkSignalId to any components which are
      *> connected to this component.
      *> lnkSignalId is a space- or null-terminated string.
      *> Before you attempt to send a signal from a component, you
      *> must first define all its output signals and connect it
      *> to a component which can receive them using the methods
      *> "makeComponent", "defineOutSignal" and "connect".
      *> For more information on Components and Signals see the topic
      *> Component Frameworks in the on-line documentation.
      *>------------------------------------------------------------
       Method-id. "signal".
       local-storage section.
       01  lsClassName                 object reference.
       01  lsClassNameText             pic x(64).
       01  lsNoOfHandlers              pic s9(9) comp-5.
       01  lsSignalHandlerIndex        pic s9(9) comp-5.
       01  lsSignalHandlers            object reference.
       01  lsHandler                   object reference.
       01  lsSignalId                  pic x(32).
       01  lsString                    object reference.
       01  lsCallback                  object reference.
       01  i                           pic s9(9) comp-5.
       01  muteFlag                    pic s9(9) comp-5.
           88 notMuted                 value 0.
       01  lsPointer                 pointer.

       linkage section.
       01  lnkSignalId                       pic x(32).
       01  lnkP1                       object reference.
       01  lnkP2                       object reference.
       01  lnkP3                       object reference.
       01  lnkP4                       object reference.
       01  lnkP5                       object reference.
       01  lnkP6                       object reference.
       01  lnkP7                       object reference.
       01  lnkP8                       object reference.
       01  lnkP9                       object reference.
       01  lnkP10                      object reference.
       01  lnkSignalReturnValue        object reference.
       copy "compnent.cpy".

       procedure division using lnkSignalId
                                lnkP1
                                lnkP2
                                lnkP3
                                lnkP4
                                lnkP5
                                lnkP6
                                lnkP7
                                lnkP8
                                lnkP9
                                lnkP10
                      returning lnkSignalReturnValue.
           call "oopsgetcomponentdata" using self
                        returning lsPointer

           set address of componentInstanceData
           to  lsPointer
           copy "csenter".
           move spaces to lsSignalId
           perform varying i from 1 by 1
                   until lnkSignalId(i:1) = x"00"
                   or    lnkSignalId(i:1) = space
               move lnkSignalId(i:1) to lsSignalId(i:1)
           end-perform
           set notMuted to true
           if spies <> null
               invoke spies "size" returning i
               if i > 0
                   invoke CharacterArray "withSpaceTerminator"
                                                     using lsSignalId
                                                 returning lsString
                   invoke Callback "new" using self
                                               "sendToSpy "
                                               lsString
                                               muteFlag
                                     returning lsCallback
                   invoke spies "do" using lsCallback
                   move 2 to i
                   invoke lsCallback "getParameter" using i
                                                returning muteFlag
               end-if
           end-if
           if outputs <> null
             if notMuted
               invoke outputs "atOrNil" using lsSignalId
                                returning lsSignalHandlers
               if lsSignalHandlers <> null
                  invoke lsSignalHandlers "size"
                      returning lsNoOfHandlers
                  if lsNoOfHandlers <> 0
                      move 1 to lsSignalHandlerIndex
                      perform with test after
                          varying lsSignalHandlerIndex from 1 by 1
                          until lsSignalHandlerIndex = lsNoOfHandlers
                             or lsNoOfHandlers = 0
                              invoke lsSignalHandlers "at"
                                     using lsSignalHandlerIndex
                                 returning lsHandler
                              if signalTracing
                                   invoke self "className"
                                               returning lsClassName
                                   move low-values to lsClassNameText
                                   invoke lsClassName "getValue"
                                               returning lsClassNameText
                                   writetrace with
                                               lsClassNameText
                                               " sending signal "
                                               lsSignalId(1:32)
                              end-if
                              copy "csleave".
                              invoke lsHandler "invoke"
                                           using lnkP1
                                                 lnkP2
                                                 lnkP3
                                                 lnkP4
                                                 lnkP5
                                                 lnkP6
                                                 lnkP7
                                                 lnkP8
                                                 lnkP9
                                                 lnkP10
                                       returning lnkSignalReturnValue
                              copy "csenter".
                              invoke lsSignalHandlers "size"
                                            returning lsNoOfHandlers
                      end-perform
                  end-if
               else
                   move lsSignalId to errorText
                   raise exception outputSignalUndefined
               end-if
             end-if
           else
              raise exception outputSocketUninitialized
           end-if
           copy "csleave".
           exit method.
       end method "signal".
      *>------------------------------------------------------------
      *> Sends the signal lnkSignalId to any components which are
      *> connected to this component.
      *> This method is similar to the "signal" method, except that
      *> lnkSignalId is a characterarray instead of a pic x(32).
      *> Before you attempt to send a signal from a component, you
      *> must first define all its output signals and connect it
      *> to a component which can receive them using the methods
      *> "makeComponent", "defineOutSignal" and "connect".
      *> For more information on Components and Signals see the topic
      *> Component Frameworks in the on-line documentation.
      *>------------------------------------------------------------
       Method-id. "signalString".
       local-storage section.
       01  lsSignalId                  pic x(32).

       linkage section.
       01  lnkSignalId                 object reference.
       01  lnkP1                        object reference.
       01  lnkP2                       object reference.
       01  lnkP3                       object reference.
       01  lnkP4                       object reference.
       01  lnkP5                       object reference.
       01  lnkP6                       object reference.
       01  lnkP7                       object reference.
       01  lnkP8                       object reference.
       01  lnkP9                       object reference.
       01  lnkP10                      object reference.
       01  lnkSignalReturnValue        object reference.

       procedure division using lnkSignalId
                                lnkP1
                                lnkP2
                                lnkP3
                                lnkP4
                                lnkP5
                                lnkP6
                                lnkP7
                                lnkP8
                                lnkP9
                                lnkP10
                      returning lnkSignalReturnValue.
           move spaces to lsSignalId
           invoke lnkSignalId "getValue" returning lsSignalId
           invoke self "signal" using lsSignalId,
                                lnkP1
                                lnkP2
                                lnkP3
                                lnkP4
                                lnkP5
                                lnkP6
                                lnkP7
                                lnkP8
                                lnkP9
                                lnkP10
                      returning lnkSignalReturnValue
           exit method.
       end method "signalString".

      *>----------------------------------------------------------------
      *> Defines an input signal for this component, so lnkMethodName
      *> is invoked automatically whenever another component sends the
      *> signal lnkSignalId on the socket lnkSocketid.
      *> You must invoke the methods "makeComponent" and
      *> "defineInSocket" to make an object into a component and define
      *> an input socket for it before you can define any input signals.
      *> You must also invoke the method "connect" after defining all
      *> input and output signals, to connect two components together
      *> before they can send signals to each other.
      *> For more information on Components and Signals see the topic
      *> Component Frameworks in the on-line documentation.
      *>----------------------------------------------------------------
       Method-id. "defineInSignal".
       local-storage section.
       01  lsCallback              object reference.
       01  lsClassName             object reference.
       01  lsClassNameText         pic x(64).
       01  lsSocketId              pic x(32).
       01  lsSocket                object reference.
       01  lsSignalId              pic x(32).
       01  i                       pic s9(9) comp-5.
       01  lsPointer                 pointer.

       linkage section.
       01  lnkSignalId             pic x(32).
       01  lnkSocketId             pic x(32).
       01  lnkMethodName           pic x(32).
       copy "compnent.cpy".

       procedure division using lnkSignalId,
                                lnkSocketId,
                                lnkMethodName.
           call "oopsgetcomponentdata" using self
                        returning lsPointer

           set address of componentInstanceData
           to  lsPointer
           move spaces to lsSocketId
           perform varying i from 1 by 1
                   until lnkSocketId(i:1) = x"00"
                   or    lnkSocketId(i:1) = space
               move lnkSocketId(i:1) to lsSocketId(i:1)
           end-perform
           move spaces to lsSignalId
           perform varying i from 1 by 1
                   until lnkSignalId(i:1) = x"00"
                   or    lnkSignalId(i:1) = space
               move lnkSignalId(i:1) to lsSignalId(i:1)
           end-perform
           invoke sockets "atOrNil"
                               using lsSocketId
                           returning lsSocket
           if signalTracing
               invoke self "className" returning lsClassName
               move low-values to lsClassNameText
               invoke lsClassName "getValue"
                   returning lsClassNameText
               writetrace with "Defining input signal "
                               lsSignalId(1:32)
                               " on "
                               lsSocketId(1:32)
                               " for "
                               lsClassNameText
           end-if
           if lsSocket <> null
               invoke lsSocket "atOrNil" using lsSignalId(1:32)
                                     returning lsCallback
               if lsCallBack = null
                   invoke Callback "new" using self lnkMethodName
                                     returning lsCallback
                   invoke lsSocket "atPut" using lsSignalId(1:32)
                                             lsCallback
               else if not duplicatesOK
                   move lsSocketId to errorText
                   move lsSignalId to errorTextAdditional
                   raise exception duplicateInputSignal
               end-if
           else
               move lsSocketId to errorText
               raise exception inputSocketUndefined
           end-if
           exit method.
       end method "defineInSignal".

      *>------------------------------------------------------------
      *> PRIVATE. Iterator
      *> Connects the outputs of outputComponent to socket socketID
      *> of inputComponent.
      *>
      *> Connect one component to another by copying callbacks from the
      *> socketID Identity Dictionary of the inputComponent
      *> to the OrderedCollection of the output socket of
      *> outputComponent
      *------------------------------------------------------------
       Method-id. "copyConnection".

       local-storage section.
       01  lsCallback                 object reference.
       01  lsCallbackCopy             object reference.
       01  lsSocket                   object reference.
       01  lsSocketId                 pic x(32).
       01  lsClassName                object reference.
       01  lsClassNameText            pic x(64).
       01  lsPointer                  pointer.
       01  lsBool                     pic x comp-5.
           88 isTrue                  value 1.
           88 isFalse                 value 0.

       linkage section.
       01  lnkSignalId                pic x(32).
       01  lnkSignalHandlers          object reference.
       01  lnkInputComponent          object reference.
       01  lnkSocketId                object reference.
       copy "compnent.cpy".

       procedure division using lnkInputComponent
                                lnkSocketId
                                lnkSignalId
                                lnkSignalHandlers.
           call "oopsgetcomponentdata" using self
                        returning lsPointer
           set address of componentInstanceData
           to  lsPointer
           copy "csenter".
           move spaces to lsSocketId
           invoke lnkSocketId "getValue" returning lsSocketId
           if signalTracing
               invoke lnkInputComponent "className"
                   returning lsClassName
               move low-values to lsClassNameText
               invoke lsClassName "getValue" returning lsClassNameText
               writetrace with "Connecting "
                               lnkSignalId(1:32)
                               " to "
                               lsClassNameText
                               " at socket "
                               lsSocketId
           end-if
           invoke lnkInputComponent "getSocket" using lsSocketId
                                            returning lsSocket
           if lsSocket <> null
               invoke lsSocket "atOrNil" using lnkSignalId
                                     returning lsCallback
               if lsCallback <> null
                   if lnkSignalHandlers <> null
                       invoke lnkSignalHandlers "includes"
                                                  using lsCallback
                                              returning lsBool
                       if isfalse
                           invoke lsCallback "copy"
                                         returning lsCallbackCopy
                           invoke lnkSignalHandlers "addLast"
                                             using lsCallbackCopy
                           invoke lnkInputComponent
                               "addSignalDependant"
                                             using self
                       end-if
                   else
                       raise exception internalError
                   end-if
               end-if
           else
               move lsSocketId to errorText
               raise exception inputSocketUndefined
           end-if
           copy "csleave".
           exit method.
       end method "copyConnection".

      *>------------------------------------------------------------
      *> Defines an output signal for this component. The name of
      *> the output signal lnkSignalId must be a space- or null-
      *> terminated name of 32 characters or less.
      *> You must invoke the method "makeComponent" to make an object
      *> into a component before you can define any output signals.
      *> You must also invoke the method "connect" after defining all
      *> input and output signals, to connect two components together
      *> before they can send signals to each other.
      *> For more information on Components and Signals see the topic
      *> Component Frameworks in the on-line documentation.
      *>------------------------------------------------------------
       Method-id. "defineOutSignal".
       local-storage section.
       01  lsSignalHandlerList        object reference.
       01  lsStandardSignalChainSize  pic s9(9) comp-5.
       01  lsSignalId                 pic x(32).
       01  i                          pic s9(9) comp-5.
       01  lsStandardOutputs          pic s9(9) comp-5.
       01  lsClassName                object reference.
       01  lsClassNameText            pic x(64).
       01  lsPointer                 pointer.

       linkage section.
       01  lnkSignalId                pic x(32).
       copy "compnent.cpy".

       procedure division using lnkSignalId.
           call "oopsgetcomponentdata" using self
                        returning lsPointer

           set address of componentInstanceData
           to  lsPointer
           copy "csenter".
           move spaces to lsSignalId
           perform varying i from 1 by 1
                   until lnkSignalId(i:1) = x"00"
                   or    lnkSignalId(i:1) = space
               move lnkSignalId(i:1) to lsSignalId(i:1)
           end-perform
           invoke outputs "atOrNil" using lsSignalId(1:32)
                                returning lsSignalHandlerList
           if lsSignalHandlerList = null
               move numberOfHandlersForSignal
               to   lsStandardSignalChainSize
               invoke OrderedCollection "ofReferences"
                                       using lsStandardSignalChainSize
                                   returning lsSignalHandlerList
               if signalTracing
                   invoke self "className" returning lsClassName
                   move low-values to lsClassNameText
                   invoke lsClassName "getValue"
                       returning lsClassNameText
                   writetrace with "Defining output signal "
                                   lsSignalId(1:32)
                                   " for "
                                   lsClassNameText
               end-if
                   invoke outputs "atPut" using lsSignalId(1:32)
                                                lsSignalHandlerList
           else if not duplicatesOK
               move lsSignalId to errorText
               raise exception duplicateOutputSignal
           end-if
           copy "csleave".
           exit method.
       end method "defineOutSignal".

      *>------------------------------------------------------------
      *> PRIVATE. Component exception handler
      *>------------------------------------------------------------
       Method-id. "componentException".

       local-storage section.
       01  lsChar                          pic x.
       01  lsClassName                     object reference.
       01  lsClassNameText                 pic x(64).
       01  lsPointer                       pointer.
       01  lsmsgfh                         object reference.
       01  tracetext                       pic x(256).
       01  i                               pic x(4) comp-5.
       01  j                               pic x(4) comp-5.
       01  astring                         object reference.
       01  string1                         object reference.
       01  string2                         object reference.
       01  string3                         object reference.


       linkage section.
       01  lnkErrorObject                   object reference.
       01  lnkErrorNumber                  pic x(4) comp-5.
       01  lnkTextCollection               object reference.
       01  lnkNullReference                object reference.
       copy "compnent.cpy".

       procedure division using lnkErrorObject
                                lnkErrorNumber
                                lnkTextCollection
                      returning lnkNullReference.
           call "oopsgetcomponentdata" using self
                        returning lsPointer

           set address of componentInstanceData
           to  lsPointer
           copy "csenter".
           set lnkNullReference to null
           move low-values to lsClassNameText
           invoke self "registerBaseMessageFile"
                                returning lsmsgfh
           invoke self "description" returning string1
           set string3 to null
           if lnkTextCollection = null then
               set string2 to null
           else
               invoke lnkTextCollection "size" returning j
               if j >= 1 then
                   move 1 to i
                   invoke lnkTextCollection "at" returning string2
                   if j >= 2 then
                       move 2 to i
                       invoke lnkTextCollection "at" returning string3
                   end-if
               end-if
           end-if
           evaluate lnkErrorNumber
               when inputSocketUndefined
           *>> LNG 21: ">> Component: %s undefined input socket: %s"
                   move 2 to i
                   move 21 to j
                   invoke lsmsgfh "getmessage"
                       using i j string1 string2
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring
               when outputSocketUninitialized
           *>> LNG 22: ">> Component: %s output socket uninitialized"
                   move 2 to i
                   move 22 to j
                   invoke lsmsgfh "getmessage"
                       using i j string1
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring
               when outputSignalUndefined
           *>> LNG 23:">> Component: %1$s output signal undefined: %2$s"
                   move 2 to i
                   move 23 to j
                   invoke lsmsgfh "getmessage"
                       using i j string1 string2
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring

               when duplicateOutputSignal
           *>> LNG 24:">> Component: %1$s duplicate output signal: %2$s"
                   move 2 to i
                   move 24 to j
                   invoke lsmsgfh "getmessage"
                       using i j string1 string2
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring

               when duplicateInputSignal
           *>> LNG 25: ">> Component: %1$s duplicate input signal: %2$s on socket: %3$s"
                   move 2 to i
                   move 25 to j
                       invoke lsmsgfh "getmessage"
                       using i j string1 string2 string3
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring

               when internalError
           *>> LNG 26: ">> Component: %1$s internal error: %2$s"
                   move 2 to i
                   move 26 to j
                   invoke lsmsgfh "getmessage"
                       using i j string1 string2
                       returning astring
                   invoke aString "display"

                   if signalTracing
                       perform write-trace
                   end-if
                   invoke astring "finalize" returning astring

               when other
      *------------This is an exception this handler cannot handle.
      *            The exception is reraised and unless trapped
      *            elsewhere terminates the application.
                   invoke self "raiseExceptionwithtextcollection" 
                          using lnkErrorNumber
                                lnkTextCollection
               end-evaluate
               invoke string1 "finalize" returning string1
               invoke lsmsgfh "finalize" returning lsmsgfh
               copy "csleave".
           exit method.

           write-trace section.
               invoke astring "sizeInBytes" returning i
               if i < 256 then
                   invoke aString "getvalue" using tracetext
                   move x'00' to tracetext(i + 1:1)
                   writetrace with tracetext
               end-if
           exit method.
       end method "componentException".


      *>---------------------------------------------------------
      *> Registers event with numeric id lseventindex against method
      *> lsMethodName in object lsReceiver. When the receiver of
      *> "setEventTo" is sent the "dispatchEvent" message, it
      *> sends an event object to all methods registered.
      *>
      *>#See method "dispatchEvent".
      *>#See class "event".
      *>---------------------------------------------------------
       method-id. "setEventTo".
       local-storage section.
       01 lsCallback            object reference.

       linkage section.
       01 lseventindex          pic s9(9) comp-5.
       01 lsReceiver            object reference.
       01 lsmethodName          pic x.
       01 lsParameter1          object reference.
       01 lsParameter2          object reference.

       procedure division using lseventindex
                                lsReceiver
                                lsMethodName
                                lsParameter1
                                lsParameter2.
           invoke Callback "new" using lsReceiver
                                       lsMethodName
                                       lsParameter1
                                       lsParameter2
                             returning lsCallback
           invoke self "setEvent" using lsEventIndex lsCallBack
      *----Finalize event object
           invoke lsCallBack "finalize" returning lsCallBack
           exit method.

       end method "setEventTo".

       end object.
       end class eBase.
