      $set mf ans85 noosvs
      *******************************************************************
      *                                                                 *
      *                                                                 *
      *                  (C) Micro Focus Ltd. 1990                      *
      *                                                                 *
      *                         BATTAPPC.CBL                            *
      *                                                                 *
      *      COBOL Advanced Program to Program (APPC) Demonstration     *
      *                                                                 *
      *                         Battleships                             *
      *                    communications module                        *
      *                                                                 *
      *******************************************************************

      *******************************************************************
      *        BATTAPPC - links two battleships games using APPC        *
      *                                                                 *
      *  This program is called by BATTLEL & BATTLER to communicate     *
      *  between one another.                                           *
      *                                                                 *
      *  The communications that take place are:                        *
      *        - to bring up a link between the two programs            *
      *        - to take down a link                                    *
      *        - to send coordinates to a program                       *
      *        - to receive coordinates from a program                  *
      *        - to send a damage report to a program                   *
      *        - to receive a damage report from a program              *
      *                                                                 *
      *  The method of communication is entirey transparent to the      *
      *  users of the game.  So long as the same interface is used,     *
      *  this module could be replaced by one which used a different    *
      *  communications protocol.                                       *
      *                                                                 *
      *  The interface consists of two parameters.  The first parameter *
      *  is the operation code - indicating which function to perform.  *
      *  The second parameter is a buffer area which is used to pass    *
      *  information between the communicating programs.                *
      *                                                                 *
      *  The result of any operation is returned to the calling program *
      *  in the RETURN-CODE system variable.  A zero value indicates    *
      *  success and a non-zero value indicates some error  - In this   *
      *  example program, the error handling is very simple - in that   *
      *  the programs will stop if any error is received.  You may,     *
      *  however, decide to provide more intelligent error handling, in *
      *  which the user of the game may be given alternative courses of *
      *  action when such an error occurs.                              *
      *                                                                 *
      *******************************************************************
       Special-names.
           call-convention 3 is api.

       Working-Storage Section.
       copy "appc.cpy".
       copy "acssvc.cpy".

      *-----------------------------------------------------------------
      * Working variables
      *-----------------------------------------------------------------
       01  tp-name                     pic x(64) value spaces.
       78  tp-name-len                 value 64.
       01  tp-id                       pic x(8) value spaces.
       01  lu-alias                    pic x(8) value spaces.
       01  plu-alias                   pic x(8) value spaces.
       01  conv-id                     pic x(4) value spaces.
       01  mode-name                   pic x(8) value spaces.
       78  mode-name-len               value 8.

       01  what-received               pic 9(4) comp-x.
       01  request-to-send-received    pic 9(2) comp-x.
       01  state-flag                  pic 9(2) comp-x.
           88 Sending-State            value 1.
           88 Receiving-State          value 0.

       01  data-buffer-length          pic 9(4) comp-5.
       01  data-buffer-ptr             usage pointer.
       01  data-buffer-address
           redefines data-buffer-ptr.
           03 data-buffer-offset       pic 9(4) comp-5.
           03 data-buffer-selector     pic 9(4) comp-5.
       01  alloc-flags                 pic 9(4) comp-5 value 1.
       01  key-char pic x.


      *-----------------------------------------------------------------
      * following items used for constructing error message
      *-----------------------------------------------------------------
       01  bin-dword.
           03 bin-dword-msw            pic 9(4) comp-x.
           03 bin-dword-lsw            pic 9(4) comp-x.
       01  bin-val.
           03 bin-val-1                pic 9(2) comp-x.
           03 bin-val-2                pic 9(2) comp-x.

       01  hex-idx-1                   pic 9(2) comp-x.
       01  hex-idx-2                   pic 9(2) comp-x.
       01  hex-disp                    pic x(4).
       01  hex-string                  pic x(16)
                                      value "0123456789ABCDEF".
       01  clear-char                  pic x value " ".
       01  clear-attr                  pic 9(2) comp-x value 7.
       01  screen-pos                  pic 9(4) comp-x value h"0100".
       01  error-msg.
           03 filler                   pic x(25)
                                      value 'APPC/ACSSVC Error Verb=x"'.
           03 error-1                  pic x(4).
           03 filler                   pic x(17)
                                      value '" Primary Code=x"'.
           03 error-2                  pic x(4).
           03 filler                   pic x(19)
                                      value '" Secondary Code=x"'.
           03 error-3                  pic x(4).
           03 error-4                  pic x(4).
           03 filler                   pic x value '"'.

      *-----------------------------------------------------------------
      *  interface paramters
       LINKAGE SECTION.
      *-----------------------------------------------------------------
       01 Comm-Code                    Pic 9(2) Comp.
       01 Comm-Buffer                  Pic x(12).

      *-----------------------------------------------------------------
       01 Shared-Segment-Buffer        Pic x(12).
      *    This is a special linkage item - not used as a parameter -
      *    but as a buffer whose address is set to a shared unnamed
      *    segment, allocated later on.  This type of memory is
      *    required by some APPC verbs - see later for details
      *
      *-----------------------------------------------------------------


      *=================================================================
      *
      *---------------------Call Interface------------------------------
       PROCEDURE DIVISION using
                                   by value Comm-Code
                                   by reference Comm-Buffer.
      *-----------------------------------------------------------------
      *=================================================================


      *-----------------------------------------------------------------
       Evaluate-Operation.
      *    work out which high level operation to perform
      *
      *-----------------------------------------------------------------
           Evaluate Comm-Code
               When 1      Perform Bring-Up-Link
               When 2      Perform Take-Down-Link
               When 3      Perform Send-Coords
               When 4      Perform Receive-Coords
               When 5      Perform Send-Report
               When 6      Perform Receive-Report
               When other  move 1 to Return-Code
           End-Evaluate
           move 0 to Return-Code
           Exit Program.

      *-----------------------------------------------------------------
       Error-Exit.
      *  quick exit in case of error during APPC
      *
      *-----------------------------------------------------------------
           move 1 to Return-Code
           Exit Program.

      *-----------------------------------------------------------------
       Bring-Up-Link.
      *    High level function to initiate a communication between
      *    two transaction programs playing the game.
      *
      *    The verbs issued to start a conversation are  different
      *    for each program - only one end may start the communication
      *    with a MC-ALLOCATE verb - this is received at the other end
      *    by a RECEIVE-ALLOCATE verb.
      *
      *    The LU-ALIAS, partner LU-ALIAS, MODE-NAME and TP-NAME which
      *    are defined in the configuration profile for this
      *    communication are placed in variables for various verbs to
      *    use.  These names must match up with those defined in the
      *    configuration currently active - switch to the
      *    communications Manager session and check to see that the
      *    correct profile is loaded.
      *
      *    Some fields passed in the Verb Control Block have to be
      *    defined in EBCDIC - all of these fields are converted from
      *    ASCII using a special utility routine provided as part
      *    of the Communications Manager software (ie. ACSSVC.DLL)  -
      *    this is done initially and the converted fields are saved in
      *    temporary variables for later use.
      *
      *    The other verbs (seen in capitals) are used to request
      *    resources of APPC before a conversation starts (TP-STARTED)
      *    and is only required on the MC-ALLOCATE side.  The other
      *    verb (ie MC-FLUSH) causes the allocation request to be sent
      *    to the remote machine immediately - this is because send
      *    buffers are not normally sent off until a buffer becomes
      *    full - so as to minimise on transmissions.  The MC-FLUSH
      *    verb is useful in this situation if you want a remote
      *    program to connect immediately.
      *
      *    Comm-buffer is used to tell this module which program is
      *    calling it - so that it can decide which set of verbs to
      *    issue.
      *
      *-----------------------------------------------------------------
           If Comm-Buffer = "PLAYER1"
      *            local end
      *            initialise configuration names
               move 'DEMOPLU1' to plu-alias
               move 'DEMOLU1 ' to lu-alias
               move 'DEMOMODE' to mode-name
               move 'BATTLE  ' to tp-name
      *            convert to EBCDIC
               Perform Convert-Tp-Name
               Perform Convert-Mode-Name
      *            issue APPC verbs to request resources and send
      *            immediate an allocation request to the remote machine
               Perform TP-STARTED
               Perform MC-ALLOCATE
               Perform MC-FLUSH
           Else
      *            remote end
      *            initialise configuration name
               move 'BATTLE  ' to Tp-Name
      *            convert to EBCDIC
               Perform Convert-Tp-Name
      *            issue APPC verb to receive allocation request
               Perform RECEIVE-ALLOCATE
           End-If
      *       allocate a buffer to be used by send and receive verbs
           Perform Allocate-Shared-Memory.

      *-----------------------------------------------------------------
       Allocate-Shared-Memory.
      *    Send and receive verbs: MC-SEND-DATA and MC-RECEIVE-AND-WAIT
      *    require the data buffer used as one of their parameters to
      *    be an unnamed shared segment - this is allocated with
      *    the DosAllocSeg api call with alloc-flag = 1
      *
      *-----------------------------------------------------------------
           move zero to Data-Buffer-Offset
           move Length of Comm-Buffer to Data-Buffer-Length
           move 1 to Alloc-Flags
      *        for COBOL/2 Toolset, do next statement
      *        call "cobolapi"
           call "__DosAllocSeg" using
                           by value Alloc-Flags
                           by reference Data-Buffer-Selector
                           by value Data-Buffer-Length
           If RETURN-CODE not = zero
               Go to Error-Exit
           End-If.


      *-----------------------------------------------------------------
       Take-Down-Link.
      *    This high level routine stops a conversation and releases
      *    resources used by the conversation.
      *
      *    The conversation is stopped at the sending end, ie the
      *    machine at which the last send verb was issued,  with
      *    the verb MC-DEALLOCATE.
      *
      *    The MC-DEALLOCATE verb is issued with type FLUSH which
      *    performs the same function as MC-FLUSH before the
      *    deallocation is sent - causing any unsent buffers to be
      *    transmitted.
      *
      *    The MC-RECEIVE-AND-WAIT is the verb issued at the receiving
      *    end, ie the machine at which the last receive verb was
      *    issued.  This verb waits until the deallocation signal
      *    arrives from the sending end.
      *
      *    The TP-ENDED verb is used to release resources at both
      *    ends of the terminated conversation.
      *
      *-----------------------------------------------------------------
           If Sending-State
               Perform MC-DEALLOCATE
           Else
               Perform MC-RECEIVE-AND-WAIT
           End-If
           Perform TP-ENDED.


      *-----------------------------------------------------------------
       Send-Coords.
      *    This high level operation sends coordinates contained in
      *    the buffer to be sent to the remote machine and then makes
      *    ready to receive a damage report from it.
      *
      *    MC-SEND-DATA causes the contents of the buffer to be sent
      *    to the particular LU defined.
      *
      *    After successful completion of MC-SEND-DATA , the
      *    conversation is placed in receive state by the
      *    MC-PREPARE-TO-RECEIVE verb - this is in readiness to receive
      *    the damage report of the coordinates specified.
      *
      *    The MC-PREPARE-TO-RECEIVE also flushes the send buffer so
      *    that nothing is left before any receive verbs take place.
      *
      *-----------------------------------------------------------------
           set address of Shared-Segment-Buffer to Data-Buffer-Ptr
           move Comm-Buffer to Shared-Segment-Buffer
           Perform MC-SEND-DATA
           Perform MC-PREPARE-TO-RECEIVE.

      *-----------------------------------------------------------------
       Receive-Report.
      *    The damage report is received using the verb
      *    MC-RECEIVE-AND-WAIT.  This verb waits indefinitely for the
      *    remote machine to send data.  When something is received
      *    a check is made that the data received is complete - if you
      *    are sending large amounts of information, data may be
      *    contained in several buffers and the 'what-received' verb
      *    contains a code to indicate if the buffer is complete or
      *    not.  This routine performs a loop issuing the verb until
      *    the last buffer arrives.
      *
      *-----------------------------------------------------------------
           move zero to what-received
           perform until what-received = ap-data-complete
               Perform MC-RECEIVE-AND-WAIT
           end-perform
           set address of Shared-Segment-Buffer to Data-Buffer-Ptr
           move Shared-Segment-Buffer to Comm-Buffer.


      *-----------------------------------------------------------------
       Receive-Coords.
      *    The coordinates are received using the MC-RECEIVE-AND-WAIT
      *    verb.  The buffer is received followed by a signal from the
      *    remote machine that it is ready to receive - so that the
      *    local end can send the damage report.  The signal passed to
      *    the MC-RECEIVE-AND-WAIT verb is contained in the
      *    'what-received' field.
      *
      *-----------------------------------------------------------------
           move zero to what-received
           perform until what-received = ap-send
               Perform MC-RECEIVE-AND-WAIT
           end-perform
           set address of Shared-Segment-Buffer to Data-Buffer-Ptr
           move Shared-Segment-Buffer to Comm-Buffer.


      *-----------------------------------------------------------------
       Send-Report.
      *    This sends the buffer using an MC-SEND-DATA verb followed
      *    by MC-FLUSH to transmit the buffer.
      *
      *-----------------------------------------------------------------
           set address of Shared-Segment-Buffer to Data-Buffer-Ptr
           move Comm-Buffer to Shared-Segment-Buffer
           Perform MC-SEND-DATA
           Perform MC-FLUSH.


      *=================================================================
      *=================================================================
      *-----------------------------------------------------------------
      *    The conversion routines below use a service utility called
      *    the Common Services Programming Interface.  It provides:
      *       -  ASCII/EBCDIC conversion in both directions
      *       -  traces API verbs and data
      *       -  provides translation tables for specified code pages
      *       -  records messages in CM message log
      *       -  sends network management messages to a network
      *            management service
      *
      *    Here we only use it for ASCII-EBCDIC using the CONVERT verb
      *
      *-----------------------------------------------------------------
      * ASCII-EBCDIC conversion routines

       Convert-Mode-Name.
           move all x"00" to VCB
           move sv-convert to opcode-cvt
           move sv-ascii-to-ebcdic to direction-cvt
           move sv-a to char-set-cvt
           move mode-name-len to len-cvt
           set src-ptr-cvt to address of mode-name
           set targ-ptr-cvt to address of mode-name
           perform Execute-Acssvc-Verb
           perform Check-Error.

       Convert-Tp-Name.
           move all x"00" to VCB
           move sv-convert to opcode-cvt
           move sv-ascii-to-ebcdic to direction-cvt
           move sv-ae to char-set-cvt
           move tp-name-len to len-cvt
           set src-ptr-cvt to address of tp-name
           set targ-ptr-cvt to address of tp-name
           perform Execute-Acssvc-Verb
           perform Check-Error.

      *-----------------------------------------------------------------
      *
      * The following routines define the call interfaces to the
      * various APPC verbs required above
      *
      *
      *-----------------------------------------------------------------

      *-----------------------------------------------------------------
       Receive-Allocate.
      *    wait receipt of allocation request from local machine
      *    and then start a new transaction program
      *
      *    The VCB should always be initialized with low values before
      *    any fields are loaded.  The verb returns a tp-id and a
      *    conv-id which are to be used by subsequent verbs during the
      *    conversation.
      *
      *    LU-Alias, PLU-Alias and mode name of the session are also
      *    returned.
      *
      *    A check on the return codes should always be made after
      *    issuing a verb.  In this case an error causes an immediate
      *    return to the calling program to occur.
      *
      *-----------------------------------------------------------------
           move all x"00" to VCB
           move ap-receive-allocate to opcode-ral
           move tp-name to tp-name-ral
           set Receiving-State to True
           perform Execute-Appc-Verb
           perform Check-Error
           move tp-id-ral to tp-id
           move conv-id-ral to conv-id
           move lu-alias-ral to lu-alias
           move plu-alias-ral to plu-alias
           move mode-name-ral to mode-name.

      *-----------------------------------------------------------------
       MC-Receive-and-Wait.
      *    wait for data or signal to be sent.  The 'what-received'
      *    field is returned by this call and indicates the type of
      *    information sent eg. data buffer or a signal to start
      *    sending data.
      *
      *    The buffer that the data is sent to MUST be a shared,
      *    unnamed segment of memory.  This is allocated using the
      *    DosAllocSeg function call (with flags=1).
      *
      *-----------------------------------------------------------------
           set Receiving-State to True
           move all x"00" to VCB
           move ap-m-receive-and-wait to opcode-mrw
           move ap-mapped-conversation to opext-mrw
           move tp-id to tp-id-mrw
           move conv-id to conv-id-mrw
           set dptr-mrw to Data-Buffer-Ptr
           move Data-Buffer-Length to max-len-mrw
           perform Execute-Appc-Verb
           If prim-rc-mda not = h"0009"
      *            if primary return code = h"0009"
      *              don't treat as error - returned when receiving
      *              deallocation signal from MC-DEALLOCATE verb
               perform check-error
           End-If
           move what-rcvd-mrw to what-received
           move rts-rcvd-mrw to request-to-send-received.


      *-----------------------------------------------------------------
       MC-Allocate.
      *    send an allocaton request to a remote machine to start a
      *    conversation.  This verbs requires certain names defined in
      *    the configuration profile.
      *
      *-----------------------------------------------------------------
           move all x"00" to VCB
           move ap-m-allocate to opcode-mal
           move ap-mapped-conversation to opext-mal
           move 1 to opext-mal
           move tp-id to tp-id-mal
           move ap-confirm-sync-level to sync-lvl-mal
           move ap-when-session-allocated to rtn-ctl-mal
           move plu-alias to plu-alias-mal
           move mode-name to mode-name-mal
           move tp-name to tp-name-mal
           move ap-none to security-mal
           set Sending-State to True
           perform Execute-Appc-Verb
           perform Check-Error
           move conv-id-mal to conv-id.

      *-----------------------------------------------------------------
       MC-Send-Data.
      *    send a buffer to the remote machine.  The buffer MUST be
      *    a shared unnamed segment of memory.  This is allocated using
      *    the DosAllocSeg function call (with flags=1).
      *
      *-----------------------------------------------------------------
           set Sending-State to True
           move all x"00" to VCB
           move ap-m-send-data to opcode-msd
           move ap-mapped-conversation to opext-msd
           move tp-id to tp-id-msd
           move conv-id to conv-id-msd
           move data-buffer-length to dlen-msd
           set dptr-msd to data-buffer-ptr
           perform Execute-Appc-Verb
           perform Check-Error
           move rts-rcvd-msd to request-to-send-received.

      *-----------------------------------------------------------------
       MC-Deallocate.
      *    close a conversation
      *
      *-----------------------------------------------------------------
           set Sending-State to True
           move all x"00" to VCB
           move ap-m-deallocate to opcode-mda
           move ap-mapped-conversation to opext-mda
           move tp-id to tp-id-mda
           move conv-id to conv-id-mda
           move ap-flush to dealloc-type-mda
           perform Execute-Appc-Verb
           perform Check-Error.

      *-----------------------------------------------------------------
       MC-Flush.
      *    cause any unsent data to be transmitted immediately
      *
      *-----------------------------------------------------------------
           move all x"00" to VCB
           move ap-m-flush to opcode-fls
           move ap-mapped-conversation to opext-fls
           move tp-id to tp-id-fls
           move conv-id to conv-id-fls
           perform Execute-Appc-Verb
           perform Check-Error.

      *-----------------------------------------------------------------
       MC-Prepare-To-Receive.
      *    cause a change of conversation state from send to receive -
      *    this must be done before a MC-SEND-DATA verb can be issued
      *    by the remote end - when it is in receive state.  This verb
      *    causes the local end to go into receive state.
      *
      *-----------------------------------------------------------------
           set Receiving-State to True
           move all x"00" to VCB
           move ap-m-prepare-to-receive to opcode-ptr
           move ap-mapped-conversation to opext-ptr
           move tp-id to tp-id-ptr
           move conv-id to conv-id-ptr
           move ap-flush to ptr-type-ptr
           perform Execute-Appc-Verb
           perform Check-Error.

      *-----------------------------------------------------------------
       TP-Started.
      *    allocate resources for conversation
      *
      *-----------------------------------------------------------------
           move all x"00" to VCB
           move ap-tp-started to opcode-tps
           move lu-alias to lu-alias-tps
           move tp-name to tp-name-tps
           perform Execute-Appc-Verb
           perform Check-Error
           move tp-id-tps to tp-id.

      *-----------------------------------------------------------------
       TP-Ended.
      *    release resources used by earlier conversation
      *
      *-----------------------------------------------------------------
           move all x"00" to VCB
           move ap-tp-ended to opcode-tpe
           move tp-id to tp-id-tpe
           perform Execute-Appc-Verb.

      *-----------------------------------------------------------------
       Execute-Appc-Verb.
      *    interface to appc/acssvc uses load-time dynamic linking
      *    two methods may be employed:
      *        - to specify IMPORTS statements in .DEF file
      *        - to use ACS.LIB link library
      *
      *    (both methods are used in BATTLE.CMD)
      *
      *-----------------------------------------------------------------
           call "__APPC" using by reference vcb.

      *-----------------------------------------------------------------
       Execute-Acssvc-Verb.
      *
      *-----------------------------------------------------------------
           call "__ACSSVC" using by reference vcb.

      *-----------------------------------------------------------------
       Check-Error.
      *    if any error on the primary return code - convert error
      *    to hex display, display error, wait for key and exit program
      *
      *-----------------------------------------------------------------
           if prim-rc-vcb not = 0
               move opcode-vcb to bin-val
               perform bin-to-hexdisp
               move hex-disp to error-1
               move prim-rc-vcb to bin-val
               perform bin-to-hexdisp
               move hex-disp to error-2
               move sec-rc-vcb to bin-dword
               move bin-dword-msw to bin-val
               perform bin-to-hexdisp
               move hex-disp to error-3
               move bin-dword-lsw to bin-val
               perform bin-to-hexdisp
               move hex-disp to error-4
               call "cbl_clear_scr"
                   using clear-char
                         clear-attr
               call "cbl_set_csr_pos" using screen-pos
               display error-msg
               display "press any key to continue"
               call "cbl_read_kbd_char"
                   using key-char
               go to Error-Exit
           end-if.

      *-----------------------------------------------------------------
       Bin-to-Hexdisp.
      *    converts bin-val - a binary word value into a displayable
      *    hex value that can be inserted into the error message string
      *
      *-----------------------------------------------------------------
           divide bin-val-1 by 16
               giving hex-idx-1 remainder hex-idx-2
           add 1 to hex-idx-1 hex-idx-2
           move hex-string(hex-idx-1:1) to hex-disp(1:1)
           move hex-string(hex-idx-2:1) to hex-disp(2:1)
           divide bin-val-2 by 16
               giving hex-idx-1 remainder hex-idx-2
           add 1 to hex-idx-1 hex-idx-2
           move hex-string(hex-idx-1:1) to hex-disp(3:1)
           move hex-string(hex-idx-2:1) to hex-disp(4:1).

