COBOL tool

I need a tool that can analyse the source of a COBOL record layout and
calculate the offset and length (true length occupied in bytes, not the
virtual length implied in the picture... for example, "pic s9(7)v99 comp-3"
has a virtual length of 9 digits but occupies 5 actual bytes), for each
field defined in the definition, including group fields and REDEFINEd and
OCCURring fields.

If anyone has code that does this and is prepared to share it, mail it to
me. I'll wrap it for windows with a GUI front end and put it on a server for
freeware download so that everyone can use it. The idea is that you could
select with the mouse all or part of a COBOL record layout viewed in your
Editor of choice, and have a popup window that would give you the offset and
length of each selected field and the total length overall. (It may be a
requirement that selection starts from the 01 level, or not, depends on how
your code works...)

So the code should be able to accept or read COBOL Data Division source as
input, and output a simple text list with an entry for each dataname showing
the offset and length of it. (The offset represents the total bytes
preceding the field, so the total length of a record definition is easily
obtained, and saves all that very tedious counting or searching for the
compiler output.)

I already have some COBOL code that parses COBOL source and analyses
pictures. I can amend it to do this as well, but it is tricky and would not
be publicly available.

Please express interest here if you think you want to have a go at this.

If no-one is up for it, I'll write it myself in C#, when I get time. :-)

Pete.
--
"I used to write COBOL...now I can do anything."

On Aug 30, 12:07*pm, "Pete Dashwood"
<dashw...@removethis.enternet.co.nz> wrote:
> I need a tool that can analyse the source of a COBOL record layout and
> calculate the offset and length (true length occupied in bytes, not the
> virtual length implied in the picture... for example, "pic s9(7)v99 comp-3"
> has a virtual length of 9 digits but occupies 5 actual bytes), for each
> field defined in the definition, including group fields and REDEFINEd and
> OCCURring fields.

I have one, it is called a 'compiler'. Actually the Microfocus
compiler can do this with such options as COPYLIST, REF, and such it
will output the byte address of each variable into the listing on
disk. A simple script can then extract the various records from the
listing and do a few simple calculations to arrive at the answers you
want.

It also has the advantage of taking into account implicit or explicit
redefines, renames, synchronized and any effects of compiler options.


> If anyone has code that does this and is prepared to share it, mail it to
> me. I'll wrap it for windows with a GUI front end and put it on a server for
> freeware download so that everyone can use it. The idea is that you could
> select with the mouse all or part of a COBOL record layout viewed in your
> Editor of choice, and have a popup window that would give you the offset and
> length of each selected field and the total length overall. (It may be a
> requirement that selection starts from the 01 level, or not, depends on how
> your code works...)
>
> So the code should be able to accept or read COBOL Data Division source as
> input, and output a simple text list with an entry for each dataname showing
> the offset and length of it. (The offset represents the total bytes
> preceding the field, so the total length of a record definition is easily
> obtained, and saves all that very tedious counting or searching for the
> compiler output.)
>
> I already have some COBOL code that parses COBOL source and analyses
> pictures. I can amend it to do this as well, but it is tricky and would not
> be publicly available.
>
> Please express interest here if you think you want to have a go at this.
>
> If no-one is up for it, I'll write it myself in C#, when I get time. :-)
>
> Pete.
> --
> "I used to write COBOL...now I can do anything."

"Richard" <riplin@azonic.co.nz> wrote in message
news:342fc890-38d5-4f8f-b1a7-13867deac1ce@r35g2000prm.googlegroups.com...
On Aug 30, 12:07 pm, "Pete Dashwood"
<dashw...@removethis.enternet.co.nz> wrote:
> I need a tool that can analyse the source of a COBOL record layout and
> calculate the offset and length (true length occupied in bytes, not the
> virtual length implied in the picture... for example, "pic s9(7)v99
> comp-3"
> has a virtual length of 9 digits but occupies 5 actual bytes), for each
> field defined in the definition, including group fields and REDEFINEd and
> OCCURring fields.

I have one, it is called a 'compiler'. Actually the Microfocus
compiler can do this with such options as COPYLIST, REF, and such it
will output the byte address of each variable into the listing on
disk. A simple script can then extract the various records from the
listing and do a few simple calculations to arrive at the answers you
want.

It also has the advantage of taking into account implicit or explicit
redefines, renames, synchronized and any effects of compiler options.

[Pete]

I'm amazed you wrote this, Richard.

Every COBOL compiler I have ever worked with has this capability as a
listing option.

I don't want to re-process compiler output (which I cannot guarantee has
even been produced yet... the tool will be used during development. You
could be developing a record layout that has never been compiled...)

I thought the requirement was clear; maybe it wasn't...

Pete.
--
"I used to write COBOL...now I can do anything."


> If anyone has code that does this and is prepared to share it, mail it to
> me. I'll wrap it for windows with a GUI front end and put it on a server
> for
> freeware download so that everyone can use it. The idea is that you could
> select with the mouse all or part of a COBOL record layout viewed in your
> Editor of choice, and have a popup window that would give you the offset
> and
> length of each selected field and the total length overall. (It may be a
> requirement that selection starts from the 01 level, or not, depends on
> how
> your code works...)
>
> So the code should be able to accept or read COBOL Data Division source as
> input, and output a simple text list with an entry for each dataname
> showing
> the offset and length of it. (The offset represents the total bytes
> preceding the field, so the total length of a record definition is easily
> obtained, and saves all that very tedious counting or searching for the
> compiler output.)
>
> I already have some COBOL code that parses COBOL source and analyses
> pictures. I can amend it to do this as well, but it is tricky and would
> not
> be publicly available.
>
> Please express interest here if you think you want to have a go at this.
>
> If no-one is up for it, I'll write it myself in C#, when I get time. :-)
>
> Pete.
> --
> "I used to write COBOL...now I can do anything."

