Support for verbosity control and interactive iterative deepening

// BlueCheck 0.2, Matt N.

// Change log
// ==========
//
// 5  Nov 2012: Version 0.1
// 21 Nov 2014: Support for iterative deepening
// 28 Nov 2014: Version 0.2, with support for shrinking

package BlueCheck;

import Randomizable  :: *;
import ModuleCollect :: *;
import StmtFSM       :: *;
import List          :: *;
import Clocks        :: *;
import FIFOF         :: *;
import ConfigReg     :: *;
import Vector        :: *;
import Assert        :: *;

// The max size of the log used for shrinking.  This is tricky to
// implement as a module parameter, hence it is a global parameter.
typedef 32 LogSize;
Integer logSize = valueOf(LogSize);

// BlueCheck module parameters
typedef struct {
  // Verbose output
  Bool verbose;

  // 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)
  Bool useIterativeDeepening;
  // This must contain valid data if 'useIterativeDeepening' is 'True'
  ID_Params id;

  // Interactive iterative deepening
  Bool interactive;

  // Attempt to shrink a counter example, if one is found
  // (This is only valid for iterative deepening)
  Bool useShrinking;

  // 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, random generators and loggers, 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, function Action gen(Bool replay)) RandomGenItem;
  Tuple2#(Fmt, Bool) InvariantItem;
  Tuple2#(Bool, Reg#(Bool)) EnsureItem;
  Tuple3#(Action, Action, Action) LogItem;
  Stmt PreStmtItem;
  Stmt PostStmtItem;
} 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, function Action gen(Bool replay)))
  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;

// Turn an item into a singleton statement if it is an EnsureItem.
function List#(Tuple2#(Bool, Reg#(Bool))) getEnsureItem(Item item) =
  case (item) matches
    tagged EnsureItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is an LogItem.
function List#(Tuple3#(Action, Action, Action))
  getLogItem(Item item) =
  case (item) matches
    tagged LogItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is a PreStmtItem.
function List#(Stmt) getPreStmtItem(Item item) =
  case (item) matches
    tagged PreStmtItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is a PostStmtItem.
function List#(Stmt) getPostStmtItem(Item item) =
  case (item) matches
    tagged PostStmtItem .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 (List::tail(app) matches tagged Nil)
    return List::head(app);
  else
    return (List::head(app) + fshow("(") +
             formatArgs(List::tail(app)) + fshow(")"));
endfunction

