Added ability to insert pre and post statements to run before and after each test

// BlueCheck 0.12, M Naylor.

// Change log
// ==========
//
// 5  Nov 2012: Version 0.1
// 20 Nov 2014: Support for Action and ActionValue props
// 21 Nov 2014: Added iterative deepening capability

package BlueCheck;

import Randomizable  :: *;
import ModuleCollect :: *;
import StmtFSM       :: *;
import List          :: *;
import Clocks        :: *;

// BlueCheck parameters
typedef struct {
  // Display message when a chosen state does not fire
  Bool showNonFire;

  // Display message when a chosen state is a no-op
  Bool showNoOp;

  // Statements to be added before and after a test run
  Stmt preStmt;
  Stmt postStmt;

  // Generate a checker based on an iterative deepening strategy
  // (If 'Invalid', a single random state walk is performed)
  Maybe#(ID_Params) iterativeDeepening;

  // Number of testing iterations to perform. For iterative deepening,
  // this is the number of times to increase the depth before stopping
  // Otherwise, the it's the length of the random state walk
  Bit#(32) numIterations;
} BlueCheck_Params;

// Sub-parameters for iterative deepening
typedef struct {
  // Iterative deepening requires ability to reset the circuit under test
  MakeResetIfc rst;

  // The number of states to be explored in a single 'test'
  Bit#(32) initialDepth;

  // The number of tests to perform at each depth
  Bit#(32) testsPerDepth;

  // A function to increase the depth
  (function Bit#(32) f(Bit#(32) currentDepth)) incDepth;
} ID_Params;

// The maximum number of states in the equivalance checker.
// You will get a compile-time error message if this parameter
// is not big enough, but it's not likely, unless you use very
// large method frequencies.
typedef 16 LogMaxStates;
typedef UInt#(LogMaxStates) State;

// The frequency that the checker will move to particular state.
typedef Integer Frequency; // Range: 1 to 100.

// A BlueCheck module implicitly collects actions, statements,
// invariants and random generators, an allowing automatic creation of
// an equivalance checker.
typedef ModuleCollect#(Item) BlueCheck;

typedef union tagged {
  Tuple3#(Frequency, Fmt, Action) ActionItem;
  Tuple3#(Frequency, Fmt, Stmt) StmtItem;
  Tuple2#(Bool, Action) RandomGenItem;
  Tuple2#(Fmt, Bool) InvariantItem;
} Item;

// Turn an item into a singleton action if it is an ActionItem.
function List#(Tuple3#(Frequency, Fmt, Action)) getActionItem(Item item) =
  case (item) matches
    tagged ActionItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton action if it is an RandomGenItem.
function List#(Tuple2#(Bool, Action)) getRandomGenItem(Item item) =
  case (item) matches
    tagged RandomGenItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton pair if it is an InvariantItem.
function List#(Tuple2#(Fmt, Bool)) getInvariantItem(Item item) =
  case (item) matches
    tagged InvariantItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is an StmtItem.
function List#(Tuple3#(Frequency, Fmt, Stmt)) getStmtItem(Item item) =
  case (item) matches
    tagged StmtItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Display a function application, where function and
// arguments are available as Fmt items of a list.
function Fmt formatApp(List#(Fmt) app);
  if (tail(app) matches tagged Nil)
    return head(app);
  else
    return (head(app) + fshow("(") + formatArgs(tail(app)) + fshow(")"));
endfunction

function Fmt formatArgs(List#(Fmt) args);
  if (tail(args) matches tagged Nil)
    return head(args);
  else
    return (head(args) + fshow(",") + formatArgs(tail(args)));
endfunction

// The following type class allows two functions of the same type to
// be applied to random inputs.  If the return values differ, the
// behaviour is to terminate with an error message (a counter-example
// has been found).  The probability that the equivalence will be
// checked on any given step can be specified.
typeclass Equiv#(type a);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, a f, a g) ();
endtypeclass

module [BlueCheck] equiv#(String name, a f, a g) ()
    provisos(Equiv#(a));
  eq(cons(fshow(name), nil), 1, f, g);
endmodule

module [BlueCheck] equivf#(Frequency fr, String name, a f, a g) ()
    provisos(Equiv#(a));
  eq(cons(fshow(name), nil), fr, f, g);
endmodule

// Base case 1: execute two actions.
instance Equiv#(Action);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, Action a, Action b) ();
    Action executeTwo =
      action
        a; b;
      endaction;
    addToCollection(tagged ActionItem
      (tuple3(fr, formatApp(app), executeTwo)));
  endmodule
endinstance

// Base case 2: execute two action-values,
// and check equivalance of results.
instance Equiv#(ActionValue#(t))
  provisos(Eq#(t), Bits#(t, n));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                       , ActionValue#(t) a
                                       , ActionValue#(t) b) ();
    Action executeTwoAndCheck =
      action
        t aVal <- a;
        t bVal <- b;
        if (aVal != bVal)
          begin
            $display("Not equal:", aVal, " versus ", bVal);
            $finish(0);
          end
      endaction;
      addToCollection(tagged ActionItem
        (tuple3(fr, formatApp(app), executeTwoAndCheck)));
  endmodule
endinstance

// Base case 3: execute two statements.
instance Equiv#(Stmt);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, Stmt a, Stmt b) ();
    Stmt s = par a; b; endpar;
    addToCollection(tagged StmtItem (tuple3(fr, formatApp(app), s)));
  endmodule
endinstance

// Recursive case: generate a random input,
// apply it to each function, and
// recurse on the resulting applications.
instance Equiv#(function b f(a x))
  provisos(Equiv#(b), Bits#(a, n), Bounded#(a), FShow#(a));
    module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                         , function b f(a x)
                                         , function b g(a y))();
      Reg#(Bool) init <- mkReg(True);
      Reg#(a) aReg <- mkRegU;
      Randomize#(a) aRandom <- mkGenericRandomizer;

      Action genRandom =
        action
          let a <- aRandom.next;
          aReg <= a;
        endaction;

      rule initialise (init);
        aRandom.cntrl.init;
        init <= False;
      endrule

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));

      eq(append(app, cons(fshow(aReg), nil)), fr, f(aReg), g(aReg));
    endmodule
endinstance

// Base case 4 (fall through): check that two values are equal.
instance Equiv#(a) provisos(Eq#(a), FShow#(a));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, a x, a y) ();
    Fmt fmt = formatApp(app) + fshow(" failed: ")
            + fshow(x) + fshow(" v ") + fshow(y);
    addToCollection(tagged InvariantItem (tuple2(fmt, x == y)));
  endmodule
endinstance

// Like the Equiv type-class, except for a single method.
typeclass Prop#(type a);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, a f) ();
endtypeclass

// Base case 1: execute statement.
instance Prop#(Stmt);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, Stmt a) ();
    addToCollection(tagged StmtItem (tuple3(fr, formatApp(app), a)));
  endmodule
endinstance

// Base case 2: execute action.
instance Prop#(Action);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, Action a) ();
    addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), a)));
  endmodule
endinstance

// Base case 3: execute action-value
instance Prop#(ActionValue#(t))
  provisos(Eq#(t), Bits#(t, n));
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, ActionValue#(t) a) ();
    Action act =
      action
        t aVal <- a;
        $display("   (Returned ", aVal, ")");
      endaction;
      addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), act)));
  endmodule
endinstance

// Recursive case.
instance Prop#(function b f(a x))
  provisos(Prop#(b), Bits#(a, n), Bounded#(a), FShow#(a));
    module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, function b f(a x))();
      Reg#(Bool) init <- mkReg(True);
      Reg#(a) aReg <- mkRegU;
      Randomize#(a) aRandom <- mkGenericRandomizer;

      Action genRandom =
        action
          let a <- aRandom.next;
          aReg <= a;
        endaction;

      rule initialise (init);
        aRandom.cntrl.init;
        init <= False;
      endrule

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));

      pr(append(app, cons(fshow(aReg), nil)), fr, f(aReg));
    endmodule
endinstance

