zOs/REXX/EDITMAC1

parVar = 'wie gehts parmVar?'
rc = adrIsp('edit dataset(tmp.rexx(eins))' ,
                'macro(editMac2) parm(parVar)' , '*')
say 'edit rc' rc
exit
/* 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 expose m.
    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 timing() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
        end
    else do
        call trc 'no datasets found' timing() '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 expose m.
    parse arg grp
    call readDDEnd grp
    call adrTso 'free dd('grp')'
return /* end lmdEnd */

lmd: procedure expose m.
    parse arg lev, withVol
    call lmdBegin gg1, lev
    do while lmdNext(gg1, q., withVol)
        do x=1 to q.0
           call out q.x
           end
        end
    call lmdEnd gg1
    return
endProcedure lmd
/**********************************************************************
    member list of a pds:
        call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmm: procedure expose m.
parse arg dsn
    id = lmmBegin(dsn)
    do ix=1 by 1
        m = lmmNext(id)
        if m = '' then
            leave
        call out m
        end
    call lmmEnd id
    return
endProcedure lmm

lmmBegin: procedure expose m.
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 expose m.
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 expose m.
parse arg lmmId opt
    if adrIsp("LMMLIST DATAID("lmmid")" ,
               "OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
        return strip(mbr)
    else
        return ''
endProcedure lmmNext

lmmRm: procedure expose m.
parse arg dsn, mbrs
    mbrs = dsnGetMbr(dsn) mbrs
    pds = dsnSetMbr(dsn, )
    call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
    call adrIsp "LMOPEN DATAID("lmmId") OPTION(OUTPUT) "
    err = ''
    do wx=1 to words(mbrs)
        m1 = word(mbrs, wx)
        rr = adrIsp("lmmDel dataid("lmmId") member("m1")", 0 8 12)
        if rc = 0 then
            say 'removed' m1 'from' pds
        else if rc = 8 then
            say 'not found' m1 'in' pds
        else do
            err = 'error deleting' m1 'in' pds 'rc' rr strip(zerrlm)
            say err
            leave
            end
        end
    call adrIsp "LMCLOSE DATAID("lmmId")"
    call adrIsp "LMFREE DATAID("lmmId")"
    if err <> '' then
        call err err
    return
endProcedure lmmRm
/*--- address ispf with error checking -------------------------------*/
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 'in' ggIspCmd':' strip(zerrlm)
endSubroutine adrIsp

/*--- address editor with error checking -----------------------------*/
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 adrTso begin *************************************************/
/*--- 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 */

/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure expose m.
parse upper arg dsn ., addPrefix
    if left(dsn,1) = "'" then
        return strip(dsn, 'b', "'")
    sp = sysvar('SYSPREF')
    if sp == '' then
        sp = userid()
    cx = pos('~', dsn)
    if cx < 1 & addPrefix == 1 then
        return sp'.'dsn
    do while cx \== 0
        le = left(dsn, cx-1)
        ri = substr(dsn, cx+1)
        if right(le, 1) == '.' | left(ri, 1) == '.' then
            dsn = le || sp || ri
        else
            dsn = le || left('.', le \== '') || sp ,
                     || left('.', ri \== '') || ri
        cx = pos('~', spec, cx)
        end
    return dsn
endProcedure dsn2Jcl

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

dsnSetMbr: procedure expose m.
parse arg dsn, mbr
     bx = pos('(', dsn)
     if bx > 0 then
         dsn = strip(left(dsn, bx-1))
     if mbr <> '' then
         dsn = dsn'('strip(mbr)')'
     return dsn
endProcedure dsnSetMbr

dsnGetMbr: procedure expose m.
parse arg dsn
     lx = pos('(', dsn)
     rx = pos(')', dsn, lx+1)
     if lx < 1 then
         return ''
     else if lx < rx then
         return substr(dsn, lx+1, rx-lx-1)
     else
         return strip(substr(dsn,lx+1))
endProcedure dsnGetMbr
/**********************************************************************
    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 expose m.
    parse upper arg ggDD
    call errAddCleanup 'call readDDEnd' ggDD', "*"'
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 */

