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

"MikeB" <MPBrede@[EMAIL PROTECTED]
> wrote in message
news:408bb0cb-b47e-43b4-b4f0-b604d6c36a3e@[EMAIL PROTECTED]
>  Please have a look at what I
> wrote and feel free to comment.
[snip]
> 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.

I am not feeling pressured and have a lot of time, so ...
I rewrote your program adding the compression part
and wrote a test program to call it. The results are as
expected.

----- Results
76DF:54AE:A30:1:1:4321:EAD5:AA43
FD05::1:0:5
::1
----- Test program
       program-id. iptest.
       data division.
       working-storage section.
       01 ip-address pic x(16) value space.
       01 ip-print-field pic x(40) value spaces.
       procedure division.
           string x"76DF54AE0A30000100014321EAD5AA43"
               delimited by size
               into ip-address
           call "ipdisp" using ip-address ip-print-field
           display ip-print-field
           string x"FD050000000000000000000100000005"
               delimited by size
               into ip-address
           call "ipdisp" using ip-address ip-print-field
           display ip-print-field
           string x"00000000000000000000000000000001"
               delimited by size
               into ip-address
           call "ipdisp" using ip-address ip-print-field
           display ip-print-field
           stop run
           .
----- Your updated program
       IDENTIFICATION DIVISION.
       PROGRAM-ID. IPDISP.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
      * IPV6
       01 HEX-VALUES.
        05  PIC X(32) VALUE "000102030405060708090A0B0C0D0E0F".
        05  PIC X(32) VALUE "101112131415161718191A1B1C1D1E1F".
        05  PIC X(32) VALUE "202122232425262728292A2B2C2D2E2F".
        05  PIC X(32) VALUE "303132333435363738393A3B3C3D3E3F".
        05  PIC X(32) VALUE "404142434445464748494A4B4C4D4E4F".
        05  PIC X(32) VALUE "505152535455565758595A5B5C5D5E5F".
        05  PIC X(32) VALUE "606162636465666768696A6B6C6D6E6F".
        05  PIC X(32) VALUE "707172737475767778797A7B7C7D7E7F".
        05  PIC X(32) VALUE "808182838485868788898A8B8C8D8E8F".
        05  PIC X(32) VALUE "909192939495969798999A9B9C9D9E9F".
        05  PIC X(32) VALUE "A0A1A2A3A4A5A6A7A8A9AAABACADAEAF".
        05  PIC X(32) VALUE "B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF".
        05  PIC X(32) VALUE "C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF".
        05  PIC X(32) VALUE "D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF".
        05  PIC X(32) VALUE "E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF".
        05  PIC X(32) VALUE "F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF".
       01 HEX-TABLE REDEFINES HEX-VALUES.
           05  HEX-BYTE    PIC XX OCCURS 256 TIMES.

       01 IP-ADDRESS.
           05 IP-ONE      PIC X(8).
           05 IP-TWO      PIC X(8).
       01  IP-BYTES REDEFINES IP-ADDRESS.
           05  IP-BYTE6   PIC X OCCURS 16 TIMES.

       01  IP-OCTETS.
           05  IP-OCTET             PIC X(4) OCCURS 8 TIMES.

       01  IP-PRINT-FIELD   PIC X(40) VALUE SPACE.

       01 ip-compress-state comp-5 pic s9(4) value 0.
       01  ip-octets-ptr comp-5 pic s9(4) value 0.
       01  IP-INDEX1                        PIC S9(4) COMP VALUE ZERO.
       01  HEX-INDEX1                       PIC S9(4) COMP VALUE ZERO.
       01  IP-PRINT-POSITION                PIC S9(4) COMP VALUE ZERO.

       linkage section.
       01 ls-ip-address pic x(16).
       01 ls-ip-print-field pic x(40).

       PROCEDURE DIVISION using ls-ip-address ls-ip-print-field.
           move ls-ip-address to ip-address

      * Expand 16 byte IP-ADDRESS to
      * 32 character hex display in IP-OCTETS

           move 1 to ip-octets-ptr
           perform
           varying ip-index1 from 1 by 1
           until ip-index1 > 16
               compute hex-index1 =
                   function ord (ip-address(ip-index1:1))
               string
                   hex-byte (hex-index1) delimited by size
               into ip-octets
               with pointer ip-octets-ptr
           end-perform

      * IP V6 addresses are formatted as 16-bit "octets" delimited by
      * colons (":") and with leading zeroes suppressed.
      *
      * Leading zeros are replaced by spaces then
      * formatting is done in reverse to suppress these spaces

           PERFORM VARYING IP-INDEX1 FROM 1 BY 1
                   UNTIL IP-INDEX1 > 8
               inspect ip-octet(ip-index1)(1:3)
               replacing leading zeros by spaces
           end-perform

      * Compress adjacent "   0"s, once

           move 1 to ip-compress-state
           perform
           varying ip-index1 from 1 by 4
           until ip-index1 > 28
               evaluate ip-compress-state
               when 1
                   if ip-octets (ip-index1:4) = "   0"
                       and ip-octets (ip-index1 + 4:4) = "   0"
                   then
                       move spaces to ip-octets (ip-index1:4)
                       move ":   " to ip-octets (ip-index1 + 4:4)
                       move 2 to ip-compress-state
                   else
                       move 1 to ip-compress-state
                   end-if
               when 2
                   if ip-octets (ip-index1:4) = ":   "
                       and ip-octets (ip-index1 + 4:4) = "   0"
                   then
                       move spaces to ip-octets (ip-index1:4)
                       move ":   " to ip-octets (ip-index1 + 4:4)
                       move 2 to ip-compress-state
                   else
                       move 3 to ip-compress-state
                   end-if
               when 3
                   continue
               end-evaluate
           end-perform

      * This is sufficient when leading IP compression
      * is partial but loses a ":" when IP compression
      * is complete. The following corrects for that

           move 0 to ip-index1
           inspect ip-octets tallying
               ip-index1 for characters before ":"
           if ip-index1 < 32
               and ip-octets (1:ip-index1) = spaces
           then
               inspect ip-octets replacing
                   first ":   " by "   :"
           end-if

      * Remove the spaces and insert a ":" after each group
      * of 4 from IP-OCTETS. ":" for field compression is in
      * the data from IP-OCTETS.

           MOVE 0 TO IP-PRINT-POSITION
           MOVE SPACES TO IP-PRINT-FIELD
           perform
           varying ip-index1 from 1 by 1
           until ip-index1 > 32
               if ip-octets (ip-index1:1) not = space
               then
                   add 1 to ip-print-position
                   move ip-octets (ip-index1:1)
                       to ip-print-field (ip-print-position:1)
               end-if
               evaluate
                   function mod (ip-index1 4) = 0
                   also ip-index1
               when true also not 32
                   if ip-octets (ip-index1:1) not = space
                   then
                       add 1 to ip-print-position
                       move ":"
                           to ip-print-field (ip-print-position:1)
                   end-if
               when other
                   continue
               end-evaluate
           END-PERFORM

           move ip-print-field to ls-ip-print-field
           exit program
           .
-----