module [BlueCheck] prop#(String name, a f) ()
    provisos(Prop#(a));
  pr(cons(fshow(name), nil), 1, f);
endmodule

module [BlueCheck] propf#(Frequency fr, String name, a f) ()
    provisos(Prop#(a));
  pr(cons(fshow(name), nil), fr, f);
endmodule

function Action ensure(Bool b) =
    action
      if (!b)
        begin
          $display("'ensure' statement failed");
          $finish(0);
        end
    endaction;

// Compute the condition for being in each state of the equivalance
// checker. Some states are visited more frequently than others.
function List#(Bool) stateConds(Reg#(State) s, Integer start,
                                         List#(Frequency) freqs);
  if (freqs matches tagged Nil) return Nil;
  else
    begin
      Frequency f = head(freqs);
      return (cons(s >= fromInteger(start) && s < fromInteger(start+f),
        stateConds(s, start+f, tail(freqs))));
    end
endfunction

function Integer sum(List#(Integer) xs);
  if (xs matches tagged Nil) return 0;
  else return (head(xs) + sum(tail(xs)));
endfunction

// Turn the list of items gathered in a BlueCheck module into an
// actual equivalence checker.
module [Module] blueCheckCore#( BlueCheck#(Empty) bc
                              , BlueCheck_Params params ) (Stmt);
  // Extract items.
  let {_, items} <- getCollection(bc);
  let actionItems = concat(map(getActionItem, items));
  let stmtItems = concat(map(getStmtItem, items));
  let randomGens = concat(map(getRandomGenItem, items));
  let invariantBools = concat(map(getInvariantItem, items));
  let actionMsgs = map(tpl_2, actionItems);
  let stmtMsgs = map(tpl_2, stmtItems);
  let actions = map(tpl_3, actionItems);
  let stmts = map(tpl_3, stmtItems);

  // Setup state machine for equivalence checking.
  // Note state 0 is a no-op state.
  List#(Integer) freqs = append(map(tpl_1, actionItems),
                                map(tpl_1, stmtItems));
  Integer numStates = 1+sum(freqs);
  Randomize#(State) randomState <-
    mkConstrainedRandomizer(0, fromInteger(numStates-1));
  Reg#(State) state <- mkReg(0);
  Wire#(Bool) waitWire <- mkDWire(False);
  Wire#(Bool) didntFire <- mkDWire(False);
  Reg#(Bool) testDone <- mkReg(False);
  List#(Bool) inState = stateConds(state, 1, freqs);

  // When count is 0 the checker is disabled
  Reg#(Bit#(32)) count <- mkReg(0);
  Bool enabled = count != 0;

  // State for iterative-deepening
  Reg#(Bit#(32)) currentDepth <- mkReg(0);
  Reg#(Bit#(32)) testNum <- mkReg(0);
  Reg#(Bit#(32)) iterCount <- mkReg(0);

  // Generate rules to generate random data.
  for (Integer i = 0; i < length(randomGens); i=i+1)
    begin
      let go  = tpl_1(randomGens[i]);
      let gen = tpl_2(randomGens[i]);
      rule genRandomData (go && !waitWire);
        gen;
      endrule
    end

  // Generate rules to check invariant booleans.
  for (Integer i = 0; i < length(invariantBools); i=i+1)
    begin
      let msg = tpl_1(invariantBools[i]);
      let b   = tpl_2(invariantBools[i]);
      rule checkInvariantBool (enabled && !waitWire);
        if (!b)
          begin
            $display(msg);
            $finish(0);
          end
      endrule
    end

  // Generate rules to run actions, guarded by the current state.
  for (Integer i = 0; i < length(actions); i=i+1)
    begin
      (* preempts = "runAction, runActionNotPossible" *)
      rule runAction (enabled && inState[i] && !waitWire);
        $display("%0t: ", $time, actionMsgs[i]);
        actions[i];
      endrule
      rule runActionNotPossible (enabled && inState[i] && !waitWire);
        didntFire <= True;
        if (params.showNonFire)
          $display("%0t: [did not fire] ", $time, actionMsgs[i]);
      endrule
    end

  // Generate rules to run statements, guarded by the current state.
  // Statements may take many cycles, hence waitWire.
  for (Integer i = 0; i < length(stmts); i=i+1)
    begin
      Integer s = length(actions)+i;
      Reg#(Bool) fsmRunning <- mkReg(False);
      FSM fsm <- mkFSMWithPred(stmts[i], enabled && inState[s]);

      rule runStmt (enabled && inState[s] && !fsmRunning);
        $display("%0t: ", $time, stmtMsgs[i]);
        fsm.start;
        fsmRunning <= True;
        waitWire <= True;
      endrule

      rule assertWait (enabled && inState[s] && fsmRunning && !fsm.done);
        waitWire <= True;
      endrule

      rule finishStmt (enabled && inState[s] && fsmRunning && fsm.done);
        fsmRunning <= False;
      endrule
    end

  // No-op.
  rule noOp (enabled && state == 0);
    if (params.showNoOp)
      $display("%0t: No-op", $time);
  endrule

  // One long walk of the state space.
  Stmt singleWalk =
    seq
      randomState.cntrl.init;
      testDone <= False;
      params.preStmt;
      $display("=== Depth %0d, Test %0d ===", currentDepth, testNum);
      while (! testDone)
        action
          await(!waitWire);
          let nextState <- randomState.next;
          state <= nextState;
          if (state != 0 && !didntFire)
            begin
              if (count < params.numIterations)
                count <= count+1;
              else
                begin
                  count <= 0;
                  testDone <= True;
                end
              end
        endaction
      params.postStmt;
      $display("OK: passed %0d iterations", params.numIterations);
    endseq;

  // Many short walks of the state space (iterative deepening).
  Stmt iterativeDeepening =
    begin
      let idParams = fromMaybe(?, params.iterativeDeepening);

      seq
        randomState.cntrl.init;
        currentDepth <= idParams.initialDepth;
        while (iterCount < params.numIterations)
          seq
            testNum <= 0;
            while (testNum < idParams.testsPerDepth)
              seq
                testDone <= False;
                $display("=== Depth %0d, Test %0d ===", currentDepth, testNum);
                params.preStmt;
                while (! testDone)
                  action
                    await(!waitWire);
                    let nextState <- randomState.next;
                    state <= nextState;
                    if (state != 0 && !didntFire)
                      begin
                        if (count < currentDepth)
                          count <= count+1;
                        else
                          begin
                            count <= 0;
                            testDone <= True;
                          end
                      end
                  endaction
                testNum <= testNum+1;
                params.postStmt;
                idParams.rst.assertReset();
              endseq
            currentDepth <= idParams.incDepth(currentDepth);
            iterCount <= iterCount+1;
          endseq
        $display("OK: passed %0d test sequences",
                   params.numIterations*idParams.testsPerDepth);
      endseq;
    end;

  return isValid(params.iterativeDeepening) ?
           iterativeDeepening : singleWalk;
endmodule

// Default parameters for single state walk
BlueCheck_Params bcParamsSimple =
  BlueCheck_Params {
    showNonFire        : False
  , showNoOp           : False
  , preStmt            : seq delay(1); endseq
  , postStmt           : seq delay(1); endseq
  , iterativeDeepening : tagged Invalid
  , numIterations      : 1000
  };

// Default parameters for iterative deepening
function BlueCheck_Params bcParamsID(MakeResetIfc rst);
  function double(x) = x*2;

  ID_Params idParams =
    ID_Params {
      rst           : rst
    , initialDepth  : 5
    , testsPerDepth : 1000
    , incDepth      : double
    };

  BlueCheck_Params params =
    BlueCheck_Params {
      showNonFire        : False
    , showNoOp           : False
    , preStmt            : seq delay(1); endseq
    , postStmt           : seq delay(1); endseq
    , iterativeDeepening : tagged Valid idParams
    , numIterations      : 3
    };

  return params;
endfunction

// Simple version returning a statement
module [Module] blueCheckStmt#(BlueCheck#(Empty) bc)(Stmt);
  Stmt s <- blueCheckCore(bc, bcParamsSimple);
  return s;
endmodule

// Simple version that constructs a checker
module [Module] blueCheck#(BlueCheck#(Empty) bc)();
  Stmt s <- blueCheckStmt(bc);
  mkAutoFSM(s);
endmodule

// Iterative deepening version returning a statement
module [Module] blueCheckStmtID# (BlueCheck#(Empty) bc
                                , MakeResetIfc rst ) (Stmt);
  Stmt s <- blueCheckCore(bc, bcParamsID(rst));
  return s;
endmodule

// Iterative deepening version that constructs a checker
module [Module] blueCheckID#( BlueCheck#(Empty) bc
                            , MakeResetIfc rst ) ();
  Stmt s <- blueCheckStmtID(bc, rst);
  mkAutoFSM(s);
endmodule

endpackage

// BlueCheck 0.12, M Naylor.

// Change log
// ==========
//
// 5  Nov 2012: Version 0.1
// 20 Nov 2014: Support for Action and ActionValue props
// 21 Nov 2014: Added iterative deepening capability

package BlueCheck;

import Randomizable  :: *;
import ModuleCollect :: *;
import StmtFSM       :: *;
import List          :: *;
import Clocks        :: *;

// BlueCheck parameters
typedef struct {
  // Display message when a chosen state does not fire
  Bool showNonFire;

  // Display message when a chosen state is a no-op
  Bool showNoOp;

  // Generate a checker based on an iterative deepening strategy
  // (If 'Invalid', a single random state walk is performed)
  Maybe#(ID_Params) iterativeDeepening;

  // Number of testing iterations to perform. For iterative deepening,
  // this is the number of times to increase the depth before stopping
  // Otherwise, the it's the length of the random state walk
  Bit#(32) numIterations;
} BlueCheck_Params;

