Calling GNUCOBOL subroutines from PL/I or Fujitsu Cobol for Windows

[Bruce Zupek]

I cannot get a GNUCOBOL subroutine invoked successfully using Fujitsu Cobol for Windows or from IBM PL/I. The calling module is a .EXE. The GNUCOBOL subroutine was compiled with -fimplicit-init - When calling a GNUCOBOL subroutine the error handler return to the system - no diagnostic as to what failed or why.
I then decided to invoke cob_init with standard Win API's - this also failed. Can some advise as to the method by which to call a GNUCOBOL subroutine from another Windows based high level language - Not "C" or its derivatives.

:::cobol
       @OPTIONS BINARY(BYTE)
       @OPTIONS NOALPHAL
      *@OPTIONS MAIN(MAIN)

      * cob_init (argc, **argv)
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
      * This program is a preloaded program used by my CICS emulator
      * The CICS main is the only .EXE to be executed during CICS
      * CICS is enhanced text only - there are no .NET / C++ components
      * Application programs (CICS Transactions) are called as .DLL's
      * My CICS main is a Fujitsu Cobol for Windows .EXE
      * This subroutine tries to invoke cob_init
      * This was an attempt to circumvent -fimplicit-init not working
      * Further testing using a PL/I main also fails
      * Any GNUCOBOL module called by CICS fails
      * The failure terminates the CICS .EXE - No indication as to why
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
       IDENTIFICATION DIVISION.
       PROGRAM-ID. ZOSGNU.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-PC.
       OBJECT-COMPUTER. IBM-PC.
       SPECIAL-NAMES.
           ARGUMENT-NUMBER   IS COMMAND-LINE-NUMBER
           ARGUMENT-VALUE    IS COMMAND-LINE-VALUE
           ENVIRONMENT-NAME  IS ENVIRONMENT-NAME
           ENVIRONMENT-VALUE IS ENVIRONMENT-VALUE
           SYMBOLIC CONSTANT
               VAL-FALSE                   IS 0
               VAL-TRUE                    IS 1
               VAL-STARTUP-FAILED          IS 0
               VAL-STARTUP-OK              IS 1
               VAL-READ-ONLY               IS 1
               VAL-WRITE-ONLY              IS 2
               VAL-READ-WRITE              IS 3
               VAL-PROTECT-FROM-WRITES     IS 1
               VAL-PROTECT-FROM-READS      IS 2
               VAL-NORMAL-I-O              IS 0
               VAL-READ-FILE-SIZE          IS 128
               VAL-I-O-OK                  IS '00'
               VAL-END-OF-FILE             IS '10'
               VAL-MEMORY-IS-NON-SHAREABLE  IS 0
               VAL-MEMORY-IS-SHAREABLE      IS 1.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       77  GNU-ZERO                   PIC 9(04) COMP-5 VALUE ZERO.
       77  GNU-NADA                   PIC X(01) VALUE SPACES.
       77  GNU-NULL                   USAGE POINTER.
       77  GNU-NULL-9 REDEFINES GNU-NULL PIC 9(08) COMP-5.
       77  DLL-ZERO                   PIC 9(08) COMP-5 VALUE ZERO.
       77  ERROR-PAUSE                PIC X(01).
       77  DLL-BUFFER-LEN             PIC 9(08) COMP-5 VALUE 200.
       77  DLL-HANDLE                 PIC 9(08) COMP-5.
       77  NULL-BYTEA                 PIC X(01) VALUE LOW-VALUES.
       77  LOADLIBRARY                PIC X(24) VALUE 'LoadLibrary '.
       77  GETDLL                     PIC X(24) VALUE 'GetProcAddress '.
       77  GNUREL                     PIC X(08) VALUE 'GNUREL'.
       77  GNUCOMM                    PIC X(07) VALUE 'GNUCOMM'.
       77  NULL-BYTE0                 PIC X(01) VALUE LOW-VALUES.
       77  GNUAPI                     PIC X(08) VALUE 'libcob-4'.
       77  NULL-BYTE1                 PIC X(01) VALUE LOW-VALUES.
       77  GNUOPEN                    PIC X(08) VALUE 'GNUOPEN'.
       77  NULL-BYTE2                 PIC X(01) VALUE LOW-VALUES.
       77  GNUINIT                    PIC X(08) VALUE 'cob_init'.
       77  NULL-BYTE2-1               PIC X(01) VALUE LOW-VALUES.
       77  GNUCMD                     PIC X(08) VALUE 'GNUCMD'.
       77  NULL-BYTE3                 PIC X(01) VALUE LOW-VALUES.
       77  ZOSPD171                   PIC X(08) VALUE 'ZOSPD171'.
       77  NULL-BYTE3                 PIC X(01) VALUE LOW-VALUES.
       77  LOAD-ERROR-BUFFER          PIC X(100).
       77  LOAD-ERROR-BUFFER-SIZE     PIC 9(08) COMP-5 VALUE 100.
       77  I                          PIC 9(04) COMP-4.
       77  NOGO                       PIC 9(04) COMP-5.
       01  PROGRAM-FIELDS.
           05  DLL-NAME.
               10  DNAME OCCURS 8 TIMES PIC X(01).
           05  DLL-LOW                  PIC X(01) VALUE LOW-VALUES.
           05  DLL-API-PTR              USAGE PROCEDURE-POINTER.
           05  DLL-API-PTR-X REDEFINES DLL-API-PTR PIC X(04).
           05  GNUOPEN-PTR              USAGE PROCEDURE-POINTER.
           05  GNUINIT-PTR              USAGE PROCEDURE-POINTER.
           05  GNUCMD-PTR               USAGE PROCEDURE-POINTER.
           05  DLL-PTR                  USAGE POINTER.
           05  LINK-ENTRY-NAME          PIC X(08).
           05  LINK-DLL-NAME.
               10  LNAME OCCURS 8 TIMES PIC X(01).
       LINKAGE SECTION.
       PROCEDURE DIVISION.
      *-*-* Set **argv to NULL
           SET GNU-NULL TO NULL.
      *-*-* Load the .DLL that contains entry point"cob_init"
           MOVE 'libcob-4' TO LINK-DLL-NAME.
           MOVE  LINK-DLL-NAME TO DLL-NAME.
           MOVE LOW-VALUES TO DLL-API-PTR-X.
           CALL 'LoadLibraryA'  WITH STDCALL LINKAGE
                 USING
                 BY REFERENCE   GNUAPI
                 RETURNING      DLL-HANDLE
           IF DLL-HANDLE = 0
               DISPLAY 'MODULE NOT FOUND=' LINK-DLL-NAME
               DISPLAY 'RETURN CODE QUERY MODULE=' RETURN-CODE
               MOVE 12 TO RETURN-CODE
               GOBACK
           END-IF.
      *-*-* DLL loaded successfully - Find Proc Address of "cob_init"
           CALL 'GetProcAddress' WITH STDCALL LINKAGE
                 USING
                 BY VALUE          DLL-HANDLE
                 BY REFERENCE      GNUINIT
                 RETURNING         DLL-API-PTR.
           IF DLL-API-PTR-X = LOW-VALUES
               DISPLAY 'PROC ADDR NOT FOUND=' LINK-DLL-NAME
               DISPLAY 'RETURN CODE QUERY MODULE=' RETURN-CODE
               MOVE 16 TO RETURN-CODE
               GOBACK
           END-IF.
      *-*-* Entry point "cob_init" found - Begin to try calling cob_init
           MOVE 0 TO GNU-NULL-9
           SET GNU-NULL TO NULL
      *-*-* Call procedure pointer "cob_init" with numerous linkages
           CALL DLL-API-PTR
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR
                            USING
                            BY VALUE 0
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           MOVE 0 TO GNU-NULL-9
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR WITH STDCALL LINKAGE
                            USING
                            BY VALUE 0
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           MOVE RETURN-CODE TO NOGO
           MOVE 0 TO GNU-NULL-9
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR WITH C LINKAGE
                            USING
                            BY VALUE 0
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR
                            USING
                            GNU-ZERO
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           MOVE 0 TO GNU-NULL-9
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR WITH STDCALL LINKAGE
                            USING
                            GNU-ZERO
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* The above failed - try again different parameters
           MOVE RETURN-CODE TO NOGO
           MOVE 0 TO GNU-NULL-9
           SET GNU-NULL TO NULL
           CALL DLL-API-PTR WITH C LINKAGE
                            USING
                            GNU-ZERO
                            BY REFERENCE GNU-NADA
           MOVE RETURN-CODE TO NOGO
           IF NOGO = 0
               GOBACK
           END-IF
      *-*-* cob_init fails with all of the above parameters
           GOBACK.

[Simon Sobisch]

You try to call cob_init() which is a void function. You cannot get any RETURNC-CODE from this. GnuCOBOL supports the extension CALL 'voidfunc' USING stuff RETURNING NULL, I don't know if Fujitsu has something similar. If not I'd try to use CALL-CONVENTION if this is supported by Fujitsu using the flags "doesn't change RETURN-CODE" (bit number two) and, if possible "static linking" (this would lead to the fujitsu COBOL caller to be always linked against libcob).

The correct parameters are an int (BINARY-LONG) and a char ** (USAGE POINTER).

Despite that (I'd like you to get this working) I'd suggest to call the COBOL module directly. For calling the module you'd need to compile it with -fimplicit-init and call it from fujitsu COBOL with the correct case and parameter. Please post the sample you already seem to have and we can check this.

The likely easiest solution is to compile the COBOL main programs via GnuCOBOL as main (-x) and do something like CALL 'SYSTEM' USING 'yourcobmain.exe param1 "param numer 2" from Fujitsu COBOL.

[Simon Sobisch]

@Bruce: Did the post help you to solve the issue?