|
View previous topic :: View next topic
|
| Author |
Message |
smijoss
Active User
Joined: 30 Aug 2007
Posts: 114
Location: pune
|
|
|
|
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 |
|
 |
smijoss
Active User
Joined: 30 Aug 2007
Posts: 114
Location: pune
|
|
|
|
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 |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
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 |
|
|
smijoss
Active User
Joined: 30 Aug 2007
Posts: 114
Location: pune
|
|
|
|
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 |
|
|
smijoss
Active User
Joined: 30 Aug 2007
Posts: 114
Location: pune
|
|
|
|
HI ,
it finally worked. the code had to be converted into uppercase.
found it by trace r. my mistake. |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Thanks for letting us know 
d |
|
| Back to top |
|
|
Frank Yaeger
DFSORT Developer
Joined: 15 Feb 2005
Posts: 7129
Location: San Jose, CA
|
|
|
|
| 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 |
|
|
Ronald Burr
Active User
Joined: 22 Oct 2009
Posts: 293
Location: U.S.A.
|
|
|
|
| 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 |
|
|
Frank Yaeger
DFSORT Developer
Joined: 15 Feb 2005
Posts: 7129
Location: San Jose, CA
|
|
|
|
| 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 |
|
|
smijoss
Active User
Joined: 30 Aug 2007
Posts: 114
Location: pune
|
|
|
|
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 |
|
|
enrico-sorichetti
Superior Member
Joined: 14 Mar 2007
Posts: 10873
Location: italy
|
|
|
|
| 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 |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
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 |
|
|
ojdiaz
New User
Joined: 19 Nov 2008
Posts: 98
Location: Spain
|
|
|
|
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 |
|
|
mbizzle
New User
Joined: 06 May 2020
Posts: 7
Location: United States
|
|
|
|
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 |
|
|
sergeyken
Senior Member
Joined: 29 Apr 2008
Posts: 2022
Location: USA
|
|
|
|
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 |
|
|
mbizzle
New User
Joined: 06 May 2020
Posts: 7
Location: United States
|
|
|
|
| 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 |
|
|
sergeyken
Senior Member
Joined: 29 Apr 2008
Posts: 2022
Location: USA
|
|
|
|
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 |
|
|
Pedro
Global Moderator
Joined: 01 Sep 2006
Posts: 2547
Location: Silicon Valley
|
|
|
|
| The source to COBDFSYM is above. Can someone apply the changes recommend by mbizzle above and post the entire program here? (it is freeware) |
|
| Back to top |
|
|
|
|
