-- Copyright: Mario Schweigler, Adam Sampson (C) 2005-2006
-- Institution: Computing Laboratory, University of Kent, Canterbury, UK
-- Description: Demo app for pony: background processing capability 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.

#INCLUDE "course.module"
#INCLUDE "pony.module"
#INCLUDE "trace.inc"

--{{{  preprocessor definitions
--#DEFINE USE.SEND.DELAY
--}}}

--{{{  PROC bm.sample (CHAN BOOL intr?, CHAN INT64 out!, to.succ!, from.succ?)
PROC bm.sample (CHAN BOOL intr?, CHAN INT64 out!, to.succ!, from.succ?)
  INITIAL INT64 num IS 0:
  SEQ
    SETPRI(31)
    WHILE TRUE
      PRI ALT
        BOOL any:
        intr ? any
          out ! num
        from.succ ? num
          to.succ ! num
:
--}}}

--{{{  PROC bm.succ (CHAN INT64 in?, out!)
PROC bm.succ (CHAN INT64 in?, out!)
  INITIAL INT64 num IS 0:
  SEQ
    SETPRI(31)
    WHILE TRUE
      SEQ
        out ! num
        in ? num
        num := num PLUS 1
:
--}}}

CHAN TYPE THING
  MOBILE RECORD
    CHAN MOBILE []BYTE c?:
:

--#DEFINE MEASURE.SAMPLE.ONLY

#IF DEFINED (MEASURE.SAMPLE.ONLY)
PROC bmbackground.mso (CHAN BYTE key?, CHAN BYTE err!)
  --{{{  Channels for `bm.sample' and `bm.succ'
  CHAN BOOL intr:
  CHAN INT64 from.sample, to.succ, from.succ:
  --}}}
  PAR
    bm.sample(intr?, from.sample!, to.succ!, from.succ?)
    bm.succ(to.succ?, from.succ!)
    VAL INT timeout IS 5000000:
    TIMER tim:
    INT t:
    INT64 s.start, s.end, s.norm.diff:
    SEQ
      C.trace ("Measuring normalised sample difference...")
      -- Cool down
      tim ? t
      tim ? AFTER t PLUS timeout
      -- Receive start sample
      intr ! TRUE
      from.sample ? s.start
      -- Timeout
      tim ? t
      tim ? AFTER t PLUS timeout
      -- Receive end sample
      intr ! TRUE
      from.sample ? s.end
      -- Calculate the normalised sample difference
      s.norm.diff := s.end MINUS s.start
      -- Output normalised sample difference
      C.trace.i ("    Normalised sample difference: ", INT s.norm.diff)
