多线程示例的样本代码

在线编辑
此示例具有三个代码样本:
THRCBL QCBLLESRC
ILE COBOL 主过程，用于创建 ILE COBOL 线程，等待这些线程完成，然后退出。
SUBA QCBLLESRC
由 THRCBL 创建的线程调用的 ILE COBOL 过程。
SUBB QCBLLESRC
由 THRCBL 创建的线程调用的第二个 ILE COBOL 过程。

图 1中显示了 THRCBL QCBLLESRC 的样本代码。

图 1。 THRCBL QCBLLESRC 的源代码

       PROCESS NOMONOPRC OPTIONS THREAD(SERIALIZE).
       IDENTIFICATION DIVISION.
       PROGRAM-ID. THRCBL.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
         special-names.  system-console is oper1.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 pthread_attr_t typedef.
          05 FILLER PIC 9(8) usage binary occurs 4 times.
          05 FILLER USAGE POINTER.
       01 pthread_t typedef.
          05 FILLER USAGE POINTER.
          05 FILLER PIC 9(8) usage binary.
          05 FILLER PIC 9(8) usage binary.
          05 FILLER PIC 9(8) usage binary.
          05 FILLER PIC 9(8) usage binary.
          05 FILLER USAGE POINTER.
       01 PROC-SUBA-PTR USAGE PROCEDURE-POINTER.
       01 PROC-SUBB-PTR USAGE PROCEDURE-POINTER.
       01 attr type pthread_attr_t.
       01 rc PIC 9(8) usage binary value 0.
       01 group1.
          05 thread type pthread_t occurs 10 times.
       01 joinStatus0 USAGE POINTER.
       01 joinStatus1 USAGE POINTER.
       PROCEDURE DIVISION.
       TEST1-INIT.
           SET PROC-SUBA-PTR TO ENTRY PROCEDURE "SUBA".
           SET PROC-SUBB-PTR TO ENTRY PROCEDURE "SUBB".

      * Create a thread attributes object
           call procedure "pthread_attr_init" using attr
                          returning rc.

      * Define threads to be joinable
           call procedure "pthread_attr_setdetachstate" using attr
                          by value 0 size 4
                          returning rc.

      * Start creating thread(s)
           call procedure "pthread_create" using thread(1) attr
                          by value PROC-SUBA-PTR omitted
                          returning rc.
           call procedure "pthread_create" using thread(2) attr
                          by value PROC-SUBB-PTR omitted
                          returning rc.
      * Start joining thread(s)
           call procedure "pthread_join" using by value thread(1)
                           by reference joinStatus0
                           returning rc.
           call procedure "pthread_join" using by value thread(2)
                           by reference joinStatus1
                           returning rc.

      * Destroy thread attributes object
           call procedure "pthread_attr_destroy" using attr
                           returning rc.

图 2中显示了 SUBA QCBLLESRC 的样本代码。

图 2。 SBA QCBLLESRC 的源代码
       PROCESS NOMONOPRC OPTIONS THREAD(SERIALIZE).
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SUBA.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
         special-names.  system-console is oper1.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 one-line pic x(11).
       PROCEDURE DIVISION.
       TEST1-INIT.
           move "IN SUBA" TO ONE-LINE.
           DISPLAY one-line UPON oper1.

SUBB QCBLLESRC 的样本代码如 图 3 所示

图 3。 SUBB QCBLLESRC 的源代码
       PROCESS NOMONOPRC OPTIONS THREAD(SERIALIZE).
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SUBB.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
         special-names.  system-console is oper1.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 one-line pic x(11).
       PROCEDURE DIVISION.
       TEST1-INIT.
           move "IN SUBB" TO ONE-LINE.
           DISPLAY one-line UPON oper1.