COBOL言語で作成したUAPのソースプログラムの翻訳について，説明します。このUAPのソースプログラムには，スレッド起動プログラム，CUPの主プログラムなどが必要です。

スレッド起動プログラムはC言語で記述し，ccコマンドで翻訳してオブジェクトファイルを作成します。また，CUPの主プログラムはCOBOL言語で作成し，COBOLコンパイラで翻訳してオブジェクトファイルを作成します。

それぞれのプログラムを翻訳するときのコマンド入力例を次に示します。なお，COBOLコンパイラには，COBOL85を使用した場合の例を示します。

〈例〉

C言語で作成したスレッド起動プログラム

• thdcup_main.c

COBOL言語で作成したCUPの主プログラム

• sample.cbl

この場合，それぞれのソースプログラムは次のように翻訳します。

 
xlc_r -c thdcup_main.c
ccbl -C2 -Mt sample.cbl
 

上記のccコマンドおよびccblコマンドを実行すると，次のオブジェクトファイルが作成されます。

• thdcup_main.o（スレッド起動プログラムのオブジェクトファイル）
• sample.o（CUPの主プログラムのオブジェクトファイル）

COBOL言語で作成したUAPの実行形式ファイルの作成には，ccblコマンドまたはccコマンドを使用する方法があります。それぞれの場合の結合方法について，説明します。

(a)　ccblコマンドを使用する場合

ccblコマンドを使用してUAPの実行形式ファイルを作成する場合，次に示すファイルを結合させて作成します。

• スレッド起動プログラムのオブジェクトファイル
• CUPの主プログラムのオブジェクトファイル
• TP1/Client/Wのライブラリ
• COBOLのライブラリ（COBOL85言語で作成したCUPの場合はCOBOL85のライブラリ）
• POSIXスレッドのライブラリ

ccblコマンドを使用して，上記のファイルを結合するときのコマンドの入力例を次に示します。

〈例〉

COBOL CUP実行形式ファイル「CBL.exe」を作成する場合

• スレッド起動プログラムのオブジェクトファイル名…thdcup_main.o
• CUPの主プログラムのオブジェクトファイル名…sample.o

次のようにファイルを結合させます。

 
ccbl -Mt -Mp -o CBL.exe thdcup_main.o sample.o -L/usr/lib -lclt -lpthread
 

(b)　ccコマンドを使用する場合

ccコマンドを使用してUAPの実行形式ファイルを作成する場合，次に示すファイルを結合させて作成します。

• スレッド起動プログラムのオブジェクトファイル
• CUPの主プログラムのオブジェクトファイル
• TP1/Client/Wのライブラリ
• COBOLのライブラリ（COBOL85言語で作成したCUPの場合はCOBOL85のライブラリ）
• POSIXスレッドのライブラリ

ccコマンドを使用して，上記のファイルを結合するときのコマンドの入力例を次に示します。

〈例〉

COBOL CUP実行形式ファイル「CBL.exe」を作成する場合

• スレッド起動プログラムのオブジェクトファイル名…thdcup_main.o
• CUPの主プログラムのオブジェクトファイル名…sample.o

次のようにファイルを結合させます。

 
xlc_r -o CBL.exe thdcup_main.o sample.o -L/usr/lib -lclt -L/opt/HILNGcbl/lib -lcbl85 -lcbl85mp
 

COBOL言語で作成したUAPのスレッド起動プログラム（C言語），およびCUPの主プログラム（COBOL言語）のコーディング例を示します。

(a)　スレッド起動プログラム（C言語）のコーディング例

