マルチスレッドで動作するUAPをCOBOL言語で作成する方法について,説明します。
COBOL言語で作成したUAPのソースプログラムの翻訳について,説明します。このUAPのソースプログラムには,スレッド起動プログラム,CUPの主プログラムなどが必要です。
スレッド起動プログラムはC言語で記述し,ccコマンドで翻訳してオブジェクトファイルを作成します。また,CUPの主プログラムはCOBOL言語で作成し,COBOLコンパイラで翻訳してオブジェクトファイルを作成します。
それぞれのプログラムを翻訳するときのコマンド入力例を次に示します。なお,COBOLコンパイラには,COBOL85を使用した場合の例を示します。
xlc_r -c thdcup_main.c
ccbl -C2 -Mt sample.cbl
COBOL言語で作成したUAPの実行形式ファイルの作成には,ccblコマンドまたはccコマンドを使用する方法があります。それぞれの場合の結合方法について,説明します。
ccblコマンドを使用してUAPの実行形式ファイルを作成する場合,次に示すファイルを結合させて作成します。
ccblコマンドを使用して,上記のファイルを結合するときのコマンドの入力例を次に示します。
ccbl -Mt -Mp -o CBL.exe thdcup_main.o sample.o -L/usr/lib -lclt -lpthread
ccコマンドを使用してUAPの実行形式ファイルを作成する場合,次に示すファイルを結合させて作成します。
ccコマンドを使用して,上記のファイルを結合するときのコマンドの入力例を次に示します。
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言語)のコーディング例を示します。
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
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 *