On Aug 30, 5:20*pm, "Pete Dashwood"
<dashw...@removethis.enternet.co.nz> wrote:
> "Richard" <rip...@azonic.co.nz> wrote in message
>
> news:342fc890-38d5-4f8f-b1a7-13867deac1ce@r35g2000prm.googlegroups.com...
> On Aug 30, 12:07 pm, "Pete Dashwood"
>
> <dashw...@removethis.enternet.co.nz> wrote:
> > I need a tool that can analyse the source of a COBOL record layout and
> > calculate the offset and length (true length occupied in bytes, not the
> > virtual length implied in the picture... for example, "pic s9(7)v99
> > comp-3"
> > has a virtual length of 9 digits but occupies 5 actual bytes), for each
> > field defined in the definition, including group fields and REDEFINEd and
> > OCCURring fields.
>
> I have one, it is called a 'compiler'. Actually the Microfocus
> compiler can do this with such options as COPYLIST, REF, and such it
> will output the byte address of each variable into the listing on
> disk. A simple script can then extract the various records from the
> listing and do a few simple calculations to arrive at the answers you
> want.
>
> It also has the advantage of taking into account implicit or explicit
> redefines, renames, synchronized and any effects of compiler options.
>
> [Pete]
>
> I'm amazed you wrote this, Richard.
>
> Every COBOL compiler I have ever worked with has this capability as a
> listing option.
>
> I don't want to re-process compiler output (which I cannot guarantee has
> even been produced yet... the tool will be used during development. You
> could be developing a record layout that has never been compiled...)

How hard would it be to write a couple of lines around a record layout
so that the compiler will process it ?

Some people have no imagination.


> I thought the requirement was clear; maybe it wasn't...
>
> Pete.
> --
> "I used to write COBOL...now I can do anything."
>
> > If anyone has code that does this and is prepared to share it, mail it to
> > me. I'll wrap it for windows with a GUI front end and put it on a server
> > for
> > freeware download so that everyone can use it. The idea is that you could
> > select with the mouse all or part of a COBOL record layout viewed in your
> > Editor of choice, and have a popup window that would give you the offset
> > and
> > length of each selected field and the total length overall. (It may be a
> > requirement that selection starts from the 01 level, or not, depends on
> > how
> > your code works...)
>
> > So the code should be able to accept or read COBOL Data Division sourceas
> > input, and output a simple text list with an entry for each dataname
> > showing
> > the offset and length of it. (The offset represents the total bytes
> > preceding the field, so the total length of a record definition is easily
> > obtained, and saves all that very tedious counting or searching for the
> > compiler output.)
>
> > I already have some COBOL code that parses COBOL source and analyses
> > pictures. I can amend it to do this as well, but it is tricky and would
> > not
> > be publicly available.
>
> > Please express interest here if you think you want to have a go at this..
>
> > If no-one is up for it, I'll write it myself in C#, when I get time. :-)
>
> > Pete.
> > --
> > "I used to write COBOL...now I can do anything."
>
>

On Fri, 29 Aug 2008 17:54:45 -0700 (PDT), Richard <riplin@azonic.co.nz> wrote:

>On Aug 30, 12:07*pm, "Pete Dashwood"
><dashw...@removethis.enternet.co.nz> wrote:
>> I need a tool that can analyse the source of a COBOL record layout and
>> calculate the offset and length (true length occupied in bytes, not the
>> virtual length implied in the picture... for example, "pic s9(7)v99 comp-3"
>> has a virtual length of 9 digits but occupies 5 actual bytes), for each
>> field defined in the definition, including group fields and REDEFINEd and
>> OCCURring fields.

A few years ago I posted a program -- cob2csv -- which did that so it could convert any
'Cobol file' to a csv. Here is a stripped down version showing only the parsing.

* This program interprets a Cobol copybook describing a record layout,
* Supported formats: string, display numeric, binary and packed decimal,
* simple OCCURS. REDEFINES is ignored, the first definition is used.
* Not supported: editing pictures, scaling, OCCURS at group level,
* OCCURS DEPENDING ON.
*
* Example input:
* 01 WWICTLG.
* 10 CTLGOP-CO-NO PIC X(3).
* 10 CTLGCONTROL-SET-SEQ-NO PIC S9(9) USAGE COMP.
* 10 CTLGINVOICE-SEQ-NO PIC S9(4) USAGE COMP.
* 10 CTLGAP-CNTRL-ENTITY-CD PIC X(4).
* 10 CTLGINVOICE-TYPE-CD PIC X(2).
* 10 CTLGLEGACY-VENDOR-NO PIC X(10).
* 10 CTLGAP-VENDOR-NO PIC X(30).
* 10 CTLGAP-PO-NO PIC X(30).
* 10 CTLGAP-INVOICE-NO PIC X(30).
* 10 CTLGINVOICE-DT PIC X(10).
* 10 CTLGTOTAL-INVOICE-AM PIC S9(11)V9(2) USAGE COMP-3.
* 10 CTLGTOTAL-MERCH-AM PIC S9(11)V99 USAGE COMP-3.
* 10 CTLGTERMS-CD PIC XX.
* 10 CTLGCARRIER-CD PIC X(10).
* 10 CTLGCARRIER-PRO-NO PIC X(10).
* 10 CTLGSHIP-DT PIC X(10).
* 10 CTLGSHIP-VIA-CD PIC X(3).
* 10 CTLGSHIP-LOC-NO PIC X(3).
* 10 CTLGSHIP-WT PIC X(10).
* 10 x redefines CTLGSHIP-WT PIC X(10).
* 10 CTLGSHIP-UNITS-DC PIC X(10).
* 10 CTLGSHIP-TY PIC X(2).
*
* Example output:
* Lvl Name Pos Len Typ Occ
* 1 10 ctlgop-co-no 1 3 x 1
* 2 10 ctlgcontrol-set-seq-no 4 4 b 1
* 3 10 ctlginvoice-seq-no 8 2 b 1
* 4 10 ctlgap-cntrl-entity-cd 10 4 x 1
* 5 10 ctlginvoice-type-cd 14 2 x 1
* 6 10 ctlglegacy-vendor-no 16 10 x 1
* 7 10 ctlgap-vendor-no 26 30 x 1
* 8 10 ctlgap-po-no 56 30 x 1
* 9 10 ctlgap-invoice-no 86 30 x 1
* 10 10 ctlginvoice-dt 116 10 x 1
* 11 10 ctlgtotal-invoice-am 126 7 2 p 1
* 12 10 ctlgtotal-merch-am 133 7 2 p 1
* 13 10 ctlgterms-cd 140 2 x 1
* 14 10 ctlgcarrier-cd 142 10 x 1
* 15 10 ctlgcarrier-pro-no 152 10 x 1
* 16 10 ctlgship-dt 162 10 x 1
* 17 10 ctlgship-via-cd 172 3 x 1
* 18 10 ctlgship-loc-no 175 3 x 1
* 19 10 ctlgship-wt 178 10 x 1
* 20 10 ctlgship-units-dc 188 10 x 1
* 21 10 ctlgship-ty 198 2 x 1
* Record length 199

