Example call to a COBOL application
The following example shows a Smalltalk method using the PlatformFunction class to call a COBOL application. The content of the method includes the definition of the parameters being passed as well as an instance of a parsed COBOL data division structure. This illustrates a call to a non-Smalltalk application from Smalltalk in MVS so the callingConvention: is 'mvs'. The function: is the name of the application being called.
callCobol
| function struct1 |
function :=
PlatformFunction
callingConvention: 'mvs'
function: 'COBRTN'
library: ''
parameterTypes: #(pointer pointer int32 uint32 float struct)
returnType: #int32.
struct1 := Struct1 new
sChar1: 'M';
sString1: 'String is passed to COBOL';
sInt1: -143456;
sUint1: 98765;
sFloat1: 3.42156;
yourself.
function callWith: 'M'
with: 'String is passed to COBOL'
with: -143456
with: 98765
with: 3.42156
with: struct1.
As you can see, the Smalltalk method actually sends the variables twice, once as individual parameters and once as part of the parsed COBOL data division structure Struct1. The COBOL application being called must be able to receive the parameters it is called with. The following application is COBRTN, the COBOL application being called from Smalltalk.
IDENTIFICATION DIVISION.
PROGRAM-ID. COBRTN.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
LINKAGE SECTION.
01 CHAR1 PIC X.
01 STRING1 PIC X(25).
01 INT1 PIC S9(9) COMP.
01 UINT1 PIC 9(9) COMP.
01 FLOAT1 COMP-2.
01 STRUCT1.
05 S-CHAR1 PIC X.
05 S-STRING1 PIC X(25).
05 S-INT1 PIC S9(9) COMP.
05 S-UINT1 PIC 9(9) COMP.
05 S-FLOAT1 COMP-2.
PROCEDURE DIVISION USING
CHAR1 STRING1 INT1 UINT1 FLOAT1 STRUCT1.
DISPLAY "COBRTN START".
DISPLAY "THE VALUE OF CHAR1 IS: " CHAR1.
DISPLAY "THE VALUE OF STRING1 IS: " STRING1.
DISPLAY "THE VALUE OF INT1 IS: " INT1.
DISPLAY "THE VALUE OF UINT1 IS: " UINT1.
DISPLAY "THE VALUE OF FLOAT1 IS: " FLOAT1.
DISPLAY " ".
DISPLAY "THE VALUES IN STRUCT1:".
DISPLAY " THE VALUE OF S1 IS: " S-CHAR1.
DISPLAY " THE VALUE OF STRING1 IS: " S-STRING1.
DISPLAY " THE VALUE OF INT1 IS: " S-INT1.
DISPLAY " THE VALUE OF UINT1 IS: " S-UINT1.
DISPLAY " THE VALUE OF FLOAT1 IS: " S-FLOAT1.
DISPLAY "COBRTN END".
GOBACK.
END PROGRAM COBRTN.
Last modified date: 07/08/2019