-- Copyright: Adam Sampson, Mario Schweigler (C) 2006
-- Institution: Computing Laboratory, University of Kent, Canterbury, UK
-- Description: Demo app for pony: throughput benchmark

-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU 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 General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
-- MA 02110-1301, USA.

--** bmthroughput: throughput benchmark for pony.
-- In this distributed application, an interactive master controls a group of
-- slaves which attempt to send data to it as fast as possible down networked
-- channels. The number of slaves, number of channels per slave, and
-- distribution of packet sizes are all configurable at runtime. The master
-- measures the data rate over a period of time.
--
-- The intention is to measure the maximum throughput available through pony,
-- and in particular to identify factors that limit network performance.
--
-- To use this system, start [@text bmthroughput -m] on one node -- which will
-- present an interactive user interface -- and as many copies of [@text
-- bmthroughput] as you like on other nodes.

--{{{  USE/INCLUDE declarations
#INCLUDE "course.module"
#INCLUDE "pony.module"
#INCLUDE "convert.module"
#INCLUDE "useful.module"
--}}}
--{{{  type definitions
--* Data sent from slaves to master.
-- This is a mobile array rather than a counted one, in order to make the
-- communication one pony NLC; we do have to pay the cost of memory allocation
-- at both ends this way, but that shouldn't be significant.
PROTOCOL CHUNK IS MOBILE []BYTE:

--* Wrapper channel type for slave-to-master data
CHAN TYPE DATA.CT
  MOBILE RECORD
    --* Data chunks
    CHAN CHUNK data?:
    --* Signal to indicate the slave is finished
    CHAN BOOL done?:
:

--* Control protocol for slaves
PROTOCOL SLAVE.CTRL
  CASE
    --* Start sources sending data.
    -- This message must be followed by [@code number] [@code client] messages
    -- giving the client ends to use.
    -- @item number How many sources to start
    -- @item min.size Minimum data packet size
    -- @item max.size Maximum data packet size
    -- @item rate Packet send rate (packets/second). Use [@code 0] to send as
    --   fast as possible.
    start; INT; INT; INT; INT
    --* Client end for source to use
    -- @item client Channel type end
    client; DATA.CT!
    --* Stop sources sending data
    stop
    --* Shut down and exit
    quit
:

--* Wrapper channel type for master-to-slave communications
CHAN TYPE SLAVE.CT
  MOBILE RECORD
    --* Commands from master to this slave
    CHAN SLAVE.CTRL in?:
:

--* Channel type used by slaves to register with the master
CHAN TYPE REGISTER.CT
  MOBILE RECORD
    --* Slave channel type to register with master
    CHAN SLAVE.CT! register?:
:
--}}}
--{{{  general utilities
--{{{  PROC start.pony (VAL []BYTE name, VAL INT node.type, RESULT SHARED PONY.NETHANDLE! net.handle)
--* Start up pony.
-- This will [@code STOP] if pony can't be started.
-- @param name Node name
-- @param node.type pony node type
-- @param net.handle Returned pony handle
PROC start.pony (VAL []BYTE name, VAL INT node.type, RESULT SHARED PONY.NETHANDLE! net.handle)
  MOBILE []BYTE ans.name, app.name, node.name:
  INT node.id, result:
  SEQ
    ans.name := ""
    app.name := "bmthroughput"
    node.name := name
    pony.startup.snh (PONYC.NETTYPE.TCPIP, ans.name, app.name, node.name, node.type, node.id, net.handle, result)
    ASSERT (result = PONYC.RESULT.STARTUP.OK)
:
--}}}
--}}}
--{{{  master
--{{{  PROC spinner (CHAN BOOL enable?, CHAN INT speed!)
--* Background spinner process.
-- @param control Control signal.
--   Send [@code TRUE] to start timing, and [@code FALSE] to stop.
-- @param speed Speed measured in cycles per second
PROC spinner (CHAN BOOL control?, CHAN INT speed!)
  --{{{  PROC id (CHAN INT in?, out!)
  PROC id (CHAN INT in?, out!)
    INITIAL INT start IS 0:
    INITIAL BOOL running IS TRUE:
    WHILE running
      INT n:
      PRI ALT
        BOOL b:
        control ? b
          TIMER tim:
          IF
            b
              SEQ
                in ? n
                tim ? start
                out ! 0
            TRUE
              INT end:
              SEQ
                in ? n
                tim ? end
                speed ! (n / ((end MINUS start) / 1000000))
                running := FALSE
                out ! (-1)
        in ? n
          out ! n
  :
  --}}}
  --{{{  PROC succ (CHAN INT in?, out!)
  PROC succ (CHAN INT in?, out!)
    INITIAL INT n IS 0:
    WHILE n <> (-1)
      SEQ
        out ! n + 1
        in ? n
  :
  --}}}
  SEQ
    SETPRI (31)
    CHAN INT a, b:
    PAR
      id (a?, b!)
      succ (b?, a!)
:
--}}}
--{{{  PROC master (VAL []BYTE name, CHAN BYTE in?, CHAN BYTE out!)
--* Main process for master mode.
-- @param name pony node name
-- @param in Standard input
-- @param out Standard output
PROC master (VAL []BYTE name, CHAN BYTE in?, CHAN BYTE out!)
  SHARED PONY.NETHANDLE! net.handle:
  REGISTER.CT? register:
  INT result:
  SEQ
    --{{{  start up pony
    start.pony (name, PONYC.NODETYPE.MASTERRESET, net.handle)
    CLAIM net.handle
      SEQ
        pony.alloc.us (net.handle, "register", PONYC.SHARETYPE.SHARED, register, result)
        ASSERT (result = PONYC.RESULT.ALLOC.OK)
    --}}}
    CHAN INT num.slaves.rep:
    --* Test parameters
    -- @item slaves Number of slaves
    -- @item channels Number of channels per slave
    -- @item use.spinner Whether to run a spinner
    -- @item min.size Minimum data packet size
    -- @item max.size Maximum data packet size
    -- @item rate Packet send rate (packets/second)
    -- @item duration Duration in seconds
    PROTOCOL TEST.PARAMS IS INT; INT; INT; INT; INT; INT; INT:
    --* Test result
    -- @item throughput Throughput (bytes/second)
    -- @item spin.rate Spinner rate (cycles/second, or -1)
    PROTOCOL TEST.RESULT IS INT; INT:
    CHAN TEST.PARAMS test.params:
    CHAN TEST.RESULT test.result:
    CHAN BOOL quit:
    PAR
      --{{{  communicate with slaves
      VAL INT MAX.SLAVES IS 100:
      INITIAL MOBILE []SLAVE.CT! slaves IS MOBILE [MAX.SLAVES]SLAVE.CT!:
      INITIAL INT num.slaves IS 0:
      INITIAL BOOL running IS TRUE:
      WHILE running
        ALT
          register[register] ? slaves[num.slaves]
            --{{{  register new slave
            SEQ
              num.slaves := num.slaves + 1
              num.slaves.rep ! num.slaves
            --}}}
          INT n.slaves, channels, use.spinner, min.size, max.size, rate, duration:
          test.params ? n.slaves; channels; use.spinner; min.size; max.size; rate; duration
            --{{{  run test
            INITIAL INT total.channels IS n.slaves * channels:
            INITIAL MOBILE []DATA.CT! data.cli IS MOBILE [total.channels]DATA.CT!:
            INITIAL MOBILE []DATA.CT? data.svr IS MOBILE [total.channels]DATA.CT?:
            TIMER tim:
            INT t:
            SEQ
              --{{{  allocate channels
              SEQ i = 0 FOR total.channels
                data.cli[i], data.svr[i] := MOBILE DATA.CT
              --}}}
              --{{{  start slaves
              PAR i = 0 FOR n.slaves
                SEQ
                  slaves[i][in] ! start; channels; min.size; max.size; rate
                  SEQ j = 0 FOR channels
                    slaves[i][in] ! client; data.cli[(i * channels) + j]
              --}}}
              CHAN BOOL target.control, spin.control:
              CHAN INT target.result, spin.result:
              PAR
                --{{{  spinner
                IF
                  use.spinner > 0
                    spinner (spin.control?, spin.result!)
                  TRUE
                    BOOL b:
                    SEQ
                      spin.control ? b
                      spin.control ? b
                      spin.result ! (-1)
                --}}}
                --{{{  data target
                INITIAL INT byte.count IS 0:
                INITIAL INT done.count IS 0:
                INITIAL INT n IS 0:
                WHILE done.count < total.channels
                  SEQ
                    ALT
                      ALT i = 0 FOR total.channels
                        ALT
                          MOBILE []BYTE data:
                          data.svr[(i + n) \ total.channels][data] ? data
                            SEQ
                              byte.count := byte.count + (SIZE data)
                              n := (n + 1) \ total.channels
                          BOOL b:
                          data.svr[(i + n) \ total.channels][done] ? b
                            SEQ
                              done.count := done.count + 1
                              n := (n + 1) \ total.channels
                      BOOL b:
                      target.control ? b
                        SEQ
                          IF
                            b
                              byte.count := 0
                            TRUE
                              target.result ! (byte.count / duration)
                --}}}
                SEQ
                  --{{{  warm up delay
                  tim ? t
                  tim ? AFTER t PLUS 2000000
                  --}}}
                  --{{{  run test cycle
                  spin.control ! TRUE
                  target.control ! TRUE
                  tim ? t
                  tim ? AFTER t PLUS (duration * 1000000)
                  target.control ! FALSE
                  spin.control ! FALSE
                  --}}}
                  --{{{  return result
                  INT throughput, spin.rate:
                  SEQ
                    target.result ? throughput
                    spin.result ? spin.rate
                    test.result ! throughput; spin.rate
                  --}}}
                  --{{{  stop slaves
                  PAR i = 0 FOR n.slaves
                    slaves[i][in] ! stop
                  --}}}
            --}}}
          BOOL b:
          quit ? b
            --{{{  quit
            SEQ
              PAR i = 0 FOR num.slaves
                slaves[i][in] ! quit
              running := FALSE
            --}}}
      --}}}
      --{{{  interact with user
      VAL []BYTE param.keys IS ['s', 'c', 'e', 'l', 'h', 'r', 'd']:
      VAL [][]BYTE param.names IS ["Number of slaves to use     ",
                                   "Number of channels per slave",
                                   "Enable spinner (0/1)        ",
                                   "Minimum packet size (bytes) ",
                                   "Maximum packet size (bytes) ",
                                   "Send rate (packets/second)  ",
                                   "Test duration (seconds)     "]:
      INITIAL [SIZE param.keys]INT params IS [1, 1, 0, 1024, 0, 0, 10]:
      INITIAL INT num.slaves IS 0:
      INITIAL INT throughput IS -1:
      INITIAL INT spin.rate IS -1:
      INITIAL BOOL running IS TRUE:
      INITIAL INT auto.runs IS 0:
      SEQ
        --{{{  parse further command-line options
        VAL []BYTE extra IS "n:mr:":
        [(SIZE extra) + (2 * (SIZE param.keys))]BYTE optlist:
        SEQ
          SEQ i = 0 FOR SIZE param.keys
            VAL INT j IS i * 2:
            SEQ
              optlist[j] := param.keys[i] - ('a' - 'A')
              optlist[j + 1] := ':'
          -- FIXME: This is ugly; it shouldn't really invoke getopt twice.
          [optlist FROM (SIZE optlist) - (SIZE extra)] := extra
          CHAN GETOPT opts:
          PAR
            file.get.options (optlist, opts!)
            INITIAL BOOL running IS TRUE:
            WHILE running
              BYTE b:
              MOBILE []BYTE s:
              --{{{  INT FUNCTION parse.int (VAL []BYTE s)
              INT FUNCTION parse.int (VAL []BYTE s)
                INT n:
                VALOF
                  SEQ
                    n := 0
                    SEQ i = 0 FOR SIZE s
                      IF
                        (s[i] >= '0') AND (s[i] <= '9')
                          n := (n * 10) + (INT (s[i] - '0'))
                        TRUE
                          SKIP
                  RESULT n
              :
              --}}}
              opts ? CASE
                opt; b
                  SKIP
                opt.arg; b; s
                  IF
                    IF i = 0 FOR SIZE param.keys
                      b = optlist[i * 2]
                        params[i] := parse.int (s)
                    b = 'r'
                      auto.runs := parse.int (s)
                    TRUE
                      SKIP
                arg; s
                  SKIP
                bad; b
                  SKIP
                done
                  running := FALSE
        --}}}
        --{{{  PROC run.test ()
        PROC run.test ()
          SEQ
            IF
              params[0] > num.slaves
                params[0] := num.slaves
              TRUE
                SKIP
            test.params ! params[0]; params[1]; params[2]; params[3]; params[4]; params[5]; params[6]
            test.result ? throughput; spin.rate
        :
        --}}}
        IF
          auto.runs > 0
            --{{{  batch mode
            SEQ
              out.string ("pony throughput benchmark*nparameters:", 0, out!)
              SEQ i = 0 FOR SIZE params
                SEQ
                  out ! ' '
                  out ! param.keys[i]
                  out ! '='
                  out.int (params[i], 0, out!)
              out.string ("*nawaiting slaves: ", 0, out!)
              out ! FLUSH
              WHILE num.slaves < params[0]
                SEQ
                  num.slaves.rep ? num.slaves
                  out ! '.'
                  out ! FLUSH
              out ! '*n'
              SEQ i = 0 FOR auto.runs
                SEQ
                  out.string ("running... ", 0, out!)
                  out ! FLUSH
                  run.test ()
                  out.string ("done*n", 0, out!)
                  out.string ("RESULT:", 0, out!)
                  SEQ i = 0 FOR SIZE params
                    SEQ
                      out ! ' '
                      out.int (params[i], 0, out!)
                  out ! ' '
                  out.int (throughput, 0, out!)
                  out ! ' '
                  out.int (spin.rate, 0, out!)
                  out ! '*n'
                  out ! FLUSH
              quit ! TRUE
            --}}}
          TRUE
            --{{{  interactive mode
            WHILE running
              SEQ
                --{{{  update display
                erase.screen (out!)
                cursor.x.y (1, 1, out!)
                out.string ("pony throughput benchmark", 0, out!)
                cursor.x.y (1, 3, out!)
                out.string ("Number of connected slaves: ", 0, out!)
                out.int (num.slaves, 0, out!)
                SEQ i = 0 FOR SIZE params
                  SEQ
                    cursor.x.y (1, (BYTE i) + 5, out!)
                    out ! '['
                    out ! param.keys[i]
                    out.string ("] ", 0, out!)
                    out.string (param.names[i], 0, out!)
                    cursor.x.y (35, (BYTE i) + 5, out!)
                    out.int (params[i], 0, out!)
                out.string ("*n*n", 0, out!)
                out.string ("[t] Start test*n[q] Quit*n*n", 0, out!)
                IF
                  throughput <> (-1)
                    SEQ
                      out.string ("Measured throughput (bytes/second): ", 0, out!)
                      out.int (throughput, 0, out!)
                      out ! '*n'
                  TRUE
                    SKIP
                IF
                  spin.rate <> (-1)
                    SEQ
                      out.string ("Spinner rate (cycles/second): ", 0, out!)
                      out.int (spin.rate, 0, out!)
                      out ! '*n'
                  TRUE
                    SKIP
                out ! '*n'
                out ! FLUSH
                --}}}
                ALT
                  num.slaves.rep ? num.slaves
                    SKIP
                  BYTE ch:
                  in ? ch
                    IF
                      IF i = 0 FOR SIZE params
                        ch = param.keys[i]
                          --{{{  change parameter
                          SEQ
                            cursor.x.y (35, (BYTE i) + 5, out!)
                            erase.eol (out!)
                            out ! FLUSH
                            in.int (params[i], 20, in?, out!)
                            throughput := -1
                            spin.rate := -1
                          --}}}
                      ch = 't'
                        --{{{  run test
                        run.test ()
                        --}}}
                      ch = 'q'
                        --{{{  quit
                        SEQ
                          quit ! TRUE
                          running := FALSE
                        --}}}
                      TRUE
                        out ! BELL
            --}}}
      --}}}
    --{{{  shut down
    CLAIM net.handle
      pony.shutdown (net.handle)
    --}}}
:
--}}}
--}}}
--{{{  slave
--{{{  PROC slave (VAL []BYTE name, CHAN BYTE in?, CHAN BYTE out!)
--* Main process for slave mode.
-- @param name pony node name
-- @param in Standard input
-- @param out Standard output
PROC slave (VAL []BYTE name, CHAN BYTE in?, CHAN BYTE out!)
  SHARED PONY.NETHANDLE! net.handle:
  SHARED REGISTER.CT! register:
  SLAVE.CT? slave.s:
  INT result:
  INT init.seed:
  SEQ
    --{{{  start up pony
    start.pony (name, PONYC.NODETYPE.SLAVEWAIT, net.handle)
    CLAIM net.handle
      SEQ
        pony.alloc.sc (net.handle, "register", PONYC.SHARETYPE.UNSHARED, register, result)
        ASSERT (result = PONYC.RESULT.ALLOC.OK)
    --}}}
    --{{{  initialise RNG
    TIMER tim:
    tim ? init.seed
    init.seed := (init.seed >> 2) + 1
    --}}}
    --{{{  register with master
    SLAVE.CT! slave.c:
    SEQ
      slave.s, slave.c := MOBILE SLAVE.CT
      CLAIM register
        register[register] ! slave.c
    --}}}
    --{{{  handle requests
    INITIAL BOOL running IS TRUE:
    WHILE running
      slave.s[in] ? CASE
        INT number, min.size, max.size, rate:
        start; number; min.size; max.size; rate
          --{{{  run a test
          INITIAL MOBILE []DATA.CT! clients IS MOBILE [number]DATA.CT!:
          --INITIAL MOBILE []CHAN BOOL stop IS MOBILE [number]CHAN BOOL:
          [5000]CHAN BOOL stop:
          SEQ
            SEQ i = 0 FOR number
              slave.s[in] ? CASE client; clients[i]
            PAR
              PAR i = 0 FOR number
                --{{{  data source
                TIMER tim:
                INT next:
                SEQ
                  tim ? next
                  INITIAL INT seed IS init.seed + i:
                  INITIAL BOOL running IS TRUE:
                  WHILE running
                    PRI ALT
                      BOOL b:
                      stop[i] ? b
                        SEQ
                          clients[i][done] ! TRUE
                          running := FALSE
                      TRUE & SKIP
                        --{{{  send a packet
                        INT size:
                        MOBILE []BYTE data:
                        SEQ
                          --{{{  wait for appropriate time
                          IF
                            rate = 0
                              SKIP
                            TRUE
                              SEQ
                                next := next PLUS (1000000 / rate)
                                tim ? AFTER next
                          --}}}
                          --{{{  decide size
                          IF
                            max.size <= min.size
                              size := min.size
                            TRUE
                              SEQ
                                size, seed := random (max.size - min.size, seed)
                                size := size + min.size
                          --}}}
                          data := MOBILE [size]BYTE
                          SEQ i = 0 FOR size
                            data[i] := BYTE (i \ 127)
                          clients[i][data] ! data
                        --}}}
                --}}}
              --{{{  wait for stop message
              SEQ
                slave.s[in] ? CASE stop
                PAR i = 0 FOR number
                  stop[i] ! TRUE
              --}}}
          --}}}
        quit
          running := FALSE
    --}}}
    --{{{  shut down
    CLAIM net.handle
      pony.shutdown (net.handle)
    --}}}
:
--}}}
--}}}
--{{{  PROC bmthroughput (CHAN BYTE in?, out!, err!)
--* Top-level process.
PROC bmthroughput (CHAN BYTE in?, out!, err!)
  INITIAL MOBILE []BYTE node.name IS "":
  INITIAL BYTE mode IS 's':
  SEQ
    --{{{  parse options
    CHAN GETOPT opts:
    PAR
      file.get.options ("n:m", opts!)
      INITIAL BOOL running IS TRUE:
      WHILE running
        BYTE b:
        MOBILE []BYTE s:
        opts ? CASE
          opt; b
            CASE b
              'm'
                mode := 'm'
          opt.arg; b; s
            CASE b
              'n'
                node.name := s
          arg; s
            mode := '?'
          bad; b
            --mode := '?'
            SKIP
          done
            running := FALSE
    --}}}
    CASE mode
      '?'
        out.string ("Usage: bmthroughput [-m] [-n NODENAME]*n", 0, err!)
      'm'
        master (node.name, in?, out!)
      's'
        slave (node.name, in?, out!)
:
--}}}

