Example 2 (COBOL: 64-bit DLL)

The following is an example of a 64-bit COBOL program calling IDISNAP as a DLL.
       IDENTIFICATION DIVISION.
       PROGRAM-ID. 'IDISNAPC'
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       77  STORAGE-AMODE31-PTR USAGE IS POINTER-32.
       LINKAGE SECTION.
       01 STORAGE-AMODE31.
         03 PTRPARM USAGE IS POINTER-32.
         03 PTRS.
           04 PTR-PARM-1 USAGE IS POINTER-32.
           04 PTR-LAST USAGE IS POINTER-32.
         03 WORK PIC X(4) .
         03 WORK_TITLE PIC X(140).
         03 WORK_PARM.
           04 WORKP_1 PIC X(9).
           04 WORKP_2 PIC X(8).
           04 WORKP_3 PIC X(2).
           04 WORKP_4 PIC X(122).
         03 WORK_RANGE.
           04 R1S     PIC X(4).
           04 R1E     PIC X(4).
         03 PARM-1.
          05 PARM-1-L PIC 9(4) COMP.
          05 ENV.
      * ********************************************
      * THIS EXAMPLE RETRIEVES THE FAULT-ID AND    *
      * IDIHIST VALUES BUT IS NOT INTERESTED IN    *
      * ANYTHING ELSE.                             *
      * THEREFORE IT PROVIDES A "SHORT" DATA AREA. *
      * ********************************************

             07 VERSION                        PIC X(4).
             07 EXIT-CALL-TYPE                 PIC X(1).
             07 FAULT-ID                       PIC X(8).
             07 ABEND-DATE                     PIC X(10).
             07 ABEND-TIME                     PIC X(8).
             07 REALTIME                       PIC X(1).
             07 SYSTEM-NAME                    PIC X(8).
             07 JOB-NAME                       PIC X(8).
             07 EXEC-PGM-NAME                  PIC X(8).
             07 USER-ID                        PIC X(8).
             07 RESERVED-1                     PIC X(4).
             07 ABEND-MODULE-NAME              PIC X(8).
             07 CICS-TRANSACTION-ID            PIC X(4).
             07 CICS-TASK-NUMBER               PIC X(5).
             07 JOB-TYPE                       PIC X(1).
             07 JOB-CLASS                      PIC X(1).
             07 ACCOUNTING-FIELDS              PIC X(3).
             07 ACCOUNTING-INFO                PIC X(144).
             07 USER-1                         PIC X(4).
             07 USER-2                         PIC X(4).
             07 RESERVED-2                     PIC X(1).
             07 LOOPPROTECTION-OPT             PIC X(1).
             07 RESERVED-3                     PIC X(4).
             07 WRITE-ROUTINE-EP            USAGE IS PROCEDURE-POINTER.
             07 INVOCATION-EXIT                PIC X(1).
             07 STEP-NAME                      PIC X(8).
             07 JOB-ID                         PIC X(8).
             07 IMS-PROGRAM-NAME               PIC X(8).
             07 USER-NAME                      PIC X(8).
             07 USER-TITLE                     PIC X(40).
             07 APPLID                         PIC X(8).
             07 TERMID                         PIC X(4).
             07 NETNAME                        PIC X(8).
             07 TCB-ADDRESS                    PIC X(8).
             07 CSA-ADDRESS                    PIC X(8).
             07 TCA-ADDRESS                    PIC X(8).
             07 IDIHIST                        PIC X(44).

       PROCEDURE DIVISION.
       MAIN SECTION.
       START000.
            ALLOCATE STORAGE-AMODE31 LOC 31
              RETURNING STORAGE-AMODE31-PTR.
            SET ADDRESS OF STORAGE-AMODE31 TO STORAGE-AMODE31-PTR.
            MOVE LENGTH OF ENV TO PARM-1-L.
            SET PTR-PARM-1 TO ADDRESS OF PARM-1.
            SET PTR-LAST TO NULL.
            SET PTRPARM TO ADDRESS OF PTRS.
            MOVE "0002" TO WORK.
            MOVE "TEST TITLE" TO WORK_TITLE.
            MOVE FUNCTION HEX-OF(PTRPARM) TO WORKP_2.
            MOVE 'SNAPDATA(' TO WORKP_1.
            MOVE ') ' TO WORKP_3.
            MOVE 'DATASETS(IDIHIST(MY.TEST.HIST))' TO WORKP_4.
            DISPLAY "STARTING" UPON SYSOUT.
            CALL "IDISNPD"   USING                 WORK
                                                   WORK_TITLE
                                                   WORK_PARM.
            DISPLAY "FAULTID: " FAULT-ID OF ENV UPON SYSOUT.
            DISPLAY "HISTDSN: " IDIHIST OF ENV UPON SYSOUT.
            DISPLAY "STOPPING" UPON SYSOUT.
            STOP RUN.
           EXIT.
       END PROGRAM 'IDISNAPC'.
Note:
This 64-bit DLL supports only the first three parameters; the storage range parameter is ignored.

This example is provided as sample job IDIVPCB6 in data set IDI.SIDISAM1.