zOs/REXX.O08/EL

/* REXX *************************************************************

    jcl  = abc(jclm) * sdf
    mgmtClas  = s005y000
    load ts= wie punchFrom  =   A540769.WK.TEXT(UNLO1)

    load punch=e.f.g.punch in=e.f.g.load
    fun='copy unload load'



**********************************************************************/
call adrEdit('macro (args) NOPROCESS')
say 'macro args' args
if adrEdit('process range Q R', 4) = 4 then do
    lF = 2
    lT = 10
    end
else do
    call adrEdit '(lf) = linenum .zfrange'
    call adrEdit '(lT) = linenum .zLrange'
    end
say 'from' lf  'to' lT
ix = 0
do lx=lf to lT
    call adrEdit('(line) = line' lx)
    ix = ix + 1
    m.inp.ix = translate(line)
    end
m.inp.0 = ix
call mSay inp, 'input lines'
loadKeys = 'TS IN INFROM PUNCH PUNCHFROM RESUME'
optKeys = 'LOADNR FUN MGMTCLAS SUBSYS JCL'
call analyseInput optKeys, 'LOAD', loadKeys
    do wx=1 to words(optKeys)
        k = word(optKeys, wx)
        say k '=' m.k
        end
    say m.loads 'loads'
    do lx=1 to m.loads
        do wx=1 to words(loadKeys)
            k = word(loadKeys, wx)
            if m.k.lx ^== '' then
                say 'load' lx k '=' m.k.lx
            end
        say 'completing load infos'
        call completeLoadInfo lx
        do wx=1 to words(loadKeys)
            k = word(loadKeys, wx)
            if m.k.lx ^== '' then
                say 'load' lx k '=' m.k.lx
            end
        end

exit

completeLoadInfo: procedure expose m.
parse arg lx
    if wordPos('COPY', m.fun) > 0 then do
        if m.punchFrom.lx = '' then
            call err 'punchFrom missing'
        call analysePunch lx, 1, dsnFromJcl(m.punchFrom.lx)
        end
    return
endProcedure completeLoadInfo

analysePunch: procedure expose m.
parse arg lx, from, dsn
    call readDsn dsn, "M.PU."
    do ix=1 to m.pu.0
        m.pu.ix = translate(strip(left(m.pu.ix, 72), 't'))
        end
    call mSay pu, 'read' dsn
    call scanStem ps, pu
    do forever
        call scanName scanSkip(ps)
        w1 = m.tok
        if w1 = template then do
            call scanName scanSkip(ps)
            na = m.tok
            call scanName scanSkip(ps)
            if m.tok ^= 'DSN' | then
                call sa
            say 'template' na 'then' m.tok
            end
        else
            call scanErr ps, 'load statement expected'
        end
    return
endProcedure analysePunch

analyseInput: procedure expose m.
parse arg optKeys, load, loadKeys
    call scanStem s, inp
    call scanOptions s, , , '*'
        do wx=1 to words(optKeys)
            k = word(optKeys, wx)
            m.k = ''
            end
    lx=0
    k = ''
    do forever
        if k = '' then
            if ^ scanKeyValue(s) then do
                if  scanAtEnd(s) then
                    leave
                else
                    call scanErr s, 'key or key=value expected'
                end
        k = translate(m.key)
        if k = load then do
            lx = lx + 1
            say 'load' lx
            do wx=1 to words(loadKeys)
                k = word(loadKeys, wx)
                m.k.lx = ''
                end
            k = ''
            do while scanKeyValue(s)
                k = translate(m.key)
                if wordPos(k, loadKeys) < 1 then
                    leave
                m.k.lx = translate(m.val)
                k = ''
                end
            end
        else do
            if wordPos(k, optKeys) < 1 then
                call scanErr s, 'key' k 'not supported'
            m.k = translate(m.val)
            k = ''
            end
        end
    m.loads = lx
    return
endProckedure analyseInput
err:
parse arg ggMsg
    call errA ggMsg
    exit 12
