Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

How to skin a cat

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

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Tue Feb 16, 2016 5:15 pm    Post subject: How to skin a cat
Reply with quote

So you've written this great exec, and want to make it available to everyone, but it needs some panels, messages and skeletons?

How would you distribute it?
  • as a set of four libraries?
  • as just one library, and LIBDEF that one several times?
  • as a single EXEC member, and create all others on-the-fly?

    • by reading your exec via sourceline()?
    • by building a stem?
Oops, your exec needs to invoke a program? And your version of z/OS & REXX do no (yet) support EXECIO on RECFM=U datasets? How would you include the LOAD library in your exec?

Any interesting thoughts about this? Please share them!
Back to top
View user's profile Send private message

vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1445
Location: Azeroth

PostPosted: Tue Feb 16, 2016 10:16 pm    Post subject:
Reply with quote

I've not written any great exec, Hypothetically, I like "as a single EXEC member, and create all others on-the-fly? "

Having the exec make compatibility checks like REXX version before actually executing the module.
Back to top
View user's profile Send private message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10202
Location: italy

PostPosted: Tue Feb 16, 2016 10:22 pm    Post subject: Reply to: How to skin a cat
Reply with quote

it is not a problem to have inline the rest of the scripts, the panels, the skels, the messages and even the tables, all fb 80 things
and expand them on the fly,
the problem are the load modules.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Tue Feb 16, 2016 10:34 pm    Post subject: Re: Reply to: How to skin a cat
Reply with quote

enrico-sorichetti wrote:
it is not a problem to have inline the rest of the scripts, the panels, the skels, the messages and even the tables, all fb 80 things
and expand them on the fly,

It's not, in general, until you renumber your exec and screw up the panel... (If you're a renumberer like me...)

enrico-sorichetti wrote:
the problem are the load modules.

Actually, it's not, but before I give the two(!) very easy ways to do this, I'll let the collected membership ponder a bit longer on it. ;)
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1445
Location: Azeroth

PostPosted: Tue Feb 16, 2016 10:40 pm    Post subject:
Reply with quote

IBM - Sub Capacity Reporting Tool - Classic version is a neat single JCL, which comprises of JCL and load module all in one member. Just run it and it creates reports on the fly.

It uses PGM=LOADER - https://www-01.ibm.com/support/knowledgecenter/SSLTBW_2.1.0/com.ibm.zos.v2r1.ceea200/clcklk.htm

I am no expert on PGM=LOADER either, just used it once and it looked neat.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Tue Feb 16, 2016 10:49 pm    Post subject:
Reply with quote

vasanthz wrote:
IBM - Sub Capacity Reporting Tool - Classic version is a neat single JCL, which comprises of JCL and load module all in one member. Just run it and it creates reports on the fly.

It uses PGM=LOADER - https://www-01.ibm.com/support/knowledgecenter/SSLTBW_2.1.0/com.ibm.zos.v2r1.ceea200/clcklk.htm

I am not expert on PGM=LOADER either, just used it once and it looked neat.

That's a third way, but it would be pretty bad when there are no initiators available, and you spend the next twenty minutes twiddling your thumbs staring at your screen... (Unless you run it in your TSO session)

My two methods are, I think, and, I'm obviously hugely biased, a bit more elegant.
Back to top
View user's profile Send private message
Willy Jensen

New User


Joined: 01 Sep 2015
Posts: 96
Location: Switzerland

PostPosted: Wed Feb 17, 2016 12:46 am    Post subject:
Reply with quote

I would say it depends on the complexity of the application. I personally like to ship EXECs, panels, skeletons and even tables (I normally just use the ISRZ00 message) in one library and use libdef with 'LIBRARY' keyword for ISPF thingies, and ALTLIB for the REXX lib. You can go up to lrecl 160 or more for those libs by the way (check the ISPF manual for details).
For the loadlibs I use the STEPLIB program from CBTAPE.ORG. Even if you could read the module with REXX, you couldn't execute it (unless I'm missing something here).
I have done all inline, but that adds a different level of complexity to your program.
So, whatever makes sense for the given application.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Wed Feb 17, 2016 1:33 am    Post subject:
Reply with quote

Willy Jensen wrote:
For the loadlibs I use the STEPLIB program from CBTAPE.ORG. Even if you could read the module with REXX, you couldn't execute it (unless I'm missing something here).

You're wrong and tomorrow (or at the latest on Thursday) I'll show how easy it is to add an easily extractable load-library in an exec. ;)
Back to top
View user's profile Send private message
Pedro

Senior Member


Joined: 01 Sep 2006
Posts: 2019
Location: Silicon Valley

PostPosted: Wed Feb 17, 2016 6:07 am    Post subject: Reply to: How to skin a cat
Reply with quote

For load modules, I think you can deliver the OBJ files and invoke the linkage editor from your rexx.

Actually, my preference is to deliver individual data sets for each type of part.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Wed Feb 17, 2016 6:12 am    Post subject: Re: Reply to: How to skin a cat
Reply with quote

Pedro wrote:
For load modules, I think you can deliver the OBJ files and invoke the linkage editor from your rexx.

