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
 
Pass data back from Rexx to COBOL
Goto page Previous  1, 2
 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CLIST & REXX
View previous topic :: :: View next topic  
Author Message
dick scherrer

Site Director


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

PostPosted: Wed Dec 22, 2010 8:47 pm    Post subject:
Reply with quote

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

Marso

REXX Moderator


Joined: 13 Mar 2006
Posts: 1321
Location: Israel

PostPosted: Wed Dec 22, 2010 8:50 pm    Post subject: Re: Reply to: Pass data back from Rexx to COBOL
Reply with quote

Or you could agree with Pedro:
Pedro wrote:
Agree with Marso: VPUT in your rexx program, and VGET in your cobol
icon_smile.gif
Back to top
View user's profile Send private message
enrico-sorichetti

Senior Member


Joined: 14 Mar 2007
Posts: 10614
Location: italy

PostPosted: Wed Dec 22, 2010 10:27 pm    Post subject: Reply to: Pass data back from Rexx to COBOL
Reply with quote

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 icon_cool.gif
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: Thu Dec 23, 2010 12:43 am    Post subject: Reply to: Pass data back from Rexx to COBOL
Reply with quote

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
View user's profile Send private message
acevedo

Active User


Joined: 11 May 2005
Posts: 344
Location: Spain

PostPosted: Thu Dec 23, 2010 3:02 pm    Post subject:
Reply with quote

dick scherrer wrote:

Are you willing/able to post your routine? If not, no problem, i'll just delete this part of the topic icon_wink.gif



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
View user's profile Send private message
dick scherrer

Site Director


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

PostPosted: Thu Dec 23, 2010 8:19 pm    Post subject: Reply to: Pass data back from Rexx to COBOL
Reply with quote

Thank you icon_smile.gif

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
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
Goto page Previous  1, 2
Page 2 of 2

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts REXX exec (opercmd) failing quietly o... Mike.Fulton All Other Mainframe Topics 2 Sat Aug 03, 2019 4:45 am
No new posts Training on numeric fields data formats sergeyken SYNCSORT 11 Thu Aug 01, 2019 8:15 pm
No new posts Upgrade to Enterprise COBOL 6 JPVRoff COBOL Programming 2 Thu Aug 01, 2019 7:21 am
No new posts COBOL copybook to Focus anandgbe COBOL Programming 7 Wed Jul 31, 2019 11:52 am
No new posts Can I use Tableau/PowerBI kind data a... rohanthengal All Other Mainframe Topics 2 Wed Jul 24, 2019 4:43 pm

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