endSubroutine err
/* copy scan begin ****************************************************
Scan: scan an input:
    scanLine(m,ln) : begin scanning a single line
    scanStem(m,ln) : begin scanning all lines in a stem
    scanAtEOL(m)   : returns whether we reached end of line
    scanAtEnd(m)   : returns whether we reached end of input
    scanLit(m,lit) : scan Literal lit if present or return 0
    scanChar(m,n)  : scan next n characters
    scanName(m)    : scan a name
    scanNum(m)     : scan integer (without sign)
    scanString(m,q): scan a String with quote q. (with doubble = 1)
    scanVerify(m,c,o): verify(...,c,o,...)
    scanKeyValue(m): scan a key = value clause (with spaces)
    scanWord(m,u)  : scan a space delimited word or a string,
                          if u=1 then uppercase non-strings
    scanErr(m, txt): error with current scan location

    m is an adress, to store our state
    if a scan function succeeds, the scan posititon is moved

returns: true if scanned, false otherwise
         m.tok    ==> last token
         m.val    ==> last value for scanString/Word/KeyValue
         m.key    ==> key for scanKeyValue
         m.scan.m.pos ==> scan position
         m.scan.m.src ==> scan source
***********************************************************************/

/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
    call scanStart m
    return
endProcedure scanLine

/*--- begin scanning the lines of a stem -----------------------------*/
scanStem: procedure expose m.
parse arg m, inStem
    call scanStart m
    m.scan.m.stem = inStem
    m.scan.m.stIx = 0
    call scanNL m, 1
    return
endProcedure scanStem

/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
    if unCond == 1 then
        m.scan.m.pos = 1 + length(m.scan.m.src)
    else if m.scan.m.pos <= length(m.scan.m.src) then
        return 0

    st = m.scan.m.stem
    if st == '' then
        return 0
    ix = m.scan.m.stIx + 1
    if ix > m.st.0 then
        return 0
    m.scan.m.src = m.st.ix
    m.scan.m.stIx = ix
    m.scan.m.pos = 1
    m.scan.m.tok = ''
    return 1
endProcedure scanNL

/*--- initialize scanner for m  --------------------------------------*/
scanStart: procedure expose m.
parse arg m
    m.scan.m.pos = 1
    m.tok = ''
    m.val = ''
    m.key = ''
    m.scan.m.stem = ''
    if symbol('m.scan.m.Name') ^== 'VAR' then do
        m.scan.LC   = 'abcdefghijklmnopqurstuvwxyz'
        m.scan.UC   = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
        m.scan.Alpha = m.scan.LC || m.scan.UC
        m.scan.AlNum = '0123456789' || m.scan.ALPHA
        m.scan.m.Name1 = m.scan.ALPHA
        m.scan.m.Name = m.scan.ALNUM
        m.scan.m.comment = ''
        end
    return
endProcedure scanStart

/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
    if symbol('m.scan.m.Name') ^== 'VAR' then
        call scanStart
    if nameOne ^== '' then do
        m.scan.m.Name1 = nameOne
        if namePlus = '' then
            namePlus = '0123456789'
        m.scan.m.name = nameOne || namePlus
        end
    m.scan.m.comment = comm
    return
endProcedure scanBegin

/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
    return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL

/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
    if m.scan.m.pos <= length(m.scan.m.src) then
        return 0
    st = m.scan.m.stem
    return st == '' | m.st.0 <= m.scan.m.stIx
endProcedure scanAtEnd

/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
    nx = 1 + length(m.scan.m.src)
    if len ^== '' then
        if nx > m.scan.m.pos + len then
            nx = m.scan.m.pos + len
    m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
    if nx = m.scan.m.pos then
        return 0
    m.scan.m.pos = nx
    return 1
endProcedure scanChar

/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
    if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
        return 0
    m.scan.m.pos = m.scan.m.pos + length(lit)
    m.tok = lit
    return 1
endProcedure scanLit

/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
    m.val = ''
    if qu = '' then
        qu = "'"
    if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
        return 0
    bx = m.scan.m.pos
    qx = m.scan.m.pos + 1
    do forever
        px = pos(qu, m.scan.m.src, qx)
        if px < 1 then
            call scanErr m, 'ending Apostroph('qu') missing'
        m.val = m.val || substr(m.scan.m.src, qx, px-qx)
        if px >= length(m.scan.m.src) then
            leave
        else if substr(m.scan.m.src, px+1, 1) <> qu then
            leave
        qx = px+2
        m.val = m.val || qu
        end
    m.tok = substr(m.scan.m.src, bx, px+1-bx)
    m.scan.m.pos = px+1
    return 1
endProcedure scanString

/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
    if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
                 , m.scan.m.Name1) <= 0 then
        return 0
    bx = m.scan.m.pos
    m.scan.m.pos = bx + 1
    call scanVerify m, m.scan.m.Name
    m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
    return 1
