Portal | Manuals | References | Downloads | Info | Programs | JCLs | Mainframe wiki | Quick Ref
IBM Mainframe Forum Index
 
Register
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Profile Log in to check your private messages Log in
 
COBDFSYM code text

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> DFSORT/ICETOOL
View previous topic :: :: View next topic  
Author Message
smijoss

Active User


Joined: 30 Aug 2007
Posts: 114
Location: pune

PostPosted: Mon Jul 12, 2010 12:15 pm    Post subject: COBDFSYM code text
Reply with quote

Hi,

Does anyone have the COBDFSYM code. I tried copying it from the PDF but it doesnt seem to work.It enters into some infinite loop. mainly because the text is getting altered.

I got a FTP link. but Ftps are blocked here. can i find it on some site or email it at E-addr removed or may be attach it here.
Back to top
View user's profile Send private message

smijoss

Active User


Joined: 30 Aug 2007
Posts: 114
Location: pune

PostPosted: Mon Jul 12, 2010 8:31 pm    Post subject: Reply to: COBDFSYM code text
Reply with quote

hi..

i found it ... in case any 1 needs it for future referenec.. i have attached it.
(attachment deleted)

Code:
/*REXX - COBDFSYM : Create DFSORT symbols from COBOL listing
*** Freeware courtesy of SEB IT Partner and IBM ***
trace r
*/
call read_coblist
call fix_duplicates
call put_symnames
exit
Put_symnames:
/* Write generated symbol definitions */
   do i = 1 to nf
     queue dnam.i','dval.i
     say   dnam.i','dval.i
   end
/* Write appended  symbol definitions */
   do i = 1 to na
     queue dapp.i
     say   dapp.i
   end
   queue ''
   'EXECIO * DISKW SYMNAMES (FINIS'
   return
Put_line:
/*   Analyze Data Division Map line     */
   parse var line linenr level dataname .
   parse var dataname dataname '.' .
   if dataname = 'FILLER'   then Return
   if level = 'PROGRAM-ID'  then Return
   if level = 88            then Do
     nf = nf + 1
     dnam.nf  = dataname
     dval.nf  = d88.linenr
     dlvl.nf  = lev
     Return
   end
   blk      = substr(line,64,4)
   if level = 1 then nf = 0
   hexoff   = substr(line,79,3) || substr(line,83,3)
   if hexoff = '      ' then hexoff = '000000'
   parse var line 92 asmdef datatyp .
   if datatyp = 'Group' | datatyp = 'Grp-VarLen'
        then parse var asmdef . 'CL' len
        else do
         len = left(asmdef,length(asmdef)-1)
         if right(asmdef,2) = '1H' then len = 2
         if right(asmdef,2) = '1F' then len = 4
         if right(asmdef,2) = '2F' then len = 8
        end

   select
     when datatyp = 'Group'         then typ = 'CH'
     when datatyp = 'Grp-VarLen'    then typ = 'CH'
     when datatyp = 'Display'       then typ = 'CH'
     when datatyp = 'Disp-Num'      then typ = 'ZD'
     when datatyp = 'Packed-Dec'    then typ = 'PD'
     when datatyp = 'Binary'        then typ = 'FI'
     when datatyp = 'Comp-1'        then typ = 'FL'
     when datatyp = 'Comp-2'        then typ = 'FL'
     otherwise                           typ = 'CH'
   end
   if typ = 'FI' then do
     if s9.linenr /= 'Y' then typ = 'BI'
   end
   else do
     if typ = 'ZD' then
       if sp.linenr = 'Y' then
         if ld.linenr = 'Y' then typ = 'FS'
         else typ = 'CST'
       else
         if ld.linenr = 'Y' then typ = 'CLO'
   end
   off = 1 + x2d(hexoff)
   nf = nf + 1
   dnam.nf  = dataname
   dval.nf  = off','len','typ
   dlvl.nf  = lev
Return
Read_COBLIST:
   l88 = 0
   lx = 0
   na  = 0
   'EXECIO * DISKR COBLIST (FINIS'
   parse pull line
   do until substr(line,2,16)  = '  LineID  PL SL '
      parse pull line
   end
/* Process program text lines */
   do until substr(line,2,16) /= '  LineID  PL SL '
      parse pull line
      do until left(line,1) = '1'
         call Check_Code_line
         parse pull line
      end
      parse pull line
   end
/* Skip lines */
   do until substr(line,2,18)  = 'LineID   Data Name'
      parse pull line
   end
/* Process Data Division Map lines */
   do until substr(line,2,18) /= 'LineID   Data Name'
      parse pull line
      do until left(line,1) = '1'
         call Put_line
         parse pull line
      end
      parse pull line
      parse pull line
   end
/* Skip rest  */
   do until queued() = 0
      parse pull line
   end
