zOs/REXX.O13/PI

/* copy pi begin ****************************************************
      pi = pipe interface and simple pipes
***********************************************************************/

/*--- begin execution of pipe pp (created by piNew)
            with output redirection outDSS ---------------------------*/
piBegin: procedure expose m.
parse arg pp, outDSS
    lc = m.pi.chLast.pp
    do x = pp to m.pi.chLast.pp
        m.wr.prcSta.x    = 0
        call wrDefine x, "b"
        end
    if m.pi.redirOut.pp then
        call wr2Ds m.pi.out.lc, outDss
    else
        m.pi.out.lc = m.wr.out
    call outPush , pp
    call piBar 'b'
    return
endProcedure piBegin

/*--- end executution of pipe pp (after piBegin and piBar*)
      close pipe if immediate delay close ----------------------------*/
piEnd: procedure expose m.
parse arg pp, immediate
    ch = m.wr.prc
    call piBar 'e'
    if pp ^= m.pi.chFirst.ch then
        call err 'piEnd on wrong pipe'
    if ch ^== m.pi.chLast.pp then
        call err 'piEnd but not on lastChild'
    orCl = m.wr.close.pp

    if immediate == '' & (m.pi.redirIn.pp & m.pi.redirOut.pp) then
        immediate = 1
    if immediate == 1 then do
        call piClose pp, orCl
        call wrDefine pp
        end
    else do
        call wrDefine pp, m.wr.write.pp,
           , 'call piClose' pp',' quote(orCl)
        if immediate == '' then
            call piDefine 'call write' pp', stem', 'call wrClose' pp
        else if immediate ^== '0' then
            call err 'piEnd bad immediate:' immediate
        end
    return
endProcedure piEnd

/*--- close pipe pp, close first child with ch1Clo -------------------*/
piClose: procedure expose m.
parse arg pp, ch1Clo
    if m.wr.prcSta.pp == 'c' then
        return
    call outPush m.pi.out.pp, pp
    if m.wr.wrBuf.pp.0 ^== 0 then
        call write pp
    interpret ch1Clo
    m.wr.wrbuf.pp.0 = 0          /* in case it was buffering */
    call outPop
    do cx=pp+1 to m.pi.chLast.pp
        call wrClose cx
        end
    ch = m.pi.chLast.pp
    if m.pi.redirOut.pp then
        call wrClose m.pi.out.ch
    m.wr.prcSta.pp = 'c'
    return
endProcedure piClose

/*--- switch to next child,
          be means 'b'=begin, 'e'=end, ''=middle ---------------------*/
piBar: procedure expose m.
parse arg be
    ch = m.wr.prc
    pp = m.pi.chFirst.ch
    if m.wr.prcTyp.ch ^== 'pipe' then
        call err 'piEnd but prc not pipe'
    if m.wr.prcTyp.pp ^== 'pipe' then
        call err 'piEnd but chFirst not pipe'
    call outPop
    if be == 'b' then
        nc = ch
    else
        nc = m.pi.out.ch
    if be ^== 'e' then do
        if nc < m.pi.chFirst.pp | nc > m.pi.chLast.pp then
            call err 'piBar newChild' nc 'out of range',
                     m.pi.chFirst.pp'..'m.pi.chLast.pp
        call outPush m.pi.out.nc, nc
        end
    return
endProcedure piBar

/*--- make the current process a writer if piping
          otherwise execute close function ---------------------------*/
piDefine: procedure expose m.
parse arg wri, clo, w2, w3
    ch = m.wr.prc
    if m.wr.prcTyp.ch == '' then do
        m = ch
        stem = ''
        interpret clo
        return
        end
    if m.wr.prcSta.ch ^== '' then do
        if m.wr.prcSta.ch ^== 0 then
            call err 'duplicate piDefine for child' ch
        m.wr.prcSta.ch = 1
        end
    push = "call outPush" m.wr.out"," ch";"
    pop  = "; call outPop"
    call wrDefine ch, push wri, push "do;" clo"; end"pop, w2, w3 pop
    return
endProcedure piDefine

/*--- create a new pipe with cnt children
          reIn, reOut whether we have redirection --------------------*/
piNew: procedure expose m.
parse arg cnt, reIn, reOut
    pp = wrNew('pipe', 0)
    m.pi.redirIn.pp = reIn = 1
    m.pi.redirOut.pp = reOut = 1
    cnt = cnt + m.pi.redirIn.pp
    m.pi.chFirst.pp = pp
    la = pp
    ch = pp
    do cx=2 to cnt
        ch = wrNew('pipe', 0)
        m.pi.chFirst.ch = pp
        m.pi.out.la = ch
        la = ch
        end
    m.pi.chLast.pp = ch
    if m.pi.RedirOut.pp then
        m.pi.out.ch = wrNew('pipe', 0)
    return pp
endProcedure piNew

/*--- create a new sequence ------------------------------------------*/
piSeqNew: procedure expose m.
parse arg cnt, reIn, reOut
    sq = wrNew('seq')
    m.pi.prc.sq = wrNew('seq')
    m.pi.code.sq.0 = 0
    return sq
endProcedure piSeqNew

/*--- add the code for the next seq stastement -----------------------*/
piSeqAdd: procedure expose m.
parse arg sq, aCd
    cx = m.pi.code.sq.0 + 1
    m.pi.code.sq.0 = cx
    m.pi.code.sq.cx = aCd
    return
