X/OpenのTXインタフェースを使用した,SUPのコーディング例を次に示します。このSUPは,6.1 で示すSUPの処理を,TXインタフェースでトランザクション制御したものです。処理の構成図と,サービス要求先のSPPの処理については,「6.1 クライアント/サーバ形態のUAPのコーディング例(SUP,SPP DAMアクセス)」を参照してください。なお,行番号 460,470で示す TX-RETURN-STATUS は,処理から直接呼び出すと正しく参照できないため,行番号490,500で示すように,RS REDEFINES TX-RETURN-STATUS と再定義しています。
10 *
20 ******************************************************
30 * SUP01 *
40 ******************************************************
50 *
60 IDENTIFICATION DIVISION.
70 *
80 PROGRAM-ID. MAIN.
90 *
100 ******************************************************
110 * データ領域の設定 *
120 ******************************************************
130 *
140 DATA DIVISION.
150 WORKING-STORAGE SECTION.
160 01 RPC-ARG1.
170 02 REQUEST PIC X(8) VALUE SPACE.
180 02 STATUS-CODE PIC X(5) VALUE SPACE.
190 02 FILLER PIC X(3).
200 02 FLAGS PIC S9(9) COMP VALUE ZERO.
210 *
220 01 RPC-ARG2.
230 02 REQUEST PIC X(8) VALUE SPACE.
240 02 STATUS-CODE PIC X(5) VALUE SPACE.
250 02 FILLER PIC X(3).
260 02 FLAGS PIC S9(9) COMP VALUE ZERO.
270 02 DESCRIPTOR PIC S9(9) COMP VALUE ZERO.
280 02 S-NAME PIC X(32) VALUE SPACE.
290 02 G-NAME PIC X(32) VALUE SPACE.
300 *
310 01 RPC-ARG3.
320 02 SEND-DATA-LENG PIC S9(9) COMP VALUE ZERO.
330 02 SEND-DATA PIC X(32) VALUE SPACE.
340 *
350 01 RPC-ARG4.
360 02 RECEIVE-DATA-LENG PIC S9(9) COMP VALUE ZERO.
370 02 RECEIVE-DATA PIC X(32) VALUE SPACE.
380 *
390 01 ADM-ARG1.
400 02 REQUEST PIC X(8) VALUE SPACE.
410 02 STATUS-CODE PIC X(5) VALUE SPACE.
420 02 FILLER PIC X(3).
430 02 FLAGS PIC S9(9) COMP VALUE ZERO.
440 02 FILLER PIC X(3).
450 *
460 01 TX-RETURN-STATUS.
470 COPY TXSTATUS.
480 *
490 01 RS REDEFINES TX-RETURN-STATUS.
500 05 RSVAL PIC S9(9) COMP-5.
510 *
520 01 TX-INFO-AREA.
530 COPY TXINFDEF.
540 *
550 PROCEDURE DIVISION.
560 *
570 ******************************************************
580 * RPC-OPEN(UAPの開始) *
590 ******************************************************
600 *
610 MOVE 'OPEN' TO REQUEST OF RPC-ARG1.
620 MOVE ZERO TO FLAGS OF RPC-ARG1.
630 CALL 'CBLDCRPC' USING RPC-ARG1.
640 IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN
650 DISPLAY 'SUP01:RPC-OPEN FAILED. CODE = '
660 STATUS-CODE OF RPC-ARG1
670 GO TO PROG-END
680 END-IF.
690 *
700 ******************************************************
710 * TX-OPEN(リソースマネジャのオープン) *
720 ******************************************************
730 *
740 CALL 'TXOPEN' USING TX-RETURN-STATUS.
750 IF RSVAL OF RS NOT = 0 THEN
760 DISPLAY 'SUP01:TX-OPEN FAILED. CODE = '
770 RSVAL OF RS
780 GO TO PROG-END
790 END-IF.
800 *
810 *************************************************************
820 * TX-SET-TRANSACTION-TIMEOUT(トランザクション監視時間の設定)*
830 *************************************************************
840 *
850 MOVE 180 TO TRANSACTION-TIMEOUT OF TX-INFO-AREA.
860 CALL 'TXSETTIMEOUT' USING TX-INFO-AREA TX-RETURN-STATUS.
870 IF RSVAL OF RS NOT = 0 THEN
880 DISPLAY 'SUP01:TX-SET-TRANSACTION-TIMEOUT FAILED. CODE = '
890 RSVAL OF RS
900 GO TO PROG-END
910 END-IF.
920 *
930 ******************************************************
940 * ADM-COMPLETE(ユーザサーバの開始処理完了報告) *
950 ******************************************************
960 *
970 MOVE 'COMPLETE' TO REQUEST OF ADM-ARG1.
980 CALL 'CBLDCADM' USING ADM-ARG1.
990 IF STATUS-CODE OF ADM-ARG1 NOT = '00000' THEN
1000 DISPLAY 'SUP01:ADM-COMPLETE FAILED. CODE = '
1010 STATUS-CODE OF ADM-ARG1
1020 GO TO PROG-END
1030 END-IF.
1040 *
1050 ******************************************************
1060 * TX-BEGIN(トランザクションの開始) *
1070 ******************************************************
1080 *
1090 CALL 'TXBEGIN' USING TX-RETURN-STATUS.
1100 IF RSVAL OF RS NOT = 0 THEN
1110 DISPLAY 'SUP01:TX-BEGIN FAILED. CODE = '
1120 RSVAL OF RS
1130 GO TO TRAN-END
1140 END-IF.
1150 *
1160 ******************************************************
1170 * TX-INFO(トランザクション情報の取得) *
1180 ******************************************************
1190 *
1200 CALL 'TXINFORM' USING TX-INFO-AREA TX-RETURN-STATUS.
1210 IF RSVAL OF RS <= 0 THEN
1220 DISPLAY 'SUP01:NOT IN TRANSACTION. CODE = '
1230 RSVAL OF RS
1240 GO TO PROG-END
1250 ELSE
1260 IF RSVAL OF RS = 1 THEN
1270 DISPLAY 'SUP01:RETURN = ' COMMIT-RETURN
1280 DISPLAY 'SUP01:CONTROL = ' TRANSACTION-CONTROL
1290 DISPLAY 'SUP01:TIMEOUT = ' TRANSACTION-TIMEOUT
1300 DISPLAY 'SUP01:STATE = ' TRANSACTION-STATE
1310 END-IF
1320 END-IF.
1330 ******************************************************
1340 * RPC-CALL(遠隔サービスの要求) *
1350 ******************************************************
1360 *
1370 MOVE 'CALL' TO REQUEST OF RPC-ARG2.
1380 MOVE 'SPP01' TO G-NAME OF RPC-ARG2.
1390 MOVE 'SVR01' TO S-NAME OF RPC-ARG2.
1400 MOVE 'SUP01:DATA OpenTP1' TO SEND-DATA OF RPC-ARG3.
1410 MOVE 32 TO SEND-DATA-LENG OF RPC-ARG3.
1420 MOVE 32 TO RECEIVE-DATA-LENG OF RPC-ARG4.
1430 CALL 'CBLDCRPC' USING RPC-ARG2 RPC-ARG3 RPC-ARG4.
1440 IF STATUS-CODE OF RPC-ARG2 NOT = '00000' THEN
1450 DISPLAY 'SUP01:RPC-CALL RETURN CODE = '
1460 STATUS-CODE OF RPC-ARG2
1470 * GO TO TRAN-END
1480 END-IF.
1490 DISPLAY 'SERVICE FUNCTION RETURN = ' RECEIVE-DATA.
1500 TRAN-END.
1510 *
1520 ******************************************************
1530 * TX-SET-TRANSACTION-CONTROL(非連鎖モード設定) *
1540 ******************************************************
1550 *
1560 MOVE 0 TO TRANSACTION-CONTROL OF TX-INFO-AREA.
1570 CALL 'TXSETTRANCTL' USING TX-INFO-AREA TX-RETURN-STATUS.
1580 IF RSVAL OF RS NOT = 0 THEN
1590 DISPLAY 'SUP01:TX-SET-TRANSACTION-CONTROL FAILED. CODE = '
1600 RSVAL OF RS
1610 END-IF.
1620 *
1630 ******************************************************
1640 * TX-COMMIT(非連鎖モードのコミット) *
1650 ******************************************************
1660 *
1670 CALL 'TXCOMMIT' USING TX-RETURN-STATUS.
1680 IF RSVAL OF RS NOT = 0 THEN
1690 DISPLAY 'SUP01:TX-COMMIT FAILED. CODE = '
1700 RSVAL OF RS
1710 END-IF.
1720 PROG-END.
1730 *
1740 ******************************************************
1750 * RPC-CLOSE(UAPの終了) *
1760 ******************************************************
1770 *
1780 MOVE 'CLOSE' TO REQUEST OF RPC-ARG1.
1790 MOVE ZERO TO FLAGS OF RPC-ARG1.
1800 CALL 'CBLDCRPC' USING RPC-ARG1.
1810 DISPLAY 'SUP01:SUP PROCESS ENDED'.
1820 STOP RUN.