$SET SOURCEFORMAT"FREE"
identification division
. program-id. cobparse.
*> author. Robert Wagner

. data division
. working-storage section
. 01 global-variables value low-values global
. 05 pic x
. 88 end-of-copybook value 'e'
. 05 pic x
. 88 end-of-sentence value 'e'
. 88 not-end-of-sentence value low-value
. 05 pic x
. 88 end-of-data-file value 'e'
. 01 word-area global
. 05 word-count binary pic s9(04)
. 05 word-limit value 200 binary pic s9(04)
. 05 word-entry occurs 1 to 200 depending on word-count
. 10 word-length binary pic s9(04)
. 10 word-text
. 15 word-byte occurs 50 pic x(01)
. 01 line-text-area global
. 05 line-length value zero binary pic s9(04)
. 05 line-limit value 256 binary pic s9(04)
. 05 line-text
. 10 line-byte occurs 1 to 256 depending on line-length pic x
. 01 layout-area global
. 05 layout-count value zero binary pic s9(04)
. 05 layout-limit value 200 binary pic s9(04)
. 05 layout-entry occurs 1 to 200 depending on layout-count
. 10 layout-level pic x(02)
. 10 layout-name pic x(30)
. 10 layout-occurs binary pic s9(04)
. 10 layout-offset binary pic s9(04)
. 10 layout-length binary pic s9(04)
. 10 layout-decimals binary pic s9(04)
. 10 layout-type pic x(01)
. 88 type-string value 'x' space
. 88 type-number value '9'
. 88 type-signed value 's'
. 88 type-binary value 'b'
. 88 type-packed value 'p'

. procedure division.
perform phase-1-copybook
goback

. phase-1-copybook.
display ' Lvl Name Pos Len Typ Occ'
perform one-sentence until end-of-copybook

. one-sentence.
set not-end-of-sentence to true
move zero to word-count
perform one-word until end-of-sentence or end-of-copybook or
word-count not less than word-limit
if word-count not equal to zero and layout-count < layout-limit
call 'syntax'
end-if
. one-word.
call 'parse'

. identification division
. program-id. syntax
*> Transforms a free-form Cobol sentence into a layout-entry.

. data division
. working-storage section
. 01 unqualified-variables
. 05 n value zero binary pic s9(04)
. 05 n-minus-1 binary pic s9(04)
. 05 m value zero binary pic s9(04)
. 05 x9-count-in-word binary pic s9(04)
. 05 pic-count-in-word binary pic s9(04)
. 05 numeric-count-in-word binary pic s9(04)
. 05 digits-after-v binary pic s9(04)
. 05 pic x(01)
. 88 picture-word value 'p'
. 88 not-picture-word value 'n'
. 05 pic x(01)
. 88 type-seen value 'y'
. 88 type-not-seen value 'n'
. 05 pic x(01)
. 88 s-seen value 'y'
. 88 s-not-seen value 'n'
. 05 pic x(01)
. 88 v-seen value 'y'
. 88 v-not-seen value 'n'
. 05 byte-type pic x(01)
. 88 pic-type value 'x' '9' 'v' 's'
. 88 x9-type value 'x' '9'
. 88 v-type value 'v'
. 88 s-type value 's'
. 88 numeric-type value '0' thru '9'
. 05 redefines-level value spaces pic x(02)
. 05 work-number pic 9(04)
. 05 redefines work-number.
. 10 pic x(03)
. 10 work-number-4 pic x(01)
. 01 display-line.
. 05 edited-count pic z(04)-
. 05 edited-level pic x(03)
. 05 edited-name pic x(30)
. 05 edited-offset pic z(04)
. 05 edited-length pic z(04)
. 05 edited-decimals pic z(02)-
. 05 edited-type pic x(01)
. 05 edited-occurs pic z(04)

. procedure division.
if redefines-level not equal to spaces
if word-text (1) greater than redefines-level
move zero to word-count
goback
else
move spaces to redefines-level
end-if
end-if

add 1 to layout-count
initialize layout-entry (layout-count)
move 1 to layout-occurs (layout-count)
move word-text (1) to layout-level (layout-count)
move word-text (2) to layout-name (layout-count)
perform varying n from 2 by 1 until n > word-count
evaluate word-text (n)
when 'pic'
when 'picture'
perform pickup-picture
when 'occurs'
perform pickup-occurs
when 'binary'
when 'comp'
when 'computational'
when 'comp-4'
when 'comp-5'
set type-binary (layout-count) to true
when 'packed-decimal'
when 'comp-3'
when 'computational-3'
set type-packed (layout-count) to true
when 'redefines'
move word-text (1) to redefines-level
move zero to word-count
subtract 1 from layout-count
goback
end-evaluate
end-perform
if layout-length (layout-count) equal to zero
subtract 1 from layout-count
goback
end-if
if type-binary (layout-count)
evaluate layout-length (layout-count)
when 1 thru 4
move 2 to layout-length (layout-count)
when 5 thru 9
move 4 to layout-length (layout-count)
when other
move 8 to layout-length (layout-count)
end-evaluate
end-if
if type-packed (layout-count)
compute layout-length (layout-count) rounded =
(layout-length (layout-count) + 1) / 2
end-if
if layout-count equal to 1
move 1 to layout-offset (layout-count)
else
compute n-minus-1 = layout-count - 1
compute layout-offset (layout-count) =
layout-offset (n-minus-1) +
(layout-length (n-minus-1) *
layout-occurs (n-minus-1))
end-if