// Sub-parameters for iterative deepening
typedef struct {
  // Iterative deepening requires ability to reset the circuit under test
  MakeResetIfc rst;

  // The number of states to be explored in a single 'test'
  Bit#(32) initialDepth;

  // The number of tests to perform at each depth
  Bit#(32) testsPerDepth;

  // A function to increase the depth
  (function Bit#(32) f(Bit#(32) currentDepth)) incDepth;
} ID_Params;

// The maximum number of states in the equivalance checker.
// You will get a compile-time error message if this parameter
// is not big enough, but it's not likely, unless you use very
// large method frequencies.
typedef 16 LogMaxStates;
typedef UInt#(LogMaxStates) State;

// The frequency that the checker will move to particular state.
typedef Integer Frequency; // Range: 1 to 100.

// A BlueCheck module implicitly collects actions, statements,
// invariants and random generators, an allowing automatic creation of
// an equivalance checker.
typedef ModuleCollect#(Item) BlueCheck;

typedef union tagged {
  Tuple3#(Frequency, Fmt, Action) ActionItem;
  Tuple3#(Frequency, Fmt, Stmt) StmtItem;
  Tuple2#(Bool, Action) RandomGenItem;
  Tuple2#(Fmt, Bool) InvariantItem;
} Item;

// Turn an item into a singleton action if it is an ActionItem.
function List#(Tuple3#(Frequency, Fmt, Action)) getActionItem(Item item) =
  case (item) matches
    tagged ActionItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton action if it is an RandomGenItem.
function List#(Tuple2#(Bool, Action)) getRandomGenItem(Item item) =
  case (item) matches
    tagged RandomGenItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton pair if it is an InvariantItem.
function List#(Tuple2#(Fmt, Bool)) getInvariantItem(Item item) =
  case (item) matches
    tagged InvariantItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is an StmtItem.
function List#(Tuple3#(Frequency, Fmt, Stmt)) getStmtItem(Item item) =
  case (item) matches
    tagged StmtItem .a: return cons(a, Nil);
    default: return Nil;
  endcase;

// Display a function application, where function and
// arguments are available as Fmt items of a list.
function Fmt formatApp(List#(Fmt) app);
  if (tail(app) matches tagged Nil)
    return head(app);
  else
    return (head(app) + fshow("(") + formatArgs(tail(app)) + fshow(")"));
endfunction

function Fmt formatArgs(List#(Fmt) args);
  if (tail(args) matches tagged Nil)
    return head(args);
  else
    return (head(args) + fshow(",") + formatArgs(tail(args)));
endfunction

// The following type class allows two functions of the same type to
// be applied to random inputs.  If the return values differ, the
// behaviour is to terminate with an error message (a counter-example
// has been found).  The probability that the equivalence will be
// checked on any given step can be specified.
typeclass Equiv#(type a);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, a f, a g) ();
endtypeclass

module [BlueCheck] equiv#(String name, a f, a g) ()
    provisos(Equiv#(a));
  eq(cons(fshow(name), nil), 1, f, g);
endmodule

module [BlueCheck] equivf#(Frequency fr, String name, a f, a g) ()
    provisos(Equiv#(a));
  eq(cons(fshow(name), nil), fr, f, g);
endmodule

// Base case 1: execute two actions.
instance Equiv#(Action);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, Action a, Action b) ();
    Action executeTwo =
      action
        a; b;
      endaction;
    addToCollection(tagged ActionItem
      (tuple3(fr, formatApp(app), executeTwo)));
  endmodule
endinstance

// Base case 2: execute two action-values,
// and check equivalance of results.
instance Equiv#(ActionValue#(t))
  provisos(Eq#(t), Bits#(t, n));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                       , ActionValue#(t) a
                                       , ActionValue#(t) b) ();
    Action executeTwoAndCheck =
      action
        t aVal <- a;
        t bVal <- b;
        if (aVal != bVal)
          begin
            $display("Not equal:", aVal, " versus ", bVal);
            $finish(0);
          end
      endaction;
      addToCollection(tagged ActionItem
        (tuple3(fr, formatApp(app), executeTwoAndCheck)));
  endmodule
endinstance

// Base case 3: execute two statements.
instance Equiv#(Stmt);
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, Stmt a, Stmt b) ();
    Stmt s = par a; b; endpar;
    addToCollection(tagged StmtItem (tuple3(fr, formatApp(app), s)));
  endmodule
endinstance

// Recursive case: generate a random input,
// apply it to each function, and
// recurse on the resulting applications.
instance Equiv#(function b f(a x))
  provisos(Equiv#(b), Bits#(a, n), Bounded#(a), FShow#(a));
    module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                         , function b f(a x)
                                         , function b g(a y))();
      Reg#(Bool) init <- mkReg(True);
      Reg#(a) aReg <- mkRegU;
      Randomize#(a) aRandom <- mkGenericRandomizer;

      Action genRandom =
        action
          let a <- aRandom.next;
          aReg <= a;
        endaction;

      rule initialise (init);
        aRandom.cntrl.init;
        init <= False;
      endrule

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));

      eq(append(app, cons(fshow(aReg), nil)), fr, f(aReg), g(aReg));
    endmodule
endinstance

// Base case 4 (fall through): check that two values are equal.
instance Equiv#(a) provisos(Eq#(a), FShow#(a));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr, a x, a y) ();
    Fmt fmt = formatApp(app) + fshow(" failed: ")
            + fshow(x) + fshow(" v ") + fshow(y);
    addToCollection(tagged InvariantItem (tuple2(fmt, x == y)));
  endmodule
endinstance

// Like the Equiv type-class, except for a single method.
typeclass Prop#(type a);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, a f) ();
endtypeclass

// Base case 1: execute statement.
instance Prop#(Stmt);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, Stmt a) ();
    addToCollection(tagged StmtItem (tuple3(fr, formatApp(app), a)));
  endmodule
endinstance

// Base case 2: execute action.
instance Prop#(Action);
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, Action a) ();
    addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), a)));
  endmodule
endinstance

// Base case 3: execute action-value
instance Prop#(ActionValue#(t))
  provisos(Eq#(t), Bits#(t, n));
  module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, ActionValue#(t) a) ();
    Action act =
      action
        t aVal <- a;
        $display("   (Returned ", aVal, ")");
      endaction;
      addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), act)));
  endmodule
endinstance

// Recursive case.
instance Prop#(function b f(a x))
  provisos(Prop#(b), Bits#(a, n), Bounded#(a), FShow#(a));
    module [BlueCheck] pr#(List#(Fmt) app, Frequency fr, function b f(a x))();
      Reg#(Bool) init <- mkReg(True);
      Reg#(a) aReg <- mkRegU;
      Randomize#(a) aRandom <- mkGenericRandomizer;

      Action genRandom =
        action
          let a <- aRandom.next;
          aReg <= a;
        endaction;

      rule initialise (init);
        aRandom.cntrl.init;
        init <= False;
      endrule

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));

      pr(append(app, cons(fshow(aReg), nil)), fr, f(aReg));
    endmodule
endinstance

module [BlueCheck] prop#(String name, a f) ()
    provisos(Prop#(a));
  pr(cons(fshow(name), nil), 1, f);
endmodule

module [BlueCheck] propf#(Frequency fr, String name, a f) ()
    provisos(Prop#(a));
  pr(cons(fshow(name), nil), fr, f);
endmodule

function Action ensure(Bool b) =
    action
      if (!b)
        begin
          $display("'ensure' statement failed");
          $finish(0);
        end
    endaction;

// Compute the condition for being in each state of the equivalance
// checker. Some states are visited more frequently than others.
function List#(Bool) stateConds(Reg#(State) s, Integer start,
                                         List#(Frequency) freqs);
  if (freqs matches tagged Nil) return Nil;
  else
    begin
      Frequency f = head(freqs);
      return (cons(s >= fromInteger(start) && s < fromInteger(start+f),
        stateConds(s, start+f, tail(freqs))));
    end
endfunction

function Integer sum(List#(Integer) xs);
  if (xs matches tagged Nil) return 0;
  else return (head(xs) + sum(tail(xs)));
endfunction

// Turn the list of items gathered in a BlueCheck module into an
// actual equivalence checker.
module [Module] blueCheckCore#( BlueCheck#(Empty) bc
                              , BlueCheck_Params params ) (Stmt);
  // Extract items.
  let {_, items} <- getCollection(bc);
  let actionItems = concat(map(getActionItem, items));
  let stmtItems = concat(map(getStmtItem, items));
  let randomGens = concat(map(getRandomGenItem, items));
  let invariantBools = concat(map(getInvariantItem, items));
  let actionMsgs = map(tpl_2, actionItems);
  let stmtMsgs = map(tpl_2, stmtItems);
  let actions = map(tpl_3, actionItems);
  let stmts = map(tpl_3, stmtItems);

  // Setup state machine for equivalence checking.
  // Note state 0 is a no-op state.
  List#(Integer) freqs = append(map(tpl_1, actionItems),
                                map(tpl_1, stmtItems));
  Integer numStates = 1+sum(freqs);
  Randomize#(State) randomState <-
    mkConstrainedRandomizer(0, fromInteger(numStates-1));
  Reg#(State) state <- mkReg(0);
  Wire#(Bool) waitWire <- mkDWire(False);
  Wire#(Bool) didntFire <- mkDWire(False);
  Reg#(Bool) testDone <- mkReg(False);
  List#(Bool) inState = stateConds(state, 1, freqs);

  // When count is 0 the checker is disabled
  Reg#(Bit#(32)) count <- mkReg(0);
  Bool enabled = count != 0;

  // State for iterative-deepening
  Reg#(Bit#(32)) currentDepth <- mkReg(0);
  Reg#(Bit#(32)) testNum <- mkReg(0);
  Reg#(Bit#(32)) iterCount <- mkReg(0);

  // Generate rules to generate random data.
  for (Integer i = 0; i < length(randomGens); i=i+1)
    begin
      let go  = tpl_1(randomGens[i]);
      let gen = tpl_2(randomGens[i]);
      rule genRandomData (go && !waitWire);
        gen;
      endrule
    end

  // Generate rules to check invariant booleans.
  for (Integer i = 0; i < length(invariantBools); i=i+1)
    begin
      let msg = tpl_1(invariantBools[i]);
      let b   = tpl_2(invariantBools[i]);
      rule checkInvariantBool (enabled && !waitWire);
        if (!b)
          begin
            $display(msg);
            $finish(0);
          end
      endrule
    end

  // Generate rules to run actions, guarded by the current state.
  for (Integer i = 0; i < length(actions); i=i+1)
    begin
      (* preempts = "runAction, runActionNotPossible" *)
      rule runAction (enabled && inState[i] && !waitWire);
        $display("%0t: ", $time, actionMsgs[i]);
        actions[i];
      endrule
      rule runActionNotPossible (enabled && inState[i] && !waitWire);
        didntFire <= True;
        if (params.showNonFire)
          $display("%0t: [did not fire] ", $time, actionMsgs[i]);
      endrule
    end

  // Generate rules to run statements, guarded by the current state.
  // Statements may take many cycles, hence waitWire.
  for (Integer i = 0; i < length(stmts); i=i+1)
    begin
      Integer s = length(actions)+i;
      Reg#(Bool) fsmRunning <- mkReg(False);
      FSM fsm <- mkFSMWithPred(stmts[i], enabled && inState[s]);

      rule runStmt (enabled && inState[s] && !fsmRunning);
        $display("%0t: ", $time, stmtMsgs[i]);
        fsm.start;
        fsmRunning <= True;
        waitWire <= True;
      endrule

      rule assertWait (enabled && inState[s] && fsmRunning && !fsm.done);
        waitWire <= True;
      endrule

      rule finishStmt (enabled && inState[s] && fsmRunning && fsm.done);
        fsmRunning <= False;
      endrule
    end

  // No-op.
  rule noOp (enabled && state == 0);
    if (params.showNoOp)
      $display("%0t: No-op", $time);
  endrule

  // One long walk of the state space.
  Stmt singleWalk =
    seq
      randomState.cntrl.init;
      testDone <= False;
      $display("=== Depth %0d, Test %0d ===", currentDepth, testNum);
      while (! testDone)
        action
          await(!waitWire);
          let nextState <- randomState.next;
          state <= nextState;
          if (state != 0 && !didntFire)
            begin
              if (count < params.numIterations)
                count <= count+1;
              else
                begin
                  count <= 0;
                  testDone <= True;
                end
              end
        endaction
      $display("OK: passed %0d iterations", params.numIterations);
    endseq;

  // Many short walks of the state space (iterative deepening).
  Stmt iterativeDeepening =
    begin
      let idParams = fromMaybe(?, params.iterativeDeepening);

      seq
        randomState.cntrl.init;
        currentDepth <= idParams.initialDepth;
        while (iterCount < params.numIterations)
          seq
            testNum <= 0;
            while (testNum < idParams.testsPerDepth)
              seq
                testDone <= False;
                $display("=== Depth %0d, Test %0d ===", currentDepth, testNum);
                while (! testDone)
                  action
                    await(!waitWire);
                    let nextState <- randomState.next;
                    state <= nextState;
                    if (state != 0 && !didntFire)
                      begin
                        if (count < currentDepth)
                          count <= count+1;
                        else
                          begin
                            count <= 0;
                            testDone <= True;
                          end
                      end
                  endaction
                testNum <= testNum+1;
                idParams.rst.assertReset();
              endseq
            currentDepth <= idParams.incDepth(currentDepth);
            iterCount <= iterCount+1;
          endseq
        $display("OK: passed %0d test sequences",
                   params.numIterations*idParams.testsPerDepth);
      endseq;
    end;

  return isValid(params.iterativeDeepening) ?
           iterativeDeepening : singleWalk;
endmodule

// Default parameters for single state walk
BlueCheck_Params bcParamsSimple =
  BlueCheck_Params {
    showNonFire        : False
  , showNoOp           : False
  , iterativeDeepening : tagged Invalid
  , numIterations      : 1000
  };

// Default parameters for iterative deepening
function BlueCheck_Params bcParamsID(MakeResetIfc rst);
  function double(x) = x*2;

  ID_Params idParams =
    ID_Params {
      rst           : rst
    , initialDepth  : 5
    , testsPerDepth : 1000
    , incDepth      : double
    };

  BlueCheck_Params params =
    BlueCheck_Params {
      showNonFire        : False
    , showNoOp           : False
    , iterativeDeepening : tagged Valid idParams
    , numIterations      : 3
    };

  return params;
endfunction

// Simple version returning a statement
module [Module] blueCheckStmt#(BlueCheck#(Empty) bc)(Stmt);
  Stmt s <- blueCheckCore(bc, bcParamsSimple);
  return s;
endmodule

// Simple version that constructs a checker
module [Module] blueCheck#(BlueCheck#(Empty) bc)();
  Stmt s <- blueCheckStmt(bc);
  mkAutoFSM(s);
endmodule

// Iterative deepening version returning a statement
module [Module] blueCheckStmtID# (BlueCheck#(Empty) bc
                                , MakeResetIfc rst ) (Stmt);
  Stmt s <- blueCheckCore(bc, bcParamsID(rst));
  return s;