/*--- finish reading DD  ggDD ----------------------------------------*/
readDDEnd: procedure expose m.
    parse upper arg ggDD, ggRet
    call errRmCleanup 'call readDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskr' ggDD '(finis)', ggRet)
endProcedure readDDEnd

/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
    parse upper arg ggDD
                  /* ensure file is erased, if no records are written */
    call adrTso 'execio' 0 'diskw' ggDD '(open)'
    call errAddCleanup 'call writeDDEnd' ggDD', "*"'
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 expose m.
parse upper arg ggDD, ggRet
    call errRmCleanup 'call writeDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskw' ggDD '(finis)', ggRet)
endProcedure writeDDEnd

/*--- standardise a dsn spec
       word1             dsName or -
       word2             dd     or -
       word3             disp   or -
       word4 to first :  attributes in tso format
       after first :     attributes for new allocation
----------------------------------------------------------------------*/
dsnSpec: procedure expose m.
parse upper arg spec
    rr = ''      /* put leading - in separate words */
    do sx=1 while words(rr) < 3 & wx \= ''
        wx = word(spec, sx)
        do while abbrev(wx, '-') & words(rr) < 3
            wx = substr(wx, 2)
            rr = rr '-'
            end
        rr = rr wx
        end
    spec = rr subWord(spec, sx)
    na = ''
    dd = ''
    di = ''
    if left(spec, 1) = '&' then /* external spec is handled ok */
        spec = strip(substr(spec, 2))
    do wx=1 by 1
        w = word(spec, wx)
        if w = '' | abbrev(w, '.') | abbrev(w, ':') then
            leave
        else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
            di = w
        else if w = 'CATALOG' then
            di = di w
        else if abbrev(w, 'DD(') then
            dd = substr(w, 4, length(w)-4)
        else if abbrev(w, 'DSN(') then
            na = strip(substr(w, 5, length(w)-5))
        else if na == '' then
            na = dsn2jcl(w)
        else if dd == '' then
            dd = w
        else if di == '' then
            di = w
        else
            leave
        end
    if na == '' then
        na = '-'
    else if abbrev(na, "'") then
        na = substr(na, 2, length(na)-2)
    if dd == '' then dd = '-'
    if di == '' then di = '-'
    re = subword(spec, wx)
    if abbrev(re, '.') then
        re = substr(re, 2)
    return na dd di re
endProcedure dsnSpec

/*--- alloc a dsn with dsnAlloc
          if the dsn is inuse wait and retry
          until either the allocation is successfull
          or the timeout occurs --------------------------------------*/
dsnAllocWait: procedure expose m.
parse upper arg spec, pDi, pDD, timeOut
    x = max(1, arg() - 1)
    do rt=0
        m.adrTsoAl.1 = ''
        m.adrTsoAl.2 = ''
        m.adrTsoAl.3 = ''
        call outtrap m.adrTsoAl.
        res = dsnAlloc(spec, pDi, pDD, '*')
        call outtrap off
        if \ abbrev(res, ' ') then
            return res
        msg = m.adrTsoAl.1'\n'm.adrTsoAl.2'\n'm.adrTsoAl.3
        if rt > timeOut & timeOut \== '' then
            return err('timeout allocating' spec time() '\n'msg)
        if pos('DATA SET IS ALLOCATED TO ANOTHER', msg) < 1 then
            return err('allocating' spec'\n'msg)
        say time() 'sleep and retry alloc' spec
        call sleep 1, 0
        end
endProcedure dsnAllocWait

/*--- alloc a dsn or a dd
          spec '-'<ddName>
               datasetName? disposition? '.'? attributes? (':' newAtts)?
          disp default disposition
          dd   default dd name
          retRc   erlaubte ReturnCodes (leer = 0)
          returns if ok then ddName <rexx for free> otherwise rc -----*/