move layout-count to edited-count
move layout-level (layout-count) to edited-level
move layout-name (layout-count) to edited-name
move layout-offset (layout-count) to edited-offset
move layout-length (layout-count) to edited-length
move layout-decimals (layout-count) to edited-decimals
move layout-type (layout-count) to edited-type
move layout-occurs (layout-count) to edited-occurs
display display-line

goback
. pickup-occurs.
add 1 to n
perform pickup-number
move work-number to layout-occurs (layout-count)
. pickup-picture.
* Picture s9(9)v9(2) will be in four words: s9, 9, v9, 2.
add 1 to n
set picture-word to true
set type-not-seen to true
set s-not-seen to true
set v-not-seen to true
perform varying n from n by 1 until n > word-count or
not-picture-word
move zero to pic-count-in-word, numeric-count-in-word,
x9-count-in-word, digits-after-v, work-number
perform varying m from 1 by 1 until m > word-length (n)
move word-byte (n, m) to byte-type
if numeric-type
add 1 to numeric-count-in-word
multiply 10 by work-number
move byte-type to work-number-4
if v-seen
add 1 to digits-after-v
end-if
end-if
if pic-type
add 1 to pic-count-in-word
end-if
if x9-type
add 1 to x9-count-in-word
end-if
if s-type
set s-seen to true
end-if
if v-type
set v-seen to true
set type-not-seen to true
end-if
end-perform
evaluate true
when numeric-count-in-word equal to word-length (n) and
type-seen
add work-number -1 to layout-length (layout-count)
if v-seen
add work-number -1 to layout-decimals (layout-count)
end-if
when pic-count-in-word equal to word-length (n) and
type-not-seen
set type-seen to true
add x9-count-in-word to layout-length (layout-count)
if v-seen
add digits-after-v to layout-decimals (layout-count)
end-if
if type-string (layout-count)
move byte-type to layout-type (layout-count)
end-if
if s-seen and type-number (layout-count)
set type-signed (layout-count) to true
end-if
when other
set not-picture-word to true
subtract 2 from n
end-evaluate
end-perform

. pickup-number.
move zero to work-number
perform varying m from 1 by 1 until m > word-length (n)
multiply 10 by work-number
move word-byte (n, m) to work-number-4
end-perform
. end program syntax

. identification division
. program-id. parse
*> Parser. Returns the next word.

. data division
. working-storage section
. 01 unqualified-variables
. 05 n value 1 binary pic s9(04)
. 05 n-plus-1 binary pic s9(04)
. 05 m binary pic s9(04)
. 05 byte-type pic x(01)
. 88 in-a-word value 'x' '9'
. 88 alpha-character value 'x'
. 88 numeric-character value '9'
. 88 full-stop value '.'
. 05 quote-character pic x(01)
. 88 in-a-quote value x'22' x'27'
. 05 a-byte pic x(01)

. procedure division.
move space to byte-type
perform varying n from n by 1 until in-a-word or in-a-quote
if n greater than line-length
call 'read-copybook'
move zero to n
if end-of-copybook goback end-if
else
perform pickup-byte
move a-byte to quote-character
compute n-plus-1 = n + 1
if full-stop and
(n less than line-length or
line-byte (n-plus-1) equal to space)
set end-of-sentence to true
add 1 to n
goback
end-if
end-if
end-perform

add 1 to word-count
move spaces to word-text (word-count)
subtract 1 from n

perform varying word-length (word-count) from 1 by 1 until
not (in-a-word or in-a-quote) or
word-length (word-count) not less length of word-text
move word-length (word-count) to m
move a-byte to word-byte (word-count, m)
if in-a-quote and a-byte equal to quote-character and
word-length (word-count) greater than 1
move space to quote-character
end-if
add 1 to n
if n greater than line-length exit paragraph end-if
perform pickup-byte
end-perform
subtract 1 from word-length (word-count)

goback

. pickup-byte.
move line-byte (n) to a-byte, byte-type
inspect byte-type converting
'abcdefghijklmnopqrstuvwxyz-0123456789' to
'xxxxxxxxxxxxxxxxxxxxxxxxxxx9999999999'

. identification division
. program-id. read-copybook
*> Returns the next line
*> Deletes comments
. environment division
. input-output section
. file-control
. select copybook-file assign to 'cob2csv.cpy'
organization is line sequential

. data division
. file section
. fd copybook-file
. 01 input-record pic x(256)
. 01 input-card.
. 05 columns-1-6 pic x(06)
. 05 columns-7-72
. 10 pic x(01)
. 10 columns-8-72 pic x(65)
. 05 columns-73-80 pic x(08)

. working-storage section
. 01 persistent-variables
. 05 value low-value pic x(01)
. 88 file-open value 'y'
. 88 file-closed value low-value
. 05 value low-value pic x(01)
. 88 free-form value 'f'.
. 88 fixed-form value low-value.
. 01 unqualified-variables.
. 05 n binary pic s9(04)
. 05 n-plus-1 binary pic s9(04)

. procedure division.
if file-closed
open input copybook-file
set file-open to true
end-if

read copybook-file at end
set end-of-copybook to true
close copybook-file
set file-closed to true
move zero to line-length
goback
end-read

if fixed-form
move 66 to line-length, line-limit
move columns-7-72 to line-text
else
move 256 to line-length, line-limit
move input-record to line-text
end-if

if columns-7-72 equal to '$SET SOURCEFORMAT"FREE"' or
columns-8-72 equal to '@OPTIONS SRF(FREE,FREE)'
set free-form to true
move zero to line-limit
end-if
if columns-7-72 equal to '$SET SOURCEFORMAT"FIXED"' or
columns-8-72 equal to '@OPTIONS SRF(FIX,FIX)'
set fixed-form to true
move zero to line-limit
end-if
if line-byte (1) equal to '*' or '/'
move zero to line-limit
end-if
move zero to line-length
perform varying n from 1 by 1 until n greater than line-limit
compute n-plus-1 = n + 1
if line-byte (n) equal to '*' and
n less than line-length and
line-byte (n-plus-1) equal to '>'
exit perform
end-if
if line-byte (n) not equal to space
move n to line-length
end-if
end-perform
if line-length greater than zero
inspect line-text converting
'ABCDEFGHIJKLMNOPQRSTUVWXYZ' to
'abcdefghijklmnopqrstuvwxyz'
end-if
goback
. end program read-copybook
. end program parse

