View previous topic :: View next topic
|
Author |
Message |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
Hello everyone, i really need help on this one..
I have to call a cobol program in C and passing a parameter to returning a value.
i tried it using:
system("CALL PGM(Cobol programName) PARM(parameters)");
I also included the cobol library name in SYSLIB step of PRE-LINK & LINK secn. in compile JCL of C program. I am using CICS in C.
I just wanted to know what is the best way to call the COBOL program, and changes i need to make in compile JCL or other files to make it work.
I am waiting for replies.
If I miss any information, kindly post it for me to answer. |
|
Back to top |
|
 |
dick scherrer
Moderator Emeritus

Joined: 23 Nov 2006 Posts: 19243 Location: Inside the Matrix
|
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
HI,
i read the topic. but it didnt help. the topic was saying about calling c from cobol, which is called by c.
i am sending you my code. help me to stop banging my head.
my c code :
Code: |
#include<stdio.h>
#include<memory.h>
#include<string.h>
#include<stdlib.h>
#include <//'SMXSBS.SCS.COPY(BMSMAP2)'>
char cbl1(char);
void main()
{
char *a;
char y;
a=&y;
y=cbl1('w');
memcpy(bmsmap2.bmsmap2o.outputo,a,1);
EXEC CICS
SEND MAP("bmsmap2")
ERASE;
EXEC CICS
RETURN;
}
|
BMSMAP2 is my mapname. i am using CICS to send the variable value to screen.
my cobol code :
Code: |
IDENTIFICATION DIVISION.
PROGRAM-ID. "CBL1".
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
LINKAGE SECTION.
01 A PIC A.
01 B PIC A.
PROCEDURE DIVISION USING BY VALUE A RETURNING B.
MOVE A TO B.
GOBACK.
END PROGRAM "CBL1". |
i am converting cobol to dll by using this jcl :
Code: |
//SMXSBSE JOB (XXXXX,X),'ZANY ',
// MSGCLASS=A,NOTIFY=&SYSUID,
// REGION=0M
//COBCMP EXEC IGYWCL,REGION=0M,LNGPRFX=IGY,
// PARM.COBOL='DLL,RENT,PGMNAME(LM),EXPORTALL',
// PARM.LKED='RENT,LIST,XREF,LET,MAP,DYNAM(DLL),CASE(MIXED)'
//COBOL.SYSIN DD DISP=SHR,DSN=SMXSBS.SCS.COBOL(CBL1)
//LKED.SYSLMOD DD DISP=SHR,DSN=SMXSBS.SCS.CDLL.LOAD(CBL1) |
and finally my C compile jcl :
Code: |
//SMXSBSDB JOB (SSG,SSG,SSGKAR,D2,DT99X),'CPP-DB2-CICS',CLASS=A,
// MSGCLASS=X,MSGLEVEL=(1,1),NOTIFY=SMXSBS,REGION=0K
//CBCCL PROC MEM=CICSCPG1,
// CRUN=,
// CPARM='CXX SOURCE,LIST,LONGNAME',
// CPARM2='XREF,SHOWINC',
// CPARM3=,
// CREGSIZ='0M',
// INDEX='CICSTS32.CICS',
// LIBPRFX='CEE',
// LNGPRFX='CBC',
// CLBPRFX='CBC',
// CLANG='EDCMSGE',
// CXXLANG='CBCMSGE',
// PLANG='EDCPMSGE',
// PREGSIZ='0M',
// PPARM='MAP,NOER',
// LPARM='AMODE=31,MAP,RENT',
// DCB80=(RECFM=FB,LRECL=80,BLKSIZE=3200),
// DCB3200=(RECFM=FB,LRECL=3200,BLKSIZE=12800),
// SRCE='BMXSBS.TCS.C',
// DBRMLIB='SMXSBS.SCS.DBRMLIB',
// LOAD='SMXSBU.CICSB1.POC.LOAD'
//*----------------------------------------------------------------- *
//* PRECOMPILE STEP FOR EMBEDDED SQL *
//*----------------------------------------------------------------- *
//PC EXEC PGM=DSNHPC,PARM='HOST(C),SOURCE'
//STEPLIB DD DSN=DSN810.SDSNLOAD,DISP=SHR
// DD DSN=DSN810.SDSNEXIT,DISP=SHR
//DBRMLIB DD DSN=&DBRMLIB(&MEM),DISP=SHR
//SYSIN DD DSN=&SRCE(&MEM),DISP=SHR
//SYSCIN DD DSN=&&DSNHOUT,DISP=(NEW,PASS),UNIT=VIO,
// SPACE=(800,(30,30))
//SYSPRINT DD SYSOUT=*
//SYSTERM DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSUT1 DD SPACE=(800,(30,30),,,ROUND),UNIT=VIO
//SYSUT2 DD SPACE=(800,(30,30),,,ROUND),UNIT=VIO
//* ---------------------------------------------------------------- *
//* TRANSLATE STEP FOR C: *
//* ---------------------------------------------------------------- *
//CTRN EXEC PGM=DFHEDP1$,PARM=('NOS,CPP,CICS'),
// REGION=0M
//STEPLIB DD DSN=CICSTS32.CICS.SDFHLOAD,DISP=SHR
//SYSIN DD DSN=*.PC.SYSCIN,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSPUNCH DD DSN=&&SYSCIN,
// DISP=(,PASS),UNIT=VIO,
// DCB=BLKSIZE=400,
// SPACE=(400,(400,100))
//* ---------------------------------------------------------------- *
//* CCOMPILE STEP: *
//* ---------------------------------------------------------------- *
//*CCOMP EXEC PGM=CBCDRVR,REGION=&CREGSIZ,
//CCOMP EXEC PGM=CCNDRVR,REGION=&CREGSIZ,
// PARM=('&CRUN/&CPARM &CPARM2 &CPARM3'),COND=(4,LT,CTRN)
//STEPLIB DD DSNAME=&LIBPRFX..SCEERUN,DISP=SHR
// DD DSNAME=CBC.SCCNCMP,DISP=SHR
//SYSLIB DD DSN=&LIBPRFX..SCEEH.H,DISP=SHR
// DD DSN=&LNGPRFX..SCLBH.H,DISP=SHR
// DD DSN=&LNGPRFX..SCLBH.HPP,DISP=SHR
// DD DSN=&LIBPRFX..SCEEH.NET.H,DISP=SHR
// DD DSN=&LIBPRFX..SCEEH.NETINET.H,DISP=SHR
// DD DSN=&LIBPRFX..SCEEH.SYS.H,DISP=SHR
// DD DSN=&INDEX..SDFHC370,DISP=SHR
//SYSMSGS DD DUMMY,DSN=&LNGPRFX..SCBC3MSG(&CLANG),DISP=SHR
//SYSXMSGS DD DUMMY,DSN=&LNGPRFX..SCBC3MSG(&CXXLANG),DISP=SHR
//SYSIN DD DSN=*.CTRN.SYSPUNCH,DISP=(OLD,DELETE)
//SYSLIN DD DSN=&&LOADSET,UNIT=VIO,
// DISP=(NEW,PASS),SPACE=(512,(50,20)),
// DCB=&DCB80
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSCPRT DD SYSOUT=*
//SYSUT1 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB80
//SYSUT4 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB80
//SYSUT5 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB3200
//SYSUT6 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB3200
//SYSUT7 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB3200
//SYSUT8 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB3200
//SYSUT9 DD UNIT=VIO,SPACE=(32000,(30,30)),
// DCB=(RECFM=VB,LRECL=137,BLKSIZE=882)
//SYSUT10 DD SYSOUT=*
//SYSUT14 DD UNIT=VIO,SPACE=(32000,(30,30)),DCB=&DCB3200
//SYSUT15 DD SYSOUT=*
//* ---------------------------------------------------------------- *
//* PRE-LINKEDIT STEP: *
//* ---------------------------------------------------------------- *
//PLKED EXEC PGM=EDCPRLK,REGION=&PREGSIZ,COND=(8,LE),
// PARM='&PPARM'
//STEPLIB DD DSNAME=&LIBPRFX..SCEERUN,DISP=SHR
//SYSMSGS DD DSNAME=&LIBPRFX..SCEEMSGP(&PLANG),DISP=SHR
//SYSLIB DD DSN=&LIBPRFX..SCEECPP,DISP=SHR
// DD DSN=&LNGPRFX..SCLBCPP,DISP=SHR
// DD DSN=SMXSBS.SCS.CDLL.LOAD(CBL1),DISP=SHR
//SYSIN DD DSN=*.CCOMP.SYSLIN,DISP=(OLD,DELETE)
// DD DSN=&CLBPRFX..SCLBSID(IOSTREAM),DISP=SHR
// DD DSN=&CLBPRFX..SCLBSID(COMPLEX),DISP=SHR
// DD DDNAME=SYSIN2
// DD DSN=SMXSBS.SCS.CDLL.LOAD(CBL1),DISP=SHR
// DD DSN=SMXSBU.CICSB1.POC.LOAD,DISP=SHR
//SYSMOD DD DSN=&&PLKSET,UNIT=VIO,DISP=(NEW,PASS),
// SPACE=(32000,(30,30)),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3200)
//SYSDEFSD DD DUMMY
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN2 DD DUMMY
//*
//* ---------------------------------------------------------------- *
//* LINKEDIT STEP: *
//* ---------------------------------------------------------------- *
//LKED EXEC PGM=HEWL,REGION=1024K,COND=(8,LT),
// PARM='&LPARM'
//SYSLIN DD DSN=*.PLKED.SYSMOD,DISP=(OLD,DELETE)
// DD DDNAME=SYSIN
// DD DSN=SMXSBS.SCS.CDLL.LOAD(CBL1),DISP=SHR
//SYSLIB DD DSN=&LIBPRFX..SCEELKED,DISP=SHR
// DD DSN=&INDEX..SDFHLOAD,DISP=SHR
// DD DSN=SMXSBS.SCS.CDLL.LOAD(CBL1),DISP=SHR
// DD DISP=SHR,DSN=DSN810.SDSNLOAD
// DD DISP=SHR,DSN=DSN810.SDSNEXIT
//SYSLMOD DD DSN=&LOAD(&MEM),DISP=SHR
// DD DSN=SMXSBU.CICSB1.POC.LOAD(CICSCPG1),DISP=SHR
//SYSUT1 DD UNIT=VIO,SPACE=(32000,(30,30))
//SYSUT2 DD UNIT=VIO,SPACE=(32000,(30,30))
//SYSPRINT DD SYSOUT=*
// PEND
//CCOMP EXEC CBCCL
//LKED.SYSIN DD *
INCLUDE SYSLIB(DFHELII)
/*
|
CBL1 is my cobol program
BMSMAP is my mapname
CICSCPG1 is my C program.
SMXSBS.SCS.CDLL.LOAD(CBL1) is the location of my COBOL DLL file.
if you could help.
or else i will have to keep banging my head aroud forums .  |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
c compile JCL is showing the following error :
Code: |
IEW2456E 9207 SYMBOL CBL1@@FC UNRESOLVED. MEMBER COULD NOT BE INCLUDED FROM THE DESIGNATED CALL LIBRARY.
IEW2746S DA13 ABEND C13-10 OCCURRED WHILE PROCESSING OUTPUT DATA SET WITH DDNAME SYSLMOD. |
others are compiling successfully. |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
hello,
i tried the post u have send me.
i tried a lot. i made all the changes necessary. but it is not working.
the error shown in my last reply is consistently coming.
plz help me out, or give me ny resourceful link or nythin which might help.
m really seeking out help on this one. i am stuck since last week. |
|
Back to top |
|
 |
Robert Sample
Global Moderator

Joined: 06 Jun 2008 Posts: 8700 Location: Dubuque, Iowa, USA
|
|
|
|
I think you missed in your reading of the previous topic my references to document SA22-7563, z/OS Language Environment Writing Interlanguage Communication Applications. You need to get a copy of this and read it thoroughly. I suspect you need a #pragma statement but I'm not sure since I haven't done a C calling COBOL under CICS program. There's an entire chapter of C calling COBOL and some examples using fetch that might help.
One thing that appears to be missing is your including the COBOL module into your C load module -- the message about CBL1@@FC is indicating that the COBOL module isn't being located (although why the @@FC is being appended, I'm not sure). |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
ok..letme read it.
thank u for ur reply.
if i am unable to get something, will post u back. |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
Hi,
I tried a lot...finally am able to call cobol from C( using C-COBOL)
but that is not including cics.
when i am including cics the c code, it is not working properly.
i think my C-CICS-COBOL(for calling cobol in C and including CICS in C) compiler has some problem.
if anyone has this compiler, can they post it here..!!?? |
|
Back to top |
|
 |
dick scherrer
Moderator Emeritus

Joined: 23 Nov 2006 Posts: 19243 Location: Inside the Matrix
|
|
|
|
Hello,
Quote: |
if anyone has this compiler, can they post it here..!!?? |
The correct compile jcl will be specific to your environment. Suggest you talk with the people who support the compliers and link editor.
It is quite common to have separate callable modules for batch and cics. If you are trying to use the exact same module, this may be part of your problem. |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
ok..i think i should seperated the c and cics compilation.
i will try and reply. |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
i tried.
its not working.
i am able to compile CICS-C program (without calling cobol).
and able to run C-COBOL program(c progm calling cobol without any CICS).
they both have diff jcls.
the jcl of CICS-C is posted above and is working.
the jcl for C-COBOL is below :
Code: |
/SMXSBSC JOB (XXXXX,X),'ZANY ',
// MSGCLASS=X,NOTIFY=&SYSUID,
// REGION=0M
//CC EXEC EDCC,CPARM='OPTF(DD:OPTIONS)',
// INFILE='SMXSBS.SCS.C(CICSCPG1)',
// OUTFILE='SMXSBS.SCS.OBJ(CICSCPG1),DISP=SHR'
//COMPILE.OPTIONS DD *
DLL RENT LONGNAME
/*
//BIND1 EXEC CBCB,BPARM='CALL,DYNAM=DLL,REUS=RENT',
// OUTFILE='SMXSBS.SCS.LOAD(CICSCPG1),DISP=SHR'
//INOBJ DD DISP=SHR,DSN=SMXSBS.SCS.OBJ
//SYSLIB DD DISP=SHR,DSN=SMXSBS.SCS.LOAD <--o/p pds of type LIBRARY
//INOBJ1 DD DISP=SHR,DSN=SMXSBS.SCS.CDLL.LOAD
//SYSLIN DD *
INCLUDE INOBJ(CICSCPG1) <-----c obj from previous step
INCLUDE INOBJ1(CBL1) <-----cobol dll
ENTRY CEESTART
NAME CICSCPG1(R)
/* |
i just have to combine both the steps.
the problem is, i dont know where to add this bind step (C and COBOL).
if i add the bind step to C-CICS jcl, then where should i add it. And will i have to exclude the prelink or linkedit step from the C-CICS jcl if am adding the BIND1 step in it.
the other problem is, even if i add the BIND1 step in C-CICS jcl, it wont work because the PDS of OUTFILE is of type LIBRARY, and all the temporary PS that are being created in C-CICS jcl( which are being used to refer back to previous steps) , does not match the type.
i need help. i knw this is very complicated and difficult for some1 sitting someplace else to help without looking at the codes. but if some1 who has tried this out and had been successful, i request them to kindly reply to this.
at least give me some idea.
i tried to get hold of some materials to study. but there is none available on C calling COBOL with CICS in it.
 |
|
Back to top |
|
 |
Robert Sample
Global Moderator

Joined: 06 Jun 2008 Posts: 8700 Location: Dubuque, Iowa, USA
|
|
|
|
I've just gone through many of the CICS manuals and cannot find any mention of DLL. I suspect you cannot create a DLL that is used in CICS; you must create a load module that can be moved into the DFHRPL concatenation instead. I have not been able to confirm this, but there's no mention of DLL in the Resource Defintion manual, the Installation Guide, Application Programming Reference, Application Programming Guide, Customization Guide, or Intercommunications Guide.
Change your C program to generate a load module in a PDS instead of a DLL, which will simplify your binding (linkage editing) task as well. |
|
Back to top |
|
 |
zanyzap4u
New User
Joined: 13 Dec 2008 Posts: 38 Location: Mexico City
|
|
|
|
ok..
now its working.
i am compiling c to renerate load module(after translation) and binding with cobol.
now i am checking if its getting reflected in cics region. its having some small difficuties.
i wil be in touch if it doesnt work..  |
|
Back to top |
|
 |
|
|