Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Junk values buster Program

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
Bill Woodger

DFSORT Moderator


Joined: 09 Mar 2011
Posts: 7251

PostPosted: Thu Sep 15, 2011 7:29 pm    Post subject: Junk values buster Program
Reply with quote

I've included a little program here. You call it with a field, the length of the field (comp pic s9(8)) and a little control block (get real professional and make a copybook).

So, CALL "UGLY" USING field, length-of-field, control-block

Why is it called UGLY? Well, I made it ugly after I wrote it, so that the generators of junk values will find it more to their coding style.

It will display in either 80 or 132 columns.

It displays a "scale" that is the length of the actual data displayed on that line.

If you have a table, you can display the whole table, set the value of L-G to the length of the occurs in the table and the table will display with the occurences one at a time. For this to work usefully, the length of the occurs has to be less than the 80/132 you are displaying at.

If you want some fun, or have a need, you can display the whole of your working-storage. Some might even be able to sensibly display parts of the procedure, or other interesting things.

If anyone is thinking of using this, wait until later when I post the real program... unless you really, really, like this style :-)

The uglification of this program is of course to demonstrate the usefullness of meaningful names.

If anyone would like to comment on this version of the program, I will consign those comments immediately to the CAQ.


Code:

       IDENTIFICATION DIVISION.
       PROGRAM-ID. UGLY.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  W-A                      PIC X(8)BX(8).

       01  W-B            USAGE IS INDEX.
       01  W-C          USAGE IS INDEX.

       01  W-D              PIC S9(9).
       01  FILLER REDEFINES W-D.
           05  FILLER                           PIC X(5).
           05  W-E         PIC 9(4).
       01  W-F PIC X VALUE "Y".
           88  W-F-Y VALUE "Y".
           88  W-F-N VALUE "N".

       01  W-G         COMP    PIC S9(4) VALUE ZERO.
       01  FILLER REDEFINES W-G.
           05  FILLER                           PIC X.
           05  W-H                      PIC X.

       01  W-I         COMP    PIC S9(4).
       01  W-J        COMP    PIC S9(4).
       01  W-K            COMP    PIC S9(4).
       
       01  W-L              COMP    PIC S9(4).
       01  W-M VALUE "ABCDEF".
           05  FILLER OCCURS 6 TIMES
                INDEXED BY I.
               10  W-N                  PIC X.

       01  W-O.
           05  W-P                       PIC X.
           05  W-Q                      PIC X.

       01  W-R.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-K
               INDEXED BY J.
               10  W-S        PIC X.
                   88  W-S-Y
                                                VALUE SPACE.
       01  W-T.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-K
               INDEXED BY K.
               10  W-U       PIC X.

       01  W-V.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-K
               INDEXED BY L.
               10  W-W            PIC X.
       01  W-X   COMP   PIC S9(4).

       01  W-Y                PIC X.
       01  W-Z
             REDEFINES W-Y    PIC 9.

       01  W-AA           PIC 9(4).
       01  FILLER REDEFINES W-AA.
           05  FILLER                           PIC XXX.
           05  W-AB      PIC 9.

       01  W-AC.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-K.
               10  FILLER                       PIC X.

       01  W-AD.
           05  FILLER                           PIC X(10) VALUE
               "----+----1".
           05  FILLER                           PIC X(10) VALUE
               "----+----2".
           05  FILLER                           PIC X(10) VALUE
               "----+----3".
           05  FILLER                           PIC X(10) VALUE
               "----+----4".
           05  FILLER                           PIC X(10) VALUE
               "----+----5".
           05  FILLER                           PIC X(10) VALUE
               "----+----6".
           05  FILLER                           PIC X(10) VALUE
               "----+----7".
           05  FILLER                           PIC X(10) VALUE
               "----+----8".
           05  FILLER                           PIC X(10) VALUE
               "----+----9".
           05  FILLER                           PIC X(10) VALUE
               "----+----0".
           05  FILLER                           PIC X(10) VALUE
               "----+----1".
           05  FILLER                           PIC X(10) VALUE
               "----+----2".
           05  FILLER                           PIC X(10) VALUE
               "----+----3".
           05  FILLER                           PIC X(02) VALUE
               "--".

       LINKAGE SECTION.

       01  L-A PIC X.

       01  L-B REDEFINES L-A.
           05  FILLER OCCURS 99999999 TIMES
                 INDEXED BY M.
               10  L-C PIC X.

       01  L-D COMP PIC S9(8).

       01  L-E.
           05  L-F         COMP PIC S9(4) VALUE +80.
               88  L-F-VALID    VALUE +80 +132.
           05  L-G     COMP PIC S9(4) VALUE ZERO.
               88  L-G-Y VALUE ZERO.
           05  FILLER                            PIC X(96) VALUE SPACE.


       PROCEDURE DIVISION USING         L-A
                                        L-D
                                        L-E
                                        .
       00-A SECTION.
           IF W-F-Y
               MOVE WHEN-COMPILED       TO W-A
               DISPLAY                  "UGLY program compiled on "
                                        W-A
               SET W-F-N                TO TRUE
           END-IF

           IF ( NOT L-F-VALID )
               DISPLAY "UGLY maximum line length should be 80 or 132"
               DISPLAY "UGLY found>" L-F "<"
               CALL "FOODUMP"
           END-IF
           IF L-G-Y
               MOVE L-F                 TO W-K
           ELSE
               IF ( L-G
                   GREATER THAN L-F )
                   DISPLAY "UGLY Sorry, chunks ignored, too big"
                   DISPLAY "UGLY Chunks>" L-G "<"
                   DISPLAY "UGLY Maxlen>" L-F "<"
                   MOVE L-F             TO W-K
               ELSE
                   MOVE L-G             TO W-K
               END-IF
           END-IF   
           SET L                        TO W-K
           SET W-B                      TO L
           SET J
               K   
               L                       TO ZERO

           PERFORM                      00-B
             VARYING                    M
             FROM                       1
             BY                         1
             UNTIL                      M
               GREATER THAN             L-D

                 
           IF ( NOT W-S-Y )
               SET W-C                  TO J
               MOVE W-C                 TO W-D
               MOVE W-E                 TO W-K
               PERFORM                  00-D
           END-IF

           GOBACK
           .
       00-B SECTION.

           MOVE L-C
                 ( M )
                                        TO W-H

           DIVIDE W-G                   BY 16
             GIVING                     W-I
             REMAINDER                  W-J

           MOVE W-I                     TO W-X
           PERFORM                      00-C
           MOVE W-Y                     TO W-P
           MOVE W-J                     TO W-X
           PERFORM                      00-C
           MOVE W-Y                     TO W-Q

           SET J
               K
               L                        UP BY +1

           IF ( J GREATER THAN W-B )
               PERFORM                  00-D
               MOVE SPACE               TO W-R
                                           W-U
               SET J
                   K
                   L
                                        TO +1
           END-IF

           MOVE W-P                     TO W-S
                                            ( J )
           MOVE W-Q                     TO W-U
                                            ( K )
           MOVE W-H                     TO W-W
                                            ( L )
           .
       00-C SECTION.

           IF ( W-X GREATER THAN 9 )
               SUBTRACT 9               FROM W-X
                 GIVING                 W-L     
               SET I                    TO W-L
               MOVE W-N ( I )           TO W-Y
           ELSE
               MOVE W-X                 TO W-AA
               MOVE W-AB                TO W-Z
           END-IF

           .
       00-D SECTION.

           MOVE W-AD                    TO W-AC
           DISPLAY                      W-AC

           DISPLAY                      W-V
           DISPLAY                      W-R
           DISPLAY                      W-T
           .
