Re: Did I write a good (efficient) program?

On Sun, 30 Mar 2008 06:37:28 -0700 (PDT), MikeB <MPBrede@[EMAIL PROTECTED]
> wrote:

>I haven't written COBOL in a number of years and am quite rusty.
>Recently someone asked my help to write some code to display an IP V6
>address in human-readable code. I wrote something, but am not sure if
>I used the best available techniques. Please have a look at what I
>wrote and feel free to comment.
>
>Background. An IP V6 address is 4 words (128-bit) long. It is in
>binary format. For human-readable purposes it is converted into 8
>"octets" separated by colons. leading zeroes in each field are
>suppressed. To compact the address, one or more adjacent octets
>containing all zeroes can be compressed *once* per IP address by
>simply producing a pair of colons.
>
>thus:  76DF:54AE:A30:1:1:4321:EAD5:AA43
>or       FD05::1:0:5 (in this instance 4 octets have been suppressed)
>or even: ::1 (loopback address)
>
>I was under a little time pressure (only had yesterday morning), so I
>haven't figured out the compression part yet. However, that is
>optional, so I'll do it when I have some spare time. In the meantime,
>I'd like to hear from members of this group if I could have written
>cleaner, leaner and more efficient COBOL.

Efficient is Cobolese for fast. In the Good Old Days we had to hold the
machine's hand,
showing it how to go fast. Concern for speed became THE criteria driving
design. As
machines got faster, we kept doing it out of habit and because no one told
us to stop. We
now program as though the year is still 1973, ignoring the fact that the
Pentium 4 on our
desktop is 2,000 times the speed of a 370/158.

http://freespace.virgin.net/roy.longbottom/whetstone.htm


>000300 IDENTIFICATION
>DIVISION.
>000400 PROGRAM-ID.
>IPDISP.
>003200 ENVIRONMENT
>DIVISION.
>003300 DATA
>DIVISION.
>003400 WORKING-STORAGE
>SECTION.
>007212*
>IPV6
>007213 01 HEX-
>VALUES.
>007214  05  FILLER  PIC X(32) VALUE
>"000102030405060708090A0B0C0D0E0F".
>007215  05  FILLER  PIC X(32) VALUE
>"101112131415161718191A1B1C1D1E1F".
>007216  05  FILLER  PIC X(32) VALUE
>"202122232425262728292A2B2C2D2E2F".
>007217  05  FILLER  PIC X(32) VALUE
>"303132333435363738393A3B3C3D3E3F".
>007218  05  FILLER  PIC X(32) VALUE
>"404142434445464748494A4B4C4D4E4F".
>007219  05  FILLER  PIC X(32) VALUE
>"505152535455565758595A5B5C5D5E5F".
>007220  05  FILLER  PIC X(32) VALUE
>"606162636465666768696A6B6C6D6E6F".
>007221  05  FILLER  PIC X(32) VALUE
>"707172737475767778797A7B7C7D7E7F".
>007222  05  FILLER  PIC X(32) VALUE
>"808182838485868788898A8B8C8D8E8F".
>007223  05  FILLER  PIC X(32) VALUE
>"909192939495969798999A9B9C9D9E9F".
>007224  05  FILLER  PIC X(32) VALUE
>"A0A1A2A3A4A5A6A7A8A9AAABACADAEAF".
>007225  05  FILLER  PIC X(32) VALUE
>"B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF".
>007226  05  FILLER  PIC X(32) VALUE
>"C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF".
>007227  05  FILLER  PIC X(32) VALUE
>"D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF".
>007228  05  FILLER  PIC X(32) VALUE
>"E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF".
>007229  05  FILLER  PIC X(32) VALUE
>"F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF".
>007230 01 HEX-TABLE REDEFINES HEX-
>VALUES.
>007231     05  HEX-BYTE    PIC XX OCCURS 256
>TIMES.

The table is awkward and repetitive. All you need is a single copy of the
hex alphabet:

01  hex-alphabet value '0123456789ABCDEF' pic x(16). 

>007232
>007235 01 IP-
>ADDRESS.
>007236     05 IP-ONE      PIC
>X(8).
>007237     05 IP-TWO      PIC
>X(8).
>007238 01  IP-BYTES REDEFINES IP-
>ADDRESS.
>007239     05  IP-BYTE6   PIC X OCCURS 16
>TIMES.
>007240
>007241 01 IP-
>BINARY.
>007242     05  IP-HEX OCCURS 16
>TIMES.
>007243         10  FILLER           PIC X VALUE LOW-
>VALUES.
>007244         10  IP-NUMBER-BINARY PIC
>X.
>007245 01  IP-INDEX REDEFINES IP-
>BINARY.
>007246      05  IP-NUMBER-INDEX     PIC 99 USAGE COMP-5 OCCURS 16
>TIMES.

Replace all that verbosity with:

01  IP-bytes redefines IP-addesses.
     05  IP-binary occurs 16 binary pic 99.


01  left-nybble  binary pic 99.
01  right-nybble binary pic 99.

perform varying IP-index1 from 1 by 1 until IP-index1 > 16
    divide 16 into IP-binary (IP-index1)
       giving left-nybble remainder right-nybble
  compute IP-index2 = IP-index1 * 2
   move hex-alphabet (left-nybble + 1: 1) to IP-display-byte (IP-index-2:
1)
   move hex-alphabet (right-nybble + 1:1) to IP-display-byte (IP-index-2 +
1: 1)
end-perform


>046562            MOVE ZEROES TO FLD-START
>      * count leading zeroes
>046563            INSPECT IP-OCTET(IP-INDEX1) TALLYING FLD-
>START
>046564              FOR LEADING "0"
>046576            IF FLD-START =
>4
>046577               THEN
>      * if the entire field are zeroes, then simply display "0:"
>      *at a later stage figure out the IP compaction convention
>      * of allowing one or more zero address fields to be compacted
>*once* per
>      * address into a sequence of
>"::"
>046578                   MOVE "0:" TO IP-PRINT-FIELD(IP-PRINT-POSITION:
>2)
>046579                   ADD 2 TO IP-PRINT-
>POSITION
>046586               ELSE
>      * only suppress leading zeroes
>      * how many bytes to move?
>046587                   COMPUTE FLD-LENGTH = (4 - FLD-START)
>      * move them into the display field
>046598                   MOVE IP-OCTET(IP-INDEX1)(FLD-START + 1:FLD-
>LENGTH)
>046599                      TO IP-PRINT-FIELD(IP-PRINT-POSITION:fld-
>length)
>      * calculate next position in display field
>046600                   COMPUTE IP-PRINT-POSITION = (IP-PRINT-
>POSITION + fld-length)
>      * add a colon (":")
>046601                   MOVE ":" TO IP-PRINT-FieLD(IP-PRINT-POSITION:
>1)
>      * bump position in display field
>046602                   ADD 1 TO IP-PRINT-
>POSITION
>046613               END-
>IF
>046614            END-PERFORM

          move 1 to fld-start
           inspect IP-octet (IP-index1)  tallying fld-start for leading
zero
           compute fld-length = length of IP-octet - fld-start + 1
           string IP-octet(IP-index1) (fld-start: fld-length) ':'
               delimited by size into
IP-print-field(IP-print-position:fld-length+1)
          add fld-length, 1 to IP-print-position