Return
Fix_Duplicates:
/* Append _n to any duplicate data names */
   nd = 0
   tdup. = ''
   Do i = 1 to nf
      nam = dnam.i
      parse var tdup.nam flag i1
      if flag     = '' then do
         tdup.nam = '0' i
         iterate
      end
      if flag     = '0' then do
         nd = nd + 1
         td1.nd = i1 i
         tdup.nam = '1' nd
         iterate
      end
      td1.i1 = td1.i1 i
   End
   Do id = 1 to nd
      parse var td1.id i tail
      n = 0
      Do while i /= ''
         n = n + 1
         dnam.i = dnam.i || '_' || n
         parse var tail i tail
      End
   End
Return
Check_code_line:
/* Analyze program text line , capture 88 VALUE clauses */
/* Capture S9, LEADING, SEPARATE parameters             */
/* Make append lines from *+ comments                   */
   parse var line 4 linenr 10 flag . 19 . 25 stmt 91
   if linenr = '' then return
   linenr = linenr + 0
   if left(stmt,2) = '*+' then do
     na = na + 1
     dapp.na = substr(stmt,3)
     return
   end
   if left(stmt,1) = '*'  then return
   if left(stmt,1) = '/'  then return
   if lastpos('.',stmt) = 0 then do
     parse pull line
     if left(line,1) = '1' then parse pull line
     if substr(line,2,16) = '  LineID  PL SL ' then parse pull line
     parse var line 4 x1 10 x2 . 19 . 25 stmt2 91
     stmt = stmt||stmt2
   end
   parse var stmt w1 .
   if w1 = '88' then do
    l88 = linenr
    if l88 /= 0 then do
      parse var stmt . 'VALUE' tail
      if tail /= '' then do
         parse var tail value '.' .
         d88.l88 = strip(value)
         if left(d88.l88,6) = 'SPACES'
           then d88.l88 = ''' '''
         if left(d88.l88,4) = 'ZERO'
           then d88.l88 = '0'
         if left(d88.l88,9) = 'LOW-VALUE'
           then d88.l88 = 'X''00'''
         l88 = 0
      end
    end
    return
   end
   else do
    lx = linenr
    if lx /= 0 then do
     parse var stmt x1 x2 x3
     if pos(' S9',x3) /=0 then s9.lx = 'Y'
     if pos(' LEADING',x3) /=0 then ld.lx ='Y'
     if pos(' SEPARATE',x3) /=0 then sp.lx = 'Y'
     lx = 0
    end
   end
Return
Back to top
View user's profile Send private message
dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6970
Location: porcelain throne

PostPosted: Mon Jul 12, 2010 8:42 pm    Post subject:
Reply with quote

does the download contain the version that
Quote:
... doesnt seem to work.It enters into some infinite loop. mainly because the text is getting altered.


or does the download contain code that actually works?
Back to top
View user's profile Send private message
smijoss

Active User


Joined: 30 Aug 2007
Posts: 114
Location: pune

PostPosted: Tue Jul 13, 2010 11:22 am    Post subject:
Reply with quote

the first code i had taken from the PDF. it didnt work since multiple spaces were getting converted to 1.

However the one i obtained from the FTP site too seems to be in a deadlock.

Has anyone faced such a problem ??
Back to top
View user's profile Send private message
smijoss

Active User


Joined: 30 Aug 2007
Posts: 114
Location: pune

PostPosted: Tue Jul 13, 2010 1:54 pm    Post subject:
Reply with quote

HI ,

it finally worked. the code had to be converted into uppercase.

found it by trace r. my mistake.
Back to top
View user's profile Send private message
dick scherrer

Site Director


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

PostPosted: Tue Jul 13, 2010 7:37 pm    Post subject: Reply to: COBDFSYM code text
Reply with quote

Thanks for letting us know icon_smile.gif

d
Back to top
View user's profile Send private message
Frank Yaeger

DFSORT Moderator


Joined: 15 Feb 2005
Posts: 7130
Location: San Jose, CA

PostPosted: Tue Jul 13, 2010 10:54 pm    Post subject:
Reply with quote

Quote:
However the one i obtained from the FTP site too seems to be in a deadlock.


Quote:
it finally worked. the code had to be converted into uppercase.


This must be something peculiar to your system. I've run COBDFSYM fine as downloaded with no changes (as have many other people).
Back to top
View user's profile Send private message
Ronald Burr

Active User


Joined: 22 Oct 2009
Posts: 293
Location: U.S.A.

PostPosted: Tue Jul 13, 2010 11:16 pm    Post subject:
Reply with quote

Frank, I "think" he meant that the COBOL source code ( input to the Rexx Exec ) had to be changed to all uppercase, not the Rexx Exec itself.
Back to top
View user's profile Send private message
Frank Yaeger

DFSORT Moderator


Joined: 15 Feb 2005
Posts: 7130
Location: San Jose, CA

PostPosted: Tue Jul 13, 2010 11:20 pm    Post subject:
Reply with quote

Wow, I never would have figured that out from what the OP posted considering he never even mentioned the COBOL source code.
Back to top
View user's profile Send private message
smijoss

Active User


Joined: 30 Aug 2007
Posts: 114
Location: pune