Back to top
View user's profile Send private message

dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne

PostPosted: Thu Sep 15, 2011 7:40 pm    Post subject:
Reply with quote

you would fit right in at my shop.
Back to top
View user's profile Send private message
Bill Woodger

DFSORT Moderator


Joined: 09 Mar 2011
Posts: 7251

PostPosted: Thu Sep 15, 2011 8:08 pm    Post subject: Reply to: Junk values buster
Reply with quote

Not me, unfortunately, this program. Which, in this state, I'd disown...

I remember learning a couple of languages at school which only had two characters available for names. I grew up when I started work.
Back to top
View user's profile Send private message
Bill Woodger

DFSORT Moderator


Joined: 09 Mar 2011
Posts: 7251

PostPosted: Fri Sep 16, 2011 11:12 am    Post subject:
Reply with quote

Here's the proper program with the proper names.

Code:

       IDENTIFICATION DIVISION.
       PROGRAM-ID. BBHEXD.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  W-WHEN-COMPILED                      PIC X(8)BX(8).

       01  W-DISPLAY-HEX-MAX-UIND      USAGE IS INDEX.
       01  W-FIRST-TIME-FLAG                    PIC X VALUE "Y".
           88  W-FIRST-TIME-IN-PROGRAM          VALUE "Y".
           88  W-NOT-FIRST-TIME-FLAG            VALUE "N".

       01  W-WORK-BYTE-FOR-CALC         COMP    PIC S9(4) VALUE ZERO.
       01  FILLER REDEFINES W-WORK-BYTE-FOR-CALC.
           05  FILLER                           PIC X.
           05  W-WORK-BYTE                      PIC X.

       01  W-LEFT-HALF-BYTE-NUM         COMP    PIC S9(4).
       01  W-RIGHT-HALF-BYTE-NUM        COMP    PIC S9(4).
       01  W-BYTES-TO-OUTPUT            COMP    PIC S9(4).
       01  W-BYTES-MOVED                COMP    PIC S9(4).
       
       01  W-HEX-ALPHA-SUB              COMP    PIC S9(4).
       01  W-HEX-ALPHA-TABLE VALUE "ABCDEF".
           05  FILLER OCCURS 6 TIMES
                INDEXED BY W-HEX-ALPHA-IDX.
               10  W-HEX-ALPHA                  PIC X.

       01  W-DISPLAY-HEX.
           05  W-LEFT-HEX                       PIC X.
           05  W-RIGHT-HEX                      PIC X.

       01  W-HEX-TO-DISPLAY-LEFT-TABLE VALUE SPACE.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-BYTES-TO-OUTPUT
               INDEXED BY W-DISPLAY-HEX-LEFT-IND.
               10  W-HEX-TO-DISPLAY-LEFT        PIC X.
                   88  W-HEX-TO-DISPLAY-LEFT-IS-EMPTY
                                                VALUE SPACE.
       01  W-HEX-TO-DISPLAY-RIGHT-TABLE VALUE SPACE.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-BYTES-TO-OUTPUT
               INDEXED BY W-DISPLAY-HEX-RIGHT-IND.
               10  W-HEX-TO-DISPLAY-RIGHT       PIC X.

       01  W-BYTE-TO-DISPLAY-TABLE VALUE SPACE.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-BYTES-TO-OUTPUT
               INDEXED BY W-DISPLAY-BYTE-IND.
               10  W-BYTE-TO-DISPLAY            PIC X.
       01  W-CONVERT-TO-HEX-FROM-DIGIT   COMP   PIC S9(4).

       01  W-CONVERTED-HEX-DIGIT                PIC X.
       01  W-CONVERTED-HEX-DIGIT-NUM
             REDEFINES W-CONVERTED-HEX-DIGIT    PIC 9.

       01  W-CONVERTED-HEX-DIGIT-NUM4           PIC 9(4).
       01  FILLER REDEFINES W-CONVERTED-HEX-DIGIT-NUM4.
           05  FILLER                           PIC XXX.
           05  W-CONVERTED-HEX-DIGIT-NUM4L      PIC 9.

       01  W-COLS-LINE.
           05  FILLER OCCURS 1 TO 132 TIMES
               DEPENDING ON W-BYTES-TO-OUTPUT.
               10  FILLER                       PIC X.

       01  W-COLS-TABLE.
           05  FILLER                           PIC X(10) VALUE
               "----+----1".
           05  FILLER                           PIC X(10) VALUE
               "----+----2".
           05  FILLER                           PIC X(10) VALUE
               "----+----3".
           05  FILLER                           PIC X(10) VALUE
               "----+----4".
           05  FILLER                           PIC X(10) VALUE
               "----+----5".
           05  FILLER                           PIC X(10) VALUE
               "----+----6".
           05  FILLER                           PIC X(10) VALUE
               "----+----7".
           05  FILLER                           PIC X(10) VALUE
               "----+----8".
           05  FILLER                           PIC X(10) VALUE
               "----+----9".
           05  FILLER                           PIC X(10) VALUE
               "----+----0".
           05  FILLER                           PIC X(10) VALUE
               "----+----1".
           05  FILLER                           PIC X(10) VALUE
               "----+----2".
           05  FILLER                           PIC X(10) VALUE
               "----+----3".
           05  FILLER                           PIC X(02) VALUE
               "--".

       LINKAGE SECTION.

       01  L-DATA-LENGTH COMP PIC S9(8).

       01  L-BBHEXD-CONTROL-BLOCK.
           05  L-BBHEXD-CB-MAX-LINE         COMP PIC S9(4) VALUE +80.
               88  L-BBHEXD-CB-MAX-LINE-VALID    VALUE +80 +132.
           05  L-BBHEXD-CB-CHUNK-LENGTH     COMP PIC S9(4) VALUE ZERO.
               88  L-BBHEXD-CB-CHUNK-LENGTH-ZERO VALUE ZERO.
           05  FILLER                            PIC X(96) VALUE SPACE.

       01  L-DATA-PICX1-FOR-USING PIC X.

       01  L-DATA-TO-DISPLAY REDEFINES L-DATA-PICX1-FOR-USING.
           05  FILLER OCCURS 99999999 TIMES
                 INDEXED BY L-DTD-BYTE-FOR-C-AND-C-IDX.
               10  L-DTD-BYTE-FOR-CONV-AND-COPY PIC X.


       PROCEDURE DIVISION USING
                                        L-DATA-PICX1-FOR-USING
                                        L-DATA-LENGTH
                                        L-BBHEXD-CONTROL-BLOCK
                                        .
       00-CONTROL SECTION.

           PERFORM                      10-FIRST-TIME
           PERFORM                      30-CNV-LK-DATA-TO-HEX-AND-DISP
           GOBACK
           .
       10-FIRST-TIME SECTION.

           IF W-FIRST-TIME-IN-PROGRAM
               PERFORM                  10A-SAY-WHO-WE-ARE
               SET W-NOT-FIRST-TIME-FLAG
                                        TO TRUE
           END-IF

           PERFORM                      10D-CHECK-OUTPUT-LENGTH
           PERFORM                      10G-SET-OUTPUT-LNGTH-AND-CHUNK
           .
       10A-SAY-WHO-WE-ARE SECTION.

           MOVE WHEN-COMPILED           TO W-WHEN-COMPILED
           DISPLAY "BBHEXD This program compiled on "
                                        W-WHEN-COMPILED
           .
       10D-CHECK-OUTPUT-LENGTH SECTION.

           IF ( NOT L-BBHEXD-CB-MAX-LINE-VALID )
               DISPLAY "BBHEXD maximum line length should be 80 or 132"
               DISPLAY "BBHEXD found>" L-BBHEXD-CB-MAX-LINE "<"
               CALL "FOODUMP"
           END-IF
           .
       10G-SET-OUTPUT-LNGTH-AND-CHUNK SECTION.

           IF L-BBHEXD-CB-CHUNK-LENGTH-ZERO
               MOVE L-BBHEXD-CB-MAX-LINE
                                        TO W-BYTES-TO-OUTPUT
           ELSE
               IF ( L-BBHEXD-CB-CHUNK-LENGTH
                   GREATER THAN L-BBHEXD-CB-MAX-LINE )
                   DISPLAY "BBHEXD Sorry, chunks ignored, too big"
                   DISPLAY "BBHEXD Chunks>" L-BBHEXD-CB-CHUNK-LENGTH "<"
                   DISPLAY "BBHEXD Maxlen>" L-BBHEXD-CB-MAX-LINE "<"
                   MOVE L-BBHEXD-CB-MAX-LINE
                                        TO W-BYTES-TO-OUTPUT
               ELSE
                   MOVE L-BBHEXD-CB-CHUNK-LENGTH
                                        TO W-BYTES-TO-OUTPUT
               END-IF
           END-IF

           SET W-DISPLAY-BYTE-IND       TO W-BYTES-TO-OUTPUT
           SET W-DISPLAY-HEX-MAX-UIND   TO W-DISPLAY-BYTE-IND

           IF L-DATA-LENGTH EQUAL TO ZERO
               DISPLAY "BBHEXD You want to display zero bytes?"
               DISPLAY "BBHEXD Do not expect to see them"
           END-IF
           .
       30-CNV-LK-DATA-TO-HEX-AND-DISP SECTION.

           SET W-DISPLAY-HEX-LEFT-IND
               W-DISPLAY-HEX-RIGHT-IND   
               W-DISPLAY-BYTE-IND       TO +1
           MOVE ZERO                    TO W-BYTES-MOVED

           PERFORM                      30A-BYTE-BY-BYTE-CONVERT
             VARYING                    L-DTD-BYTE-FOR-C-AND-C-IDX
             FROM                       1
             BY                         1
             UNTIL                      L-DTD-BYTE-FOR-C-AND-C-IDX
               GREATER THAN             L-DATA-LENGTH

           IF ( W-BYTES-MOVED NOT EQUAL TO ZERO )
               MOVE W-BYTES-MOVED       TO W-BYTES-TO-OUTPUT
               PERFORM                  99A-DISPLAY-PART-OF-OUTPUT
           END-IF

           .
       30A-BYTE-BY-BYTE-CONVERT SECTION.

           MOVE L-DTD-BYTE-FOR-CONV-AND-COPY
                 ( L-DTD-BYTE-FOR-C-AND-C-IDX )
                                        TO W-WORK-BYTE

           DIVIDE W-WORK-BYTE-FOR-CALC  BY 16
             GIVING                     W-LEFT-HALF-BYTE-NUM
             REMAINDER                  W-RIGHT-HALF-BYTE-NUM

           MOVE W-LEFT-HALF-BYTE-NUM    TO W-CONVERT-TO-HEX-FROM-DIGIT
           PERFORM                      30AA-CONVERT-HALF-BYTE
           MOVE W-CONVERTED-HEX-DIGIT   TO W-LEFT-HEX
           MOVE W-RIGHT-HALF-BYTE-NUM   TO W-CONVERT-TO-HEX-FROM-DIGIT
           PERFORM                      30AA-CONVERT-HALF-BYTE
           MOVE W-CONVERTED-HEX-DIGIT   TO W-RIGHT-HEX

           IF ( W-DISPLAY-HEX-LEFT-IND
               GREATER THAN W-DISPLAY-HEX-MAX-UIND )
               PERFORM                  99A-DISPLAY-PART-OF-OUTPUT
               SET W-DISPLAY-HEX-LEFT-IND
                   W-DISPLAY-HEX-RIGHT-IND
                   W-DISPLAY-BYTE-IND
                                        TO +1
           END-IF

           MOVE W-LEFT-HEX              TO W-HEX-TO-DISPLAY-LEFT
                                            ( W-DISPLAY-HEX-LEFT-IND )
           MOVE W-RIGHT-HEX             TO W-HEX-TO-DISPLAY-RIGHT
                                            ( W-DISPLAY-HEX-RIGHT-IND )
           MOVE W-WORK-BYTE             TO W-BYTE-TO-DISPLAY
                                            ( W-DISPLAY-BYTE-IND )
           ADD +1                       TO W-BYTES-MOVED
           SET W-DISPLAY-HEX-LEFT-IND
               W-DISPLAY-HEX-RIGHT-IND
               W-DISPLAY-BYTE-IND       UP BY +1
           .
       30AA-CONVERT-HALF-BYTE SECTION.

           IF ( W-CONVERT-TO-HEX-FROM-DIGIT GREATER THAN 9 )
               SUBTRACT 9               FROM W-CONVERT-TO-HEX-FROM-DIGIT
                 GIVING                 W-HEX-ALPHA-SUB     
               SET W-HEX-ALPHA-IDX      TO W-HEX-ALPHA-SUB
               MOVE W-HEX-ALPHA ( W-HEX-ALPHA-IDX )
                                        TO W-CONVERTED-HEX-DIGIT
           ELSE
               MOVE W-CONVERT-TO-HEX-FROM-DIGIT
                                        TO W-CONVERTED-HEX-DIGIT-NUM4
               MOVE W-CONVERTED-HEX-DIGIT-NUM4L
                                        TO W-CONVERTED-HEX-DIGIT-NUM
           END-IF

           .
       99A-DISPLAY-PART-OF-OUTPUT SECTION.

           MOVE W-COLS-TABLE            TO W-COLS-LINE
           DISPLAY                      W-COLS-LINE

           DISPLAY                      W-BYTE-TO-DISPLAY-TABLE
           DISPLAY                      W-HEX-TO-DISPLAY-LEFT-TABLE
           DISPLAY                      W-HEX-TO-DISPLAY-RIGHT-TABLE
           MOVE SPACE                   TO W-BYTE-TO-DISPLAY-TABLE
                                           W-HEX-TO-DISPLAY-LEFT-TABLE
                                           W-HEX-TO-DISPLAY-RIGHT-TABLE
           MOVE ZERO                    TO W-BYTES-MOVED

           .
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Executing OO COBOL program invoking J... Virendra Shambharkar COBOL Programming 2 Tue Jan 10, 2017 6:37 pm
No new posts Need Suggestion on COBOL program vickey_dw COBOL Programming 5 Thu Jan 05, 2017 10:55 pm
No new posts SQL query to run through list of valu... Ni3-db2 DB2 14 Wed Dec 14, 2016 9:52 am
No new posts I can not compile my program PL1 V3.R... Miguel Fernandez PL/I & Assembler 13 Tue Dec 06, 2016 8:30 pm
No new posts IMS BMP program causes 878 system abend Artemk IMS DB/DC 7 Tue Nov 22, 2016 8:26 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us