Node:Static COBOL to C, Next:, Previous:Dynamic C to COBOL, Up:C Interface



Static linking with C programs

Let's call the following C function from COBOL:

     ---- say.c -----------------------------
     int
     say(char *hello, char *world)
     {
       int i;
       for (i = 0; i < 6; i++)
         putchar(hello[i]);
       for (i = 0; i < 6; i++)
         putchar(world[i]);
       putchar('\n');
       return 0;
     }
     ----------------------------------------
     

This program is equivalent to the foregoing say.cob.

Note that, unlike C, the arguments passed from COBOL programs are not terminated by the null character (i.e., \0).

You can call this function in the same way you call COBOL programs:

     ---- hello.cob -------------------------
            IDENTIFICATION DIVISION.
            PROGRAM-ID. hello.
            ENVIRONMENT DIVISION.
            DATA DIVISION.
            WORKING-STORAGE SECTION.
            01 HELLO PIC X(6) VALUE "Hello ".
            01 WORLD PIC X(6) VALUE "World!".
            PROCEDURE DIVISION.
            CALL "say" USING HELLO WORLD.
            STOP RUN.
     ----------------------------------------
     

Compile these programs as follows:

     $ cc -c say.c
     $ cobc -c -static -fmain hello.cob
     $ cobc -o hello hello.o say.o
     $ ./hello
     Hello World!