--
--	MPI-style group operations
--	Copyright (C) 2008 John Markus Bjørndalen
--	Copyright (C) 2008 Adam Sampson <ats@offog.org>
--
--	This program is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation, either
--	version 2 of the License, or (at your option) any later version.
--
--	This program is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this program.  If not, see
--	<http://www.gnu.org/licenses/>.

-- Each rank corresponds to a Trap node number.
-- Each node registers a port for each other rank.

#INCLUDE "useful.module"
#INCLUDE "trap.module"

--{{{  binomial tree
--{{{  FUNCTION cube.dim
INT FUNCTION cube.dim (VAL INT val)
  INT dim, size:
  VALOF
    SEQ
      dim := 0
      size := 1
      WHILE size < val
        dim, size := dim + 1, size << 1
    RESULT dim
:
--}}}
--{{{  FUNCTION hibit.of
INT FUNCTION hibit.of (VAL INT value, start.v)
  INT start, mask:
  VALOF
    SEQ
      start := start.v - 1
      mask := 1 << start
      WHILE (start >= 0) AND ((value /\ mask) = 0)
        start, mask := start - 1, mask >> 1
    RESULT start
:
--}}}
--{{{  FUNCTION binom.get.parent
INT FUNCTION binom.get.parent (VAL INT rank, gsize)
  VAL INT dim IS cube.dim (gsize):
  VAL INT hibit IS hibit.of (rank, dim):
  VALOF
    SKIP
    RESULT (rank /\ (~(1 << hibit))) \ gsize
:
--}}}
--{{{  PROC binom.get.children
PROC binom.get.children (VAL INT rank, gsize, RESULT MOBILE []INT children)
  VAL INT dim IS cube.dim (gsize):
  VAL INT hibit IS hibit.of (rank, dim):

  INITIAL MOBILE []INT peers IS MOBILE [gsize]INT:
  INITIAL INT num.peers IS 0:

  INITIAL INT i IS hibit + 1:
  INITIAL INT mask IS 1 << i:

  SEQ
    WHILE i < dim
      INITIAL INT peer IS rank \/ mask:
      SEQ
        IF
          peer < gsize
            SEQ
              peers[num.peers] := peer
              num.peers := num.peers + 1
          TRUE
            SKIP
        i := i + 1
        mask := mask << 1

    children := MOBILE [num.peers]INT
    [children FROM 0] := [peers FOR num.peers]
:
--}}}
--{{{  PROC test.binom
PROC test.binom ()
  SEQ
    SEQ gsize = 2 FOR 31
      INITIAL INT total IS 0:
      SEQ
        --{{{  check we can compute parents
        SEQ rank = 1 FOR (gsize - 1)
          VAL INT parent IS binom.get.parent (rank, gsize):
          ASSERT (parent < rank)
        --}}}
        --{{{  check children and parents are consistent
        SEQ rank = 0 FOR gsize
          MOBILE []INT children:
          SEQ
            binom.get.children (rank, gsize, children)
            SEQ i = 0 FOR SIZE children
              VAL INT child IS children[i]:
              ASSERT (binom.get.parent (child, gsize) = rank)
            total := total + (SIZE children)
        --}}}
        --{{{  check we've seen everybody
        ASSERT (total = (gsize - 1))
        --}}}
:
--}}}
--}}}

--{{{  comms helpers
--{{{  PROC receive.from.multiple
--* Receive from multiple senders in parallel.
PROC receive.from.multiple (MOBILE []TRAP.CHANNEL.CT? chans, VAL INT rank,
                            VAL []INT senders,
                            RESULT MOBILE []MOBILE []BYTE results)
  SEQ
    results := MOBILE [SIZE senders]MOBILE []BYTE
    PAR i = 0 FOR SIZE senders
      VAL INT sender IS senders[i]:
      MOBILE []BYTE d:
      SEQ
        #IF TRUE
        chans[sender][msg] ? d
        results[i] := d
        #ELSE
        -- FIXME: occ21 bug: this clobbers senders.
        chans[sender][msg] ? results[i]
        #ENDIF
:
--}}}
--{{{  PROC pass.on.multiple
--* Transmit to multiple receivers in parallel.
PROC pass.on.multiple (SHARED TRAP.CT! trap, VAL INT rank,
                       VAL []INT targets, MOBILE []BYTE data)
  SEQ
    IF
      (SIZE targets) > 0
        -- No point in parallelising this here; trap.send forks internally
        -- anyway.
        SEQ
          SEQ i = 1 FOR (SIZE targets) - 1
            trap.send (trap, targets[i], rank, CLONE data)
          trap.send (trap, targets[0], rank, data)
      TRUE
        SKIP
:
--}}}
--}}}

--{{{  PROC groupops.start
--* Allocate all the initial channels for group operations.
PROC groupops.start (SHARED TRAP.CT! trap, VAL INT groupsize,
                     RESULT MOBILE []TRAP.CHANNEL.CT? chans)
  SEQ
    chans := MOBILE [groupsize]TRAP.CHANNEL.CT?
    SEQ i = 0 FOR groupsize
      trap.open (trap, i, chans[i])
:
--}}}
--{{{  PROC groupops.barrier
--* Do a barrier synchronisation among a group.
PROC groupops.barrier (SHARED TRAP.CT! trap, MOBILE []TRAP.CHANNEL.CT? chans,
                       VAL INT rank, groupsize)
  MOBILE []INT children:
  [100]INT cs:
  MOBILE []MOBILE []BYTE results:
  INITIAL MOBILE []BYTE msg IS MOBILE [0]BYTE:
  SEQ
    binom.get.children (rank, groupsize, children)
    receive.from.multiple (chans, rank, children, results)
    [cs FOR SIZE children] := children
    IF
      rank <> 0
        VAL INT parent IS binom.get.parent (rank, groupsize):
        SEQ
          trap.send (trap, parent, rank, msg)
          chans[parent][msg] ? msg
      TRUE
        SKIP
    pass.on.multiple (trap, rank, [cs FOR SIZE children], msg)
:
--}}}
--{{{  PROC test.barrier
PROC test.barrier ()
  VAL INT groupsize IS 8:
  PAR rank = 0 FOR groupsize
    SHARED TRAP.CT! trap:
    MOBILE []TRAP.CHANNEL.CT? chans:
    SEQ
      trap.start (rank, trap)
      groupops.start (trap, groupsize, chans)
      WHILE TRUE
        SEQ
          trace.isn (rank, ": Heave!")
          groupops.barrier (trap, chans, rank, groupsize)
          trace.isn (rank, ": Ho!")
          groupops.barrier (trap, chans, rank, groupsize)
:
--}}}

--{{{  PROC test
PROC test ()
  SEQ
    test.binom ()
    test.barrier ()
:
--}}}