endProcedure scanName

/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
    if vOpt == '' then   /* empty string does not take default| */
        nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
    else
        nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
    if nx = 0 then
        nx = length(m.scan.m.src) + 1
    m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
    if nx <= m.scan.m.pos then
        return 0
    m.scan.m.pos = nx
    return 1
endProcedure scanVerify

/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
    if ^ scanVerify(m, '0123456789') then
        return 0
    else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
             > 0 then
        call scanErr m, 'illegal number end'
    return 1
endProcedure scanNum

/*--- scan a word and put value into *.val
           a word is either delimited by space or stopper
                     or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
    if scanString(m, "'")              then return 1
    if scanString(m, """")             then return 1
    if ^scanVerify(m, ' 'stopper, 'm') then return 0
    m.val = m.tok
    return 1
endProcedure scanWord

/*--- scan a key = word phrase
          put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
    if ^ scanName(scanSkip(m)) then
        return 0
    m.key = m.tok
    if ^ scanLit(scanSkip(m), '=') then do
        m.val = def
        m.tok = ' no='
        end
    else if ^scanWord(scanSkip(m)) then
        call scanErr(m, 'word expected after' m.key '=')
    return 1
endProcedure scanKeyValue

/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
    say 'scanErr' txt
    say '  last token' m.scan.m.tok
    say '  charPos' m.scan.m.Pos':',
                  strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
    say '  in line:' strip(m.scan.m.src, 't')
    st = m.scan.m.stem
    if st ^== '' then
        say 'stem' st 'line' m.scan.m.stIx 'of' m.st.0
    call err 'scanErr' txt
endProcedure scanErr

/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
    res = 0
    cc = m.scan.m.comment
    do forever
        if scanVerify(m, ' ') then nop
        else if scanNL(m) then nop
        else if cc == '' then
            return res
        else if ^ scanLit(m, cc) then
            return res
        else if ^scanNL(m, 1) then
            return res
        res = 1
        end
endProcedure scanSpaceNL

/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
    call scanSpaceNl m
return m
endProcedure scanSkip

/* copy scan end   ****************************************************/
/* copy mrw  begin *****************************************************

      interface m mRead and mWrite
          mNew
          convenience function to write to current output
***********************************************************************/
test: procedure
call mCopyArgs a, 0, 'eins ...', 'zwei ...', 'drei ... schluss'
call mIni
r = mNew()
s = mNew()
call mDefReadFromStem r, a
say 0 mReadLn(r,x) "'"m.x"'"
call mDefReadFromStem s, a
do i=1 to 5
    say i mReadLn(r,x) "'"m.x"' read s" mReadLn(s, y) m.y
    end
exit
endProcedure
/*--- initialize m ---------------------------------------------------*/
mIni: procedure expose m.
    m.mrw.0 = 0
    m.mrw.ini = 1
    return
endProcedure mIni

mNew: procedure expose m.
    m.mrw.0 = m.mrw.0 + 1
    return m.mrw.0
endProcedure mNew

mDefRead: procedure expose m.
parse arg m, rexx
    m.mrw.m.readLnIx = ''
    m.mrw.m.read = rexx
    return
endProcedure mDefRead

mRead: procedure expose m.
parse arg m, stem
    interpret m.mrw.m.read
endProcedure mRead

/*--- put next line into m.line, return false at eof -----------------*/
mReadLn: procedure expose m.
parse arg m, line
    if m.mrw.m.readLnIx == '' ,
            | m.mrw.m.readLnIx >= m.mrw.m.readLnStem.0 then do
        if ^ mRead(m, 'MRW.'m'.READLNSTEM') then do
            m.line = ''
            return 0
            end
        lx  = 1
        end
    else do
        lx = 1 + m.mrw.m.readLnIx
        end
    m.mrw.m.readLnIx = lx
    m.line = m.mrw.m.readLnStem.lx
    return 1
endProcedure readLn

mDefReadFromStem: procedure expose m.
parse arg m, stem
    m.mrw.m.readFromStem = stem
    call mDefRead m, 'if m.mrw.m.readFromStem == "" then return 0;' ,
                   'call mCopyStem stem, 0, m.mrw.m.readFromStem;' ,
                   'm.mrw.m.readFromStem = "";',
                   'return 1;'
    return
endProcedure mDefReadStem

