zOs/REXX.O13/PIPE

/* copy pipe begin *****************************************************
***********************************************************************/
pipeIni: procedure expose m.
    if m.pipe.ini == 1 then
        return
    m.pipe.ini = 1
    call catIni
    call mapReset env.vars
    m.env.with.0 = 0
    call mapReset env.c2w
    call mNewArea 'ENV.WICO', '='
    m.pipe.0 = 1
    m.pipe.1.in  = jOpen(oNew('JRWEof'), '<')
    m.pipe.1.out = jOpen(oNew('JSay'), '>')
    call pipe '+'
    return
endProcedure pipeIni

/*-------------------------------
  +-       push pop frame
  PYNFA    ouput Parent saY Newcat File, Appendtofile
  psf|     parent string file oldOut
  old          --> new
  pipeBegin    --> pipe '+N'
  pipeBeLa f   --> pipe '+F'
  pipeLast     --> pipe 'P|'
  pipeLast f   --> pipe 'F|', f
  pipeEnd      --> pipe '-'
--------------------------------*/
pipe: procedure expose m.
parse arg opts, aO, aI
    ox = 1; oc = substr(opts, ox, 1)
    ax = m.pipe.0
    px = ax -1
    if oc == '-' then do
        if px < 2 then
            call err 'pipe pop empty'
        call jClose m.pipe.ax.out
        call jClose m.pipe.ax.in
        ax = px
        m.pipe.0 = ax
        px = ax-1
        ox = ox+1; oc = substr(opts, ox, 1)
        end
    if oc == '+' then do
        px = ax
        ax = ax+ 1
        m.pipe.0 = ax
        m.pipe.ax.in  = jOpen(m.pipe.px.in, '<')
        m.pipe.ax.out = jOpen(m.pipe.px.out, '>')
        ox = ox+1; oc = substr(opts, ox, 1)
        end
    oOut = m.pipe.ax.out
    if pos(oc, 'NYPFA') > 0 then do
        call jClose oOut
        if oc == 'Y' then
            m.pipe.ax.out = jOpen(m.pipe.1.out, '>')
        else if oc == 'P' then
            m.pipe.ax.out = jOpen(m.pipe.px.out, '>')
        else if oc == 'N' then
            m.pipe.ax.out = jOpen(Cat(), '>')
        else if oc == 'F' then
            m.pipe.ax.out = jOpen(o2file(aO), '>')
        else if oc == 'A' then
            m.pipe.ax.out = jOpen(o2file(aO), '>>')
        ox = ox+1; oc = substr(opts, ox, 1)
        end
    if pos(oc, 's|fp') > 0 then do
        call jClose m.pipe.ax.in
        if oc == 'p' then
            m.pipe.ax.in = jOpen(m.pipe.px.in, '<')
        else if oc == '|' then
            m.pipe.ax.in = jOpen(oOut, '<')
        else if oc == 'f' then do
            if arg() <= 3 then
                m.pipe.ax.in = jOpen(o2file(aI), '<')
            else do
                ct = jOpen(Cat(), '>')
                do lx = 3 to arg()
                    call jWriteAll ct, arg(lx)
                    end
                m.pipe.ax.in = jOpen(jclose(ct), '<')
                end
            end
        else if arg() <= 3 then
            m.pipe.ax.in = jOpen(jBuf(aI), '<')
        else do
            bu = jOpen(jBuf(), '>')
            do lx = 3 to arg()
                call jWrite bu, arg(lx)
                end
            m.pipe.ax.in = jOpen(jclose(bu), '<')
            end
        ox = ox+1; oc = substr(opts, ox, 1)
        end
    if oc \== ' ' then
        call err 'implement' substr(opts, ox) 'in pipe' opts
    m.j.in  = m.pipe.ax.in
    m.j.out = m.pipe.ax.out
    return
endProcedure pipe

/*--- write all from rdr (rsp in) to out, not lazy ----------------*/
pipeWriteNow: procedure expose m.
    parse arg rdr
    call jWriteNow m.j.out, if(rdr == '', m.j.in, rdr)
    return
endProcedure pipeWriteNow

/*--- write all from rdr (rsp in) to out, possibly lazy -----------*/
pipeWriteAll: procedure expose m.
parse arg rdr
    call jWriteAll m.j.out, if(rdr == '', m.j.in, rdr)
    return
endProcedure pipeWriteAll

pipePreSuf: procedure expose m.
parse arg le, ri
    do while in(v)
        call out le || m.v || ri
        end
    return
