Skip to content
Snippets Groups Projects
Select Git revision
  • 9027262c186b07050296166b6a905d7ccd7b4abc
  • master default protected
  • RTSD-375
  • L2SDP-1134
  • L2SDP-1137
  • L2SDP-LIFT
  • L2SDP-1113
  • HPR-158
8 results

tb_io_ddr.vhd

Blame
  • Code owners
    Assign users and groups as approvers for specific file changes. Learn more.
    tb_io_ddr.vhd 21.83 KiB
    --------------------------------------------------------------------------------
    --
    -- Copyright (C) 2014
    -- ASTRON (Netherlands Institute for Radio Astronomy) <http://www.astron.nl/>
    -- JIVE (Joint Institute for VLBI in Europe) <http://www.jive.nl/>
    -- P.O.Box 2, 7990 AA Dwingeloo, The Netherlands
    --
    -- This program is free software: you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation, either version 3 of the License, or
    -- (at your option) any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
    --
    --------------------------------------------------------------------------------
    
    -- This testbench tests the different type of DDR controllers.
    --
    -- The DUT can be selected, using the g_technology and g_tech_ddr constants.
    --
    -- Testbench is selftesting:
    --
    -- > as 10
    -- > run -all
    --
    library IEEE, technology_lib, tech_ddr_lib, common_lib, dp_lib, diagnostics_lib;
    use IEEE.std_logic_1164.all;
    use IEEE.numeric_std.all;
    use common_lib.common_pkg.all;
    use common_lib.common_mem_pkg.all;
    use common_lib.tb_common_pkg.all;
    use common_lib.tb_common_mem_pkg.all;
    use dp_lib.dp_stream_pkg.all;
    use technology_lib.technology_pkg.all;
    use technology_lib.technology_select_pkg.all;
    use tech_ddr_lib.tech_ddr_pkg.all;
    
    entity tb_io_ddr is
      generic (
        g_sim_model             : boolean := true;  -- FALSE;
        g_technology            : natural := c_tech_select_default;
        g_tech_ddr3             : t_c_tech_ddr := c_tech_ddr3_4g_800m_master;
        --g_tech_ddr4             : t_c_tech_ddr := c_tech_ddr4_4g_1600m;
        g_tech_ddr4             : t_c_tech_ddr := c_tech_ddr4_16g_1600m_64;
        --g_tech_ddr4             : t_c_tech_ddr := c_tech_ddr4_16g_1600m_72_64;
        g_tb_end                : boolean := true;  -- when TRUE then tb_end ends this simulation, else a higher multi-testbench will end the simulation
        g_cross_domain_dvr_ctlr : boolean := true;  -- when TRUE insert clock cross domain logic and also insert clock cross domain logic when g_dvr_clk_period/=c_ctlr_clk_period
        g_dvr_clk_period        : time := 5 ns;  -- 200 MHz
        g_dp_factor             : natural := 4;  -- 1 or power of 2, c_dp_data_w = c_ctlr_data_w / g_dp_factor
        g_block_len             : natural := 100;  -- block length for a DDR write access and read back access in number of c_ctlr_data_w words
        g_nof_block             : natural := 2;  -- number of blocks that will be written to DDR and readback from DDR
        g_nof_wr_per_block      : natural := 1;  -- number of write accesses per block
        g_nof_rd_per_block      : natural := 1;  -- number of read accesses per block
        g_nof_repeat            : natural := 1;  -- number of stimuli repeats with write flush after each repeat
        g_wr_flush_mode         : string := "VAL"  -- "VAL", "SOP", "SYN"
      );
      port (
        tb_end : out std_logic
      );
    end entity tb_io_ddr;
    
    architecture str of tb_io_ddr is
      -- Select DDR3 or DDR4 dependent on the technology and sim model
      constant c_mem_ddr                  : t_c_tech_ddr := func_tech_sel_ddr(g_technology, g_tech_ddr3, g_tech_ddr4);
    
      -- Need to use >= c_tech_ddr4_sim_16k for g_block_len = 2500 in tb_tb_io_ddr
      constant c_sim_ddr                  : t_c_tech_ddr := func_tech_sel_ddr(g_technology, c_tech_ddr3_sim_16k, c_tech_ddr4_sim_16k);
      constant c_tech_ddr                 : t_c_tech_ddr := func_tech_sel_ddr(g_sim_model, c_sim_ddr, c_mem_ddr);
    
      constant c_exp_gigabytes            : integer := func_tech_ddr_module_gigabytes(c_tech_ddr);
      constant c_exp_nofbytes_w           : natural := func_tech_ddr_module_nofbytes_w(c_tech_ddr);
      constant c_exp_nof_bytes_per_word   : natural := func_tech_ddr_ctlr_ip_data_w(c_tech_ddr) / c_byte_w;
    
      constant c_dp_clk_period            : time := 5 ns;  -- 200 MHz
      constant c_mm_clk_period            : time := 8 ns;  -- 125 MHz
      constant c_ctlr_ref_clk_period      : time := sel_a_b(g_sim_model, c_dp_clk_period, sel_a_b(c_tech_ddr.name = "DDR3", 5 ns, 40 ns));  -- 200 MHz for DDR3 on UniBoard and 25 MHz for DDR4 on UniBoard2, use dp clock for sim_model
      constant c_ctlr_clk_freq            : natural := c_tech_ddr.mts / c_tech_ddr.rsl;  -- 200 MHz
      constant c_ctlr_clk_period          : time := (1000000 / c_ctlr_clk_freq) * 1 ps;  -- 5000 ps
      constant c_cross_domain_dvr_ctlr    : boolean := g_cross_domain_dvr_ctlr or g_dvr_clk_period /= c_ctlr_clk_period;
    
      constant c_ctlr_address_w           : natural := func_tech_ddr_ctlr_address_w(c_tech_ddr);
      constant c_ctlr_data_w              : natural := func_tech_ddr_ctlr_data_w(c_tech_ddr);
    
      constant c_dp_data_w                : natural := c_ctlr_data_w / g_dp_factor;
    
      constant c_wr_fifo_depth            : natural := 256;  -- defined at DDR side of the FIFO
      constant c_rd_fifo_depth            : natural := 256;  -- defined at DDR side of the FIFO
    
      -- Frame size for sop/eop
      constant c_wr_frame_size            : natural := 32;
      -- Sync period
      constant c_wr_sync_period           : natural := 512;
    
      -- Typical DDR access stimuli
      -- . write block of words in 1 write access and then readback in 4 block read accesses
      -- . use appropriate c_len to access across a DDR address column (a_col_w=10)
      constant c_nof_access_per_block     : natural := g_nof_wr_per_block + g_nof_rd_per_block;
      constant c_nof_access               : natural := g_nof_block * c_nof_access_per_block;
    
      function func_ctlr_address_lo_arr return t_nat_natural_arr is
        constant c_wr  : natural := g_block_len / g_nof_wr_per_block;
        constant c_rd  : natural := g_block_len / g_nof_rd_per_block;
        variable v_arr : t_nat_natural_arr(0 to c_nof_access - 1);
      begin
        for R in 0 to g_nof_block - 1 loop
          -- Write block in g_nof_wr_per_block accesses
          for I in 0 to g_nof_wr_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + I) := R * g_block_len + I * c_wr;
          end loop;
          -- Read back block in g_nof_rd_per_block accesses
          for I in 0 to g_nof_rd_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + g_nof_wr_per_block + I) := R * g_block_len + I * c_rd;
          end loop;
        end loop;
        return v_arr;
      end;
    
      function func_ctlr_nof_address_arr return t_nat_natural_arr is
        constant c_wr      : natural := g_block_len / g_nof_wr_per_block;
        constant c_rd      : natural := g_block_len / g_nof_rd_per_block;
        constant c_wr_last : natural := g_block_len - c_wr * (g_nof_wr_per_block - 1);
        constant c_rd_last : natural := g_block_len - c_rd * (g_nof_rd_per_block - 1);
        variable v_arr     : t_nat_natural_arr(0 to c_nof_access - 1);
      begin
        for R in 0 to g_nof_block - 1 loop
          -- Write block in g_nof_wr_per_block accesses
          for I in 0 to g_nof_wr_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + I) := c_wr;
          end loop;
          v_arr(R * c_nof_access_per_block + g_nof_wr_per_block - 1) := c_wr_last;
          -- Read back block in g_nof_rd_per_block accesses
          for I in 0 to g_nof_rd_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + g_nof_wr_per_block + I) := c_rd;
          end loop;
          v_arr(R * c_nof_access_per_block + g_nof_wr_per_block + g_nof_rd_per_block - 1) := c_rd_last;
        end loop;
        return v_arr;
      end;
    
      function func_ctlr_wr_not_rd_arr return std_logic_vector is
        variable v_arr : std_logic_vector(0 to c_nof_access - 1);
      begin
        for R in 0 to g_nof_block - 1 loop
          -- Write block in g_nof_wr_per_block accesses
          for I in 0 to g_nof_wr_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + I) := '1';
          end loop;
          -- Read back block in g_nof_rd_per_block accesses
          for I in 0 to g_nof_rd_per_block - 1 loop
            v_arr(R * c_nof_access_per_block + g_nof_wr_per_block + I) := '0';
          end loop;
        end loop;
        return v_arr;
      end;
    
      constant c_ctlr_address_lo_arr      : t_nat_natural_arr(0 to c_nof_access - 1) := func_ctlr_address_lo_arr;
      constant c_ctlr_nof_address_arr     : t_nat_natural_arr(0 to c_nof_access - 1) := func_ctlr_nof_address_arr;
      constant c_ctlr_wr_not_rd_arr       : std_logic_vector(0 to c_nof_access - 1)  := func_ctlr_wr_not_rd_arr;
    
      signal dbg_c_ctlr_address_lo_arr    : t_nat_natural_arr(0 to c_nof_access - 1) := c_ctlr_address_lo_arr;
      signal dbg_c_ctlr_nof_address_arr   : t_nat_natural_arr(0 to c_nof_access - 1) := c_ctlr_nof_address_arr;
      signal dbg_c_ctlr_wr_not_rd_arr     : std_logic_vector(0 to c_nof_access - 1)  := c_ctlr_wr_not_rd_arr;
    
      signal dbg_c_tech_ddr               : t_c_tech_ddr := c_tech_ddr;
      signal dbg_c_exp_gigabytes          : integer := c_exp_gigabytes;  -- = 0 for sim model, else nof GB
      signal dbg_c_exp_nofbytes_w         : natural := c_exp_nofbytes_w;
      signal ddr_gigabytes                : integer;
      signal dbg_c_exp_nof_bytes_per_word : natural := c_exp_nof_bytes_per_word;
      signal ctlr_nof_bytes_per_word      : natural;
      signal dbg_c_dp_data_w              : natural := c_dp_data_w;
      signal dbg_c_wr_fifo_depth          : natural := c_wr_fifo_depth;
      signal dbg_c_rd_fifo_depth          : natural := c_rd_fifo_depth;
    
      signal i_tb_end             : std_logic := '0';
      signal ctlr_ref_clk         : std_logic := '0';
      signal ctlr_ref_rst         : std_logic;
      signal ctlr_clk             : std_logic;
      signal ctlr_rst             : std_logic;
      signal dvr_clk              : std_logic := '0';
      signal dvr_rst              : std_logic;
      signal dp_clk               : std_logic := '0';
      signal dp_rst               : std_logic;
      signal mm_clk               : std_logic := '0';
      signal mm_rst               : std_logic;
    
      -- Status interface
      signal reg_io_ddr_mosi      : t_mem_mosi := c_mem_mosi_rst;
      signal reg_io_ddr_miso      : t_mem_miso := c_mem_miso_rst;
    
      -- Driver interface
      signal dvr_miso             : t_mem_ctlr_miso;
      signal dvr_mosi             : t_mem_ctlr_mosi;
    
      signal dvr_done             : std_logic;
      signal dvr_en               : std_logic;
      signal dvr_wr_not_rd        : std_logic;
      signal dvr_start_address    : std_logic_vector(c_ctlr_address_w - 1 downto 0);
      signal dvr_nof_data         : std_logic_vector(c_ctlr_address_w - 1 downto 0);
      signal dvr_wr_flush_en      : std_logic;
    
      signal diag_wr_src_in       : t_dp_siso;
      signal diag_wr_src_out      : t_dp_sosi;
    
      signal wr_fifo_usedw        : std_logic_vector(ceil_log2(c_wr_fifo_depth * g_dp_factor) - 1 downto 0);
      signal wr_src_out           : t_dp_sosi;
      signal wr_val_cnt           : natural := 0;
    
      signal diag_rd_snk_out      : t_dp_siso;
      signal diag_rd_snk_in       : t_dp_sosi;
      signal rd_fifo_usedw        : std_logic_vector(ceil_log2(c_rd_fifo_depth * g_dp_factor) - 1 downto 0);
    
      signal dbg_wr_data          : std_logic_vector(c_dp_data_w - 1 downto 0);
      signal dbg_wr_val           : std_logic;
      signal dbg_rd_data          : std_logic_vector(c_dp_data_w - 1 downto 0);
      signal dbg_rd_val           : std_logic;
    
      signal src_diag_en          : std_logic;
      signal src_val_cnt          : std_logic_vector(31 downto 0);
    
      signal snk_diag_en          : std_logic;
      signal snk_diag_res         : std_logic;
      signal snk_diag_res_val     : std_logic;
      signal snk_val_cnt          : std_logic_vector(31 downto 0);
      signal expected_cnt         : natural;
    
      -- DDR3 PHY interface
      signal phy3_in              : t_tech_ddr3_phy_in;
      signal phy3_io              : t_tech_ddr3_phy_io;
      signal phy3_ou              : t_tech_ddr3_phy_ou;
    
      -- DDR4 PHY interface
      signal phy4_in              : t_tech_ddr4_phy_in;
      signal phy4_io              : t_tech_ddr4_phy_io;
      signal phy4_ou              : t_tech_ddr4_phy_ou;
    begin
      ctlr_ref_clk <= not ctlr_ref_clk or i_tb_end after c_ctlr_ref_clk_period / 2;
    
      dvr_clk  <= not dvr_clk or i_tb_end after g_dvr_clk_period / 2;
      dvr_rst  <= '1', '0' after 100 ns;
    
      dp_clk   <= not dp_clk or i_tb_end after c_dp_clk_period / 2;
      dp_rst   <= '1', '0' after 100 ns;
    
      mm_clk   <= not mm_clk or i_tb_end after c_mm_clk_period / 2;
      mm_rst   <= '1', '0' after 100 ns;
    
      tb_end <= i_tb_end;
    
      p_stimuli : process
      begin
        i_tb_end          <= '0';
        dvr_en            <= '0';
        dvr_wr_flush_en   <= '0';
        dvr_wr_not_rd     <= '0';
        dvr_start_address <= (others => '0');
        dvr_nof_data      <= (others => '0');
        src_diag_en       <= '0';
        snk_diag_en       <= '0';
        expected_cnt      <= 0;
        ctlr_ref_rst      <= '1';
        wait for 100 ns;
        ctlr_ref_rst      <= '0';
    
        -- Wait until calibration done (and ctlr_rst released)
        proc_common_wait_until_high(dvr_clk, dvr_done);
    
        -- Read DDR4 memory status
        proc_common_wait_cross_clock_domain_latency(mm_clk, dp_clk);
        proc_mem_mm_bus_rd(0, mm_clk, reg_io_ddr_miso, reg_io_ddr_mosi);
        proc_mem_mm_bus_rd_latency(1, mm_clk);
        -- . verify ddr_gigabytes
        ddr_gigabytes <= TO_SINT(reg_io_ddr_miso.rddata(23 downto 16));
        proc_common_wait_some_cycles(mm_clk, 1);
        assert ddr_gigabytes = c_exp_gigabytes report "Wrong read ddr_gigabytes" severity ERROR;
        -- . verify ctlr_nof_bytes_per_word
        ctlr_nof_bytes_per_word  <= TO_UINT(reg_io_ddr_miso.rddata(15 downto 8));
        proc_common_wait_some_cycles(mm_clk, 1);
        assert ctlr_nof_bytes_per_word = c_exp_nof_bytes_per_word report "Wrong read ctlr_nof_bytes_per_word" severity ERROR;
    
        -- Start diagnostics source for write and sink for verify read
        proc_common_wait_some_cycles(dp_clk, 1);
        src_diag_en <= '1';
        snk_diag_en <= '1';
    
        -- After reset the write FIFO is flushed until the first write access is started, even when dvr_wr_flush_en='0'
        proc_common_wait_some_cycles(ctlr_clk, 1000);
    
        for R in 0 to g_nof_repeat - 1 loop
          proc_common_wait_some_cycles(dvr_clk, 1);
          for I in c_ctlr_address_lo_arr'range loop
            dvr_start_address <= TO_UVEC(c_ctlr_address_lo_arr(I),  c_ctlr_address_w);
            dvr_nof_data      <= TO_UVEC(c_ctlr_nof_address_arr(I), c_ctlr_address_w);
    
            -- START ACCESS
            dvr_wr_not_rd <= c_ctlr_wr_not_rd_arr(I);
            dvr_en        <= '1';
            proc_common_wait_some_cycles(dvr_clk, 1);
            dvr_en        <= '0';
    
            -- ACCESS DONE
            proc_common_wait_until_lo_hi(dvr_clk, dvr_done);
    
            if c_ctlr_wr_not_rd_arr(I) = '0' then
              expected_cnt <= expected_cnt + c_ctlr_nof_address_arr(I) * g_dp_factor;
            end if;
          end loop;
    
          -- Stop diagnostics source
          proc_common_wait_some_cycles(dp_clk, 1);
          src_diag_en <= '0';
    
          -- Flush the wr fifo
          proc_common_wait_some_cycles(dvr_clk, 1);
          dvr_wr_flush_en <= '1';
          proc_common_wait_some_cycles(dvr_clk, 1);
          dvr_wr_flush_en <= '0';
    
          -- Wait until the wr fifo has been flushed and the rd fifo has been read empty
          proc_common_wait_some_cycles(ctlr_clk, c_tech_ddr.command_queue_depth * c_tech_ddr.maxburstsize);  -- rd FIFO may still get filled some more
          proc_common_wait_some_cycles(ctlr_clk, largest(TO_UINT(wr_fifo_usedw) / g_dp_factor, TO_UINT(rd_fifo_usedw)));
          proc_common_wait_some_cycles(ctlr_clk, 10);  -- some extra margin
    
          assert unsigned(wr_fifo_usedw) < g_dp_factor  report "[ERROR] Write FIFO is flushed but not empty!" severity FAILURE;
          assert unsigned(rd_fifo_usedw) = 0            report "[ERROR] Read FIFO is not empty!" severity FAILURE;
          assert unsigned(snk_val_cnt)   = expected_cnt report "[ERROR] Unexpected number of read data!" severity FAILURE;
    
          -- Check diagnostics sink after the rd fifo has been read empty
          proc_common_wait_some_cycles(dp_clk, 1);
          assert snk_diag_res_val = '1' report "[ERROR] DIAG_RES INVALID!" severity FAILURE;
          --ASSERT snk_diag_res = '0' REPORT "[ERROR] WRONG DIAG_RES!" SEVERITY FAILURE;
          --FIXME: Add 4GB DDR4 IO driver IP for unb2c and then uncomment ASSERT snk_diag_res and delete this IF-THEN-ELSE.
          if c_tech_ddr.name = "DDR4" and g_technology = c_tech_arria10_e2sg then
            -- Cannot yet verify DDR4 for g_technology = c_tech_arria10_e2sg (is
            -- unb2c), because we have 8GB DDR4 IO Driver and 4GB DDR4 memory. In
            -- simulation these can connect, but appear to yield dbg_rd_data = 0
            -- causing wrong snk_diag_res.
            report "Did not check snk_diag_res." severity NOTE;
          else
            assert snk_diag_res = '0' report "[ERROR] WRONG DIAG_RES!" severity FAILURE;
            report "Checked snk_diag_res." severity NOTE;
          end if;
    
          -- Stop diagnostics sink
          snk_diag_en <= '0';
    
          -- Restart diagnostics source and sink
          proc_common_wait_some_cycles(dp_clk, 1);
          src_diag_en <= '1';
          snk_diag_en <= '1';
        end loop;
    
        -- If the test failed then it would have stopped already (due to SEVERITY FAILURE), so if it gets here then the test has passed
        report "[OK] Test passed." severity NOTE;
    
        -- Stop the simulation
        -- . Stopping the clocks via tb_end does end the tb for the DDR3 IP, but is not sufficient to stop the tb for the DDR4 IP.
        -- . Making ctlr_ref_rst <= '1'; also does not stop the tb with the DDR4 IP (apparently some loop remains running in the DDR4 model), so therefore force simulation stop
        i_tb_end <= '1';
    
        ctlr_ref_rst <= '1';
        if g_tb_end = false then
          report "Tb Simulation finished." severity NOTE;
        else
          report "Tb Simulation finished." severity FAILURE;
        end if;
        wait;
      end process;
    
      u_diagnostics: entity diagnostics_lib.diagnostics
      generic map (
        g_dat_w             => c_dp_data_w,
        g_nof_streams       => 1
         )
      port map (
        rst                 => dp_rst,
        clk                 => dp_clk,
    
        snk_out_arr(0)      => diag_rd_snk_out,
        snk_in_arr(0)       => diag_rd_snk_in,
        snk_diag_en(0)      => snk_diag_en,
        snk_diag_md(0)      => '1',
        snk_diag_res(0)     => snk_diag_res,
        snk_diag_res_val(0) => snk_diag_res_val,
        snk_val_cnt(0)      => snk_val_cnt,
    
        src_out_arr(0)      => diag_wr_src_out,
        src_in_arr(0)       => diag_wr_src_in,
        src_diag_en(0)      => src_diag_en,
        src_diag_md(0)      => '1',
        src_val_cnt(0)      => src_val_cnt
      );
    
      dbg_wr_data <= diag_wr_src_out.data(c_dp_data_w - 1 downto 0);
      dbg_wr_val  <= diag_wr_src_out.valid;
      dbg_rd_data <= diag_rd_snk_in.data(c_dp_data_w - 1 downto 0);
      dbg_rd_val  <= diag_rd_snk_in.valid;
    
      wr_val_cnt <= wr_val_cnt + 1 when rising_edge(dp_clk) and diag_wr_src_out.valid = '1';
    
      p_sop_eop : process (diag_wr_src_out, wr_val_cnt)
      begin
        -- Default, fits g_wr_flush_mode="VAL"
        wr_src_out <= diag_wr_src_out;
    
        if g_wr_flush_mode = "SOP" then
          wr_src_out.sop <= '0';
          wr_src_out.eop <= '0';
          if wr_val_cnt mod c_wr_frame_size = 0 then
            wr_src_out.sop <= diag_wr_src_out.valid;
          elsif wr_val_cnt mod c_wr_frame_size = c_wr_frame_size-1 then
            wr_src_out.eop <= diag_wr_src_out.valid;
          end if;
        end if;
    
        if g_wr_flush_mode = "SYN" then
          wr_src_out.sync <= '0';
          if wr_val_cnt mod c_wr_sync_period = 0 then
            wr_src_out.sync <= diag_wr_src_out.valid;
          end if;
        end if;
      end process;
    
      -- Map original dvr interface signals to t_mem_ctlr_mosi/miso
      dvr_done              <= dvr_miso.done;  -- Requested wr or rd sequence is done
      dvr_mosi.burstbegin   <= dvr_en;
      dvr_mosi.wr           <= dvr_wr_not_rd;  -- No need to use dvr_mosi.rd
      dvr_mosi.address      <= RESIZE_MEM_CTLR_ADDRESS(dvr_start_address);
      dvr_mosi.burstsize    <= RESIZE_MEM_CTLR_BURSTSIZE(dvr_nof_data);
      dvr_mosi.flush        <= dvr_wr_flush_en;
    
      u_io_ddr: entity work.io_ddr
      generic map(
        g_sim_model              => g_sim_model,
        g_technology             => g_technology,
        g_tech_ddr               => c_tech_ddr,
        g_cross_domain_dvr_ctlr  => c_cross_domain_dvr_ctlr,
        g_wr_data_w              => c_dp_data_w,
        g_wr_fifo_depth          => c_wr_fifo_depth,  -- defined at DDR side of the FIFO.
        g_rd_fifo_depth          => c_rd_fifo_depth,  -- defined at DDR side of the FIFO.
        g_rd_data_w              => c_dp_data_w,
        g_wr_flush_mode          => g_wr_flush_mode,
        g_wr_flush_use_channel   => false,
        g_wr_flush_start_channel => 0,
        g_wr_flush_nof_channels  => 1
      )
      port map (
        -- DDR reference clock
        ctlr_ref_clk       => ctlr_ref_clk,
        ctlr_ref_rst       => ctlr_ref_rst,
    
        -- DDR controller clock domain
        ctlr_clk_out       => ctlr_clk,
        ctlr_rst_out       => ctlr_rst,
    
        ctlr_clk_in        => ctlr_clk,  -- connect ctlr_clk_out to ctlr_clk_in at top level to avoid potential delta-cycle differences between the same clock
        ctlr_rst_in        => ctlr_rst,
    
        -- MM clock domain
        mm_clk             => mm_clk,
        mm_rst             => mm_rst,
    
        -- MM register map for DDR controller status info
        reg_io_ddr_mosi    => reg_io_ddr_mosi,
        reg_io_ddr_miso    => reg_io_ddr_miso,
    
        -- Driver clock domain
        dvr_clk            => dvr_clk,
        dvr_rst            => dvr_rst,
    
        dvr_miso           => dvr_miso,
        dvr_mosi           => dvr_mosi,
    
        -- Write FIFO clock domain
        wr_clk             => dp_clk,
        wr_rst             => dp_rst,
    
        wr_fifo_usedw      => wr_fifo_usedw,
        wr_sosi            => wr_src_out,
        wr_siso            => diag_wr_src_in,
    
        -- Read FIFO clock domain
        rd_clk             => dp_clk,
        rd_rst             => dp_rst,
    
        rd_fifo_usedw      => rd_fifo_usedw,
        rd_sosi            => diag_rd_snk_in,
        rd_siso            => diag_rd_snk_out,
    
        -- DDR3 PHY external interface
        phy3_ou            => phy3_ou,
        phy3_io            => phy3_io,
        phy3_in            => phy3_in,
    
        -- DDR4 PHY external interface
        phy4_ou            => phy4_ou,
        phy4_io            => phy4_io,
        phy4_in            => phy4_in
      );
    
      u_tech_ddr_memory_model : entity tech_ddr_lib.tech_ddr_memory_model
      generic map (
        g_tech_ddr => c_tech_ddr
      )
      port map (
        -- DDR3 PHY interface
        mem3_in => phy3_ou,
        mem3_io => phy3_io,
    
        -- DDR4 PHY interface
        mem4_in => phy4_ou,
        mem4_io => phy4_io
      );
    end architecture str;