000010 #include <stdio.h>
000020 #include <pthread.h>
000030 #include <sys/errno.h>
000040
000050 #define THDMAX  5
000060
000070 extern void *CUP_THREAD();
000080
000090 main()
000100 {
000110     int        i;
000120     int        rc;
000130     int        exit_value;
000140     pthread_t  threads[THDMAX];
000150     struct timeval timeout;
000160
000170     /*--- スレッドを生成する ---*/
000180     for (i = 1; i < THDMAX; i++) {
000190         fflush(stdout);
000200         rc = pthread_create((pthread_t *)&threads[i],
000210                             NULL,
000220                             CUP_THREAD,
000230                             (void *)i);
000240         if (rc < 0) {
000250             printf("cup0: pthread_create に失敗しました。CODE=%d\n", errno);
000260         }
000370     }
000380
000390     /*--- スレッドの終了を待ち合わせる ---*/
000300     for (i = 1; i < THDMAX; i++) {
000310         rc = pthread_join(threads[i], (void **)&exit_value);
000320         if (rc < 0) {
000330             printf("cup0: pthread_join に失敗しました。CODE=%d\n", errno);
000340         }
000350     }
000360
000370 }
000380

(b)　CUPの主プログラム（COBOL言語）のコーディング例

000010    *
000020    **************************************************
000030    *  CUPサンプルプログラム                                *
000040    **************************************************
000050    *
000060     IDENTIFICATION DIVISION.
000070     PROGRAM-ID. CUP_THREAD.
000080    *
000090    **************************************************
000100    *  データ領域の設定                                     *
000110    **************************************************
000120    *
000130     DATA DIVISION.
000140     WORKING-STORAGE SECTION.
000150     01  DCCLS-CLTIN-ARG.
000160         02  DCCLS-CLTIN-REQUEST        PIC  X(8) VALUE 'CLTIN   '.
000170         02  DCCLS-CLTIN-STATUS-CODE    PIC  X(5).
000180         02  FILLER                     PIC  X(3).
000190         02  DCCLS-CLTIN-FLAGS          PIC S9(9) COMP VALUE ZERO.
000200         02  DCCLS-CLTIN-T-HOST         PIC  X(64).
000210         02  DCCLS-CLTIN-LOGNAME        PIC  X(16).
000220         02  DCCLS-CLTIN-PASSWD         PIC  X(16).
000230         02  DCCLS-CLTIN-S-HOST         PIC  X(64).
000240         02  DCCLS-CLTIN-HWND           PIC  9(4) COMP.
000250         02  FILLER                     PIC  X(2).
000260         02  DCCLS-CLTIN-CLTID          PIC  9(9) COMP.
000270         02  DCCLS-CLTIN-DEFPATH        PIC  X(256).
000280    *
000290     01  DCCLS-CLTOUT-ARG.
000300         02  DCCLS-CLTOUT-REQUEST       PIC  X(8) VALUE 'CLTOUT  '.
000310         02  DCCLS-CLTOUT-STATUS-CODE   PIC  X(5).
000320         02  FILLER                     PIC  X(3).
000330         02  DCCLS-CLTOUT-FLAGS         PIC S9(9) COMP VALUE ZERO.
000340         02  DCCLS-CLTOUT-CLTID         PIC  9(9) COMP.
000350    *
000360     01  DCRPS-OPEN-ARG1.
000370         02  DCRPS-OPEN-REQUEST         PIC  X(8) VALUE 'OPEN    '.
000380         02  DCRPS-OPEN-STATUS-CODE     PIC  X(5).
000390         02  FILLER                     PIC  X(3).
000400         02  DCRPS-OPEN-FLAGS           PIC S9(9) COMP VALUE ZERO.
000410         02  DCRPS-OPEN-CLTID           PIC  9(9) COMP.
000420    *
000430     01  DCRPS-OPEN-ARG2.
000440         02  FILLER                     PIC  X(1).
000450    *
000460     01  DCRPS-OPEN-ARG3.
000470         02  FILLER                     PIC  X(1).
000480    *
000490     01  DCRPS-CALL-ARG1.
000500         02  DCRPS-CALL-REQUEST         PIC  X(8) VALUE 'CALL    '.
000510         02  DCRPS-CALL-STATUS-CODE     PIC  X(5).
000520         02  FILLER                     PIC  X(3).
000530         02  DCRPS-CALL-FLAGS           PIC S9(9) COMP VALUE ZERO.
000540         02  DCRPS-CALL-DESCRIPTER      PIC S9(9) COMP.
000550         02  DCRPS-CALL-SVGROUP         PIC  X(32).
000560         02  DCRPS-CALL-SVNAME          PIC  X(32).
000570         02  DCRPS-CALL-CLTID           PIC  9(9) COMP.
000580    *
000590     01  DCRPS-CALL-ARG2.
000600         02  DCRPS-CALL-INDATALEN       PIC S9(9) COMP.
000610         02  DCRPS-CALL-INDATA          PIC  X(512).
000620    *
000630     01  DCRPS-CALL-ARG3.
000640         02  DCRPS-CALL-OUTDATALEN      PIC S9(9) COMP.
000650         02  DCRPS-CALL-OUTDATA         PIC  X(512).
000660    *
000670     01  DCRPS-CLOSE-ARG1.
000680         02  DCRPS-CLOSE-REQUEST        PIC  X(8) VALUE 'CLOSE   '.
000690         02  DCRPS-CLOSE-STATUS-CODE    PIC  X(5).
000700         02  FILLER                     PIC  X(3).
000710         02  DCRPS-CLOSE-FLAGS          PIC S9(9) COMP VALUE ZERO.
000720         02  DCRPS-CLOSE-CLTID          PIC  9(9) COMP.
000730    *
000740     01  DCRPS-CLOSE-ARG2.
000750         02  FILLER                     PIC  X(1).
000760    *
000770     01  DCRPS-CLOSE-ARG3.
000780         02  FILLER                     PIC  X(1).     
000790    *
000800    **************************************************
000810    *  CUPの開始                                     *
000820    **************************************************
000830     PROCEDURE DIVISION.
000840     MAIN SECTION.
000850     PROG-START.
000860    *
000870    **************************************************
000880    *  クライアントユーザの認証要求                  *
000890    **************************************************
000900         MOVE 'CLTIN   '     TO DCCLS-CLTIN-REQUEST IN DCCLS-CLTIN-ARG.
000910         MOVE ZERO           TO DCCLS-CLTIN-FLAGS   IN DCCLS-CLTIN-ARG.
000920         MOVE 'host01:10000' TO DCCLS-CLTIN-T-HOST  
000930                       IN DCCLS-CLTIN-ARG.
000940         MOVE 'user01'       TO DCCLS-CLTIN-LOGNAME IN DCCLS-CLTIN-ARG.
000950         MOVE 'puser01'      TO DCCLS-CLTIN-PASSWD  IN DCCLS-CLTIN-ARG.
000960         MOVE ZERO           TO DCCLS-CLTIN-HWND    IN DCCLS-CLTIN-ARG.
000970         MOVE SPACE          TO DCCLS-CLTIN-DEFPATH IN DCCLS-CLTIN-ARG.
000980    *
000990    *    *******************************
001000         CALL 'CBLDCCLS' USING DCCLS-CLTIN-ARG.
001010    *    *******************************
001020         IF DCCLS-CLTIN-STATUS-CODE IN DCCLS-CLTIN-ARG NOT = '00000'
001030         THEN
001040           DISPLAY 'CUP01: CBLDCCLS(CLTIN)に失敗しました。CODE='
001050                    DCCLS-CLTIN-STATUS-CODE IN DCCLS-CLTIN-ARG
001060           GO TO PROG-EXIT
001070         END-IF.
001080    *
001090    **************************************************
001100    *  RPC-OPEN(RPC環境の初期設定)                   *
001110    **************************************************
001120         MOVE 'OPEN    '         TO
001130              DCRPS-OPEN-REQUEST IN DCRPS-OPEN-ARG1.
001140         MOVE ZERO               TO DCRPS-OPEN-FLAGS
001150              IN DCRPS-OPEN-ARG1.
001160         MOVE DCCLS-CLTIN-CLTID  IN DCCLS-CLTIN-ARG TO
001170              DCRPS-OPEN-CLTID   IN DCRPS-OPEN-ARG1.
001180    *
001190    *    *******************************
001200         CALL 'CBLDCRPS' USING DCRPS-OPEN-ARG1 DCRPS-OPEN-ARG2
001210                                            DCRPS-OPEN-ARG3.
001220    *    *******************************
001230         IF DCRPS-OPEN-STATUS-CODE IN DCRPS-OPEN-ARG1 NOT = '00000'
001240         THEN
001250           DISPLAY 'CUP01: CBLDCRPS(OPEN)に失敗しました。CODE='
001260                    DCRPS-OPEN-STATUS-CODE IN DCRPS-OPEN-ARG1
001270           GO TO PROG-END
001280         END-IF.
001290    *
001300    *    *********************************************
001310    *    * RPC-CALL(RPCの実行)                       *
001320    *    *********************************************
001330         MOVE 'CALL    '      TO
001340              DCRPS-CALL-REQUEST IN DCRPS-CALL-ARG1.
001350         MOVE ZERO            TO
001360              DCRPS-CALL-FLAGS IN DCRPS-CALL-ARG1.
001370         MOVE 'spp01'       TO
001380              DCRPS-CALL-SVGROUP IN DCRPS-CALL-ARG1.
001390         MOVE 'svr01'     TO
001400              DCRPS-CALL-SVNAME     IN DCRPS-CALL-ARG1.
001410         MOVE DCCLS-CLTIN-CLTID  IN DCCLS-CLTIN-ARG TO
001420              DCRPS-CALL-CLTID   IN DCRPS-CALL-ARG1.
001430         MOVE 'HELLO SPP !! ' TO
001440              DCRPS-CALL-INDATA     IN DCRPS-CALL-ARG2.
001450         MOVE 512             TO
001460              DCRPS-CALL-INDATALEN  IN DCRPS-CALL-ARG2.
001470         MOVE SPACE           TO
001480              DCRPS-CALL-OUTDATA    IN DCRPS-CALL-ARG3.
001490         MOVE 512             TO
001500              DCRPS-CALL-OUTDATALEN IN DCRPS-CALL-ARG3.
001510    *
001520    *    **************************************************
001530         CALL 'CBLDCRPS' USING DCRPS-CALL-ARG1 DCRPS-CALL-ARG2
001540                               DCRPS-CALL-ARG3
001550    *    **************************************************
001560         IF DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1 NOT = '00000'
001570         THEN
001580           DISPLAY 'CUP01: CBLDCRPS(CALL)に失敗しました。'
001590                   'CODE=' DCRPS-CALL-STATUS-CODE IN DCRPS-CALL-ARG1
001600           GO TO PROG-END
001610         END-IF.
001620     PROG-END.
001630    *
001640    **************************************************
001650    *  RPC-CLOSE(RPC環境の解除)                      *
001660    **************************************************
001670         MOVE 'CLOSE   ' TO DCRPS-CLOSE-REQUEST IN DCRPS-CLOSE-ARG1.
001680         MOVE ZERO       TO DCRPS-CLOSE-FLAGS   IN DCRPS-CLOSE-ARG1.
001690         MOVE DCCLS-CLTIN-CLTID  IN DCCLS-CLTIN-ARG TO
001700              DCRPS-CLOSE-CLTID  IN DCRPS-CLOSE-ARG1.
001710    *
001720    *    *******************************
001730         CALL 'CBLDCRPS' USING DCRPS-CLOSE-ARG1 DCRPS-CLOSE-ARG2
001740                                           DCRPS-CLOSE-ARG3.
001750    *    *******************************
001760     PROG-EXIT.
001770         MOVE 'CLTOUT  '  TO DCCLS-CLTOUT-REQUEST IN DCCLS-CLTOUT-ARG.
001780         MOVE ZERO        TO DCCLS-CLTOUT-FLAGS   IN DCCLS-CLTOUT-ARG.
001790         MOVE DCCLS-CLTIN-CLTID  IN DCCLS-CLTIN-ARG TO
001800              DCCLS-CLTOUT-CLTID IN DCCLS-CLTOUT-ARG.
001810    *
001820    *    *******************************
001830         CALL 'CBLDCCLS' USING DCCLS-CLTOUT-ARG.
001840    *    *******************************
001850         STOP RUN.
001860    *