function Fmt formatArgs(List#(Fmt) args);
  if (List::tail(args) matches tagged Nil)
    return List::head(args);
  else
    return (List::head(args) + fshow(",") + formatArgs(List::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), FShow#(t));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                       , ActionValue#(t) a
                                       , ActionValue#(t) b) ();
    Wire#(Bool) success <- mkDWire(True);
    Wire#(t) aWire      <- mkDWire(?);
    Wire#(t) bWire      <- mkDWire(?);
    Fmt msg             =  fshow("Not equal: ") + fshow(aWire)
                        +  fshow(" versus ")    + fshow(bWire);

    Action executeTwoAndCheck =
      action
        t aVal <- a; aWire <= aVal;
        t bVal <- b; bWire <= bVal;
        if (aVal != bVal) success <= False;
      endaction;
      addToCollection(tagged ActionItem
        (tuple3(fr, formatApp(app), executeTwoAndCheck)));
      addToCollection(tagged InvariantItem (tuple2(msg, success)));
  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;
      FIFOF#(a) aLog <- mkUGSizedFIFOF(logSize);

      function Action genRandom(Bool replay) =
        action
          let a <- aRandom.next;
          aReg <= replay ? aLog.first : a;
        endaction;

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

      Action logEnq   = aLog.enq(aReg);
      Action logRot   = action aLog.deq; aLog.enq(aLog.first); endaction;
      Action logClear = aLog.clear;

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));
      addToCollection(tagged LogItem (tuple3(logEnq, logRot, logClear)));

      eq(List::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) ();
    Wire#(Bool) success <- mkDWire(True);
    Fmt fmt = formatApp(app) + fshow(" failed: ")
            + fshow(x) + fshow(" v ") + fshow(y);

    rule check;
      if (x != y) success <= False;
    endrule

    addToCollection(tagged InvariantItem (tuple2(fmt, success)));
  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#(Bool));
  module [BlueCheck] pr#(List#(Fmt) app,Frequency fr,ActionValue#(Bool) a) ();
    Wire#(Bool) success <- mkDWire(True);
    Fmt msg = fshow("Property failed");

    Action act =
      action
        Bool s <- a;
        if (!s) success <= False;
      endaction;
      addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), act)));
      addToCollection(tagged InvariantItem (tuple2(msg, success)));
  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;
      FIFOF#(a) aLog <- mkUGSizedFIFOF(logSize);

      function Action genRandom(Bool replay) =
        action
          let a <- aRandom.next;
          aReg <= replay ? aLog.first : a;
        endaction;

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

      Action logEnq   = aLog.enq(aReg);
      Action logRot   = action aLog.deq; aLog.enq(aLog.first); endaction;
      Action logClear = aLog.clear;

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));
      addToCollection(tagged LogItem (tuple3(logEnq, logRot, logClear)));

      pr(List::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

// Ensure function -- for making assertions inside properties
typedef (function Action f(Bool cond)) Ensure;
typedef (function Action f(Bool cond, Fmt msg)) EnsureMsg;

module [BlueCheck] getEnsure (Ensure);
  // Create ensure function
  Wire#(Bool) ok <- mkDWire(True);
  Reg#(Bool) showMsg <- mkReg(False);
  function Action ensureFunc(Bool cond) = action ok <= cond; endaction;
  addToCollection(tagged EnsureItem (tuple2(ok, showMsg)));
  return ensureFunc;
endmodule

module [BlueCheck] getEnsureMsg (EnsureMsg);
  // Create ensure function
  Wire#(Bool) ok <- mkDWire(True);
  Reg#(Bool) showMsg <- mkReg(False);
  function Action ensureFunc(Bool cond, Fmt msg) =
    action ok <= cond; if (!cond && showMsg) $display(msg); endaction;
  addToCollection(tagged EnsureItem (tuple2(ok, showMsg)));
  return ensureFunc;
endmodule

function Action assignReg(t x, Reg#(t) r) = action r <= x; endaction;

// Allow user to add custom pre/post statements for each test
module [BlueCheck] addPreStmt#(Stmt pre) (Empty);
  addToCollection(tagged PreStmtItem pre);
endmodule

module [BlueCheck] addPostStmt#(Stmt post) (Empty);
  addToCollection(tagged PostStmtItem post);
endmodule

// 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 = List::head(freqs);
      return (Cons(s >= fromInteger(start) && s < fromInteger(start+f),
        stateConds(s, start+f, List::tail(freqs))));
    end
endfunction

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

// Sequence a list of statements
function Stmt seqList(List#(Stmt) xs);
  if (xs matches tagged Nil) return (seq delay(1); endseq);
  else return (seq List::head(xs); seqList(List::tail(xs)); endseq);
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 concat = List::concat;
  let map    = List::map;
  let append = List::append;
  let {_, items} <- getCollection(bc);
  let actionItems    = concat(map(getActionItem, items));
  let stmtItems      = concat(map(getStmtItem, items));
  let randomGens     = concat(map(getRandomGenItem, items));
  let logItems       = concat(map(getLogItem, items));
  let ensureItems    = concat(map(getEnsureItem, items));
  let invariantBools = concat(map(getInvariantItem, items));
  let preStmt        = seqList(concat(map(getPreStmtItem, items)));
  let postStmt       = seqList(concat(map(getPostStmtItem, 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);
  let ensureBools    = map(tpl_1, ensureItems);
  let ensureShows    = map(tpl_2, ensureItems);

  // 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));
  ConfigReg#(State) state <- mkConfigReg(0);
  Wire#(Bool) waitWire <- mkDWire(False);
  Wire#(Bool) didntFire <- mkDWire(False);
  Reg#(Bool) testDone <- mkReg(False);
  Reg#(Bool) doneUI <- mkReg(False);
  List#(Bool) inState = stateConds(state, 1, freqs);
  Reg#(Bool) shrinkingMode <- mkReg(False);
  Reg#(Bool) verbose <- mkReg(params.verbose);

  // When all random generators have initialised
  Reg#(Bool) randGensInitialised <- mkReg(False);

  // When count is 0, actions/statements are disabled
  ConfigReg#(Bit#(32)) count <- mkConfigReg(0);
  Bool actionsEnabled = count != 0;

  // When delayed count is 0, invariant checking is disabled
  ConfigReg#(Bit#(32)) delayedCount <- mkConfigReg(0);
  Bool checkingEnabled = delayedCount != 0;

  rule updateDelayedCount;
    delayedCount <= count;
  endrule

  // Log/replay signals
  FIFOF#(State) stateLog  <- mkSizedFIFOF(logSize);
  FIFOF#(Bit#(64)) timeLog <- mkSizedFIFOF(logSize);
  Wire#(Bool) replayWire <- mkDWire(False);
  Wire#(Bool) logEnqWire <- mkDWire(False);
  Wire#(Bool) logRotWire <- mkDWire(False);
  Wire#(Bool) logClearWire <- mkDWire(False);
  Reg#(Bit#(32)) counterExampleLength <- mkReg(0);
  Reg#(Bit#(32)) omitNum <- mkReg(0);
  Vector#(LogSize, Reg#(Bool)) omitMask <- replicateM(mkReg(False));

  // Track failures
  Reg#(Bool) failureReg    <- mkConfigReg(False);
  Wire#(Bool) resetFailure <- mkDWire(False);
  Bool ensureFailure    = List::any( \== (False), ensureBools);
  Bool invariantFailure = (waitWire || !checkingEnabled) ? False
                        : List::any( \== (False), map (tpl_2, invariantBools));
  Bool failureFound     = ensureFailure || invariantFailure || failureReg;

  rule trackFailure;
    if (resetFailure)
      failureReg <= False;
    else if (ensureFailure || invariantFailure)
      failureReg <= True;
  endrule

  // Local timer
  Reg#(Bit#(64)) timer <- mkReg(0);
  Wire#(Bool) resetTimer <- mkDWire(False);

  rule incTimer;
    if (resetTimer)
      timer <= 0;
    else
      timer <= timer+1;
  endrule

  // 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(replayWire);
      endrule
    end

  // Signal when all random generators have initialised
  rule initRandomGens;
    randGensInitialised <= List::all(tpl_1, randomGens);
  endrule

  // Rules to check 'ensure' assertions.
  rule checkEnsure (!failureReg && List::any( \== (False) , ensureBools));
    if (verbose)
      $display("%0t: 'ensure' statement failed", timer);
  endrule

  // 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 (checkingEnabled && !failureReg && !waitWire);
        if (!b && verbose) $display("%0t: ", timer, msg);
      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 (actionsEnabled && inState[i] && !waitWire);
        if (verbose)
          $display("%0t: ", timer, actionMsgs[i]);
        actions[i];
        if (!shrinkingMode)
          logEnqWire <= True;
      endrule
      rule runActionNotPossible (actionsEnabled && inState[i] && !waitWire);
        didntFire <= True;
        if (params.showNonFire && verbose)
          $display("%0t: [did not fire] ", timer, 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], actionsEnabled && inState[s]);

      rule runStmt (actionsEnabled && inState[s] && !fsmRunning);
        if (verbose)
          $display("%0t: ", timer, stmtMsgs[i]);
        fsm.start;
        fsmRunning <= True;
        waitWire <= True;
        if (!shrinkingMode)
          logEnqWire <= True;
      endrule

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

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

  // Generate rules to modify logs
  if (params.useIterativeDeepening && params.useShrinking)
  begin

    for (Integer i = 0; i < length(logItems); i=i+1)
      begin
        let logEnq   = tpl_1(logItems[i]);
        let logRot   = tpl_2(logItems[i]);
        let logClear = tpl_3(logItems[i]);

        // Enqueue the current state into the log
        (* mutually_exclusive = "triggerEnq,triggerRot" *)
        rule triggerEnq (logEnqWire);
          logEnq;
        endrule

        // Remove the head of the log and append it to the end
        rule triggerRot (logRotWire);
          logRot;
        endrule

        // Clear the log
        rule triggerClear (logClearWire);
          logClear;
        endrule
      end

    // Also update the state and timer logs
    (* mutually_exclusive = "enqLogs,rotLogs" *)
    rule enqLogs (logEnqWire);
      stateLog.enq(state);
      timeLog.enq(timer);
    endrule

    rule rotLogs (logRotWire);
      stateLog.enq(stateLog.first); stateLog.deq;
      timeLog.enq(timeLog.first); timeLog.deq;
    endrule

    rule clearLogs (logClearWire);
      stateLog.clear;
      timeLog.clear;
    endrule
  end

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

  // Single walk of state space ===============================================

  // One long walk of the state space.
  Stmt singleWalk =
    seq
      action
        // Show ensure-failure messages?
        let _ <- List::mapM(assignReg(True), ensureShows);
      endaction

      // Initialise
      randomState.cntrl.init;
      await(randGensInitialised);
      testDone <= False;
      resetTimer <= True;
      preStmt;
      while (!testDone)
        action
          await(!waitWire);
          let nextState <- randomState.next;
          if (failureFound)
            begin
              count <= 0;
              testDone <= True;
            end
          else
            begin
              state <= nextState;
              if (state != 0 && !didntFire)
                begin
                  if (count < params.numIterations)
                    count <= count+1;
                  else
                    begin
                      count <= 0;
                      testDone <= True;
                    end
                end
            end
        endaction
      postStmt;
      if (failureFound)
        $display("FAILED: counter-example found.");
      else
        $display("OK: passed %0d iterations", params.numIterations);
    endseq;

  // Replaying and shrinking counter examples =================================

  Stmt shrink =
    seq
      // Initialise shrinker
      action
        omitNum <= 0;
        shrinkingMode <= True;
        for (Integer i=0; i < logSize; i=i+1) omitMask[i] <= False;
      endaction

      // Try to omit each element of the failing sequence, and if
      // it succeeds, undo the omission.
      while (omitNum <= counterExampleLength)
        seq
          action
            if (verbose) $display("=== Shrink attempt %0d ===", omitNum);
            // Display counter example even if verbose == False
            if (!verbose && omitNum == counterExampleLength)
              begin
                verbose <= True;
                let _ <- List::mapM(assignReg(True), ensureShows);
                $display("");
              end
          endaction

          omitMask[omitNum] <= True;
          // Reset circuit under test
          params.id.rst.assertReset();
          action
            // Initialise replay
            resetFailure <= True;
            resetTimer <= True;
          endaction

          // Test sequence starts here
          delay(1);
          preStmt;
          while (count < counterExampleLength)
            action
              await(!waitWire);
              if (timer+1 >= timeLog.first)
                begin
                  if (omitMask[count] == False)
                    begin
                      state <= stateLog.first;
                      replayWire <= True;
                    end
                  else
                    state <= 0;
                  logRotWire <= True;
                  count <= count+1;
                end
              else
                state <= 0;
            endaction
          count <= 0;
          postStmt;
          if (!failureFound)
            omitMask[omitNum] <= False;
          omitNum <= omitNum+1;
      endseq

      // Restore original settings
      action
        shrinkingMode <= False;
        verbose <= params.verbose;
        let _ <- List::mapM(assignReg(params.verbose), ensureShows);
      endaction
    endseq;

  // Iterative deepening ======================================================

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

  Stmt iterativeDeepening =
    seq
      // Initialisation
      action
        resetFailure <= True;
        iterCount <= 0;
      endaction

      // Each iteration will produce N test sequences of size 'depth'.
      // After each iteration, the depth is increased.
      currentDepth <= params.id.initialDepth;
      while (!failureFound && iterCount < params.numIterations)
        seq
          // Check that the depth is OK
          if (params.useShrinking && currentDepth >= fromInteger(logSize))
            seq
              $display("Maximum depth of %0d", logSize-1, " exceeded.");
              $display("Increase the 'logSize' parameter in BlueCheck.bsv.");
              $finish(0);
            endseq

          // Produce a test sequence of size 'currentDepth'
          testNum <= 0;
          while (!failureFound && testNum < params.id.testsPerDepth)
            seq
              // Reset the circuit under test
              params.id.rst.assertReset();

              // Initialise test
              action
                $write("=== Depth %0d, Test %0d/%0d ===%c", currentDepth,
                  testNum, params.id.testsPerDepth, verbose ? 10 : 13);
                testDone <= False;
                counterExampleLength <= currentDepth;
                logClearWire <= True;
                resetTimer <= True;
              endaction

              // Test sequence starts here
              delay(1);
              preStmt;   // Execute user-defined pre-statement
              while (!testDone)
                action
                  // This action only fires when not waiting for a
                  // user-defined statement to finish.
                  await(!waitWire);
                  let nextState <- randomState.next;
                  let actionFired = (state != 0 && !didntFire);
                  if (failureFound)
                    begin
                      // We found a counter example smaller than the depth
                      //counterExampleLength <= count;
                      counterExampleLength <= actionFired ? count : count-1;
                      count <= 0;
                      testDone <= True;
                    end
                  else
                    begin
                      // Change the state for the next clock cycle
                      state <= nextState;
                      if (actionFired)
                        begin
                          // Is this the final element of the sequence?
                          if (count < currentDepth)
                            count <= count+1;
                          else
                            begin
                              // A count of '0' disables the checker
                              count <= 0;
                              testDone <= True;
                            end
                        end
                    end
                endaction
              postStmt; // Execute user-defined post-statement
              testNum <= testNum+1;
            endseq

          currentDepth <= params.id.incDepth(currentDepth);
          iterCount <= iterCount+1;
        endseq

      // We've reached the end of iterative deepening.  Either we
      // found a failure or performed the desired number of tests.
      if (!failureFound)
        $display("OK: passed %0d test sequences",
                   params.numIterations*params.id.testsPerDepth);
      else if (params.useShrinking)
        shrink;
      else
        $display("\nFAILED: counter-example found");

    endseq;

  // Iterative deepening (with iteraction) ====================================

  Stmt iterativeDeepeningTop =
    seq
      action
        // Show ensure-failure messages?
        let _ <- List::mapM(assignReg(params.verbose), ensureShows);
      endaction

      // Initialise the random generators
      randomState.cntrl.init;
      await(randGensInitialised);

      // Loop while user demands it
      while (! doneUI)
        seq
          iterativeDeepening;
          if (params.interactive)
            action
              $display("Continue searching?\n",
                       "Press ENTER to continue or Ctrl-D to stop: ");
              int c <- $fgetc(stdin);
              if (c < 0) doneUI <= True;
            endaction
          else
            doneUI <= True;
        endseq
    endseq;

  // Result of blueCheck module
  return params.useIterativeDeepening ?
           iterativeDeepeningTop : singleWalk;
endmodule

// Default parameters for single state walk
BlueCheck_Params bcParamsSimple =
  BlueCheck_Params {
    verbose               : True
  , showNonFire           : False
  , showNoOp              : False
  , useIterativeDeepening : False
  , interactive           : False
  , useShrinking          : False
  , id                    : ?
  , numIterations         : 1000
  };

// Default parameters for iterative deepening
function BlueCheck_Params bcParamsID(MakeResetIfc rst);
  function incDepth(x) = x+1;

  ID_Params idParams =
    ID_Params {
      rst           : rst
    , initialDepth  : 20
    , testsPerDepth : 10000
    , incDepth      : incDepth
    };

  BlueCheck_Params params =
    BlueCheck_Params {
      verbose               : False
    , showNonFire           : False
    , showNoOp              : False
    , useIterativeDeepening : True
    , interactive           : True
    , useShrinking          : True
    , id                    : idParams
    , numIterations         : 1
    };

  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.2, Matt N.

// Change log
// ==========
//
// 5  Nov 2012: Version 0.1
// 21 Nov 2014: Support for iterative deepening
// 28 Nov 2014: Version 0.2, with support for shrinking

package BlueCheck;

import Randomizable  :: *;
import ModuleCollect :: *;
import StmtFSM       :: *;
import List          :: *;
import Clocks        :: *;
import FIFOF         :: *;
import ConfigReg     :: *;
import Vector        :: *;
import Assert        :: *;

// The max size of the log used for shrinking.  This is tricky to
// implement as a module parameter, hence it is a global parameter.
typedef 32 LogSize;
Integer logSize = valueOf(LogSize);

// BlueCheck module 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)
  Bool useIterativeDeepening;
  // This must contain valid data if 'useIterativeDeepening' is 'True'
  ID_Params id;

  // Attempt to shrink a counter example, if one is found
  // (This is only valid for iterative deepening)
  Bool useShrinking;

  // 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, random generators and loggers, 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, function Action gen(Bool replay)) RandomGenItem;
  Tuple2#(Fmt, Bool) InvariantItem;
  Bool EnsureItem;
  Tuple3#(Action, Action, Action) LogItem;
  Stmt PreStmtItem;
  Stmt PostStmtItem;
} 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, function Action gen(Bool replay)))
  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;

// Turn an item into a singleton statement if it is an EnsureItem.
function List#(Bool) getEnsureItem(Item item) =
  case (item) matches
    tagged EnsureItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is an LogItem.
function List#(Tuple3#(Action, Action, Action))
  getLogItem(Item item) =
  case (item) matches
    tagged LogItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is a PreStmtItem.
function List#(Stmt) getPreStmtItem(Item item) =
  case (item) matches
    tagged PreStmtItem .a: return Cons(a, Nil);
    default: return Nil;
  endcase;

// Turn an item into a singleton statement if it is a PostStmtItem.
function List#(Stmt) getPostStmtItem(Item item) =
  case (item) matches
    tagged PostStmtItem .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 (List::tail(app) matches tagged Nil)
    return List::head(app);
  else
    return (List::head(app) + fshow("(") +
             formatArgs(List::tail(app)) + fshow(")"));
endfunction

function Fmt formatArgs(List#(Fmt) args);
  if (List::tail(args) matches tagged Nil)
    return List::head(args);
  else
    return (List::head(args) + fshow(",") + formatArgs(List::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), FShow#(t));
  module [BlueCheck] eq#(List#(Fmt) app, Frequency fr
                                       , ActionValue#(t) a
                                       , ActionValue#(t) b) ();
    Wire#(Bool) success <- mkDWire(True);
    Wire#(t) aWire      <- mkDWire(?);
    Wire#(t) bWire      <- mkDWire(?);
    Fmt msg             =  fshow("Not equal: ") + fshow(aWire)
                        +  fshow(" versus ")    + fshow(bWire);

    Action executeTwoAndCheck =
      action
        t aVal <- a; aWire <= aVal;
        t bVal <- b; bWire <= bVal;
        if (aVal != bVal) success <= False;
      endaction;
      addToCollection(tagged ActionItem
        (tuple3(fr, formatApp(app), executeTwoAndCheck)));
      addToCollection(tagged InvariantItem (tuple2(msg, success)));
  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;
      FIFOF#(a) aLog <- mkUGSizedFIFOF(logSize);

      function Action genRandom(Bool replay) =
        action
          let a <- aRandom.next;
          aReg <= replay ? aLog.first : a;
        endaction;

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

      Action logEnq   = aLog.enq(aReg);
      Action logRot   = action aLog.deq; aLog.enq(aLog.first); endaction;
      Action logClear = aLog.clear;

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));
      addToCollection(tagged LogItem (tuple3(logEnq, logRot, logClear)));

      eq(List::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) ();
    Wire#(Bool) success <- mkDWire(True);
    Fmt fmt = formatApp(app) + fshow(" failed: ")
            + fshow(x) + fshow(" v ") + fshow(y);

    rule check;
      if (x != y) success <= False;
    endrule

    addToCollection(tagged InvariantItem (tuple2(fmt, success)));
  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#(Bool));
  module [BlueCheck] pr#(List#(Fmt) app,Frequency fr,ActionValue#(Bool) a) ();
    Wire#(Bool) success <- mkDWire(True);
    Fmt msg = fshow("Property failed");

    Action act =
      action
        Bool s <- a;
        if (!s) success <= False;
      endaction;
      addToCollection(tagged ActionItem (tuple3(fr, formatApp(app), act)));
      addToCollection(tagged InvariantItem (tuple2(msg, success)));
  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;
      FIFOF#(a) aLog <- mkUGSizedFIFOF(logSize);

      function Action genRandom(Bool replay) =
        action
          let a <- aRandom.next;
          aReg <= replay ? aLog.first : a;
        endaction;

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

      Action logEnq   = aLog.enq(aReg);
      Action logRot   = action aLog.deq; aLog.enq(aLog.first); endaction;
      Action logClear = aLog.clear;

      addToCollection(tagged RandomGenItem (tuple2(!init, genRandom)));
      addToCollection(tagged LogItem (tuple3(logEnq, logRot, logClear)));

      pr(List::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

// Ensure function -- for making assertions inside properties
typedef (function Action f(Bool cond)) Ensure;

module [BlueCheck] getEnsure (Ensure);
  // Create ensure function
  Wire#(Bool) ok <- mkDWire(True);
  function Action ensureFunc(Bool cond) = action ok <= cond; endaction;
  addToCollection(tagged EnsureItem ok);
  return ensureFunc;
endmodule

// Allow user to add custom pre/post statements for each test
module [BlueCheck] addPreStmt#(Stmt pre) (Empty);
  addToCollection(tagged PreStmtItem pre);
endmodule

module [BlueCheck] addPostStmt#(Stmt post) (Empty);
  addToCollection(tagged PostStmtItem post);
endmodule

// 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 = List::head(freqs);
      return (Cons(s >= fromInteger(start) && s < fromInteger(start+f),
        stateConds(s, start+f, List::tail(freqs))));
    end
endfunction

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

// Sequence a list of statements
function Stmt seqList(List#(Stmt) xs);
  if (xs matches tagged Nil) return (seq delay(1); endseq);
  else return (seq List::head(xs); seqList(List::tail(xs)); endseq);
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 concat = List::concat;
  let map    = List::map;
  let append = List::append;
  let {_, items} <- getCollection(bc);
  let actionItems    = concat(map(getActionItem, items));
  let stmtItems      = concat(map(getStmtItem, items));
  let randomGens     = concat(map(getRandomGenItem, items));
  let logItems       = concat(map(getLogItem, items));
  let ensureItems    = concat(map(getEnsureItem, items));
  let invariantBools = concat(map(getInvariantItem, items));
  let preStmt        = seqList(concat(map(getPreStmtItem, items)));
  let postStmt       = seqList(concat(map(getPostStmtItem, 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));
  ConfigReg#(State) state <- mkConfigReg(0);
  Wire#(Bool) waitWire <- mkDWire(False);
  Wire#(Bool) didntFire <- mkDWire(False);
  Reg#(Bool) testDone <- mkReg(False);
  List#(Bool) inState = stateConds(state, 1, freqs);
  Reg#(Bool) shrinkingMode <- mkReg(False);

  // When all random generators have initialised
  Reg#(Bool) randGensInitialised <- mkReg(False);

  // When count is 0, actions/statements are disabled
  ConfigReg#(Bit#(32)) count <- mkConfigReg(0);
  Bool actionsEnabled = count != 0;

  // When delayed count is 0, invariant checking is disabled
  ConfigReg#(Bit#(32)) delayedCount <- mkConfigReg(0);
  Bool checkingEnabled = delayedCount != 0;

  rule updateDelayedCount;
    delayedCount <= count;
  endrule

  // Log/replay signals
  FIFOF#(State) stateLog  <- mkSizedFIFOF(logSize);
  FIFOF#(Bit#(64)) timeLog <- mkSizedFIFOF(logSize);
  Wire#(Bool) replayWire <- mkDWire(False);
  Wire#(Bool) logEnqWire <- mkDWire(False);
  Wire#(Bool) logRotWire <- mkDWire(False);
  Wire#(Bool) logClearWire <- mkDWire(False);
  Reg#(Bit#(32)) counterExampleLength <- mkReg(0);
  Reg#(Bit#(32)) omitNum <- mkReg(0);
  Vector#(LogSize, Reg#(Bool)) omitMask <- replicateM(mkReg(False));

  // Track failures
  Reg#(Bool) failureReg    <- mkConfigReg(False);
  Wire#(Bool) resetFailure <- mkDWire(False);
  Bool ensureFailure    = List::any( \== (False), ensureItems);
  Bool invariantFailure = (waitWire || !checkingEnabled) ? False
                        : List::any( \== (False), map (tpl_2, invariantBools));
  Bool failureFound     = ensureFailure || invariantFailure || failureReg;

  rule trackFailure;
    if (resetFailure)
      failureReg <= False;
    else if (ensureFailure || invariantFailure)
      failureReg <= True;
  endrule

  // Local timer
  Reg#(Bit#(64)) timer <- mkReg(0);
  Wire#(Bool) resetTimer <- mkDWire(False);

  rule incTimer;
    if (resetTimer)
      timer <= 0;
    else
      timer <= timer+1;
  endrule

  // 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(replayWire);
      endrule
    end

  // Signal when all random generators have initialised
  rule initRandomGens;
    randGensInitialised <= List::all(tpl_1, randomGens);
  endrule

  // Rules to check 'ensure' assertions.
  rule checkEnsure (!failureReg && List::any( \== (False) , ensureItems));
    $display("%0t: 'ensure' statement failed", timer);
  endrule

  // 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 (checkingEnabled && !failureReg && !waitWire);
        if (!b) $display("%0t: ", timer, msg);
      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 (actionsEnabled && inState[i] && !waitWire);
        $display("%0t: ", timer, actionMsgs[i]);
        actions[i];
        if (!shrinkingMode)
          logEnqWire <= True;
      endrule
      rule runActionNotPossible (actionsEnabled && inState[i] && !waitWire);
        didntFire <= True;
        if (params.showNonFire)
          $display("%0t: [did not fire] ", timer, 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], actionsEnabled && inState[s]);

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

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

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

  // Generate rules to modify logs
  if (params.useIterativeDeepening && params.useShrinking)
  begin

    for (Integer i = 0; i < length(logItems); i=i+1)
      begin
        let logEnq   = tpl_1(logItems[i]);
        let logRot   = tpl_2(logItems[i]);
        let logClear = tpl_3(logItems[i]);

        // Enqueue the current state into the log
        (* mutually_exclusive = "triggerEnq,triggerRot" *)
        rule triggerEnq (logEnqWire);
          logEnq;
        endrule

        // Remove the head of the log and append it to the end
        rule triggerRot (logRotWire);
          logRot;
        endrule

        // Clear the log
        rule triggerClear (logClearWire);
          logClear;
        endrule
      end

    // Also update the state and timer logs
    (* mutually_exclusive = "enqLogs,rotLogs" *)
    rule enqLogs (logEnqWire);
      stateLog.enq(state);
      timeLog.enq(timer);
    endrule

    rule rotLogs (logRotWire);
      stateLog.enq(stateLog.first); stateLog.deq;
      timeLog.enq(timeLog.first); timeLog.deq;
    endrule

    rule clearLogs (logClearWire);
      stateLog.clear;
      timeLog.clear;
    endrule
  end

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

  // Single walk of state space ===============================================

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

  // Replaying and shrinking counter examples =================================

  Stmt shrink =
    seq
      // Initialise shrinker
      action
        omitNum <= 0;
        shrinkingMode <= True;
        for (Integer i=0; i < logSize; i=i+1) omitMask[i] <= False;
      endaction

      // Try to omit each element of the failing sequence, and if
      // it succeeds, undo the omission.
      while (omitNum <= counterExampleLength)
        seq
          $display("=== Shrink attempt %0d ===", omitNum);
          omitMask[omitNum] <= True;
          // Reset circuit under test
          params.id.rst.assertReset();
          action
            // Initialise replay
            resetFailure <= True;
            resetTimer <= True;
          endaction

          // Test sequence starts here
          delay(1);
          preStmt;
          while (count < counterExampleLength)
            action
              await(!waitWire);
              if (timer+1 >= timeLog.first)
                begin
                  if (omitMask[count] == False)
                    begin
                      state <= stateLog.first;
                      replayWire <= True;
                    end
                  else
                    state <= 0;
                  logRotWire <= True;
                  count <= count+1;
                end
              else
                state <= 0;
            endaction
          count <= 0;
          postStmt;
          if (!failureFound)
            omitMask[omitNum] <= False;
          omitNum <= omitNum+1;
      endseq
    endseq;

  // Iterative deepening ======================================================

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

  Stmt iterativeDeepening =
    seq
      // Initialise the random generators
      randomState.cntrl.init;
      await(randGensInitialised);

      // Each iteration will produce N test sequences of size 'depth'.
      // After each iteration, the depth is increased.
      currentDepth <= params.id.initialDepth;
      while (!failureFound && iterCount < params.numIterations)
        seq
          // Check that the depth is OK
          if (params.useShrinking && currentDepth >= fromInteger(logSize))
            seq
              $display("Maximum depth of %0d", logSize-1, " exceeded.");
              $display("Increase the 'logSize' parameter in BlueCheck.bsv.");
              $finish(0);
            endseq

          // Produce a test sequence of size 'currentDepth'
          testNum <= 0;
          while (!failureFound && testNum < params.id.testsPerDepth)
            seq
              // Reset the circuit under test
              params.id.rst.assertReset();

              // Initialise test
              action
                $display("=== Depth %0d, Test %0d ===", currentDepth, testNum);
                testDone <= False;
                counterExampleLength <= currentDepth;
                logClearWire <= True;
                resetTimer <= True;
              endaction

              // Test sequence starts here
              delay(1);
              preStmt;   // Execute user-defined pre-statement
              while (!testDone)
                action
                  // This action only fires when not waiting for a
                  // user-defined statement to finish.
                  await(!waitWire);
                  let nextState <- randomState.next;
                  if (failureFound)
                    begin
                      // We found a counter example smaller than the depth
                      counterExampleLength <= count;
                      count <= 0;
                      testDone <= True;
                    end
                  else
                    begin
                      // Change the state for the next clock cycle
                      state <= nextState;
                      if (state != 0 && !didntFire)
                        begin
                          // Is this the final element of the sequence?
                          if (count < currentDepth)
                            count <= count+1;
                          else
                            begin
                              // A count of '0' disables the checker
                              count <= 0;
                              testDone <= True;
                            end
                        end
                    end
                endaction
              postStmt; // Execute user-defined post-statement
              testNum <= testNum+1;
            endseq

          currentDepth <= params.id.incDepth(currentDepth);
          iterCount <= iterCount+1;
        endseq

      // We've reached the end of iterative deepening.  Either we
      // found a failure or performed the desired number of tests.
      if (!failureFound)
        $display("OK: passed %0d test sequences",
                   params.numIterations*params.id.testsPerDepth);
      else if (params.useShrinking)
        shrink;
    endseq;

  return params.useIterativeDeepening ?
           iterativeDeepening : singleWalk;
endmodule

// Default parameters for single state walk
BlueCheck_Params bcParamsSimple =
  BlueCheck_Params {
    showNonFire           : False
  , showNoOp              : False
  , useIterativeDeepening : False
  , useShrinking          : False
  , id                    : ?
  , numIterations         : 1000
  };

// Default parameters for iterative deepening
function BlueCheck_Params bcParamsID(MakeResetIfc rst);
  function incDepth(x) = x+1;

  ID_Params idParams =
    ID_Params {
      rst           : rst
    , initialDepth  : 10
    , testsPerDepth : 3000
    , incDepth      : incDepth
    };

  BlueCheck_Params params =
    BlueCheck_Params {
      showNonFire           : False
    , showNoOp              : False
    , useIterativeDeepening : True
    , useShrinking          : True
    , id                    : idParams
    , numIterations         : 5
    };

  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


Finally catch a processor bug in the SLT instruction!

import ClientServer::*;
import GetPut::*;
import Connectable::*;
import FIFO::*;
import FIFOF::*;
import SpecialFIFOs::*;
import RegFile::*;
import FShow::*;
import AvalonCommon::*;
import AvalonMaster::*;
import Cache::*;
import Instructions::*;
import Trace::*;
import RFile::*;
import Divider::*;

typedef union tagged {
    struct { Ridx     r;    Bit#(32) data;               } WbREG;
    struct { Ridx     r;    Bit#(24) addr; Bit#(2) line; } WbLB;
    struct { Ridx     r;    Bit#(24) addr; Bit#(2) line; } WbLBU;
    struct { Ridx     r;    Bit#(24) addr; Bit#(1) line; } WbLH;
    struct { Ridx     r;    Bit#(24) addr; Bit#(1) line; } WbLHU;
    struct { Ridx     r;    Bit#(24) addr;               } WbLW;
    struct { Bit#( 8) data; Bit#(24) addr; Bit#(2) line; } WbSB;
    struct { Bit#(16) data; Bit#(24) addr; Bit#(1) line; } WbSH;
    struct { Bit#(32) data; Bit#(24) addr;               } WbSW;
} WBOp deriving (Eq, Bits);

instance FShow#(WBOp);
    function Fmt fshow(WBOp op);
        case (op) matches
            tagged WbREG .s: return $format("WbREG{r:%0d,data:%h}", s.r, s.data);
            tagged WbLB  .s: return $format("WbLB {r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLBU .s: return $format("WbLBU{r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLH  .s: return $format("WbLH {r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLHU .s: return $format("WbLHU{r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLW  .s: return $format("WbLW {r:%0d,addr:%h}", s.r, s.addr);
            tagged WbSB  .s: return $format("WbSB {data:%h,addr:%h,line:%h}", s.data, s.addr, s.line);
            tagged WbSH  .s: return $format("WbSH {data:%h,addr:%h,line:%h}", s.data, s.addr, s.line);
            tagged WbSW  .s: return $format("WbSW {data:%h,addr:%h}", s.data, s.addr);
        endcase
    endfunction
endinstance

module mkProcessor#(module#(AvalonMaster#(24,32)) mkMaster,
                    function Bool ignoreCache(Bit#(24) addr),
                    Bit#(24) resetAddr, Bit#(24) irqAddr)
                   (AvalonMasterWires#(24,32));

    AvalonMaster#(24,32) masterAdapter <- mkMaster;
    Cache#(24,12,12) cache <- mkCache(ignoreCache);

    Reg  #(Bit#(24)) fetchPC <- mkReg(resetAddr);
    FIFOF#(Bit#(24)) jumpTo <- mkBypassFIFOF;
    FIFOF#(Bit#(24)) execPC <- mkPipelineFIFOF;
    FIFOF#(Bit#(32)) instFIFO <- mkBypassFIFOF;
    FIFOF#(Bit#(32)) dataFIFO <- mkBypassFIFOF;
    FIFOF#(WBOp) pendingLoad <- mkPipelineFIFOF;
    FIFOF#(WBOp) execToWB <- mkPipelineFIFOF;

    RFile rf <- mkRFile;
    Reg#(Bit#(32)) lo <- mkReg(0);
    Reg#(Bit#(32)) hi <- mkReg(0);

    Divider divider <- mkDivider;
    Reg#(Bool) dividerPending <- mkReg(False);

    Reg#(Bool) irqEnabled <- mkReg(False);
    FIFOF#(Bit#(32)) irqFIFO <- mkUGFIFOF;
    Reg#(Bit#(24)) irqReturnAddr <- mkRegU;

    Reg#(Bool) clearCache <- mkReg(False);

    mkConnection(cache.busClient.request, masterAdapter.busServer.request);
    mkConnection(masterAdapter.busServer.response, cache.busClient.response);
    mkConnection(cache.instCache.response, toPut(instFIFO));
    mkConnection(cache.dataCache.response, toPut(dataFIFO));

    rule getIrq(irqEnabled && irqFIFO.notFull);
        let irq <- masterAdapter.irqGet.get;
        irqFIFO.enq(irq);
    endrule

    rule clearTheCaches(clearCache);
        clearCache <= False;
        cache.clear;
    endrule

    rule dividerGetResult(dividerPending);
        match {.r,.q} <- divider.response.get;
        hi <= r;
        lo <= q;
        dividerPending <= False;
    endrule

    rule fetchAhead(!jumpTo.notEmpty && !clearCache);
        let pc = fetchPC;
        if(irqEnabled && irqFIFO.notEmpty)
          begin
            trace($format("[IRQ] irqReturnAddr=%h", fetchPC));
            irqReturnAddr <= fetchPC;
            irqEnabled <= False;
            pc = irqAddr;
          end
        fetchPC <= pc + 1;
        trace($format("[Fetch %h]", pc));
        cache.instCache.request.put(AvalonRequest{command: Read, addr: pc, data: ?});
        execPC.enq(pc);
    endrule

    rule fetchJump(jumpTo.notEmpty && !clearCache);
        let pc = fetchPC;
        let newpc = jumpTo.first;
        if(irqEnabled && irqFIFO.notEmpty)
          begin
            trace($format("[IRQ] [@BDS] irqReturnAddr=%h", newpc));
            irqReturnAddr <= newpc;
            irqEnabled <= False;
            newpc = irqAddr;
          end
        fetchPC <= newpc;
        trace($format("[Fetch %h] [jump %h]", pc, newpc));
        cache.instCache.request.put(AvalonRequest{command: Read, addr: pc, data: ?});
        execPC.enq(pc);
        jumpTo.deq;
    endrule

    rule exec(!pendingLoad.notEmpty && !dividerPending && !clearCache);
        Instr inst = unpack(instFIFO.first);
        let pc  = execPC.first;
        let pc1 = pc+1;
        trace($format("[Exec  %h] ", pc)+fshow(inst));
        instFIFO.deq;
        execPC.deq;

        function Bit#(32) zextSh(Sham sh) = zeroExtend(sh);

        case (inst) matches
            tagged ADD   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)+rf.rd2(s.rt)                                });
            tagged ADDI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)+signExtend(s.im)                            });
            tagged ADDIU .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)+signExtend(s.im)                            });
            tagged ADDU  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)+rf.rd2(s.rt)                                });
            tagged LUI   .s: execToWB.enq(WbREG{r:s.rt, data:{s.im,16'b0}                                             });
            tagged SUB   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)-rf.rd2(s.rt)                                });
            tagged SUBU  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)-rf.rd2(s.rt)                                });
            tagged SLL   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)<<zextSh(s.sa)                               });
            tagged SLLV  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)<<zextSh(rf.rd2(s.rs)[4:0])                  });
            tagged SRA   .s: execToWB.enq(WbREG{r:s.rd, data:signedShiftRight(rf.rd1(s.rt),zextSh(s.sa))              });
            tagged SRAV  .s: execToWB.enq(WbREG{r:s.rd, data:signedShiftRight(rf.rd1(s.rt),zextSh(rf.rd2(s.rs)[4:0])) });
            tagged SRL   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)>>zextSh(s.sa)                               });
            tagged SRLV  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)>>zextSh(rf.rd2(s.rs)[4:0])                  });
            tagged AND   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)&rf.rd2(s.rt)                                });
            tagged ANDI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)&zeroExtend(s.im)                            });
            tagged NOR   .s: execToWB.enq(WbREG{r:s.rd, data:~(rf.rd1(s.rs)|rf.rd2(s.rt))                             });
            tagged OR    .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)|rf.rd2(s.rt)                                });
            tagged ORI   .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)|zeroExtend(s.im)                            });
            tagged XOR   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)^rf.rd2(s.rt)                                });
            tagged XORI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)^zeroExtend(s.im)                            });
            tagged SLT   .s: execToWB.enq(WbREG{r:s.rd, data:zeroExtend(pack(signedLT(rf.rd1(s.rs),rf.rd2(s.rt))))    });
            tagged SLTI  .s: execToWB.enq(WbREG{r:s.rt, data:zeroExtend(pack(signedLT(rf.rd1(s.rs),signExtend(s.im))))});
            tagged SLTIU .s: execToWB.enq(WbREG{r:s.rt, data:zeroExtend(pack(         rf.rd1(s.rs)<signExtend(s.im)) )});
            tagged SLTU  .s: execToWB.enq(WbREG{r:s.rd, data:zeroExtend(pack(         rf.rd1(s.rs)<rf.rd2(s.rt)))     });
            tagged DIV   .s:
                action
                    dividerPending <= True;
                    divider.request.put(tuple3(rf.rd1(s.rs),rf.rd2(s.rt),True));
                endaction
            tagged DIVU  .s:
                action
                    dividerPending <= True;
                    divider.request.put(tuple3(rf.rd1(s.rs),rf.rd2(s.rt),False));
                endaction
            tagged MULT  .s:
                action
                    Int#(64) r1 = unpack(signExtend(rf.rd1(s.rs)));
                    Int#(64) r2 = unpack(signExtend(rf.rd2(s.rt)));
                    Bit#(64) mult = pack(r1*r2);
                    hi <= mult[63:32];
                    lo <= mult[31: 0];
                endaction
            tagged MULTU .s:
                action
                    UInt#(64) r1 = unpack(zeroExtend(rf.rd1(s.rs)));
                    UInt#(64) r2 = unpack(zeroExtend(rf.rd2(s.rt)));
                    Bit#(64) mult = pack(r1*r2);
                    hi <= mult[63:32];
                    lo <= mult[31: 0];
                endaction
            tagged MFHI  .s: execToWB.enq(WbREG{r:s.rd, data:hi});
            tagged MFLO  .s: execToWB.enq(WbREG{r:s.rd, data:lo});
            tagged BEQ   .s: if(rf.rd1(s.rs)==rf.rd2(s.rt)) jumpTo.enq(pc1 + signExtend(s.of));
            tagged BGEZ  .s: if(signedGE(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BGTZ  .s: if(signedGT(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BLEZ  .s: if(signedLE(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BLTZ  .s: if(signedLT(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BNE   .s: if(rf.rd1(s.rs)!=rf.rd2(s.rt)) jumpTo.enq(pc1 + signExtend(s.of));
            tagged J     .s: jumpTo.enq(truncate(s.tg));
            tagged JAL   .s:
                action
                    execToWB.enq(WbREG{r:31, data:zeroExtend(pc+2)<<2});
                    jumpTo.enq(truncate(s.tg));
                endaction
            tagged JALR  .s:
                action
                    execToWB.enq(WbREG{r:s.rd, data:zeroExtend(pc+2)<<2});
                    jumpTo.enq(truncate(rf.rd1(s.rs)>>2));
                endaction
            tagged JR    .s: jumpTo.enq(truncate(rf.rd1(s.rs)>>2));
            tagged LB    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLB{r:s.rt, addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged LBU   .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLBU{r:s.rt, addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged LH    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLH{r:s.rt, addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged LHU   .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLHU{r:s.rt, addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged LW    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLW{r:s.rt, addr:truncate(addr>>2)});
                endaction
            tagged SB    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSB{data:truncate(rf.rd2(s.rt)), addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged SH    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSH{data:truncate(rf.rd2(s.rt)), addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged SW    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSW{data:rf.rd2(s.rt), addr:truncate(addr>>2)});
                endaction
            tagged SYSC  .s:
                case (s.sc)
                    20'h0000: $finish();
                    20'h0001: $display("[Display] %h", rf.rd1(4));
                    20'h0002: clearCache <= True;
                    20'h0003: irqEnabled <= False;
                    20'h0004: irqEnabled <= True;
                    20'h0005: execToWB.enq(WbREG{r:4, data:(irqFIFO.notEmpty ? irqFIFO.first : 0)});
                    20'h0006: if(irqFIFO.notEmpty) begin jumpTo.enq(irqReturnAddr); irqFIFO.deq; irqEnabled <= True; end
                endcase
            tagged ILLEGAL : $display("Exec error: Invalid instruction %h at pc=%h", pack(inst), pc);
        endcase
    endrule

    rule wbLoadResult(dataFIFO.notEmpty && !clearCache);
        let wbOp = pendingLoad.first;
        let data = dataFIFO.first;
        trace($format("[wbLoadResult] [data=%h] ",data)+fshow(wbOp));
        function Bit#(8) byteLine(Bit#(32) d, Bit#(2) line);
            return (case(line)
                2'h0: d[31:24];
                2'h1: d[23:16];
                2'h2: d[15: 8];
                2'h3: d[ 7: 0];
            endcase);
        endfunction
        function Bit#(16) halfLine(Bit#(32) d, Bit#(1) line);
            return (case(line)
                1'h0: d[31:16];
                1'h1: d[15: 0];
            endcase);
        endfunction
        function Bit#(32) byteSub(Bit#(32) d, Bit#(2) line, Bit#(8) newd);
            case(line)
                2'h0: d[31:24] = newd;
                2'h1: d[23:16] = newd;
                2'h2: d[15: 8] = newd;
                2'h3: d[ 7: 0] = newd;
            endcase
            return d;
        endfunction
        function Bit#(32) halfSub(Bit#(32) d, Bit#(1) line, Bit#(16) newd);
            case(line)
                1'h0: d[31:16] = newd;
                1'h1: d[15: 0] = newd;
            endcase
            return d;
        endfunction
        case (wbOp) matches
            tagged WbREG .s: $display("WB error: wbREG shouldn't cause a pending load");
            tagged WbLB  .s: rf.wr(s.r, signExtend(byteLine(data, s.line)));
            tagged WbLBU .s: rf.wr(s.r, zeroExtend(byteLine(data, s.line)));
            tagged WbLH  .s: rf.wr(s.r, signExtend(halfLine(data, s.line)));
            tagged WbLHU .s: rf.wr(s.r, zeroExtend(halfLine(data, s.line)));
            tagged WbLW  .s: rf.wr(s.r, data);
            tagged WbSB  .s: cache.dataCache.request.put(AvalonRequest{command: Write, addr: truncate(s.addr),
                                                                       data: byteSub(data, s.line, s.data)});
            tagged WbSH  .s: cache.dataCache.request.put(AvalonRequest{command: Write, addr: truncate(s.addr),
                                                                       data: halfSub(data, s.line, s.data)});
            tagged WbSW  .s: $display("WB error: wbSW shouldn't cause a pending load");
        endcase
        dataFIFO.deq;
        pendingLoad.deq;
    endrule

    rule wbFromExec(!dataFIFO.notEmpty && !clearCache);
        let wbOp = execToWB.first;
        trace($format("[wbFromExec] ")+fshow(wbOp));
        function Action reqLoad(Bit#(24) addr) = action
            cache.dataCache.request.put(AvalonRequest{command:Read, addr:truncate(addr), data:?});
            pendingLoad.enq(wbOp);
        endaction;
        case (wbOp) matches
            tagged WbREG .s: rf.wr(s.r, s.data);
            tagged WbLB  .s: reqLoad(s.addr);
            tagged WbLBU .s: reqLoad(s.addr);
            tagged WbLH  .s: reqLoad(s.addr);
            tagged WbLHU .s: reqLoad(s.addr);
            tagged WbLW  .s: reqLoad(s.addr);
            tagged WbSB  .s: reqLoad(s.addr);
            tagged WbSH  .s: reqLoad(s.addr);
            tagged WbSW  .s:
                cache.dataCache.request.put(AvalonRequest{command:Write, addr:truncate(s.addr), data:s.data});
        endcase
        execToWB.deq;
    endrule

    return masterAdapter.masterWires;
endmodule

import ClientServer::*;
import GetPut::*;
import Connectable::*;
import FIFO::*;
import FIFOF::*;
import SpecialFIFOs::*;
import RegFile::*;
import FShow::*;
import AvalonCommon::*;
import AvalonMaster::*;
import Cache::*;
import Instructions::*;
import Trace::*;
import RFile::*;
import Divider::*;

typedef union tagged {
    struct { Ridx     r;    Bit#(32) data;               } WbREG;
    struct { Ridx     r;    Bit#(24) addr; Bit#(2) line; } WbLB;
    struct { Ridx     r;    Bit#(24) addr; Bit#(2) line; } WbLBU;
    struct { Ridx     r;    Bit#(24) addr; Bit#(1) line; } WbLH;
    struct { Ridx     r;    Bit#(24) addr; Bit#(1) line; } WbLHU;
    struct { Ridx     r;    Bit#(24) addr;               } WbLW;
    struct { Bit#( 8) data; Bit#(24) addr; Bit#(2) line; } WbSB;
    struct { Bit#(16) data; Bit#(24) addr; Bit#(1) line; } WbSH;
    struct { Bit#(32) data; Bit#(24) addr;               } WbSW;
} WBOp deriving (Eq, Bits);

instance FShow#(WBOp);
    function Fmt fshow(WBOp op);
        case (op) matches
            tagged WbREG .s: return $format("WbREG{r:%0d,data:%h}", s.r, s.data);
            tagged WbLB  .s: return $format("WbLB {r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLBU .s: return $format("WbLBU{r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLH  .s: return $format("WbLH {r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLHU .s: return $format("WbLHU{r:%0d,addr:%h,line:%h}", s.r, s.addr, s.line);
            tagged WbLW  .s: return $format("WbLW {r:%0d,addr:%h}", s.r, s.addr);
            tagged WbSB  .s: return $format("WbSB {data:%h,addr:%h,line:%h}", s.data, s.addr, s.line);
            tagged WbSH  .s: return $format("WbSH {data:%h,addr:%h,line:%h}", s.data, s.addr, s.line);
            tagged WbSW  .s: return $format("WbSW {data:%h,addr:%h}", s.data, s.addr);
        endcase
    endfunction
endinstance

module mkProcessor#(module#(AvalonMaster#(24,32)) mkMaster,
                    function Bool ignoreCache(Bit#(24) addr),
                    Bit#(24) resetAddr, Bit#(24) irqAddr)
                   (AvalonMasterWires#(24,32));

    AvalonMaster#(24,32) masterAdapter <- mkMaster;
    Cache#(24,12,12) cache <- mkCache(ignoreCache);

    Reg  #(Bit#(24)) fetchPC <- mkReg(resetAddr);
    FIFOF#(Bit#(24)) jumpTo <- mkBypassFIFOF;
    FIFOF#(Bit#(24)) execPC <- mkPipelineFIFOF;
    FIFOF#(Bit#(32)) instFIFO <- mkBypassFIFOF;
    FIFOF#(Bit#(32)) dataFIFO <- mkBypassFIFOF;
    FIFOF#(WBOp) pendingLoad <- mkPipelineFIFOF;
    FIFOF#(WBOp) execToWB <- mkPipelineFIFOF;

    RFile rf <- mkRFile;
    Reg#(Bit#(32)) lo <- mkReg(0);
    Reg#(Bit#(32)) hi <- mkReg(0);

    Divider divider <- mkDivider;
    Reg#(Bool) dividerPending <- mkReg(False);

    Reg#(Bool) irqEnabled <- mkReg(False);
    FIFOF#(Bit#(32)) irqFIFO <- mkUGFIFOF;
    Reg#(Bit#(24)) irqReturnAddr <- mkRegU;

    Reg#(Bool) clearCache <- mkReg(False);

    mkConnection(cache.busClient.request, masterAdapter.busServer.request);
    mkConnection(masterAdapter.busServer.response, cache.busClient.response);
    mkConnection(cache.instCache.response, toPut(instFIFO));
    mkConnection(cache.dataCache.response, toPut(dataFIFO));

    rule getIrq(irqEnabled && irqFIFO.notFull);
        let irq <- masterAdapter.irqGet.get;
        irqFIFO.enq(irq);
    endrule

    rule clearTheCaches(clearCache);
        clearCache <= False;
        cache.clear;
    endrule

    rule dividerGetResult(dividerPending);
        match {.r,.q} <- divider.response.get;
        hi <= r;
        lo <= q;
        dividerPending <= False;
    endrule

    rule fetchAhead(!jumpTo.notEmpty && !clearCache);
        let pc = fetchPC;
        if(irqEnabled && irqFIFO.notEmpty)
          begin
            trace($format("[IRQ] irqReturnAddr=%h", fetchPC));
            irqReturnAddr <= fetchPC;
            irqEnabled <= False;
            pc = irqAddr;
          end
        fetchPC <= pc + 1;
        trace($format("[Fetch %h]", pc));
        cache.instCache.request.put(AvalonRequest{command: Read, addr: pc, data: ?});
        execPC.enq(pc);
    endrule

    rule fetchJump(jumpTo.notEmpty && !clearCache);
        let pc = fetchPC;
        let newpc = jumpTo.first;
        if(irqEnabled && irqFIFO.notEmpty)
          begin
            trace($format("[IRQ] [@BDS] irqReturnAddr=%h", newpc));
            irqReturnAddr <= newpc;
            irqEnabled <= False;
            newpc = irqAddr;
          end
        fetchPC <= newpc;
        trace($format("[Fetch %h] [jump %h]", pc, newpc));
        cache.instCache.request.put(AvalonRequest{command: Read, addr: pc, data: ?});
        execPC.enq(pc);
        jumpTo.deq;
    endrule

    rule exec(!pendingLoad.notEmpty && !dividerPending && !clearCache);
        Instr inst = unpack(instFIFO.first);
        let pc  = execPC.first;
        let pc1 = pc+1;
        trace($format("[Exec  %h] ", pc)+fshow(inst));
        instFIFO.deq;
        execPC.deq;

        function Bit#(32) zextSh(Sham sh) = zeroExtend(sh);

        case (inst) matches
            tagged ADD   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)+rf.rd2(s.rt)                                });
            tagged ADDI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)+signExtend(s.im)                            });
            tagged ADDIU .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)+signExtend(s.im)                            });
            tagged ADDU  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)+rf.rd2(s.rt)                                });
            tagged LUI   .s: execToWB.enq(WbREG{r:s.rt, data:{s.im,16'b0}                                             });
            tagged SUB   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)-rf.rd2(s.rt)                                });
            tagged SUBU  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)-rf.rd2(s.rt)                                });
            tagged SLL   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)<<zextSh(s.sa)                               });
            tagged SLLV  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)<<zextSh(rf.rd2(s.rs)[4:0])                  });
            tagged SRA   .s: execToWB.enq(WbREG{r:s.rd, data:signedShiftRight(rf.rd1(s.rt),zextSh(s.sa))              });
            tagged SRAV  .s: execToWB.enq(WbREG{r:s.rd, data:signedShiftRight(rf.rd1(s.rt),zextSh(rf.rd2(s.rs)[4:0])) });
            tagged SRL   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)>>zextSh(s.sa)                               });
            tagged SRLV  .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rt)>>zextSh(rf.rd2(s.rs)[4:0])                  });
            tagged AND   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)&rf.rd2(s.rt)                                });
            tagged ANDI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)&zeroExtend(s.im)                            });
            tagged NOR   .s: execToWB.enq(WbREG{r:s.rd, data:~(rf.rd1(s.rs)|rf.rd2(s.rt))                             });
            tagged OR    .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)|rf.rd2(s.rt)                                });
            tagged ORI   .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)|zeroExtend(s.im)                            });
            tagged XOR   .s: execToWB.enq(WbREG{r:s.rd, data:rf.rd1(s.rs)^rf.rd2(s.rt)                                });
            tagged XORI  .s: execToWB.enq(WbREG{r:s.rt, data:rf.rd1(s.rs)^zeroExtend(s.im)                            });
            tagged SLT   .s: execToWB.enq(WbREG{r:s.rd, data:zeroExtend(pack(signedLT(rf.rd1(s.rs),rf.rd2(s.rt))))    });
            tagged SLTI  .s: execToWB.enq(WbREG{r:s.rt, data:zeroExtend(pack(signedLT(rf.rd1(s.rs),signExtend(s.im))))});
            tagged SLTIU .s: execToWB.enq(WbREG{r:s.rt, data:zeroExtend(pack(         rf.rd1(s.rs)<signExtend(s.im)) )});
            tagged SLTU  .s: execToWB.enq(WbREG{r:s.rt, data:zeroExtend(pack(         rf.rd1(s.rs)<rf.rd2(s.rt)))     });
            tagged DIV   .s:
                action
                    dividerPending <= True;
                    divider.request.put(tuple3(rf.rd1(s.rs),rf.rd2(s.rt),True));
                endaction
            tagged DIVU  .s:
                action
                    dividerPending <= True;
                    divider.request.put(tuple3(rf.rd1(s.rs),rf.rd2(s.rt),False));
                endaction
            tagged MULT  .s:
                action
                    Int#(64) r1 = unpack(signExtend(rf.rd1(s.rs)));
                    Int#(64) r2 = unpack(signExtend(rf.rd2(s.rt)));
                    Bit#(64) mult = pack(r1*r2);
                    hi <= mult[63:32];
                    lo <= mult[31: 0];
                endaction
            tagged MULTU .s:
                action
                    UInt#(64) r1 = unpack(zeroExtend(rf.rd1(s.rs)));
                    UInt#(64) r2 = unpack(zeroExtend(rf.rd2(s.rt)));
                    Bit#(64) mult = pack(r1*r2);
                    hi <= mult[63:32];
                    lo <= mult[31: 0];
                endaction
            tagged MFHI  .s: execToWB.enq(WbREG{r:s.rd, data:hi});
            tagged MFLO  .s: execToWB.enq(WbREG{r:s.rd, data:lo});
            tagged BEQ   .s: if(rf.rd1(s.rs)==rf.rd2(s.rt)) jumpTo.enq(pc1 + signExtend(s.of));
            tagged BGEZ  .s: if(signedGE(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BGTZ  .s: if(signedGT(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BLEZ  .s: if(signedLE(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BLTZ  .s: if(signedLT(rf.rd1(s.rs),0))   jumpTo.enq(pc1 + signExtend(s.of));
            tagged BNE   .s: if(rf.rd1(s.rs)!=rf.rd2(s.rt)) jumpTo.enq(pc1 + signExtend(s.of));
            tagged J     .s: jumpTo.enq(truncate(s.tg));
            tagged JAL   .s:
                action
                    execToWB.enq(WbREG{r:31, data:zeroExtend(pc+2)<<2});
                    jumpTo.enq(truncate(s.tg));
                endaction
            tagged JALR  .s:
                action
                    execToWB.enq(WbREG{r:s.rd, data:zeroExtend(pc+2)<<2});
                    jumpTo.enq(truncate(rf.rd1(s.rs)>>2));
                endaction
            tagged JR    .s: jumpTo.enq(truncate(rf.rd1(s.rs)>>2));
            tagged LB    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLB{r:s.rt, addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged LBU   .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLBU{r:s.rt, addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged LH    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLH{r:s.rt, addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged LHU   .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLHU{r:s.rt, addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged LW    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbLW{r:s.rt, addr:truncate(addr>>2)});
                endaction
            tagged SB    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSB{data:truncate(rf.rd2(s.rt)), addr:truncate(addr>>2), line:addr[1:0]});
                endaction
            tagged SH    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSH{data:truncate(rf.rd2(s.rt)), addr:truncate(addr>>2), line:addr[1]});
                endaction
            tagged SW    .s:
                action
                    Bit#(32) addr = rf.rd1(s.rb)+signExtend(s.of);
                    execToWB.enq(WbSW{data:rf.rd2(s.rt), addr:truncate(addr>>2)});
                endaction
            tagged SYSC  .s:
                case (s.sc)
                    20'h0000: $finish();
                    20'h0001: $display("[Display] %h", rf.rd1(4));
                    20'h0002: clearCache <= True;
                    20'h0003: irqEnabled <= False;
                    20'h0004: irqEnabled <= True;
                    20'h0005: execToWB.enq(WbREG{r:4, data:(irqFIFO.notEmpty ? irqFIFO.first : 0)});
                    20'h0006: if(irqFIFO.notEmpty) begin jumpTo.enq(irqReturnAddr); irqFIFO.deq; irqEnabled <= True; end
                endcase
            tagged ILLEGAL : $display("Exec error: Invalid instruction %h at pc=%h", pack(inst), pc);
        endcase
    endrule

    rule wbLoadResult(dataFIFO.notEmpty && !clearCache);
        let wbOp = pendingLoad.first;
        let data = dataFIFO.first;
        trace($format("[wbLoadResult] [data=%h] ",data)+fshow(wbOp));
        function Bit#(8) byteLine(Bit#(32) d, Bit#(2) line);
            return (case(line)
                2'h0: d[31:24];
                2'h1: d[23:16];
                2'h2: d[15: 8];
                2'h3: d[ 7: 0];
            endcase);
        endfunction
        function Bit#(16) halfLine(Bit#(32) d, Bit#(1) line);
            return (case(line)
                1'h0: d[31:16];
                1'h1: d[15: 0];
            endcase);
        endfunction
        function Bit#(32) byteSub(Bit#(32) d, Bit#(2) line, Bit#(8) newd);
            case(line)
                2'h0: d[31:24] = newd;
                2'h1: d[23:16] = newd;
                2'h2: d[15: 8] = newd;
                2'h3: d[ 7: 0] = newd;
            endcase
            return d;
        endfunction
        function Bit#(32) halfSub(Bit#(32) d, Bit#(1) line, Bit#(16) newd);
            case(line)
                1'h0: d[31:16] = newd;
                1'h1: d[15: 0] = newd;
            endcase
            return d;
        endfunction
        case (wbOp) matches
            tagged WbREG .s: $display("WB error: wbREG shouldn't cause a pending load");
            tagged WbLB  .s: rf.wr(s.r, signExtend(byteLine(data, s.line)));
            tagged WbLBU .s: rf.wr(s.r, zeroExtend(byteLine(data, s.line)));
            tagged WbLH  .s: rf.wr(s.r, signExtend(halfLine(data, s.line)));
            tagged WbLHU .s: rf.wr(s.r, zeroExtend(halfLine(data, s.line)));
            tagged WbLW  .s: rf.wr(s.r, data);
            tagged WbSB  .s: cache.dataCache.request.put(AvalonRequest{command: Write, addr: truncate(s.addr),
                                                                       data: byteSub(data, s.line, s.data)});
            tagged WbSH  .s: cache.dataCache.request.put(AvalonRequest{command: Write, addr: truncate(s.addr),
                                                                       data: halfSub(data, s.line, s.data)});
            tagged WbSW  .s: $display("WB error: wbSW shouldn't cause a pending load");
        endcase
        dataFIFO.deq;
        pendingLoad.deq;
    endrule

    rule wbFromExec(!dataFIFO.notEmpty && !clearCache);
        let wbOp = execToWB.first;
        trace($format("[wbFromExec] ")+fshow(wbOp));
        function Action reqLoad(Bit#(24) addr) = action
            cache.dataCache.request.put(AvalonRequest{command:Read, addr:truncate(addr), data:?});
            pendingLoad.enq(wbOp);
        endaction;
        case (wbOp) matches
            tagged WbREG .s: rf.wr(s.r, s.data);
            tagged WbLB  .s: reqLoad(s.addr);
            tagged WbLBU .s: reqLoad(s.addr);
            tagged WbLH  .s: reqLoad(s.addr);
            tagged WbLHU .s: reqLoad(s.addr);
            tagged WbLW  .s: reqLoad(s.addr);
            tagged WbSB  .s: reqLoad(s.addr);
            tagged WbSH  .s: reqLoad(s.addr);
            tagged WbSW  .s:
                cache.dataCache.request.put(AvalonRequest{command:Write, addr:truncate(s.addr), data:s.data});
        endcase
        execToWB.deq;
    endrule

    return masterAdapter.masterWires;
endmodule


fix variable names, return FSM interface method by method

// Copyright (c) 2014 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 StmtFSM::*;
import BRAM::*;

module mkHirschB#(BRAMServer#(Bit#(strIndexWidth), Bit#(8)) strA, BRAMServer#(Bit#(strIndexWidth), Bit#(8)) strB, BRAMServer#(Bit#(lIndexWidth), Bit#(16)) matL)(FSM)
         provisos(Add#(0, 7, strIndexWidth),
	       Add#(0, 14, lIndexWidth));

    Reg#(Bit#(7)) aLenReg <- mkReg(0);
  Reg#(Bit#(7)) bLenReg <- mkReg(0);
  Reg#(Bit#(14)) rLenReg <- mkReg(0);
  Reg#(Bit#(7)) ii <- mkReg(0);
  Reg#(Bit#(7)) jj <- mkReg(0);
   Reg#(Bit#(8)) aData <- mkReg(0);
   Reg#(Bit#(8)) bData <- mkReg(0);
   Reg#(Bit#(16)) k1jm1 <- mkReg(0);
  Reg#(Bit#(16)) k0j <- mkReg(0);

  Stmt hirschB =
   seq
      /* initialize two rows of temporary storage */
      for (jj <= 0; jj < aLenReg; jj <= jj + 1)
	 seq
	    matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: 0});
	    matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {1,jj}, datain: 0});
	 endseq
      /* Loop through string a */
      for (ii <= 1; ii <= aLenReg; ii <= ii + 1)
	 seq
	    /* Copy L[1] to L[0].  could pingpong instead, or unroll loop */
	    for (jj <= 0; jj <= bLenReg; jj <= jj + 1)
	       seq
		  matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {0,jj}, datain: 0});
		  action
		     let ta <- matL.response.get();
		     matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {1,jj}, datain: ta});
		  endaction
	       endseq
	    /* Loop through string B */
	    for (jj <= 0; jj <= bLenReg; jj <= jj + 1)
	       seq
		  /* Read a[i] and b[j] */
		  strA.request.put(BRAMRequest{write: False, responseOnWrite: False, address: ii-1, datain: 0});
		  strB.request.put(BRAMRequest{write: False, responseOnWrite: False, address: jj-1, datain: 0});
		  action
		     let ta <- strA.response.get();
		     let tb <- strB.response.get();
		     aData <= ta;
		     bData <= tb;
		  endaction
		  if (aData == bData)
		     seq
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {1,jj-1}, datain: 0});
			action
			   let ta <- matL.response.get();
			   matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: ta + 1});
			endaction
		     endseq
		  else
		     seq
			/* read K[0][j] and K[1][j-1] */
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {1,jj}, datain: 0});
			action
			   let ta <- matL.response.get();
			   k0j <= ta;
			endaction
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {0,jj-1}, datain: 0});
			action
			   let ta <- matL.response.get();
			   k1jm1 <= ta;
			endaction
			matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: max(k0j,k1jm1)});
		     endseq
		  endseq
	 endseq
   endseq;

   Stmt hirschC =
   seq

   endseq;

   FSM hB <- mkFSM(hirschB);

   method Action start = hB.start;
   method Action waitTillDone = hB.waitTillDone;
   method Bool done = hB.done;
   method Action abort = hB.abort;