endmodule

// Iterative deepening version that constructs a checker
module [Module] blueCheckID#( BlueCheck#(Empty) bc
                            , MakeResetIfc rst ) ();
  Stmt s <- blueCheckStmtID(bc, rst);
  mkAutoFSM(s);
endmodule

endpackage


Removed a temporary workaround in Near_Mem_IO_AXI4 re. MTIMECMPH writes

// Copyright (c) 2016-2022 Bluespec, Inc. All Rights Reserved

package Near_Mem_IO_AXI4;

// ================================================================
// This package implements an AXI4 slave IP with two pieces of RISC-V
// functionality that are unrelated except in that they generate local
// interrupts for the Core.
//
// These are also known as CLINT (Core-Local Interruptor) in other RISC-V systems.
//
// - real-time timer:
//     Two 64-bit memory-mapped registers (rg_time and rg_timecmp).
//     Delivers an external interrupt whenever rg_timecmp >= rg_time.
//     The timer is cleared when rg_timecmp is written.
//     Can be used for the RISC-V v1.10 Privilege Spec 'mtime' and
//     'mtimecmp', and provides a memory-mapped API to access them.
//
//     Offset/Size        Name        Function
//     'h_4000/8 Bytes    mtimecmp    R/W the hart0 mtimecmp  register
//     'h_BFF8/8 Bytes    mtime       R/W the mtime     register
//
// - Memory-mapped location for software interrupts.
//
//     Offset/Size        Name        Function
//     'h_0000/8 Bytes    msip        R/W Writing LSB=1 generates a software interrupt to hart0
//
// ----------------
// This slave IP can be attached to fabrics with 32b- or 64b-wide data channels.
//    (NOTE: this is the width of the fabric, which can be chosen
//      independently of the native width of a CPU master on the
//      fabric (such as RV32/RV64 for a RISC-V CPU).
// When attached to 32b-wide fabric, 64-bit locations must be
// read/written in two 32b transaction, once for the lower 32b and
// once for the upper 32b.
//
// Some of the 'truncate()'s and 'zeroExtend()'s below are no-ops but
// necessary to satisfy type-checking.
// ================================================================

export  Near_Mem_IO_AXI4_IFC (..),
        mkNear_Mem_IO_AXI4;

// ================================================================
// BSV library imports

import  FIFOF         :: *;
import  GetPut        :: *;
import  ClientServer  :: *;
import  ConfigReg     :: *;

// ----------------
// BSV additional libs

import Cur_Cycle  :: *;
import GetPut_Aux :: *;
import Semi_FIFOF :: *;
import ByteLane   :: *;

// ================================================================
// Project imports

// Main fabric
import AXI4_Types   :: *;
import AXI4_Fabric  :: *;
import Fabric_Defs  :: *;    // for Wd_Id, Wd_Addr, Wd_Data, Wd_User

// ================================================================
// Local constants and types

// Module state
typedef enum {MODULE_STATE_START, MODULE_STATE_READY } Module_State
deriving (Bits, Eq, FShow);

// ================================================================
// Interface

interface Near_Mem_IO_AXI4_IFC;
   // Reset
   interface Server #(Bit #(0), Bit #(0))  server_reset;

   // set_addr_map should be called after this module's reset
   method Action set_addr_map (Fabric_Addr addr_base, Fabric_Addr addr_lim);

   // Memory-mapped access
   interface AXI4_Slave_IFC #(Wd_Id, Wd_Addr, Wd_Data, Wd_User) axi4_slave;

   // Read MTIME to update shadow-copy TIME CSR
   (* always_ready *)
   method Bit #(64) mv_read_mtime;

   // Timer interrupt
   // True/False = set/clear interrupt-pending in CPU's MTIP
   interface Get #(Bool)  get_timer_interrupt_req;

   // Software interrupt
   interface Get #(Bool)  get_sw_interrupt_req;
endinterface

// ================================================================