endProcedure pipePreSuf

envIsDefined: procedure expose m.
parse arg na
    return   '' \== mapValAdr(env.vars, na)
endProcedure envIsDefined

envPushWith: procedure expose m.
parse arg obj, cl, fn, elCl
    tos = m.env.with.0 + 1
    m.env.with.0 = tos
    m.env.with.tos.fun = fn
    m.env.with.tos.muElCl = ''
    if fn == '' then do
        call envSetWith obj, cl
        return
        end
    if cl == '' then
        cl = objClass(obj)
    if fn == 'as1' then do
        call envSetWith obj, cl
        m.env.with.tos.muElRef = m.cl.valueCl \== '',
                               & m.cl.valueCl \== m.class.classV
        if m.env.with.tos.muElRef then
            m.env.with.tos.muElCl = m.cl.valueCl
        else
            m.env.with.tos.muElCl = cl
        return
        end
    else if fn \== 'asM' then
        call err 'bad fun' fn
    ff = oClaMet(cl, 'oFlds')  /*just be sure it's initialised */
    if m.cl.stemCl == '' then
        call err 'class' className(cl) 'not stem'
    cc = m.cl.stemCl
    isRef = m.cc == 'r'
    m.env.with.tos.muElRef = isRef
    if m.cc \== 'r' then
        m.env.with.tos.muElCl = cc
    else if elCl \== '' then
        m.env.with.tos.muElCl = elCl
    else if m.cc.class == '' then
        call err 'elCl null for envPushWith('obj ','cl ','multi', ...)'
    else
        m.env.with.tos.muElCl = m.cc.class
    m.env.with.tos.class = ''
    m.env.with.tos.muCla = cl
    m.env.with.tos.muObj = obj
    return
endProcedure envPushWith

envSetWith: procedure expose m.
parse arg obj, cl
    if cl == '' & obj \== '' then
        cl = objClass(obj)
    tos = m.env.with.0
    m.env.with.tos = obj
    m.env.with.tos.class = cl
    return
endProcedure envSetWith

envWithObj: procedure expose m.
    tos = m.env.with.0
    if tos < 1 then
        call err 'no with in envWithObj'
    return m.env.with.tos
endProcedure envWithObj

envAccPath: procedure expose m. m cl
parse arg pa, stop, nllNw
    nullNew = nllNw == 1
    dx = verify(pa, m.class.cPath, 'm')
    if dx = 0 then do
        n1 = pa
        p2 = ''
        end
    else do
        n1 = left(pa, dx-1)
        p2 = substr(pa, dx)
        end
    wCla = ''
    do wx = m.env.with.0 by -1 to if(stop==1, m.env.with.0, 1)
        wCla = m.env.with.wx.class
        if symbol('m.wCla.f2c.n1') == 'VAR' then
            return oAccPath(m.env.with.wx, pa, m.env.with.wx.class)
        end
    if stop == 1 then
        return 'no field' n1 'in class' className(wCla)
    vv =  mapValAdr(env.vars, n1)
    if vv \== '' then
        if p2 == '' then
            return oAccPath(vv, '', m.class.classR)
        else
            return oAccPath(vv, '|'p2, m.class.classR)
    else if nullNew & p2 == '' then
        return oAccPath(mapValAdr(env.vars, n1,'a'), p2,m.class.classR)
    else
        return 'undefined variable' pa
endProcedure envAccPath

envWithNext: procedure expose m.
parse arg beEn, defCl, obj
    tos = m.env.with.0
    if tos < 1 then
        call err 'envWithNext with.0' tos
    st = m.env.with.tos.muObj
    if beEn  == 'b' then do
        if m.env.with.tos.fun == 'asM' then
            m.st.0 = 0
        if m.env.with.tos.muElCl == '' then
            m.env.with.tos.muElCl = defCl
        end
    else if m.env.with.tos.fun == 'asM' then
        m.st.0 = m.st.0 + 1
    else if m.env.with.tos.fun == '' then
        call outO m.env.with.tos
    else if beEn = '' then
        call err 'no multi allowed'
    if beEn == 'e' then
        return
    if m.env.with.tos.fun == 'as1' then do
         if m.env.with.tos == '' then
             call err 'implement withNext null'
         return
         end
