|
View previous topic :: View next topic
|
| Author |
Message |
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
| Quote: |
| I have programs calling an assembler routine to get the DSNAME for a DDNAME, 'surfing' Data Areas from Cobol... |
Does your "COBOL only" code work in z/OS 1.9? There have been a couple of COBOL routines posted here (in the forum) but when i tried to use them on a client machine, they did not work completely correctly (problem with actually returning the dsn).
A couple of my clients have no REXX expertise and are unwilling to use "stuff" they feel they cannot support. . .
Are you willing/able to post your routine? If not, no problem, i'll just delete this part of the topic  |
|
| Back to top |
|
 |
Marso
REXX Moderator
Joined: 13 Mar 2006
Posts: 1353
Location: Israel
|
|
|
|
Or you could agree with Pedro:
| Pedro wrote: |
| Agree with Marso: VPUT in your rexx program, and VGET in your cobol |
 |
|
| Back to top |
|
|
enrico-sorichetti
Superior Member
Joined: 14 Mar 2007
Posts: 10873
Location: italy
|
|
|
|
for the long windy, useless road check FAN140.SEAGSAM(EAGGXCOB)
for an easier way google for COBOL DDNAME and You should get a link to something like
Getting DSN name in a COBOL program - Application Forum at ...
which contain a cobol code snippet that will do just that...
given an allocated DDNAME return the DSNAME
did not seem so complicated to me to google  |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
| Quote: |
| did not seem so complicated to me to google |
Yup, easy to Google and get "hits". Unfortunately, none of the code i tried would work correctly on the client's 1.9 system - which is not scheduled to be upgraded uneil sometime next year. . .
d |
|
| Back to top |
|
|
acevedo
Active User
Joined: 11 May 2005
Posts: 344
Location: Spain
|
|
|
|
| dick scherrer wrote: |
Are you willing/able to post your routine? If not, no problem, i'll just delete this part of the topic |
OF COURSE, we are here under 1.9 and this code runs fine, I remember translating from Rexx to cobol the SWAREQ function, change it according to your needs, or make it a module as we did it here, nowadays we have only the Rexx and Assembler options.
| Code: |
CBL TRUNC(BIN)
*================================================================*
* DSNAMES desde la DSAB *
*
*
* /*--------------------------------------------------------------
* swareq: procedure
* if right(c2x(arg(1)),1)¬=translate('F') then /* swa=below ?
* return c2d(arg(1))+16 /* yes, return sva+16
* numeric digits 10 /* allow up to 7ffffff
* sva=c2d(arg(1)) /* convert to decimal
* tcb = c2d(storage(21c,4)) /* tcb psatold
* jscb = c2d(storage(d2x(tcb+180),4)) /* jscb tcbjscb
* qmpl = c2d(storage(d2x(jscb+244),4)) /* qmpl jscbqmp
* qmat = c2d(storage(d2x(qmpl+24),4)) /* qmat qmadd
* do while sva>65536
* qmat = c2d(storage(d2x(qmat+12),4)) /* next qmat qmat+12
* sva=sva-65536 /* 010006f -> 000006f
* end
* return c2d(storage(d2x(qmat+sva+1),4))+16
*
*--------------------------------------------------------------
* identification division
*================================================================*
identification division.
program-id. qw3calo.
data division.
*----------------------------------------------------------------*
* working-storage section
*----------------------------------------------------------------*
working-storage section.
01 filler.
05 swa-place pic x(5).
05 four-bytes.
10 w-binary-4 pic s9(8) comp.
10 w-pointer-4 redefines w-binary-4 pointer.
05 w-binary pic s9(8) comp.
*----------------------------------------------------------------*
* linkage section
*----------------------------------------------------------------*
linkage section.
01 psa.
05 filler pic x(540).
05 psatold pointer.
01 tcb.
05 filler pic x(180).
05 tcbjscb pointer.
01 jscb.
05 filler pic x(244).
05 jscbqmpi pointer.
05 filler pic x(13).
05 jscjctp pic x(3).
05 filler pic x(56).
05 jscdsabq pointer.
01 jct.
05 filler pic x(31).
05 jctjcsmf pic x.
05 filler pic x(84).
05 jctstat2 pic x.
* 01 qmpl. pic x(32).
01 qmpl.
05 filler pic x(24).
05 qmat-x.
10 qmat-fw pic s9(8) comp.
10 qmat-p redefines qmat-fw pointer.
01 qmat.
10 filler pointer occurs 16384.
01 qdb.
05 filler pic x(12).
05 dsqfrstp pointer.
01 dsab.
05 dsabid pic x(4).
05 dsabfchn pointer.
05 filler pic x(13).
05 dsabssva pic x(3).
05 filler pic x(24).
05 dsabssnm pic x(4).
01 siot.
05 filler pic x(4).
05 sctddnam pic x(8).
05 filler pic x(144).
05 sjfcbptr pointer.
01 jfcb.
05 jfcbdsnm pic x(44).
05 jfcbelem pic x(8).
05 filler pic x(66).
05 jfcbvols pic x(30).
procedure division.
set address of psa to null
set address of tcb to psatold
set address of jscb to tcbjscb
set address of qmpl to jscbqmpi
set address of qdb to jscdsabq
set address of dsab to dsqfrstp
** determinar emplazamiento de la swa
move jscjctp to four-bytes(2:3)
add 16 to w-binary-4
set address of jct to w-pointer-4
move jctstat2 to four-bytes(4:1)
divide w-binary-4 by 2 giving w-binary-4 remainder w-binary
if w-binary = 1 then
move 'ABOVE' to swa-place
else
move 'BELOW' to swa-place
end-if
display ' class=' jctjcsmf
' swa=' swa-place
** recuperar allocates desde la dsab.
perform varying w-binary-4 from 1 by 1
until dsabid not = 'DSAB'
move dsabssva to four-bytes(2:3)
if swa-place = 'ABOVE' then
* set address of qmat to qmat-p
move low-values to four-bytes(1:1)
compute w-binary-4 = w-binary-4 + qmat-fw + 1
set address of qmat to w-pointer-4
move qmat(1:4) to four-bytes
end-if
add 16 to w-binary-4
set address of siot to w-pointer-4
set address of jfcb to sjfcbptr
if dsabssnm = low-values then
display ' ddname=' sctddnam
' dsname=' jfcbdsnm
' member=' jfcbelem
' volser=' jfcbvols
else
display ' ddname=' sctddnam
' dsname=' jfcbdsnm
' subsys=' dsabssnm
' class=' siot(81:1)
' form=' siot(77:4)
end-if
* proximo
set address of dsab to dsabfchn
end-perform
goback.
|
| dick scherrer wrote: |
A couple of my clients have no REXX expertise and are unwilling to use "stuff" they feel they cannot support. . . : |
I'm not a Cobol expert nor a Rexx expert, but IMHO this:
| Code: |
/*Rexx */
arg DDNAME
X = LISTDSI(DDNAME "FILE")
queue LEFT(SYSDSNAME,44) Syslrecl SYSrecfm
"execio 1 diskw DDINFO"
Exit |
it's much easier to maintain and understand than the Cobol option.
hth
;) |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Thank you
After today, i'll be away from a mainframe for a few days. I'll put this on a system and post back here the results (probably next week sometime).
| Quote: |
| it's much easier to maintain and understand than the Cobol option. |
Yup, i completely agree, but sometimes it is most difficult to get ideas to move forward (i.e the "that's the way we've always done it" syndrome)<g>
Thanks again - have wonderful Christmas and New Year!
d |
|
| Back to top |
|
|
|
|
