Skip to content
Snippets Groups Projects
Commit 78f95d97 authored by Eric Kooistra's avatar Eric Kooistra
Browse files

Merge branch 'L2SDP-143' into 'master'

Merged sub-branch L2SDP-151 into L2SDP-143 (st_histogram rework)

Closes L2SDP-143

See merge request desp/hdl!101
parents 3e44ef8e 86cfe496
Branches
No related tags found
1 merge request!101Merged sub-branch L2SDP-151 into L2SDP-143 (st_histogram rework)
......@@ -18,7 +18,6 @@ synth_files =
src/vhdl/st_histogram.vhd
src/vhdl/st_histogram_reg.vhd
src/vhdl/mms_st_histogram.vhd
src/vhdl/st_histogram_8_april.vhd
tb/vhdl/tb_st_pkg.vhd
......@@ -31,7 +30,9 @@ test_bench_files =
tb/vhdl/tb_st_xst.vhd
tb/vhdl/tb_tb_st_xst.vhd
tb/vhdl/tb_st_histogram.vhd
tb/vhdl/tb_mms_st_histogram.vhd
tb/vhdl/tb_st_histogram.vhd
tb/vhdl/tb_tb_st_histogram.vhd
regression_test_vhdl =
......@@ -39,6 +40,7 @@ regression_test_vhdl =
tb/vhdl/tb_tb_st_xsq.vhd
tb/vhdl/tb_tb_st_xst.vhd
#tb/vhdl/tb_st_calc.vhd -- tb is not self checking yet
tb/vhdl/tb_tb_st_histogram.vhd
[modelsim_project_file]
......
......@@ -18,37 +18,25 @@
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Author: J.W.E. Oudman
-- Purpose: Create a histogram from the input data and present it to the MM bus
-- Author:
-- . Daniel van der Schuur
-- Purpose:
-- . MMS-wrapper that adds registers and multi-instance support to st_histogram.
-- Description:
-- mms_st_histogram couples the st_histogram component which works entirely
-- in the dp clock domain through st_histogram_reg that handles the cross
-- domain conversion to the MM bus.
--
--
-- --------------------------------------
-- | mms_st_histogram |
-- | |
-- | ---------------- | -------
-- snk_in -->|-->| st_histogram | | ^
-- | ---------------- | |
-- | | ^ |
-- | | | | dp clock domain
-- | ram_st_histogram_miso |
-- | | | |
-- | | ram_st_histogram_mosi | |
-- | v | | v
-- | -------------------- | -------
-- | | st_histogram_reg |-- ram_miso -->|--> mm clock domain
-- | | |<-- ram_mosi --|<--
-- | -------------------- | -------
-- | |
-- --------------------------------------
--
--
-------------------------------------------------------------------------------
-- . st_histogram_reg implements the registers to control all g_nof_instances
-- . This MMS wrapper contains logic to fill a local RAM with the contents of
-- a selected st_histogram instance.
-- Usage (see st_histogram_reg.vhd for the register map):
-- . Reading RAM contents:
-- 1) User writes instance to read (0..g_nof_instances-1) to ram_fill_inst
-- register via reg_mosi
-- 2) Users writes to bit 0 of fill_ram register via reg_mosi
-- . ram_filling status will go high
-- 3) User reads ram_filling status until it reads zero via reg_mosi
-- 4) User reads freshly filled RAM contents via ram_mosi
-- . Clearing the RAMs:
-- . The inactive RAM is cleared automatically just before the next input sync.
-- . ram_clearing status will go high during this time.
LIBRARY IEEE, common_lib, mm_lib, technology_lib, dp_lib;
USE IEEE.std_logic_1164.ALL;
......@@ -59,21 +47,23 @@ USE technology_lib.technology_select_pkg.ALL;
ENTITY mms_st_histogram IS
GENERIC (
g_in_data_w : NATURAL := 14; -- >= 9 when g_nof_bins is 512; (max. c_dp_stream_data_w =768)
g_nof_bins : NATURAL := 512; -- is a power of 2 and g_nof_bins <= c_data_span; max. 512
g_nof_data : NATURAL; --
g_str : STRING := "freq.density" -- to select output to MM bus ("frequency" or "freq.density")
g_nof_instances : NATURAL;
g_data_w : NATURAL;
g_nof_bins : NATURAL;
g_nof_data_per_sync : NATURAL
);
PORT (
dp_rst : IN STD_LOGIC;
dp_clk : IN STD_LOGIC;
mm_rst : IN STD_LOGIC;
dp_rst : IN STD_LOGIC;
snk_in_arr : IN t_dp_sosi_arr(g_nof_instances-1 DOWNTO 0);
mm_clk : IN STD_LOGIC;
mm_rst : IN STD_LOGIC;
-- Streaming
snk_in : IN t_dp_sosi;
reg_mosi : IN t_mem_mosi;
reg_miso : OUT t_mem_miso;
-- Memory Mapped
ram_mosi : IN t_mem_mosi;
ram_miso : OUT t_mem_miso
);
......@@ -81,45 +71,163 @@ END mms_st_histogram;
ARCHITECTURE str OF mms_st_histogram IS
SIGNAL ram_st_histogram_mosi : t_mem_mosi;
SIGNAL ram_st_histogram_miso : t_mem_miso;
CONSTANT c_reg_adr_w : NATURAL := 1;
CONSTANT c_ram_adr_w : NATURAL := ceil_log2(g_nof_bins);
CONSTANT c_ram_dat_w : NATURAL := ceil_log2(g_nof_data_per_sync);
CONSTANT c_ram : t_c_mem := (latency => 1,
adr_w => c_ram_adr_w,
dat_w => c_ram_dat_w,
nof_dat => g_nof_bins,
init_sl => '0');
CONSTANT c_addr_high : NATURAL := g_nof_bins-1;
SIGNAL common_ram_cr_cw_wr_mosi : t_mem_mosi;
SIGNAL nxt_common_ram_cr_cw_wr_mosi : t_mem_mosi;
SIGNAL common_ram_cr_cw_rd_mosi : t_mem_mosi;
SIGNAL common_ram_cr_cw_rd_miso : t_mem_miso;
SIGNAL ram_mosi_arr : t_mem_mosi_arr(g_nof_instances-1 DOWNTO 0);
SIGNAL ram_miso_arr : t_mem_miso_arr(g_nof_instances-1 DOWNTO 0);
SIGNAL ram_clearing_arr : STD_LOGIC_VECTOR(g_nof_instances-1 DOWNTO 0);
SIGNAL ram_fill_inst : STD_LOGIC_VECTOR(ceil_log2(g_nof_instances)-1 DOWNTO 0);
SIGNAL ram_fill_inst_int : NATURAL;
SIGNAL ram_fill : STD_LOGIC;
SIGNAL ram_filling : STD_LOGIC;
SIGNAL nxt_ram_filling : STD_LOGIC;
SIGNAL address : STD_LOGIC_VECTOR(c_ram_adr_w-1 DOWNTO 0);
SIGNAL nxt_address : STD_LOGIC_VECTOR(c_ram_adr_w-1 DOWNTO 0);
BEGIN
-------------------------------------------------------------------------------
-- st_histogram instances and their registers
-------------------------------------------------------------------------------
gen_st_histogram : FOR i IN 0 TO g_nof_instances-1 GENERATE
u_st_histogram : ENTITY work.st_histogram
GENERIC MAP(
g_in_data_w => g_in_data_w,
g_data_w => g_data_w,
g_nof_bins => g_nof_bins,
g_nof_data => g_nof_data,
g_str => g_str
g_nof_data_per_sync => g_nof_data_per_sync
)
PORT MAP (
dp_rst => dp_rst,
dp_clk => dp_clk,
dp_rst => dp_rst,
snk_in => snk_in,
sla_in_ram_mosi => ram_st_histogram_mosi,
sla_out_ram_miso => ram_st_histogram_miso
snk_in => snk_in_arr(i),
ram_clearing => ram_clearing_arr(i),
ram_mosi => ram_mosi_arr(i),
ram_miso => ram_miso_arr(i)
);
END GENERATE;
u_st_histogram_reg : ENTITY work.st_histogram_reg
-- GENERIC MAP(
-- g_in_data_w =>
-- g_nof_bins =>
-- g_nof_data =>
-- g_str =>
-- )
GENERIC MAP (
g_nof_instances => g_nof_instances
)
PORT MAP (
dp_rst => dp_rst,
dp_clk => dp_clk,
mm_rst => mm_rst,
dp_rst => dp_rst,
ram_clearing => ram_clearing_arr(0),
ram_filling => ram_filling,
mm_clk => mm_clk,
mm_rst => mm_rst,
mas_out_ram_mosi => ram_st_histogram_mosi,
mas_in_ram_miso => ram_st_histogram_miso,
ram_fill_inst => ram_fill_inst,
ram_fill => ram_fill,
ram_mosi => ram_mosi,
ram_miso => ram_miso
reg_mosi => reg_mosi,
reg_miso => reg_miso
);
-------------------------------------------------------------------------------
-- Dual clock RAM: DP write side, MM read side
-------------------------------------------------------------------------------
u_common_ram_cr_cw : ENTITY common_lib.common_ram_cr_cw
GENERIC MAP (
g_technology => c_tech_select_default,
g_ram => c_ram,
g_init_file => "UNUSED"
)
PORT MAP (
wr_clk => dp_clk,
wr_rst => dp_rst,
wr_clken => '1',
wr_en => common_ram_cr_cw_wr_mosi.wr,
wr_adr => common_ram_cr_cw_wr_mosi.address(c_ram_adr_w-1 DOWNTO 0),
wr_dat => common_ram_cr_cw_wr_mosi.wrdata(c_ram_dat_w-1 DOWNTO 0),
rd_clk => mm_clk,
rd_rst => mm_rst,
rd_clken => '1',
rd_en => common_ram_cr_cw_rd_mosi.rd,
rd_adr => common_ram_cr_cw_rd_mosi.address(c_ram_adr_w-1 DOWNTO 0),
rd_dat => common_ram_cr_cw_rd_miso.rddata(c_ram_dat_w-1 DOWNTO 0),
rd_val => common_ram_cr_cw_rd_miso.rdval
);
-- User side MM bus for histogram readout
common_ram_cr_cw_rd_mosi <= ram_mosi;
ram_miso <= common_ram_cr_cw_rd_miso;
-------------------------------------------------------------------------------
-- Logic to move st_histogram RAM contents into the dual clock RAM above
-------------------------------------------------------------------------------
-- Keep track of ram_filling status and address
nxt_ram_filling <= '0' WHEN TO_UINT(address)=c_addr_high ELSE '1' WHEN ram_fill='1' ELSE ram_filling;
nxt_address <= (OTHERS=>'0') WHEN ram_filling='0' ELSE INCR_UVEC(address, 1) WHEN ram_filling='1' ELSE address;
-- Help signal for bus selection
ram_fill_inst_int <= TO_UINT(ram_fill_inst);
-- Do read request on ram_mosi when ram_filling
p_mosi_arr: PROCESS (ram_filling, address, ram_fill_inst_int)
BEGIN
FOR i IN 0 TO g_nof_instances-1 LOOP
ram_mosi_arr(i) <= c_mem_mosi_rst;
IF i = ram_fill_inst_int THEN
ram_mosi_arr(i).rd <= ram_filling;
ram_mosi_arr(i).address(c_ram_adr_w-1 DOWNTO 0) <= address;
END IF;
END LOOP;
END PROCESS;
-- Forward the read histogram data from ram_miso into write mosi of dual clock RAM
p_rd_miso_to_wr_mosi : PROCESS(ram_miso_arr, ram_fill_inst_int, address)
BEGIN
nxt_common_ram_cr_cw_wr_mosi <= common_ram_cr_cw_wr_mosi;
FOR i IN 0 TO g_nof_instances-1 LOOP
IF i = ram_fill_inst_int THEN
nxt_common_ram_cr_cw_wr_mosi.wr <= ram_miso_arr(i).rdval;
nxt_common_ram_cr_cw_wr_mosi.wrdata(c_ram_dat_w-1 DOWNTO 0) <= ram_miso_arr(i).rddata(c_ram_dat_w-1 DOWNTO 0);
nxt_common_ram_cr_cw_wr_mosi.address(c_ram_adr_w-1 DOWNTO 0) <= address;
END IF;
END LOOP;
END PROCESS;
-- Registers
p_clk : PROCESS(dp_clk, dp_rst) IS
BEGIN
IF dp_rst = '1' THEN
common_ram_cr_cw_wr_mosi <= c_mem_mosi_rst;
address <= (OTHERS=>'0');
ram_filling <= '0';
ELSIF RISING_EDGE(dp_clk) THEN
common_ram_cr_cw_wr_mosi <= nxt_common_ram_cr_cw_wr_mosi;
address <= nxt_address;
ram_filling <= nxt_ram_filling;
END IF;
END PROCESS;
END str;
This diff is collapsed.
-- Daniel's suggested restructured st_hitogram.vhd.
LIBRARY IEEE, common_lib, mm_lib, technology_lib, dp_lib;
USE IEEE.std_logic_1164.ALL;
USE common_lib.common_pkg.ALL;
USE common_lib.common_mem_pkg.ALL;
USE dp_lib.dp_stream_pkg.ALL;
USE technology_lib.technology_select_pkg.ALL;
ENTITY st_histogram_8_april IS
GENERIC (
g_in_data_w : NATURAL := 14; -- >= 9 when g_nof_bins is 512; (max. c_dp_stream_data_w =768) <-- maybe just g_data_w ??
g_nof_bins : NATURAL := 512; -- is a power of 2 and g_nof_bins <= c_data_span; max. 512
g_nof_data : NATURAL
-- g_sim_ram_miso_mode : BOOLEAN := FALSE -- when TRUE the ram_miso bus will get a copy of the data written into the RAM.
);
PORT (
dp_rst : IN STD_LOGIC;
dp_clk : IN STD_LOGIC;
-- Streaming
snk_in : IN t_dp_sosi;
-- DP clocked memory bus
ram_mosi : IN t_mem_mosi;
ram_miso : OUT t_mem_miso
);
END st_histogram_8_april;
ARCHITECTURE rtl OF st_histogram_8_april IS
CONSTANT c_adr_w : NATURAL := ceil_log2(g_nof_bins);
CONSTANT c_ram : t_c_mem := (latency => 1,
adr_w => c_adr_w, -- 9 bits needed to adress/select 512 adresses
dat_w => c_word_w, -- 32bit, def. in common_pkg; >= c_bin_w
nof_dat => g_nof_bins, -- 512 adresses with 32 bit words, so 512
init_sl => '0'); -- MM side : sla_in, sla_out
-- CONSTANT c_mem_miso_setting : t_mem_miso := (rddata => mem_miso_init, -- c_mem_miso_rst; -- limit to 32 bit
-- rdval => '0',
-- waitrequest => '0' );
CONSTANT c_adr_low_calc : INTEGER := g_in_data_w-c_adr_w; -- Calculation might yield a negative number
CONSTANT c_adr_low : NATURAL := largest(0, c_adr_low_calc); -- Override any negative value of c_adr_low_calc
-- SIGNAL mem_miso_init : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0) := (OTHERS => '0');
SIGNAL bin_reader_mosi : t_mem_mosi := c_mem_mosi_rst;
SIGNAL nxt_bin_writer_mosi : t_mem_mosi;
SIGNAL bin_writer_mosi : t_mem_mosi;
SIGNAL nxt_bin_arbiter_wr_mosi : t_mem_mosi;
SIGNAL bin_arbiter_wr_mosi : t_mem_mosi;
SIGNAL nxt_bin_arbiter_rd_mosi : t_mem_mosi;
SIGNAL bin_arbiter_rd_mosi : t_mem_mosi;
SIGNAL bin_arbiter_rd_miso : t_mem_miso := c_mem_miso_rst;
SIGNAL bin_reader_rd_miso : t_mem_miso := c_mem_miso_rst;
SIGNAL common_ram_r_w_0_miso : t_mem_miso := c_mem_miso_rst;
SIGNAL init_phase : STD_LOGIC := '1';
SIGNAL nxt_init_phase : STD_LOGIC;
SIGNAL rd_cnt_allowed : STD_LOGIC := '0';
SIGNAL rd_cnt_allowed_pp : STD_LOGIC := '0';
SIGNAL toggle_detect : STD_LOGIC := '0';
SIGNAL toggle_detect_pp : STD_LOGIC;
SIGNAL toggle_detect_false : STD_LOGIC := '1';
SIGNAL nxt_prev_wrdata : NATURAL;
SIGNAL prev_wrdata : NATURAL;
SIGNAL prev_prev_wrdata : NATURAL;
SIGNAL prev_prev_prev_wrdata: NATURAL;
SIGNAL sync_detect : STD_LOGIC := '0';
SIGNAL sync_detect_pp : STD_LOGIC;
SIGNAL same_r_w_address : STD_LOGIC;
SIGNAL same_r_w_address_pp : STD_LOGIC;
--pipelined signals
SIGNAL snk_in_p : t_dp_sosi;
SIGNAL snk_in_pp : t_dp_sosi;
SIGNAL prev_bin_reader_mosi : t_mem_mosi := c_mem_mosi_rst ;
SIGNAL bin_reader_mosi_pp : t_mem_mosi := c_mem_mosi_rst;
SIGNAL bin_reader_mosi_ppp : t_mem_mosi := c_mem_mosi_rst;
--debug signals
-- SIGNAL nxt_dbg_sync_detect : STD_LOGIC;
-- SIGNAL dbg_sync_detect : STD_LOGIC;
SIGNAL dbg_state_string : STRING(1 TO 3) := " ";
SIGNAL dbg_snk_data : STD_LOGIC_VECTOR(g_in_data_w-1 DOWNTO 0);
BEGIN
-----------------------------------------------------------------------------
-- Bin reader: Convert snk_in data to bin_reader_mosi with read request
-- and generate signals for detection of problems in the
-- consecutive data.
-- . in : snk_in (latency: 0)
-- : bin_arbiter_rd_miso (latency: 2)
-- . out : init_phase (latency: 0 ?
-- : bin_reader_mosi (latency: 0)
-- : prev_bin_reader_mosi (latency: 1)
-- : bin_reader_mosi_pp (latency: 2)
-- : bin_reader_mosi_ppp (latency: 3)
-- : bin_reader_rd_miso (latency: 2)
-- : rd_cnt_allowed_pp (latency: 2)
-- : same_r_w_address_pp (latency: 2)
-- : toggle_detect_pp (latency: 2)
-- : sync_detect (latency: 0)
-- : sync_detect_pp (latency: 2)
-----------------------------------------------------------------------------
bin_reader_mosi.rd <= snk_in.valid; -- when 1, count allowed
bin_reader_mosi.address(c_adr_w-1 DOWNTO 0) <= snk_in.data(g_in_data_w-1 DOWNTO c_adr_low);
bin_reader_rd_miso <= bin_arbiter_rd_miso;
--snk_in pipeline; Enable sync and valid comparisons
u_dp_pipeline_snk_in_1_cycle : ENTITY dp_lib.dp_pipeline
GENERIC MAP (
g_pipeline => 1 -- 0 for wires, > 0 for registers,
)
PORT MAP (
rst => dp_rst,
clk => dp_clk,
snk_in => snk_in,
src_out => snk_in_p
);
init_phase <= '0' WHEN snk_in_p.sync = '1'; -- ELSE will be impossible since the init_phase may only be triggered once on the first sync
-- nxt_init_phase <= '0' WHEN snk_in_p_.sync='1' ELSE init_phase;
-- p_init_phase : PROCESS(dp_clk, dp_rst)
-- BEGIN
-- IF dp_rst = '1' THEN
-- init_phase <= '1';
-- ELSIF RISING_EDGE(dp_clk) THEN
-- init_phase <= nxt_init_phase;
-- END IF;
-- END PROCESS;
-- Enable sync comparisons
u_dp_pipeline_snk_in_2_cycle : ENTITY dp_lib.dp_pipeline
GENERIC MAP (
g_pipeline => 2 -- 0 for wires, > 0 for registers,
)
PORT MAP (
rst => dp_rst,
clk => dp_clk,
snk_in => snk_in,
src_out => snk_in_pp
);
dbg_snk_data <= snk_in_pp.data(g_in_data_w-1 DOWNTO 0);
toggle_detect_false <= '0' WHEN snk_in_pp.sync = '1'; -- ELSE will be impossible since the toggle_detect_false may only be triggered once on the first sync
sync_detect <= snk_in.valid WHEN (snk_in.sync='1' OR snk_in_p.sync='1' OR snk_in_pp.sync='1') ELSE '0'; -- @sync, first 3 cycles would try to read from the wrong (old) RAM block, detect this problem
-- Line up to p_nxt_bin_writer_mosi process
u_common_pipeline_sl_sync_detect_2_cycle : ENTITY common_lib.common_pipeline_sl
GENERIC MAP(
g_pipeline => 2 -- 0 for wires, > 0 for registers,
)
PORT MAP (
clk => dp_clk,
in_dat => sync_detect,
out_dat => sync_detect_pp
);
-- Enable adress comparisons 1 cycle back
-- Skip unvalid data with trigger bin_reader_mosi.rd to make comparisons between unvalid-data-seperated data possible.
u_common_pipeline_bin_reader_mosi_1_cycle : ENTITY common_lib.common_pipeline
GENERIC MAP (
g_representation => "UNSIGNED", --orig. signed
g_pipeline => 1,
g_in_dat_w => c_adr_w, -- c_mem_address_w
g_out_dat_w => c_adr_w
)
PORT MAP (
clk => dp_clk,
clken => bin_reader_mosi.rd, -- '1',
in_dat => STD_LOGIC_VECTOR(bin_reader_mosi.address(c_adr_w-1 DOWNTO 0)),
out_dat => prev_bin_reader_mosi.address(c_adr_w-1 DOWNTO 0)
);
-- Enable adress comparisons 2 cycles back
u_common_pipeline_bin_reader_mosi_2_cycle : ENTITY common_lib.common_pipeline
GENERIC MAP (
g_representation => "UNSIGNED", --orig. signed
g_pipeline => 1,
g_in_dat_w => c_adr_w,
g_out_dat_w => c_adr_w
)
PORT MAP (
clk => dp_clk,
in_dat => STD_LOGIC_VECTOR(prev_bin_reader_mosi.address(c_adr_w-1 DOWNTO 0)),
out_dat => bin_reader_mosi_pp.address(c_adr_w-1 DOWNTO 0)
);
-- Enable adress comparisons 3 cycles back
u_common_pipeline_bin_reader_mosi_3_cycle : ENTITY common_lib.common_pipeline
GENERIC MAP (
g_representation => "UNSIGNED", --orig. signed
g_pipeline => 2,
g_in_dat_w => c_adr_w,
g_out_dat_w => c_adr_w
)
PORT MAP (
clk => dp_clk,
in_dat => STD_LOGIC_VECTOR(prev_bin_reader_mosi.address(c_adr_w-1 DOWNTO 0)),
out_dat => bin_reader_mosi_ppp.address(c_adr_w-1 DOWNTO 0)
);
-- Only count sequential valid data on the same address when: address is the same as last and 1 or 2 cycles after the sync when in sync_detect; address is the same as last and past the initialisation and outside sync_detect
rd_cnt_allowed <= snk_in.valid WHEN ( bin_reader_mosi.address = prev_bin_reader_mosi.address AND ( snk_in_p.sync='1' OR (snk_in_pp.sync='1' AND snk_in_p.valid='1') ) )
OR (bin_reader_mosi.address = prev_bin_reader_mosi.address AND init_phase='0' AND sync_detect='0')
ELSE '0';
-- Line rd_cnt_allowed up to p_nxt_bin_writer_mosi process
u_common_pipeline_sl_rd_cnt_allowed : ENTITY common_lib.common_pipeline_sl
GENERIC MAP(
g_pipeline => 2 -- 0 for wires, > 0 for registers,
)
PORT MAP (
clk => dp_clk,
in_dat => rd_cnt_allowed,
out_dat => rd_cnt_allowed_pp
);
-- Detect a (valid) repeating address seperated by one other address past the initialisation and outside the first two cycles of a (new) sync --also @sync, one wil be true; use NOT(1 or 1) instead of (0 or 0)
toggle_detect <= snk_in.valid WHEN (bin_reader_mosi_pp.address = bin_reader_mosi.address AND bin_reader_mosi_pp.address /= prev_bin_reader_mosi.address AND toggle_detect_false = '0' AND NOT(snk_in.sync='1' OR snk_in_p.sync='1') )
ELSE '0';
-- Line up to p_nxt_bin_writer_mosi process
u_common_pipeline_sl_toggle_detect : ENTITY common_lib.common_pipeline_sl
GENERIC MAP(
g_pipeline => 2 -- 0 for wires, > 0 for registers,
)
PORT MAP (
clk => dp_clk,
in_dat => toggle_detect,
out_dat => toggle_detect_pp
);
-- Detect an (valid) address that has to be read as well as written at the same time
same_r_w_address <= snk_in.valid WHEN (bin_reader_mosi.address = bin_reader_mosi_ppp.address AND init_phase = '0' AND sync_detect = '0') ELSE '0';
-- Line up top p_nxt_bin_writer_mosi process
u_common_pipeline_sl_same_r_w_address : ENTITY common_lib.common_pipeline_sl
GENERIC MAP(
g_pipeline => 2 -- 0 for wires, > 0 for registers,
)
PORT MAP (
clk => dp_clk,
in_dat => same_r_w_address,
out_dat => same_r_w_address_pp
);
-----------------------------------------------------------------------------
-- Bin writer : increments current bin value and sets up write request
-- . in : toggle_detect_pp (latency: 2)
-- . in : same_r_w_address_pp (latency: 2)
-- . in : bin_reader_mosi_pp (latency: 2)
-- . in : bin_reader_rd_miso (latency: 2) aka bin_arbiter_rd_miso or common_ram_r_w_0_miso
-- . in : rd_cnt_allowed_pp (latency: 2)
-- . in : sync_detect_pp
-- . out : bin_writer_mosi (latency: 3)
-----------------------------------------------------------------------------
p_nxt_bin_writer_mosi : PROCESS(bin_reader_rd_miso,
bin_reader_mosi_pp.address, toggle_detect_pp, rd_cnt_allowed_pp, init_phase, prev_wrdata, prev_prev_wrdata, prev_prev_prev_wrdata, sync_detect_pp, same_r_w_address_pp) IS -- init_phase unnecesary? ; removed: common_ram_r_w_0_miso.rdval, common_ram_r_w_0_miso.rddata,
BEGIN
nxt_bin_writer_mosi <= c_mem_mosi_rst;
dbg_state_string <= "unv";
IF bin_reader_rd_miso.rdval='1' THEN -- common_ram_r_w_0_miso
nxt_bin_writer_mosi.wr <= '1';
nxt_bin_writer_mosi.wrdata <= INCR_UVEC(bin_reader_rd_miso.rddata, 1); -- common_ram_r_w_0_miso
nxt_bin_writer_mosi.address <= bin_reader_mosi_pp.address;
nxt_prev_wrdata <= TO_UINT(bin_reader_rd_miso.rddata) + 1; -- common_ram_r_w_0_miso
dbg_state_string <= "val";
ELSIF toggle_detect_pp = '1' THEN
nxt_bin_writer_mosi.wr <= '1';
nxt_bin_writer_mosi.wrdata <= TO_UVEC( (prev_prev_wrdata+1), c_mem_data_w);
nxt_bin_writer_mosi.address <= bin_reader_mosi_pp.address;
nxt_prev_wrdata <= prev_prev_wrdata+1;
dbg_state_string <= "td ";
ELSIF rd_cnt_allowed_pp = '1' THEN
nxt_bin_writer_mosi.wr <= '1';
nxt_bin_writer_mosi.wrdata <= TO_UVEC( (prev_wrdata + 1), c_mem_data_w);
nxt_prev_wrdata <= prev_wrdata + 1;
dbg_state_string <= "r# ";
nxt_bin_writer_mosi.address <= bin_reader_mosi_pp.address;
ELSIF sync_detect_pp = '1' THEN
nxt_bin_writer_mosi.wr <= '1';
nxt_bin_writer_mosi.wrdata <= TO_UVEC(1, c_mem_data_w); -- snk_in.sync: 1; snk_in_p.sync (thus new adress): 1; snk_in_pp.sync (thus new adress): 1
nxt_bin_writer_mosi.address <= bin_reader_mosi_pp.address;
nxt_prev_wrdata <= 1;
dbg_state_string <= "sd ";
ELSIF same_r_w_address_pp = '1' THEN
nxt_bin_writer_mosi.wr <= '1';
nxt_bin_writer_mosi.wrdata <= TO_UVEC( (prev_prev_prev_wrdata+1), c_mem_data_w);
nxt_bin_writer_mosi.address <= bin_reader_mosi_pp.address;
nxt_prev_wrdata <= prev_prev_prev_wrdata + 1;
dbg_state_string <= "srw";
END IF;
END PROCESS;
p_prev_wrdata : PROCESS(dp_clk, dp_rst, nxt_bin_writer_mosi.wr) IS --seperated from p_bin_writer_mosi since the implementation was unwanted
BEGIN
IF dp_rst = '1' THEN
prev_wrdata <= 0;
prev_prev_wrdata <= 0;
prev_prev_prev_wrdata <= 0;
ELSIF nxt_bin_writer_mosi.wr='1' AND RISING_EDGE(dp_clk) THEN
prev_wrdata <= nxt_prev_wrdata;
prev_prev_wrdata <= prev_wrdata;
prev_prev_prev_wrdata <= prev_prev_wrdata;
END IF;
END PROCESS;
p_bin_writer_mosi : PROCESS(dp_clk, dp_rst) IS --, nxt_bin_writer_mosi, nxt_prev_wrdata, prev_wrdata, prev_prev_wrdata
BEGIN
IF dp_rst = '1' THEN
bin_writer_mosi <= c_mem_mosi_rst;
-- prev_wrdata <= 0;
-- prev_prev_wrdata <= 0;
-- prev_prev_prev_wrdata <= 0;
ELSIF RISING_EDGE(dp_clk) THEN
bin_writer_mosi <= nxt_bin_writer_mosi;
-- IF nxt_bin_writer_mosi.wr = '1' THEN
-- prev_wrdata <= nxt_prev_wrdata;
-- prev_prev_wrdata<= prev_wrdata;
-- prev_prev_prev_wrdata <= prev_prev_wrdata;
-- END IF;
END IF;
END PROCESS;
-----------------------------------------------------------------------------
-- Bin Arbiter: Determine next RAM access
-- . in : bin_reader_mosi (latency: 0)
-- : init_phase (latency: 0)
-- : prev_bin_reader_mosi (latency: 1)
-- : bin_reader_mosi_pp (latency: 2)
-- : bin_reader_mosi_ppp (latency: 3)
-- : bin_writer_mosi (latency: 3)
-- : sync_detect (latency: 0? or 3?
-- : common_ram_r_w_0_miso (latency: 2)
-- . out : bin_arbiter_rd_mosi (latency: 1)
-- . : bin_arbiter_rd_miso (latency: 2)
-- . : bin_arbiter_wr_mosi (latency: 4)
-----------------------------------------------------------------------------
nxt_bin_arbiter_wr_mosi <= bin_writer_mosi;
-- Read RAM when subsequent addresses are not the same, when there is no toggle detected and only when the same address is not going to be written to. When a sync is detected don't read in the old RAM block.
nxt_bin_arbiter_rd_mosi.rd <= bin_reader_mosi.rd WHEN (bin_reader_mosi.address /= prev_bin_reader_mosi.address AND bin_reader_mosi.address /= bin_reader_mosi_pp.address
AND NOT(bin_reader_mosi.address = bin_reader_mosi_ppp.address) AND sync_detect='0')
OR (init_phase = '1') ELSE '0';
nxt_bin_arbiter_rd_mosi.address <= bin_reader_mosi.address;
p_bin_arbiter_mosi : PROCESS(dp_clk, dp_rst) IS --, nxt_bin_arbiter_wr_mosi, nxt_bin_arbiter_rd_mosi
BEGIN
IF dp_rst = '1' THEN
bin_arbiter_wr_mosi <= c_mem_mosi_rst;
bin_arbiter_rd_mosi <= c_mem_mosi_rst;
ELSIF RISING_EDGE(dp_clk) THEN
bin_arbiter_wr_mosi <= nxt_bin_arbiter_wr_mosi;
bin_arbiter_rd_mosi <= nxt_bin_arbiter_rd_mosi;
END IF;
END PROCESS;
-- Temporary debug data
ram_miso.rddata <= bin_arbiter_wr_mosi.wrdata;
-- Make RAM data available for the bin_reader (or bin_writer)
bin_arbiter_rd_miso <= common_ram_r_w_0_miso;
-----------------------------------------------------------------------------
-- RAM that contains the bins
-- . in : bin_arbiter_wr_mosi (latency: 4)
-- . in : bin_arbiter_rd_mosi (latency: 1)
-- . out : common_ram_r_w_0_miso (latency: 2)
-----------------------------------------------------------------------------
common_ram_r_w_0: ENTITY common_lib.common_ram_r_w
GENERIC MAP (
g_technology => c_tech_select_default,
g_ram => c_ram,
g_init_file => "UNUSED"
)
PORT MAP (
rst => dp_rst,
clk => dp_clk,
clken => '1',
wr_en => bin_arbiter_wr_mosi.wr,
wr_adr => bin_arbiter_wr_mosi.address(c_adr_w-1 DOWNTO 0),
wr_dat => bin_arbiter_wr_mosi.wrdata(c_word_w-1 DOWNTO 0),
rd_en => bin_arbiter_rd_mosi.rd,
rd_adr => bin_arbiter_rd_mosi.address(c_adr_w-1 DOWNTO 0),
rd_dat => common_ram_r_w_0_miso.rddata(c_word_w-1 DOWNTO 0),
rd_val => common_ram_r_w_0_miso.rdval
);
END rtl;
......@@ -18,98 +18,186 @@
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Author: J.W.E. Oudman
-- Purpose: Provide MM slave register for st_histogram
-- Author:
-- . Daniel van der Schuur
-- Purpose:
-- . Provide MM registers for st_histogram
-- Description:
-- Because the st_histogram component uses 2 RAM blocks that are swapped
-- after every sync pulse, both blocks have to work in the dp clock domain
-- and the Memory Mapped bus coming out of the component consequently also
-- works in the dp clock domain.
--
-- To convert the signals to the mm clock domain the common_reg_cross_domain
-- component is used. Because the inner workings of that component is
-- dependent on some components that take time to reliably stabialize the
-- conversion takes 12 mm clock cycles before the next address may be
-- requested.
--
--
-- [Alternative: shared dual clocked RAM block]
--
--
-------------------------------------------------------------------------------
-- . Address 0, bit 0 = RAM clear
-- . Read : 'ram_clearing' status output of st_histogram.vhd. '1' when RAM is clearing.
-- . Address 1 = select RAM instance to fill (read out)
-- . Read : read back selected instance
-- . Write: select RAM instance to fill
-- . Address 2, bit 0 = RAM fill
-- . Read : 'ram_filling' status. '1' right after write of ram_fill. '0' when not filling RAM (anymore).
-- . Write: 'ram_fill ' control. '1' to fill RAM on write event.
LIBRARY IEEE, common_lib, dp_lib;-- mm_lib, technology_lib,
LIBRARY IEEE, common_lib;
USE IEEE.std_logic_1164.ALL;
USE common_lib.common_pkg.ALL;
USE common_lib.common_mem_pkg.ALL;
USE dp_lib.dp_stream_pkg.ALL;
--USE technology_lib.technology_select_pkg.ALL;
ENTITY st_histogram_reg IS
-- GENERIC (
-- g_nof_bins : NATURAL := 512; -- is a power of 2 and g_nof_bins <= c_data_span; max. 512
-- g_str : STRING := "freq.density" -- to select output to MM bus ("frequency" or "freq.density")
-- );
GENERIC (
g_nof_instances : NATURAL
);
PORT (
dp_rst : IN STD_LOGIC;
dp_clk : IN STD_LOGIC;
mm_rst : IN STD_LOGIC;
mm_clk : IN STD_LOGIC;
dp_rst : IN STD_LOGIC;
ram_clearing : IN STD_LOGIC;
ram_fill_inst : OUT STD_LOGIC_VECTOR(ceil_log2(g_nof_instances)-1 DOWNTO 0);
ram_fill : OUT STD_LOGIC;
ram_filling : IN STD_LOGIC;
-- DP clocked memory bus
mas_out_ram_mosi : OUT t_mem_mosi ;--:= c_mem_mosi_rst; -- Beware, works in dp clock domain !
mas_in_ram_miso : IN t_mem_miso ;--:= c_mem_miso_rst; -- '' !
-- ram_st_histogram_mosi : OUT t_mem_mosi; -- Beware, works in dp clock domain !
-- ram_st_histogram_miso : IN t_mem_miso; -- '' !
mm_clk : IN STD_LOGIC;
mm_rst : IN STD_LOGIC;
-- Memory Mapped
ram_mosi : IN t_mem_mosi;
ram_miso : OUT t_mem_miso
reg_mosi : IN t_mem_mosi;
reg_miso : OUT t_mem_miso
);
END st_histogram_reg;
ARCHITECTURE str OF st_histogram_reg IS
ARCHITECTURE rtl OF st_histogram_reg IS
-- CONSTANT c_mm_reg : t_c_mem := (latency => 1,
-- adr_w => 1,
-- dat_w => c_word_w,
-- nof_dat => 1,
-- init_sl => g_default_value);
CONSTANT c_nof_addresses : NATURAL := 3;
CONSTANT c_mm_reg : t_c_mem := (latency => 1,
adr_w => ceil_log2(c_nof_addresses),
dat_w => c_word_w, -- Use MM bus data width = c_word_w = 32 for all MM registers
nof_dat => c_nof_addresses,
init_sl => '0');
BEGIN
SIGNAL mm_ram_clearing : STD_LOGIC;
SIGNAL mm_ram_fill_inst : STD_LOGIC_VECTOR(ceil_log2(g_nof_instances)-1 DOWNTO 0);
SIGNAL mm_ram_fill : STD_LOGIC;
SIGNAL mm_ram_filling : STD_LOGIC;
BEGIN
u_common_reg_cross_domain_mosi_address : ENTITY common_lib.common_reg_cross_domain
------------------------------------------------------------------------------
-- MM register access in the mm_clk domain
-- . Hardcode the shared MM slave register directly in RTL instead of using
-- the common_reg_r_w instance. Directly using RTL is easier when the large
-- MM register has multiple different fields and with different read and
-- write options per field in one MM register.
------------------------------------------------------------------------------
p_mm_reg : PROCESS (mm_clk, mm_rst)
BEGIN
IF mm_rst = '1' THEN
-- Read access
reg_miso <= c_mem_miso_rst;
-- Access event, register values
mm_ram_fill <= '0';
mm_ram_fill_inst <= (OTHERS=>'0');
ELSIF rising_edge(mm_clk) THEN
-- Read access defaults
reg_miso.rdval <= '0';
-- Access event defaults
mm_ram_fill <= '0';
-- Write access: set register value
IF reg_mosi.wr = '1' THEN
CASE TO_UINT(reg_mosi.address(c_mm_reg.adr_w-1 DOWNTO 0)) IS
WHEN 1 =>
mm_ram_fill_inst <= reg_mosi.wrdata(ceil_log2(g_nof_instances)-1 DOWNTO 0);
WHEN 2 =>
mm_ram_fill <= '1';
WHEN OTHERS => NULL; -- unused MM addresses
END CASE;
-- Read access: get register value
ELSIF reg_mosi.rd = '1' THEN
reg_miso <= c_mem_miso_rst; -- set unused rddata bits to '0' when read
reg_miso.rdval <= '1'; -- c_mm_reg.latency = 1
CASE TO_UINT(reg_mosi.address(c_mm_reg.adr_w-1 DOWNTO 0)) IS
WHEN 0 =>
-- Read RAM clearing status
reg_miso.rddata(0) <= mm_ram_clearing;
WHEN 1 =>
-- Read selected RAM instance to fill
reg_miso.rddata(ceil_log2(g_nof_instances)-1 DOWNTO 0) <= mm_ram_fill_inst;
WHEN 2 =>
-- Read RAM filling status
reg_miso.rddata(0) <= mm_ram_filling;
WHEN OTHERS => NULL; -- unused MM addresses
END CASE;
END IF;
END IF;
END PROCESS;
------------------------------------------------------------------------------
-- Transfer register value between mm_clk and st_clk domain.
-- If the function of the register ensures that the value will not be used
-- immediately when it was set, then the transfer between the clock domains
-- can be done by wires only. Otherwise if the change in register value can
-- have an immediate effect then the bit or word value needs to be transfered
-- using:
--
-- . common_async --> for single-bit level signal
-- . common_spulse --> for single-bit pulse signal
-- . common_reg_cross_domain --> for a multi-bit (a word) signal
--
-- Typically always use a crossing component for the single bit signals (to
-- be on the save side) and only use a crossing component for the word
-- signals if it is necessary (to avoid using more logic than necessary).
------------------------------------------------------------------------------
-- ST --> MM
u_common_async_clear : ENTITY common_lib.common_async
GENERIC MAP (
g_rst_level => '0'
)
PORT MAP (
in_rst => mm_rst,
in_clk => mm_clk,
clk => mm_clk,
rst => mm_rst,
in_new => ram_mosi.rd,
in_dat => ram_mosi.address,
din => ram_clearing,
dout => mm_ram_clearing
);
out_rst => dp_rst,
out_clk => dp_clk,
u_common_async_fill : ENTITY common_lib.common_async
GENERIC MAP (
g_rst_level => '0'
)
PORT MAP (
clk => mm_clk,
rst => mm_rst,
out_dat => mas_out_ram_mosi.address,
out_new => mas_out_ram_mosi.rd
din => ram_filling,
dout => mm_ram_filling
);
u_reg_cross_domain_miso_rddata : ENTITY common_lib.common_reg_cross_domain
u_common_spulse_fill : ENTITY common_lib.common_spulse
PORT MAP (
in_rst => dp_rst,
in_clk => dp_clk,
in_clk => mm_clk,
in_rst => mm_rst,
in_new => mas_in_ram_miso.rdval,
in_dat => mas_in_ram_miso.rddata,
in_pulse => mm_ram_fill,
in_busy => OPEN,
out_rst => mm_rst,
out_clk => mm_clk,
out_clk => dp_clk,
out_rst => dp_rst,
out_pulse => ram_fill
);
out_dat => ram_miso.rddata,
out_new => ram_miso.rdval
u_common_reg_cross_domain : ENTITY common_lib.common_reg_cross_domain
PORT MAP (
in_clk => mm_clk,
in_rst => mm_rst,
in_dat => mm_ram_fill_inst,
in_done => OPEN,
out_clk => dp_clk,
out_rst => dp_rst,
out_dat => ram_fill_inst,
out_new => OPEN
);
END str;
END rtl;
......@@ -20,283 +20,231 @@
-------------------------------------------------------------------------------
--
-- Author: J.W.E. Oudman
-- Purpose: Create a histogram from the input data and present it to the MM bus
-- Author:
-- . Daniel van der Schuur
-- Purpose:
-- .
-- ModelSim usage:
-- . (open project, compile)
-- . (load simulation config)
-- . as 8
-- . run -a
-- Description:
--
--
--
-- .
-------------------------------------------------------------------------------
LIBRARY IEEE, common_lib, mm_lib, dp_lib;
USE IEEE.std_logic_1164.ALL;
USE IEEE.numeric_std.ALL;
USE common_lib.common_pkg.ALL;
USE common_lib.tb_common_pkg.ALL;
USE common_lib.common_mem_pkg.ALL;
USE common_lib.tb_common_mem_pkg.ALL;
USE common_lib.tb_common_pkg.ALL;
USE dp_lib.dp_stream_pkg.ALL;
USE dp_lib.tb_dp_pkg.ALL;
ENTITY tb_mms_st_histogram IS
GENERIC(
g_sync_length : NATURAL := 338;
g_nof_sync : NATURAL := 3;
g_data_w : NATURAL := 4;
g_nof_bins : NATURAL := 8;
g_nof_data : NATURAL := 338;
g_str : STRING := "freq.density";
g_valid_gap : BOOLEAN := FALSE;
g_snk_in_data_sim_type : STRING := "counter" -- "counter" or "toggle"
g_nof_sync : NATURAL := 4;
g_nof_instances : NATURAL := 12;
g_data_w : NATURAL := 14;
g_nof_bins : NATURAL := 512;
g_nof_data_per_sync : NATURAL := 40000
);
END tb_mms_st_histogram;
ARCHITECTURE tb OF tb_mms_st_histogram IS
CONSTANT c_adr_w : NATURAL := ceil_log2(g_nof_bins);
CONSTANT c_mm_init_time : NATURAL := 5;
CONSTANT c_dp_inti_time : NATURAL := 5;
SIGNAL tb_end : STD_LOGIC := '0';
SIGNAL first_sync : STD_LOGIC := '0';
----------------------------------------------------------------------------
---------------------------------------------------------------------------
-- Clocks and resets
----------------------------------------------------------------------------
CONSTANT c_mm_clk_period : TIME := 20 ns;
---------------------------------------------------------------------------
CONSTANT c_dp_clk_period : TIME := 5 ns;
CONSTANT c_mm_clk_period : TIME := 20 ns;
SIGNAL mm_rst : STD_LOGIC := '1';
SIGNAL mm_clk : STD_LOGIC := '1';
SIGNAL dp_rst : STD_LOGIC;
SIGNAL dp_clk : STD_LOGIC := '1';
SIGNAL dp_rst : STD_LOGIC;
SIGNAL mm_clk : STD_LOGIC := '1';
SIGNAL mm_rst : STD_LOGIC;
SIGNAL tb_end : STD_LOGIC := '0';
----------------------------------------------------------------------------
-- Streaming Input
-- stimuli
----------------------------------------------------------------------------
SIGNAL stimuli_en : STD_LOGIC := '1';
SIGNAL st_histogram_snk_in : t_dp_sosi;
SIGNAL stimuli_src_out : t_dp_sosi;
SIGNAL stimuli_src_in : t_dp_siso;
----------------------------------------------------------------------------
-- Memory Mapped Input
-- st_histogram
----------------------------------------------------------------------------
SIGNAL st_histogram_snk_in_arr : t_dp_sosi_arr(g_nof_instances-1 DOWNTO 0);
SIGNAL st_histogram_reg_mosi : t_mem_mosi;
SIGNAL st_histogram_reg_miso : t_mem_miso;
SIGNAL st_histogram_ram_mosi : t_mem_mosi;
SIGNAL st_histogram_ram_miso : t_mem_miso;
----------------------------------------------------------------------------
-- Readout & verification
----------------------------------------------------------------------------
CONSTANT c_ram_dat_w : NATURAL := ceil_log2(g_nof_data_per_sync)+1;
CONSTANT c_expected_ram_content : NATURAL := g_nof_data_per_sync/g_nof_bins;
SIGNAL ram_filling : STD_LOGIC;
SIGNAL ram_rd_word : STD_LOGIC_VECTOR(c_ram_dat_w-1 DOWNTO 0);
SIGNAL ram_rd_word_int : NATURAL;
SIGNAL ram_rd_word_valid : STD_LOGIC;
SIGNAL nxt_ram_rd_word_valid : STD_LOGIC;
BEGIN
----------------------------------------------------------------------------
-- Clock and reset generation
----------------------------------------------------------------------------
mm_clk <= NOT mm_clk OR tb_end AFTER c_mm_clk_period/2;
mm_rst <= '1', '0' AFTER c_mm_clk_period*c_mm_init_time;
dp_clk <= NOT dp_clk OR tb_end AFTER c_dp_clk_period/2;
dp_rst <= '1', '0' AFTER c_dp_clk_period*c_dp_inti_time;
dp_rst <= '1', '0' AFTER c_dp_clk_period*10;
mm_clk <= NOT mm_clk OR tb_end AFTER c_mm_clk_period/2;
mm_rst <= '1', '0' AFTER c_mm_clk_period*10;
----------------------------------------------------------------------------
-- Source: counter stimuli
-- DP Stimuli: generate st_histogram input data
----------------------------------------------------------------------------
stimuli_src_in <= c_dp_siso_rdy;
p_data : PROCESS(dp_rst, dp_clk, st_histogram_snk_in)
-- Generate g_nof_sync packets of g_nof_data_per_sync words
p_generate_packets : PROCESS
VARIABLE v_sosi : t_dp_sosi := c_dp_sosi_rst;
BEGIN
IF g_snk_in_data_sim_type = "counter" THEN
IF dp_rst='1' THEN
st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) <= (OTHERS=>'0');
ELSIF rising_edge(dp_clk) AND st_histogram_snk_in.valid='1' THEN
st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) <= INCR_UVEC(st_histogram_snk_in.data(g_data_w-1 DOWNTO 0), 1);
END IF;
ELSIF g_snk_in_data_sim_type = "toggle" THEN
IF dp_rst='1' THEN
st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) <= (OTHERS=>'0');
ELSIF rising_edge(dp_clk) AND st_histogram_snk_in.valid='1' THEN
IF st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) = TO_UVEC(0, g_data_w) THEN
st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) <= TO_UVEC(1, g_data_w);
ELSE
st_histogram_snk_in.data(g_data_w-1 DOWNTO 0) <= TO_UVEC(0, g_data_w);
END IF;
END IF;
END IF;
END PROCESS;
p_stimuli : PROCESS
BEGIN
IF g_valid_gap = FALSE THEN
-- dp_rst <= '1';
st_histogram_snk_in.sync <= '0';
st_histogram_snk_in.valid <= '0';
WAIT UNTIL rising_edge(dp_clk);
-- FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
-- dp_rst <= '0';
FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
st_histogram_snk_in.valid <= '1';
stimuli_src_out <= c_dp_sosi_rst;
proc_common_wait_until_low(dp_clk, dp_rst);
proc_common_wait_some_cycles(dp_clk, 5);
FOR I IN 0 TO g_nof_sync-1 LOOP
st_histogram_snk_in.sync <= '1';
WAIT UNTIL rising_edge(dp_clk);
st_histogram_snk_in.sync <= '0';
FOR I IN 0 TO g_sync_length-1 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
v_sosi.sync := '1';
v_sosi.data := RESIZE_DP_DATA(v_sosi.data(g_data_w-1 DOWNTO 0)); -- wrap when >= 2**g_data_w
proc_dp_gen_block_data(g_data_w, TO_UINT(v_sosi.data), g_nof_data_per_sync, TO_UINT(v_sosi.channel), TO_UINT(v_sosi.err), v_sosi.sync, v_sosi.bsn, dp_clk, stimuli_en, stimuli_src_in, stimuli_src_out);
END LOOP;
FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
tb_end <= '1';
WAIT;
ELSIF g_valid_gap = TRUE THEN
-- dp_rst <= '1';
st_histogram_snk_in.sync <= '0';
st_histogram_snk_in.valid <= '0';
WAIT UNTIL rising_edge(dp_clk);
-- FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
-- dp_rst <= '0';
FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
st_histogram_snk_in.valid <= '1';
FOR I IN 0 TO g_nof_sync-2 LOOP
st_histogram_snk_in.sync <= '1';
WAIT UNTIL rising_edge(dp_clk);
st_histogram_snk_in.sync <= '0';
FOR I IN 0 TO (g_sync_length/2)-1 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
st_histogram_snk_in.valid <= '0';
WAIT UNTIL rising_edge(dp_clk);
--WAIT UNTIL rising_edge(dp_clk);
--WAIT UNTIL rising_edge(dp_clk);
st_histogram_snk_in.valid <= '1';
FOR I IN 0 TO (g_sync_length/4)-1 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
st_histogram_snk_in.valid <= '0';
WAIT UNTIL rising_edge(dp_clk);
--st_histogram_snk_in.valid <= '0';
st_histogram_snk_in.sync <= '1';
WAIT UNTIL rising_edge(dp_clk);
st_histogram_snk_in.valid <= '1';
st_histogram_snk_in.sync <= '0';
FOR I IN 0 TO (g_sync_length/4)-1 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
END LOOP;
FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(dp_clk); END LOOP;
proc_common_wait_some_cycles(dp_clk, 50);
tb_end <= '1';
WAIT;
END IF;
END PROCESS;
----------------------------------------------------------------------------
-- Source: read MM bus stimuli
----------------------------------------------------------------------------
-- p_mm_stimuli : PROCESS --(st_histogram_snk_in.sync)
-- BEGIN
-- IF mm_rst='1' THEN
-- st_histogram_ram_mosi <= c_mem_mosi_rst; --.address(c_adr_w-1 DOWNTO 0) <= (OTHERS=>'0');
---- ELSIF rising_edge(mm_clk) THEN --AND st_histogram_snk_in.valid='1'
-- ELSE
-- IF first_sync = '0' THEN
-- WAIT UNTIL st_histogram_snk_in.sync = '1';
-- first_sync <= '1';
-- -- wait till one RAM block is written
-- FOR I IN 0 TO (g_sync_length/4) LOOP WAIT UNTIL rising_edge(mm_clk); END LOOP;
-- -- wait for some more cycles
-- FOR I IN 0 TO 9 LOOP WAIT UNTIL rising_edge(mm_clk); END LOOP;
---- ELSIF rising_edge(mm_clk) THEN
-- ELSE
-- FOR I IN 0 TO g_nof_bins-1
-- --
-- st_histogram_ram_mosi.rd <= '1';
-- st_histogram_ram_mosi.address(c_adr_w-1 DOWNTO 0) <= INCR_UVEC(st_histogram_ram_mosi.address(c_adr_w-1 DOWNTO 0), 1);
-- END IF;
-- END IF;
-- END PROCESS;
p_mm_stimuli : PROCESS --(st_histogram_snk_in.sync)
BEGIN
--IF mm_rst='1' THEN
st_histogram_ram_mosi <= c_mem_mosi_rst; --.address(c_adr_w-1 DOWNTO 0) <= (OTHERS=>'0');
-- ELSIF rising_edge(mm_clk) THEN --AND st_histogram_snk_in.valid='1'
--ELSE
--IF first_sync = '0' THEN
WAIT UNTIL st_histogram_snk_in.sync = '1';
--first_sync <= '1';
-- wait till one RAM block is written
FOR I IN 0 TO (g_sync_length/4) LOOP WAIT UNTIL rising_edge(mm_clk); END LOOP;
-- wait for some more cycles
FOR I IN 0 TO 2 LOOP WAIT UNTIL rising_edge(mm_clk); END LOOP;
-- ELSIF rising_edge(mm_clk) THEN
--ELSE
FOR I IN 0 TO g_nof_bins-1 LOOP
proc_mem_mm_bus_rd(I, mm_clk, st_histogram_ram_mosi);
proc_common_wait_some_cycles(mm_clk, 11);
-- miso.rddata arrives
END LOOP;
--
--st_histogram_ram_mosi.rd <= '1';
--st_histogram_ram_mosi.address(c_adr_w-1 DOWNTO 0) <= INCR_UVEC(st_histogram_ram_mosi.address(c_adr_w-1 DOWNTO 0), 1);
--END IF;
--END IF;
END PROCESS;
-- -- Read data request to the MM bus
-- -- Use proc_mem_mm_bus_rd_latency() to wait for the MM MISO rd_data signal
-- -- to show the data after some read latency
-- PROCEDURE proc_mem_mm_bus_rd(CONSTANT rd_addr : IN NATURAL;
-- SIGNAL mm_clk : IN STD_LOGIC;
-- SIGNAL mm_miso : IN t_mem_miso;
-- SIGNAL mm_mosi : OUT t_mem_mosi) IS
-- BEGIN
-- mm_mosi.address <= TO_MEM_ADDRESS(rd_addr);
-- proc_mm_access(mm_clk, mm_miso.waitrequest, mm_mosi.rd);
-- END proc_mem_mm_bus_rd;
---- Issues a rd or a wr MM access and wait for it to have finished
-- PROCEDURE proc_mm_access(SIGNAL mm_clk : IN STD_LOGIC;
-- SIGNAL mm_waitreq : IN STD_LOGIC;
-- SIGNAL mm_access : OUT STD_LOGIC) IS
-- BEGIN
-- mm_access <= '1';
-- WAIT UNTIL rising_edge(mm_clk);
-- WHILE mm_waitreq='1' LOOP
-- WAIT UNTIL rising_edge(mm_clk);
-- END LOOP;
-- mm_access <= '0';
-- END proc_mm_access;
-- proc_mem_mm_bus_rd(0, mm_clk, mm_mosi); -- Read nof_early_syncs
-- proc_common_wait_some_cycles(mm_clk, 1);
-- mm_nof_early_syncs <= mm_miso.rddata(c_word_w-1 DOWNTO 0);
----------------------------------------------------------------------------
-- DUT: Device Under Test
-- mms_st_histogram
----------------------------------------------------------------------------
gen_snk_in_arr: FOR i IN 0 TO g_nof_instances-1 GENERATE
st_histogram_snk_in_arr(i) <= stimuli_src_out;
END GENERATE;
u_mms_st_histogram : ENTITY work.mms_st_histogram
GENERIC MAP(
g_in_data_w => g_data_w,
g_nof_instances => g_nof_instances,
g_data_w => g_data_w,
g_nof_bins => g_nof_bins,
g_nof_data => g_nof_data,
g_str => g_str
g_nof_data_per_sync => g_nof_data_per_sync
)
PORT MAP (
dp_rst => dp_rst,
dp_clk => dp_clk,
mm_rst => mm_rst,
dp_rst => dp_rst,
mm_clk => mm_clk,
mm_rst => mm_rst,
snk_in_arr => st_histogram_snk_in_arr,
-- Streaming
snk_in => st_histogram_snk_in,
reg_mosi => st_histogram_reg_mosi,
reg_miso => st_histogram_reg_miso,
-- Memory Mapped
ram_mosi => st_histogram_ram_mosi,
ram_miso => st_histogram_ram_miso --OPEN
ram_miso => st_histogram_ram_miso
);
----------------------------------------------------------------------------
-- MM Readout of st_histogram instances
----------------------------------------------------------------------------
p_ram_clear : PROCESS
BEGIN
st_histogram_ram_mosi <= c_mem_mosi_rst;
st_histogram_reg_mosi <= c_mem_mosi_rst;
ram_filling <= '0';
ram_rd_word <= (OTHERS=>'0');
-- The first sync indicates start of incoming data - let it pass
proc_common_wait_until_high(dp_clk, stimuli_src_out.sync);
proc_common_wait_some_cycles(mm_clk, 10);
FOR i IN 0 TO g_nof_sync-2 LOOP
-- Wiat for a full sync period of data
proc_common_wait_until_high(dp_clk, stimuli_src_out.sync);
-- The sync has passed, we can start reading the resulting histogram
FOR j IN 0 TO g_nof_instances-1 LOOP
-- Select st_histogram instance to read out
proc_mem_mm_bus_wr(1, j, mm_clk, st_histogram_reg_mosi);
proc_common_wait_some_cycles(mm_clk, 2);
-- Enable RAM filling
proc_mem_mm_bus_wr(2, 1, mm_clk, st_histogram_reg_mosi);
proc_common_wait_some_cycles(mm_clk, 10);
-- Wait until RAM filling is done
proc_mem_mm_bus_rd(2, mm_clk, st_histogram_reg_mosi);
ram_filling <= st_histogram_reg_miso.rddata(0);
proc_common_wait_some_cycles(mm_clk, 2);
WHILE ram_filling='1' LOOP
-- Read filling status
proc_mem_mm_bus_rd(2, mm_clk, st_histogram_reg_mosi);
ram_filling <= st_histogram_reg_miso.rddata(0);
proc_common_wait_some_cycles(mm_clk, 1);
END LOOP;
-- Read out the RAM contents
FOR k IN 0 TO g_nof_bins-1 LOOP
proc_mem_mm_bus_rd(k, mm_clk, st_histogram_ram_mosi);
ram_rd_word <= st_histogram_ram_miso.rddata(c_ram_dat_w-1 DOWNTO 0);
ram_rd_word_int <= TO_UINT(ram_rd_word);
END LOOP;
END LOOP;
END LOOP;
END PROCESS;
-- Register st_histogram_ram_miso.rdval so we read only valid data
p_nxt_ram_rd_word_valid : PROCESS(mm_rst, mm_clk)
BEGIN
IF mm_rst = '1' THEN
ram_rd_word_valid <= '0';
ELSIF RISING_EDGE(mm_clk) THEN
ram_rd_word_valid <= nxt_ram_rd_word_valid;
END IF;
END PROCESS;
nxt_ram_rd_word_valid <= st_histogram_ram_miso.rdval;
----------------------------------------------------------------------------
-- Perform verification of ram_rd_word when ram_rd_word_valid
----------------------------------------------------------------------------
p_verify_assert : PROCESS
BEGIN
FOR i IN 0 TO g_nof_sync-1 LOOP
proc_common_wait_until_high(dp_clk, stimuli_src_out.sync);
proc_common_wait_until_high(dp_clk, ram_rd_word_valid);
IF i=0 THEN -- Sync period 0: we expect RAM to contain zeros
ASSERT ram_rd_word_int=0 REPORT "RAM contains wrong bin count (expected 0, actual " & INTEGER'IMAGE(ram_rd_word_int) & ")" SEVERITY ERROR;
ELSE -- Sync period 1 onwards
ASSERT ram_rd_word_int=c_expected_ram_content REPORT "RAM contains wrong bin count (expected " & INTEGER'IMAGE(c_expected_ram_content) & ", actual " & INTEGER'IMAGE(ram_rd_word_int) & ")" SEVERITY ERROR;
END IF;
END LOOP;
WAIT FOR 5 ns;
END PROCESS;
END tb;
This diff is collapsed.
......@@ -18,12 +18,14 @@
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Author: J.W.E. Oudman
-- Author:
-- . Daniel van der Schuur
-- Purpose:
-- Description:
-- .
-- . Test tb_st_histogram in with several parameter sets
-- Usage
-- . as 8
-- . run -all
-- . Testbenches are self-checking
LIBRARY IEEE;
USE IEEE.std_logic_1164.ALL;
......@@ -35,29 +37,16 @@ ARCHITECTURE tb OF tb_tb_st_histogram IS
SIGNAL tb_end : STD_LOGIC := '0'; -- declare tb_end to avoid 'No objects found' error on 'when -label tb_end'
BEGIN
-- Usage
-- > as 8
-- > run -all
-- > Testbenches are self-checking
--
-- g_sync_length : NATURAL := 200;
-- g_nof_sync : NATURAL := 3;
-- g_data_w : NATURAL := 4;
-- g_nof_bins : NATURAL := 8;
-- g_nof_data : NATURAL := 200;
-- --g_str : STRING := "freq.density";
-- g_valid_gap : STRING := "custom"; -- "false" or "true" or "custom"
-- g_snk_in_data_sim_type : STRING := "same rw" -- "counter" or "toggle" or "same rw" or "mix"
--
-- g_nof_sync : NATURAL := 4;
-- g_data_w : NATURAL := 8;
-- g_nof_bins : NATURAL := 256;
-- g_nof_data : NATURAL := 1024;
-- do test for different number of bins
u_tb_st_histogram_counter_nof_2 : ENTITY work.tb_st_histogram GENERIC MAP (200, 3, 1, 2, 200, "true" , "counter" );
u_tb_st_histogram_counter_nof_4 : ENTITY work.tb_st_histogram GENERIC MAP (200, 3, 2, 4, 200, "true" , "counter" );
u_tb_st_histogram_counter : ENTITY work.tb_st_histogram GENERIC MAP (200, 3, 4, 8, 200, "true" , "counter" );
u_tb_st_histogram_0 : ENTITY work.tb_st_histogram GENERIC MAP ( 7, 8, 256, 1024); -- Incoming data wraps (repeats) 1024/ 256= 4 times: Bin count = 4
u_tb_st_histogram_1 : ENTITY work.tb_st_histogram GENERIC MAP ( 6, 10, 256, 4096); -- Incoming data wraps (repeats) 4096/ 256=16 times: Bin count = 16
u_tb_st_histogram_2 : ENTITY work.tb_st_histogram GENERIC MAP ( 5, 12, 512, 4096); -- Incoming data wraps (repeats) 4096/ 512= 8 times: Bin count = 8
u_tb_st_histogram_3 : ENTITY work.tb_st_histogram GENERIC MAP ( 4, 13, 1024, 8192); -- Incoming data wraps (repeats) 8192/1024= 8 times: Bin count = 8
u_tb_st_histogram_4 : ENTITY work.tb_st_histogram GENERIC MAP (40, 6, 64, 128); -- Incoming data wraps (repeats) 128/ 64= 2 times: Bin count = 2
-- do tests for RAM delay issues
u_tb_st_histogram_toggle : ENTITY work.tb_st_histogram GENERIC MAP (200, 3, 4, 8, 200, "true" , "toggle" );
u_tb_st_histogram_same_rw : ENTITY work.tb_st_histogram GENERIC MAP (200, 3, 4, 8, 200, "custom", "same rw" );
END tb;
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment