Joined: 09 Mar 2011 Posts: 7309 Location: Inside the Matrix
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.
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-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
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-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).
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
