Did I write a good (efficient) program?
in [Cobol]
|
From: MikeB on 30 Mar 2008 09:37 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. Thanks. ----------------------------------------------------------------------------------------------------------- 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. 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. 007247 007248 01 IP- DISPLAY. 007249 05 IP-DISPLAY-BYTE PIC XX OCCURS 16 TIMES. 007250 01 IP-OCTETS REDEFINES IP- DISPLAY. 007251 05 IP-OCTET PIC X(4) OCCURS 8 TIMES. 007252 007253 01 IP-PRINT-FIELD PIC X(40) VALUE SPACE. 007256 007257 01 IP-INDEX1 PIC S9(4) COMP VALUE ZERO. 007258 01 HEX-INDEX1 PIC S9(4) COMP VALUE ZERO. 007259 01 IP-PRINT-POSITION PIC S9(4) COMP VALUE ZERO. 007260 01 FLD-START PIC S9(4) COMP VALUE ZERO. 007261 01 FLD-LENGTH PIC S9(4) COMP VALUE ZERO. 030600 030700 PROCEDURE DIVISION. * for each of the 16 bytes in the IPV6 address: 046522 PERFORM VARYING IP-INDEX1 FROM 1 BY 1 046523 UNTIL IP-INDEX1 > 16 * move a byte into a two-byte field that can be used as a number 046524 MOVE IP-BYTE6(IP- INDEX1) 046525 TO IP-NUMBER-BINARY(IP-INDEX1) * bump the number up to be used as an index into the array 046532 ADD 1 TO IP-NUMBER-INDEX(IP- INDEX1) 046533 GIVING HEX-INDEX1 * move the indicated bytes in the array (translation table) to the * display field 046540 MOVE HEX-BYTE(HEX- INDEX1) 046541 TO IP-DISPLAY-BYTE(IP- INDEX1) 046554 END- PERFORM 046555 046556 MOVE 1 TO IP-PRINT- POSITION 046557 MOVE SPACES TO IP-PRINT- FIELD 046558 * IP V6 addresses are formatted as half-word "octets" dearated by * colons (":") and with leading zeroes suppressed. * * for each of the 8 octets: 046560 PERFORM VARYING IP-INDEX1 FROM 1 BY 1 046561 UNTIL IP-INDEX1 > 8 * set tally field to zero 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
From: Doug Miller on 30 Mar 2008 11:09 In article <408bb0cb-b47e-43b4-b4f0-b604d6c36a3e(a)p25g2000hsf.googlegroups.com>, MikeB <MPBrede(a)gmail.com> wrote: Please repost in a more easily readable form. >000300 IDENTIFICATION >DIVISION. >000400 PROGRAM-ID. >IPDISP. >003200 ENVIRONMENT >DIVISION. >003300 DATA >DIVISION. >003400 WORKING-STORAGE >SECTION. -- Regards, Doug Miller (alphageek at milmac dot com) It's time to throw all their damned tea in the harbor again.
From: Rick Smith on 30 Mar 2008 12:47 "MikeB" <MPBrede(a)gmail.com> wrote in message news:408bb0cb-b47e-43b4-b4f0-b604d6c36a3e(a)p25g2000hsf.googlegroups.com... [snip] > In the meantime, > I'd like to hear from members of this group if I could have written > cleaner, leaner and more efficient COBOL. I can not say that it meets all the criteria but here is another way to have done it. It uses intrinsic functions and STRING to do ... uh ... character and string manipulation. Showing the PROCEDURE DIVISION only. ----- PROCEDURE DIVISION. * 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 MOVE 1 TO IP-PRINT-POSITION MOVE SPACES TO IP-PRINT-FIELD PERFORM VARYING IP-INDEX1 FROM 8 BY -1 UNTIL IP-INDEX1 < 1 inspect ip-octet(ip-index1)(1:3) replacing leading zeros by spaces string function reverse (ip-octet(ip-index1)) delimited by spaces ":" delimited by size into ip-print-field with pointer ip-print-position END-PERFORM * Reverse the string subtract 2 from ip-print-position move function reverse (ip-print-field(1:ip-print-position)) to ip-print-field stop run . -----
From: Rick Smith on 31 Mar 2008 19:20 "MikeB" <MPBrede(a)gmail.com> wrote in message news:408bb0cb-b47e-43b4-b4f0-b604d6c36a3e(a)p25g2000hsf.googlegroups.com... [snip] > 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 . -----
From: MikeB on 30 Mar 2008 14:52
On Mar 30, 10:09 am, spamb...(a)milmac.com (Doug Miller) wrote: > In article <408bb0cb-b47e-43b4-b4f0-b604d6c36...(a)p25g2000hsf.googlegroups.com>, MikeB <MPBr...(a)gmail.com> wrote: > > Please repost in a more easily readable form. Yikes, what's up with that? Sorry. I'll try again, but I'm posting from Google Groups and I fear I'm not in control of linebreaks and other stuff. So I put it on http://mpbrede.googlepages.com/coboltext in text format and downloadable. Sorry for the inconvenience. |