@smallformat
@verbatim
GNUCOBOL 3.1.2 06MAR202 Source Listing                                                2022/03/06
                                                                                     COBDUMP.cbl
Line   Statement                                                                         Page: 1
====== =========================================================================================
     1        >>SOURCE FORMAT IS FIXED
     2        IDENTIFICATION DIVISION.
     3        PROGRAM-ID.   COBDUMP.
     4       *>***************************************************************
     5       *> This is an OpenCOBOL subroutine that will generate a        **
     6       *> formatted Hex/Char dump of a storage area.  To use this     **
     7       *> subroutine, simply CALL it as follows:                      **
     8       *>                                                             **
     9       *> CALL "COBDUMP" USING <data-item>                            **
    10       *>                    [ <length> ]                             **
    11       *>                                                             **
    12       *> If specified, the <length> argument specifies how many      **
    13       *> bytes of <data-item> are to be dumped.  If absent, all of   **
    14       *> <data-item> will be dumped (i.e. LENGTH(<data-item>) will   **
    15       *> be assumed for <length>).                                   **
    16       *>                                                             **
    17       *> >>> Note that the subroutine name MUST be specified in  <<< **
    18       *> >>> UPPERCASE                                           <<< **
    19       *>                                                             **
    20       *> The dump is generated to STDERR, so you may pipe it to a    **
    21       *> file when you execute your program using "2> file".         **
    22       *>                                                             **
    23       *> AUTHOR:       GARY L. CUTLER                                **
    24       *>                                                             **
    25       *> NOTE:         The author has a sentimental attachment to    **
    26       *>               this subroutine - it's been around since 1971 **
    27       *>               and it's been converted to and run on 10 dif- **
    28       *>               ferent operating system/compiler environments **
    29       *>                                                             **
    30       *> DATE-WRITTEN: October 14, 1971                              **
    31       *>                                                             **
    32       *>***************************************************************
    33       *>  DATE  CHANGE DESCRIPTION                                   **
    34       *> ====== ==================================================== **
    35       *> GC1071 Initial coding - Univac Dept. of Defense COBOL '68   **
    36       *> GC0577 Converted to Univac ASCII COBOL (ACOB) - COBOL '74   **
    37       *> GC1182 Converted to Univac UTS4000 COBOL - COBOL '74 w/     **
    38       *>        SCREEN SECTION enhancements                          **
    39       *> GC0883 Converted to Honeywell/Bull COBOL - COBOL '74        **
    40       *> GC0983 Converted to IBM VS COBOL - COBOL '74                **
    41       *> GC0887 Converted to IBM VS COBOL II - COBOL '85             **
    42       *> GC1294 Converted to Micro Focus COBOL V3.0 - COBOL '85 w/   **
    43       *>        extensions                                           **
    44       *> GC0703 Converted to Unisys Universal Compiling System (UCS) **
    45       *>        COBOL (UCOB) - COBOL '85                             **
    46       *> GC1204 Converted to Unisys Object COBOL (OCOB) - COBOL 2002 **
    47       *> GC0609 Converted to OpenCOBOL 1.1 - COBOL '85 w/ some COBOL **
    48       *>        2002 features                                        **
    49       *> GC0410 Enhanced to make 2nd argument (buffer length)        **
    50       *>        optional                                             **
    51       *> GC0211 Ported to IBM Enterprise COBOL                       **
    52       *> GC0612 Updated for OpenCOBOL 2.0                            **
    53       *> VC0322 Moved lines only with . to end of previous statement **
@end verbatim
@end smallformat
@page
@smallformat
@verbatim
GNUCOBOL 3.1.2 06MAR202 Source Listing                                                2022/03/06
                                                                                     COBDUMP.cbl