dsnAlloc: procedure expose m.
parse upper arg spec, pDi, pDD, retRc
    parse value dsnSpec(spec) with na dd di rest
    if na = '-' then
        m.dsnAlloc.dsn = ''
    else
        m.dsnAlloc.dsn = na
    if na == '-' & dd \== '-' & di == '-' & rest = '' then
        return dd
    if dd == '-' & pDD \== '' then
        dd = pDD
    if dd == '-' then do
        if symbol('m.adrTso.ddNum') = 'VAR' then
            dd = m.adrTso.ddNum + 1
        else
            dd = 1
        m.adrTso.ddNum = dd
        dd = 'DD' || dd
        end
    if di = '-' & pDi \== '' then
        di = pDi
    if di = '-' then
        di = 'SHR'
    else if pos('(', na) < 1 then
        nop
    else if di = 'MOD' then
        call err 'disp mod for' na
    else
        di = 'SHR'
    if pos('/', na) > 0 then
        return csmAlloc(na dd di rest, retRc)
    else
        return tsoAlloc(na dd di rest, retRc)
endProcedure dsnAlloc

tsoAlloc: procedure expose m.
parse arg na dd disp rest ':' nn, retRc
    c = 'alloc dd('dd')' disp
    if na \== '-' then
        c = c "DSN('"na"')"
    else if disp = 'NEW' and nn \== '' then
        c = c dsnCreateAtts(,nn)
    call outtrap m.adrTsoAl.
    alRc = adrTso(c rest, '*')
    call outtrap off
    if alRc =  0 then do
        call errAddCleanup 'call tsoFree' dd', "*"'
        return dd 'call tsoFree' dd';'
        end
    if nn \= '' & wordPos(disp, 'OLD SHR') > 0 ,
          & sysDsn("'"m.dsnAlloc.dsn"'") == 'DATASET NOT FOUND' then do
        say 'tsoAlloc creating' c rest ':'nn
        call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(na, nn)
        call adrTso 'free  dd('dd')'
        return tsoAlloc(na dd disp rest, retRc)
        end
    do ax=1 to m.adrTsoAl.0
        say m.adrTsoal.ax
        end
    if retRc = '*' | wordPos(alRc, retRc) > 0 then
        return ' ' alRc
    call err 'tsoAlloc rc' alRc 'for' c rest
endProcedure tsoAlloc

tsoAtts: procedure expose m.
parse arg dsn
    rc = listDsi("'"dsn"' SMSINFO")
    if rc = 0 then
        mv = ''
    else if rc = 4 & sysReason = 19 then do
        mv = 'UNITCNT(30)'
        say 'multi volume' mv
        end
    else if rc ^= 0 then
        call err 'listDsi rc' rc 'reason' sysReason,
                             sysMsgLvl1 sysMsgLvl2
    al = 'CAT'
    al = ''
    if right(sysDsSms, 7) == 'LIBRARY' ,
        | abbrev(sysDsSms, 'PDS') then
         al = al 'DSNTYPE(LIBRARY)'
    if sysUnits = 'TRACK' then
        sysUnits = 'TRACKS'
    al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
        "DATACLAS("sysDataClass")" ,
        "RECFM("translate('1 2 3', ' 'sysREcFM, ' 123')")",
        "LRECL("SYSLRECL")",
        "blksize("sysBLkSIZE")",
        "SPACE("sysPrimary"," sysSeconds")" sysUnits mv
    return al
endProcedure tsoAtts

tsoFree: procedure expose m.
parse arg dd, ggRet
    call adrTso 'free dd('dd')', ggRet
    call errRmCleanup 'call tsoFree' dd', "*"'
    return
endProcedure tsoFree

dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
    forCsm = forCsm == 1
    aU = ' 'translate(atts)
    if abbrev(atts, ':') then do
        parse var atts a1 atts
        bl = 32760
        rl = substr(a1, 3)
        if abbrev(a1, ':F') then do
            if rl = '' then
                rl = 80
            recfm='f b'
            bl = bl - (bl // rl)
            end
        else do
            if rl = '' then
                rl = bl-4
            recfm = substr(a1, 2, 1) 'b'
            end
        if forCsm then
            atts =  atts "recfm("space(recfm, 0)") lrecl("rl")",
                    "blkSize("bl")"
        else
            atts = atts "recfm("recfm") lrecl("rl") block("bl")"
        end
    if pos('(', dsn) > 0 & pos(' DSNTYPE(', aU) < 1 ,
                         & pos(' DSORG(',   aU) < 1 then
        atts = atts 'dsntype(library) dsorg(po)'
    if pos(' MGMTCLAS(', aU) < 1 then
        atts = atts 'mgmtclas(COM#A091)'
    if pos(' SPACE(', aU) < 1 then
        if forCsm then
            atts = atts 'space(10, 1000) cylinder'
        else
            atts = atts 'space(10, 1000) cyl'
    if dsn == '' then
       return atts
    return "dataset('"dsnSetMbr(dsn)"')" atts
endProcedure dsnCreateAtts

/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/
readDSN:
parse arg ggDsnSpec, ggSt
    ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN')
    call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)'
    interpret subword(ggAlloc, 2)
    return
endSubroutine readDsn

/*--- write the dataset specified in ggDsnSpec from stem ggSt
          write ggCnt records if not empty otherwise ggst0
          if ggSay 1 then say ... records written to ... -------------*/
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
    call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
            '(stem' ggSt 'open finis)'
    interpret subword(ggAlloc, 2)
    if ggSay == 1 | m.debug == 1 then
       say ggCnt 'records written to' ggDsnSpec
    return
endSubroutine writeDsn

copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
    frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
    toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
    call readDDBegin word(frDD, 1)
    call writeDDBegin word(toDD, 1)
    cnt = 0
    do while readDD(word(frDD, 1), r.)
        call writeDD word(toDD, 1), r.
        cnt = cnt + r.0
        end
    call readDDEnd word(frDD, 1)
    call writeDDEnd word(toDD, 1)
    interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
    if ggSay == 1 | m.debug == 1 then
       say cnt 'records copied from' frSpec 'to' to toSpec
    return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
    messages, errorhandling,help
***********************************************************************/
errIni: procedure expose m.
    if m.err.ini == 1 then
        return
    call outIni
    m.err.ini     = 1
    m.err.handler = ''
    m.err.cleanup = ';'
    m.err.opt     = ''
    return
endProcedure errIni
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
    call errIni
    parse arg m.err.opt, m.err.handler
    if pos('I', translate(m.err.opt)) > 0 then
        if errOS() \== 'LINUX' then
            if sysVar('sysISPF') = 'ACTIVE' then
                    call adrIsp 'control errors return'
    return
endSubroutine errReset

/*--- error routine: abend with message ------------------------------*/
err:
    parse arg ggTxt, ggOpt
    call errIni
    drop err handler cleanup opt call return
    if ggOpt == '' & m.err.handler \== '' then do
        if 1 then do /* no detection of recursive err call loop
                        --> will anyway fail by stack overflow */
            interpret m.err.handler
            end
        else do
                     /* avoid recursive err call loop */
            drop call return
            if symbol('m.err.call') \== 'VAR' then
                m.err.call = 1
            else
                m.err.call = m.err.call + 1
            if m.err.call > 10 then do
                say 'errHandler loop:' m.err.handler
                end
            else do
                m.err.return = 1
                call errInterpret m.err.handler
                m.err.call = m.err.call - 1
                if m.err.return then
                    return result
                end
            end
        end
    call outPush
    call errSay ggTxt, 'e'
    call errCleanup
    if ggOpt == '' then
        ggOpt = m.err.opt
    ggOpt = translate(ggOpt)
    if pos('T', ggOpt) > 0  then do
        trace ?r
        say 'trace ?r in err'
        end
    if pos('H', ggOpt) > 0  then do
        call errSay 'divide by zero to show stackHistory', 'e'
        x = 1 / 0
        end
    call errSay 'exit(12)', 'e'
    exit errSetRc(12)
endSubroutine err

errAddCleanup: procedure expose m.
parse arg code
    if m.err.ini \== 1 then
        call errIni
        /* concatenate backwards, then it is executed also backwards */
    m.err.cleanup = ';'code || m.err.cleanup
    return