:
#ELSE
PROC bmbackground (CHAN BYTE key?, CHAN BYTE err!)
  MOBILE []BYTE ans.name, app.name, node.name:
  INT node.type, own.node.id, result:
  SHARED PONY.NETHANDLE! net.handle:
  PONY.ERRHANDLE! err.handle:
  INT err.point:
  SEQ
    ans.name := ""
    app.name := "bmbackground"
    node.name := ""
    --{{{  Get node-type
    node.type := -1
    CHAN GETOPT opts:
    PAR
      file.get.options ("ms", opts!)
      INITIAL BOOL running IS TRUE:
      WHILE running
        BYTE b:
        opts ? CASE
          opt ; b
            CASE b
              'm'
                SEQ
                  C.trace ("bmbackground: will be master")
                  node.type := PONYC.NODETYPE.MASTERRESET
              's'
                SEQ
                  C.trace ("bmbackground: will be slave")
                  node.type := PONYC.NODETYPE.SLAVEWAIT
          done
            running := FALSE
    IF
      node.type = (-1)
        SEQ
          C.trace ("bmbackground: you must specify either master (-m) or slave (-s) mode")
          STOP
      TRUE
        SKIP
    --}}}
    --{{{  Startup
    pony.startup.snh.ueh.iep (PONYC.NETTYPE.TCPIP, ans.name,
                              app.name, node.name, node.type,
                              own.node.id,
                              net.handle,
                              err.handle, err.point,
                              result)
    --}}}
    IF
      result = PONYC.RESULT.STARTUP.OK
        --{{{  Channels for `bm.sample' and `bm.succ'
        CHAN BOOL intr:
        CHAN INT64 from.sample, to.succ, from.succ:
        --}}}
        PAR
          --{{{  Run `bm.sample' and `bm.succ' in parallel to master
          IF
            node.type = PONYC.NODETYPE.MASTERRESET
              PAR
                bm.sample(intr?, from.sample!, to.succ!, from.succ?)
                bm.succ(to.succ?, from.succ!)
            TRUE
              SKIP
          --}}}
          SEQ
            VAL []INT SIZES IS [1, 5, 10, 50, 100, 500, 1000, 5000, 10000, 50000, 100000, 500000, 1000000]:
            VAL INT WARMUP.LOOPS IS 1000:
            #IF DEFINED (USE.SEND.DELAY)
            VAL INT MEASURE.LOOPS IS 500:
            VAL INT SEND.DELAY IS 1000000 / 100:
            #ELSE
            VAL INT MEASURE.LOOPS IS 10000:
            #ENDIF
            CASE node.type
              PONYC.NODETYPE.MASTERRESET
                THING? svr:
                SEQ
                  C.trace ("bmbackground: Master starting, alloc...")
                  CLAIM net.handle!
                    pony.alloc.us (net.handle, "thing", PONYC.SHARETYPE.UNSHARED, svr, result)
                  ASSERT (result = PONYC.RESULT.ALLOC.OK)
                  --{{{  run tests
                  VAL INT timeout IS 5000000:
                  TIMER tim:
                  INT t, t.start, t.end, time, bgpc:
                  INT64 s.start, s.end, s.diff, s.norm.diff:
                  REAL32 base.rate:
                  SEQ
                    C.trace ("Measuring base loop rate...")
                    -- Cool down
                    tim ? t
                    tim ? AFTER t PLUS timeout
                    -- Receive start sample
                    intr ! TRUE
                    from.sample ? s.start
                    -- Timeout
                    tim ? t
                    tim ? AFTER t PLUS timeout
                    -- Receive end sample
                    intr ! TRUE
                    from.sample ? s.end
                    -- Calculate the normalised sample difference and base rate
                    s.norm.diff := s.end MINUS s.start
                    base.rate := (REAL32 ROUND s.norm.diff) / ((REAL32 ROUND timeout) / 1000000.0)
                    -- Output normalised sample difference
                    C.trace.i ("    Base loop rate (cycles/second): ", INT ROUND base.rate)
                    SEQ j = 0 FOR SIZE SIZES
                      VAL INT size IS SIZES[j]:
                      MOBILE []BYTE data:
                      REAL32 rate:
                      SEQ
                        C.trace.i ("Measuring with packet size: ", size)
                        -- Warm up
                        SEQ i = 0 FOR WARMUP.LOOPS
                          svr[c] ? data
                        -- Receive start sample
                        intr ! TRUE
                        from.sample ? s.start
                        -- Measure start time
                        tim ? t.start
                        -- Receive test packets
                        SEQ i = 0 FOR MEASURE.LOOPS
                          svr[c] ? data
                        -- Measure end time
                        tim ? t.end
                        -- Receive end sample
                        intr ! TRUE
                        from.sample ? s.end
                        -- Calculate the time
                        time := t.end MINUS t.start
                        -- Calculate the sample difference and rate
                        s.diff := s.end MINUS s.start
                        rate := (REAL32 ROUND s.diff) / ((REAL32 ROUND time) / 1000000.0)
                        -- Output sample difference
                        C.trace.i ("    Loop rate (cycles/second): ", INT ROUND rate)
                        -- Calculate the background processing capability
                        bgpc := INT ROUND ((100.0 * rate) / base.rate)
                        -- Output the results
                        C.trace.i ("    Background processing capability (%): ", bgpc)
                  --}}}
                  C.trace ("bmbackground: Master done")
              PONYC.NODETYPE.SLAVEWAIT
                THING! cli:
                SEQ
                  C.trace ("bmbackground: Slave starting")
                  CLAIM net.handle!
                    pony.alloc.uc (net.handle, "thing", PONYC.SHARETYPE.UNSHARED, cli, result)
                  ASSERT (result = PONYC.RESULT.ALLOC.OK)
                  --{{{  run tests
                  SEQ j = 0 FOR SIZE SIZES
                    VAL INT size IS SIZES[j]:
                    MOBILE []BYTE data:
                    TIMER tim:
                    INT t:
                    SEQ
                      C.trace.i ("Sending with packet size: ", size)
                      tim ? t
                      SEQ i = 0 FOR WARMUP.LOOPS + MEASURE.LOOPS
                        SEQ
                          data := MOBILE [size]BYTE
                          cli[c] ! data
                          #IF DEFINED (USE.SEND.DELAY)
                          t := t PLUS SEND.DELAY
                          tim ? AFTER t
                          #ENDIF
                  --}}}
                  C.trace ("bmbackground: Slave done")
              ELSE
                STOP
            CHAN BOOL sync:
            PAR
              --{{{  Shutdown
              SEQ
                CLAIM net.handle
                  pony.shutdown (net.handle)
                sync ! TRUE
              --}}}
              --{{{  Errors and shutdown of error-handler
              TIMER tim:
              INT t, result:
              MOBILE []PONY.ERROR err.array:
              SEQ
                tim ? t
                PRI ALT
                  BOOL any:
                  sync ? any
                    out.string ("Shutdown sync.*n", 0, err!)
                  tim ? AFTER t PLUS 10000000
                    out.string ("Shutdown timeout.*n", 0, err!)
                out.string ("Getting errors after initial error-point.*n", 0, err!)
                INITIAL MOBILE []INT null.int.array IS MOBILE [0]INT:
                pony.err.get.errs.after (err.handle, err.point,
                                         TRUE, TRUE, TRUE, null.int.array,
                                         err.array, result)
                SEQ
                  out.string ("Number of errors: ", 0, err!)
                  out.int ((SIZE err.array), 0, err!)
                  out.string ("*n", 0, err!)
                  SEQ i = 0 FOR (SIZE err.array)
                    SEQ
                      out.string ("error: ans.concerned:         ", 0, err!)
                      out.bool (err.array[i][ans.concerned], 0, err!)
                      out.string ("*n       master.concerned:      ", 0, err!)
                      out.bool (err.array[i][master.concerned], 0, err!)
                      out.string ("*n       remote.node.concerned: ", 0, err!)
                      out.bool (err.array[i][remote.node.concerned], 0, err!)
                      out.string ("*n       remote.node.id:        ", 0, err!)
                      out.int (err.array[i][remote.node.id], 0, err!)
                      out.string ("*n       err.code:              ", 0, err!)
                      out.int (err.array[i][err.code], 0, err!)
                      out.string ("*n", 0, err!)
                  out.string ("Shutting down error-handler.*n", 0, err!)
                pony.err.shutdown (err.handle)
                out.string ("Error-handler shutdown finished.*n", 0, err!)
              --}}}
      TRUE
        SKIP
    --{{{  Exit message
    out.string ("Finished! :)*n", 0, err!)
    --}}}
:
#ENDIF