Line   Statement                                                                         Page: 2
====== =========================================================================================
    54       *>        Fix for bug #816 by making WS-Buffer-Byte-NUM        **
    55       *>        UNSIGNED                                             **
    56       *>***************************************************************
    57        ENVIRONMENT DIVISION.
    58        CONFIGURATION SECTION.
    59        REPOSITORY.
    60            FUNCTION ALL INTRINSIC.
    61        DATA DIVISION.
    62        WORKING-STORAGE SECTION.
    63        01  WS-Addr-PTR                           USAGE POINTER.
    64        01  WS-Addr-NUM REDEFINES WS-Addr-PTR
    65                                                  USAGE BINARY-LONG.
    66
    67        01  WS-Addr-SUB                           USAGE BINARY-CHAR.
    68
    69        01  WS-Addr-Value-NUM                     USAGE BINARY-LONG.
    70
    71        01  WS-Buffer-Byte-CHR.
    72            05 WS-Buffer-Byte-NUM                 USAGE BINARY-CHAR
    73                                                         UNSIGNED.
    74
    75        01  WS-Buffer-Length-NUM                  USAGE BINARY-LONG.
    76
    77        01  WS-Buffer-SUB                         PIC 9(4) COMP-5.
    78
    79        01  WS-Hex-Digit-TXT VALUE '0123456789ABCDEF'.
    80            05 WS-Hex-Digit-CHR                   OCCURS 16 TIMES
    81                                                  PIC X(1).
    82
    83        01  WS-Nibble-SUB                         PIC 9(1) COMP-5.
    84
    85        01  WS-Nibble-Left-SUB                    PIC 9(1) COMP-5.
    86
    87        01  WS-Nibble-Right-SUB                   PIC 9(1) COMP-5.
    88
    89        01  WS-Output-Detail-TXT.
    90            05 WS-OD-Addr-TXT.
    91               10 WS-OD-Addr-Hex-CHR              OCCURS 8 TIMES PIC X.
    92            05 FILLER                             PIC X(1).
    93            05 WS-OD-Relative-Byte-NUM            PIC Z(3)9.
    94            05 FILLER                             PIC X(1).
    95            05 WS-OD-Hex-TXT                      OCCURS 16 TIMES.
    96               10 WS-OD-Hex-1-CHR                 PIC X.
    97               10 WS-OD-Hex-2-CHR                 PIC X.
    98               10 FILLER                          PIC X.
    99            05 WS-OD-ASCII-Data-TXT.
   100               10 WS-OD-ASCII-CHR                 OCCURS 16 TIMES
   101                                                  PIC X.
   102        01  WS-Output-SUB                         PIC 9(2) COMP-5.
   103
   104        >>SOURCE FORMAT IS FREE
   105        01  WS-Output-Header-1-TXT.
   106            05 VALUE '<-Addr-> Byte <---------------- Hexadecimal ''----------------> <---
@end verbatim
@end smallformat
@page
@smallformat
@verbatim
GNUCOBOL 3.1.2 06MAR202 Source Listing                                                2022/03/06
                                                                                     COBDUMP.cbl
Line   Statement                                                                         Page: 3
====== =========================================================================================
   107 - Char ---->' PIC X(80).
   108
   109        01  WS-Output-Header-2-TXT.
   110            05 VALUE '======== ==== =============================================== ======
   111 ==========' PIC X(80).
   112        >>SOURCE FORMAT IS FIXED
   113
   114        LINKAGE SECTION.
   115        01  L-Buffer-TXT                          PIC X ANY LENGTH.
   116
   117        01  L-Buffer-Length-NUM                   USAGE BINARY-LONG.
   118
   119        PROCEDURE DIVISION USING L-Buffer-TXT,
   120                                 OPTIONAL L-Buffer-Length-NUM.
   121        000-Main SECTION.
   122            IF NUMBER-OF-CALL-PARAMETERS = 1
   123                MOVE LENGTH(L-Buffer-TXT) TO WS-Buffer-Length-NUM
   124            ELSE
   125                MOVE L-Buffer-Length-NUM  TO WS-Buffer-Length-NUM
   126            END-IF
   127            MOVE SPACES TO WS-Output-Detail-TXT
   128            SET WS-Addr-PTR TO ADDRESS OF L-Buffer-TXT
   129            PERFORM 100-Generate-Address
   130            MOVE 0 TO WS-Output-SUB
   131            DISPLAY WS-Output-Header-1-TXT UPON SYSERR
   132            DISPLAY WS-Output-Header-2-TXT UPON SYSERR
   133            PERFORM VARYING WS-Buffer-SUB FROM 1 BY 1
   134                      UNTIL WS-Buffer-SUB > WS-Buffer-Length-NUM
   135                ADD 1 TO WS-Output-SUB
   136                IF WS-Output-SUB = 1
   137                    MOVE WS-Buffer-SUB TO WS-OD-Relative-Byte-NUM
   138                END-IF
   139                MOVE L-Buffer-TXT (WS-Buffer-SUB : 1)
   140                  TO WS-OD-ASCII-CHR (WS-Output-SUB)
   141                     WS-Buffer-Byte-CHR
   142                DIVIDE WS-Buffer-Byte-NUM BY 16
   143                    GIVING WS-Nibble-Left-SUB
   144                    REMAINDER WS-Nibble-Right-SUB
   145                ADD 1 TO WS-Nibble-Left-SUB
   146                         WS-Nibble-Right-SUB
   147                MOVE WS-Hex-Digit-CHR (WS-Nibble-Left-SUB)
   148                  TO WS-OD-Hex-1-CHR  (WS-Output-SUB)
   149                MOVE WS-Hex-Digit-CHR (WS-Nibble-Right-SUB)
   150                  TO WS-OD-Hex-2-CHR  (WS-Output-SUB)
   151                IF WS-Output-SUB = 16
   152                    CALL "C$PRINTABLE" USING WS-OD-ASCII-Data-TXT
   153                    DISPLAY WS-Output-Detail-TXT UPON SYSERR
   154                    MOVE SPACES TO WS-Output-Detail-TXT
   155                    MOVE 0 TO WS-Output-SUB
   156                    SET WS-Addr-PTR UP BY 16
   157                    PERFORM 100-Generate-Address
   158                END-IF
   159            END-PERFORM