endProcedure errAddCleanup

errRmCleanup: procedure expose m.
parse arg code
    if m.err.ini \== 1 then
        call errIni
    cx = pos(';'code';', m.err.cleanup)
    if cx > 0 then
        m.err.cleanup = left(m.err.cleanup, cx) ,
                     || substr(m.err.cleanup, cx + length(code)+2)
    return
endProcedure errRmCleanup

errCleanup: procedure expose m.
    call errIni
    cl = m.err.cleanup
    if cl = ';' then
        return
    m.err.cleanup = ';'
    call out 'err cleanup begin' cl
    call errInterpret cl
    call out 'err cleanup end' cl
    return
endProcedure errCleanup

errInterpret: procedure expose m.
parse arg code
    interpret code
    m.err.return = 0
    return
endProcedure errInterpret
/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
    interpret 'assertRes =' arg(1)
    if \ assertRes then
        call err 'assert failed' arg(1)':' arg(2)
    return
endProcedure assert

/*--- output an errorMessage msg with pref pref
           split message in lines at '/n' ---------------------------*/
errSay: procedure expose m.
parse arg msg, pref
    parse source . . ggS3 .                           /* current rexx */
    if pref == 'e' then
        msg = 'fatal error in' ggS3':' msg
    else if pref == 'w' then
        msg = 'warning in' ggS3':' msg
    else if pref \== '' then
        msg = pref':' msg
    return outNl(msg)
endProcedure errSay

/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
    call errSay msg, 'e'
    call help
    call err msg, op
endProcedure errHelp

/*--- return the Operating System we are running on: TSO or LINUX ---*/
errOS: procedure expose m.
    parse source os .
    return os
endProcedure errOS

/*--- set rc for ispf: -------------------------------------------------
    if a cmd is run by ispStart, its RC is ignored,
         but ISPF passes the value of the shared varible 3IspfRc
         back as return code
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
    if errOS() \== 'LINUX' then
           if sysVar('sysISPF') = 'ACTIVE' then
            address ispExec vput 'zIspfRc' shared
    return zIspfRc
endProcedure errSetRc

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

debug: procedure expose m.
parse arg msg
    if m.debug == 1 then
        call out 'debug' msg
    return
endProcedure debug

/*--- display the first comment block of the source as help ----------*/
help: procedure expose m.
    parse source . . s3 .
    call out right(' help for rexx' s3, 79, '*')
    if arg() > 0 then
        say ' ' arg(1)
    do lx=1 by 1
        if pos('/*', sourceLine(lx)) > 0 then
            leave
        else if lx > 10 then do
            call out '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
        call out li
        end
    call out right(' end help for rexx' s3, 79, '*')
    return 4
endProcedure help

/*--- output all lines (separated by '\n') of all args --------------*/
outNl: procedure expose m.
    do ax=1 to max(1, arg())
        msg = arg(ax)
        sx = 0
        bx = -1
        do lx=1 until bx >= length(msg)
                ex = pos('\n', msg, bx+2)
            if ex < 1 then
                ex = length(msg)+1
            call out substr(msg, bx+2, ex-bx-2)
            bx = ex
         end
        end
    return 0
endProcedure outNl
/* copy err end   *****************************************************/
/* copy out begin ******************************************************
    out interface with simplistic implementation
***********************************************************************/
outIni: procedure expose m.
parse arg msg
    if m.out.ini == 1 then
        return
    m.out.ini = 1
    m.out.dst = ''
    return
endProcedure outIni

/*--- output a message to the current destination -------------------*/
out: procedure expose m.
parse arg msg
    if m.out.ini \== 1 then
        call outIni
    if m.out.dst == '' then do
        say msg
        end
    else do
        st = m.out.dst
        sx = m.st.0 + 1
        m.st.0 = sx
        m.st.sx = msg
        end
    return 0
endProcedure out

/*--- push an out destination ---------------------------------------*/
outPush: procedure expose m.
parse arg m.out.dst
    return
endProcedure outPush
/* copy out end   *****************************************************/