OpenTP1 Version 7 TP1/Client User's Guide TP1/Client/W, TP1/Client/P
This subsection describes how to create a COBOL UAP that can run in a multi-thread environment.
The following describes how to compile the source program of a UAP written in COBOL. The source program of this UAP requires a thread activation program and the CUP main program.
Write a thread activation program in C, and compile the program by using the cc command to create an object file. Write the CUP main program in COBOL, and compile the program by using a COBOL compiler to create the object files.
The following shows the names of example programs used in this subsection, and shows examples of commands for compiling the programs. The examples assume that COBOL85 is used as a COBOL compiler.
Commands to be entered:
xlc_r -c thdcup_main.c ccbl -c2 -Mt sample.cbl
When the above cc and ccbl commands are executed, the following object files are created:
You can use the ccbl or cc command to create the executable file of a UAP. The following shows how to use the ccbl and cc commands when creating the executable file of a UAP.
When you use the ccbl command to create the executable file of a UAP, you link the following files:
The following shows the names of files used in this example, and shows an example of the command for linking the above files by using the ccbl command.
Command to be entered:
ccbl -Mt -Mp -o CBL.exe thdcup_main.o sample.o -L/usr/lib -lclt -lpthread
When you use the cc command to create the executable file of a UAP, you link the following files:
The following shows the names of files used in this example, and shows an example of the command for linking the above files by using the cc command.
Command to be entered:
xlc_r -o CBL.exe thdcup_main.o sample.o -L/usr/lib -lclt -L/opt/HILNGcbl/lib -lcbl85 -lcbl85mp
The following shows examples of the thread activation program (written in C) and the CUP main program (written in COBOL) for a UAP written in 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 /* Generates a thread */ 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 failed. CODE=%d\n", errno); 000260 } 000370 } 000380} 000390 /* Waits for the thread to end. */ 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 failed. CODE=%d\n", errno); 000340 } 000350 } 000360 000370 } 000380
000010 * 000020 ************************************************** 000030 * CUP SAMPLE PROGRAM * 000040 ************************************************** 000050 * 000060 IDENTIFICATION DIVISION. 000070 PROGRAM-ID. CUP_THREAD. 000080 * 000090 ************************************************** 000100 * DATA AREA SETTINGS * 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 * START OF CUP * 000820 ************************************************** 000830 PROCEDURE DIVISION. 000840 MAIN SECTION. 000850 PROG-START. 000860 * 000870 ************************************************** 000880 * CLIENT USER AUTHENTICATION REQUEST * 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) failed. CODE=' 001050 DCCLS-CLTIN-STATUS-CODE IN DCCLS-CLTIN-ARG 001060 GO TO PROG-EXIT 001070 END-IF. 001080 * 001090 ************************************************** 001100 * RPC-OPEN(RPC ENVIRONMENT INITIALIZATION) * 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) failed. CODE=' 001260 DCRPS-OPEN-STATUS-CODE IN DCRPS-OPEN-ARG1 001270 GO TO PROG-END 001280 END-IF. 001290 * 001300 * ********************************************* 001310 * * RPC-CALL(RPC EXECUTION) * 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) failed.' 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 ENVIRONMENT RELEASE) * 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 *
All Rights Reserved. Copyright (C) 2006, 2009, Hitachi, Ltd.