. end program cobparse

"Robert" <no@e.mail> wrote in message
news:umnhb490a0jpnau4rjd4qu1l4g8pl250c7@4ax.com...
> On Fri, 29 Aug 2008 17:54:45 -0700 (PDT), Richard <riplin@azonic.co.nz>
> wrote:
>
>>On Aug 30, 12:07 pm, "Pete Dashwood"
>><dashw...@removethis.enternet.co.nz> wrote:
>>> I need a tool that can analyse the source of a COBOL record layout and
>>> calculate the offset and length (true length occupied in bytes, not the
>>> virtual length implied in the picture... for example, "pic s9(7)v99
>>> comp-3"
>>> has a virtual length of 9 digits but occupies 5 actual bytes), for each
>>> field defined in the definition, including group fields and REDEFINEd
>>> and
>>> OCCURring fields.
>
> A few years ago I posted a program -- cob2csv -- which did that so it
> could convert any
> 'Cobol file' to a csv. Here is a stripped down version showing only the
> parsing.
>
> * This program interprets a Cobol copybook describing a record layout,
> * Supported formats: string, display numeric, binary and packed decimal,
> * simple OCCURS. REDEFINES is ignored, the first definition is used.
> * Not supported: editing pictures, scaling, OCCURS at group level,
> * OCCURS DEPENDING ON.
> *
> * Example input:
> * 01 WWICTLG.
> * 10 CTLGOP-CO-NO PIC X(3).
> * 10 CTLGCONTROL-SET-SEQ-NO PIC S9(9) USAGE COMP.
> * 10 CTLGINVOICE-SEQ-NO PIC S9(4) USAGE COMP.
> * 10 CTLGAP-CNTRL-ENTITY-CD PIC X(4).
> * 10 CTLGINVOICE-TYPE-CD PIC X(2).
> * 10 CTLGLEGACY-VENDOR-NO PIC X(10).
> * 10 CTLGAP-VENDOR-NO PIC X(30).
> * 10 CTLGAP-PO-NO PIC X(30).
> * 10 CTLGAP-INVOICE-NO PIC X(30).
> * 10 CTLGINVOICE-DT PIC X(10).
> * 10 CTLGTOTAL-INVOICE-AM PIC S9(11)V9(2) USAGE COMP-3.
> * 10 CTLGTOTAL-MERCH-AM PIC S9(11)V99 USAGE COMP-3.
> * 10 CTLGTERMS-CD PIC XX.
> * 10 CTLGCARRIER-CD PIC X(10).
> * 10 CTLGCARRIER-PRO-NO PIC X(10).
> * 10 CTLGSHIP-DT PIC X(10).
> * 10 CTLGSHIP-VIA-CD PIC X(3).
> * 10 CTLGSHIP-LOC-NO PIC X(3).
> * 10 CTLGSHIP-WT PIC X(10).
> * 10 x redefines CTLGSHIP-WT PIC X(10).
> * 10 CTLGSHIP-UNITS-DC PIC X(10).
> * 10 CTLGSHIP-TY PIC X(2).
> *
> * Example output:
> * Lvl Name Pos Len Typ Occ
> * 1 10 ctlgop-co-no 1 3 x 1
> * 2 10 ctlgcontrol-set-seq-no 4 4 b 1
> * 3 10 ctlginvoice-seq-no 8 2 b 1
> * 4 10 ctlgap-cntrl-entity-cd 10 4 x 1
> * 5 10 ctlginvoice-type-cd 14 2 x 1
> * 6 10 ctlglegacy-vendor-no 16 10 x 1
> * 7 10 ctlgap-vendor-no 26 30 x 1
> * 8 10 ctlgap-po-no 56 30 x 1
> * 9 10 ctlgap-invoice-no 86 30 x 1
> * 10 10 ctlginvoice-dt 116 10 x 1
> * 11 10 ctlgtotal-invoice-am 126 7 2 p 1
> * 12 10 ctlgtotal-merch-am 133 7 2 p 1
> * 13 10 ctlgterms-cd 140 2 x 1
> * 14 10 ctlgcarrier-cd 142 10 x 1
> * 15 10 ctlgcarrier-pro-no 152 10 x 1
> * 16 10 ctlgship-dt 162 10 x 1
> * 17 10 ctlgship-via-cd 172 3 x 1
> * 18 10 ctlgship-loc-no 175 3 x 1
> * 19 10 ctlgship-wt 178 10 x 1
> * 20 10 ctlgship-units-dc 188 10 x 1
> * 21 10 ctlgship-ty 198 2 x 1
> * Record length 199
>
> $SET SOURCEFORMAT"FREE"
> identification division
> . program-id. cobparse.
> *> author. Robert Wagner
>
> . data division
> . working-storage section
> . 01 global-variables value low-values global
> . 05 pic x
> . 88 end-of-copybook value 'e'
> . 05 pic x
> . 88 end-of-sentence value 'e'
> . 88 not-end-of-sentence value low-value
> . 05 pic x
> . 88 end-of-data-file value 'e'
> . 01 word-area global
> . 05 word-count binary pic s9(04)
> . 05 word-limit value 200 binary pic s9(04)
> . 05 word-entry occurs 1 to 200 depending on word-count
> . 10 word-length binary pic s9(04)
> . 10 word-text
> . 15 word-byte occurs 50 pic x(01)
> . 01 line-text-area global
> . 05 line-length value zero binary pic s9(04)
> . 05 line-limit value 256 binary pic s9(04)
> . 05 line-text
> . 10 line-byte occurs 1 to 256 depending on line-length pic x
> . 01 layout-area global
> . 05 layout-count value zero binary pic s9(04)
> . 05 layout-limit value 200 binary pic s9(04)
> . 05 layout-entry occurs 1 to 200 depending on layout-count
> . 10 layout-level pic x(02)
> . 10 layout-name pic x(30)
> . 10 layout-occurs binary pic s9(04)
> . 10 layout-offset binary pic s9(04)
> . 10 layout-length binary pic s9(04)
> . 10 layout-decimals binary pic s9(04)
> . 10 layout-type pic x(01)
> . 88 type-string value 'x' space
> . 88 type-number value '9'
> . 88 type-signed value 's'
> . 88 type-binary value 'b'
> . 88 type-packed value 'p'
>
> . procedure division.
> perform phase-1-copybook
> goback
>
> . phase-1-copybook.
> display ' Lvl Name Pos Len Typ Occ'
> perform one-sentence until end-of-copybook
>
> . one-sentence.
> set not-end-of-sentence to true
> move zero to word-count
> perform one-word until end-of-sentence or end-of-copybook or
> word-count not less than word-limit
> if word-count not equal to zero and layout-count < layout-limit
> call 'syntax'
> end-if
> . one-word.
> call 'parse'
>
> . identification division
> . program-id. syntax
> *> Transforms a free-form Cobol sentence into a layout-entry.
>
> . data division
> . working-storage section
> . 01 unqualified-variables
> . 05 n value zero binary pic s9(04)
> . 05 n-minus-1 binary pic s9(04)
> . 05 m value zero binary pic s9(04)
> . 05 x9-count-in-word binary pic s9(04)
> . 05 pic-count-in-word binary pic s9(04)
> . 05 numeric-count-in-word binary pic s9(04)
> . 05 digits-after-v binary pic s9(04)
> . 05 pic x(01)
> . 88 picture-word value 'p'
> . 88 not-picture-word value 'n'
> . 05 pic x(01)
> . 88 type-seen value 'y'
> . 88 type-not-seen value 'n'
> . 05 pic x(01)
> . 88 s-seen value 'y'
> . 88 s-not-seen value 'n'
> . 05 pic x(01)
> . 88 v-seen value 'y'
> . 88 v-not-seen value 'n'
> . 05 byte-type pic x(01)
> . 88 pic-type value 'x' '9' 'v' 's'
> . 88 x9-type value 'x' '9'
> . 88 v-type value 'v'
> . 88 s-type value 's'
> . 88 numeric-type value '0' thru '9'
> . 05 redefines-level value spaces pic x(02)
> . 05 work-number pic 9(04)
> . 05 redefines work-number.
> . 10 pic x(03)
> . 10 work-number-4 pic x(01)
> . 01 display-line.
> . 05 edited-count pic z(04)-
> . 05 edited-level pic x(03)
> . 05 edited-name pic x(30)
> . 05 edited-offset pic z(04)
> . 05 edited-length pic z(04)
> . 05 edited-decimals pic z(02)-
> . 05 edited-type pic x(01)
> . 05 edited-occurs pic z(04)
>
> . procedure division.
> if redefines-level not equal to spaces
> if word-text (1) greater than redefines-level
> move zero to word-count
> goback
> else
> move spaces to redefines-level
> end-if
> end-if
>
> add 1 to layout-count
> initialize layout-entry (layout-count)
> move 1 to layout-occurs (layout-count)
> move word-text (1) to layout-level (layout-count)
> move word-text (2) to layout-name (layout-count)
> perform varying n from 2 by 1 until n > word-count
> evaluate word-text (n)
> when 'pic'
> when 'picture'
> perform pickup-picture
> when 'occurs'
> perform pickup-occurs
> when 'binary'
> when 'comp'
> when 'computational'
> when 'comp-4'
> when 'comp-5'
> set type-binary (layout-count) to true
> when 'packed-decimal'
> when 'comp-3'
> when 'computational-3'
> set type-packed (layout-count) to true
> when 'redefines'
> move word-text (1) to redefines-level
> move zero to word-count
> subtract 1 from layout-count
> goback
> end-evaluate
> end-perform
> if layout-length (layout-count) equal to zero
> subtract 1 from layout-count
> goback
> end-if
> if type-binary (layout-count)
> evaluate layout-length (layout-count)
> when 1 thru 4
> move 2 to layout-length (layout-count)
> when 5 thru 9
> move 4 to layout-length (layout-count)
> when other
> move 8 to layout-length (layout-count)
> end-evaluate
> end-if
> if type-packed (layout-count)
> compute layout-length (layout-count) rounded =
> (layout-length (layout-count) + 1) / 2
> end-if
> if layout-count equal to 1
> move 1 to layout-offset (layout-count)
> else
> compute n-minus-1 = layout-count - 1
> compute layout-offset (layout-count) =
> layout-offset (n-minus-1) +
> (layout-length (n-minus-1) *
> layout-occurs (n-minus-1))
> end-if
>
> move layout-count to edited-count
> move layout-level (layout-count) to edited-level
> move layout-name (layout-count) to edited-name
> move layout-offset (layout-count) to edited-offset
> move layout-length (layout-count) to edited-length
> move layout-decimals (layout-count) to edited-decimals
> move layout-type (layout-count) to edited-type
> move layout-occurs (layout-count) to edited-occurs
> display display-line
>
> goback
> . pickup-occurs.
> add 1 to n
> perform pickup-number
> move work-number to layout-occurs (layout-count)
> . pickup-picture.
> * Picture s9(9)v9(2) will be in four words: s9, 9, v9, 2.
> add 1 to n
> set picture-word to true
> set type-not-seen to true
> set s-not-seen to true
> set v-not-seen to true
> perform varying n from n by 1 until n > word-count or
> not-picture-word
> move zero to pic-count-in-word, numeric-count-in-word,
> x9-count-in-word, digits-after-v, work-number
> perform varying m from 1 by 1 until m > word-length (n)
> move word-byte (n, m) to byte-type
> if numeric-type
> add 1 to numeric-count-in-word
> multiply 10 by work-number
> move byte-type to work-number-4
> if v-seen
> add 1 to digits-after-v
> end-if
> end-if
> if pic-type
> add 1 to pic-count-in-word
> end-if
> if x9-type
> add 1 to x9-count-in-word
> end-if
> if s-type
> set s-seen to true
> end-if
> if v-type
> set v-seen to true
> set type-not-seen to true
> end-if
> end-perform
> evaluate true
> when numeric-count-in-word equal to word-length (n) and
> type-seen
> add work-number -1 to layout-length (layout-count)
> if v-seen
> add work-number -1 to layout-decimals (layout-count)
> end-if
> when pic-count-in-word equal to word-length (n) and
> type-not-seen
> set type-seen to true
> add x9-count-in-word to layout-length (layout-count)
> if v-seen
> add digits-after-v to layout-decimals (layout-count)
> end-if
> if type-string (layout-count)
> move byte-type to layout-type (layout-count)
> end-if
> if s-seen and type-number (layout-count)
> set type-signed (layout-count) to true
> end-if
> when other
> set not-picture-word to true
> subtract 2 from n
> end-evaluate
> end-perform
>
> . pickup-number.
> move zero to work-number
> perform varying m from 1 by 1 until m > word-length (n)
> multiply 10 by work-number
> move word-byte (n, m) to work-number-4
> end-perform
> . end program syntax
>
> . identification division
> . program-id. parse
> *> Parser. Returns the next word.
>
> . data division
> . working-storage section
> . 01 unqualified-variables
> . 05 n value 1 binary pic s9(04)
> . 05 n-plus-1 binary pic s9(04)
> . 05 m binary pic s9(04)
> . 05 byte-type pic x(01)
> . 88 in-a-word value 'x' '9'
> . 88 alpha-character value 'x'
> . 88 numeric-character value '9'
> . 88 full-stop value '.'
> . 05 quote-character pic x(01)
> . 88 in-a-quote value x'22' x'27'
> . 05 a-byte pic x(01)
>
> . procedure division.
> move space to byte-type
> perform varying n from n by 1 until in-a-word or in-a-quote
> if n greater than line-length
> call 'read-copybook'
> move zero to n
> if end-of-copybook goback end-if
> else
> perform pickup-byte
> move a-byte to quote-character
> compute n-plus-1 = n + 1
> if full-stop and
> (n less than line-length or
> line-byte (n-plus-1) equal to space)
> set end-of-sentence to true
> add 1 to n
> goback
> end-if
> end-if
> end-perform
>
> add 1 to word-count
> move spaces to word-text (word-count)
> subtract 1 from n
>
> perform varying word-length (word-count) from 1 by 1 until
> not (in-a-word or in-a-quote) or
> word-length (word-count) not less length of word-text
> move word-length (word-count) to m
> move a-byte to word-byte (word-count, m)
> if in-a-quote and a-byte equal to quote-character and
> word-length (word-count) greater than 1
> move space to quote-character
> end-if
> add 1 to n
> if n greater than line-length exit paragraph end-if
> perform pickup-byte
> end-perform
> subtract 1 from word-length (word-count)
>
> goback
>
> . pickup-byte.
> move line-byte (n) to a-byte, byte-type
> inspect byte-type converting
> 'abcdefghijklmnopqrstuvwxyz-0123456789' to
> 'xxxxxxxxxxxxxxxxxxxxxxxxxxx9999999999'
>
> . identification division
> . program-id. read-copybook
> *> Returns the next line
> *> Deletes comments
> . environment division
> . input-output section
> . file-control
> . select copybook-file assign to 'cob2csv.cpy'
> organization is line sequential
>
> . data division
> . file section
> . fd copybook-file
> . 01 input-record pic x(256)
> . 01 input-card.
> . 05 columns-1-6 pic x(06)
> . 05 columns-7-72
> . 10 pic x(01)
> . 10 columns-8-72 pic x(65)
> . 05 columns-73-80 pic x(08)
>
> . working-storage section
> . 01 persistent-variables
> . 05 value low-value pic x(01)
> . 88 file-open value 'y'
> . 88 file-closed value low-value
> . 05 value low-value pic x(01)
> . 88 free-form value 'f'.
> . 88 fixed-form value low-value.
> . 01 unqualified-variables.
> . 05 n binary pic s9(04)
> . 05 n-plus-1 binary pic s9(04)
>
> . procedure division.
> if file-closed
> open input copybook-file
> set file-open to true
> end-if
>
> read copybook-file at end
> set end-of-copybook to true
> close copybook-file
> set file-closed to true
> move zero to line-length
> goback
> end-read
>
> if fixed-form
> move 66 to line-length, line-limit
> move columns-7-72 to line-text
> else
> move 256 to line-length, line-limit
> move input-record to line-text
> end-if
>
> if columns-7-72 equal to '$SET SOURCEFORMAT"FREE"' or
> columns-8-72 equal to '@OPTIONS SRF(FREE,FREE)'
> set free-form to true
> move zero to line-limit
> end-if
> if columns-7-72 equal to '$SET SOURCEFORMAT"FIXED"' or
> columns-8-72 equal to '@OPTIONS SRF(FIX,FIX)'
> set fixed-form to true
> move zero to line-limit
> end-if
> if line-byte (1) equal to '*' or '/'
> move zero to line-limit
> end-if
> move zero to line-length
> perform varying n from 1 by 1 until n greater than line-limit
> compute n-plus-1 = n + 1
> if line-byte (n) equal to '*' and
> n less than line-length and
> line-byte (n-plus-1) equal to '>'
> exit perform
> end-if
> if line-byte (n) not equal to space
> move n to line-length
> end-if
> end-perform
> if line-length greater than zero
> inspect line-text converting
> 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' to
> 'abcdefghijklmnopqrstuvwxyz'
> end-if
> goback
> . end program read-copybook
> . end program parse
>
> . end program cobparse
> .
>