mReadFromStem: procedure expose m.
parse arg m, stem
    si = m.mrw.m.readStem
    ix = m.mrw.m.readStemIx + 1
    m.mrw.m.readStemIx = ix
    if ix <= m.si.0 then do
        m.stem = m.si.ix
        return 1
        end
    else do
        m.stem = ''
        return 0
        end
endProcedure mReadFromStem

/**** simple convience function for stems *****************************/
/*--- fill stem st from index dx with lines from stem src ------------*/
mCopyStem: procedure expose m.
parse arg dst, dx, src
    if dx == '' then
        dx = m.dst.0
    do ix = 1 to m.src.0
        dx = dx + 1
        m.dst.dx = m.src.ix
        end
    m.dst.0 = dx
   return dst
endProcedure mCopyStmm

/*--- fill stem dst from index dx with arguments ---------------------*/
mCopyArgs: procedure expose m.
parse arg dst, dx
    if dx == '' then
        dx = m.dst.0
    do ix = 3 to arg()
        dx = dx + 1
        m.dst.dx = arg(ix)
        end
    m.dst.0 = dx
    return dst
endProcedure mCopyArgs


mSay: procedure expose m.
parse arg stem, msg
    l = length(m.stem.0)
    if l < 3 then
        l = 3
    say left('', l, '-') msg 'mSay begin stem' stem m.stem.0
    do ix = 1 to m.stem.0
        say right(ix, l) strip(m.stem.ix, 't')
        end
    say left('', l, '-') msg 'mSay end   stem' stem m.stem.0
   return
endProcedure mSayem
/* copy mrw  end   ****************************************************/
/* copy adr begin ****************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
    if left(dsn,1) = "'" then
        return strip(dsn, 'b', "'")
    else if sysvar('SYSPREF') = '' then
        return dsn
    else
        return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl

/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
    return "'"dsn"'"
endProcedure dsnFromJcl

/**********************************************************************
    io: read or write a dataset with the following callsequences:
        read:  readDDBegin, readDD*,  readDDEnd
        write: writeBegin,  writeDD*, writeEnd

        readDD returns true if data read, false at eof
***********************************************************************/

/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure
return /* end readDDBegin */

/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt = '' then
        ggCnt = 100
    call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
    return (value(ggSt'0') > 0)
return /* end readDD */

readDDall:
    parse arg ggDD, ggSt
    call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
    return
endSubroutine readDDall

readDSN:
    parse arg dsn, ggSt
    call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
    call readDDall readDsn, ggSt
    call adrTso 'free dd(readDsn)'
    return
endSubroutine readDsn

/*--- finish reading DD  ggDD ----------------------------------------*/
readDDEnd: procedure
    parse arg ggDD
    call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */

/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure
    parse arg ggDD
                  /* ensure file is erased, if no records are written */
    call adrTso 'execio' 0 'diskw' ggDD '(open)'
return /* end writeDDBegin */

/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
    return
endSubroutine writeDD

/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure
    parse arg ggDD
    call adrTso 'execio 0 diskw' ggDD '(finis)'
return /* end writeDDEnd */

/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
    parse arg ggTsoCmd, ggRet
    address tso ggTsoCmd
    if rc == 0                     then return 0
    else if ggRet == '*'           then return rc
    else if wordPos(rc, ggRet) > 0 then return rc
    else
        call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */
/* copy adr end    ****************************************************/
/* copy adrIsp begin *************************************************/
/**********************************************************************
    lmd: catalog read
    call sequence: lmdBegin, lmdNext*, lmdEnd
        mit lmd service (mit save in file und read,
                         weil list zu langsam und listcat abstürzt)
        1. arg (grp)     als group dataset für lmd save
                         und dd name für file read
***********************************************************************/
lmdBegin: procedure
    parse arg grp, lev
    call adrIsp 'lmdinit listid(lmdId) level('lev')'
    res = adrIsp('lmdlist listid(&lmdId) option(save) group('grp')', 4)
    call adrIsp 'lmdfree listid(&lmdId)'
    if res = 0 then do
        call trc showTime() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
        end
    else do
        call trc 'no datasets found' showTime() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') dummy'
        end
    call readDDBegin grp
return /* end lmdBegin */

lmdNext:
    parse arg ggGrp, ggSt, withVolume
    if ^ readDD(ggGrp, ggSt) then
         return 0
    if withVolume ^== 1 then
        do ggIx=1 to value(ggSt'0')
            x = value(ggSt || ggIx, word(value(ggSt || ggIx), 1))
            end
    return 1
