Computer Laboratory

Bluepsec Examples

Avalon Master and Slave Interfaces

Overview

Altera's SOPC Builder system allows rapid design of systems-on-FPGA, including processors, interface devices, etc. Components are hooked together using the Avalon interconnect. This library (Avalon2ClientServer) provides Avalon master and slave interfaces for single memory accesses (not bursts). An example bridge design is also presented.

The AvalonFIFOs example provides memory mapped communication channels between multiple processors. This code could probably do with a little tidying, but the design as it stands is robust (we're using it in a research project).


Avalon2ClientServer (Master and Slave Interfaces)

/*****************************************************************************
 Avalon2ClientServer
 ===================
 
 Provides Avalon (Altera's switched bus standard) slave and master interfaces
 to Bluespec Client and Server interfaces
 *****************************************************************************/


package Avalon2ClientServer;

import FIFO::*;
import FIFOF::*;
import FIFOLevel::*;
import GetPut::*;
import ClientServer::*;
import Connectable::*;

// Type for avalon bus data
typedef UInt#(32) AvalonWordT;
typedef Maybe#(AvalonWordT) ReturnedDataT;

// Memory access type.  Note that MemNull used as part of arbiterlock release message.
typedef enum { MemRead, MemWrite, MemNull } MemAccessT deriving(Bits,Eq);

// Structure for memory requests
typedef struct {
   MemAccessT   rw;
   UInt#(word_address_width)  addr; // word address
   AvalonWordT  data;
   Bool arbiterlock;
   } MemAccessPacketT#(numeric type word_address_width) deriving(Bits,Eq);



/*****************************************************************************
   Avalon slave interface to Bluepsec Client interface
   ===================================================
   Simon Moore, September 2009
 *****************************************************************************/


// Avalon Slave Interface
// notes:
//  - all methods are ready and enabled
//  - names are chosen to match what SOPC builder expects for variable names
//    in the Verilog code - don't change!
(* always_ready, always_enabled *)
interface AvalonSlaveIfc#(numeric type word_address_width);
   method Action s0(UInt#(word_address_width) address, AvalonWordT writedata,
		    Bool write, Bool read, Bool arbiterlock); //, Bool resetrequest);
   method AvalonWordT s0_readdata;
   method Bool s0_waitrequest;
endinterface


interface AvalonSlave2ClientIfc#(numeric type word_address_width);
   interface AvalonSlaveIfc#(word_address_width) avs;
   interface Client#(MemAccessPacketT#(word_address_width),ReturnedDataT) client;
//(* always_read, always_enabled *)  method Bool reset_from_bus;
endinterface


module mkAvalonSlave2Client(AvalonSlave2ClientIfc#(word_address_width))
   provisos(Max#(word_address_width,29,29));

   // bypass wires for incoming Avalon slave signals
   Wire#(UInt#(word_address_width)) address_w   <- mkBypassWire;
   Wire#(AvalonWordT) writedata_w          <- mkBypassWire;
   Wire#(Bool)        read_w               <- mkBypassWire;
   Wire#(Bool)        write_w              <- mkBypassWire;
   Wire#(Bool)        arbiterlock_w        <- mkBypassWire;
   Reg# (Bool)        prev_arbiterlock     <- mkReg(False);
//   Wire#(Bool)        resetrequest_w       <- mkBypassWire;
   
   // bypass wire for Avalon wait signal + pulsewires to clear
   Wire#(Bool)        avalonwait           <- mkBypassWire;
   PulseWire          avalonwait_end_read  <- mkPulseWire;
   PulseWire          avalonwait_end_write <- mkPulseWire;

   // DWire for read data returned to Avalon slave bus
   Wire#(AvalonWordT) datareturned <- mkDWire(32'hdeaddead);

   // reg indicating that the Avalon request is being processed and further
   // requests should be ignored until the avalonwait signal has been released
   // (gone low)
   Reg#(Bool) ignore_further_requests <- mkReg(False);

   // FIFO holding requests received from Avalon slave bus sent out via
   // the client request interface
   FIFOF#(MemAccessPacketT#(word_address_width)) outbuf <- mkFIFOF;
   
   // provide the avalonwait signal
   // note: this must appear within the same clock cycle that a read or write
   //       is initiated
   (* no_implicit_conditions *)
   rule wire_up_avalonwait;
      avalonwait <= (read_w && !avalonwait_end_read) || (write_w && !avalonwait_end_write);
   endrule
   
   rule arbiterlock_history;
      prev_arbiterlock <= arbiterlock_w;
   endrule
   
   rule handle_end_arbiterlock (prev_arbiterlock && !arbiterlock_w && !read_w && !write_w);
      outbuf.enq(MemAccessPacketT{
	 rw:   MemNull,     // send MemNull to clear arbiter lock
	 addr: address_w,   // don't care what the address and data are but keep...
	 data: writedata_w, // ...consistent with next rule to simplify implementation
	 arbiterlock: arbiterlock_w});
   endrule
   
   // if this is a new Avalon slave bus request then enqueue
   // note: if outbuf FIFO is full, Avalon slave forced to wait
   rule hanlde_bus_requests ((read_w || write_w) && !ignore_further_requests);
      outbuf.enq(MemAccessPacketT{
	 rw: read_w ? MemRead : MemWrite,
	 addr: address_w,
	 data: writedata_w, // N.B. "data" is undefined for reads
	 arbiterlock: arbiterlock_w});
      ignore_further_requests <= read_w;
      // release avalonwait for writes since the request has been enqueued
      if(write_w) avalonwait_end_write.send;
   endrule
   
   // once avalonwait has gone low, get ready to respond to next request
   // from the Avalon bus
   rule cancel_ingore_further_requests(!avalonwait && ignore_further_requests);
      ignore_further_requests <= False;
   endrule
   
   // Avalon slave interface - just wiring
   interface AvalonSlaveIfc avs;
      method Action s0(address, writedata, write, read, arbiterlock); //, resetrequest);
	 address_w     <= address;
	 writedata_w   <= writedata;
	 write_w       <= write;
	 read_w        <= read;
	 arbiterlock_w <= arbiterlock;
//	 resetrequest_w <= resetrequest;
      endmethod
      
      method s0_readdata;
	 return datareturned;
      endmethod
      
      method s0_waitrequest;
	 return avalonwait;
      endmethod
      
   endinterface

   // client interface   
   interface Client client;
      interface request = toGet(outbuf);
      
      interface Put response;
	 method Action put(d);
	    // note: respond to data read
	    // currently if d is Invalid then ignored but it could be used
	    // to do a avalonwait_end_write.send if it was required the
	    // clients waited on writes until the writes had completed
	    if(isValid(d))
	       begin
		  // note duality of DWire for data and PulseWire for
		  //  associated signal
		  datareturned <= fromMaybe(32'hdeaddead,d);
		  avalonwait_end_read.send;
	       end
	 endmethod
      endinterface
   endinterface

//   method Bool reset_from_bus;
//      return resetrequest_w;
//   endmethod
endmodule



/*****************************************************************************
   Bluespec Server interface to Avalon master interface
   ====================================================
   Simon Moore, October 2009
 *****************************************************************************/


// Avalon Master Interface
// notes:
//  - all methods are ready and enabled
//  - names are chosen to match what SOPC builder expects for variable names
//    in the Verilog code - don't change!
//  - initally a long latency (too much buffering?) but (hopfully) robust
//    design remove some latch stages in the future

(* always_ready, always_enabled *)
interface AvalonMasterIfc#(numeric type word_address_width);
   method Action m0(AvalonWordT readdata, Bool waitrequest);
   method AvalonWordT m0_writedata;
   method UInt#(TAdd#(2,word_address_width)) m0_address;
   method Bool m0_read;
   method Bool m0_write;
   method Bool m0_arbiterlock;
endinterface


interface Server2AvalonMasterIfc#(numeric type word_address_width);
   interface AvalonMasterIfc#(word_address_width) avm;
   interface Server#(MemAccessPacketT#(word_address_width),ReturnedDataT) server;
endinterface


module mkServer2AvalonMaster(Server2AvalonMasterIfc#(word_address_width))
   provisos(Max#(word_address_width,29,29),
	    Add#(word_address_width, 2, TAdd#(2, word_address_width)));
   // bypass wires for incoming Avalon master signals
   // N.B. avalon master address is a byte address, so need to add 2 bits
   Reg#(UInt#(word_address_width))  address_r       <- mkReg(0);
   Reg#(AvalonWordT)  writedata_r     <- mkReg(0);
   Reg#(Bool)         read_r          <- mkReg(False);
   Reg#(Bool)         write_r         <- mkReg(False);
   Reg#(Bool)         arbiterlock_r   <- mkReg(False);
   PulseWire          signal_read     <- mkPulseWire;
   PulseWire          signal_write    <- mkPulseWire;
   Wire#(Bool)        avalonwait      <- mkBypassWire;
   Wire#(AvalonWordT) avalonreaddata  <- mkBypassWire;
   
   // buffer data returned
   // TODO: could this buffer be removed by not initiating the transaction
   // until the returndata get operation was active, then do the memory 
   // transaction and return the value to the get without buffering?
   //  - possibly not if the interface is fully pipelined because there
   //    can be several transactions ongoing (several addresses issued, etc.)
   //    before data comes back
   
   // FIFO of length 4 which is:
   // Unguarded enq since it it guarded by the bus transaction initiation
   // Guarded deq
   // Unguarded count so isLessThan will not block
   FIFOLevelIfc#(ReturnedDataT,4) datareturnbuf <- mkGFIFOLevel(True,False,True);
   FIFO#(MemAccessT) pending_acks <- mkFIFO;
   
   let write_ack = write_r && !read_r && !avalonwait;
   let read_ack  = !write_r && read_r && !avalonwait;
   
   rule buffer_data_read (read_ack && (pending_acks.first==MemRead));
      datareturnbuf.enq(tagged Valid avalonreaddata);
      $display("   %05t: Avalon2ClientServer returning data",$time);
      pending_acks.deq;
   endrule
   
   rule signal_data_write (write_ack && (pending_acks.first==MemWrite));
      datareturnbuf.enq(tagged Invalid); // signal write has happened
      pending_acks.deq;
   endrule

   rule signal_mem_null (pending_acks.first==MemNull);
      datareturnbuf.enq(tagged Invalid); // signal null has happened
      pending_acks.deq;
   endrule

   (* no_implicit_conditions *)
   rule do_read_reg;
      if(signal_read) read_r <= True;
      else if(!avalonwait) read_r <= False;
   endrule
   
   (* no_implicit_conditions *)
   rule do_write_reg;
      if(signal_write) write_r <= True;
      else if(!avalonwait) write_r <= False;
   endrule
   
   // Avalon master interface - just wiring
   interface AvalonMasterIfc avm;
      method Action m0(readdata, waitrequest);
	 avalonreaddata <= readdata;
	 avalonwait <= waitrequest;
      endmethod
      
      method m0_writedata;   return writedata_r;    endmethod
      method m0_address;     return unpack({pack(address_r),2'b00});   endmethod
      method m0_read;        return read_r;         endmethod
      method m0_write;       return write_r;        endmethod
      method m0_arbiterlock; return arbiterlock_r;  endmethod
   endinterface

   // server interface   
   interface Server server;
      interface response = toGet(datareturnbuf);
      
      interface Put request;
	 method Action put(packet) if (!avalonwait && datareturnbuf.isLessThan(2));
	    address_r     <= packet.addr;
	    writedata_r   <= packet.data;
	    arbiterlock_r <= packet.arbiterlock;
	    pending_acks.enq(packet.rw);
	    case(packet.rw)
	       MemRead:  signal_read.send();
	       MemWrite: signal_write.send();
	    endcase
	 endmethod
      endinterface
   endinterface

endmodule



/*****************************************************************************
   Bluespec Server interface to Avalon master PIPELINED interface
   ==============================================================
   Simon Moore, October 2009
 *****************************************************************************/


// Avalon Master Interface - pipelined version
//  - partially working - really need "flush" signal
// notes:
//  - all methods are ready and enabled
//  - names are chosen to match what SOPC builder expects for variable names
//    in the Verilog code - don't change!
//  - initally a long latency (too much buffering?) but (hopfully) robust
//    design remove some latch stages in the future

(* always_ready, always_enabled *)
interface AvalonPipelinedMasterIfc#(numeric type word_address_width);
   method Action m0(AvalonWordT readdata, Bool readdatavalid, Bool waitrequest);
   method AvalonWordT m0_writedata;
   method UInt#(TAdd#(2,word_address_width)) m0_address;
   method Bool m0_read;
   method Bool m0_write;
   method Bool m0_arbiterlock;
endinterface


interface Server2AvalonPipelinedMasterIfc#(numeric type word_address_width);
   interface AvalonPipelinedMasterIfc#(word_address_width) avm;
   interface Server#(MemAccessPacketT#(word_address_width),ReturnedDataT) server;
endinterface


module mkServer2AvalonPipelinedMaster(Server2AvalonPipelinedMasterIfc#(word_address_width))
   provisos(Max#(word_address_width,29,29),
	    Add#(word_address_width, 2, TAdd#(2, word_address_width)));
   // bypass wires for incoming Avalon master signals
   // N.B. avalon master address is a byte address, so need to add 2 bits
   Reg#(UInt#(word_address_width))  address_r       <- mkReg(0);
   Reg#(AvalonWordT)  writedata_r     <- mkReg(0);
   Reg#(Bool)         read_r          <- mkReg(False);
   Reg#(Bool)         write_r         <- mkReg(False);
   Reg#(Bool)         arbiterlock_r   <- mkReg(False);
   PulseWire          signal_read     <- mkPulseWire;
   PulseWire          signal_write    <- mkPulseWire;
   Wire#(Bool)        avalonwait      <- mkBypassWire;
   Wire#(Bool)        avalonreadvalid <- mkBypassWire;
   Wire#(AvalonWordT) avalonreaddata  <- mkBypassWire;
   
   // buffer data returned
   // TODO: could this buffer be removed by not initiating the transaction
   // until the returndata get operation was active, then do the memory 
   // transaction and return the value to the get without buffering?
   //  - possibly not if the interface is fully pipelined because there
   //    can be several transactions ongoing (several addresses issued, etc.)
   //    before data comes back
   
   // FIFO of length 4 which is:
   // Unguarded enq since it it guarded by the bus transaction initiation
   // Guarded deq
   // Unguarded count so isLessThan will not block
   FIFOLevelIfc#(ReturnedDataT,4) datareturnbuf <- mkGFIFOLevel(True,False,True);
   FIFO#(MemAccessT) pending_acks <- mkSizedFIFO(4);
   FIFO#(MemAccessT) pending_write_acks <- mkSizedFIFO(4);
   
   let write_ack = write_r && !read_r && !avalonwait;
   
   rule buffer_data_read (avalonreadvalid && (pending_acks.first==MemRead));
      datareturnbuf.enq(tagged Valid avalonreaddata);
      $display("   %05t: Avalon2ClientServer returning data",$time);
      pending_acks.deq;
   endrule
   
   rule data_read_error (avalonreadvalid && (pending_acks.first!=MemRead));
      $display("ERROR: Server2AvalonPipelinedMaster - read returned when expeting a write or null ack");
   endrule
   
   rule buffer_data_write_during_readvalid (avalonreadvalid && write_ack);
      pending_write_acks.enq(MemWrite);
   endrule
   
   rule signal_data_write (!avalonreadvalid && write_ack && (pending_acks.first==MemWrite));
      datareturnbuf.enq(tagged Invalid); // signal write has happened
      pending_acks.deq;
   endrule

   rule signal_mem_null (pending_acks.first==MemNull);
      datareturnbuf.enq(tagged Invalid); // signal null has happened
      pending_acks.deq;
   endrule

   rule resolve_pending_write_acks (!avalonreadvalid && !write_ack && (pending_acks.first==MemWrite));
      pending_write_acks.deq; // N.B. only fires if this dequeue can happen
      datareturnbuf.enq(tagged Invalid);
      pending_acks.deq;
   endrule
   
   (* no_implicit_conditions *)
   rule do_read_reg;
      if(signal_read) read_r <= True;
      else if(!avalonwait) read_r <= False;
   endrule
   
   (* no_implicit_conditions *)
   rule do_write_reg;
      if(signal_write) write_r <= True;
      else if(!avalonwait) write_r <= False;
   endrule
   
   // Avalon master interface - just wiring
   interface AvalonPipelinedMasterIfc avm;
      method Action m0(readdata, readdatavalid, waitrequest);
	 avalonreaddata <= readdata;
	 avalonreadvalid <= readdatavalid;
	 avalonwait <= waitrequest;
      endmethod
      
      method m0_writedata;   return writedata_r;    endmethod
      method m0_address;     return unpack({pack(address_r),2'b00});   endmethod
      method m0_read;        return read_r;         endmethod
      method m0_write;       return write_r;        endmethod
      method m0_arbiterlock; return arbiterlock_r;  endmethod
   endinterface

   // server interface   
   interface Server server;
      interface response = toGet(datareturnbuf);
      
      interface Put request;
	 method Action put(packet) if (!avalonwait && datareturnbuf.isLessThan(2));
	    address_r     <= packet.addr;
	    writedata_r   <= packet.data;
	    arbiterlock_r <= packet.arbiterlock;
	    pending_acks.enq(packet.rw);
	    case(packet.rw)
	       MemRead:  signal_read.send();
	       MemWrite: signal_write.send();
	    endcase
	 endmethod
      endinterface
   endinterface

endmodule



/*****************************************************************************
 Avalon Bridge
 N.B. as usual the names on interfaces are chosen to match what SOPC
 builder expects, so don't change!
 ****************************************************************************/

interface AvalonBridgeIfc#(numeric type word_address_width);
   interface AvalonSlaveIfc#(word_address_width) avs;
   interface AvalonMasterIfc#(word_address_width) avm;
endinterface
   

module mkAvalonBridge(AvalonBridgeIfc#(word_address_width))
   provisos(Max#(word_address_width,29,29),
	    Add#(word_address_width, 2, TAdd#(2, word_address_width)));

   AvalonSlave2ClientIfc#(word_address_width) client <- mkAvalonSlave2Client;
   Server2AvalonMasterIfc#(word_address_width) server <- mkServer2AvalonMaster;
   
   mkConnection(client.client,server.server);
   
   interface avs = client.avs;
   interface avm = server.avm;
endmodule		      


endpackage

Link to the Avalon2ClientServer.bsv source

AvalonBridge Example

This provides a bridge between master and slave ports whilst introducing one cycle of latency.

/******************************************************************************
 
 Avalon Bridge Example
 ====================
 Simon Moore
 
 Version 3 - October 2009
 
 Provides a simple Avalon bridge (no bursts) for Altera's NIOS SOPC system
 
 Notes:
 * should import directly into SOPC builder with default timings
 * names for parameters match up with the default names that
   Altera's SOPC builder tool expects
   - Reference:
     SOPC builder, Chapter 6, table 6-1 (for default names)
     Avalon interface specifications (for signals)
  
******************************************************************************/

package AvalonBridgeExample;

import Clocks::*;
import FIFOF::*;
import Avalon2ClientServer::*;
import ClientServer::*;
import GetPut::*;

(* synthesize,
 reset_prefix = "csi_clockreset_reset_n",
 clock_prefix = "csi_clockreset_clk" *)
(* doc="************** Simon's comments for Verilog code: **************" *)
(* doc="Top level module for Avalon Bridge Example" *)
(* doc="Port names should align with SOPC builder's new device requirements" *)
(* doc="Need to add the $BLUESPECDIR/Verilog directory to the Libraries in Quartus" *)
module mkAvalonBridgeExample(AvalonBridgeIfc#(8));
   
   // make bridge with 8-bit word address
   AvalonBridgeIfc#(8) bridge <- mkAvalonBridge;
   
   // N.B. names match what SOPC builder expects
   interface avs = bridge.avs;
   interface avm = bridge.avm;
endmodule


endpackage

Link to the AvalonBridgeExample.bsv source

AvalonTimer Example

This provides a simple timer (clock) that can be started, stopped, set and read over the Avalon interconnect. Code for a NIOS II processor is also provided.

package AvalonTimer;

import GetPut::*;
import ClientServer::*;
import Avalon2ClientServer::*;

// word address width
`define addr_width 2

(* always_ready, always_enabled *)
interface AvalonTimerIfc;
   interface AvalonSlaveIfc#(`addr_width) avs; // AvalonSlave physical interface
   method UInt#(26) coe_leds;  // exported signals (coe=Conduit Output Export)
endinterface


// tell Bluespec to produce a synthesizable design
// and set clock and reset names to what SOPC builder expects
(* synthesize,
   reset_prefix = "csi_clockreset_reset_n",
   clock_prefix = "csi_clockreset_clk" *)
module mkAvalonTimer(AvalonTimerIfc);
   
   AvalonSlave2ClientIfc#(`addr_width) slave <- mkAvalonSlave2Client;
   Reg#(UInt#(32)) timer <- mkReg(0);
   Reg#(Bool) run_timer <- mkReg(False);
   Wire#(Maybe#(UInt#(32))) set_timer <- mkDWire(tagged Invalid);
   PulseWire timer_stop <- mkPulseWire;
   PulseWire timer_start <- mkPulseWire;
   
   rule handle_avalon_requests;
      let req <- slave.client.request.get();
      ReturnedDataT rtn = tagged Invalid;
      case(tuple2(req.addr, req.rw))
	 tuple2(0, MemWrite) : set_timer <= tagged Valid req.data;
	 tuple2(0, MemRead)  : rtn = tagged Valid timer;
	 tuple2(1, MemWrite) : if(req.data==0) timer_stop.send; else timer_start.send;
	 tuple2(1, MemRead)  : begin
				  rtn = tagged Valid timer;
				  timer_stop.send();
			       end
      endcase
      slave.client.response.put(rtn);
   endrule

   (* no_implicit_conditions *)   
   rule handle_timer (True);
      let running = !timer_stop && (timer_start || run_timer);
      if(isValid(set_timer))
	 timer <= fromMaybe(?,set_timer);
      else if(running)
	 timer <= timer+1;
      run_timer <= running;
   endrule
   
   // pass physical Avalon interface out of this module
   interface avs = slave.avs;
   // export upper bits of timer to LEDs
   method UInt#(26) coe_leds;
      return truncate(timer>>6);
   endmethod
      
endmodule


endpackage: AvalonTimer

Link to the AvalonTimer.bsv source


#include <stdio.h>
// library with hardware specific parameters
#include <system.h>
// low-level input/output library
#include <io.h>



void set_timer(int t)
{
  // write t directly to the device bypassing the processor's cache
  IOWR_32DIRECT(MKAVALONTIMER_0_BASE, 0, t);
}

int read_timer()
{
  // read the timer directly from the device bypassing the processor's cache
  return IORD_32DIRECT(MKAVALONTIMER_0_BASE, 0);
}

void stop_timer()
{
  // stop timer by writing 0 to word address 1 of the device (byte address 4)
  IOWR_32DIRECT(MKAVALONTIMER_0_BASE, 4, 0);    
}

void start_timer()
{
  // start timer by writing 1 to word address 1 of the device (byte address 4)
  IOWR_32DIRECT(MKAVALONTIMER_0_BASE, 4, 1);    
}

int read_and_stop_timer()
{
  return IORD_32DIRECT(MKAVALONTIMER_0_BASE, 4);
}


int main()
{
  printf("Starting timer test\n");
  fprintf(stderr,"Timer test\n(LCD output)");

  stop_timer();
  printf("timer = %d\n",read_timer());
  printf("timer = %d\n",read_timer());
  printf("start timer\n");
  start_timer();
  printf("timer = %d\n",read_timer());
  printf("timer = %d\n",read_timer());
  printf("read and stop = %d\n",read_and_stop_timer());
  printf("timer = %d\n",read_timer());
  
  return 0;
}

Link to the timereg.c source

AvalonFIFOs Example

/*****************************************************************************
 AvalonFIFOs
 ===========
 Simon Moore, Dec 2009
 
 Dec 2009 - added multiported version
 
 Provides a set of FIFOs (specified by "num_fifos") and one Avalon Slave
 interface to access them.  Data is tagged with one byte specified via
 register 1.  The tag should be written before the data is written and it
 should be read after the data is read.  Each FIFO is allocated 4 word 
 addresses to access it.
 
 Processor memory map:
   read/write  address   meaning
     read         0      read from fifo
     write        0      write word to fifo
     read         1      bit 9 = overflow-output, bit 8 = underflow-input
                         bits 7-0 = tag byte
     write        1      write tag byte
     read         2      number of waiting data items
     write        2      clear fifo + overflow and underflow bits
     read         3      number of empty fifo slots
     write        3      clear fifo + overflow and underflow bits

  Bug fixes:
   * in mkAvalonFIFOs_UGFIFOCount
      - moved fifo.clear from clear method to keep_count rule
        - the fifo is now cleared when the counter is cleared
        - seemed to be necessary to help the scheduler otherwise
          fifo.enq in do_enq never fired despite no_implicit_conditions
 *****************************************************************************/

package AvalonFIFOs;

import GetPut::*;
import Vector::*;
import ClientServer::*;
import Avalon2ClientServer::*;
import FIFOF::*;
import FIFOLevel::*;
import FIFO::*;
import Connectable::*;

`define fifo_depth 32
// num fifos for single Avalon port version
`define num_fifos 4
// num ports for multi-Avalon slave version
`define num_ports 3
`define fifo_address_width 2
//`define replication_address_width Log(num_fifos)
`define replication_address_width 2
//`define total_address_width (fifo_address_width+replication_address_width);
`define total_address_width 4

(* always_enabled, always_ready *)
interface AvalonFIFOs_UGFIFOCountIfc#( type element_type );
   method Action enq ( element_type sendData ) ;
   method Action deq () ;
   method element_type first () ;
   method Bool notFull ;
   method Bool notEmpty ;
   method UInt#(32) count; //TODO: fix this hack...
   method Action clear;
endinterface


// like FIFOCountIfc but with ungarded enq and deq
module mkAvalonFIFOs_UGFIFOCount#(Integer fifoDepth)(AvalonFIFOs_UGFIFOCountIfc#(element_type))
   provisos (Bits#(element_type,element_type_width));

   FIFOF#(element_type) fifo <- mkUGSizedFIFOF(fifoDepth);
   Wire#(Maybe#(element_type)) enq_dw <- mkDWire(tagged Invalid);
   PulseWire deq_pulse <- mkPulseWire;
   Reg#(UInt#(32)) counter <- mkReg(0); // hack - fix
   PulseWire count_down <- mkPulseWire;
   PulseWire count_up <- mkPulseWire;
   PulseWire count_zero <- mkPulseWire;
   Wire#(element_type) first_bw <- mkBypassWire;
   
   (* no_implicit_conditions *)
   rule do_first_bypass (True); // needed?
      first_bw <= fifo.notEmpty ? fifo.first : unpack(0);
   endrule
   
   (* no_implicit_conditions *)
   rule keep_count;
      if(count_zero)
	 begin
	    counter <= 0;
	    fifo.clear;
	 end
      else if(count_up && !count_down) counter<=counter+1;
      else if(!count_up && count_down) counter<=counter-1;
   endrule
   
   (* no_implicit_conditions *)
   rule do_enq (isValid(enq_dw) && fifo.notFull);
      fifo.enq(fromMaybe(?,enq_dw));
      count_up.send;
      $display("%05d: %m - do_enq fired",$time);
   endrule
   
   rule do_enq_failed (isValid(enq_dw) && !fifo.notFull);
      $display("%05d: %m - WARNING: fifo enq when full",$time);
   endrule
   
   (* no_implicit_conditions *)
   rule do_deq (deq_pulse && fifo.notEmpty);
      fifo.deq;
      count_down.send;
   endrule
   
   rule do_deq_failed (deq_pulse && !fifo.notEmpty);
      $display("Warning: fifo deq when full");
   endrule
   
   method Action enq ( element_type sendData );
      enq_dw <= tagged Valid sendData;
   endmethod
   method Action deq ();
      deq_pulse.send;
   endmethod
   method element_type first (); return first_bw; endmethod
   method Bool notFull = fifo.notFull;
   method Bool notEmpty = fifo.notEmpty;
   method count; return extend(counter); endmethod
   method Action clear;
      count_zero.send;
   endmethod
endmodule
 
   
typedef UInt#(8) AvalonFIFOs_tagT;
   
typedef struct {
   AvalonFIFOs_tagT  tag;
   AvalonWordT       data;
   } AvalonFIFOs_tagdataT deriving (Bits);


typedef struct {
   UInt#(`replication_address_width) addr_top;
   UInt#(`fifo_address_width) addr_bot;
} AvalonFIFOs_Addr_SeperatorT deriving (Bits);
   
interface AvalonFIFOsIfc;
   interface AvalonSlaveIfc#(`total_address_width) avs;
endinterface
      
(* synthesize,
   reset_prefix = "csi_clockreset_reset_n",
   clock_prefix = "csi_clockreset_clk" *)
(* doc="************** Simon's comments for Verilog code: **************" *)
(* doc="Top level module for Avalon Bridge Example" *)
(* doc="Port names should align with SOPC builder's new device requirements" *)
(* doc="Need to add the $BLUESPECDIR/Verilog directory to the Libraries in Quartus" *)
module mkAvalonFIFOs(AvalonFIFOsIfc);
   AvalonSlave2ClientIfc#(`total_address_width) slave <- mkAvalonSlave2Client;
   
   Vector#(`num_fifos,AvalonFIFOs_UGFIFOCountIfc#(AvalonFIFOs_tagdataT)) f <- replicateM(mkAvalonFIFOs_UGFIFOCount(`fifo_depth));
   Vector#(`num_fifos,Reg#(AvalonFIFOs_tagT)) tag_in  <- replicateM(mkReg(0));
   Vector#(`num_fifos,Reg#(AvalonFIFOs_tagT)) tag_out <- replicateM(mkReg(0));
   Vector#(`num_fifos,Reg#(Bool)) underflow <- replicateM(mkReg(False));
   Vector#(`num_fifos,Reg#(Bool)) overflow <- replicateM(mkReg(False));

   rule handle_requests;
      let req <- slave.client.request.get;
      ReturnedDataT rtn = tagged Invalid;
      AvalonFIFOs_Addr_SeperatorT a = unpack(pack(req.addr));
      case(tuple2(a.addr_bot,req.rw))
	 tuple2(0, MemRead ) : if(f[a.addr_top].notEmpty)
				  begin
				     let d = f[a.addr_top].first;
				     f[a.addr_top].deq;
				     rtn = tagged Valid d.data;
				     tag_in[a.addr_top] <= d.tag;
				  end
			       else
				  begin
				     rtn = tagged Valid 0;
				     tag_in[a.addr_top] <= 0;
				     underflow[a.addr_top] <= True;
				  end
	 tuple2(0, MemWrite) : if(f[a.addr_top].notFull)
				  f[a.addr_top].enq(AvalonFIFOs_tagdataT{tag:tag_out[a.addr_top], data:req.data});
			       else
				  overflow[a.addr_top] <= True;
	 tuple2(1, MemRead ) : rtn = tagged Valid extend(unpack({pack(overflow[a.addr_top]),pack(underflow[a.addr_top]),pack(tag_in[a.addr_top])}));
	 tuple2(1, MemWrite) : tag_out[a.addr_top] <= truncate(req.data);
	 tuple2(2, MemRead ) : rtn = tagged Valid extend(f[a.addr_top].count);
	 tuple2(2, MemWrite) : begin
				  overflow[a.addr_top] <= False;
				  underflow[a.addr_top] <= False;
				  f[a.addr_top].clear;
			       end
	 tuple2(3, MemRead ) : rtn = tagged Valid extend(`fifo_depth-f[a.addr_top].count);
	 tuple2(3, MemWrite) : begin
				  overflow[a.addr_top] <= False;
				  underflow[a.addr_top] <= False;
				  f[a.addr_top].clear;
			       end
      endcase
      slave.client.response.put(rtn);
   endrule
   
   interface avs=slave.avs;
endmodule


/*****************************************************************************
 AvalonFIFOMultiPort
 ===================
 Simon Moore, Dec 2009
 
 Provides N Avalon Slaves and point-to-point FIFO communication between
 these ports (i.e. grows O(N^2)).
 
 It is constructed from N x AvalonFIFOOnePort
 
 Port P has N output ports and N input ports, i.e. there is one port
 which allows it to communicate with itself
 
 Use same address map as AvalonFIFOs.
 
  Processor memory map (word addressed):
   read/write  address   meaning
     read         0      read from fifo
     write        0      write word to fifo
     read         1      bit 9 = overflow-output, bit 8 = underflow-input
                         bits 7-0 = tag byte
     write        1      write tag byte
     read         2      number of waiting data items
     write        2      clear fifo + overflow and underflow bits
     read         3      number of empty fifo slots
     write        3      clear fifo + overflow and underflow bits 

 *****************************************************************************/


interface AvalonFIFOOnePortIfc;
   interface AvalonSlaveIfc#(`total_address_width) avs;
   interface Vector#(`num_ports,Client#(AvalonFIFOs_tagdataT,AvalonFIFOs_tagdataT)) chan;
endinterface

module mkAvalonFIFOOnePort(AvalonFIFOOnePortIfc);
   AvalonSlave2ClientIfc#(`total_address_width) slave <- mkAvalonSlave2Client;

   // TODO - use just one long fifo and token based flow control?
   //      - N.B. require "number of empty fifo slots" for sender
   Vector#(`num_ports,AvalonFIFOs_UGFIFOCountIfc#(AvalonFIFOs_tagdataT)) fin <- replicateM(mkAvalonFIFOs_UGFIFOCount(`fifo_depth));
   Vector#(`num_ports,AvalonFIFOs_UGFIFOCountIfc#(AvalonFIFOs_tagdataT)) fout <- replicateM(mkAvalonFIFOs_UGFIFOCount(`fifo_depth));
   Vector#(`num_ports,Reg#(AvalonFIFOs_tagT)) tag_in  <- replicateM(mkReg(0));
   Vector#(`num_ports,Reg#(AvalonFIFOs_tagT)) tag_out <- replicateM(mkReg(0));
   Vector#(`num_ports,Reg#(Bool)) underflow <- replicateM(mkReg(False));
   Vector#(`num_ports,Reg#(Bool)) overflow <- replicateM(mkReg(False));
   
   rule handle_requests;
      let req <- slave.client.request.get;
      ReturnedDataT rtn = tagged Invalid;
      AvalonFIFOs_Addr_SeperatorT a = unpack(pack(req.addr));
      case(tuple2(a.addr_bot,req.rw))
	 tuple2(0, MemRead ) : if(fin[a.addr_top].notEmpty)
				  begin
				     let d = fin[a.addr_top].first;
				     fin[a.addr_top].deq;
				     rtn = tagged Valid d.data;
				     tag_in[a.addr_top] <= d.tag;
				  end
			       else
				  begin
				     rtn = tagged Valid 0;
				     tag_in[a.addr_top] <= 0;
				     underflow[a.addr_top] <= True;
				  end
	 tuple2(0, MemWrite) : if(fout[a.addr_top].notFull)
				  fout[a.addr_top].enq(AvalonFIFOs_tagdataT{tag:tag_out[a.addr_top], data:req.data});
			       else
				  overflow[a.addr_top] <= True;
	 tuple2(1, MemRead ) : rtn = tagged Valid extend(unpack({pack(overflow[a.addr_top]),pack(underflow[a.addr_top]),pack(tag_in[a.addr_top])}));
	 tuple2(1, MemWrite) : tag_out[a.addr_top] <= truncate(req.data);
	 tuple2(2, MemRead ) : rtn = tagged Valid extend(fin[a.addr_top].count);
	 tuple2(2, MemWrite) : begin
				  overflow[a.addr_top] <= False;
				  underflow[a.addr_top] <= False;
				  fout[a.addr_top].clear;
			       end
	 tuple2(3, MemRead ) : rtn = tagged Valid extend(`fifo_depth-fout[a.addr_top].count);
	 tuple2(3, MemWrite) : begin
				  overflow[a.addr_top] <= False;
				  underflow[a.addr_top] <= False;
				  fin[a.addr_top].clear;
				  fout[a.addr_top].clear;
			       end
      endcase
      slave.client.response.put(rtn);
   endrule
   
   // this is a bit of a hack to provide get and put interfaces to fifoin and fifoout
   Vector#(`num_ports,FIFO#(AvalonFIFOs_tagdataT)) bout <- replicateM(mkFIFO);
   Vector#(`num_ports,FIFO#(AvalonFIFOs_tagdataT)) bin <- replicateM(mkFIFO);
   for(Integer p=0; p<`num_ports; p=p+1)
      begin
	 rule bin_to_fin (fin[p].notFull);
	    fin[p].enq(bin[p].first);
	    bin[p].deq;
	 endrule
	 rule fout_to_bout(fout[p].notEmpty);
	    bout[p].enq(fout[p].first);
	    fout[p].deq;
	 endrule
      end
   
   Vector#(`num_ports,Client#(AvalonFIFOs_tagdataT,AvalonFIFOs_tagdataT)) c = newVector;
   for(Integer p=0; p<`num_ports; p=p+1)
      c[p] = Client{request: toGet(bout[p]), response: toPut(bin[p])};
      
   interface chan=c;
   interface avs=slave.avs;
endmodule


interface AvalonFIFOMultiPortIfc;
   interface Vector#(`num_ports,AvalonSlaveIfc#(`total_address_width)) avs;
endinterface


(* synthesize,
   reset_prefix = "csi_clockreset_reset_n",
   clock_prefix = "csi_clockreset_clk" *)
(* doc="************** Simon's comments for Verilog code: **************" *)
(* doc="Top level module for Avalon Bridge Example" *)
(* doc="Port names should align with SOPC builder's new device requirements" *)
(* doc="Need to add the $BLUESPECDIR/Verilog directory to the Libraries in Quartus" *)
module mkAvalonFIFOMultiPort(AvalonFIFOMultiPortIfc);
   Vector#(`num_ports,AvalonFIFOOnePortIfc) ports <- replicateM(mkAvalonFIFOOnePort);
   Vector#(`num_ports,AvalonSlaveIfc#(`total_address_width)) slaves;
   
   for(Integer src=0; src<`num_ports; src=src+1)
      for(Integer dest=0; dest<`num_ports; dest=dest+1)
	 mkConnection(ports[src].chan[dest].request.get,ports[dest].chan[src].response.put);
   
   for(Integer j=0; j<`num_ports; j=j+1)
      slaves[j] = ports[j].avs;

   interface avs = slaves;
endmodule



endpackage
       

Link to the AvalonFIFOs.bsv source