@end verbatim
@end smallformat
@page
@smallformat
@verbatim
GNUCOBOL 3.1.2 06MAR202 Source Listing                                                2022/03/06
                                                                                     COBDUMP.cbl
Line   Statement                                                                         Page: 4
====== =========================================================================================
   160            IF WS-Output-SUB > 0
   161                CALL "C$PRINTABLE" USING WS-OD-ASCII-Data-TXT
   162                DISPLAY WS-Output-Detail-TXT UPON SYSERR
   163            END-IF
   164            EXIT PROGRAM.
   165
   166        100-Generate-Address SECTION.
   167            MOVE 8 TO WS-Addr-SUB
   168            MOVE WS-Addr-NUM TO WS-Addr-Value-NUM
   169            MOVE ALL '0' TO WS-OD-Addr-TXT
   170            PERFORM WITH TEST BEFORE UNTIL WS-Addr-Value-NUM = 0
   171                DIVIDE WS-Addr-Value-NUM BY 16
   172                    GIVING WS-Addr-Value-NUM
   173                    REMAINDER WS-Nibble-SUB
   174                ADD 1 TO WS-Nibble-SUB
   175                MOVE WS-Hex-Digit-CHR (WS-Nibble-SUB)
   176                  TO WS-OD-Addr-Hex-CHR (WS-Addr-SUB)
   177                SUBTRACT 1 FROM WS-Addr-SUB
   178            END-PERFORM
   179            .
@end verbatim
@end smallformat
@page
@smallformat
@verbatim
GNU COBOL 2.1 23NOV2013 Cross-Reference Listing                                       2014/03/27
                                          C:/Users/tda010/Documents/Programs/Samples/COBDUMP.cbl
PROGRAM-ID      Identifier/Register/Function     Defn   Where Defined   References       Page: 5
=============== ================================ ====== =============== ========================
COBDUMP         000-Main                            116 PROCEDURE
COBDUMP         100-Generate-Address                161 PROCEDURE          124     152
COBDUMP         L-Buffer-Length-NUM                 112 LINKAGE            115     120
COBDUMP         L-Buffer-TXT                        110 LINKAGE            114     118     123
                                                                           134
COBDUMP         NUMBER-OF-CALL-PARAMETERS               PROCEDURE          117
COBDUMP         WS-Addr-NUM                          61 WORKING-STORAGE    163
COBDUMP         WS-Addr-PTR                          60 WORKING-STORAGE     61     123*    151*
COBDUMP         WS-Addr-SUB                          64 WORKING-STORAGE    162*    171     172
COBDUMP         WS-Addr-Value-NUM                    66 WORKING-STORAGE    163*    165     166
                                                                           167*
COBDUMP         WS-Buffer-Byte-CHR                   68 WORKING-STORAGE    136
COBDUMP         WS-Buffer-Byte-NUM                   69 WORKING-STORAGE    137
COBDUMP         WS-Buffer-Length-NUM                 71 WORKING-STORAGE    118*    120*    129
COBDUMP         WS-Buffer-SUB                        73 WORKING-STORAGE    128*    129     132
                                                                           134
COBDUMP         WS-Hex-Digit-CHR                     76 WORKING-STORAGE    142     144     170
COBDUMP         WS-Hex-Digit-TXT                     75 WORKING-STORAGE
COBDUMP         WS-Nibble-Left-SUB                   81 WORKING-STORAGE    138*    140*    142
COBDUMP         WS-Nibble-Right-SUB                  83 WORKING-STORAGE    139*    141*    144
COBDUMP         WS-Nibble-SUB                        79 WORKING-STORAGE    168*    169*    170
COBDUMP         WS-OD-Addr-Hex-CHR                   87 WORKING-STORAGE    171*
COBDUMP         WS-OD-Addr-TXT                       86 WORKING-STORAGE    164*
COBDUMP         WS-OD-ASCII-CHR                      96 WORKING-STORAGE    135*
COBDUMP         WS-OD-ASCII-Data-TXT                 95 WORKING-STORAGE    147C    156C
COBDUMP         WS-OD-Hex-1-CHR                      92 WORKING-STORAGE    143*
COBDUMP         WS-OD-Hex-2-CHR                      93 WORKING-STORAGE    145*
COBDUMP         WS-OD-Hex-TXT                        91 WORKING-STORAGE
COBDUMP         WS-OD-Relative-Byte-NUM              89 WORKING-STORAGE    132*
COBDUMP         WS-Output-Detail-TXT                 85 WORKING-STORAGE    122*    148     149*
                                                                           157
COBDUMP         WS-Output-Header-1-TXT              102 WORKING-STORAGE    126
COBDUMP         WS-Output-Header-2-TXT              105 WORKING-STORAGE    127
COBDUMP         WS-Output-SUB                        99 WORKING-STORAGE    125*    130*    131
@end verbatim
@end smallformat