endmodule

// Copyright (c) 2014 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 StmtFSM::*;
import BRAM::*;

module mkHirschA#(BRAMServer#(Bit#(strIndexWidth), Bit#(8)) strA, BRAMServer#(Bit#(strIndexWidth), Bit#(8)) strB, BRAMServer#(Bit#(lIndexWidth), Bit#(16)) matL)(FSM);

    Reg#(Bit#(7)) aLenReg <- mkReg(0);
  Reg#(Bit#(7)) bLenReg <- mkReg(0);
  Reg#(Bit#(14)) rLenReg <- mkReg(0);
  Reg#(Bit#(7)) ii <- mkReg(0);
  Reg#(Bit#(7)) jj <- mkReg(0);
   Reg#(Bit#(8)) aData <- mkReg(0);
   Reg#(Bit#(8)) bData <- mkReg(0);
   Reg#(Bit#(16)) k0jm1 <- mkReg(0);
  Reg#(Bit#(16)) k1j <- mkReg(0);

  Stmt hirschB =
   seq
      /* initialize two rows of temporary storage */
      for (jj <= 0; jj < aLenReg; jj <= jj + 1)
	 seq
	    matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: 0});
	    matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {1,jj}, datain: 0});
	 endseq
      /* Loop through string a */
      for (ii <= 1; ii <= aLenReg; ii <= ii + 1)
	 seq
	    /* Copy L[1] to L[0].  could pingpong instead, or unroll loop */
	    for (jj <= 0; jj <= bLenReg; jj <= jj + 1)
	       seq
		  matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {0,jj}, datain: 0});
		  action
		     let ta <- matL.response.get();
		     matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {1,jj}, datain: ta});
		  endaction
	       endseq
	    /* Loop through string B */
	    for (jj <= 0; jj <= bLenReg; jj <= jj + 1)
	       seq
		  /* Read a[i] and b[j] */
		  strA.request.put(BRAMRequest{write: False, responseOnWrite: False, address: ii-1, datain: 0});
		  strB.request.put(BRAMRequest{write: False, responseOnWrite: False, address: jj-1, datain: 0});
		  action
		     let ta <- strA.response.get();
		     let tb <- strB.response.get();
		     aData <= ta;
		     bData <= tb;
		  endaction
		  if (aData == bData)
		     seq
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {1,jj-1}, datain: 0});
			action
			   let ta <- matL.response.get();
			   matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: ta + 1});
			endaction
		     endseq
		  else
		     seq
			/* read K[0][j] and K[1][j-1] */
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {1,jj}, datain: 0});
			action
			   let ta <- matL.response.get();
			   k0j <= ta;
			endaction
			matL.request.put(BRAMRequest{write: False, responseOnWrite: False, address: {0,jj-1}, datain: 0});
			action
			   let ta <- matL.response.get();
			   k1jm1 <= ta;
			endaction
			matL.request.put(BRAMRequest{write: True, responseOnWrite: False, address: {0,jj}, datain: max(k0j,k1jm1)});
		     endseq
		  endseq
	 endseq
   endseq;

   Stmt hirschC =
   seq

   endseq;

   mkFSM(hirschB);
endmodule