With all(?) dependencies? Solution four, but probably also not ideal.

Pedro wrote:
Actually, my preference is to deliver individual data sets for each type of part.
One IBM program: TASID...

All-in-one solutions are so much more reliable, you don't forget anything and everything can be updated in one place.
Back to top
View user's profile Send private message
don.leahy

Active Member


Joined: 06 Jul 2010
Posts: 641
Location: Whitby, ON, Canada

PostPosted: Wed Feb 17, 2016 9:06 pm    Post subject:
Reply with quote

I package my stuff into a series of publicly accessible data sets. I then supply a startup procedure for each tool that LIBDEFs/ALTLIBs what the tool needs. I also supply instructions on how each user can incorporate the stuff into their own ISPF environment, should they choose to do that. (I have an 'open source' mentality regarding my creations and do not mind if my users tinker with them....this is not production code after all).

For load modules, a LIBDEF to ISPLLIB is usually all I need to supply. In some cases I use a (inhouse?) program called CALLTLIB that executes load modules from dd statement TASKLIB.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Wed Feb 17, 2016 9:26 pm    Post subject:
Reply with quote

Most of what I've written is available for those on "that" (aka FanDeZhi) site, just get a userid and ask me for RACF read permission on my datasets. Just would appreciate it if you'll let me know where you are using it, especially if you use them in a corporate environment.

Anyway, my two methods of actually storing the load modules in on-the-fly extractable format will be published on this site tomorrow, and I want honest answers to the "Sheesh, why didn't I think of that?" question!
Back to top
View user's profile Send private message
don.leahy

Active Member


Joined: 06 Jul 2010
Posts: 641
Location: Whitby, ON, Canada

PostPosted: Wed Feb 17, 2016 11:04 pm    Post subject:
Reply with quote

I am thinking XMIT, but I have never used it for this purpose and am not sure that it would work.
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Wed Feb 17, 2016 11:41 pm    Post subject:
Reply with quote

don.leahy wrote:
I am thinking XMIT, but I have never used it for this purpose and am not sure that it would work.

Bravo!!!

That's the original method I used until a few weeks ago. It works, but you need to jump through some hoops to get it to work.

Here's how I use it in my "QH" exec, which invokes Doug Nadel's ISPFHTML utility. Note that the 576 excluded lines can be obtained by contacting me directly.*