endSubroutin lmdNext

lmdEnd: procedure
    parse arg grp
    call readDDEnd grp
    call adrTso 'free dd('grp')'
return /* end lmdEnd */

/**********************************************************************
    member list of a pds:
        call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
    if dsn = '' then
        dsn = 'wk.pli(*)'
    say 'lmmTest for dsn' dsn
    id = lmmBegin(dsn)
    do ix=1 by 1
        m = lmmNext(id)
        if m = '' then
            leave
        say ix m
        end
    call lmmEnd id
    say  'lmmTest end' (ix-1) 'members in' dsn
    return
endProcedure lmmTest

lmmBegin: procedure
parse arg dsn
    mbr = dsnGetMbr(dsn)
    pds = dsnSetMbr(dsn, )
    call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
    call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
    res = lmmId
    if mbr <> '' then
        res = res 'pattern('mbr')'
    return res
endProcedure lmmBegin

lmmEnd: procedure
parse arg lmmId opt
    call adrIsp "LMMLIST DATAID("lmmId") option(free)", 8
    call adrIsp "LMCLOSE DATAID("lmmId")"
    call adrIsp "LMFREE DATAID("lmmId")"
    return
endProcedure lmmEnd

lmmNext: procedure
parse arg lmmId opt
    if adrIsp("LMMLIST DATAID("lmmid")" ,
               "OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
        return mbr
    else
        return ''
endProcedure lmmNext

/**********************************************************************
    adr*: address an environment
***********************************************************************/

adrIsp:
    parse arg ggIspCmd, ggRet
    address ispexec ggIspCmd
    if rc = 0 then return 0
    else if ggRet == '*' then return rc
    else if wordPOS(rc, ggRet) > 0 then return rc
    else
        call err 'adr ispExec rc' rc 'for' ggIspCmd
endSubroutine adrIsp

adrEdit:
    parse arg ggEditCmd, ggRet
    address isrEdit ggEditCmd
    if rc = 0 then return 0
    else if ggRet == '*' then return rc
    else if wordPOS(rc, ggRet) > 0 then return rc
    else
        call err 'adr isrEdit rc' rc 'for' ggEditCmd
endSubroutine adrEdit

/* copy adrIsp end   *************************************************/
/* copy err begin ******************************************************
    messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
    call errA ggMsg
    exit 12
endSubroutine err
   end call should define err ----------------------------------------*/

/*--- error routine: abend with message ------------------------------*/
errA:
    parse arg ggTxt
    parse source . . ggS3 .                           /* current rexx */
    say 'fatal error in' ggS3':' ggTxt
    x = x / 0
    exit setRc(12)
endSubroutine errA

/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
    say 'fatal error:' ggMsg
    call help
    call err ggMsg
endProcedure errHelp

/*--- set rc for ispf: -----------------------------------------------*/
    if a cmd is run by ispStart, its RC is ignored,
         but ISPF passes the value of the shared varible zIspfRc
         back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
    if sysVar('sysISPF') = 'ACTIVE' then do
        say 'exitRc setting zIspfRc='zIspfRc
        address ispExec vput 'zIspfRc' shared
        end
    return zIspfRc
endProcedure setRc

/*--- output a trace message if m.trace is set -----------------------*/
trc: procedure expose m.
parse arg msg
    if m.trace == 1 then
        say 'trc:' msg
    return
endProcedure trc

/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure
parse arg txt, qu
    if qu = '' then
        qu = '"'
    res = qu
    ix = 1
    do forever
        qx = pos(qu, txt, ix)
        if qx = 0 then
            return res || substr(txt, ix) || qu
        res = res || substr(txt, ix, qx-ix) || qu || qu
        ix = qx + length(qu)
        end
endProcedure quote

/*--- return current time and cpu usage ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg

/--- display the first comment block of the source as help -----------*/
help: procedure
    parse source . . s3 .
    say 'help for rexx' s3
    do lx=1 by 1
        if pos('/*', sourceLine(lx)) > 0 then
            leave
        else if lx > 10 then do
            say 'initial commentblock not found for help'
            return
            end
        end
    do lx=lx+1 by 1
        li = strip(sourceLine(lx), 't', ' ')
        if pos('*/', li) > 0 then
            leave
        say li
        end
    return 4
endProcedure help
/* copy err end   *****************************************************/