Sample PL/I to COBOL applications
PL/I routine calling COBOL subroutine
*PROCESS MACRO;
PL1CBL: PROC OPTIONS(MAIN);
/*Module/File Name: IBMPCB
/*********************************************************************/
/* FUNCTION : Interlanguage communications call to a *
/* a COBOL program. *
/* *
/* This example illustrates an interlanguage call from *
/* a PL/I main program to a COBOL subroutine. *
/* The parameters passed across the call from PL/I to *
/* COBOL have the following characteristics: *
/* *
/* Data Type PL/I Attributes COBOL Data Description *
/* ---------------- -------------------- ---------------------- *
/* Halfword Integer REAL FIXED BIN(15,0) PIC S9999 USAGE COMP *
/* Fullword Integer REAL FIXED BIN(31,0) PIC S9(9) USAGE COMP *
/* Packed Decimal REAL FIXED DEC(m,n) PIC S9(m-n).9(n) COMP-3 *
/* Short Floating REAL FLOAT DEC(6) USAGE COMP-1 *
/* or REAL FLOAT BIN(21) *
/* Long Floating REAL FLOAT DEC(16) USAGE COMP-2 *
/* or REAL FLOAT BIN(53) *
/* Character string CHARACTER(n) PIC X(n) USAGE DISPLAY *
/* DBCS string GRAPHIC(n) PIC G(n) USAGE DISPLAY-1 *
/* *
/* Note 1: in COBOL, the usages COMPUTATIONAL-1 and COMP-1 *
/* are equivalent. *
/* Note 2: in COBOL, the usages COMPUTATIONAL-2 and COMP-2 *
/* are equivalent. *
/* Note 3: in COBOL, the usages FIXED-DECIMAL, COMP-3, and *
/* COMPUTATIONAL-3 are all equivalent. *
/* Note 4: in COBOL, the usages COMP, COMPUTATIONAL, COMP-4, *
/* COMPUTATIONAL-4, and BINARY are all equivalent. *
/* Note 5: character strings passed must NOT have the VARYING *
/* attribute in PL/I (both SBCS and DBCS). *
/* Note 6: in COBOL, the reserved word USAGE is optional. *
/* Note 7: in PL/I, the attributes BIN and BINARY are equivalent. *
/* Note 8: in PL/I, the attributes DEC and DECIMAL are equivalent. *
/* Note 9: in PL/I, attributes CHAR and CHARACTER are equivalent. *
/* *
/*********************************************************************/
%INCLUDE CEEIBMAW;
%INCLUDE CEEIBMCT;
/**********************************************************/
/* DECLARE ENTRY FOR THE CALL TO COBOL */
/**********************************************************/
DCL PL1CBSB EXTERNAL ENTRY(
/*1*/ FIXED BINARY(15,0),
/*2*/ FIXED BINARY(31,0),
/*3*/ FIXED DECIMAL(5,3),
/*4*/ FLOAT DECIMAL(6),
/*5*/ FLOAT DECIMAL(16),
/*6*/ CHARACTER(23),
/*7*/ GRAPHIC(2) )
OPTIONS(COBOL);
/**********************************************************/
/* Declare parameters: */
/**********************************************************/
DCL PLI_INT2 FIXED BINARY(15,0) INIT(15);
DCL PLI_INT4 FIXED BINARY(31,0) INIT(31);
DCL PLI_PD53 FIXED DECIMAL(5,3) INIT(-12.345);
DCL PLI_FLOAT4 FLOAT DECIMAL(6) INIT(53.99999);
DCL PLI_FLOAT8 FLOAT DECIMAL(16) INIT(3.14151617);
DCL PLI_CHAR23 CHARACTER(23) INIT('PASSED CHARACTER STRING');
DCL PLI_DBCS GRAPHIC(2) INIT('40404040'GX);
/**********************************************************/
/* PROCESS STARTS HERE */
/**********************************************************/
PUT SKIP LIST( '*******************************************');
PUT SKIP LIST( 'PL/I Calling COBOL example is now in motion');
PUT SKIP LIST( '*******************************************');
PUT SKIP;
CALL PL1CBSB( PLI_INT2, PLI_INT4, PLI_PD53,
PLI_FLOAT4, PLI_FLOAT8, PLI_CHAR23, PLI_DBCS);
PUT SKIP LIST( 'PL/I calling COBOL subroutine example ended');
END PL1CBL; COBOL program called by a PL/I main
CBL LIB,QUOTE,NODYNAM
*************************************************
* *
* IBM Language Environment for MVS & VM *
* *
* Licensed Materials - Property of IBM *
* *
* 5645-001 5688-198 *
* (C) Copyright IBM Corp. 1991, 1998 *
* All Rights Reserved *
* *
* US Government Users Restricted Rights - Use, *
* duplication or disclosure restricted by GSA *
* ADP Schedule Contract with IBM Corp. *
* *
*************************************************
*Module/File Name: IGZTPCB
****************************************************************
** PL1CBSB - COBOL language subroutine invoked by the ***
** PL/I program PL1CBL. ***
** ***
** This is an example of a COBOL subroutine that is called ***
** from a PL/I main program. See the calling PL/I program ***
** for a table of the PL/I data formats and corresponding ***
** COBOL data formats. The arguments received are compared ***
** to their expected values, and any discrepancies reported. ***
** ***
****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PL1CBSB.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
77 COBOL-INT2 PIC S9999 BINARY VALUE 15.
77 COBOL-INT4 PIC S9(9) BINARY VALUE 31.
77 COBOL-PD53 PIC S9(2)V9(3) COMP-3 VALUE -12.345.
77 COBOL-FLOAT4 COMP-1 VALUE 53.99999E0.
77 COBOL-FLOAT8 COMP-2 VALUE 3.14151617E0.
77 COBOL-CHAR23 PIC X(23) DISPLAY
VALUE "PASSED CHARACTER STRING".
77 COBOL-DBCS PIC G(2) DISPLAY-1 VALUE SPACES.
77 FLOAT8-DIFF COMP-2.
LINKAGE SECTION.
01 INT2-ARG PIC S9999 BINARY.
01 INT4-ARG PIC S9(9) BINARY.
01 PD53-ARG PIC S9(2)V9(3) COMP-3.
01 FLOAT4-ARG COMP-1.
01 FLOAT8-ARG COMP-2.
01 CHAR23-ARG PIC X(23) DISPLAY.
01 DBCS-ARG PIC G(2) DISPLAY-1.
**
PROCEDURE DIVISION USING INT2-ARG, INT4-ARG, PD53-ARG,
FLOAT4-ARG, FLOAT8-ARG,
CHAR23-ARG, DBCS-ARG.
0001-ENTRY-FROM-PL1.
DISPLAY "***************************************".
DISPLAY "COBOL PROGRAM ENTERED FROM PL/I PROGRAM".
DISPLAY "***************************************".
****************************************************************
** Compare passed arguments to initialized values. **
****************************************************************
IF (INT2-ARG NOT = COBOL-INT2) THEN
DISPLAY "Error passing PL/I FIXED BIN(15,0) to COBOL:"
DISPLAY "Actual argument value is " INT2-ARG
DISPLAY "Expected value is " COBOL-INT2
END-IF.
IF (INT4-ARG NOT = COBOL-INT4) THEN
DISPLAY "Error passing PL/I FIXED BIN(31,0) to COBOL:"
DISPLAY "Actual argument value is " INT4-ARG
DISPLAY "Expected value is " COBOL-INT4
END-IF.
IF (PD53-ARG NOT = COBOL-PD53) THEN
DISPLAY "Error passing PL/I FIXED DEC(5,3) to COBOL:"
DISPLAY "Actual argument value is " PD53-ARG
DISPLAY "Expected value is " COBOL-PD53
END-IF.
IF (FLOAT4-ARG NOT = COBOL-FLOAT4) THEN
****************************************************************
* Calculate absolute difference between short float value *
****************************************************************
COMPUTE FLOAT8-DIFF = COBOL-FLOAT4 - FLOAT4-ARG
IF (FLOAT8-DIFF < 0) THEN
COMPUTE FLOAT8-DIFF = - FLOAT8-DIFF
END-IF
IF (FLOAT8-DIFF > .00001E0) THEN
DISPLAY "Error passing PL/I FLOAT DEC(6) to COBOL:"
ELSE
DISPLAY "Warning: slight difference found when "
"passing PL/I FLOAT DEC(6) to COBOL:"
END-IF
DISPLAY "Actual argument value is " FLOAT4-ARG
DISPLAY "Expected value is " COBOL-FLOAT4
END-IF.
IF (FLOAT8-ARG NOT = COBOL-FLOAT8) THEN
****************************************************************
* Calculate absolute difference between long float values *
****************************************************************
COMPUTE FLOAT8-DIFF = COBOL-FLOAT8 - FLOAT8-ARG
IF (FLOAT8-DIFF < 0) THEN
COMPUTE FLOAT8-DIFF = - FLOAT8-DIFF
END-IF
IF (FLOAT8-DIFF > .000000001E0) THEN
DISPLAY "Error passing PL/I FLOAT DEC(16) to COBOL:"
ELSE
DISPLAY "Warning: slight difference found when "
"passing PL/I FLOAT DEC(16) to COBOL:"
END-IF
DISPLAY "Actual argument value is " FLOAT8-ARG
DISPLAY "Expected value is " COBOL-FLOAT8
END-IF.
IF (CHAR23-ARG NOT = COBOL-CHAR23) THEN
DISPLAY "Error passing PL/I CHAR(23) to COBOL:"
DISPLAY "Actual argument value is '" CHAR23-ARG "'"
DISPLAY "Expected value is '" COBOL-CHAR23 "'"
END-IF.
IF (DBCS-ARG NOT = COBOL-DBCS) THEN
DISPLAY "Error passing PL/I GRAPHIC(23) to COBOL:"
DISPLAY "Actual argument value is '" DBCS-ARG "'"
DISPLAY "Expected value is '" COBOL-DBCS "'"
END-IF.
GOBACK.