Portal | Manuals | References | Downloads | Info | Programs | JCLs | Mainframe wiki | Quick Ref
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Profile Log in to check your private messages Log in
 
REXX Utilty for Record Size calculation

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CLIST & REXX
View previous topic :: :: View next topic  
Author Message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Wed Sep 05, 2007 1:33 pm    Post subject: REXX Utilty for Record Size calculation
Reply with quote

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.

Thanks
Back to top
View user's profile Send private message

manihcl85
Warnings : 1

New User


Joined: 11 Jan 2007
Posts: 52
Location: chennai

PostPosted: Wed Sep 05, 2007 2:30 pm    Post subject:
Reply with quote

Hi,

using Length command u can find length of an record. give an example to explain what u need exactly.

Regards,
Mani
Back to top
View user's profile Send private message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Wed Sep 05, 2007 2:47 pm    Post subject:
Reply with quote

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).
Back to top
View user's profile Send private message
dick scherrer

Site Director


Joined: 23 Nov 2006
Posts: 19270
Location: Inside the Matrix

PostPosted: Wed Sep 05, 2007 10:39 pm    Post subject:
Reply with quote

Hello,

If you run a compile (maybe even with many of your record formats instead of one compile per layout) the output will show you the lengths you want.
Back to top
View user's profile Send private message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Thu Sep 06, 2007 10:20 am    Post subject:
Reply with quote

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.

Thanks
Back to top
View user's profile Send private message
Zapper

New User


Joined: 12 Sep 2007
Posts: 5
Location: Lelystad Holland

PostPosted: Thu Sep 13, 2007 1:40 pm    Post subject:
Reply with quote

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 icon_smile.gif )
Would you be interested in this tool?
Back to top
View user's profile Send private message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Thu Sep 13, 2007 1:50 pm    Post subject:
Reply with quote

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
Back to top
View user's profile Send private message
Zapper

New User


Joined: 12 Sep 2007
Posts: 5
Location: Lelystad Holland

PostPosted: Thu Sep 13, 2007 3:31 pm    Post subject:
Reply with quote

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 icon_smile.gif ).
cu
Back to top
View user's profile Send private message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Thu Sep 13, 2007 4:30 pm    Post subject:
Reply with quote

YES !!!!

That is what I was looking for . Can you please send that utility to me. I would be really thankful.


Thanks,
Rishi/K
Back to top
View user's profile Send private message
Zapper

New User


Joined: 12 Sep 2007
Posts: 5
Location: Lelystad Holland

PostPosted: Thu Sep 13, 2007 7:55 pm    Post subject:
Reply with quote

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*/
Back to top
View user's profile Send private message
Rishi Khare

New User


Joined: 13 Aug 2007
Posts: 16
Location: Mumbai

PostPosted: Thu Sep 27, 2007 6:04 pm    Post subject: Reply to: REXX Utilty for Record Size calculation
Reply with quote

Hi ,
Thanx a lots Man !!! you have been really helpful.

Had a little trobule.....

Can you please explain me what dose the below code do.
when i run this utility it gives me an error ' UNUSABLE OUTPUT'


"ALLOC FI(SYSLIB) DA('CICS630.SDFHCOBQ'",
"'XXXXXXX.P00.COPY'",
"'YYYYYYYY.P00.COPY') SHR"

Thanks ,
Rishi/K
Back to top
View user's profile Send private message
Zapper

New User


Joined: 12 Sep 2007
Posts: 5
Location: Lelystad Holland

PostPosted: Fri Sep 28, 2007 3:47 pm    Post subject: Re: Reply to: REXX Utilty for Record Size calculation
Reply with quote

Rishi Khare wrote:
Hi ,
Thanx a lots Man !!! you have been really helpful.

Had a little trobule.....

Can you please explain me what dose the below code do.
when i run this utility it gives me an error ' UNUSABLE OUTPUT'


"ALLOC FI(SYSLIB) DA('CICS630.SDFHCOBQ'",
"'XXXXXXX.P00.COPY'",
"'YYYYYYYY.P00.COPY') SHR"

Thanks ,
Rishi/K


The error ' UNUSABLE OUTPUT' comes with a faulty compilation.
In this case I think its the code you mentioned.

The datasets associated with SYSLIB are copy libraries.
If there are Copy statements in the part you want to analyse the copy members are included.

Look in a batch compile job for the right copy libraries.
The ones I put in the code a only examples.

You can delete the mentioned lines if you don't need this feature.
It's very handy, though.

Soon I will post a newer version, with a couple of bugs fixed (the occurs thing).
Back to top
View user's profile Send private message
Zapper

New User


Joined: 12 Sep 2007
Posts: 5
Location: Lelystad Holland

PostPosted: Fri Nov 30, 2007 2:21 pm    Post subject: Re: Reply to: REXX Utilty for Record Size calculation
Reply with quote

Zapper wrote:
Rishi Khare wrote:
Hi ,
Thanx a lots Man !!! you have been really helpful.

Had a little trobule.....

Can you please explain me what dose the below code do.
when i run this utility it gives me an error ' UNUSABLE OUTPUT'


"ALLOC FI(SYSLIB) DA('CICS630.SDFHCOBQ'",
"'XXXXXXX.P00.COPY'",
"'YYYYYYYY.P00.COPY') SHR"

Thanks ,
Rishi/K


The error ' UNUSABLE OUTPUT' comes with a faulty compilation.
In this case I think its the code you mentioned.

The datasets associated with SYSLIB are copy libraries.
If there are Copy statements in the part you want to analyse the copy members are included.

Look in a batch compile job for the right copy libraries.
The ones I put in the code a only examples.

You can delete the mentioned lines if you don't need this feature.
It's very handy, though.

Soon I will post a newer version, with a couple of bugs fixed (the occurs thing).


Finally, an update. (I was busy with VAG on my assignment, so I didn't get to testing the macro)
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CLIST & REXX All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts ejck thru rexx to multiple jobs insid... Susanta All Other Mainframe Topics 5 Tue Sep 19, 2017 1:39 pm
This topic is locked: you cannot edit posts or make replies. Extract all "IF" Statements... Adarsh Damodaran CLIST & REXX 1 Wed Sep 06, 2017 9:28 am
No new posts JES2 job size field matching Windows ... SRICOBSAS All Other Mainframe Topics 4 Tue Sep 05, 2017 5:49 pm
No new posts Creating ISPF Screens with Scrname vi... Albireo20 TSO/ISPF 9 Tue Sep 05, 2017 4:24 pm
No new posts How to Run Rexx Macro? Kalaivignesh CLIST & REXX 5 Fri Sep 01, 2017 9:08 pm

Facebook
Back to Top
 
Job Vacancies | Forum Rules | Bookmarks | Subscriptions | FAQ | Polls | Contact Us