This looks pretty close, Robert.

If you can amend it to support REDEFINES and group levels, say up to 6
levels should be fine...(my own code uses a pushed and popped stack of
levels with total lengths and offsets), I will wrap it as a a COM server (so
it can run anywhere) and put a .NET GUI around it. We need to have an
offset and length for every dataname in the copybook, including fillers...
The end result would be a COBOL component (with attribution to you) running
in a C# framework, with all source and executable publicly available. I'll
organise the "translation" and passing of text selected by the mouse, to
your code so it appears as if it were a copybook, and the output can be a
..txt file or display on screen, selectable by the user.

I have already amended my own code to get this information, so my original
problem is solved, but I think this would be a useful tool to have anyway,
as a separate item in the toolbox.

Pete.
--
"I used to write COBOL...now I can do anything."

"Pete Dashwood" <dashwood@removethis.enternet.co.nz> wrote in message
news:6hsrpjFniqdpU1@mid.individual.net...
>
>
> "Robert" <no@e.mail> wrote in message
> news:umnhb490a0jpnau4rjd4qu1l4g8pl250c7@4ax.com...
<snipped COBOL code>

> This looks pretty close, Robert.
>
> If you can amend it to support REDEFINES and group levels, say up to 6
> levels should be fine...(my own code uses a pushed and popped stack of
> levels with total lengths and offsets), I will wrap it as a a COM server
> (so it can run anywhere) and put a .NET GUI around it. We need to have an
> offset and length for every dataname in the copybook, including fillers...
> The end result would be a COBOL component (with attribution to you)
> running in a C# framework, with all source and executable publicly
> available. I'll organise the "translation" and passing of text selected by
> the mouse, to your code so it appears as if it were a copybook, and the
> output can be a .txt file or display on screen, selectable by the user.
>
> I have already amended my own code to get this information, so my original
> problem is solved, but I think this would be a useful tool to have anyway,
> as a separate item in the toolbox.

