SEND and RECEIVE

A thread sends a message to another thread with the SEND statement. A thread receives a message from another thread with the RECEIVE statement. Messages can either be broadcast, in which case they are sent to all threads, or directed, in which case the message is sent to a particular thread or set of threads.

For example, suppose you have a thread that updates a complicated display in response to a message. Another thread receives user input and sends messages to the update thread. The code might look like this:

77  H-DISPLAY-THREAD    HANDLE OF THREAD.
77  RECORD-NUMBER       PIC 9(5).
77  UPDATE-RECORD-NO    PIC 9(5).

MAIN-LOGIC.
    PERFORM INITIALIZE
    PERFORM CREATE-MAIN-SCREEN          
    PERFORM THREAD DISPLAY-THREAD, 
            HANDLE IN H-DISPLAY-THREAD
    PERFORM UNTIL DONE
        PERFORM ENTER-MAIN-SCREEN
        IF NOT DONE
            SEND RECORD-NUMBER TO 
                 THREAD H-DISPLAY-THREAD
        END-IF
    END-PERFORM
    PERFORM SHUT-DOWN
    STOP RUN.

DISPLAY-THREAD.
    PERFORM CREATE-STATUS-SCREEN
    PERFORM UNTIL 1 = 0
        RECEIVE UPDATE-RECORD-NO FROM ANY THREAD
        PERFORM UPDATE-STATUS-SCREEN
    END-PERFORM.

The thread that updates the screen sits in an infinite loop waiting for messages. It will terminate when the runtime shuts down. Because it uses the RECEIVE statement, this thread is very efficient even though it contains an infinite loop. Note that the program includes two copies of the "record number": one sent by the main thread, and one to hold the value received by the update thread. This isolates the data sharing to the SEND and RECEIVE statements. If the main thread goes on to change RECORD-NUMBER while the update thread is performing its screen updates, the action will not affect the update thread because it has its own copy in STATUS-RECORD-NO.

The following example expands on the previous one to make the code more robust. In particular, the new code handles the case where other threads may be sending different types of messages, as well the case where all the sending threads die for some reason. Note that some of the code from the first example has been omitted for brevity:

77  H-DISPLAY-THREAD        HANDLE OF THREAD.
77  RECORD-NUMBER           PIC 9(5).

78  UPDATE-MSG-TYPE         VALUE 1.

01  SENDING-RECORD.
    03  SENDING-MSG-TYPE    PIC 99.
    03  SENDING-REC-NO      PIC 9(5).

01  UPDATE-RECORD.
    03  FILLER              PIC 99.
       88  IS-UPDATE-MSG    VALUE UPDATE-MSG-TYPE.
    03  UPDATE-RECORD-NO    PIC 9(5).


MAIN-LOGIC.
    PERFORM THREAD DISPLAY-THREAD, 
            HANDLE IN H-DISPLAY-THREAD
    PERFORM UNTIL DONE
        PERFORM ENTER-MAIN-SCREEN
        IF NOT DONE
           MOVE UPDATE-MSG-TYPE TO SENDING-MSG-TYPE
           MOVE RECORD-NUMBER TO SENDING-REC-NO
           SEND SENDING-RECORD TO 
                        THREAD H-DISPLAY-THREAD
           END-SEND
        END-IF
    END-PERFORM.

DISPLAY-THREAD.
    PERFORM CREATE-STATUS-SCREEN
    PERFORM UNTIL 1 = 0
        RECEIVE UPDATE-RECORD FROM ANY THREAD
           ON EXCEPTION
              PERFORM SENDING-THREADS-DIED-ERROR
        END-RECEIVE
        IF IS-UPDATE-MSG
            PERFORM UPDATE-STATUS-SCREEN
        END-IF
    END-PERFORM.

The preceding example assumes that all messages in the program will be formatted with a two-digit type code as the first element. The update thread checks the message received to see if it contains a type that it knows how to respond to. If it does not, it simply ignores the message. This check is a good idea because the update thread uses the ANY THREAD option in its RECEIVE statement. If some other thread broadcasts a message (SEND TO ALL THREADS), the update thread would receive the message even though it might not be an update message. Adding the message-type code resolves this issue. It also makes debugging easier if you have more than one message type in your program.

Messages can also interrupt a thread that is in an ACCEPT statement. However, to allow that you must declare that the ACCEPT statement may be interrupted. This is specified with the ALLOWING MESSAGES phrase in the ACCEPT statement.