Using an XMIT file seems to have the disadvantage that you cannot provide seamless processing (or at least, I've never managed to do so), the code will stop. I use this "feature" to display a small pop-up help screen to show the options that are available once the load-library has been created, and for this exec it's actually required to create a "real" load library, rather than a "new,delete,delete" temporary one.

The key to extracting the XMIT file are the five
Code:
queue "receive indsn('"ispdyn"(ispfhtml)')"
queue "dsn(ispfhtml.load) sysout(a)"

zcmd = ';'moi ?
"ispexec control nondispl end"
"ispexec display panel(isr@prim)"

statements in the help procedure. I'll leave it up to the interested reader to figure out what they do.
Code:
/* REXX exec to invoke Doug Nadel's ISPFHTML utility                  */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2007-2012               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2012-09-24 | RAHP | Get rid of extension nonsense                | *
* |------------+------+----------------------------------------------| *
* | 2009-03-16 | RAHP | Replace LISTDSI by BXPWDYN                   | *
* |------------+------+----------------------------------------------| *
* | 2007-09-24 | RAHP | Remove call to 'GETTEMP'                     | *
* |------------+------+----------------------------------------------| *
* | 2007-09-03 | RAHP | Include Doug Nadel's ISPFHTML load library   | *
* |------------+------+----------------------------------------------| *
* | 2007-08-30 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* QH is a REXX exec to invoke Doug Nadel's ISTPHTML utility to capture *
* ISPF screens to HTML. Ideally it should be assigned to a PF key.     *
*                                                                      *
* See <http://www.sillysot.com/mvs/> for the manual (Gone...)          *
***********************************************************************/
parse source source
parse value source with . . moi .

arg parm

parm = translate(space(parm))

rc = sysdsn("'"userid()".ispfhtml.load'")
if rc \= 'OK' then
  do
    call help
    exit
  end

select
  when parm = ''     then opt = ''
  when parm = 'NS'   then opt = ',nostart'
  when parm = 'NE'   then opt = ',noend'
  when parm = 'A'    then opt = ',append'
  when parm = 'AN'   then opt = ',append,nostart,noend'
  when parm = 'ANS'  then opt = ',append,nostart'
  when parm = 'ANE'  then opt = ',append,noend'
  otherwise
    do
      call help
      exit
    end
end

"ispexec libdef ispllib " ||,
                "dataset id('"userid()".ispfhtml.load') stack"
"ispexec select pgm(ispfhtml) parm(html"opt")"
"ispexec libdef ispllib"
exit

/***********************************************************************
* HELP:                                                                *
*                                                                      *
* Display a small help panel                                           *
***********************************************************************/
help:
  call load_dynlib

  rc = sysdsn("'"userid()".ispfhtml.load'")
  if rc \= 'OK' then
    do
      queue "receive indsn('"ispdyn"(ispfhtml)')"
      queue "dsn(ispfhtml.load) sysout(a)"

      zcmd = ';'moi ?
      "ispexec control nondispl end"
      "ispexec display panel(isr@prim)"
      exit
    end

  "ispexec libdef ispplib library id("dynlib") stack"

  zwinttl = 'QH Options'
  "ispexec addpop row(10) column(-1)"
  "ispexec display panel ("moi")"
  "ispexec rempop"

  "ispexec libdef ispplib"
  "free f("dynlib")"
return

/***********************************************************************
* LOAD_DYNLIB:                                                         *
*                                                                      *
* This procedure loads the via EPANQ generated panel, message and      *
* skeleton code into a library. Note that there is no reason to use    *
* different libraries for any of these objects, as long as they are    *
* named differently!                                                   *
***********************************************************************/
load_dynlib:
dynlib = 'dyn'random(99999)
alloc  = "alloc fi("dynlib") rtdsn(sysdsname) "   ||,
                   "lrecl(80) blksize(0) dir(5) " ||,
                   "new delete reuse "            ||,
                   "space(1,1)"
rc = bpxwdyn(alloc)

if rc = 0 then
  ispdyn = sysdsname
else
  ispdyn = 'NOT FOUND'

"newstack"

member = moi

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 2007-' ||,
      '2007              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 2007-08-30 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - QH                                       ' ||,
      '                  *' || '/'
queue '/' || '*                                                  ' ||,
      '                  *' || '/'
queue '/' || '* This panel is used by the QH exec to display the ' ||,
      'possible options  *' || '/'
queue '/' || '* available.                                       ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' ¢ type(text) intens(high) color(yellow)'
queue ' ~ type(text) intens(high) color(green)'
queue ' $ type(text) intens(high) color(yellow)'
queue ' '
queue ')body window(77,8)'
queue '%''?''  $-~Display this panel'
queue '%None $-~Capture the screen to a new file'
queue '%''NS'' $-~Capture screen to new file, without table start' ||,
      'ing html'
queue '%''NE'' $-~Capture screen to new file, without table endin' ||,
      'g html'
queue '%''A''  $-~Append screen to file'
queue '%''AN ''$-~Append screen to file, without table starting o' ||,
      'r ending html'
queue '%''ANE''$-~Append screen to file, without table ending htm' ||,
      'l'
queue '%''ANS''$-~Append screen to file, without table starting h' ||,
      'tml'
queue ')init'
queue ')proc'
queue '  .resp = end'
queue ')end'

call put_object

"newstack"

member = 'ispfhtml'

queue x2c(50E0C9D5D4D9F0F100420001000150101100010007C3C1D9D4E5E2F1) ||,
      x2c(101200010005D5C1C4C5D3100100010001C1100200010001C1102400) ||,
      x2c(01000EF2F0F0F0F0F1F2F0F1F9F4F4F5F6102F0001000101)
-  -  -  -  -  -  -  -  -  -  -  -  -  -  -   576 Line(s) not Displayed
queue x2c(E0C9D5D4D9F0F6)

put_object:
  tfil = 'tfil'random(9999)

  "alloc f("tfil") da('"ispdyn"("member")') shr reu"
  "execio" queued() "diskw "tfil" (finis"
  "free f("tfil")"

  "delstack"
return

* Offer only available to real z/OS professionals!
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Thu Feb 18, 2016 3:30 pm    Post subject:
Reply with quote

As promised, the other more transparent way, which does not suffer from the lack of seamless processing the XMIT method seems to suffer from:

Don't use XMIT, use AMATERSE!

Code:
/* REXX exec to invoke the FORCOMP program                            */
/***********************************************************************
* This is a heavily enhanced version of the FOCO#C CLIST to invoke the *
* FORCOMP program. The most significant enhancements are:              *
*                                                                      *
* - when run from this library, the exec is completely self-contained  *
*   in that the library is LIBDEF'ed to give access to the ISPF panels *
*   required by FORCOMP. Obviously the two panels could also have been *
*   included in the same way.                                          *
*                                                                      *
* - the exec contains, in a set QUEUE statements the AMATERSE's LOAD   *
*   library containing the original FORCOMP program, which due to lack *
*   of a Shared Library currently abends with a                        *
*                                                                      *
*   CSV003I REQUESTED MODULE IBMBPSLA NOT FOUND                        *
*                                                                      *
*   message.                                                           *
*                                                                      *
* Note: A substantial part of this code is a direct translation of     *
* CLIST to REXX of FOCO#C, so the code is not too well-structured...   *
***********************************************************************/
parse source source
parse value source with . . moi . lib .

/***********************************************************************
* Find out where we are running from                                   *
***********************************************************************/
if lib = '?' then
  do
    dsn = get_dsn()
    parse value dsn with '''' lib '(' mem ')''' .
  end

"ispexec lmerase dataset("pppp")"
"ispexec lmerase dataset("qqqq")"

"alloc da(pppp) recfm(f b) lrecl(4096) blksize(4096) " ||,
               "space(15 15) tracks dsorg(ps) new reu"

"alloc da(qqqq) recfm(f b) lrecl(4096) blksize(4096) " ||,
               "space(15 15) tracks dsorg(ps) new reu"


"ispexec libdef ispplib dataset id('"lib"') stack"

"alloc f(help) da('"lib"(forcomph)') reu shr"

parse value '' with compmdsn compsdsn

compcur = compmmbr

loop:
  "ispexec display panel(forcompp)"

  if rc = 8 then
    do
      "ispexec lmerase dataset("pppp")"
      "ispexec lmerase dataset("qqqq")"

      "ispexec libdef ispplib"
      exit 0
    end

  if compmdsn \= '' then
    do
      typ  = ''
      mdsn = compmdsn
      sdsn = compsdsn
    end
  else
    do
      typ  = compmtyp
      mdsn = ''''compmprj'.'compmgrp'.'compmtyp'('compmmbr')'''
      sdsn = ''''compsprj'.'compsgrp'.'compstyp'('compsmbr')'''
    end

  dsnckm = sysdsn(mdsn)
  if dsnckm \= 'OK' then
    do
      say 'Master' dsnckm
      compcur = compmmbr
      signal loop
    end

  dsncks = sysdsn(sdsn)
  if dsncks \= 'OK' then
    do
      say 'Servant' dsncks
      compcur = compsmbr
      signal loop
    end

  compcur = compmmbr

  "alloc f(master)   da("mdsn") shr reu"
  "alloc f(servant)  da("sdsn") shr reu"

  "alloc f(pageseq)  da(pppp)   shr reu"
  "alloc f(nopgseq)  da(qqqq)   shr reu"
  "alloc f(pageio)   da(pppp)   shr reu"
  "alloc f(sysut1)   da(*)          reu"
  "alloc f(sysprint) da(*)          reu"

  rc = sysdsn("'"userid()".foco.load.other'")
  if rc \= 'OK' then
    call terse_2_load

  "call '"userid()".foco.load.other(forcomp)'" "/"typ

  "free f(master)"
  "free f(servant)"
  "free f(pageseq)"
  "free f(nopgseq)"
  "free f(pageio)"
  "free f(sysut1)"
  "free f(sysprint)"

  signal loop
exit

/***********************************************************************
* GET_DSN:                                                             *
*                                                                      *
* GET_DSN is a procedure to find the dataset where the code was run    *
* from. It assumes cataloged data sets.                                *
*                                                                      *
* Code written by Frank Clarke, original code by Doug Nadel, with SWA  *
* code lifted from Gilbert Gilbert Saint-flour's SWAREQ exec.          *
*                                                                      *
* From: <http://www.tek-tips.com/viewthread.cfm?qid=1162402&page=3>    *
***********************************************************************/
get_dsn: procedure
  numeric digits 10                      /* allow up to 7FFFFFFF      */

  answer = "* UNKNOWN *"                 /* assume disaster           */

  parse source . . name dd ds .          /* get known info            */

  call listdsi(dd "FILE")                /* get 1st ddname from file  */

  select
    /*-----------------------------------------------------------------+
    | If a sequential exec, use the info from parse source             |
    +-----------------------------------------------------------------*/
    when name = "?" then
      answer = "'"ds"'"

    /*-----------------------------------------------------------------+
    | Check if the exec is in the first dataset                        |
    +-----------------------------------------------------------------*/
    when sysdsn("'"sysdsname"("name")'") = "OK" then
      answer = "'"sysdsname"("name")'"

    /*-----------------------------------------------------------------+
    | A bit more work...                                               |
    +-----------------------------------------------------------------*/
    otherwise
      do
        /*-------------------------------------------------------------+
        | Scan the TIOT for the DDname                                 |
        +-------------------------------------------------------------*/
        tiotptr  = 24 + ptr(12 + ptr(ptr(ptr(16))))
        tioelngh = c2d(stg(tiotptr, 1))        /* Length of 1st entry */

        do until tioelngh = 0 |,
                 tioeddnm = dd
          tioeddnm = strip(stg(tiotptr + 4, 8))

          /*-----------------------------------------------------------+
          | Advance to next entry on no-match                          |
          +-----------------------------------------------------------*/
          if tioeddnm \= dd then
            tiotptr = tiotptr + tioelngh

          tioelngh = c2d(stg(tiotptr, 1))
        end

        /*-------------------------------------------------------------+
        | If it's found, loop through the datasets doing a swareq for  |
        | each one to find the DSname                                  |
        +-------------------------------------------------------------*/
        if dd = tioeddnm then
          do until tioelngh = 0 | stg(4 + tiotptr, 1) \= " "
            tioejfcb = stg(tiotptr + 12, 3)
            jfcb     = swareq(tioejfcb)         /* SVA to 31-bit addr */
            dsn      = strip(stg(jfcb, 44))     /* JFCBDSNM           */

            if sysdsn("'"dsn"("name")'") = 'OK' then
              leave

            /*---------------------------------------------------------+
            | Advance to next entry on no-match                        |
            +---------------------------------------------------------*/
            tiotptr  = tiotptr + tioelngh
            tioelngh = c2d(stg(tiotptr, 1))
          end

        answer = "'"dsn"("name")'"
      end
  end
return answer

ptr: return c2d(storage(d2x(arg(1)), 4))
stg: return storage(d2x(arg(1)), arg(2))

swareq: procedure
  if right(c2x(arg(1)), 1) \= 'F' then        /* SWA=BELOW ?          */
    return c2d(arg(1)) + 16                   /* yes, return sva + 16 */

  sva  = c2d(arg(1))                          /* convert to decimal   */
  tcb  = c2d(storage(21c, 4))                 /* TCB PSATOLD          */
  tcb  = ptr(540)                             /* TCB PSATOLD          */
  jscb = ptr(tcb + 180)                       /* JSCB TCBJSCB         */
  qmpl = ptr(jscb + 244)                      /* QMPL JSCBQMPI        */
  qmat = ptr(qmpl + 24)                       /* QMAT QMADD           */

  do while sva > 65536
    qmat = ptr(qmat + 12)                     /* next QMAT QMAT + 12  */
    sva  = sva - 65536                        /* 010006F -> 000006F   */
  end

return ptr(qmat + sva + 1) + 16

/***********************************************************************
* TERSE_2_LOAD:                                                        *
*                                                                      *
* Expand the AMATERSE'd load library back to a PDS                     *
***********************************************************************/
terse_2_load:
alloc  = "alloc fi(sysut1) rtdsn(sysdsname) " ||,
                 "lrecl(1024) blksize(0)  "   ||,
                 "new delete reuse "          ||,
                 "space(1,1)"
rc = bpxwdyn(alloc)

if rc = 0 then
  ispdyn = sysdsname
else
  ispdyn = 'NOT FOUND'

"newstack"

queue x2c(09016D5E8C016D5E0000000000100100210210210510200300100600) ||,
-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  - 35 Line(s) not Displayed
      x2c(0C638501B3973932290041240013980D404040404040404040404040)
-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  1665 Line(s) not Displayed
queue x2c(7CCDF1D0DD0010D60010C709D0010A90756C0B6E9D30A90799160010) ||,
-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  - 35 Line(s) not Displayed
      x2c(41FF04B05EAE22A905105387FAA1E770404040404040404040404040)

  "execio" queued() "diskw sysut1 (finis"

  "delstack"

  "alloc f(sysut2) da('"userid()".foco.load') " ||,
                  "new reu "                    ||,
                  "dsorg(po) "                  ||,
                  "dir(1) "                     ||,
                  "space(1 1) track release "   ||,
                  "recfm(U) lrecl(27998) blksize(0) "

  "alloc f(sysprint) dummy reu"

  "call *(amaterse) 'UNPACK'"

  "free f(sysut1)"
  "free f(sysut2)"
return


Note: The excluded lines are available on request (basically you'll get a ZIPPED XMIT of the entire FOCO.SRCE PDS) but again, only to real z/OS professionals!
Back to top
View user's profile Send private message
Willy Jensen

New User


Joined: 01 Sep 2015
Posts: 96
Location: Switzerland

PostPosted: Thu Feb 18, 2016 10:08 pm    Post subject:
Reply with quote

Ok I stand corrected, not for the first time. Robert, how do you generate the QUEUE statements, edit macro?
Back to top
View user's profile Send private message
prino

Active Member


Joined: 07 Feb 2009
Posts: 984
Location: Oostende, Belgium

PostPosted: Thu Feb 18, 2016 10:22 pm    Post subject:
Reply with quote

Willy Jensen wrote:
Ok I stand corrected, not for the first time. Robert, how do you generate the QUEUE statements, edit macro?

Selvfølgelig! Her er den:

Code:
/* REXX edit macro to convert ISPF source into in-line REXX (and vv)  */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2006-2009               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2009-04-22 | RAHP | Update comment                               | *
* |------------+------+----------------------------------------------| *
* | 2007-09-24 | RAHP | Put under GPL V3                             | *
* |------------+------+----------------------------------------------| *
* | 2007-09-03 | RAHP | Add 'bin' parameter for binary data          | *
* |------------+------+----------------------------------------------| *
* | 2007-08-16 | RAHP | Split comment delimiters in strings          | *
* |------------+------+----------------------------------------------| *
* | 2007-07-25 | RAHP | Use 'MSG' lines in help                      | *
* |------------+------+----------------------------------------------| *
* | 2007-01-25 | RAHP | Build temporary dataset to find p'.' chars   | *
* |            |      | Speedup queue conversion by bulktest for     | *
* |            |      | p'.'s and quotes                             | *
* |            |      | Store un-EPANQ'ed data in temporary dataset  | *
* |------------+------+----------------------------------------------| *
* | 2006-12-13 | RAHP | Add reverse function                         | *
* |------------+------+----------------------------------------------| *
* | 2006-11-28 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* EPANQ is a REXX edit macro to take ISPF panel, message and skeleton  *
* source and convert them into a number of REXX 'queue' statements     *
* that can be embedded in an exec to dynamically build them without    *
* the use for a predefined libraries.                                  *
*                                                                      *
* The code automagically doubles single quotes (') and converts any    *
* 'invalid' (ie p'.') characters to x2c().                             *
*                                                                      *
* Obviously, it can also do the reverse, converting 'queue'd ISPF      *
* panels, messages and/or skeleton source back into an editable        *
* format.                                                              *
************************************************************************
* Send questions, suggestions and/or bug reports to:                   *
*                                                                      *
* robert@prino.org / robert.ah.prins@gmail.com                         *
*                                                                      *
* Robert AH Prins                                                      *
* Taboralaan 46                                                        *
* 8400 Oostende                                                        *
* Belgium                                                              *
************************************************************************
* This program is free software: you can redistribute it and/or        *
* modify it under the terms of the GNU General Public License as       *
* published by the Free Software Foundation, either version 3 of       *
* the License, or (at your option) any later version.                  *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program. If not, see <http://www.gnu.org/licenses/>  *
***********************************************************************/
parse source source
parse value source with . . moi .

"isredit macro (parm)"

parm = translate(space(parm))

/***********************************************************************
* Recursive invocation to get all p'.'s from temporary dataset         *
***********************************************************************/
if parm = 'PDOT'x2c(ff) then
  do
    call find_pdot
    return
  end

dest  = 0
line. = ''
type. = 'MSG'

"isredit (SESSION) = session"
if parm = '?' then
  do
    call help

    exit 1
  end

"isredit (STATE) = user_state"

"isredit (SF) = linenum .SF"
rcf = rc

"isredit (SL) = linenum .SL"
rcl = rc

if rcf = 0 &,
   rcl = 0 then
  call queue_2_source
else
  if rcf \= 0 &,
     rcl \= 0 then
    call source_2_queue
  else
    call help

"isredit user_state = (STATE)"
exit 1

/***********************************************************************
* SOURCE_2_QUEUE:                                                      *
*                                                                      *
* Procedure to convert panel, message or skeleton source into REXX     *
* queue statements, with doubles quotes and p'.' characters translated *
* into x2c() statements.                                               *
***********************************************************************/
source_2_queue:
  /*********************************************************************
  * Get all p'.' characters that later need to be translated to x2c()  *
  *********************************************************************/
  call get_pdot

  "isredit (ZL) = linenum .zl"

  "newstack"

  "isredit (DSN) = dataset"
  "isredit (MEM) = member"

  queue 'member = '''strip(mem)''''
  queue ''

  do i = 1 to +zl
    "isredit (L) = line" i

    if parm \= 'BIN' then
      call process_line
    else
      call process_bin
  end

  dynlib = 'dyn'random(99999)
  "alloc f("dynlib") del space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  "execio" queued() "diskw "dynlib" (finis"

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(exclu)"
  "ispexec view dataid("mydsn")"
  "ispexec lmfree dataid("mydsn")"

  "free f("dynlib")"

  "delstack"
return

/***********************************************************************
* PROCESS_LINE:                                                        *
*                                                                      *
* This procedure processes each line. It doubles all quotes, converts  *
* all 'invalid' (ie p'.') characters to x2c() and breaks up the line   *
* in queueable parts of up to 60 characters.                           *
***********************************************************************/
process_line: procedure expose l pdot
  /*********************************************************************
  * Marker for non-x2c()'ed lines                                      *
  *********************************************************************/
  o. = x2c(00)
  o  = 0

  /*********************************************************************
  * Need at least one character                                        *
  *********************************************************************/
  l  = strip(l, 'T')' '

  i  = 1

  ls = space(l, 0)
  lz = space(translate(l, ' ', pdot''''), 0)

  if ls = lz then
    do
      if l \== ' ' then
        l = strip(l, 'T')

      p = pos('/' || '*', l)
      do while p \= 0
        l = substr(l, 1, p) || ''' || ''' || substr(l, p + 1)
        p = pos('/' || '*', l)
      end

      p = pos('*' || '/', l)
      do while p \= 0
        l = substr(l, 1, p) || ''' || ''' || substr(l, p + 1)
        p = pos('*' || '/', l)
      end

      if length(l) <= 63 then
        queue 'queue '''l''''
      else
        do
          queue 'queue '''substr(l,  1, 58)''' ||,'
          queue '      '''substr(l, 59)''''
        end

      return
    end

  do while i <= length(l)
    c = substr(l, i, 1)
    if i = length(l) & i \= 1 then
      c = ''

    h = pos(c, pdot)

    select
      /*****************************************************************
      * String together all (up to 25 at a time) p'.' characters       *
      *****************************************************************/
      when h \= 0 then
        do
          hex = ''

          do while h \= 0 & length(hex) < 25
            hex = hex || c
            i   = i + 1
            c   = substr(l, i, 1)
            h   = pos(c, pdot)
          end

          o   = o + 1
          o.o = 'x2c(' || c2x(hex) || ')'
        end

      /*****************************************************************
      * Normal characters                                              *
      *****************************************************************/
      otherwise
        do
          if c = '''' then
            c = ''''''

          /*************************************************************
          * Start new segment if                                       *
          *                                                            *
          *  - this is the first segment                               *
          *  - if the previous segment resulted from one or more p'.'  *
          *    characters                                              *
          *  - if length of the segment concatenated with the current  *
          *    character exceeds 59                                    *
          *************************************************************/
          if o                       = 0 |,
             left(o.o, 1)           \= x2c(00) |,
             length(o.o) + length(c) > 59 then
            o = o + 1

          o.o = o.o || c
          i   = i + 1
        end
    end

    o.0 = o
  end

  prefix = 'queue '
  do o = 1 to o.0
    if left(o.o, 1) = x2c(00) then
      q = prefix || '''' || substr(o.o, 2) || ''''
    else
      q = prefix || o.o

    prefix = '      '

    if o \= o.0 then
      q = q || ' ||,'

    queue q
  end
return

/***********************************************************************
* PROCESS_BIN:                                                         *
*                                                                      *
* This procedure processes pure binary data to greatly reduce the      *
* number of separate queue statements.                                 *
***********************************************************************/
process_bin: procedure expose l
  /*********************************************************************
  * Need at least one character                                        *
  *********************************************************************/
  l  = strip(l, 'T')' '
  o  = 0

  do while l \= ''
    o   = o + 1
    o.o = 'x2c('c2x(left(l, 28))')'
    l   = substr(l, 29)
  end
  o.0 = o

  prefix = 'queue '
  do o = 1 to o.0
    q      = prefix || o.o
    prefix = '      '

    if o \= o.0 then
      q = q || ' ||,'

    queue q
  end
return

/***********************************************************************
* QUEUE_2_SOURCE:                                                      *
*                                                                      *
* Procedure to convert 'queue'd panel, message or skeleton back into   *
* an editable format.                                                  *
***********************************************************************/
queue_2_source:
  m   = 0
  m.0 = 0
  nl  = ''

  dynlib = 'dyn'random(99999)

  "alloc f("dynlib") new space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  do i = +sf to +sl
    "isredit (L) = line" i
    l  = strip(l)

    nl = strip(nl,, ',') || l

    if right(nl, 1) \= ',' then
      do
        if left(nl, 6) = 'queue ' then
          do
            interpret nl
            m   = m + 1
            m.0 = m
            parse pull m.m
          end
        else
          if left(nl, 6) = 'member' then
            do
              call saver

              drop m.
              m   = 0
              m.0 = 0

              interpret nl
            end

        nl = ''
      end
  end

  call saver

  drop mydsn

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(shr)"
  "ispexec view dataid("mydsn")"
  "ispexec lmfree dataid("mydsn")"

  "free f("dynlib")"
return

/***********************************************************************
* SAVER:                                                               *
*                                                                      *
* Save a complete panel, message or skeleton                           *
***********************************************************************/
saver:
  if m \= 0 then
    do
      "newstack"

      do m = 1 to m.0
        queue m.m
      end

      "execio" queued() "diskw "dynlib" (finis"

      "delstack"
    end
return

/***********************************************************************
* GET_PDOT:                                                            *
*                                                                      *
* This procedure finds all p'.' characters that exist for the current  *
* edit/view session.                                                   *
***********************************************************************/
get_pdot: procedure expose moi pdot
  dynlib = 'dyn'random(99999)

  "alloc f("dynlib") new space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  "newstack"

  queue xrange('00'x,'3f'x)
  queue xrange('40'x,'7f'x)
  queue xrange('80'x,'bf'x)
  queue xrange('c0'x,'ff'x)

  "execio" queued() "diskw "dynlib" (finis"

  "delstack"

  drop mydsn

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(exclu)"

  parm = 'PDOT'x2c(ff)
  "ispexec view dataid("mydsn") macro("moi") parm(parm)"

  "ispexec lmfree dataid("mydsn")"

  "ispexec vget (pdot) shared"

  "free f("dynlib")"
return

/***********************************************************************
* FIND_PDOT:                                                           *
*                                                                      *
* This procedure finds all p'.' characters that exist for the current  *
* edit/view session.                                                   *
***********************************************************************/
find_pdot: procedure
  pdot = ''

  "isredit f p'.' first"
  do while rc = 0
    "isredit (L) = line .zcsr"
    "isredit (R,C) = cursor"

    pdot = pdot || substr(l, c, 1)

    "isredit f p'.' next"
  end

  "ispexec vput (pdot) shared"
  "isredit end"
return

/***********************************************************************
* MESSAGE:                                                             *
*                                                                      *
* General purpose edit message insertion routine                       *
***********************************************************************/
message:
  "isredit (MSTATE) = user_state"
  "isredit caps = off"
  do i = line.0 to 1 by -1
    lin = line.i
    "isredit line_after "dest" = "type.i"line (LIN)"
  end
  "isredit user_state = (MSTATE)"
  "isredit locate" dest
return

/***********************************************************************
* HELP:                                                                *
*                                                                      *
* HELP is a general "help" screen displaying routine                   *
***********************************************************************/
help:
  arg parm

  type.  = 'NOTE'
  i      = 1
  text   = 'The' moi 'edit macro'
  line.i = center(text, 72)
  type.i = 'MSG'
  i      = i + 1
  line.i = center(left('~', length(text), '~'), 72)
  type.i = 'MSG'
  i      = i + 1
  line.i = center(' Use DOWN to read all "HELP"',
           'screens ', 72, '*')
  type.i = 'MSG'

  i      = i + 2
  line.i = '  The' moi 'edit macro performs the two tasks of',
           'converting ISPF'
  i      = i + 1
  line.i = '  panel, message and/or skeleton source into a series',
           'of REXX queue'
  i      = i + 1
  line.i = '  statements that can be embedded in an exec to recreate',
           'these items'
  i      = i + 1
  line.i = '  at runtime, reducing the dependency on external panel,',
           'message and/or'
  i      = i + 1
  line.i = '  skeleton libraries. It can also perform the reverse,',
           'converting a'
  i      = i + 1
  line.i = '  series of REXX queue statements back into editable',
           'source.'

  i      = i + 2
  line.i = '  Usage:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '   o Convert to queue statements (default)'

  i      = i + 2
  line.i = '      - VIEW the member that needs to be',
           'turned into queue statements'
  i      = i + 1
  line.i = '      - Enter' moi 'on the commandline and',
           'press ENTER'
  i      = i + 2
  line.i = '     When' moi 'has finished, you will be VIEWing',
           'a temporary dataset'
  i      = i + 1
  line.i = '     with the queue statements. You can use',
           '''CUT'', ''CREATE'' or ''MOVE'''
  i      = i + 1
  line.i = '     to save them to their final location.'

  i      = i + 2
  line.i = '     Note:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '     To convert data with a large number of',
           '''unprintable'' characters,'
  i      = i + 1
  line.i = '     resulting in excessively large code, it is possible',
           'to add a'
  i      = i + 1
  line.i = '     ''bin'' parameter, ie use ''EPANQ BIN'', which will',
           'result in all'
  i      = i + 1
  line.i = '     data being converted in x2c(...) queue statements.'

  i      = i + 2
  line.i = '   o Convert ''queue'' statements to source'

  i      = i + 2
  line.i = '      - VIEW the member that needs to be turned back',
           'into source and'

  i      = i + 2
  line.i = '         o mark the line containing the first ''queue''',
           'statement with'
  i      = i + 1
  line.i = '           a .SF label'
  i      = i + 1
  line.i = '         o mark the line containing the last ''queue''',
           'statement with'
  i      = i + 1
  line.i = '           a .SL label'

  i      = i + 2
  line.i = '     Note:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '     If the member contains more than one object and',
           'they are'
  i      = i + 1
  line.i = '     separated by "member = ''xxxxxxxx''" statements, you',
           'can put the'
  i      = i + 1
  line.i = '     .SF label on the line that contains the first of',
           'these'
  i      = i + 1
  line.i = '     "member = ''xxxxxxxx''" statements and' moi 'will',
           'process all',
  i      = i + 1
  line.i = '     members in one go, ignoring all statements other',
           '''queue'''
  i      = i + 1
  line.i = '     and ''member = ...'''

  i      = i + 2
  line.i = center(' End of HELP information ', 72, '*')
  type.i = 'MSG'
  line.0 = i

  call message
return

Possible improvement is to use BIN mode if the number of non-printable characters exceeds a threshold, or for source with an LRECL > 80/255/whatever. Feel free to send me an updated version!
Back to top
View user's profile Send private message
Willy Jensen

New User


Joined: 01 Sep 2015
Posts: 96
Location: Switzerland

PostPosted: Fri Feb 19, 2016 7:47 pm    Post subject:
Reply with quote

Maybe give this a try, it should work for FB files. I have used similar code in batch.

Code:
 /* rexx */                                       
 Address Isredit "MACRO NOPROCESS"               
 Address Isredit                                 
                                                 
 /* load data to stem */                         
 "(ln) = linenum .zlast"                         
 Do lnr=1 to ln                                   
   "(s)= Line (lnr)"                             
   line.lnr=strip(s,'t')                         
 End                                             
 line.0=ln                                       
 say 'records read:' line.0                       
 lrecl= length(line.1)                           
 say 'record length' lrecl                       
                                                 
 rec=''                                           
 outn=0                                           
 do linen=1 to line.0                             
   rec=left(line.linen,lrecl,'00'x)    /* fill */
   p='queue'                                     
   c=','                                         
   do until rec=''                               
     parse var rec r =31 rec                     
     if rec='' then c=''                         
     outn=outn+1                                 
     out.outn= p "x2c('"c2x(r)"')"c               
     p='||   '                                   
   end                                           
 end                                             
 say outn 'records generated'                     
                                                 
 /* rewrite */                                   
 "del .zf .zl"                                   
 Do lnr=1 to outn                                 
   s=out.lnr                                     
   "line_after .zl = (s)"                         
 End                                             
                                                 
 "reset"

Coded
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:



Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us