endProcedure

/*--- activate sequence depending on piping envrionment --------------*/
piSeq: procedure expose m.
parse arg sq
    m.pi.runX.sq = 0
    call piDefine "call piSeqRun" sq", 0, stem",
                  , "call piSeqRun" sq", 1"
    return
endProcedure piSeq

/*--- execute sequence sq, if close then close it otherwise
      if close then close it else write stem -------------------------*/
piSeqRun: procedure expose m.
parse arg sq, close, stem
    rx = m.pi.runX.sq
    pr = m.pi.prc.sq
    if rx > m.pi.code.sq.0 then
        return
    if rx > 0 then do
        if ^ close then do
            call write pr, stem
            return
            end
        call wrClose pr
        end
    do rx = rx+1 to m.pi.code.sq.0
        call piSeqRunOne sq, rx
        if m.wr.write.pr ^== '' & ^ close then do
            call write pr, stem
            m.pi.runX.sq = rx
            call wrDefine sq, m.wr.write.pr, 'call piSeqRun' sq', 1'
            return
            end
        call wrClose m.pi.prc.sq
        end

    m.pi.runX.sq = rx
    call wrDefine sq
    return
endProcedure piSeqRun

/*--- in sequence sq exectute statement cx ---------------------------*/
piSeqRunOne: procedure expose m.
parse arg sq, cx
    pr = m.pi.prc.sq
    call wrDefine pr
    m.wr.prcSta.pr = 0
    call outPush , pr
    interpret m.pi.code.sq.cx
    call outPop
    return
endProcedure piSeqRunOne

/*--- comp pipe stmt (($:wr!$:li!$:in) stmt?)? ($:cl stmt?)? $:end? --*/
piCmpStmt: procedure expose m.
parse arg m
    aa = ''
    ab = ','

    if symbol("m.pi.define.0") = 'VAR' then
        px = 1 + m.pi.define.0
    else
        px = 1
    if scanLit(m, '$:wr') then do
        call scanSpaceNL m
        m.pi.defineWr1.px = rscStmt(m, 0)
        aa = 'm.pi.defineWr1.'px
        end
    else if scanLit(m, '$:li') then do
        call scanSpaceNL m
        m.pi.defineWr2.px = rscStmt(m, 0)
        aa = 'm.pi.defineWr2.'px
        end
    else if scanLit(m, '$:in') then do
        call scanSpaceNL m
        m.pi.defineWr2.px = rscStmt(m, 0)
        aa = 'm.pi.defineWr2.'px', "call out stem"'
        end

    call scanSpaceNL m
    if scanLit(m, '$:cl') then do
        call scanSpaceNL m
        m.pi.defineClo.px = rscStmt(m, 0)
        ab = 'm.pi.defineClo.'px','
        end

    if aa == '' & ab == ',' then
        return ""

    m.pi.define.0 = px
    call scanSpaceNL m
    if scanLit(m, '$:end') then do
        call scanSpaceNL m
        end
    if pos('Wr1.', aa) > 0 then
        return 'call piDefine' aa',' ab
    else
        return 'call piDefine' ',' ab aa
endProcedure piCmpStmt

/*--- generate code for a pipe from stmts, input and output --------*/
piCmpPipe: procedure expose m.
    parse arg stCnt, st, inp, out
    px = piNew(stCnt, inp ^== '', out ^== '')
    if inp ^== '' then
        if stCnt > 0 then
            st = inp'; call piBar;' st
        else
            st = inp
    return 'call piBegin' px',' out'; do;' st '; end;call piEnd' px
endProcedure piCmpPipe

/*--- compile a Sequence = '(stmt ! '$;')* ---------------------------*/
piCmpSeq: procedure expose m.
parse arg m
    cnt = 0
    sq = ''
    code = ''
    call scanSpaceNL m
    do forever
        if scanLit(m, '$;') then do
            call scanSpaceNL m
            end
        else do
            one = rscPipe(m)
            if one == '' then
                return rscStrip(code)
            else if sq ^== '' then
                call piSeqAdd sq, one
            else if code == '' then
                code = one
            else do
                sq = piSeqNew()
                call piSeqAdd sq, code
                call piSeqAdd sq, one
                code = 'call piSeq' sq
                end
            end
        end
endProcedure piCmpSeq
/**********************************************************************
      pipe = simple pipes
***********************************************************************/
piWC: procedure expose m.
parse arg wrT, wrO, wrC
    m = m.wr.prc
    m.wr.wc.m.chars = 0
    m.wr.wc.m.lines = 0
    if wrO ^== '' then
        call outLn wrO
    if wrT = 0 then
        wri = ''
    else if wrT == '' then
        wri = ';call outLn m.line'
    else
        wri = ';call outLn' quote(wrT) 'm.line'
    if wrC == '' then
        wrC = "piWC" m "counted'"
    call piDefine "m.wr.wc."m".lines =    m.wr.wc."m".lines + m.stem.0",
        , "call outLn " quote(wrC),
          "    m.wr.wc."m".lines 'lines and'",
          "    m.wr.wc."m".chars 'characters'",
        , "  m.wr.wc."m".chars = m.wr.wc."m".chars + length(m.line)" wri
    return
endProcedure piWC

/* copy pi end ********************************************************/