Just to be absolutely clear, the toolbox being referred to here is the
conceptual toolbox that all Programmers have, NOT the Migration Toolset I
have mentioned here a few times.. It is NOT my intention to sell this
product or to attach it to any product for which a charge is made. It would
be Freeware. I will provide a URL for free client download at no charge to
the person downloading. (No, not even for bandwidth or media... :-))

Pete.
--
"I used to write COBOL...now I can do anything."

>
> Pete.
> --
> "I used to write COBOL...now I can do anything."
>
>
>

Pete Dashwood wrote:
> I need a tool that can analyse the source of a COBOL record layout and
> calculate the offset and length (true length occupied in bytes, not
> the virtual length implied in the picture... for example, "pic
> s9(7)v99 comp-3" has a virtual length of 9 digits but occupies 5
> actual bytes), for each field defined in the definition, including
> group fields and REDEFINEd and OCCURring fields.
>
> If anyone has code that does this and is prepared to share it, mail
> it to me. I'll wrap it for windows with a GUI front end and put it on
> a server for freeware download so that everyone can use it. The idea
> is that you could select with the mouse all or part of a COBOL record
> layout viewed in your Editor of choice, and have a popup window that
> would give you the offset and length of each selected field and the
> total length overall. (It may be a requirement that selection starts
> from the 01 level, or not, depends on how your code works...)
>
> So the code should be able to accept or read COBOL Data Division
> source as input, and output a simple text list with an entry for each
> dataname showing the offset and length of it. (The offset represents
> the total bytes preceding the field, so the total length of a record
> definition is easily obtained, and saves all that very tedious
> counting or searching for the compiler output.)
>
> I already have some COBOL code that parses COBOL source and analyses
> pictures. I can amend it to do this as well, but it is tricky and
> would not be publicly available.
>
> Please express interest here if you think you want to have a go at
> this.
> If no-one is up for it, I'll write it myself in C#, when I get time.
> :-)