(* synthesize *)
module mkNear_Mem_IO_AXI4 (Near_Mem_IO_AXI4_IFC);

   // Verbosity: 0: quiet; 1: reset; 2: timer interrupts, all reads and writes
   Reg #(Bit #(4)) cfg_verbosity <- mkConfigReg (2);

   Reg #(Module_State) rg_state <- mkReg (MODULE_STATE_START);

   // ----------------
   // Soft reset requests and responses
   FIFOF #(Bit #(0)) f_reset_reqs <- mkFIFOF;
   FIFOF #(Bit #(0)) f_reset_rsps <- mkFIFOF;

   // ----------------
   // Memory-mapped access

   // Base and limit addrs for this memory-mapped block.
   Reg #(Fabric_Addr) rg_addr_base <- mkRegU;
   Reg #(Fabric_Addr) rg_addr_lim  <- mkRegU;

   // Connector to AXI4 fabric
   AXI4_Slave_Xactor_IFC #(Wd_Id, Wd_Addr, Wd_Data, Wd_User) slave_xactor <- mkAXI4_Slave_Xactor;

   // ----------------
   // Timer registers

   Reg #(Bit #(64)) crg_time [2]    <- mkCReg (2, 0);
   Reg #(Bit #(64)) crg_timecmp [2] <- mkCReg (2, '1);

   Reg #(Bool) rg_mtip      <- mkReg (False);
   Reg #(Bool) rg_mtip_prev <- mkReg (False);

   // Timer-interrupt queue
   FIFOF #(Bool) f_timer_interrupt_req <- mkFIFOF;

   // ----------------
   // Software-interrupt registers

   Reg #(Bool) rg_msip <- mkRegU;

   // Software interrupt queue
   FIFOF #(Bool) f_sw_interrupt_req <- mkFIFOF;

   // ================================================================
   // BEHAVIOR

   // ----------------------------------------------------------------
   // Reset

   rule rl_reset (rg_state == MODULE_STATE_START);
      f_reset_reqs.deq;

      slave_xactor.reset;
      f_timer_interrupt_req.clear;
      f_sw_interrupt_req.clear;

      rg_state        <= MODULE_STATE_READY;
      crg_time [1]    <= 0;
      crg_timecmp [1] <= '1;
      rg_msip         <= False;

      rg_mtip         <= False;
      rg_mtip_prev    <= False;

      f_reset_rsps.enq (?);

      if (cfg_verbosity != 0)
	 $display ("%0d: Near_Mem_IO_AXI4.rl_reset", cur_cycle);
   endrule

   rule rl_soft_reset (f_reset_reqs.notEmpty);
      rg_state <= MODULE_STATE_START;
   endrule

   // ----------------------------------------------------------------
   // Keep time and generate interrupt

   // Increment time, but saturate, do not wrap-around
   (* fire_when_enabled, no_implicit_conditions *)
   rule rl_tick_timer (   (rg_state == MODULE_STATE_READY)
		       && (crg_time [0] != '1)
		       && (! f_reset_reqs.notEmpty));

      crg_time [0] <= crg_time [0] + 1;
   endrule

   // Compare and generate timer interrupt request

   /* OLD: DELETE AFTER DEBUG NEW
   Bool new_mtip = (crg_time [0] >= crg_timecmp [0]);

   rule rl_compare ((rg_state == MODULE_STATE_READY)
		    && (rg_mtip != new_mtip)
		    && (! f_reset_reqs.notEmpty));

      rg_mtip <= new_mtip;
      f_timer_interrupt_req.enq (new_mtip);
      if (cfg_verbosity > 1)
	 $display ("%0d: Near_Mem_IO_AXI4.rl_compare: new MTIP = %0d, time = %0d, timecmp = %0d",
		   cur_cycle, new_mtip, crg_time [0], crg_timecmp [0]);
   endrule
   */

   rule rl_mtip ((rg_state == MODULE_STATE_READY) && (! f_reset_reqs.notEmpty));
      rg_mtip <= (crg_time [0] >= crg_timecmp [0]);
   endrule

   rule rl_mtip_edge;
      if (rg_mtip != rg_mtip_prev) begin
	 f_timer_interrupt_req.enq (rg_mtip);
	 if (cfg_verbosity > 1)
	    $display ("%0d: Near_Mem_IO_AXI4.rl_mtip_edge: rg_mtip change to %0d",
		      cur_cycle, rg_mtip);
      end
      rg_mtip_prev <= rg_mtip;
   endrule

   // ----------------------------------------------------------------
   // Handle 'memory'-read requests

   rule rl_process_rd_req (   (rg_state == MODULE_STATE_READY)
			   && (! f_reset_reqs.notEmpty));

      let rda <- pop_o (slave_xactor.o_rd_addr);
      if (cfg_verbosity > 1) begin
	 $display ("%0d: Near_Mem_IO_AXI4.rl_process_rd_req", cur_cycle);
	 $display ("    ", fshow (rda));
      end

      let        byte_addr = rda.araddr - rg_addr_base;
      Bit #(64)  rdata = 0;
      AXI4_Resp  rresp = axi4_resp_okay;

      if (rda.araddr < rg_addr_base) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_rd_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (rda));
	 rresp = axi4_resp_decerr;
      end

      else if (byte_addr == 'h_0000)
	 // MSIP
	 rdata = zeroExtend (rg_msip ? 1'b1 : 1'b0);

      else if (byte_addr == 'h_4000)
	 // MTIMECMP
	 rdata = truncate (crg_timecmp [0]);    // truncates for 32b fabrics

      else if (byte_addr == 'h_BFF8)
	 // MTIME
	 rdata = truncate (crg_time [0]);       // truncates for 32b fabrics

      // The following ALIGN4B reads are only needed for 32b fabrics
      else if (byte_addr == 'h_0004)
	 // MSIPH
	 rdata = 0;

      else if (byte_addr == 'h_4004) begin
	 // MTIMECMPH
	 Bit #(64) x64 = crg_timecmp [0];
	 if (valueOf (Wd_Data) == 32)
	    x64 = { 0, x64 [63:32] };
	 rdata = zeroExtend (x64);    // extends for 64b fabrics
      end

      else if (byte_addr == 'h_BFFC) begin
	 // MTIMEH
	 Bit #(64) x64 = crg_time [0];
	 if (valueOf (Wd_Data) == 32)
	    x64 = { 0, x64 [63:32] };
	 rdata = zeroExtend (x64);    // extends for 64b fabrics
      end

      else
	 rresp = axi4_resp_decerr;

      if (rresp != axi4_resp_okay) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_rd_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (rda));
      end

      // Send read-response to bus
      Fabric_Data x = truncate (rdata);
      let rdr = AXI4_Rd_Data {rid:   rda.arid,
			      rdata: x,
			      rresp: rresp,
			      rlast: True,
			      ruser: rda.aruser};
      slave_xactor.i_rd_data.enq (rdr);

      if (cfg_verbosity > 1) begin
	 $display ("    ", fshow (rdr));
      end
   endrule

   // ----------------------------------------------------------------
   // Handle 'memory'-write requests

   rule rl_process_wr_req (   (rg_state == MODULE_STATE_READY)
			   && (! f_reset_reqs.notEmpty));

      let wra <- pop_o (slave_xactor.o_wr_addr);
      let wrd <- pop_o (slave_xactor.o_wr_data);
      if (cfg_verbosity > 1) begin
	 $display ("%0d: Near_Mem_IO_AXI4.rl_process_wr_req", cur_cycle);
	 $display ("    ", fshow (wra));
	 $display ("    ", fshow (wrd));
      end

      Bit #(64) wdata     = zeroExtend (wrd.wdata);
      Bit #(8)  wstrb     = zeroExtend (wrd.wstrb);
      Bit #(8)  data_byte = wdata [7:0];

      let        byte_addr = wra.awaddr - rg_addr_base;
      AXI4_Resp  bresp     = axi4_resp_okay;

      if (wra.awaddr < rg_addr_base) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_wr_req: unrecognized addr", cur_cycle);
	 $display ("            ", fshow (wra));
	 $display ("            ", fshow (wrd));
	 bresp = axi4_resp_decerr;
      end

      // MSIP
      else if (byte_addr == 'h_0000) begin
	 Bool new_msip = (wdata [0] == 1'b1);
	 if (rg_msip != new_msip) begin
	    rg_msip <= new_msip;
	    f_sw_interrupt_req.enq (new_msip);
	    if (cfg_verbosity > 1)
	       $display ("    new MSIP = %0d", new_msip);
	 end
      end

      // MSIPH
      else if (byte_addr == 'h_0004) begin
	 noAction;    // upper 32 bits wired to 0
      end

      // MTIMECMP and MTIMECMPH
      else if ((byte_addr == 'h_4000) || (byte_addr == 'h_4004)) begin
	 Bit #(64) old_timecmp = crg_timecmp [1];
	 Bit #(64) new_timecmp = ?;

	 if (byte_addr == 'h_4000) begin
	    new_timecmp = fn_update_strobed_bytes (old_timecmp,
						   zeroExtend (wdata),
						   zeroExtend (wstrb));
	 end
	 else begin
	    Bit #(64) x64      = zeroExtend (wdata);
	    Bit #(8)  x64_strb = zeroExtend (wstrb);
	    if (valueOf (Wd_Data) == 32) begin
	       x64      = { x64 [31:0], 0 };
	       x64_strb = { x64_strb [3:0], 0 };
	    end
	    new_timecmp = fn_update_strobed_bytes (old_timecmp, x64, x64_strb);
	 end

	 crg_timecmp [1] <= new_timecmp;
	 rg_mtip <= False;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIMECMP");
	    $display ("        old MTIMECMP         = %0d", old_timecmp);
	    $display ("        new MTIMECMP         = %0d", new_timecmp);
	    $display ("        cur MTIME            = %0d", crg_time [1]);
	 end

	 // Simulation-only warning that timer interval is very large
	 if ((new_timecmp > crg_time [1])
	     && ((new_timecmp - crg_time [1]) > 'h_1_0000_0000))
	    $display ("%0d: WARNING: very large timer interval:  time %0d  timecmp %0d",
		      cur_cycle, crg_time [1], new_timecmp);
      end

      else if (byte_addr == 'h_BFF8) begin
	 // MTIME
	 Bit #(64) old_time = crg_time [1];
	 Bit #(64) new_time = fn_update_strobed_bytes (old_time,
						       zeroExtend (wdata),
						       zeroExtend (wstrb));
	 crg_time [1] <= new_time;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIME");
	    $display ("        old MTIME = %0d", old_time);
	    $display ("        new MTIME = %0d", new_time);
	 end
      end

      else if (byte_addr == 'h_BFFC) begin
	 // MTIMEH
	 Bit #(64) old_time = crg_time [1];
	 Bit #(64) x64      = zeroExtend (wdata);
	 Bit #(8)  x64_strb = zeroExtend (wstrb);
	 if (valueOf (Wd_Data) == 32) begin
	    x64      = { x64 [31:0], 0 };
	    x64_strb = { x64_strb [3:0], 0 };
	 end
	 Bit #(64) new_time = fn_update_strobed_bytes (old_time, x64, x64_strb);
	 crg_time [1] <= new_time;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIME");
	    $display ("        old MTIME = %0d", old_time);
	    $display ("        new MTIME = %0d", new_time);
	 end
      end

      else
	 bresp = axi4_resp_decerr;

      if (bresp != axi4_resp_okay) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_wr_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (wra));
	 $display ("    ", fshow (wrd));
      end

      // Send write-response to bus
      let wrr = AXI4_Wr_Resp {bid:   wra.awid,
			      bresp: bresp,
			      buser: wra.awuser};
      slave_xactor.i_wr_resp.enq (wrr);

      if (cfg_verbosity > 1) begin
	 $display ("    ", fshow (wrr));
      end
   endrule

   // ================================================================
   // INTERFACE

   // Reset
   interface  server_reset = toGPServer (f_reset_reqs, f_reset_rsps);

   // set_addr_map should be called after this module's reset
   method Action  set_addr_map (Fabric_Addr addr_base,
				Fabric_Addr addr_lim) if (rg_state == MODULE_STATE_READY);
      if (addr_base [1:0] != 0)
	 $display ("%0d: WARNING: Near_Mem_IO_AXI4.set_addr_map: addr_base 0x%0h is not 4-Byte-aligned",
		   cur_cycle, addr_base);

      if (addr_lim [1:0] != 0)
	 $display ("%0d: WARNING: Near_Mem_IO_AXI4.set_addr_map: addr_lim 0x%0h is not 4-Byte-aligned",
		   cur_cycle, addr_lim);

      rg_addr_base <= addr_base;
      rg_addr_lim  <= addr_lim;
      $display ("%0d: Near_Mem_IO_AXI4.set_addr_map: addr_base 0x%0h addr_lim 0x%0h",
		cur_cycle, addr_base, addr_lim);
   endmethod

   // Memory-mapped access
   interface  axi4_slave = slave_xactor.axi_side;

   // Read MTIME to update shadow-copy TIME CSR
   method Bit #(64) mv_read_mtime;
      return crg_time [0];
   endmethod

   // Timer interrupt
   interface Get get_timer_interrupt_req;
     method ActionValue#(Bool) get();
       let x <- toGet (f_timer_interrupt_req).get;
       if (cfg_verbosity > 1)
          $display ("%0d: Near_Mem_IO_AXI4: get_timer_interrupt_req: %x", cur_cycle, x);
       return x;
     endmethod
   endinterface

   // Software interrupt
   interface Get get_sw_interrupt_req;
     method ActionValue#(Bool) get();
       let x <- toGet (f_sw_interrupt_req).get;
       if (cfg_verbosity > 1)
          $display ("%0d: Near_Mem_IO_AXI4: get_sw_interrupt_req: %x", cur_cycle, x);
       return x;
     endmethod
   endinterface
endmodule

// ================================================================

endpackage

// Copyright (c) 2016-2022 Bluespec, Inc. All Rights Reserved

package Near_Mem_IO_AXI4;

// ================================================================
// This package implements an AXI4 slave IP with two pieces of RISC-V
// functionality that are unrelated except in that they generate local
// interrupts for the Core.
//
// These are also known as CLINT (Core-Local Interruptor) in other RISC-V systems.
//
// - real-time timer:
//     Two 64-bit memory-mapped registers (rg_time and rg_timecmp).
//     Delivers an external interrupt whenever rg_timecmp >= rg_time.
//     The timer is cleared when rg_timecmp is written.
//     Can be used for the RISC-V v1.10 Privilege Spec 'mtime' and
//     'mtimecmp', and provides a memory-mapped API to access them.
//
//     Offset/Size        Name        Function
//     'h_4000/8 Bytes    mtimecmp    R/W the hart0 mtimecmp  register
//     'h_BFF8/8 Bytes    mtime       R/W the mtime     register
//
// - Memory-mapped location for software interrupts.
//
//     Offset/Size        Name        Function
//     'h_0000/8 Bytes    msip        R/W Writing LSB=1 generates a software interrupt to hart0
//
// ----------------
// This slave IP can be attached to fabrics with 32b- or 64b-wide data channels.
//    (NOTE: this is the width of the fabric, which can be chosen
//      independently of the native width of a CPU master on the
//      fabric (such as RV32/RV64 for a RISC-V CPU).
// When attached to 32b-wide fabric, 64-bit locations must be
// read/written in two 32b transaction, once for the lower 32b and
// once for the upper 32b.
//
// Some of the 'truncate()'s and 'zeroExtend()'s below are no-ops but
// necessary to satisfy type-checking.
// ================================================================

export  Near_Mem_IO_AXI4_IFC (..),
        mkNear_Mem_IO_AXI4;

// ================================================================
// BSV library imports

import  FIFOF         :: *;
import  GetPut        :: *;
import  ClientServer  :: *;
import  ConfigReg     :: *;

// ----------------
// BSV additional libs

import Cur_Cycle  :: *;
import GetPut_Aux :: *;
import Semi_FIFOF :: *;
import ByteLane   :: *;

// ================================================================
// Project imports

// Main fabric
import AXI4_Types   :: *;
import AXI4_Fabric  :: *;
import Fabric_Defs  :: *;    // for Wd_Id, Wd_Addr, Wd_Data, Wd_User

// ================================================================
// Local constants and types

// Module state
typedef enum {MODULE_STATE_START, MODULE_STATE_READY } Module_State
deriving (Bits, Eq, FShow);

// ================================================================
// Interface

interface Near_Mem_IO_AXI4_IFC;
   // Reset
   interface Server #(Bit #(0), Bit #(0))  server_reset;

   // set_addr_map should be called after this module's reset
   method Action set_addr_map (Fabric_Addr addr_base, Fabric_Addr addr_lim);

   // Memory-mapped access
   interface AXI4_Slave_IFC #(Wd_Id, Wd_Addr, Wd_Data, Wd_User) axi4_slave;

   // Read MTIME to update shadow-copy TIME CSR
   (* always_ready *)
   method Bit #(64) mv_read_mtime;

   // Timer interrupt
   // True/False = set/clear interrupt-pending in CPU's MTIP
   interface Get #(Bool)  get_timer_interrupt_req;

   // Software interrupt
   interface Get #(Bool)  get_sw_interrupt_req;
endinterface

// ================================================================

(* synthesize *)
module mkNear_Mem_IO_AXI4 (Near_Mem_IO_AXI4_IFC);

   // Verbosity: 0: quiet; 1: reset; 2: timer interrupts, all reads and writes
   Reg #(Bit #(4)) cfg_verbosity <- mkConfigReg (2);

   Reg #(Module_State) rg_state <- mkReg (MODULE_STATE_START);

   // ----------------
   // Soft reset requests and responses
   FIFOF #(Bit #(0)) f_reset_reqs <- mkFIFOF;
   FIFOF #(Bit #(0)) f_reset_rsps <- mkFIFOF;

   // ----------------
   // Memory-mapped access

   // Base and limit addrs for this memory-mapped block.
   Reg #(Fabric_Addr) rg_addr_base <- mkRegU;
   Reg #(Fabric_Addr) rg_addr_lim  <- mkRegU;

   // Connector to AXI4 fabric
   AXI4_Slave_Xactor_IFC #(Wd_Id, Wd_Addr, Wd_Data, Wd_User) slave_xactor <- mkAXI4_Slave_Xactor;

   // ----------------
   // Timer registers

   Reg #(Bit #(64)) crg_time [2]    <- mkCReg (2, 0);
   Reg #(Bit #(64)) crg_timecmp [2] <- mkCReg (2, '1);

   Reg #(Bool) rg_mtip      <- mkReg (False);
   Reg #(Bool) rg_mtip_prev <- mkReg (False);

   // Timer-interrupt queue
   FIFOF #(Bool) f_timer_interrupt_req <- mkFIFOF;

   // ----------------
   // Software-interrupt registers

   Reg #(Bool) rg_msip <- mkRegU;

   // Software interrupt queue
   FIFOF #(Bool) f_sw_interrupt_req <- mkFIFOF;

   // ================================================================
   // BEHAVIOR

   // ----------------------------------------------------------------
   // Reset

   rule rl_reset (rg_state == MODULE_STATE_START);
      f_reset_reqs.deq;

      slave_xactor.reset;
      f_timer_interrupt_req.clear;
      f_sw_interrupt_req.clear;

      rg_state        <= MODULE_STATE_READY;
      crg_time [1]    <= 0;
      crg_timecmp [1] <= '1;
      rg_msip         <= False;

      rg_mtip         <= False;
      rg_mtip_prev    <= False;

      f_reset_rsps.enq (?);

      if (cfg_verbosity != 0)
	 $display ("%0d: Near_Mem_IO_AXI4.rl_reset", cur_cycle);
   endrule

   rule rl_soft_reset (f_reset_reqs.notEmpty);
      rg_state <= MODULE_STATE_START;
   endrule

   // ----------------------------------------------------------------
   // Keep time and generate interrupt

   // Increment time, but saturate, do not wrap-around
   (* fire_when_enabled, no_implicit_conditions *)
   rule rl_tick_timer (   (rg_state == MODULE_STATE_READY)
		       && (crg_time [0] != '1)
		       && (! f_reset_reqs.notEmpty));

      crg_time [0] <= crg_time [0] + 1;
   endrule

   // Compare and generate timer interrupt request

   /* OLD: DELETE AFTER DEBUG NEW
   Bool new_mtip = (crg_time [0] >= crg_timecmp [0]);

   rule rl_compare ((rg_state == MODULE_STATE_READY)
		    && (rg_mtip != new_mtip)
		    && (! f_reset_reqs.notEmpty));

      rg_mtip <= new_mtip;
      f_timer_interrupt_req.enq (new_mtip);
      if (cfg_verbosity > 1)
	 $display ("%0d: Near_Mem_IO_AXI4.rl_compare: new MTIP = %0d, time = %0d, timecmp = %0d",
		   cur_cycle, new_mtip, crg_time [0], crg_timecmp [0]);
   endrule
   */

   rule rl_mtip ((rg_state == MODULE_STATE_READY) && (! f_reset_reqs.notEmpty));
      rg_mtip <= (crg_time [0] >= crg_timecmp [0]);
   endrule

   rule rl_mtip_edge;
      if (rg_mtip != rg_mtip_prev) begin
	 f_timer_interrupt_req.enq (rg_mtip);
	 if (cfg_verbosity > 1)
	    $display ("%0d: Near_Mem_IO_AXI4.rl_mtip_edge: rg_mtip change to %0d",
		      cur_cycle, rg_mtip);
      end
      rg_mtip_prev <= rg_mtip;
   endrule

   // ----------------------------------------------------------------
   // Handle 'memory'-read requests

   rule rl_process_rd_req (   (rg_state == MODULE_STATE_READY)
			   && (! f_reset_reqs.notEmpty));

      let rda <- pop_o (slave_xactor.o_rd_addr);
      if (cfg_verbosity > 1) begin
	 $display ("%0d: Near_Mem_IO_AXI4.rl_process_rd_req", cur_cycle);
	 $display ("    ", fshow (rda));
      end

      let        byte_addr = rda.araddr - rg_addr_base;
      Bit #(64)  rdata = 0;
      AXI4_Resp  rresp = axi4_resp_okay;

      if (rda.araddr < rg_addr_base) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_rd_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (rda));
	 rresp = axi4_resp_decerr;
      end

      else if (byte_addr == 'h_0000)
	 // MSIP
	 rdata = zeroExtend (rg_msip ? 1'b1 : 1'b0);

      else if (byte_addr == 'h_4000)
	 // MTIMECMP
	 rdata = truncate (crg_timecmp [0]);    // truncates for 32b fabrics

      else if (byte_addr == 'h_BFF8)
	 // MTIME
	 rdata = truncate (crg_time [0]);       // truncates for 32b fabrics

      // The following ALIGN4B reads are only needed for 32b fabrics
      else if (byte_addr == 'h_0004)
	 // MSIPH
	 rdata = 0;

      else if (byte_addr == 'h_4004) begin
	 // MTIMECMPH
	 Bit #(64) x64 = crg_timecmp [0];
	 if (valueOf (Wd_Data) == 32)
	    x64 = { 0, x64 [63:32] };
	 rdata = zeroExtend (x64);    // extends for 64b fabrics
      end

      else if (byte_addr == 'h_BFFC) begin
	 // MTIMEH
	 Bit #(64) x64 = crg_time [0];
	 if (valueOf (Wd_Data) == 32)
	    x64 = { 0, x64 [63:32] };
	 rdata = zeroExtend (x64);    // extends for 64b fabrics
      end

      else
	 rresp = axi4_resp_decerr;

      if (rresp != axi4_resp_okay) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_rd_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (rda));
      end

      // Send read-response to bus
      Fabric_Data x = truncate (rdata);
      let rdr = AXI4_Rd_Data {rid:   rda.arid,
			      rdata: x,
			      rresp: rresp,
			      rlast: True,
			      ruser: rda.aruser};
      slave_xactor.i_rd_data.enq (rdr);

      if (cfg_verbosity > 1) begin
	 $display ("    ", fshow (rdr));
      end
   endrule

   // ----------------------------------------------------------------
   // Handle 'memory'-write requests

   rule rl_process_wr_req (   (rg_state == MODULE_STATE_READY)
			   && (! f_reset_reqs.notEmpty));

      let wra <- pop_o (slave_xactor.o_wr_addr);
      let wrd <- pop_o (slave_xactor.o_wr_data);
      if (cfg_verbosity > 1) begin
	 $display ("%0d: Near_Mem_IO_AXI4.rl_process_wr_req", cur_cycle);
	 $display ("    ", fshow (wra));
	 $display ("    ", fshow (wrd));
      end

      Bit #(64) wdata     = zeroExtend (wrd.wdata);
      Bit #(8)  wstrb     = zeroExtend (wrd.wstrb);
      Bit #(8)  data_byte = wdata [7:0];

      let        byte_addr = wra.awaddr - rg_addr_base;
      AXI4_Resp  bresp     = axi4_resp_okay;

      if (wra.awaddr < rg_addr_base) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_wr_req: unrecognized addr", cur_cycle);
	 $display ("            ", fshow (wra));
	 $display ("            ", fshow (wrd));
	 bresp = axi4_resp_decerr;
      end

      // MSIP
      else if (byte_addr == 'h_0000) begin
	 Bool new_msip = (wdata [0] == 1'b1);
	 if (rg_msip != new_msip) begin
	    rg_msip <= new_msip;
	    f_sw_interrupt_req.enq (new_msip);
	    if (cfg_verbosity > 1)
	       $display ("    new MSIP = %0d", new_msip);
	 end
      end

      // MSIPH
      else if (byte_addr == 'h_0004) begin
	 noAction;    // upper 32 bits wired to 0
      end

      // MTIMECMP and MTIMECMPH
      else if ((byte_addr == 'h_4000) || (byte_addr == 'h_4004)) begin
	 Bit #(64) old_timecmp = crg_timecmp [1];
	 Bit #(64) new_timecmp = ?;

	 if (byte_addr == 'h_4000) begin
	    new_timecmp = fn_update_strobed_bytes (old_timecmp,
						   zeroExtend (wdata),
						   zeroExtend (wstrb));
	 end
	 else begin
	    Bit #(64) x64      = zeroExtend (wdata);
	    Bit #(8)  x64_strb = zeroExtend (wstrb);
	    if (valueOf (Wd_Data) == 32) begin
	       x64      = { x64 [31:0], 0 };
	       x64_strb = { x64_strb [3:0], 0 };
	    end
	    // TEMPORARY DEBUG: TODO: DELETE WHEN DONE
	    // We're seeing 'h_AAAA_AAAA written here,
	    // which results in a huge timer interval
	    x64 = 0;
	    new_timecmp = fn_update_strobed_bytes (old_timecmp, x64, x64_strb);
	 end

	 crg_timecmp [1] <= new_timecmp;
	 rg_mtip <= False;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIMECMP");
	    $display ("        old MTIMECMP         = %0d", old_timecmp);
	    $display ("        new MTIMECMP         = %0d", new_timecmp);
	    $display ("        cur MTIME            = %0d", crg_time [1]);
	 end

	 // Simulation-only warning that timer interval is very large
	 if ((new_timecmp > crg_time [1])
	     && ((new_timecmp - crg_time [1]) > 'h_1_0000_0000))
	    $display ("%0d: WARNING: very large timer interval:  time %0d  timecmp %0d",
		      cur_cycle, crg_time [1], new_timecmp);
      end

      else if (byte_addr == 'h_BFF8) begin
	 // MTIME
	 Bit #(64) old_time = crg_time [1];
	 Bit #(64) new_time = fn_update_strobed_bytes (old_time,
						       zeroExtend (wdata),
						       zeroExtend (wstrb));
	 crg_time [1] <= new_time;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIME");
	    $display ("        old MTIME = %0d", old_time);
	    $display ("        new MTIME = %0d", new_time);
	 end
      end

      else if (byte_addr == 'h_BFFC) begin
	 // MTIMEH
	 Bit #(64) old_time = crg_time [1];
	 Bit #(64) x64      = zeroExtend (wdata);
	 Bit #(8)  x64_strb = zeroExtend (wstrb);
	 if (valueOf (Wd_Data) == 32) begin
	    x64      = { x64 [31:0], 0 };
	    x64_strb = { x64_strb [3:0], 0 };
	 end
	 Bit #(64) new_time = fn_update_strobed_bytes (old_time, x64, x64_strb);
	 crg_time [1] <= new_time;

	 if (cfg_verbosity > 1) begin
	    $display ("    Writing MTIME");
	    $display ("        old MTIME = %0d", old_time);
	    $display ("        new MTIME = %0d", new_time);
	 end
      end

      else
	 bresp = axi4_resp_decerr;

      if (bresp != axi4_resp_okay) begin
	 $display ("%0d: ERROR: Near_Mem_IO_AXI4.rl_process_wr_req: unrecognized addr", cur_cycle);
	 $display ("    ", fshow (wra));
	 $display ("    ", fshow (wrd));
      end

      // Send write-response to bus
      let wrr = AXI4_Wr_Resp {bid:   wra.awid,
			      bresp: bresp,
			      buser: wra.awuser};
      slave_xactor.i_wr_resp.enq (wrr);

      if (cfg_verbosity > 1) begin
	 $display ("    ", fshow (wrr));
      end
   endrule

   // ================================================================
   // INTERFACE

   // Reset
   interface  server_reset = toGPServer (f_reset_reqs, f_reset_rsps);

   // set_addr_map should be called after this module's reset
   method Action  set_addr_map (Fabric_Addr addr_base,
				Fabric_Addr addr_lim) if (rg_state == MODULE_STATE_READY);
      if (addr_base [1:0] != 0)
	 $display ("%0d: WARNING: Near_Mem_IO_AXI4.set_addr_map: addr_base 0x%0h is not 4-Byte-aligned",
		   cur_cycle, addr_base);

      if (addr_lim [1:0] != 0)
	 $display ("%0d: WARNING: Near_Mem_IO_AXI4.set_addr_map: addr_lim 0x%0h is not 4-Byte-aligned",
		   cur_cycle, addr_lim);

      rg_addr_base <= addr_base;
      rg_addr_lim  <= addr_lim;
      $display ("%0d: Near_Mem_IO_AXI4.set_addr_map: addr_base 0x%0h addr_lim 0x%0h",
		cur_cycle, addr_base, addr_lim);
   endmethod

   // Memory-mapped access
   interface  axi4_slave = slave_xactor.axi_side;

   // Read MTIME to update shadow-copy TIME CSR
   method Bit #(64) mv_read_mtime;
      return crg_time [0];
   endmethod

   // Timer interrupt
   interface Get get_timer_interrupt_req;
     method ActionValue#(Bool) get();
       let x <- toGet (f_timer_interrupt_req).get;
       if (cfg_verbosity > 1)
          $display ("%0d: Near_Mem_IO_AXI4: get_timer_interrupt_req: %x", cur_cycle, x);
       return x;
     endmethod
   endinterface

   // Software interrupt
   interface Get get_sw_interrupt_req;
     method ActionValue#(Bool) get();
       let x <- toGet (f_sw_interrupt_req).get;
       if (cfg_verbosity > 1)
          $display ("%0d: Near_Mem_IO_AXI4: get_sw_interrupt_req: %x", cur_cycle, x);
       return x;
     endmethod
   endinterface
endmodule

// ================================================================

endpackage


wordsRead was actually changed to be bytesRead

// Copyright (c) 2013 Quanta Research Cambridge, Inc.

// Permission is hereby granted, free of charge, to any person
// obtaining a copy of this software and associated documentation
// files (the "Software"), to deal in the Software without
// restriction, including without limitation the rights to use, copy,
// modify, merge, publish, distribute, sublicense, and/or sell copies
// of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:

// The above copyright notice and this permission notice shall be
// included in all copies or substantial portions of the Software.

// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
// BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
// ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
// CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.
import FIFO::*;
import FIFOF::*;
import Vector::*;
import BuildVector::*;
import GetPut::*;
import ClientServer::*;

import Pipe::*;
import MemTypes::*;
import MemreadEngine::*;
import Pipe::*;
import HostInterface::*;

interface ReadTestRequest;
   method Action startRead(Bit#(32) pointer, Bit#(32) numBytes, Bit#(32) burstLen, Bit#(32) iterCnt);
endinterface

interface ReadTest;
   interface ReadTestRequest request;
   interface Vector#(1,MemReadClient#(DataBusWidth)) dmaClient;
endinterface

interface ReadTestIndication;
   method Action readDone(Bit#(32) mismatchCount);
endinterface

module mkReadTest#(ReadTestIndication indication) (ReadTest);

   Reg#(SGLId)   pointer <- mkReg(0);
   Reg#(Bit#(32))       numBytes <- mkReg(0);
   Reg#(Bit#(BurstLenSize)) burstLenBytes <- mkReg(0);
   Reg#(Bit#(32))  itersToFinish <- mkReg(0);
   Reg#(Bit#(32))   itersToStart <- mkReg(0);
   Reg#(Bit#(32))        bytesRead <- mkReg(0);
   Reg#(Bit#(32)) mismatchCounts <- mkReg(0);
   MemreadEngine#(DataBusWidth,1,1)        re <- mkMemreadEngine;
   FIFO#(Bit#(32)) checkDoneFifo <- mkFIFO();

   rule start (itersToStart > 0);
      $display("Test: request.put");
      re.readServers[0].request.put(MemengineCmd{sglId:pointer, base:0, len:numBytes, burstLen:burstLenBytes});
      itersToStart <= itersToStart-1;
   endrule

   Reg#(Bit#(DataBusWidth)) vReg <- mkReg(0);
   Reg#(Bit#(DataBusWidth)) vExpectedReg <- mkReg(0);
   Reg#(Bool)               validReg <- mkReg(False);
   Reg#(Bit#(32))           bytesToRead <- mkReg(0);
   Reg#(Bool)               lastReg <- mkReg(False);
   rule check;
      // first pipeline stage
      if (re.dataPipes[0].notEmpty()) begin
	 let v <- toGet(re.dataPipes[0]).get;
	 let rval = bytesRead/4;
	 let expectedV = {rval+1,rval};
	 vReg <= v;
	 vExpectedReg <= expectedV;
	 validReg <= True;
	 let next_bytesRead = bytesRead + fromInteger(valueOf(DataBusWidth))/8;
	 let next_bytesToRead = bytesToRead - fromInteger(valueOf(DataBusWidth))/8;
	 let last = (bytesToRead <= fromInteger(valueOf(DataBusWidth))/8);
	 //$display("check next_bytesRead=%d next_bytesToRead=%d last=%d", next_bytesRead, next_bytesToRead, last);
	 if (last) begin
	    next_bytesRead = 0;
	    next_bytesToRead = numBytes;
	 end
	 lastReg <= last;
	 bytesRead <= next_bytesRead;
	 bytesToRead <= next_bytesToRead;
      end
      else begin
	 validReg <= False;
      end

      // second pipeline stage
      if (validReg) begin
	 let v = vReg;
	 let expectedV = vExpectedReg;
	 let misMatch = v != expectedV;
	 mismatchCounts <= mismatchCounts + (misMatch ? 1 : 0);
	 //$display("Test: check new=%x numBytes=%x bytesRead=%x misMatch=%x read=%x expect=%x", new_bytesRead, numBytes, bytesRead, misMatch, v, expectedV);
	 if (lastReg) begin
	    checkDoneFifo.enq(mismatchCounts);
	 end
      end
   endrule

   rule finish if (itersToFinish > 0);
      $display("Test: response.get itersToFinish %x", itersToFinish);
      let mc <- toGet(checkDoneFifo).get();
      let rv <- re.readServers[0].response.get;
      if (itersToFinish == 1) begin
	 indication.readDone(mismatchCounts);
      end
      itersToFinish <= itersToFinish - 1;
   endrule

   interface dmaClient = vec(re.dmaClient);
   interface ReadTestRequest request;
      method Action startRead(Bit#(32) rp, Bit#(32) nb, Bit#(32) bl, Bit#(32) ic) if (itersToStart == 0 && itersToFinish == 0);
         $display("startRead pointer=%x numBytes %x burstLen %x iteration %x", rp, nb, bl, ic);
	 pointer <= rp;
	 numBytes  <= nb;
	 bytesToRead <= nb;
	 burstLenBytes  <= truncate(bl);
	 itersToFinish <= ic;
	 itersToStart <= ic;
	 mismatchCounts <= 0;
	 bytesRead <= 0;
      endmethod
   endinterface
endmodule

// Copyright (c) 2013 Quanta Research Cambridge, Inc.

// Permission is hereby granted, free of charge, to any person
// obtaining a copy of this software and associated documentation
// files (the "Software"), to deal in the Software without
// restriction, including without limitation the rights to use, copy,
// modify, merge, publish, distribute, sublicense, and/or sell copies
// of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:

// The above copyright notice and this permission notice shall be
// included in all copies or substantial portions of the Software.

// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
// BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
// ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
// CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.
import FIFO::*;
import FIFOF::*;
import Vector::*;
import BuildVector::*;
import GetPut::*;
import ClientServer::*;

import Pipe::*;
import MemTypes::*;
import MemreadEngine::*;
import Pipe::*;
import HostInterface::*;

interface ReadTestRequest;
   method Action startRead(Bit#(32) pointer, Bit#(32) numBytes, Bit#(32) burstLen, Bit#(32) iterCnt);
endinterface

interface ReadTest;
   interface ReadTestRequest request;
   interface Vector#(1,MemReadClient#(DataBusWidth)) dmaClient;
endinterface

interface ReadTestIndication;
   method Action readDone(Bit#(32) mismatchCount);
endinterface

module mkReadTest#(ReadTestIndication indication) (ReadTest);

   Reg#(SGLId)   pointer <- mkReg(0);
   Reg#(Bit#(32))       numBytes <- mkReg(0);
   Reg#(Bit#(BurstLenSize)) burstLenBytes <- mkReg(0);
   Reg#(Bit#(32))  itersToFinish <- mkReg(0);
   Reg#(Bit#(32))   itersToStart <- mkReg(0);
   Reg#(Bit#(32))        wordsRead <- mkReg(0);
   Reg#(Bit#(32)) mismatchCounts <- mkReg(0);
   MemreadEngine#(DataBusWidth,1,1)        re <- mkMemreadEngine;
   FIFO#(Bit#(32)) checkDoneFifo <- mkFIFO();

   rule start (itersToStart > 0);
      $display("Test: request.put");
      re.readServers[0].request.put(MemengineCmd{sglId:pointer, base:0, len:numBytes, burstLen:burstLenBytes});
      itersToStart <= itersToStart-1;
   endrule

   Reg#(Bit#(DataBusWidth)) vReg <- mkReg(0);
   Reg#(Bit#(DataBusWidth)) vExpectedReg <- mkReg(0);
   Reg#(Bool)               validReg <- mkReg(False);
   Reg#(Bit#(32))           bytesToRead <- mkReg(0);
   Reg#(Bool)               lastReg <- mkReg(False);
   rule check;
      // first pipeline stage
      if (re.dataPipes[0].notEmpty()) begin
	 let v <- toGet(re.dataPipes[0]).get;
	 let rval = wordsRead/4;
	 let expectedV = {rval+1,rval};
	 vReg <= v;
	 vExpectedReg <= expectedV;
	 validReg <= True;
	 let next_wordsRead = wordsRead + fromInteger(valueOf(DataBusWidth))/8;
	 let next_bytesToRead = bytesToRead - fromInteger(valueOf(DataBusWidth))/8;
	 let last = (bytesToRead <= fromInteger(valueOf(DataBusWidth))/8);
	 //$display("check next_wordsRead=%d next_bytesToRead=%d last=%d", next_wordsRead, next_bytesToRead, last);
	 if (last) begin
	    next_wordsRead = 0;
	    next_bytesToRead = numBytes;
	 end
	 lastReg <= last;
	 wordsRead <= next_wordsRead;
	 bytesToRead <= next_bytesToRead;
      end
      else begin
	 validReg <= False;
      end

      // second pipeline stage
      if (validReg) begin
	 let v = vReg;
	 let expectedV = vExpectedReg;
	 let misMatch = v != expectedV;
	 mismatchCounts <= mismatchCounts + (misMatch ? 1 : 0);
	 //$display("Test: check new=%x numBytes=%x wordsRead=%x misMatch=%x read=%x expect=%x", new_wordsRead, numBytes, wordsRead, misMatch, v, expectedV);
	 if (lastReg) begin
	    checkDoneFifo.enq(mismatchCounts);
	 end
      end
   endrule

   rule finish if (itersToFinish > 0);
      $display("Test: response.get itersToFinish %x", itersToFinish);
      let mc <- toGet(checkDoneFifo).get();
      let rv <- re.readServers[0].response.get;
      if (itersToFinish == 1) begin
	 indication.readDone(mismatchCounts);
      end
      itersToFinish <= itersToFinish - 1;
   endrule

   interface dmaClient = vec(re.dmaClient);
   interface ReadTestRequest request;
      method Action startRead(Bit#(32) rp, Bit#(32) nb, Bit#(32) bl, Bit#(32) ic) if (itersToStart == 0 && itersToFinish == 0);
         $display("startRead pointer=%x numBytes %x burstLen %x iteration %x", rp, nb, bl, ic);
	 pointer <= rp;
	 numBytes  <= nb;
	 bytesToRead <= nb;
	 burstLenBytes  <= truncate(bl);
	 itersToFinish <= ic;
	 itersToStart <= ic;
	 mismatchCounts <= 0;
	 wordsRead <= 0;
      endmethod
   endinterface
endmodule