PostPosted: Wed Jul 14, 2010 2:00 pm    Post subject:
Reply with quote

No. i had to change the REXX code to upper case.

the cobol source code is always in capital .. i have never seen them in lowercase.
Back to top
View user's profile Send private message
enrico-sorichetti

Senior Member


Joined: 14 Mar 2007
Posts: 10696
Location: italy

PostPosted: Wed Jul 14, 2010 2:46 pm    Post subject: Reply to: COBDFSYM code text
Reply with quote

Quote:
No. i had to change the REXX code to upper case.


the problem must be somewhere else, and You inferred a wrong conclusion!

mixed case REXX scripts have always worked without any issues
Back to top
View user's profile Send private message
dick scherrer

Site Director


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

PostPosted: Wed Jul 14, 2010 8:03 pm    Post subject:
Reply with quote

Hello,

Quote:
the cobol source code is always in capital .. i have never seen them in lowercase.
The posted rexx looks like it will only work for COBOL source with uppercase, but the compiler allows source with mixed case.
Back to top
View user's profile Send private message
ojdiaz

New User


Joined: 19 Nov 2008
Posts: 90
Location: Spain

PostPosted: Thu Jul 15, 2010 2:16 pm    Post subject:
Reply with quote

Sometime in the past it happened the same to me. I downloaded the code from a different source and it worked. I think that the one in the PDF worked fine for me. My problem was that when I uploaded it to the HOST system, all "|" were changed to "&" chars and that gave me errors, but i don't remember if that was the infinite loop.

As for the rexx code, it works fine in all the shops i have used it with mixed case letters
Back to top
View user's profile Send private message
mbizzle

New User


Joined: 06 May 2020
Posts: 7
Location: United States

PostPosted: Wed May 06, 2020 6:55 pm    Post subject:
Reply with quote

I registered just so I could share this fix to COBDFSYM.

I had been using it for a few years now, and loved it and was sad when our upgrade from cobol compiler V4 to V6 bricked this program. Luckily, it was a fairly simple fix to update it.
Here are the fixes you need to make to allow it to be compatible with the V6 (and i assume V5) compilers.
I am posting this on a few forums so that others may find it that have the same issue.

change this line
parse var line 92 asmdef datatyp .
to
parse var line 87 asmdef datatyp .

and add this line

do until left(line,1) = '1'
call Put_line
parse pull line
if pos('End of Data Division Map',line)<> 0 then leave
end
Back to top
View user's profile Send private message
sergeyken

Active Member


Joined: 29 Apr 2008
Posts: 810
Location: Maryland

PostPosted: Thu May 07, 2020 11:36 pm    Post subject:
Reply with quote

No "fool-proof" protection.

If //COBLIST DD isn't an exact compiler listing, the code enters an indefinite loop without any trace of that problem...
Back to top
View user's profile Send private message
mbizzle

New User


Joined: 06 May 2020
Posts: 7
Location: United States

PostPosted: Thu May 07, 2020 11:41 pm    Post subject:
Reply with quote

sergeyken wrote:
No "fool-proof" protection.

If //COBLIST DD isn't an exact compiler listing, the code enters an indefinite loop without any trace of that problem...


I wholeheartedly agree. If I had the time or energy, I would just gut and rewrite the program, but fortunately (or unfortunately) it works . I was always surprised by the sloppiness of this code, especially considering that it was written by IBM. Most of the code snippits and samples they include always seem to be elegantly written. This one, however, seems almost like an afterthought.
It would be nice if they included a compile option to produce this dataset , i.e. like write it out to a SYMNAMES dataset.
Back to top
View user's profile Send private message
sergeyken

Active Member


Joined: 29 Apr 2008
Posts: 810
Location: Maryland

PostPosted: Fri May 08, 2020 3:55 am    Post subject:
Reply with quote

I wrote similar converters myself, separately for three companies (it was strictly prohibited to move any used code into outside world); I had to rewrite the same things several times...

In my case I had to convert not the compiler listing, but different types of source code(s): copybooks (VSAM<->DB2<->FTP) <-> LOAD/UNLOAD statements for different UNLOAD utilities <-> SYMNAMES table(s), to adjust fields between VSAM/DB2, and to ETL to other platforms.
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 -> DFSORT/ICETOOL All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts VSAM I/O - Extended Addressability - ... amitsjcntl JCL & VSAM 12 Mon Jul 06, 2020 3:51 pm
No new posts Force a Return Code and print error m... Rick Ryan SYNCSORT 30 Thu Jun 25, 2020 1:18 am
No new posts trying to set return code in PROC tanvi110788 JCL & VSAM 16 Wed May 20, 2020 2:02 pm
No new posts Need help in REXX code to list the af... chavinash2004 CLIST & REXX 3 Wed Apr 01, 2020 12:53 pm
No new posts Error Creating KSDS file, REASON CODE... sandeep prajapati JCL & VSAM 8 Tue Mar 24, 2020 12:05 pm

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