Is COBFD what you want?

See COBFD.ZIP on the Flexus download page:
http://www.flexus.com/download.html

On Sat, 30 Aug 2008 17:20:08 +1200, "Pete Dashwood"
<dashwood@removethis.enternet.co.nz> wrote:

>
>
>"Richard" <riplin@azonic.co.nz> wrote in message
>news:342fc890-38d5-4f8f-b1a7-13867deac1ce@r35g2000prm.googlegroups.com...
>On Aug 30, 12:07 pm, "Pete Dashwood"
><dashw...@removethis.enternet.co.nz> wrote:
>> I need a tool that can analyse the source of a COBOL record layout and
>> calculate the offset and length (true length occupied in bytes, not the
>> virtual length implied in the picture... for example, "pic s9(7)v99
>> comp-3"
>> has a virtual length of 9 digits but occupies 5 actual bytes), for each
>> field defined in the definition, including group fields and REDEFINEd and
>> OCCURring fields.
>
>I have one, it is called a 'compiler'. Actually the Microfocus
>compiler can do this with such options as COPYLIST, REF, and such it
>will output the byte address of each variable into the listing on
>disk. A simple script can then extract the various records from the
>listing and do a few simple calculations to arrive at the answers you
>want.
>
>It also has the advantage of taking into account implicit or explicit
>redefines, renames, synchronized and any effects of compiler options.
>
>[Pete]
>
>I'm amazed you wrote this, Richard.
>
>Every COBOL compiler I have ever worked with has this capability as a
>listing option.
>
>I don't want to re-process compiler output (which I cannot guarantee has
>even been produced yet... the tool will be used during development. You
>could be developing a record layout that has never been compiled...)
>
>I thought the requirement was clear; maybe it wasn't...
>
>Pete.

I didn't take an extensive look at this, but this site might have what
you are looking for:

http://www.uvsoftware.ca/cobaids1.htm

Regards,
////
(o o)
-oOO--(_)--OOo-

"I find television very educating. Every time somebody
turns on the set, I go into the other room and read a book."
-- Groucho Marx
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Remove nospam to email me.

Steve

"HeyBub" <heybub@NOSPAMgmail.com> wrote in message
news:MJKdnWHjZaBO7STVnZ2dnUVZ_uGdnZ2d@earthlink.co m...
>
> Is COBFD what you want?
>
> See COBFD.ZIP on the Flexus download page:
> http://www.flexus.com/download.html

I was starting to wonder if anybody remembered that. It's been there since
about 1994.

Ok, so I never got around to updating it. So what do you want at that
price?

--
Michael C. Mattias
Tal Systems Inc.
Racine WI
mmattias@talsystems.com