/*  if obj \== '' then do
        if \ m.env.with.tos.muElRef then
            call err 'obj but not ref'
        m.nn = obj
        call envSetWith obj
        end
*/
    if m.env.with.tos.fun == '' then do
        call envSetWith oNew(m.env.with.tos.muElCl)
        return
        end
    nn = st'.' || (m.st.0 + 1)
    if m.env.with.tos.muElRef then do
        m.nn = oNew(m.env.with.tos.muElCl)
        call envSetWith m.nn
        end
    else do
        call oClear oMutate(nn, m.env.with.tos.muElCl)
        call envSetWith nn
        end
    return
endProcedure envWithNext

envPushName: procedure expose m.
parse arg nm, multi, elCl
    res = envAccPath(nm, , 1)
    if res \== 1 then
        return err(res 'in envPushName('nm',' multi')')
    do while m.cl == 'r'
        if m.m == '' then do
            res = oRefSetNew(m, cl)
            if res \== 1 then
                call err res 'in envPushName('nm',' multi')'
            end
        m = m.m
        cl = objClass(m)
        end
    call envPushWith m, cl, multi, elCl
    return
endProcedure envPushName

envNewWiCo: procedure expose m.
parse arg co, cl
    k1 = strip(co cl)
    n = mapGet('ENV.C2W', k1, '')
    if n \== '' then
        return n
    k2 = k1
    if co \== '' then do
        k2 = strip(m.co.classes cl)
        n = mapGet('ENV.C2W', k2, '')
        end
    k3 = k2
    if n == '' then do
        cx = wordPos(cl, m.co.classes)
        if cx > 0 then do
            k3 = space(subWord(m.co.classes, 1, cx-1),
                     subWord(m.co.classes, cx+1) cl, 1)
            n = mapGet('ENV.C2W', k3, '')
            end
        end
    if n == '' then
        n = envNewWico2(co, k3)
    call mapAdd 'ENV.C2W', k1, n
    if k2 \== k1 then
        call mapPut 'ENV.C2W', k2, n
    if k3 \== k2 & k3 \== k1 then
        call mapPut 'ENV.C2W', k3, n
    return n
endProcedure envNewWiCo

envNewWiCo2: procedure expose m.
parse arg co, clLi
    n = mNew('ENV.WICO')
    if co == '' then
        m.n.level = 1
    else
        m.n.level = m.co.level + 1
    m.n.classes = clLi
    na = ''
    do cx = 1 to words(clLi)
        c1 = word(clLi, cx)
        na = na className(c1)
        do qx=1 to 2
            ff = c1 || word('.FLDS .STMS', qx)
            do fx = 1 to m.ff.0
                fn = m.ff.fx
                if fn == '' then
                    iterate
                fn = substr(fn, 2)
                m.n.f2c.fn = cx
                end
            end
        end
    m.n.classNames = space(na, 1)
    return n
endProcedure envNewWiCo2

envPopWith:procedure expose m.
    tos = m.env.with.0
    m.env.with.0 = tos - 1
    return
endProcedure envPopWith

envGet: procedure expose m.
parse arg na
    res = envAccPath(na)
    if res == 1 then
        res = oAccStr(m, cl)
    if res == 1 then
        return str
    return err(res 'in envGet('na')')
endProcedure envGet

envGetO: procedure expose m.
parse arg na, opt
    res = envAccPath(na, , opt == '-b')
    if res == 1 then
        res = oAccO(m, cl, opt)
    if res == 1 then
        return ref
    return err(res 'in envGetO('na')')
endProcedure envGetO

envPutO: procedure expose m.
parse arg na, ref, stop
    res = envAccPath(na, stop, 1)
    if res == 1 then
        res = ocPutO(m, cl, ref)
    if res = 1 then
        return ref
    return err(res 'in envPutO('na',' ref',' stop')')
endProcedure envPutO

envPut: procedure expose m.
parse arg na, va, stop
    res = envAccPath(na, stop , 1)
    if res == 1 then
        res = ocPut(m, cl, va)
    if res == 1 then
        return va
    return err(res 'in EnvPut('na',' va',' stop')')
endProcedure envPut

envRead: procedure expose m.
parse arg na
    return in("ENV.VARS."na)

envReadO: procedure expose m.
parse arg na
    res = inO()
    if res == '' then
        return 0
    call envPutO na, res
    return 1
endProcedure envReadO

envHasKey: procedure expose m.
parse arg na
    return mapHasKey(env.vars, na)

envRemove: procedure expose m.
parse arg na
    return mapRemove(env.vars, na)
/* copy pipe end ******************************************************/