zOs/REXX.O08/SRT

call sortTest
/* copy sort begin ****************************************************/
sort: procedure expose m.
parse arg i, o
    call sort1 i, 1, m.i.0, o, 1, sort.work, 1
    m.o.0 = m.i.0
    return
endProcedure sort

sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w1
    if le <= 1 then do
        if le = 1 then
            m.o.o0 = m.i.i0
        return
        end
    h = (le + 1) % 2
    call sort1 i, i0,   h,    o, o0+le-h, w, w1
    call sort1 i, i0+h, le-h, w, w1,      o, o0
    call sortMerge o, o0+le-h, o0+le, w, w1, w1+le-h, o, o0
    return
endProcedure sort1

sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
    do while l0 < le & r0 < re
        if m.l.l0 <<= m.r.r0 then do
            m.o.o0 = m.l.l0
            l0 = l0 + 1
            end
        else do
            m.o.o0 = m.r.r0
            r0 = r0 + 1
            end
        o0 = o0 + 1
        end
    do while l0 < le
        m.o.o0 = m.l.l0
        l0 = l0 + 1
        o0 = o0 + 1
        end
    do while r0 < re
        m.o.o0 = m.r.r0
        r0 = r0 + 1
        o0 = o0 + 1
        end
    return
endProcedure sortWork

sortTest: procedure expose m.
    m.i.1 = eins
    m.i.2 = zwei
    m.i.3 = drei
    m.i.4 = vier
    m.i.5 = fuenf
    m.i.6 = sechs
    m.i.7 = sieben
    m.i.8 = acht
    m.i.9 = neun
    m.i.10 = zehn
    m.i.11 = elf
    m.i.12 = zwoelf
    m.i.13 = dreizehn
    m.i.14 = vierzehn
    m.i.15 = 1
    m.i.16 = 2
    m.i.17 = 3
    m.i.18 = 4
    m.i.19 = 4
    m.i.20 = 3
    m.i.21 = 2
    m.i.22 = 1
    m.i.23 = 0
    m.i.24 = 1
    yy = 27
    do while yy > 0
        do x = 0 to yy
            m.i.0 = x
            call sort i, o
            m = ''
            la = ''
            if x <> m.o.0 then
                call err 'size mismatch' x '<>' m.o.0
            do y=1 to m.o.0
                m = m m.o.y
                if ^ (la << m.o.y) then
                    call err 'sort mismatch' yy x y '^' la '<<' m.o.y
                end
            end
        say 'sort' yy m
        do x = 2 to yy
            x1 = x-1
            m.i.x1 = m.i.x
            end
        yy = yy-1
        end
endProcedure sortTest
    im = (ie + ib) % 2
    bs = 'SORT.'nx
    ms = 'SORT.' || (nx+1)
    call sort1 nx+2, bs, i, ib, im
    call sort1 nx+2, ms, i, im, ie
    bx = 1
    bz = 1 + im - ib
    mx = 1
    mz = 1 + ie - im
    ox = 0
    do while bx < bz & mx < mz
        bk = m.bs.bx
        mk = m.ms.mx
        ox = ox+1
        if m.bk <= m.mk then do
            m.o.ox = bk
            bx = bx + 1
            end
        else do
            m.o.ox = mk
            mx = mx + 1
            end
        end
    do bx=bx to bz-1
        ox = ox + 1
        m.o.ox = m.bs.bx
        end
    do mx=mx to mz-1
        ox = ox + 1
        m.o.ox = m.ms.mx
        end
    return
endProcedure sort1
/* copy sort end   ****************************************************/