I need a REXX utility which can calculate the total byte length of a
record layout. I have used File-AID before. But now on this new site we dont have File Aid. I am desperately in need for a solution. I have to do this manually everytime.
What i really mean is this The following is a cobol file layout.
now what i need is the total length in Bytes for the specified layout.
what we do regularly is we total this up manually. but if the layout is very big . it becomes very difficult to do this manually.
01 GROUP-A.
05 A PIC x(2).
05 B PIC S9(3) comp-3.
05 C PIC S9(9) comp.
05 D PIC S9(9) comp.
05 FILLER PIC X(10).
Thanks for the reply . what i was looking for was a REXX utility which dose the same without even compiling the code. i have a REXX code for one but it has some bugs in it.
what you have to do is mark your layout within
CC
..............
...............
.............
............
.............
CC
and run that REXX utility from command line . it will give you the total byte length of the inclosed layout. will attach the REXX code with this . see if you can help me out on this.
Joined: 12 Sep 2007 Posts: 5 Location: Lelystad Holland
I've been working on a similar tool. Worked fine, I thought, but then I found more and more bugs.
I had to consider the cobol typical exceptions like specifying comp-3 (or other usage clauses) on a group level, usage is sync and redefines (where the redefine part could be bigger or smaller than the part it redefines).
After a long struggle I gave in, and started working on a totaly new tool where I would first do a sneaky compile and than evaluate the outcome, wich would be correct in all cases (that is, in case of a compile-error-free bit of code).
It worked!!
The tool analyses the given bit of code (with copy-members included) and makes a temp file presenting the record structure with begin and end-position.
The only weak part of the tool is the evaluation of the occurs-column.
It has not been fully tested. (I call it a beta-version )
Would you be interested in this tool?
sure man i would be very much interested if you are not talking about COBTABLE.EXE . coz i have that one already. the only problem here is i have to transfer the copybook from mainframes to the PC in Text format. which takes a lot of time.
Joined: 12 Sep 2007 Posts: 5 Location: Lelystad Holland
Rishi Khare wrote:
Thanks for the reply ....
sure man i would be very much interested if you are not talking about COBTABLE.EXE . coz i have that one already. the only problem here is i have to transfer the copybook from mainframes to the PC in Text format. which takes a lot of time.
Thanks again
No I'm talking real mainframe-macro-rexx-select-a-couple-of-lines-by-linenumber-or-label-and-voila-within-a-few-seconds-a-record-structure-over-your-edit-screen tool (keep breathing).
I have to find some time to post it (i'm @ work you know ).
cu
Joined: 12 Sep 2007 Posts: 5 Location: Lelystad Holland
Rishi Khare wrote:
YES !!!!
That is what I was looking for . Can you please send that utility to me. I would be really thankful.
Thanks,
Rishi/K
Ok, I translated all the dutch phrases into english.
Now to put this to work do the following:
Set the profile of the source to unnum.
Make a ISPSLIB-dataset (I called mine Userid().P00.SKELET)
with a member named E@SLINE which has only one line:
&sline
In some environment the programlibrary of the compiler is already allocated on logging in TSO. In that case change line
"CALL 'SYS1.SIGYCOMP(IGYCRCTL)'",
"'LIB,SOURCE,NOOBJECT,NOSEQ,NOFSRT,NOOFF,MAP,NOOPT'"
into
Address ISPEXEC "SELECT PGM(IGYCRCTL) "||,
"PARM('SOURCE,NOOBJECT,NOSEQ,NOFSRT,NOOFF,MAP,NOOPT')"
If you wish I can put together a few comments on the code.
And now the main part:
Put the code in a member named WSA in your Dataset allocated to ISPEXEC or ISPPROC.
In a piece of Cobol put WSA in the commandline and tag the lines you want to analyse with labels .a .b and hit ENTER or type WSA beginline endline and hit ENTER.
(Here comes the drill)
Code:
/*REXX**************************************************************/
/* WORKING STORAGE ANALYST */
/* ----------------------- */
/* Developed by Rico Andriol */
/* All rights reserved */
/* Copyright (c) Andriol Consultancy */
/*******************************************************************/
trace i
x=Msg(on)
Address "ISREDIT"
"MACRO (Begin, EndPos) PROCESS"
"(Dw) = DATA_WIDTH"
If Dw > 72 Then Dw = 72
If Begin = '' Then
Do
"(Begin) = LINENUM .A"
If Rc > 0 THEN DO
Zedsmsg = "No StartPosition"
Zedlmsg = "Give startPosition with label .a or linenumber"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Return
End
End
If EndPos = '' Then
Do
"(EndPos) = LINENUM .B"
If Rc > 0 Then
Do
Zedsmsg = "No EndPosition"
Zedlmsg = "Give EndPosition with label .b or linenumber"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Return
End
End
"(LABELNM,NEST) = LABEL (BEGIN)"
If LabelNm = '' Then "LABEL (BEGIN) = .A"
If EndPos = Begin Then
Do
"F ' ' .A .A first nx"
End
Else
Do
"(LABELNM,NEST) = LABEL (ENDPOS)"
If LabelNm = '' Then "LABEL (ENDPOS) = .B"
/* 01 level present? */
Address ISREDIT
"X '*' .A .B all 7 7"
"F 'DIVISION' .A .B all nx"
If Rc = 0 then
Do
Zedsmsg = "Too much selected"
Zedlmsg = "Area ("Begin End") over divisions"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Return
End
"F 'SECTION' .A .B all nx"
If Rc = 0 then
Do
Zedsmsg = "Too much selected "
Zedlmsg = "Area ("Begin End") over sections"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Return
End
"F ' ' .A .B first nx"
End
"(SLINE) = LINE .ZCSR"
If Word(Substr(SLine,7),1) = '01' Then
Add01Level = 0
Else
Add01Level = 1
"RESET"
Address ISPEXEC
"LIBDEF ISPSLIB DATASET ID('"Userid()".P00.SKELET')"
"FTOPEN TEMP"
SLine = ' IDENTIFICATION DIVISION.'
"FTINCL E@SLINE"
SLine = ' PROGRAM-ID. WSATEST.'
"FTINCL E@SLINE"
SLine = ' ENVIRONMENT DIVISION.'
"FTINCL E@SLINE"
SLine = ' CONFIGURATION SECTION.'
"FTINCL E@SLINE"
SLine = ' SPECIAL-NAMES.'
"FTINCL E@SLINE"
SLine = ' DECIMAL-POINT IS COMMA.'
"FTINCL E@SLINE"
SLine = ' DATA DIVISION.'
"FTINCL E@SLINE"
SLine = ' WORKING-STORAGE SECTION.'
"FTINCL E@SLINE"
If Add01Level = 1 Then
Do
SLine = ' 01 FILLER.'
"FTINCL E@SLINE"
End
Nr = Begin - 1
Do While Nr < EndPos
Nr = Nr + 1
Address ISREDIT "(SLINE) = LINE &NR"
If Rc = 0 Then
Do
SLine = Overlay(' ',SLine,1,6) /* linenumbers away */
If Pos('*',SLine) = 7 Then Iterate /* comment lines away */
SLine = Left(SLine,Dw) /* not too much */
If Words(SLine) = 0 Then Iterate /* empty lines away */
"FTINCL E@SLINE"
End
End
"FTCLOSE"
x=Msg(off)
Address TSO
"DEL '"Userid()".SYSPRINT'"
"FREE FI(SYSIN SYSPRINT SYSLIB)"
"FREE FI(SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)"
x=Msg(on)
Address ISPEXEC "VGET ZTEMPF"
"ALLOC FI(SYSIN) DA('"ZTEMPF"') SHR REUSE"
"ALLOC FI(SYSPRINT) DA('"Userid()".SYSPRINT') NEW SPACE(15 15)
TRACKS LRECL(121) RECFM(F B A ) BLKSIZE(0)
DSORG(PS)"
"ALLOC FI(SYSLIB) DA('CICS630.SDFHCOBQ'",
"'XXXXXXX.P00.COPY'",
"'YYYYYYYY.P00.COPY') SHR"
"ALLOC FI(SYSUT1) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT2) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT3) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT4) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT5) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT6) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"ALLOC FI(SYSUT7) NEW SPACE(5,5) TRACKS UNIT(SYSDA)"
"CALL 'SYS1.SIGYCOMP(IGYCRCTL)'",
"'LIB,SOURCE,NOOBJECT,NOSEQ,NOFSRT,NOOFF,MAP,NOOPT'"
If Rc > 4 Then Do
Zedsmsg = 'Wrong input'
Zedlmsg = 'Syntaxerrors found. RC = ' Rc
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Address ISPEXEC "BROWSE DATASET('"Userid()".SYSPRINT')"
"FREE FI(SYSIN SYSPRINT SYSLIB)"
"FREE FI(SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)"
Exit
End
"EXECIO * DISKR SYSPRINT (FINIS STEM CMPRGL.)"
"FREE FI(SYSPRINT SYSIN SYSLIB)"
"FREE FI(SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)"
/* Look for startpoint list */
Nr = 1
Do Forever While Nr <= CmpRgl.0
If Left(CmpRgl.Nr,7) = '0Source' Then
Do
Nr = Nr + 3
Leave
End
Else
Nr = Nr + 1
END /* Do Forever While Nr <= CmpRgl.0 */
If Nr >= CmpRgl.0 Then
Do
Zedsmsg = "No Usable Oupput"
Zedlmsg = "Background compilation did not produce any good"
Address ISPEXEC "SETMSG MSG(ISRZ001)"
Return
End
/* Process list */
UNr = 1
OutptLn.1 = ' Linenr Lv Fieldname Red Picture',
' Ocrs Bytes Start End' /* headline */
Do Forever While Nr <= CmpRgl.0
If Left(CmpRgl.Nr,1) = ' ' Then
Do
If SubStr(CmpRgl.Nr,60,4) = 'BLW=' Then
Call ProcessLine
Nr = Nr + 1
End
Else
Do
If Left(CmpRgl.Nr,8) = '0PROGRAM' Then
Leave
Else
Nr = Nr + 1
End
END /* Do Forever While Nr <= CmpRgl.0 */
Call EvalOcrs /* evaluate occurs */
Call MakeLst /* make report and put it in temp file */
Exit
ProcessLine:
LvlVnm = SubStr(CmpRgl.Nr,11,49)
Level = Word(LvlVnm,1)
Vnm = Strip(Word(LvlVnm,2),'t','.')
BaseStr = SubStr(CmpRgl.Nr,79,3)
If BaseStr = ' ' Then BaseStr = 0
Base = X2D(BaseStr)*4096
DType = SubStr(CmpRgl.Nr,103,15)
Assemblr = SubStr(CmpRgl.Nr,92,10)
If DType = 'Group' | DType = 'Grp-varlen' Then
Do
If Substr(Assemblr,1,3) = '0CL' Then
Bytes = Strip(Substr(Assemblr,4),'t')
End
Else
Do
Bytes = Substr(Assemblr,1,Length(Word(Assemblr,1))-1)
End
Attrib = SubStr(CmpRgl.Nr,119,5)
If Pos('R',Attrib) > 0 Then Redef = 'Y'
Else Redef = ' '
If Pos('O',Attrib) > 0 Then Occurs = 'Y'
Else Occurs = ' '
BeginPosStr = SubStr(CmpRgl.Nr,83,3)
If BeginPosStr = ' ' Then BeginPosStr = 0
BeginPos = Base+X2D(BeginPosStr)+1
UNr = UNr + 1
OutptLn.UNr = Left(CmpRgl.Nr,7) Copies(' ',Level-1),
Right(Level,2) Left(Vnm,28-Level),
Redef Left(Dtype,18) Occurs,
Right(Bytes,5) Right(BeginPos,5) Right(BeginPos+Bytes-1,5)
OutptLn.0 = UNr
Return /* ProcessLine */
EvalOcrs:
Nr = 2
Do Forever While Nr <= OutptLn.0
If Substr(OutptLn.Nr,62,1) = 'Y' Then Call DetOcrs
Nr = Nr + 1
End /* Do Forever While Nr <= OutptLn.0 */
Return /* EvalOcrs */
DetOcrs:
Level1 = Word(Substr(OutptLn.Nr,8,29),1)
Element1 = Substr(OutptLn.Nr,64,5)
Begin1 = Substr(OutptLn.Nr,70,5)
UNr = Nr + 1
Do Forever While UNr <= OutptLn.0
Level2 = Word(Substr(OutptLn.UNr,8,29),1)
Begin2 = Substr(OutptLn.UNr,70,5)
If Level2 <= Level1 Then
Do
Leave
End
UNr = UNr + 1
End
If UNr > OutptLn.0 | Begin2 = Begin1 Then /* terugzoeken */
Do
UNr = Nr - 1
Do Forever Until UNr < 1
Level2 = Word(Substr(OutptLn.UNr,8,29),1)
If Level2 < Level1 Then
Do
Begin2 = Substr(OutptLn.UNr,70,5)
Element2 = Substr(OutptLn.UNr,64,5)
Leave
End
UNr = UNr - 1
End
OcCount = (Element2-Begin1+Begin2)/Element1
End
Else
OcCount = (Begin2-Begin1)/Element1
LA = Length(OcCount)
OutptLn.Nr = Overlay(OcCount,OutptLn.Nr,62-LA+1,LA)
Return /* DetOcrs */
MakeLst:
/* Maak Overzicht */
Address TSO
Call TempDs
"ALLOC FI(OUTF) DA('"||TempDsn||"') OLD"
If Rc /= 0 Then
Do
Say "*** Unable to allocate TEMP ***"
Say "*** Returncode = " Rc "***"
Exit
End
"EXECIO * DISKW OUTF (FINIS STEM OutptLn.)"
If Rc /= 0 Then
Do
Say "*** Unable to fill TEMP ***"
Say "*** Returncode = " Rc "***"
Exit
End
Address ISPEXEC "BROWSE DATASET('"TempDsn"')"
If Rc > 4 Then
Do
Say "*** Unable to edit TEMP ***"
Say "*** Returncode = " Rc "***"
Exit
End
Call DelTmpDs
Return /* MakeLst */
TempDs:
TempDsn = USERID()||".TEMP"
x = msg(off)
If ListDsi(TempDsn) = 0 Then
Call DelTmpDs
Call MakeTmpDs
x = msg(off)
Return /*TempDs*/
DelTmpDs:
"DELETE '"||TempDsn||"'"
Return /*DelTmpDs*/
MakeTmpDs:
"ALLOC FILE(DD1) DATASET('"||TempDsn||"')
TRACKS SPACE(2,5) LRECL(255) BLKSIZE(6160) RECFM(V)
NEW CATALOG"
If Rc /= 0 Then
Do
Say "*** Unable to create TEMP ***"
Say "*** Returncode = " Rc "***"
Exit
End
"FREE F(DD1)"
Return /*MakeTmpDs*/