dos_compilers/Microsoft COBOL v45/DEMO/APPCDEMO/BATTAPPC.CBL

647 lines
29 KiB
Plaintext
Raw Normal View History

2024-07-24 16:18:17 +02:00
$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).