zOs/REXX/M

/* copy m begin *******************************************************
  we use variables as follows
    m. stem m: all global data and object data that must survive
               a procedure call  (m for memory in Memoria of B5000)
    m.<mbr>.** and m.<mbr>_**: every rexx Module (copy) should only
               allocate these addresses to avoid address conficts
               with <mbr> the name of therexx module
        we pass parameters around (e.g. a=address, m=memory, st=stem)
            and the called function may use m.a or m.a.subField etc.
    gg*: local variable in subroutines without procedure
    everything else: temporary data within procedure

  every subroutine is declared as procedure expose m.
      (also if no m. variable is used, because e.g. of error handling)
  the few subroutines that cannot use procedure, should use only
        variables starting with gg
**********************************************************************/
/*---make an area -----*/

mNewArea: procedure expose m.
parse arg nm, adr
    ax = m.m_area.0 + 1
    m.m_area.0 = ax
    m.m_area.ax = nm
    if adr == '=' then
        adr = nm
    else if adr == '' then
        adr = 'M.'ax
    if symbol('m.m_2a.nm') == 'VAR' then
        call err 'area name' nm 'already used'
    if symbol('m.m_2a.adr') == 'VAR' then
        call err 'adr' adr 'for area' nm 'already used'
    m.m_2a.adr = adr
    m.m_2a.nm  = adr
    m.adr.0 = 0
    m.m_free.adr.0 = 0
    return nm
endProcedure mNewArea

mNew: procedure expose m. ggArea
parse arg name
    if symbol('m.m_2a.name') \== 'VAR' then
        call err 'area' name 'does not exists'
    adr = m.m_2a.name
    if m.m_free.adr.0 > 0 then do
        fx = m.m_free.adr.0
        m.m_free.adr.0 = fx-1
        return m.m_free.adr.fx
        end
    m.adr.0 = m.adr.0 + 1
    return adr'.'m.adr.0
endProcedure mNew

mFree: procedure expose m.
parse arg m
    adr = left(m, lastPos('.', m)-1)
    fx = m.m_free.adr.0 + 1
    m.m_free.adr.0  = fx
    m.m_free.adr.fx = m
    return ''
endProcedure mFree
/*--- iterate over all allocate elements of an area -----------------*/
mIterBegin: procedure expose m.
parse arg nm
    return m.m_2a.nm'.0'
endProcedure mIterBegin

mIter: procedure expose m.
parse arg cur
    if cur == '' then
        return ''
    lx = lastPos('.', cur)
    adr = left(cur, lx-1)
    ix = substr(cur, lx+1)
    do ix=ix+1 to m.adr.0
        n = adr'.'ix
        do fx=1 to m.m_free.adr.0 while m.m_free.adr.fx \== n
            end
        if fx > m.m_free.adr.0 then
            return n
        end
    return ''
endProcedure mIter

/*--- get m.a -------------------------------------------------------*/
mGet: procedure expose m.
parse arg a
    return m.a
endProcedure mGet

/*--- put value v into m.a ------------------------------------------*/
mPut: procedure expose m.
parse arg a, v
    m.a = v
    return v
endProcedure mPut

/*--- cut stem a to length len --------------------------------------*/
mCut: procedure expose m.
parse arg a, len
    m.a.0 = len
    return a
endProcedure mCut

/*--- add one or several arguments to stem m.a ----------------------*/
mAdd: procedure expose m.
parse arg a
    ix = m.a.0
    do ax = 2 to arg()
        ix = ix + 1
        m.a.ix = arg(ax)
        end
    m.a.0 = ix
    return a'.'ix
endProcedure mAdd

/*--- pop last element from stem m.a --------------------------------*/
mPop: procedure expose m.
parse arg a
    ix = m.a.0
    if ix < 1 then
        call err 'pop from empty stem' a
    m.a.0 = ix-1
    return m.a.ix
endProcedure mPop

/*--- create the inverse map of a stem ------------------------------*/
mInverse: procedure expose m.
parse arg a, i
    do x=1 to m.a.0
        v = m.a.x
        m.i.v = x
        end
    return m.a.0
endProcedure inverse

/*--- add to m.dst.* a (sub)sequence of m.src.* ---------------------*/
mAddSt: procedure expose m.
    parse arg dst, src, fx , tx
    dx = m.dst.0
    if fx == '' then
        fx = 1
    if tx == '' then
        tx = m.src.0
    do sx = fx to tx
        dx = dx + 1
        m.dst.dx = m.src.sx
        end
    m.dst.0 = dx
    return dst
endProcedure mAddSt

/*--- find position of first occurrence of ele in stem m,
        return 0 if nonemove a part of a stem -----------------------*/
mPos: procedure expose m.
parse arg m, ele, sx
    if sx == '' then
        sx = 1
    do x=sx to m.m.0
        if m.m.x = ele then
            return x
        end
    return 0
endProcedure mPos

/*--- move a part of a stem -----------------------------------------*/
mMove: procedure expose m.
parse arg m, sx, dx
    if dx < sx then do
        y = dx
        do x=sx to m.m.0
            m.m.y = m.m.x
            y = y + 1
            end
        end
    else if dx > sx then do
        y = m.m.0 + dx - sx
        do x=m.m.0 by -1 to sx
            m.m.y = m.m.x
            y = y - 1
            end
        end
    m.m.0 = m.m.0 + dx - sx
    return
endProcedure mMove

/*--- insert a stem into another ------------------------------------*/
mInsert: procedure expose m.
parse arg m, tx, st
    call mMove m, tx, tx+m.st.0
    do sx=1 to m.st.0
        dx = tx-1+sx
            m.m.dx = m.st.sx
            end
    return
endProcedure mInsert

/*--- strip all elements of a stem ----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
    if opt == '' then
        opt = 'b'
    do x=1 to m.st.0
        m.st.x = strip(m.st.x, opt)
        end
    return st
endProcedure mStrip

/* cat the lines of a stem with separator ---------------------------*/
mCat: procedure expose m.
parse arg st, sep
    if m.st.0 < 1 then
        return ''
    res = m.st.1
    do sx=2 to m.st.0
        res = res || sep || m.st.sx
        end
    return res
endProcedure mCat

mIni: procedure expose m.
    if m.m_ini == 1 then
        return
    m.m_ini = 1
    call utIni
    m.m_area.0 = 0
    call mNewArea
    return
endProcedure mIni

/* copy m end ********************************************************/