Commit 1c53def3 authored by Maciej Lipinski's avatar Maciej Lipinski

Merge branch 'Fixed-latency-streamers' into proposed_master

parents 94c94685 8c3ee07c
......@@ -75,6 +75,10 @@ package wr_board_pkg is
application_size : integer
) return integer;
function f_pick_clk_ref_rate (
pcs_16bit_in : boolean
) return integer;
function f_vectorize_diag (
diag_in : t_generic_word_array;
diag_vector_size : integer)
......@@ -288,6 +292,18 @@ package body wr_board_pkg is
end if;
end f_pick_diag_size;
-- guess clk_ref (WR reference Clock) rate based on PCS word width
function f_pick_clk_ref_rate (
pcs_16bit_in : boolean
) return integer is
begin
if(pcs_16bit_in = TRUE) then
return 62500000;
else
return 125000000;
end if;
end f_pick_clk_ref_rate;
function f_vectorize_diag (
diag_in : t_generic_word_array;
diag_vector_size : integer)
......
......@@ -491,7 +491,8 @@ begin -- architecture struct
g_streamers_op_mode => g_streamers_op_mode,
g_tx_streamer_params => g_tx_streamer_params,
g_rx_streamer_params => g_rx_streamer_params,
g_simulation => g_simulation)
g_simulation => g_simulation,
g_clk_ref_rate => f_pick_clk_ref_rate(g_pcs_16bit))
port map (
clk_sys_i => clk_sys_i,
rst_n_i => rst_n_i,
......
Subproject commit 4e5f7badf0b72f51bdb01c63fcdc6d69afb4b750
Subproject commit f73bc3d2959bdaab52adf910d99ed90cabab11ab
......@@ -4,5 +4,6 @@ files = ["dmtd_phase_meas.vhd",
"hpll_period_detect.vhd",
"pulse_gen.vhd",
"oserdes_4_to_1.vhd",
"pulse_stamper.vhd" ]
"pulse_stamper.vhd",
"pulse_stamper_sync.vhd"]
......@@ -84,6 +84,31 @@ architecture rtl of pulse_stamper is
signal pulse_sys_p1 : std_logic;
signal pulse_back : std_logic_vector(2 downto 0);
-- One of two clocks is used in WR for timestamping: 125MHz or 62.5MHz
-- This functions translates the cycle count into 125MHz-clock cycles
-- in the case when 62.5MHz clock is used. As a result, timestamps are
-- always in the same "clock domain". This is important, e.g. for streamers,
-- in applicatinos where one WR Node works with 62.5MHz WR clock and
-- another in 125MHz.
function f_8ns_cycle_cnt (in_cyc: std_logic_vector; ref_clk: integer)
return std_logic_vector is
variable out_cyc : std_logic_vector(27 downto 0);
begin
if (ref_clk = 125000000) then
out_cyc := in_cyc;
elsif(ref_clk = 62500000) then
out_cyc := in_cyc(26 downto 0) & '0';
else
assert FALSE report
"The only ref_clk_rate supported: 62.5MHz and 125MHz"
severity FAILURE;
end if;
return out_cyc;
end f_8ns_cycle_cnt;
begin -- architecture rtl
-- Synchronization of external pulse into the clk_ref_i clock domain
......@@ -150,7 +175,7 @@ begin -- architecture rtl
tag_valid_o <= '0';
elsif pulse_sys_p1='1' then
tag_tai_o <= tag_utc_ref;
tag_cycles_o <= tag_cycles_ref;
tag_cycles_o <= f_8ns_cycle_cnt(tag_cycles_ref,g_ref_clk_rate);
tag_valid_o <= '1';
else
tag_valid_o <='0';
......
--------------------------------------------------------------------------------
-- CERN
-- wr-cores/timing
-- https://www.ohwr.org/project/wr-cores
--------------------------------------------------------------------------------
--
-- unit name : pulse_stamper_sync.vhd
-- author : Tomasz Wlostowski, based on pulse_stamper by Javier Serrano
-- description:
--
-- this module allows to time stamp pulses that are synchronous to clk_ref
-- domain, so in the domain of the WR time (i.e. tm_tai_i and tm_cycles_i).
-- The generated timestamp is then made available in the clk_sys domain.
--
--------------------------------------------------------------------------------
-- Copyright (c) 2019 CERN BE/CO/HT
--------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--------------------------------------------------------------------------------
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
use work.gencores_pkg.all;
entity pulse_stamper_sync is
generic (
-- reference clock frequency
g_ref_clk_rate : integer := 125000000);
port(
clk_ref_i : in std_logic; -- timing reference clock
clk_sys_i : in std_logic; -- data output reference clock
rst_n_i : in std_logic; -- system reset
pulse_i : in std_logic; -- pulse to be stamped (ref clock domain)
-------------------------------------------------------------------------------
-- Timing input (from WRPC), clk_ref_i domain
------------------------------------------------------------------------------
-- 1: time given on tm_utc_i and tm_cycles_i is valid (otherwise, don't timestamp)
tm_time_valid_i : in std_logic;
-- number of seconds
tm_tai_i : in std_logic_vector(39 downto 0);
-- number of clk_ref_i cycles
tm_cycles_i : in std_logic_vector(27 downto 0);
---------------------------------------------------------------------------
-- Time tag output (clk_sys_i domain)
---------------------------------------------------------------------------
tag_tai_o : out std_logic_vector(39 downto 0);
tag_cycles_o : out std_logic_vector(27 downto 0);
-- single-cycle pulse: strobe tag on tag_utc_o and tag_cycles_o
tag_valid_o : out std_logic;
tag_error_o : out std_logic -- 1 when pulse came with tm_time_valid_i = 0
);
end pulse_stamper_sync;
architecture rtl of pulse_stamper_sync is
signal rst_n_ref : std_logic;
signal pulse_d : std_logic;
signal tag_ready_ref, tag_ready_ref_d, tag_ready_ref_p1 : std_logic;
signal tag_time_valid_ref : std_logic;
signal tag_ready_sys_p1 : std_logic;
-- Time tagger signals
signal tag_utc_ref : std_logic_vector(39 downto 0);
signal tag_cycles_ref : std_logic_vector(27 downto 0);
-- One of two clocks is used in WR for timestamping: 125MHz or 62.5MHz
-- This functions translates the cycle count into 125MHz-clock cycles
-- in the case when 62.5MHz clock is used. As a result, timestamps are
-- always in the same "clock domain". This is important, e.g. for streamers,
-- in applicatinos where one WR Node works with 62.5MHz WR clock and
-- another in 125MHz.
function f_8ns_cycle_cnt (in_cyc : std_logic_vector; ref_clk : integer)
return std_logic_vector is
variable out_cyc : std_logic_vector(27 downto 0);
begin
if (ref_clk = 125000000) then
out_cyc := in_cyc;
elsif(ref_clk = 62500000) then
out_cyc := in_cyc(26 downto 0) & '0';
else
assert false report
"The only ref_clk_rate supported: 62.5MHz and 125MHz"
severity failure;
end if;
return out_cyc;
end f_8ns_cycle_cnt;
begin -- architecture rtl
U_sync_reset_ref : gc_sync_ffs
generic map (
g_sync_edge => "positive")
port map (
clk_i => clk_ref_i,
rst_n_i => '1',
data_i => rst_n_i,
synced_o => rst_n_ref);
-- Time tagging of the pulse, still in the clk_ref_i domain
p_tagger : process (clk_ref_i)
begin
if rising_edge(clk_ref_i) then
if rst_n_ref = '0' then
pulse_d <= '0';
tag_ready_ref <= '0';
tag_ready_ref_d <= '0';
tag_ready_ref_p1 <= '0';
else
pulse_d <= pulse_i;
tag_ready_ref_d <= tag_ready_ref;
tag_ready_ref_p1 <= not tag_ready_ref_d and tag_ready_ref;
if pulse_i = '1' and pulse_d = '0' then
tag_utc_ref <= tm_tai_i;
tag_cycles_ref <= tm_cycles_i;
tag_time_valid_ref <= tm_time_valid_i;
tag_ready_ref <= '1';
else
tag_ready_ref <= '0';
end if;
end if;
end if;
end process;
U_SyncTagReady : gc_pulse_synchronizer2
port map (
clk_in_i => clk_ref_i,
rst_in_n_i => rst_n_ref,
clk_out_i => clk_sys_i,
rst_out_n_i => rst_n_i,
d_ready_o => open,
d_p_i => tag_ready_ref_p1,
q_p_o => tag_ready_sys_p1);
-- Now we can take the time tags into the clk_sys_i domain
p_sys_tags : process (clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
tag_tai_o <= (others => '0');
tag_cycles_o <= (others => '0');
tag_valid_o <= '0';
tag_error_o <= '0';
elsif tag_ready_sys_p1 = '1' then
tag_tai_o <= tag_utc_ref;
tag_cycles_o <= f_8ns_cycle_cnt(tag_cycles_ref, g_ref_clk_rate);
tag_valid_o <= '1';
tag_error_o <= not tag_time_valid_ref;
else
tag_valid_o <= '0';
end if;
end if;
end process;
end architecture rtl;
......@@ -93,7 +93,7 @@ architecture behavioral of ep_rx_crc_size_check is
signal crc_gen_enable : std_logic;
signal crc_gen_reset : std_logic;
signal crc_match, crc_match2 : std_logic;
signal crc_match : std_logic;
signal crc_cur : std_logic_vector(31 downto 0);
signal crc_in_data : std_logic_vector(15 downto 0);
......@@ -106,7 +106,6 @@ architecture behavioral of ep_rx_crc_size_check is
signal state : t_state;
signal q_flush, q_empty : std_logic;
signal q_purge : std_logic;
signal q_in, q_out : std_logic_vector(17 downto 0);
signal q_bytesel : std_logic;
......@@ -306,6 +305,7 @@ begin -- behavioral
src_fab_o.error <= '1';
q_purge <= '1';
elsif(snk_fab_i.eof = '1') then
q_purge <= '1';
state <= ST_WAIT_FRAME;
else
state <= ST_OOB;
......@@ -324,6 +324,7 @@ begin -- behavioral
if(src_dreq_i = '1' and snk_fab_i.eof='1') then
state <= ST_WAIT_FRAME;
q_purge <= '1';
end if;
end case;
......
......@@ -6,7 +6,7 @@
-- Author : Tomasz Wlostowski
-- Company : CERN BE-CO-HT
-- Created : 2009-06-22
-- Last update: 2017-02-02
-- Last update: 2018-10-03
-- Platform : FPGA-generic
-- Standard : VHDL'93
-------------------------------------------------------------------------------
......@@ -117,34 +117,6 @@ end ep_rx_path;
architecture behavioral of ep_rx_path is
type t_rx_deframer_state is (RXF_IDLE, RXF_DATA, RXF_FLUSH_STALL, RXF_FINISH_CYCLE, RXF_THROW_ERROR);
signal state : t_rx_deframer_state;
signal gap_cntr : unsigned(3 downto 0);
-- new sigs
signal counter : unsigned(7 downto 0);
signal rxdata_saved : std_logic_vector(15 downto 0);
signal next_hdr : std_logic;
signal is_pause : std_logic;
signal data_firstword : std_logic;
signal flush_stall : std_logic;
signal stb_int : std_logic;
signal fab_int : t_ep_internal_fabric;
signal dreq_int : std_logic;
signal ack_count : unsigned(7 downto 0);
signal src_out_int : t_wrf_source_out;
signal tmp_sel : std_logic;
signal tmp_dat : std_logic_vector(15 downto 0);
signal fab_pipe : t_fab_pipe(0 to 9);
signal dreq_pipe : std_logic_vector(9 downto 0);
......
......@@ -12,5 +12,9 @@ files = ["streamers_pkg.vhd",
"wr_streamers_wb.vhd",
"streamers_priv_pkg.vhd",
"xtx_streamers_stats.vhd",
"xrx_streamers_stats.vhd"
]
"xrx_streamers_stats.vhd",
"fixed_latency_delay.vhd",
"fixed_latency_ts_match.vhd",
"fifo_showahead_adapter.vhd",
"ts_restore_tai.vhd",
];
......@@ -58,7 +58,8 @@ entity dropping_buffer is
d_o : out std_logic_vector(g_data_width-1 downto 0);
d_valid_o : out std_logic;
d_req_i : in std_logic);
d_req_i : in std_logic;
d_full_o : out std_logic);
end dropping_buffer;
......@@ -104,6 +105,7 @@ begin -- behavioral
full <= '1' when (wr_ptr + 1 = rd_ptr) else '0';
d_req_o <= not full;
d_full_o <= full;
p_empty_reg : process(clk_i)
begin
......
--------------------------------------------------------------------------------
-- CERN
-- wr-cores/wr-streamers
-- https://www.ohwr.org/project/wr-cores
--------------------------------------------------------------------------------
--
-- unit name : fifo_showahead_adapter.vhd
-- author : Tomasz Wlostowski
-- description:
--
-- Emulation of show-ahead FIFO, used if the show-ahead feature in a FIFO
-- is not supported.
--
--
--------------------------------------------------------------------------------
-- Copyright (c) 2019 CERN BE/CO/HT
--------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--------------------------------------------------------------------------------
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
entity fifo_showahead_adapter is
generic (
g_width : integer);
port (
clk_i : in std_logic;
rst_n_i : in std_logic;
fifo_q_i : in std_logic_vector(g_width-1 downto 0);
fifo_empty_i : in std_logic;
fifo_rd_o : out std_logic;
q_o : out std_logic_vector(g_width-1 downto 0);
valid_o : out std_logic;
rd_i : in std_logic
);
end fifo_showahead_adapter;
architecture rtl of fifo_showahead_adapter is
signal rd, rd_d : std_logic;
signal valid_int : std_logic;
begin
process(clk_i)
begin
if rising_edge(clk_i) then
if rst_n_i = '0' then
rd_d <= '0';
valid_int <= '0';
else
rd_d <= rd;
if rd = '1' then
valid_int <= '1';
elsif rd_i = '1' then
valid_int <= not fifo_empty_i;
end if;
end if;
end if;
end process;
rd <= not fifo_empty_i when valid_int = '0' else rd_i and not fifo_empty_i;
q_o <= fifo_q_i;
fifo_rd_o <= rd;
valid_o <= valid_int;
end rtl;
--------------------------------------------------------------------------------
-- CERN
-- wr-cores/wr-streamers
-- https://www.ohwr.org/project/wr-cores
--------------------------------------------------------------------------------
--
-- unit name : fixed_latency_delay.vhd
-- author : Tomasz Wlostowski
-- description:
--
-- This module delays incoming data until the configured fixed
-- latency. The delayed data is stored in a dropping FIFO.
--
--
--------------------------------------------------------------------------------
-- Copyright (c) 2019 CERN BE/CO/HT
--------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--------------------------------------------------------------------------------
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
use work.gencores_pkg.all;
use work.genram_pkg.all;
use work.streamers_priv_pkg.all;
use work.streamers_pkg.all;
entity fixed_latency_delay is
generic(
g_data_width : integer;
g_buffer_size : integer;
g_use_ref_clock_for_data : integer;
g_clk_ref_rate : integer;
g_simulation : integer := 0;
g_sim_cycle_counter_range: integer := 125000000
);
port(
rst_n_i : in std_logic;
clk_sys_i : in std_logic;
clk_ref_i : in std_logic;
-- timing I/F, clk_ref_i clock domain
tm_time_valid_i : in std_logic;
tm_tai_i : in std_logic_vector(39 downto 0);
tm_cycles_i : in std_logic_vector(27 downto 0);
-- input i/f (dropping buffer)
d_data_i : in std_logic_vector(g_data_width-1 downto 0);
d_last_i : in std_logic;
d_sync_i : in std_logic;
d_target_ts_en_i : in std_logic;
d_target_ts_tai_i : in std_logic_vector(39 downto 0);
d_target_ts_cycles_i : in std_logic_vector(27 downto 0);
d_target_ts_error_i : in std_logic;
d_valid_i : in std_logic;
d_drop_i : in std_logic;
d_accept_i : in std_logic;
d_req_o : out std_logic;
d_full_o : out std_logic;
-- output data path (clk_ref_i/clk_sys_i clock domain for
-- g_use_ref_clock_for_data = 1/0 respectively)
rx_first_p1_o : out std_logic;
rx_last_p1_o : out std_logic;
rx_data_o : out std_logic_vector(g_data_width-1 downto 0);
rx_valid_o : out std_logic;
rx_dreq_i : in std_logic;
rx_late_o : out std_logic;
rx_timeout_o : out std_logic;
-- SYS clock domain
stat_match_p1_o : out std_logic;
stat_late_p1_o : out std_logic;
stat_timeout_p1_o : out std_logic;
rx_streamer_cfg_i : in t_rx_streamer_cfg
);
end entity;
architecture rtl of fixed_latency_delay is
type t_state is (IDLE, TS_SETUP_MATCH, TS_WAIT_MATCH, SEND);
signal State: t_state;
signal rst_n_ref : std_logic;
signal wr_full : std_logic;
constant c_datapath_width : integer := g_data_width + 2 + 28 + 40 + 1 + 1;
signal fifo_rd : std_logic;
signal dbuf_d : std_logic_vector(c_datapath_width-1 downto 0);
signal dbuf_q : std_logic_vector(c_datapath_width-1 downto 0);
signal fifo_q : std_logic_vector(c_datapath_width-1 downto 0);
signal dbuf_q_valid : std_logic;
signal dbuf_req : std_logic;
signal fifo_data : std_logic_vector(g_data_width-1 downto 0);
signal fifo_sync, fifo_last, fifo_target_ts_en : std_logic;
signal fifo_target_ts : std_logic_vector(27 downto 0);
signal fifo_empty : std_logic;
signal fifo_we : std_logic;
signal fifo_valid : std_logic;
signal rx_valid : std_logic;
signal delay_arm_p : std_logic;
signal delay_match_p : std_logic;
signal delay_miss_p : std_logic;
signal delay_timeout_p : std_logic;
signal fifo_target_ts_error : std_logic;
signal fifo_target_ts_tai : std_logic_vector(39 downto 0);
signal fifo_target_ts_cycles : std_logic_vector(27 downto 0);
signal clk_data : std_logic;
signal rst_n_data : std_logic;
begin
U_SyncReset_to_RefClk : gc_sync_ffs
port map (
clk_i => clk_ref_i,
rst_n_i => '1',
data_i => rst_n_i,
synced_o => rst_n_ref);
-- choose which clock to use as clk_data
clk_data <= clk_sys_i when g_use_ref_clock_for_data = 0 else clk_ref_i;
rst_n_data <= rst_n_i when g_use_ref_clock_for_data = 0 else rst_n_ref;
-- Pack input data to the FIFO in clk_sys_i clock domain
dbuf_d(g_data_width-1 downto 0) <= d_data_i;
dbuf_d(g_data_width) <= d_last_i;
dbuf_d(g_data_width+1) <= d_sync_i;
dbuf_d(g_data_width+2) <= d_target_ts_en_i;
dbuf_d(g_data_width+3+27 downto g_data_width+3) <= d_target_ts_cycles_i;
dbuf_d(g_data_width+3+28+39 downto g_data_width+3+28) <= d_target_ts_tai_i;
dbuf_d(g_data_width+3+28+40) <= d_target_ts_error_i;
U_DropBuffer : entity work.dropping_buffer
generic map (
g_size => g_buffer_size,
g_data_width => c_datapath_width)
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
d_i => dbuf_d,
d_req_o => d_req_o,
d_drop_i => d_drop_i,
d_accept_i => d_accept_i,
d_valid_i => d_valid_i,
d_full_o => d_full_o,
d_o => dbuf_q,
d_valid_o => dbuf_q_valid,
d_req_i => dbuf_req);
dbuf_req <= not wr_full;
fifo_we <= dbuf_q_valid and not wr_full;
U_ClockSyncFifo : generic_async_fifo
generic map (
g_data_width => c_datapath_width,
g_size => 16,
g_show_ahead => false)
port map (
rst_n_i => rst_n_i,
clk_wr_i => clk_sys_i,
d_i => dbuf_q,
we_i => dbuf_q_valid,
wr_full_o => wr_full,
clk_rd_i => clk_data,
q_o => fifo_q,
rd_i => fifo_rd,
rd_empty_o => fifo_empty);
-- FSM that controls the readout from the FIFO and the delaying of
-- exposing the data to the user.
p_fsm_seq: process(clk_data)
begin
if rising_edge(clk_data) then
if rst_n_data = '0' then
state <= IDLE;
fifo_valid <= '0';
else
if fifo_rd = '1' and fifo_empty = '0' then
fifo_valid <= '1';
elsif rx_valid = '1' then
fifo_valid <= '0';
end if;
case state is
-- wait for data to come
when IDLE =>
if fifo_empty = '0' then
state <= TS_SETUP_MATCH;
end if;
-- decide whether to delay the release of data or not, based on config
when TS_SETUP_MATCH =>
if fifo_valid = '1' then
if fifo_target_ts_en = '1' and fifo_target_ts_error = '0' then
state <= TS_WAIT_MATCH;
else
state <= SEND;
end if;
end if;
-- wait for the correct time (fixed-delay per config)
when TS_WAIT_MATCH =>
if delay_miss_p = '1' or delay_match_p = '1' or delay_timeout_p = '1' then
if fifo_last = '1' and fifo_empty = '0' then
state <= TS_SETUP_MATCH;
else
state <= SEND;
end if;
end if;
-- provide the data to the user
when SEND =>
if fifo_last = '1' and fifo_valid = '1' then
if fifo_empty = '1' then
state <= IDLE; -- nothing in the FIFO
else
state <= TS_SETUP_MATCH; -- new frame
end if;
elsif fifo_empty = '1' then
state <= IDLE; -- nothing in the FIFO
end if;
end case;
end if;
end if;
end process;
-- the module that is used when fixed-delay is requested. In notifies
-- the FSM when the configured fixed-latency has expired.
U_Compare: entity work.fixed_latency_ts_match
generic map (
g_clk_ref_rate => g_clk_ref_rate,
g_sim_cycle_counter_range => g_sim_cycle_counter_range,
g_simulation => g_simulation,
g_use_ref_clock_for_data => g_use_ref_clock_for_data)
port map (
clk_ref_i => clk_ref_i,
clk_data_i => clk_data,
rst_ref_n_i => rst_n_ref,
rst_data_n_i => rst_n_data,
-- in clk_data (clk_sys_i or clk_ref_i) domain
arm_p_i => delay_arm_p,
ts_tai_i => fifo_target_ts_tai,
ts_cycles_i => fifo_target_ts_cycles,
-- in clk_sys_i domain
ts_latency_i => rx_streamer_cfg_i.fixed_latency,
ts_timeout_i => rx_streamer_cfg_i.fixed_latency_timeout,
-- in clk_ref_i domain
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
-- in clk_data (clk_sys_i or clk_ref_i) domain
timeout_p_o => delay_timeout_p,
match_p_o => delay_match_p,
late_p_o => delay_miss_p);
-- combinatorial part of the above FSM
p_fsm_comb: process(state, rx_dreq_i, fifo_empty, delay_miss_p, fifo_last, delay_match_p, delay_timeout_p, fifo_target_ts_en, fifo_valid)
begin
case state is
when IDLE =>
delay_arm_p <= '0';
fifo_rd <= not fifo_empty;
rx_valid <= '0';
rx_late_o <= '0';
rx_timeout_o <= '0';
when TS_SETUP_MATCH =>
delay_arm_p <= fifo_valid and fifo_target_ts_en and not fifo_target_ts_error;
fifo_rd <= '0';
rx_valid <= '0';
rx_late_o <= '0';
rx_timeout_o <= '0';
when TS_WAIT_MATCH =>
delay_arm_p <= '0';
fifo_rd <= (delay_match_p or delay_miss_p or delay_timeout_p) and not fifo_empty;
rx_valid <= delay_match_p or delay_miss_p;
rx_late_o <= delay_miss_p;
rx_timeout_o <= delay_timeout_p;
when SEND =>
delay_arm_p <= '0';
fifo_rd <= (rx_dreq_i or (fifo_last and fifo_valid)) and not fifo_empty;
rx_valid <= fifo_valid;
rx_late_o <= '0';
rx_timeout_o <= '0';
end case;
end process;
-----------------------------------------------------------------------------
-- synchronize signals for stats counters that are in clk_sys_i domain
-----------------------------------------------------------------------------
U_Sync_RXMatch_Pulse : gc_pulse_synchronizer2
port map (
clk_in_i => clk_data,
rst_in_n_i => rst_n_data,
clk_out_i => clk_sys_i,
rst_out_n_i => rst_n_i,
d_p_i => delay_match_p,
q_p_o => stat_match_p1_o);
U_Sync_RXLate_Pulse : gc_pulse_synchronizer2
port map (
clk_in_i => clk_data,
rst_in_n_i => rst_n_data,
clk_out_i => clk_sys_i,
rst_out_n_i => rst_n_i,
d_p_i => delay_miss_p,
q_p_o => stat_late_p1_o);
U_Sync_RXTimeout_Pulse : gc_pulse_synchronizer2
port map (
clk_in_i => clk_data,
rst_in_n_i => rst_n_data,
clk_out_i => clk_sys_i,
rst_out_n_i => rst_n_i,
d_p_i => delay_timeout_p,
q_p_o => stat_timeout_p1_o);
-- decode the data from FIFO in clk_data_i (clk_ref_i or clk_sys_i) domain
fifo_data <= fifo_q(g_data_width-1 downto 0);
fifo_last <= fifo_q(g_data_width);
fifo_sync <= fifo_q(g_data_width+1);
fifo_target_ts_en <= fifo_q(g_data_width+2);
fifo_target_ts_cycles <= fifo_q(g_data_width+3+27 downto g_data_width+3);
fifo_target_ts_tai <= fifo_q(g_data_width+3+28+39 downto g_data_width+3+28);
fifo_target_ts_error <= fifo_q(g_data_width+3+28+40);
-- signals that are outputs to the user
rx_data_o <= fifo_data;
rx_valid_o <= rx_valid;
rx_first_p1_o <= fifo_sync and rx_valid;
rx_last_p1_o <= fifo_last and rx_valid;
end rtl;
--------------------------------------------------------------------------------
-- CERN
-- wr-cores/wr-streamers
-- https://www.ohwr.org/project/wr-cores
--------------------------------------------------------------------------------
--
-- unit name : fixed_latency_ts_match.vhd
-- author : Tomasz Wlostowski
-- description:
--
-- Module that "fires" (pulse on match_o) when the current TAI time
-- is exactly input timestamped delayed by input latency, i.e.
-- current_TAI_time = ts_tai_i + ts_cycles_i + ts_latency_i
-- The module includes handling of timeout and "missed deadline", i.e. the
-- situation in which current TAI time is already passed the delayed timestamp.
--
--
--------------------------------------------------------------------------------
-- Copyright (c) 2019 CERN BE/CO/HT
--------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--------------------------------------------------------------------------------
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
entity fixed_latency_ts_match is
generic
(g_clk_ref_rate : integer;
g_simulation : integer := 0;
g_sim_cycle_counter_range : integer := 125000000;
g_use_ref_clock_for_data : integer := 0
);
port
(
clk_ref_i : in std_logic;
clk_data_i : in std_logic; -- either clk_sys_i or clk_ref_i
rst_ref_n_i : in std_logic;
rst_data_n_i : in std_logic;
-- in clk_data (clk_sys_i or clk_ref_i) domain
arm_p_i : in std_logic;
ts_tai_i : in std_logic_vector(39 downto 0);
ts_cycles_i : in std_logic_vector(27 downto 0);
-- in clk_sys_i domain
ts_latency_i : in std_logic_vector(27 downto 0);
ts_timeout_i : in std_logic_vector(27 downto 0);
-- in clk_ref_i domain
tm_time_valid_i : in std_logic := '0';
tm_tai_i : in std_logic_vector(39 downto 0) := x"0000000000";
-- Fractional part of the second (in clk_ref_i cycles)
tm_cycles_i : in std_logic_vector(27 downto 0) := x"0000000";
-- in clk_data (clk_sys_i or clk_ref_i) domain
match_p_o : out std_logic;
late_p_o : out std_logic;
timeout_p_o : out std_logic
);
end entity;
architecture rtl of fixed_latency_ts_match is
type t_state is (IDLE, WRAP_ADJ_TS, CHECK_LATE, WAIT_TRIG);
impure function f_cycles_counter_range return integer is
begin
if g_simulation = 1 then
if g_clk_ref_rate = 62500000 then
return 2*g_sim_cycle_counter_range;
else
return g_sim_cycle_counter_range;
end if;
else
return 125000000;
end if;
end function;
signal ts_adjusted_cycles : unsigned(28 downto 0);
signal ts_adjusted_tai : unsigned(39 downto 0);
signal ts_timeout_cycles : unsigned(28 downto 0);
signal ts_timeout_tai : unsigned(39 downto 0);
signal ts_adjusted_cycles_latched : unsigned(28 downto 0);
signal ts_adjusted_tai_latched : unsigned(39 downto 0);
signal ts_timeout_cycles_latched : unsigned(28 downto 0);
signal ts_timeout_tai_latched : unsigned(39 downto 0);
signal tm_cycles_scaled : unsigned(28 downto 0);
signal ts_latency_scaled : unsigned(28 downto 0);
signal ts_timeout_scaled : unsigned(28 downto 0);
signal tm_cycles_scaled_d : unsigned(28 downto 0);
signal tm_tai_d : unsigned(39 downto 0);
signal match, late, timeout : std_logic;
signal state : t_state;
signal trig : std_logic;
signal arm_synced_p, arm_synced_p_d : std_logic;
signal wait_cnt : unsigned(23 downto 0);
begin
process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
tm_cycles_scaled_d <= tm_cycles_scaled;
tm_tai_d <= unsigned(tm_tai_i);
end if;
end process;
-- clk_ref_i domain: tm_cycles_i
-- sys_clk domain: ts_latency_i & ts_timeout_i
-- scale the cycle counts depending what clack is used as ref_clk.
-- The software input assumes 125MHz clock (8ns cycle).
process(tm_cycles_i, ts_latency_i, ts_timeout_i)
begin
if g_clk_ref_rate = 62500000 then
tm_cycles_scaled <= unsigned(tm_cycles_i & '0');
ts_latency_scaled <= unsigned(ts_latency_i & '0');
ts_timeout_scaled <= unsigned(ts_timeout_i & '0');
elsif g_clk_ref_rate = 125000000 then
tm_cycles_scaled <= unsigned('0' & tm_cycles_i);
ts_latency_scaled <= unsigned('0' & ts_latency_i);
ts_timeout_scaled <= unsigned('0' & ts_timeout_i);
else
report "Unsupported g_clk_ref_rate (62.5 / 125 MHz)" severity failure;
end if;
end process;
--ML: this seems unsed
process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
if rst_ref_n_i = '0' then
wait_cnt <= (others => '0');
trig <= '0';
else
case State is
when IDLE =>
wait_cnt <= (others => '0');
trig <= '0';
when others =>
wait_cnt <= wait_cnt + 1;
if wait_cnt = 3000 then
trig <= '1';
end if;
end case;
end if;
end if;
end process;
------------------------------------------------------------------------------
-- FSM that always works in clk_ref_i domain because it compares the current
-- WR TAI/cycles value with the expected value whent the fixed-latency is
-- reached. It also handles the cases when
-- 1) it's already too late, in such case it notifies with late_o
-- 2) the latency was not achieved in a configured timeout amount of time,
-- in such case it notifies with timeout_p_o
-- If all goes well and the delayed TAI/cycles were reached, it notifes with
-- match_p_o
------------------------------------------------------------------------------
process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
if rst_ref_n_i = '0' then
late <= '0';
match <= '0';
State <= IDLE;
else
case State is
when IDLE =>
match <= '0';
late <= '0';
timeout <= '0';
-- save the configuration when starting to receive frame to be
-- fixed-latency delayed
if arm_synced_p_d = '1' then
ts_adjusted_tai <= ts_adjusted_tai_latched;
ts_adjusted_cycles <= ts_adjusted_cycles_latched;
ts_timeout_tai <= ts_timeout_tai_latched;
ts_timeout_cycles <= ts_timeout_cycles_latched;
State <= WRAP_ADJ_TS;
end if;
when WRAP_ADJ_TS =>
-- adjust TAI seconds if the delayed latency timestamp is in the next TAI second
if ts_adjusted_cycles >= f_cycles_counter_range then
ts_adjusted_cycles <= ts_adjusted_cycles - f_cycles_counter_range;
ts_adjusted_tai <= ts_adjusted_tai + 1;
end if;
-- adjust TAI seconds if the delayed timeout timestamp is in the next TAI second
if ts_timeout_cycles >= f_cycles_counter_range then
ts_timeout_cycles <= ts_timeout_cycles - f_cycles_counter_range;
ts_timeout_tai <= ts_timeout_tai + 1;
end if;
state <= CHECK_LATE;
when CHECK_LATE => -- handle all the late cases
-- if the time is temporarily incorrect, we assume we are late, send the info out
if tm_time_valid_i = '0' then
late <= '1';
state <= IDLE;
end if;
-- if we are in the future relateive to the delayed timestamp, we are definitely late
if ts_adjusted_tai < tm_tai_d then
late <= '1';
State <= IDLE;
elsif ts_adjusted_tai = tm_tai_d and ts_adjusted_cycles <= tm_cycles_scaled_d then
late <= '1';
State <= IDLE;
else
State <= WAIT_TRIG;
end if;
when WAIT_TRIG => -- wait for the correct timestamp for exposing the data, or timeout
if tm_tai_d > ts_timeout_tai or
(ts_timeout_tai = tm_tai_d and tm_cycles_scaled_d > ts_timeout_cycles) then
timeout <= '1';
State <= IDLE;
end if;
if ts_adjusted_cycles = tm_cycles_scaled_d and ts_adjusted_tai = tm_tai_d then
match <= '1';
State <= IDLE;
end if;
end case;
end if;
end if;
end process;
------------------------------------------------------------------------------
-- clk_data_i == clk_ref_i | data is in the ref_clk domain
------------------------------------------------------------------------------
gen_data_synchronous_to_wr : if g_use_ref_clock_for_data /= 0 generate
match_p_o <= match;
late_p_o <= late;
timeout_p_o <= timeout;
arm_synced_p <= arm_p_i;
process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
arm_synced_p_d <= arm_synced_p;
if arm_synced_p = '1' then
ts_adjusted_cycles_latched <= resize(unsigned(ts_cycles_i) + unsigned(ts_latency_scaled), 29);
ts_adjusted_tai_latched <= resize(unsigned(ts_tai_i), 40);
ts_timeout_cycles_latched <= resize(unsigned(ts_cycles_i) + unsigned(ts_timeout_scaled), 29);
ts_timeout_tai_latched <= resize(unsigned(ts_tai_i), 40);
end if;
end if;
end process;
end generate;
------------------------------------------------------------------------------
-- clk_data_i != clk_ref_i | data is in the sys_clk domain
------------------------------------------------------------------------------
gen_data_asynchronous_to_wr : if g_use_ref_clock_for_data = 0 generate
U_Sync1: entity work.gc_pulse_synchronizer2
port map (
clk_in_i => clk_data_i,
clk_out_i => clk_ref_i,
rst_in_n_i => rst_data_n_i,
rst_out_n_i => rst_ref_n_i,
d_ready_o => open,
d_p_i => arm_p_i,
q_p_o => arm_synced_p_d);
U_Sync2: entity work.gc_pulse_synchronizer2
port map (
clk_in_i => clk_ref_i,
clk_out_i => clk_data_i,
rst_in_n_i => rst_ref_n_i,
rst_out_n_i => rst_data_n_i,
d_ready_o => open,
d_p_i => match,
q_p_o => match_p_o);
U_Sync3: entity work.gc_pulse_synchronizer2
port map (
clk_in_i => clk_ref_i,
clk_out_i => clk_data_i,
rst_in_n_i => rst_ref_n_i,
rst_out_n_i => rst_data_n_i,
d_ready_o => open,
d_p_i => late,
q_p_o => late_p_o);
U_Sync4: entity work.gc_pulse_synchronizer2
port map (
clk_in_i => clk_ref_i,
clk_out_i => clk_data_i,
rst_in_n_i => rst_ref_n_i,
rst_out_n_i => rst_data_n_i,
d_ready_o => open,
d_p_i => timeout,
q_p_o => timeout_p_o);
process(clk_data_i)
begin
if rising_edge(clk_data_i) then
if arm_p_i = '1' then
ts_adjusted_cycles_latched <= resize(unsigned(ts_cycles_i) + unsigned(ts_latency_scaled), 29);
ts_adjusted_tai_latched <= resize(unsigned(ts_tai_i), 40);
ts_timeout_cycles_latched <= resize(unsigned(ts_cycles_i) + unsigned(ts_timeout_scaled), 29);
ts_timeout_tai_latched <= resize(unsigned(ts_tai_i), 40);
end if;
end if;
end process;
end generate;
end rtl;
......@@ -75,6 +75,11 @@ package streamers_pkg is
-- legacy: the streamers initially used in Btrain did not check/insert the escape
-- code. This is justified if only one block of a known number of words is sent/expected
escape_code_disable : boolean;
-- when non-zero, the datapath (tx port) are in the clk_ref_i clock
-- domain instead of clk_sys_i. This is a must for fixed latency mode if
-- clk_sys_i is asynchronous (i.e. not locked) to the WR timing.
use_ref_clk_for_data : integer;
end record;
-----------------------------------------------------------------------------------------
......@@ -105,6 +110,11 @@ package streamers_pkg is
-- In combination with the g_escape_code_disable generic set to TRUE, the behaviour of
-- the "Btrain streamers" can be recreated.
expected_words_number : integer;
-- when non-zero, the datapath (rx port) are in the clk_ref_i clock
-- domain instead of clk_sys_i. This is a must for fixed latency mode if
-- clk_sys_i is asynchronous (i.e. not locked) to the WR timing.
use_ref_clk_for_data : integer;
end record;
constant c_tx_streamer_params_defaut: t_tx_streamer_params :=(
......@@ -113,12 +123,14 @@ package streamers_pkg is
threshold => 128,
max_words_per_frame => 256,
timeout => 1024,
use_ref_clk_for_data => 0,
escape_code_disable => FALSE);
constant c_rx_streamer_params_defaut: t_rx_streamer_params :=(
data_width => 32,
buffer_size => 256,
escape_code_disable => FALSE,
use_ref_clk_for_data => 0,
expected_words_number => 0);
type t_rx_streamer_cfg is record
......@@ -139,6 +151,13 @@ package streamers_pkg is
filter_remote : std_logic;
-- value in cycles of fixed-latency enforced on data
fixed_latency : std_logic_vector(27 downto 0);
-- value in cycles of fixed-latency timeout (if it takes longer than this value
-- to output the packet, it's dropped)
fixed_latency_timeout : std_logic_vector(27 downto 0);
-- software controlled reset
sw_reset : std_logic;
end record;
type t_tx_streamer_cfg is record
......@@ -156,6 +175,8 @@ package streamers_pkg is
qtag_vid : std_logic_vector(11 downto 0);
-- priority used to tag
qtag_prio : std_logic_vector(2 downto 0);
-- software controlled reset
sw_reset : std_logic;
end record;
constant c_rx_streamer_cfg_default: t_rx_streamer_cfg :=(
......@@ -164,7 +185,9 @@ package streamers_pkg is
ethertype => x"dbff",
accept_broadcasts => '1',
filter_remote => '0',
fixed_latency => x"0000000");
fixed_latency => x"0000000",
fixed_latency_timeout => x"1000000",
sw_reset => '0');
constant c_tx_streamer_cfg_default: t_tx_streamer_cfg :=(
mac_local => x"000000000000",
......@@ -172,7 +195,8 @@ package streamers_pkg is
ethertype => x"dbff",
qtag_ena => '0',
qtag_vid => x"000",
qtag_prio => "000");
qtag_prio => "000",
sw_reset => '0');
component xtx_streamer
generic (
......@@ -183,13 +207,15 @@ package streamers_pkg is
g_tx_timeout : integer := 1024;
g_escape_code_disable : boolean := FALSE;
g_simulation : integer := 0;
g_sim_startup_cnt : integer := 6250);--100us
g_sim_startup_cnt : integer := 6250;--100us
g_clk_ref_rate : integer := 125000000;
g_use_ref_clock_for_data : integer := 0);
port (
clk_sys_i : in std_logic;
clk_ref_i : in std_logic := '0';
rst_n_i : in std_logic;
src_i : in t_wrf_source_in;
src_o : out t_wrf_source_out;
clk_ref_i : in std_logic := '0';
tm_time_valid_i : in std_logic := '0';
tm_tai_i : in std_logic_vector(39 downto 0) := x"0000000000";
tm_cycles_i : in std_logic_vector(27 downto 0) := x"0000000";
......@@ -209,7 +235,11 @@ package streamers_pkg is
g_data_width : integer := 32;
g_buffer_size : integer := 256;
g_escape_code_disable : boolean := FALSE;
g_expected_words_number : integer := 0);
g_expected_words_number : integer := 0;
g_clk_ref_rate : integer := 125000000;
g_simulation : integer := 0;
g_sim_cycle_counter_range : integer := 125000000;
g_use_ref_clock_for_data : integer := 0);
port (
clk_sys_i : in std_logic;
rst_n_i : in std_logic;
......@@ -223,6 +253,8 @@ package streamers_pkg is
rx_last_p1_o : out std_logic;
rx_data_o : out std_logic_vector(g_data_width-1 downto 0);
rx_valid_o : out std_logic;
rx_late_o : out std_logic;
rx_timeout_o : out std_logic;
rx_dreq_i : in std_logic;
rx_lost_p1_o : out std_logic := '0';
rx_lost_blocks_p1_o : out std_logic := '0';
......@@ -230,16 +262,21 @@ package streamers_pkg is
rx_lost_frames_cnt_o : out std_logic_vector(14 downto 0);
rx_latency_o : out std_logic_vector(27 downto 0);
rx_latency_valid_o : out std_logic;
rx_stat_overflow_p1_o : out std_logic;
rx_stat_match_p1_o : out std_logic;
rx_stat_late_p1_o : out std_logic;
rx_stat_timeout_p1_o : out std_logic;
rx_frame_p1_o : out std_logic;
rx_streamer_cfg_i : in t_rx_streamer_cfg := c_rx_streamer_cfg_default);
end component;
constant c_WRS_STATS_ARR_SIZE_OUT : integer := 18;
constant c_WRS_STATS_ARR_SIZE_OUT : integer := 24;
constant c_WRS_STATS_ARR_SIZE_IN : integer := 1;
component xrtx_streamers_stats is
generic (
g_streamers_op_mode : t_streamers_op_mode := TX_AND_RX;
g_clk_ref_rate : integer := 125000000;
g_cnt_width : integer := 50;
g_acc_width : integer := 64
);
......@@ -253,6 +290,9 @@ package streamers_pkg is
lost_frames_cnt_i : in std_logic_vector(14 downto 0);
rcvd_latency_i : in std_logic_vector(27 downto 0);
rcvd_latency_valid_i : in std_logic;
rx_stat_match_p1_i : in std_logic;
rx_stat_late_p1_i : in std_logic;
rx_stat_timeout_p1_i : in std_logic;
clk_ref_i : in std_logic;
tm_time_valid_i : in std_logic := '0';
tm_tai_i : in std_logic_vector(39 downto 0) := x"0000000000";
......@@ -266,6 +306,9 @@ package streamers_pkg is
lost_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_block_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_match_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_late_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_timeout_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_acc_overflow_o : out std_logic;
latency_acc_o : out std_logic_vector(g_acc_width-1 downto 0);
latency_max_o : out std_logic_vector(27 downto 0);
......@@ -281,6 +324,7 @@ package streamers_pkg is
component xwr_streamers is
generic (
g_streamers_op_mode : t_streamers_op_mode := TX_AND_RX;
g_clk_ref_rate : integer := 125000000;
--tx/rx
g_tx_streamer_params : t_tx_streamer_params := c_tx_streamer_params_defaut;
g_rx_streamer_params : t_rx_streamer_params := c_rx_streamer_params_defaut;
......@@ -290,7 +334,8 @@ package streamers_pkg is
-- WB i/f
g_slave_mode : t_wishbone_interface_mode := CLASSIC;
g_slave_granularity : t_wishbone_address_granularity := BYTE;
g_simulation : integer := 0
g_simulation : integer := 0;
g_sim_cycle_counter_range : integer := 125000
);
port (
......@@ -329,4 +374,4 @@ package streamers_pkg is
);
end component;
end streamers_pkg;
\ No newline at end of file
end streamers_pkg;
......@@ -72,9 +72,15 @@ package streamers_priv_pkg is
tm_time_valid_i : in std_logic;
snapshot_ena_i : in std_logic := '0';
reset_stats_i : in std_logic;
rx_stat_match_p1_i : in std_logic;
rx_stat_late_p1_i : in std_logic;
rx_stat_timeout_p1_i : in std_logic;
rcvd_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_block_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_match_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_late_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_timeout_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_acc_overflow_o : out std_logic;
latency_acc_o : out std_logic_vector(g_acc_width-1 downto 0);
......@@ -82,26 +88,10 @@ package streamers_priv_pkg is
latency_min_o : out std_logic_vector(27 downto 0));
end component;
component wr_streamers_wb is
port (
rst_n_i : in std_logic;
clk_sys_i : in std_logic;
wb_adr_i : in std_logic_vector(5 downto 0);
wb_dat_i : in std_logic_vector(31 downto 0);
wb_dat_o : out std_logic_vector(31 downto 0);
wb_cyc_i : in std_logic;
wb_sel_i : in std_logic_vector(3 downto 0);
wb_stb_i : in std_logic;
wb_we_i : in std_logic;
wb_ack_o : out std_logic;
wb_stall_o : out std_logic;
regs_i : in t_wr_streamers_in_registers;
regs_o : out t_wr_streamers_out_registers
);
end component;
-- component from wr-core/modules/timing
component pulse_stamper
generic (
g_ref_clk_rate : integer := 125000000);
port (
clk_ref_i : in std_logic;
clk_sys_i : in std_logic;
......
--------------------------------------------------------------------------------
-- CERN
-- wr-cores/wr-streamers
-- https://www.ohwr.org/project/wr-cores
--------------------------------------------------------------------------------
--
-- unit name : ts_restore_tai.vhd
-- author : Tomasz Wlostowski
-- description:
--
-- This module restores full TAI timestamp from the timestamp
-- received in WR_streamer frame
--
--
--------------------------------------------------------------------------------
-- Copyright (c) 2019 CERN BE/CO/HT
--------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--------------------------------------------------------------------------------
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
use work.gencores_pkg.all;
entity ts_restore_tai is
generic
(
g_tm_sample_period : integer := 20;
g_clk_ref_rate : integer;
g_simulation : integer := 0;
g_sim_cycle_counter_range : integer := 125000000
);
port (
clk_sys_i : in std_logic;
clk_ref_i : in std_logic;
rst_n_i : in std_logic;
-- Timing I/F, clk_ref_i clock domain
tm_time_valid_i : in std_logic;
tm_tai_i : in std_logic_vector(39 downto 0);
tm_cycles_i : in std_logic_vector(27 downto 0);
-- Timestamp I/F, clk_sys_i clock domain
ts_valid_i : in std_logic;
ts_cycles_i : in std_logic_vector(27 downto 0);
ts_valid_o : out std_logic;
ts_cycles_o : out std_logic_vector(27 downto 0);
ts_error_o : out std_logic;
ts_tai_o : out std_logic_vector(39 downto 0)
);
end entity;
architecture rtl of ts_restore_tai is
signal tm_cycles_sys, tm_cycles_ref, tm_cycles_ref_d : std_logic_vector(27 downto 0);
signal tm_tai_sys, tm_tai_ref, tm_tai_ref_d : std_logic_vector(39 downto 0);
signal tm_valid_sys, tm_valid_ref, tm_valid_ref_d : std_logic;
signal tm_sample_cnt : unsigned(5 downto 0);
signal tm_sample_p_ref : std_logic;
signal tm_sample_p_sys : std_logic;
impure function f_cycles_counter_range return integer is
begin
if g_simulation = 1 then
if g_clk_ref_rate = 62500000 then
return 2*g_sim_cycle_counter_range;
else
return g_sim_cycle_counter_range;
end if;
else
return 125000000;
end if;
end function;
constant c_rollover_threshold_lo : integer := f_cycles_counter_range / 4;
constant c_rollover_threshold_hi : integer := f_cycles_counter_range * 3 / 4;
signal rst_n_ref : std_logic;
begin
U_SyncReset_to_RefClk : gc_sync_ffs
port map (
clk_i => clk_ref_i,
rst_n_i => '1',
data_i => rst_n_i,
synced_o => rst_n_ref);
p_sample_tm_ref : process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
if rst_n_ref = '0' then
tm_sample_p_ref <= '0';
tm_sample_cnt <= (others => '0');
else
tm_cycles_ref <= tm_cycles_ref_d;
tm_tai_ref <= tm_tai_ref_d;
tm_valid_ref <= tm_valid_ref_d;
if tm_sample_cnt = g_tm_sample_period-1 then
tm_sample_p_ref <= '1';
tm_cycles_ref_d <= tm_cycles_i;
tm_tai_ref_d <= tm_tai_i;
tm_valid_ref_d <= tm_time_valid_i;
tm_sample_cnt <= (others => '0');
else
tm_sample_p_ref <= '0';
tm_sample_cnt <= tm_sample_cnt + 1;
end if;
end if;
end if;
end process;
U_Sync_Sample_Pulse : gc_pulse_synchronizer2
port map (
clk_in_i => clk_ref_i,
rst_in_n_i => rst_n_ref,
clk_out_i => clk_sys_i,
rst_out_n_i => rst_n_i,
d_ready_o => open,
d_p_i => tm_sample_p_ref,
q_p_o => tm_sample_p_sys);
p_sample_tm_sys : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
tm_valid_sys <= '0';
elsif tm_sample_p_sys = '1' then
tm_tai_sys <= tm_tai_ref;
tm_cycles_sys <= tm_cycles_ref;
tm_valid_sys <= tm_valid_ref;
end if;
end if;
end process;
p_process : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
ts_valid_o <= '0';
else
if ts_valid_i = '1' then
if unsigned(ts_cycles_i) > c_rollover_threshold_hi and unsigned(tm_cycles_sys) < c_rollover_threshold_lo then
ts_tai_o <= std_logic_vector(unsigned(tm_tai_sys) - 1);
else
ts_tai_o <= tm_tai_sys;
end if;
ts_cycles_o <= ts_cycles_i;
ts_error_o <= not tm_valid_sys;
ts_valid_o <= '1';
else
ts_valid_o <= '0';
end if;
end if;
end if;
end process;
end rtl;
......@@ -3,8 +3,8 @@
---------------------------------------------------------------------------------------
-- File : wr_streamers_wb.vhd
-- Author : auto-generated by wbgen2 from wr_streamers_wb.wb
-- Created : Wed Aug 16 22:45:12 2017
-- Version : 0x00000001
-- Created : Thu May 23 16:11:14 2019
-- Version : 0x00000002
-- Standard : VHDL'87
---------------------------------------------------------------------------------------
-- THIS FILE WAS GENERATED BY wbgen2 FROM SOURCE FILE wr_streamers_wb.wb
......@@ -30,6 +30,8 @@ entity wr_streamers_wb is
wb_stb_i : in std_logic;
wb_we_i : in std_logic;
wb_ack_o : out std_logic;
wb_err_o : out std_logic;
wb_rty_o : out std_logic;
wb_stall_o : out std_logic;
regs_i : in t_wr_streamers_in_registers;
regs_o : out t_wr_streamers_out_registers
......@@ -72,11 +74,19 @@ signal wr_streamers_cfg_or_rx_ftr_remote_int : std_logic ;
signal wr_streamers_cfg_or_rx_fix_lat_int : std_logic ;
signal wr_streamers_dbg_ctrl_mux_int : std_logic ;
signal wr_streamers_dbg_ctrl_start_byte_int : std_logic_vector(7 downto 0);
signal wr_streamers_rstr_rst_sw_dly0 : std_logic ;
signal wr_streamers_rstr_rst_sw_int : std_logic ;
signal wr_streamers_rx_cfg6_rx_fixed_latency_timeout_int : std_logic_vector(27 downto 0);
signal ack_sreg : std_logic_vector(9 downto 0);
signal rddata_reg : std_logic_vector(31 downto 0);
signal wrdata_reg : std_logic_vector(31 downto 0);
signal bwsel_reg : std_logic_vector(3 downto 0);
signal rwaddr_reg : std_logic_vector(5 downto 0);
signal ack_in_progress : std_logic ;
signal wr_int : std_logic ;
signal rd_int : std_logic ;
signal allones : std_logic_vector(31 downto 0);
signal allzeros : std_logic_vector(31 downto 0);
begin
-- Some internal signals assignments
......@@ -89,7 +99,7 @@ begin
ack_sreg <= "0000000000";
ack_in_progress <= '0';
rddata_reg <= "00000000000000000000000000000000";
wr_streamers_ver_id_int <= "00000000000000000000000000000001";
wr_streamers_ver_id_int <= "00000000000000000000000000000010";
wr_streamers_sscr1_rst_stats_int <= '0';
wr_streamers_sscr1_rst_seq_id_int <= '0';
wr_streamers_sscr1_snapshot_stats_int <= '0';
......@@ -121,6 +131,8 @@ begin
wr_streamers_cfg_or_rx_fix_lat_int <= '0';
wr_streamers_dbg_ctrl_mux_int <= '0';
wr_streamers_dbg_ctrl_start_byte_int <= "00000000";
wr_streamers_rstr_rst_sw_int <= '0';
wr_streamers_rx_cfg6_rx_fixed_latency_timeout_int <= "0001000000000000000000000000";
elsif rising_edge(clk_sys_i) then
-- advance the ACK generator shift register
ack_sreg(8 downto 0) <= ack_sreg(9 downto 1);
......@@ -129,6 +141,7 @@ begin
if (ack_sreg(0) = '1') then
wr_streamers_sscr1_rst_stats_int <= '0';
wr_streamers_sscr1_rst_seq_id_int <= '0';
wr_streamers_rstr_rst_sw_int <= '0';
ack_in_progress <= '0';
else
end if;
......@@ -580,6 +593,92 @@ begin
rddata_reg(31 downto 0) <= regs_i.dummy_dummy_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "100010" =>
if (wb_we_i = '1') then
wr_streamers_rstr_rst_sw_int <= wrdata_reg(0);
end if;
rddata_reg(0) <= '0';
rddata_reg(0) <= 'X';
rddata_reg(1) <= 'X';
rddata_reg(2) <= 'X';
rddata_reg(3) <= 'X';
rddata_reg(4) <= 'X';
rddata_reg(5) <= 'X';
rddata_reg(6) <= 'X';
rddata_reg(7) <= 'X';
rddata_reg(8) <= 'X';
rddata_reg(9) <= 'X';
rddata_reg(10) <= 'X';
rddata_reg(11) <= 'X';
rddata_reg(12) <= 'X';
rddata_reg(13) <= 'X';
rddata_reg(14) <= 'X';
rddata_reg(15) <= 'X';
rddata_reg(16) <= 'X';
rddata_reg(17) <= 'X';
rddata_reg(18) <= 'X';
rddata_reg(19) <= 'X';
rddata_reg(20) <= 'X';
rddata_reg(21) <= 'X';
rddata_reg(22) <= 'X';
rddata_reg(23) <= 'X';
rddata_reg(24) <= 'X';
rddata_reg(25) <= 'X';
rddata_reg(26) <= 'X';
rddata_reg(27) <= 'X';
rddata_reg(28) <= 'X';
rddata_reg(29) <= 'X';
rddata_reg(30) <= 'X';
rddata_reg(31) <= 'X';
ack_sreg(2) <= '1';
ack_in_progress <= '1';
when "100011" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat15_rx_late_frames_cnt_lsb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "100100" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat16_rx_late_frames_cnt_msb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "100101" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat17_rx_timeout_frames_cnt_lsb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "100110" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat18_rx_timeout_frames_cnt_msb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "100111" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat19_rx_match_frames_cnt_lsb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "101000" =>
if (wb_we_i = '1') then
end if;
rddata_reg(31 downto 0) <= regs_i.rx_stat20_rx_match_frames_cnt_msb_i;
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when "101001" =>
if (wb_we_i = '1') then
wr_streamers_rx_cfg6_rx_fixed_latency_timeout_int <= wrdata_reg(27 downto 0);
end if;
rddata_reg(27 downto 0) <= wr_streamers_rx_cfg6_rx_fixed_latency_timeout_int;
rddata_reg(28) <= 'X';
rddata_reg(29) <= 'X';
rddata_reg(30) <= 'X';
rddata_reg(31) <= 'X';
ack_sreg(0) <= '1';
ack_in_progress <= '1';
when others =>
-- prevent the slave from hanging the bus on invalid address
ack_in_progress <= '1';
......@@ -699,8 +798,31 @@ begin
regs_o.dbg_ctrl_start_byte_o <= wr_streamers_dbg_ctrl_start_byte_int;
-- Debug content
-- DUMMY value to read
-- Software reset streamers
process (clk_sys_i, rst_n_i)
begin
if (rst_n_i = '0') then
wr_streamers_rstr_rst_sw_dly0 <= '0';
regs_o.rstr_rst_sw_o <= '0';
elsif rising_edge(clk_sys_i) then
wr_streamers_rstr_rst_sw_dly0 <= wr_streamers_rstr_rst_sw_int;
regs_o.rstr_rst_sw_o <= wr_streamers_rstr_rst_sw_int and (not wr_streamers_rstr_rst_sw_dly0);
end if;
end process;
-- WR Streamer RX Late Frames Count (LSB)
-- WR Streamer RX Late Frames Count (MSB)
-- WR Streamer RX Timed-out Frames Count (LSB)
-- WR Streamer RX Timed-out Frames Count (MSB)
-- WR Streamer RX OK Frames Count (LSB)
-- WR Streamer RX OK Frames Count (MSB)
-- RX Fixed Latency Timeout (Default: 0x1000000=~134ms)
regs_o.rx_cfg6_rx_fixed_latency_timeout_o <= wr_streamers_rx_cfg6_rx_fixed_latency_timeout_int;
rwaddr_reg <= wb_adr_i;
wb_stall_o <= (not ack_sreg(0)) and (wb_stb_i and wb_cyc_i);
wb_err_o <= '0';
wb_rty_o <= '0';
-- ACK signal generation. Just pass the LSB of ACK counter.
wb_ack_o <= ack_sreg(0);
end syn;
......@@ -28,7 +28,7 @@ peripheral {
-----------------------------------------------------------------";
prefix = "wr_streamers";
hdl_entity = "wr_streamers_wb";
version= 1;
version= 2;
reg {
name = "Statistics status and ctrl register";
......@@ -76,7 +76,8 @@ peripheral {
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
};
reg {
name = "Statistics status and ctrl register";
prefix = "SSCR2";
......@@ -289,6 +290,9 @@ peripheral {
};
};
reg {
name = "Tx Config Reg 0";
prefix = "TX_CFG0";
......@@ -615,6 +619,7 @@ peripheral {
access_dev = WRITE_ONLY;
};
};
reg {
name = "Test value";
prefix = "DUMMY";
......@@ -625,6 +630,116 @@ peripheral {
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Reset Register";
prefix = "RSTR";
field {
name = "Software reset streamers";
prefix = "RST_SW";
description = "Writing 1 triggers a full software reset of the streamers.";
type = MONOSTABLE;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT15";
field {
name = "WR Streamer RX Late Frames Count (LSB)";
description = "Number of RX frames that missed their fixed-latency deadline";
prefix = "RX_LATE_FRAMES_CNT_LSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT16";
field {
name = "WR Streamer RX Late Frames Count (MSB)";
description = "Number of RX frames that missed their fixed-latency deadline";
prefix = "RX_LATE_FRAMES_CNT_MSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT17";
field {
name = "WR Streamer RX Timed-out Frames Count (LSB)";
description = "Number of RX frames that had their execution timestamp too far in the future (exceeding the RX_CFG6 value)";
prefix = "RX_TIMEOUT_FRAMES_CNT_LSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT18";
field {
name = "WR Streamer RX Timed-out Frames Count (MSB)";
description = "Number of RX frames that had their execution timestamp too far in the future (exceeding the RX_CFG6 value)";
prefix = "RX_TIMEOUT_FRAMES_CNT_MSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT19";
field {
name = "WR Streamer RX OK Frames Count (LSB)";
description = "Number of RX executed on time in the fixed latency mode";
prefix = "RX_MATCH_FRAMES_CNT_LSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx statistics";
prefix = "RX_STAT20";
field {
name = "WR Streamer RX OK Frames Count (MSB)";
description = "Number of RX executed on time in the fixed latency mode";
prefix = "RX_MATCH_FRAMES_CNT_MSB";
type = SLV;
size = 32;
access_bus = READ_ONLY;
access_dev = WRITE_ONLY;
};
};
reg {
name = "Rx Config Reg 6";
prefix = "RX_CFG6";
field {
name = "RX Fixed Latency Timeout (Default: 0x1000000=~134ms)";
prefix = "RX_FIXED_LATENCY_TIMEOUT";
type = SLV;
size = 28;
reset_value = 0x1000000;
access_bus = READ_WRITE;
access_dev = READ_ONLY;
};
};
};
......@@ -3,8 +3,8 @@
---------------------------------------------------------------------------------------
-- File : wr_streamers_wbgen2_pkg.vhd
-- Author : auto-generated by wbgen2 from wr_streamers_wb.wb
-- Created : Wed Aug 16 22:45:12 2017
-- Version : 0x00000001
-- Created : Thu May 23 16:11:14 2019
-- Version : 0x00000002
-- Standard : VHDL'87
---------------------------------------------------------------------------------------
-- THIS FILE WAS GENERATED BY wbgen2 FROM SOURCE FILE wr_streamers_wb.wb
......@@ -41,6 +41,12 @@ package wr_streamers_wbgen2_pkg is
rx_stat13_rx_latency_acc_cnt_msb_i : std_logic_vector(31 downto 0);
dbg_data_i : std_logic_vector(31 downto 0);
dummy_dummy_i : std_logic_vector(31 downto 0);
rx_stat15_rx_late_frames_cnt_lsb_i : std_logic_vector(31 downto 0);
rx_stat16_rx_late_frames_cnt_msb_i : std_logic_vector(31 downto 0);
rx_stat17_rx_timeout_frames_cnt_lsb_i : std_logic_vector(31 downto 0);
rx_stat18_rx_timeout_frames_cnt_msb_i : std_logic_vector(31 downto 0);
rx_stat19_rx_match_frames_cnt_lsb_i : std_logic_vector(31 downto 0);
rx_stat20_rx_match_frames_cnt_msb_i : std_logic_vector(31 downto 0);
end record;
constant c_wr_streamers_in_registers_init_value: t_wr_streamers_in_registers := (
......@@ -63,7 +69,13 @@ package wr_streamers_wbgen2_pkg is
rx_stat12_rx_latency_acc_cnt_lsb_i => (others => '0'),
rx_stat13_rx_latency_acc_cnt_msb_i => (others => '0'),
dbg_data_i => (others => '0'),
dummy_dummy_i => (others => '0')
dummy_dummy_i => (others => '0'),
rx_stat15_rx_late_frames_cnt_lsb_i => (others => '0'),
rx_stat16_rx_late_frames_cnt_msb_i => (others => '0'),
rx_stat17_rx_timeout_frames_cnt_lsb_i => (others => '0'),
rx_stat18_rx_timeout_frames_cnt_msb_i => (others => '0'),
rx_stat19_rx_match_frames_cnt_lsb_i => (others => '0'),
rx_stat20_rx_match_frames_cnt_msb_i => (others => '0')
);
-- Output registers (WB slave -> user design)
......@@ -101,6 +113,8 @@ package wr_streamers_wbgen2_pkg is
cfg_or_rx_fix_lat_o : std_logic;
dbg_ctrl_mux_o : std_logic;
dbg_ctrl_start_byte_o : std_logic_vector(7 downto 0);
rstr_rst_sw_o : std_logic;
rx_cfg6_rx_fixed_latency_timeout_o : std_logic_vector(27 downto 0);
end record;
constant c_wr_streamers_out_registers_init_value: t_wr_streamers_out_registers := (
......@@ -135,11 +149,33 @@ package wr_streamers_wbgen2_pkg is
cfg_or_rx_ftr_remote_o => '0',
cfg_or_rx_fix_lat_o => '0',
dbg_ctrl_mux_o => '0',
dbg_ctrl_start_byte_o => (others => '0')
dbg_ctrl_start_byte_o => (others => '0'),
rstr_rst_sw_o => '0',
rx_cfg6_rx_fixed_latency_timeout_o => (others => '0')
);
function "or" (left, right: t_wr_streamers_in_registers) return t_wr_streamers_in_registers;
function f_x_to_zero (x:std_logic) return std_logic;
function f_x_to_zero (x:std_logic_vector) return std_logic_vector;
component wr_streamers_wb is
port (
rst_n_i : in std_logic;
clk_sys_i : in std_logic;
wb_adr_i : in std_logic_vector(5 downto 0);
wb_dat_i : in std_logic_vector(31 downto 0);
wb_dat_o : out std_logic_vector(31 downto 0);
wb_cyc_i : in std_logic;
wb_sel_i : in std_logic_vector(3 downto 0);
wb_stb_i : in std_logic;
wb_we_i : in std_logic;
wb_ack_o : out std_logic;
wb_err_o : out std_logic;
wb_rty_o : out std_logic;
wb_stall_o : out std_logic;
regs_i : in t_wr_streamers_in_registers;
regs_o : out t_wr_streamers_out_registers
);
end component;
end package;
package body wr_streamers_wbgen2_pkg is
......@@ -155,7 +191,7 @@ function f_x_to_zero (x:std_logic_vector) return std_logic_vector is
variable tmp: std_logic_vector(x'length-1 downto 0);
begin
for i in 0 to x'length-1 loop
if x(i) = '1' then
if(x(i) = '1') then
tmp(i):= '1';
else
tmp(i):= '0';
......@@ -186,6 +222,12 @@ tmp.rx_stat12_rx_latency_acc_cnt_lsb_i := f_x_to_zero(left.rx_stat12_rx_latency_
tmp.rx_stat13_rx_latency_acc_cnt_msb_i := f_x_to_zero(left.rx_stat13_rx_latency_acc_cnt_msb_i) or f_x_to_zero(right.rx_stat13_rx_latency_acc_cnt_msb_i);
tmp.dbg_data_i := f_x_to_zero(left.dbg_data_i) or f_x_to_zero(right.dbg_data_i);
tmp.dummy_dummy_i := f_x_to_zero(left.dummy_dummy_i) or f_x_to_zero(right.dummy_dummy_i);
tmp.rx_stat15_rx_late_frames_cnt_lsb_i := f_x_to_zero(left.rx_stat15_rx_late_frames_cnt_lsb_i) or f_x_to_zero(right.rx_stat15_rx_late_frames_cnt_lsb_i);
tmp.rx_stat16_rx_late_frames_cnt_msb_i := f_x_to_zero(left.rx_stat16_rx_late_frames_cnt_msb_i) or f_x_to_zero(right.rx_stat16_rx_late_frames_cnt_msb_i);
tmp.rx_stat17_rx_timeout_frames_cnt_lsb_i := f_x_to_zero(left.rx_stat17_rx_timeout_frames_cnt_lsb_i) or f_x_to_zero(right.rx_stat17_rx_timeout_frames_cnt_lsb_i);
tmp.rx_stat18_rx_timeout_frames_cnt_msb_i := f_x_to_zero(left.rx_stat18_rx_timeout_frames_cnt_msb_i) or f_x_to_zero(right.rx_stat18_rx_timeout_frames_cnt_msb_i);
tmp.rx_stat19_rx_match_frames_cnt_lsb_i := f_x_to_zero(left.rx_stat19_rx_match_frames_cnt_lsb_i) or f_x_to_zero(right.rx_stat19_rx_match_frames_cnt_lsb_i);
tmp.rx_stat20_rx_match_frames_cnt_msb_i := f_x_to_zero(left.rx_stat20_rx_match_frames_cnt_msb_i) or f_x_to_zero(right.rx_stat20_rx_match_frames_cnt_msb_i);
return tmp;
end function;
end package body;
......@@ -68,13 +68,17 @@ entity xrtx_streamers_stats is
g_streamers_op_mode : t_streamers_op_mode := TX_AND_RX;
-- Width of frame counters
g_cnt_width : integer := 50; -- min:15, max:64, 50 bits should be ok for 50 years
g_acc_width : integer := 64 -- max value 64
g_acc_width : integer := 64; -- max value 64
-- rate fo the White Rabbit referene clock. By default, this clock is
-- 125MHz for WR Nodes. There are some WR Nodes that work with 62.5MHz.
g_clk_ref_rate : integer := 125000000
);
port (
clk_i : in std_logic;
rst_n_i : in std_logic;
-- input signals from streamers
sent_frame_i : in std_logic;
rcvd_frame_i : in std_logic;
lost_block_i : in std_logic;
......@@ -83,6 +87,10 @@ entity xrtx_streamers_stats is
rcvd_latency_i : in std_logic_vector(27 downto 0);
rcvd_latency_valid_i : in std_logic;
rx_stat_match_p1_i : in std_logic;
rx_stat_late_p1_i : in std_logic;
rx_stat_timeout_p1_i : in std_logic;
clk_ref_i : in std_logic;
tm_time_valid_i : in std_logic := '0';
tm_tai_i : in std_logic_vector(39 downto 0) := x"0000000000";
......@@ -100,6 +108,10 @@ entity xrtx_streamers_stats is
rcvd_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_block_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_match_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_late_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_timeout_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
-- output statistics: latency
latency_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_acc_overflow_o : out std_logic;
......@@ -115,24 +127,27 @@ end xrtx_streamers_stats;
architecture rtl of xrtx_streamers_stats is
signal reset_time_tai : std_logic_vector(39 downto 0);
signal reset_time_cycles : std_logic_vector(27 downto 0);
signal reset_time_tai : std_logic_vector(39 downto 0);
signal reset_time_cycles : std_logic_vector(27 downto 0);
signal sent_frame_cnt : unsigned(g_cnt_width-1 downto 0);
signal rcvd_frame_cnt : unsigned(g_cnt_width-1 downto 0);
signal lost_frame_cnt : unsigned(g_cnt_width-1 downto 0);
signal lost_block_cnt : unsigned(g_cnt_width-1 downto 0);
signal latency_cnt : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_match_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rx_stat_timeout_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rx_stat_late_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal latency_max : std_logic_vector(27 downto 0);
signal latency_min : std_logic_vector(27 downto 0);
signal latency_acc : unsigned(g_acc_width-1+1 downto 0);
signal latency_acc_overflow: std_logic;
signal latency_max : std_logic_vector(27 downto 0);
signal latency_min : std_logic_vector(27 downto 0);
signal latency_acc : unsigned(g_acc_width-1+1 downto 0);
signal latency_acc_overflow : std_logic;
signal sent_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rcvd_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal lost_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal lost_block_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rx_match_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rx_late_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal rx_timeout_frame_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal latency_cnt_out : std_logic_vector(g_cnt_width-1 downto 0);
signal latency_acc_overflow_out : std_logic;
signal latency_acc_out : std_logic_vector(g_acc_width-1 downto 0);
......@@ -147,7 +162,7 @@ architecture rtl of xrtx_streamers_stats is
signal snapshot_remote_ena : std_logic;
signal snapshot_ena : std_logic;
signal snapshot_ena_d1 : std_logic;
-- for code cleanness
constant c_cw : integer := g_cnt_width;
constant c_aw : integer := g_acc_width;
......@@ -184,6 +199,8 @@ begin
-------------------------------------------------------------------------------------------
-- process that timestamps the reset so that we can make statistics over time
U_Reset_Timestamper : pulse_stamper
generic map(
g_ref_clk_rate => g_clk_ref_rate)
port map (
clk_ref_i => clk_ref_i,
clk_sys_i => clk_i,
......@@ -240,12 +257,20 @@ begin
lost_frames_cnt_i => lost_frames_cnt_i,
rcvd_latency_i => rcvd_latency_i,
rcvd_latency_valid_i => rcvd_latency_valid_i,
rx_stat_timeout_p1_i => rx_stat_timeout_p1_i,
rx_stat_match_p1_i => rx_stat_match_p1_i,
rx_stat_late_p1_i => rx_stat_late_p1_i,
tm_time_valid_i => tm_time_valid_i,
snapshot_ena_i => snapshot_ena,
reset_stats_i => reset_stats,
rcvd_frame_cnt_o => rcvd_frame_cnt_out,
lost_frame_cnt_o => lost_frame_cnt_out,
lost_block_cnt_o => lost_block_cnt_out,
rx_stat_match_cnt_o => rx_stat_match_cnt_out,
rx_stat_late_cnt_o => rx_stat_late_cnt_out,
rx_stat_timeout_cnt_o => rx_stat_timeout_cnt_out,
latency_cnt_o => latency_cnt_out,
latency_acc_overflow_o => latency_acc_overflow_out,
latency_acc_o => latency_acc_out,
......@@ -256,6 +281,9 @@ begin
rcvd_frame_cnt_out <= (others => '0');
lost_frame_cnt_out <= (others => '0');
lost_block_cnt_out <= (others => '0');
rx_stat_match_cnt_out <= (others => '0');
rx_stat_late_cnt_out <= (others => '0');
rx_stat_timeout_cnt_out <= (others => '0');
latency_cnt_out <= (others => '0');
latency_acc_overflow_out <= '0';
latency_acc_out <= (others => '0');
......@@ -274,6 +302,9 @@ begin
latency_acc_o <= latency_acc_out;
latency_cnt_o <= latency_cnt_out;
latency_acc_overflow_o <= latency_acc_overflow_out;
rx_stat_timeout_cnt_o <= rx_stat_timeout_cnt_out;
rx_stat_late_cnt_o <= rx_stat_late_cnt_out;
rx_stat_match_cnt_o <= rx_stat_match_cnt_out;
-------------------------------------------------------------------------------------------
-- SNMP remote output
......@@ -323,6 +354,18 @@ begin
snmp_array_o(14)(c_cw-1 downto 0) <= latency_cnt_out;
snmp_array_o(14)(31 downto c_cw) <= (others => '0');
snmp_array_o(15)(31 downto 0) <= (others => '0');
snmp_array_o(18)(c_cw-1 downto 0) <= rx_stat_match_cnt_out;
snmp_array_o(19)(31 downto c_cw) <= (others => '0');
snmp_array_o(19)(31 downto 0) <= (others => '0');
snmp_array_o(20)(c_cw-1 downto 0) <= rx_stat_late_cnt_out;
snmp_array_o(21)(31 downto c_cw) <= (others => '0');
snmp_array_o(21)(31 downto 0) <= (others => '0');
snmp_array_o(22)(c_cw-1 downto 0) <= rx_stat_timeout_cnt_out;
snmp_array_o(23)(31 downto c_cw) <= (others => '0');
snmp_array_o(23)(31 downto 0) <= (others => '0');
end generate;
ACC_SINGLE_WORD_gen: if(c_aw < 33) generate
snmp_array_o(16)(c_aw-1 downto 0) <= latency_acc_out;
......@@ -351,6 +394,18 @@ begin
snmp_array_o(14)(31 downto 0) <= latency_cnt_out(31 downto 0);
snmp_array_o(15)(c_cw-32-1 downto 0) <= latency_cnt_out(c_cw-1 downto 32);
snmp_array_o(15 )(31 downto c_cw-32) <= (others => '0');
snmp_array_o(18)(31 downto 0) <= rx_stat_match_cnt_out(31 downto 0);
snmp_array_o(19)(c_cw-32-1 downto 0) <= rx_stat_match_cnt_out(c_cw-1 downto 32);
snmp_array_o(19)(31 downto c_cw-32) <= (others => '0');
snmp_array_o(20)(31 downto 0) <= rx_stat_late_cnt_out(31 downto 0);
snmp_array_o(21)(c_cw-32-1 downto 0) <= rx_stat_late_cnt_out(c_cw-1 downto 32);
snmp_array_o(21)(31 downto c_cw-32) <= (others => '0');
snmp_array_o(22)(31 downto 0) <= rx_stat_timeout_cnt_out(31 downto 0);
snmp_array_o(23)(c_cw-32-1 downto 0) <= rx_stat_timeout_cnt_out(c_cw-1 downto 32);
snmp_array_o(23)(31 downto c_cw-32) <= (others => '0');
end generate;
ACC_TWO_WORDs_gen: if(c_aw > 32) generate
snmp_array_o(16)(31 downto 0) <= latency_acc_out(31 downto 0);
......
......@@ -71,11 +71,31 @@ entity xrx_streamer is
-- other than zero, only a fixed number of words is accepted.
-- In combination with the g_escape_code_disable generic set to TRUE, the behaviour of
-- the "Btrain streamers" can be recreated.
g_expected_words_number : integer := 0
g_expected_words_number : integer := 0;
-- rate fo the White Rabbit referene clock. By default, this clock is
-- 125MHz for WR Nodes. There are some WR Nodes that work with 62.5MHz.
-- in the future, more frequences might be supported..
g_clk_ref_rate : integer := 125000000;
-- indicate that we are simulating so that some processes can be made to take less
-- time, e.g. below
g_simulation : integer := 0;
-- shorten the duration of second to see TAI seconds for simulation only (i.e.
-- only if g_simulation = 1)
g_sim_cycle_counter_range : integer := 125000000;
-- when non-zero, the datapath (tx_/rx_ ports) are in the clk_ref_i clock
-- domain instead of clk_sys_i. This is a must for fixed latency mode if
-- clk_sys_i is asynchronous (i.e. not locked) to the WR timing.
g_use_ref_clock_for_data : integer := 0
);
port (
clk_sys_i : in std_logic;
-- White Rabbit reference clock
clk_ref_i : in std_logic := '0';
rst_n_i : in std_logic;
-- Endpoint/WRC interface
......@@ -87,9 +107,6 @@ entity xrx_streamer is
-- Caution: uses clk_ref_i clock domain!
---------------------------------------------------------------------------
-- White Rabbit reference clock
clk_ref_i : in std_logic := '0';
-- Time valid flag
tm_time_valid_i : in std_logic := '0';
......@@ -111,6 +128,12 @@ entity xrx_streamer is
rx_data_o : out std_logic_vector(g_data_width-1 downto 0);
-- 1 indicted that rx_data_o is outputting a valid data word.
rx_valid_o : out std_logic;
-- 1 indicates the frame has been reproduced later than its desired fixed latency
rx_late_o : out std_logic;
-- 1 indicates the frame has been reproduced earlier than its desired fixed
-- latency due to the RX latency timeout
rx_timeout_o : out std_logic;
-- Synchronous data request input: when 1, the streamer may output another
-- data word in the subsequent clock cycle.
rx_dreq_i : in std_logic;
......@@ -128,6 +151,11 @@ entity xrx_streamer is
rx_latency_o : out std_logic_vector(27 downto 0);
-- 1 when the latency on rx_latency_o is valid.
rx_latency_valid_o : out std_logic;
-- pulse when a frame was dropped due to buffer overflow
rx_stat_overflow_p1_o : out std_logic;
rx_stat_match_p1_o : out std_logic;
rx_stat_late_p1_o : out std_logic;
rx_stat_timeout_p1_o : out std_logic;
-- received streamer frame (counts all frames, corrupted and not)
rx_frame_p1_o : out std_logic;
-- configuration
......@@ -138,7 +166,7 @@ end xrx_streamer;
architecture rtl of xrx_streamer is
type t_rx_state is (IDLE, HEADER, FRAME_SEQ_ID, PAYLOAD, SUBFRAME_HEADER, EOF);
type t_rx_state is (IDLE, HEADER, FRAME_SEQ_ID, PAYLOAD, EOF, DROP_FRAME);
signal fab, fsm_in : t_pipe;
......@@ -154,38 +182,73 @@ architecture rtl of xrx_streamer is
signal pack_data, fifo_data : std_logic_vector(g_data_width-1 downto 0);
signal fifo_drop, fifo_accept, fifo_accept_d0, fifo_dvalid : std_logic;
signal fifo_drop, fifo_accept, fifo_accept_d0, fifo_dvalid, fifo_full, fifo_dreq : std_logic;
signal fifo_sync, fifo_last, frames_lost, blocks_lost : std_logic;
signal fifo_dout, fifo_din : std_logic_vector(g_data_width + 1 downto 0);
signal fifo_dout, fifo_din : std_logic_vector(g_data_width + 1 + 28 + 1 downto 0);
attribute mark_debug : string;
attribute mark_debug of fifo_drop : signal is "true";
attribute mark_debug of fifo_accept : signal is "true";
attribute mark_debug of fifo_dvalid : signal is "true";
attribute mark_debug of state : signal is "true";
attribute mark_debug of fsm_in : signal is "true";
attribute mark_debug of fifo_full : signal is "true";
attribute mark_debug of fifo_dreq : signal is "true";
signal fifo_target_ts_en : std_logic;
signal fifo_target_ts : std_logic_vector(28 downto 0);
signal pending_write, fab_dvalid_pre : std_logic;
signal tx_tag_cycles, rx_tag_cycles : std_logic_vector(27 downto 0);
signal tx_tag_valid, rx_tag_valid : std_logic;
signal tx_tag_valid, tx_tag_present, rx_tag_valid : std_logic;
signal rx_tag_valid_stored : std_logic;
signal got_next_subframe : std_logic;
signal is_frame_seq_id : std_logic;
signal word_count : unsigned(11 downto 0);
signal sync_seq_no : std_logic;
-- fixed latency signals
type t_rx_delay_state is (DISABLED, DELAY, ALLOW);
signal timestamped : std_logic;
signal delay_cnt : unsigned(27 downto 0);
signal rx_dreq_allow : std_logic;
signal rx_latency : unsigned(27 downto 0);
signal rx_latency_stored : unsigned(27 downto 0);
signal rx_latency_valid : std_logic;
signal delay_state : t_rx_delay_state;
signal rx_dreq : std_logic;
signal is_vlan : std_logic;
constant c_fixed_latency_zero : unsigned(27 downto 0) := (others => '0');
constant c_timestamper_delay : unsigned(27 downto 0) := to_unsigned(12, 28); -- cycles
signal fifo_last_int : std_logic;
signal rst_int_n : std_logic;
signal tx_tag_error : std_logic;
signal tx_tag_adj_valid : std_logic;
signal tx_tag_adj_error : std_logic;
signal tx_tag_adj_cycles : std_logic_vector(27 downto 0);
signal tx_tag_adj_tai : std_logic_vector(39 downto 0);
signal fifo_target_ts_tai : std_logic_vector(39 downto 0);
signal fifo_target_ts_cycles : std_logic_vector(27 downto 0);
signal fifo_target_ts_error : std_logic;
signal timestamp_pushed_to_fifo : std_logic;
begin -- rtl
p_software_reset : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
rst_int_n <= '0';
else
rst_int_n <= not rx_streamer_cfg_i.sw_reset;
end if;
end if;
end process;
U_rx_crc_generator : gc_crc_gen
generic map (
g_polynomial => x"1021",
......@@ -209,7 +272,7 @@ begin -- rtl
U_Fabric_Sink : xwb_fabric_sink
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
snk_i => snk_i,
snk_o => snk_o,
addr_o => fab.addr,
......@@ -229,7 +292,7 @@ begin -- rtl
g_escape_code => x"cafe")
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
d_i => fab.data,
d_detect_enable_i => detect_escapes,
d_valid_i => fab.dvalid,
......@@ -245,113 +308,100 @@ begin -- rtl
fab.dreq <= fsm_in.dreq;
is_escape <= '0';
end generate gen_no_escape;
fsm_in.eof <= fab.eof or fab.error;
fsm_in.sof <= fab.sof;
U_Output_FIFO : dropping_buffer
generic map (
g_size => g_buffer_size,
g_data_width => g_data_width + 2)
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
d_i => fifo_din,
d_req_o => fsm_in.dreq,
d_drop_i => fifo_drop,
d_accept_i => fifo_accept_d0,
d_valid_i => fifo_dvalid,
d_o => fifo_dout,
d_valid_o => rx_valid_o,
d_req_i => rx_dreq);
fifo_din(g_data_width+1) <= fifo_sync;
fifo_din(g_data_width) <= fifo_last or
((not pending_write) and is_escape); -- when word is 16 bits
fifo_din(g_data_width-1 downto 0) <= fifo_data;
rx_data_o <= fifo_dout(g_data_width-1 downto 0);
rx_first_p1_o <= fifo_dout(g_data_width+1);
rx_last_p1_o <= fifo_dout(g_data_width);
U_RX_Timestamper : pulse_stamper
generic map(
g_ref_clk_rate => g_clk_ref_rate)
port map (
clk_ref_i => clk_ref_i,
clk_sys_i => clk_sys_i,
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
pulse_a_i => fsm_in.sof,
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
tag_cycles_o => rx_tag_cycles);
tag_cycles_o => rx_tag_cycles,
tag_valid_o => rx_tag_valid);
-------------------------------------------------------------------------------------------
-- fixed latency implementation
-------------------------------------------------------------------------------------------
fifo_last_int <= fifo_last or ((not pending_write) and is_escape); -- when word is 16 bit
-- mask rx_dreq to prevent reception
rx_dreq <= rx_dreq_i and rx_dreq_allow;
-- produce a pulse when SOF is timestamped, this pulse starts counter in clk_sys clock
-- domain
U_sync_with_clk : gc_sync_ffs
U_FixLatencyDelay : entity work.fixed_latency_delay
generic map (
g_data_width => g_data_width,
g_buffer_size => 32,
g_use_ref_clock_for_data => g_use_ref_clock_for_data,
g_clk_ref_rate => g_clk_ref_rate,
g_sim_cycle_counter_range => g_sim_cycle_counter_range,
g_simulation => g_simulation)
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
data_i => fsm_in.sof,
synced_o => timestamped);
-- introduce fixed latency, if configured to do so
p_fixed_latency_fsm : process(clk_sys_i)
rst_n_i => rst_int_n,
clk_sys_i => clk_sys_i,
clk_ref_i => clk_ref_i,
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
d_data_i => fifo_data,
d_last_i => fifo_last_int,
d_sync_i => fifo_sync,
d_target_ts_en_i => fifo_target_ts_en,
d_target_ts_tai_i => fifo_target_ts_tai,
d_target_ts_cycles_i => fifo_target_ts_cycles,
d_target_ts_error_i => fifo_target_ts_error,
d_valid_i => fifo_dvalid,
d_drop_i => fifo_drop,
d_accept_i => fifo_accept_d0,
d_req_o => fifo_dreq,
d_full_o => fifo_full,
rx_first_p1_o => rx_first_p1_o,
rx_last_p1_o => rx_last_p1_o,
rx_data_o => rx_data_o,
rx_valid_o => rx_valid_o,
rx_dreq_i => rx_dreq_i,
rx_late_o => rx_late_o,
rx_timeout_o => rx_timeout_o,
stat_match_p1_o => rx_stat_match_p1_o,
stat_late_p1_o => rx_stat_late_p1_o,
stat_timeout_p1_o => rx_stat_timeout_p1_o,
rx_streamer_cfg_i => rx_streamer_cfg_i);
U_RestoreTAITimeFromRXTimestamp : entity work.ts_restore_tai
generic map (
g_tm_sample_period => 20,
g_clk_ref_rate => g_clk_ref_rate,
g_simulation => g_simulation,
g_sim_cycle_counter_range => g_sim_cycle_counter_range)
port map (
clk_sys_i => clk_sys_i,
clk_ref_i => clk_ref_i,
rst_n_i => rst_n_i,
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
ts_valid_i => tx_tag_valid,
ts_cycles_i => tx_tag_cycles,
ts_valid_o => tx_tag_adj_valid,
ts_cycles_o => tx_tag_adj_cycles,
ts_error_o => tx_tag_adj_error,
ts_tai_o => tx_tag_adj_tai);
p_gen_fsm_dreq : process(fifo_full, state)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
delay_state <= DISABLED;
rx_latency_stored <= (others=>'0');
rx_dreq_allow <= '1';
delay_cnt <= c_timestamper_delay;
else
case delay_state is
when DISABLED =>
if unsigned(rx_streamer_cfg_i.fixed_latency) /= c_fixed_latency_zero then
delay_state <= ALLOW;
end if;
rx_latency_stored <= (others=>'0');
delay_cnt <= c_timestamper_delay;
rx_dreq_allow <= '1';
when ALLOW =>
if unsigned(rx_streamer_cfg_i.fixed_latency) = c_fixed_latency_zero then
delay_state <= DISABLED;
elsif(rx_latency_valid ='1') then
rx_dreq_allow <= '0';
rx_latency_stored <= rx_latency;
delay_state <= DELAY;
end if;
if(timestamped = '1') then
delay_cnt <= c_timestamper_delay;
else
delay_cnt <= delay_cnt + 2;
end if;
when DELAY =>
if unsigned(rx_streamer_cfg_i.fixed_latency) <= delay_cnt + rx_latency_stored then
rx_latency_stored <= (others=>'0');
rx_dreq_allow <= '1';
delay_state <= ALLOW;
else
delay_cnt <= delay_cnt + 2;
end if;
end case;
end if;
if state = PAYLOAD then
fsm_in.dreq <= not fifo_full;
else
fsm_in.dreq <= '1';
end if;
end process;
-------------------------------------------------------------------------------------------
-- end of fixed latency implementation
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
p_fsm : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
if rst_int_n = '0' then
state <= IDLE;
count <= (others => '0');
seq_no <= (others => '1');
......@@ -371,11 +421,11 @@ begin -- rtl
rx_frame_p1_o <= '0';
rx_lost_frames_cnt_o <= (others => '0');
frames_lost <= '0';
rx_latency <= (others=>'0');
rx_latency_valid <= '0';
blocks_lost <= '0';
pack_data <= (others=>'0');
is_vlan <= '0';
tx_tag_present <= '0';
tx_tag_valid <= '0';
else
case state is
when IDLE =>
......@@ -396,14 +446,25 @@ begin -- rtl
rx_lost_frames_cnt_o <= (others => '0');
frames_lost <= '0';
blocks_lost <= '0';
rx_latency <= (others=>'0');
rx_latency_valid <= '0';
is_vlan <= '0';
tx_tag_present <= '0';
tx_tag_valid <= '0';
if(fsm_in.sof = '1') then
state <= HEADER;
if(fifo_full = '1') then
state <= DROP_FRAME;
else
state <= HEADER;
end if;
end if;
when DROP_FRAME =>
if (fsm_in.eof = '1' or fsm_in.error = '1') then
state <= IDLE;
end if;
when HEADER =>
if(fsm_in.eof = '1') then
state <= IDLE;
......@@ -449,12 +510,14 @@ begin -- rtl
count <= count + 1;
when x"07" =>
if(is_vlan = '0') then
tx_tag_valid <= fsm_in.data(15);
tx_tag_cycles(27 downto 16)<= fsm_in.data(11 downto 0);
tx_tag_present <= fsm_in.data(15);
tx_tag_error <= fsm_in.data(14);
tx_tag_cycles(27 downto 16) <= fsm_in.data(11 downto 0);
end if;
count <= count + 1;
when x"08" =>
if(is_vlan = '0') then
tx_tag_valid <= '1';
tx_tag_cycles(15 downto 0) <= fsm_in.data;
count <= count + 1;
crc_en <= '1';
......@@ -466,10 +529,12 @@ begin -- rtl
end if;
count <= count + 1;
when x"09" =>
tx_tag_valid <= fsm_in.data(15);
tx_tag_cycles(27 downto 16)<= fsm_in.data(11 downto 0);
tx_tag_present <= fsm_in.data(15);
tx_tag_error <= fsm_in.data(14);
tx_tag_cycles(27 downto 16) <= fsm_in.data(11 downto 0);
count <= count + 1;
when x"0A" =>
tx_tag_valid <= '1';
tx_tag_cycles(15 downto 0) <= fsm_in.data;
count <= count + 1;
crc_en <= '1';
......@@ -493,17 +558,6 @@ begin -- rtl
ser_count <= (others => '0');
word_count <= word_count + 1; -- count words, increment in advance
got_next_subframe <= '1';
if(tx_tag_valid = '1') then
rx_latency_valid <= '1';
if(unsigned(tx_tag_cycles) > unsigned(rx_tag_cycles)) then
rx_latency <= unsigned(rx_tag_cycles) - unsigned(tx_tag_cycles) + to_unsigned(125000000, 28);
else
rx_latency <= unsigned(rx_tag_cycles) - unsigned(tx_tag_cycles);
end if;
tx_tag_valid <= '0';
else
rx_latency_valid <= '0';
end if;
if(std_logic_vector(seq_no) /= fsm_in.data(14 downto 0)) then
seq_no <= unsigned(fsm_in.data(14 downto 0))+1;
......@@ -522,32 +576,11 @@ begin -- rtl
end if;
end if;
when SUBFRAME_HEADER =>
fifo_drop <= '0';
fifo_accept <= '0';
ser_count <= (others => '0');
if(fsm_in.eof = '1') then
state <= IDLE;
got_next_subframe <= '0';
blocks_lost <= '0';
elsif (fsm_in.dvalid = '1' and is_escape = '1') then
got_next_subframe <= '1';
if(std_logic_vector(count) /= fsm_in.data(14 downto 0)) then
count <= unsigned(fsm_in.data(14 downto 0))+1;
blocks_lost <= '1';
else
count <= count + 1;
blocks_lost <= '0';
end if;
state <= PAYLOAD;
end if;
when PAYLOAD =>
frames_lost <= '0';
rx_lost_frames_cnt_o <= (others => '0');
rx_latency_valid <= '0';
fifo_sync <= got_next_subframe;
if(fsm_in.eof = '1') then
......@@ -588,6 +621,8 @@ begin -- rtl
state <= EOF;
fifo_accept <= crc_match; --_latched;
fifo_drop <= not crc_match; --_latched;
fifo_dvalid <= pending_write and not fifo_dvalid;
else
blocks_lost <= '0';
......@@ -625,6 +660,7 @@ begin -- rtl
fifo_accept <= '1';
fifo_drop <= '0';
fifo_dvalid <= '1';
else
word_count <= word_count + 1;
end if;
......@@ -660,7 +696,67 @@ begin -- rtl
end if;
end process;
p_delay_fifo_accept : process(clk_sys_i)
p_handle_latency : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_int_n = '0' then
fifo_target_ts_en <= '0';
rx_latency_valid <= '0';
rx_tag_valid_stored <= '0';
timestamp_pushed_to_fifo <= '0';
rx_latency <= (others => '0');
else
case state is
when IDLE =>
timestamp_pushed_to_fifo <= '0';
rx_tag_valid_stored <= '0';-- prepare for next timestamp
fifo_target_ts_en <= '0';
when HEADER =>
-- remember that we got timestamp, it can happen only when receiving header
if(rx_tag_valid = '1') then
rx_tag_valid_stored <= '1';
end if;
when PAYLOAD =>
if(timestamp_pushed_to_fifo = '0' and tx_tag_adj_valid = '1' and tx_tag_present = '1' and unsigned(rx_streamer_cfg_i.fixed_latency) /= 0) then
fifo_target_ts_cycles <= tx_tag_adj_cycles;
fifo_target_ts_tai <= tx_tag_adj_tai;
fifo_target_ts_error <= tx_tag_adj_error or tx_tag_error;
fifo_target_ts_en <= '1';
end if;
if fifo_dvalid = '1' and fifo_target_ts_en = '1' then
timestamp_pushed_to_fifo <= '1';
end if;
-- latency measurement
if(tx_tag_present = '1' and rx_tag_valid_stored = '1') then
rx_latency_valid <= '1';
rx_tag_valid_stored <= '0';
if(unsigned(tx_tag_cycles) > unsigned(rx_tag_cycles)) then
rx_latency <= unsigned(rx_tag_cycles) - unsigned(tx_tag_cycles) + to_unsigned(125000000, 28);
else
rx_latency <= unsigned(rx_tag_cycles) - unsigned(tx_tag_cycles);
end if;
else
rx_latency_valid <= '0';
end if;
when others => null;
end case;
end if;
end if;
end process;
p_delay_signals : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
fifo_accept_d0 <= fifo_accept;
......@@ -672,6 +768,6 @@ begin -- rtl
rx_lost_frames_p1_o <= frames_lost;
rx_latency_o <= std_logic_vector(rx_latency);
rx_latency_valid_o <= rx_latency_valid;
crc_restart <= '1' when (state = FRAME_SEQ_ID or (is_escape = '1' and fsm_in.data(15) = '1')) else not rst_n_i;
crc_restart <= '1' when (state = FRAME_SEQ_ID or (is_escape = '1' and fsm_in.data(15) = '1')) else not rst_int_n;
end rtl;
......@@ -65,14 +65,23 @@ entity xrx_streamers_stats is
rcvd_latency_valid_i : in std_logic;
tm_time_valid_i : in std_logic;
snapshot_ena_i : in std_logic := '0';
reset_stats_i : in std_logic;
snapshot_ena_i : in std_logic := '0';
reset_stats_i : in std_logic;
rx_stat_match_p1_i : in std_logic;
rx_stat_late_p1_i : in std_logic;
rx_stat_timeout_p1_i : in std_logic;
----------------------- statistics ----------------------------------------
-- output statistics: tx/rx counters
rcvd_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_frame_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
lost_block_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
-- output statistics: latency
rx_stat_match_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_late_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
rx_stat_timeout_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
-- output statistics: latency
latency_cnt_o : out std_logic_vector(g_cnt_width-1 downto 0);
latency_acc_overflow_o : out std_logic;
latency_acc_o : out std_logic_vector(g_acc_width-1 downto 0);
......@@ -88,6 +97,9 @@ architecture rtl of xrx_streamers_stats is
signal rcvd_frame_cnt : unsigned(g_cnt_width-1 downto 0);
signal lost_frame_cnt : unsigned(g_cnt_width-1 downto 0);
signal lost_block_cnt : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_late_cnt : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_match_cnt : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_timeout_cnt : unsigned(g_cnt_width-1 downto 0);
signal latency_cnt : unsigned(g_cnt_width-1 downto 0);
signal latency_max : std_logic_vector(27 downto 0);
......@@ -100,6 +112,9 @@ architecture rtl of xrx_streamers_stats is
signal lost_frame_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal lost_block_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal latency_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_late_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_match_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal rx_stat_timeout_cnt_d1 : unsigned(g_cnt_width-1 downto 0);
signal latency_max_d1 : std_logic_vector(27 downto 0);
signal latency_min_d1 : std_logic_vector(27 downto 0);
......@@ -121,6 +136,10 @@ begin
rcvd_frame_cnt <= (others => '0');
lost_frame_cnt <= (others => '0');
lost_block_cnt <= (others => '0');
rx_stat_timeout_cnt <= (others => '0');
rx_stat_late_cnt <= (others => '0');
rx_stat_match_cnt <= (others => '0');
else
-- count received frames
if(rcvd_frame_i = '1') then
......@@ -134,6 +153,19 @@ begin
if(lost_block_i = '1') then
lost_block_cnt <= lost_block_cnt + 1;
end if;
-- count fixed latency on-time frames
if(rx_stat_match_p1_i = '1') then
rx_stat_match_cnt <= rx_stat_match_cnt + 1;
end if;
-- count fixed latency late frames
if(rx_stat_late_p1_i = '1') then
rx_stat_late_cnt <= rx_stat_late_cnt + 1;
end if;
-- count fixed latency timed-out frames
if(rx_stat_timeout_p1_i = '1') then
rx_stat_timeout_cnt <= rx_stat_timeout_cnt + 1;
end if;
end if;
end if;
end process;
......@@ -198,6 +230,10 @@ begin
lost_block_cnt_d1 <= lost_block_cnt;
latency_cnt_d1 <= latency_cnt;
rx_stat_timeout_cnt_d1 <= rx_stat_timeout_cnt;
rx_stat_match_cnt_d1 <= rx_stat_match_cnt;
rx_stat_late_cnt_d1 <= rx_stat_late_cnt;
latency_max_d1 <= latency_max;
latency_min_d1 <= latency_min;
latency_acc_d1 <= latency_acc;
......@@ -211,6 +247,13 @@ begin
-------------------------------------------------------------------------------------------
-- snapshot or current value
-------------------------------------------------------------------------------------------
rx_stat_match_cnt_o <= std_logic_vector(rx_stat_match_cnt_d1) when (snapshot_ena_d1 = '1') else
std_logic_vector(rx_stat_match_cnt);
rx_stat_late_cnt_o <= std_logic_vector(rx_stat_late_cnt_d1) when (snapshot_ena_d1 = '1') else
std_logic_vector(rx_stat_late_cnt);
rx_stat_timeout_cnt_o <= std_logic_vector(rx_stat_timeout_cnt_d1) when (snapshot_ena_d1 = '1') else
std_logic_vector(rx_stat_timeout_cnt);
rcvd_frame_cnt_o <= std_logic_vector(rcvd_frame_cnt_d1) when (snapshot_ena_d1 = '1') else
std_logic_vector(rcvd_frame_cnt);
lost_frame_cnt_o <= std_logic_vector(lost_frame_cnt_d1) when (snapshot_ena_d1 = '1') else
......
......@@ -78,11 +78,24 @@ entity xtx_streamer is
-- the timer is overriden is set in the second generic
g_simulation : integer :=0;
-- startup counter, used only in simulatin mode (value in 16ns cycles)
g_sim_startup_cnt : integer := 6250-- 100us
g_sim_startup_cnt : integer := 6250;-- 100us;
-- rate fo the White Rabbit referene clock. By default, this clock is
-- 125MHz for WR Nodes. There are some WR Nodes that work with 62.5MHz.
-- in the future, more frequences might be supported..
g_clk_ref_rate : integer := 125000000;
-- when non-zero, the datapath (tx_/rx_ ports) are in the clk_ref_i clock
-- domain instead of clk_sys_i. This is a must for fixed latency mode if
-- clk_sys_i is asynchronous (i.e. not locked) to the WR timing.
g_use_ref_clock_for_data : integer := 0
);
port (
clk_sys_i : in std_logic;
-- White Rabbit reference clock
clk_ref_i : in std_logic := '0';
rst_n_i : in std_logic;
-- Endpoint/WRC interface - packet source
......@@ -94,8 +107,6 @@ entity xtx_streamer is
-- Caution: uses clk_ref_i clock domain!
---------------------------------------------------------------------------
-- White Rabbit reference clock
clk_ref_i : in std_logic := '0';
-- Time valid flag
tm_time_valid_i : in std_logic := '0';
......@@ -108,6 +119,7 @@ entity xtx_streamer is
-- status of the link, in principle the tx can be done only if link is oK
link_ok_i : in std_logic := '1';
---------------------------------------------------------------------------
-- User interface
---------------------------------------------------------------------------
......@@ -122,6 +134,10 @@ entity xtx_streamer is
-- the following clock cycle.
tx_dreq_o : out std_logic;
-- sync signal, allowing to align transmission of the frames to the
-- least supported WR reference clock frequency. Used in fixed latency mode.
tx_sync_o : out std_logic;
-- Last signal. Can be used to indicate the last data word in a larger
-- block of samples (see documentation for more details).
tx_last_p1_i : in std_logic := '1';
......@@ -150,9 +166,14 @@ architecture rtl of xtx_streamer is
signal tx_threshold_hit : std_logic;
signal tx_timeout_hit : std_logic;
signal tx_flush_latched : std_logic;
signal tx_idle : std_logic;
signal tx_fifo_last, tx_fifo_we, tx_fifo_full, tx_fifo_empty, tx_fifo_rd : std_logic;
signal tx_fifo_empty_int, tx_fifo_rd_int, tx_fifo_rd_int_d : std_logic;
signal tx_fifo_q_int, tx_fifo_q_reg : std_logic_vector(g_data_width downto 0);
signal tx_fifo_q_valid : std_logic;
signal tx_fifo_q, tx_fifo_d : std_logic_vector(g_data_width downto 0);
signal tx_flush, tx_flush_p2 : std_logic;
signal state : t_tx_state;
signal seq_no, count : unsigned(14 downto 0);
signal ser_count : unsigned(7 downto 0);
......@@ -171,18 +192,53 @@ architecture rtl of xtx_streamer is
signal tx_almost_empty, tx_almost_full : std_logic;
signal buf_frame_count : unsigned(5 downto 0) := (others => '0');
signal buf_frame_count_inc_ref : std_logic;
signal buf_frame_count_dec_sys : std_logic;
signal buf_frame_count : std_logic_vector(5 downto 0);
signal tag_cycles : std_logic_vector(27 downto 0);
signal tag_valid, tag_valid_latched : std_logic;
signal tag_error : std_logic;
signal link_ok_delay_cnt : unsigned(25 downto 0);
signal link_ok_delay_expired : std_logic;
signal link_ok_delay_expired_ref : std_logic;
signal link_ok_ref : std_logic;
attribute mark_debug : string;
attribute mark_debug of link_ok_delay_cnt : signal is "true";
attribute mark_debug of link_ok_delay_expired_ref : signal is "true";
attribute mark_debug of link_ok_delay_expired : signal is "true";
attribute mark_debug of link_ok_ref : signal is "true";
signal clk_data : std_logic;
signal rst_n_ref : std_logic;
signal stamper_pulse_a : std_logic;
constant c_link_ok_rst_delay : unsigned(25 downto 0) := to_unsigned(62500000, 26);-- 1s
constant c_link_ok_rst_delay_sim : unsigned(25 downto 0) := to_unsigned(g_sim_startup_cnt, 26);
signal rst_int_n : std_logic;
begin -- rtl
p_software_reset : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
rst_int_n <= '0';
else
rst_int_n <= not tx_streamer_cfg_i.sw_reset;
end if;
end if;
end process;
-------------------------------------------------------------------------------------------
-- check sanity of input generics
-------------------------------------------------------------------------------------------
......@@ -219,7 +275,7 @@ begin -- rtl
U_Fab_Source : xwb_fabric_source
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
src_i => src_i,
src_o => src_o,
addr_i => c_WRF_DATA,
......@@ -242,7 +298,7 @@ begin -- rtl
g_escape_code => x"cafe")
port map (
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
d_i => fsm_out.data,
d_insert_enable_i => fsm_escape_enable,
d_escape_i => fsm_escape,
......@@ -253,7 +309,7 @@ begin -- rtl
d_valid_o => fab_src.dvalid,
d_req_i => fab_src.dreq);
end generate gen_escape;
gen_no_escape: if (g_escape_code_disable = TRUE) generate
gen_no_escape : if (g_escape_code_disable = true) generate
fab_src.data <= fsm_out.data;
fab_src.dvalid <= fsm_out.dvalid;
fsm_out.dreq <= fab_src.dreq;
......@@ -262,6 +318,8 @@ begin -- rtl
tx_fifo_we <= tx_valid_i and not tx_fifo_full;
tx_fifo_d <= tx_last_p1_i & tx_data_i;
gen_use_sys_clock_for_data : if g_use_ref_clock_for_data = 0 generate
U_TX_Buffer : generic_sync_fifo
generic map (
g_data_width => g_data_width + 1,
......@@ -272,7 +330,7 @@ begin -- rtl
g_almost_full_threshold => g_tx_buffer_size - 2,
g_show_ahead => true)
port map (
rst_n_i => rst_n_i,
rst_n_i => rst_int_n,
clk_i => clk_sys_i,
d_i => tx_fifo_d,
we_i => tx_fifo_we,
......@@ -283,44 +341,142 @@ begin -- rtl
almost_empty_o => tx_almost_empty,
almost_full_o => tx_almost_full
);
tx_fifo_rd <= '1' when (state = PAYLOAD and ser_count = g_data_width/16-1 and
fsm_out.dreq = '1' and tx_fifo_empty = '0') else
'0';
tx_threshold_hit <= '1' when tx_almost_empty = '0' and (buf_frame_count /= 0) else '0';
clk_data <= clk_sys_i;
stamper_pulse_a <= fsm_out.sof;
tx_flush <= tx_flush_p1_i;
end generate gen_use_sys_clock_for_data;
gen_use_ref_clock_for_data : if g_use_ref_clock_for_data /= 0 generate
U_TX_Buffer : generic_async_fifo
generic map (
g_data_width => g_data_width + 1,
g_size => g_tx_buffer_size,
g_with_rd_empty => true,
g_with_wr_full => true,
g_with_wr_almost_full => true,
g_with_rd_almost_empty => true,
g_almost_empty_threshold => g_tx_threshold,
g_almost_full_threshold => g_tx_buffer_size - 2,
g_show_ahead => false)
port map (
rst_n_i => rst_int_n,
clk_wr_i => clk_ref_i,
clk_rd_i => clk_sys_i,
d_i => tx_fifo_d,
we_i => tx_fifo_we,
q_o => tx_fifo_q_int,
rd_i => tx_fifo_rd_int,
rd_empty_o => tx_fifo_empty_int,
wr_full_o => tx_fifo_full,
rd_almost_empty_o => tx_almost_empty,
wr_almost_full_o => tx_almost_full
);
-- emulate show-ahead mode, not supported by async fifos in the
-- general-cores library.
U_ShowAheadAdapter : entity work.fifo_showahead_adapter
generic map (
g_width => g_data_width + 1)
port map (
clk_i => clk_sys_i,
rst_n_i => rst_int_n,
fifo_q_i => tx_fifo_q_int,
fifo_empty_i => tx_fifo_empty_int,
fifo_rd_o => tx_fifo_rd_int,
q_o => tx_fifo_q,
valid_o => tx_fifo_q_valid,
rd_i => tx_fifo_rd);
tx_fifo_empty <= not tx_fifo_q_valid;
clk_data <= clk_ref_i;
p_detect_sof : process(clk_ref_i)
begin
if rising_edge(clk_ref_i) then
if rst_n_ref = '0' then
tx_idle <= '1';
stamper_pulse_a <= '0';
else
if tx_last_p1_i = '1' and tx_valid_i = '1' then
tx_idle <= '1';
elsif tx_valid_i = '1' then
tx_idle <= '0';
end if;
stamper_pulse_a <= tx_valid_i and tx_idle;
end if;
end if;
end process;
U_Extend: entity work.gc_extend_pulse
generic map(
g_width => 2)
port map(
clk_i => clk_ref_i,
rst_n_i => rst_n_ref,
pulse_i => tx_flush_p1_i,
extended_o => tx_flush_p2);
U_Sync: entity work.gc_sync_ffs
port map (
clk_i => clk_sys_i,
rst_n_i => rst_int_n,
data_i => tx_flush_p2,
synced_o => tx_flush);
end generate gen_use_ref_clock_for_data;
-- sys clock domain
tx_fifo_rd <= '1' when (state = PAYLOAD and ser_count = g_data_width/16-1 and
fsm_out.dreq = '1' and tx_fifo_empty = '0') else
'0';
-- sys clock domain
tx_threshold_hit <= '1' when tx_almost_empty = '0' and (signed(buf_frame_count) > 0) else '0';
tx_fifo_last <= tx_fifo_q(g_data_width);
U_Timestamper : pulse_stamper
U_Timestamper : entity work.pulse_stamper_sync
generic map(
g_ref_clk_rate => g_clk_ref_rate)
port map (
clk_ref_i => clk_ref_i,
clk_sys_i => clk_sys_i,
rst_n_i => rst_n_i,
pulse_a_i => fsm_out.sof,
rst_n_i => rst_int_n,
pulse_i => stamper_pulse_a,
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
tag_tai_o => open,
tag_cycles_o => tag_cycles,
tag_valid_o => tag_valid);
tag_valid_o => tag_valid,
tag_error_o => tag_error);
p_frame_counter : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
buf_frame_count <= (others => '0');
else
if(tx_fifo_we = '1' and tx_last_p1_i = '1' and (tx_fifo_rd = '0' or tx_fifo_last = '0')) then
buf_frame_count <= buf_frame_count+ 1;
elsif((tx_fifo_we = '0' or tx_last_p1_i = '0') and (tx_fifo_rd = '1' and tx_fifo_last = '1')) then
buf_frame_count <= buf_frame_count - 1;
end if;
end if;
end if;
end process;
buf_frame_count_inc_ref <= tx_fifo_we and tx_last_p1_i;
buf_frame_count_dec_sys <= tx_fifo_rd and tx_fifo_last;
U_FrameCounter: gc_async_counter_diff
generic map (
g_bits => 5,
g_output_clock => "dec")
port map (
rst_n_i => rst_int_n,
clk_inc_i => clk_data,
clk_dec_i => clk_sys_i,
inc_i => buf_frame_count_inc_ref,
dec_i => buf_frame_count_dec_sys,
counter_o => buf_frame_count);
p_tx_timeout : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
if rst_int_n = '0' then
timeout_counter <= (others => '0');
tx_timeout_hit <= '0';
else
......@@ -339,10 +495,22 @@ begin -- rtl
end if;
end process;
p_latch_timestamp : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_int_n = '0' or state = FRAME_SEQ_ID then
tag_valid_latched <= '0';
elsif tag_valid = '1' then
tag_valid_latched <= '1';
end if;
end if;
end process;
p_fsm : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if rst_n_i = '0' then
if rst_int_n = '0' then
state <= IDLE;
fsm_out.sof <= '0';
fsm_out.eof <= '0';
......@@ -354,7 +522,6 @@ begin -- rtl
crc_en <= '0';
crc_reset <= '1';
tx_frame_p1_o <= '0';
tag_valid_latched <= '0';
tx_flush_latched <= '0';
fsm_escape_enable <= '0';
fsm_escape <= '0';
......@@ -363,21 +530,19 @@ begin -- rtl
if(tx_reset_seq_i = '1') then
seq_no <= (others => '0');
end if;
if(tag_valid = '1') then
tag_valid_latched <= '1'; -- overriden in IDLE
if tx_flush = '1' or tx_timeout_hit = '1' then
tx_flush_latched <= '1';
end if;
tx_flush_latched <= '0';-- overriden in IDLE
case state is
when IDLE =>
tag_valid_latched <= '0';
tx_flush_latched <= tx_flush_p1_i or tx_timeout_hit;
crc_en <= '0';
crc_reset <= '0';
fsm_out.eof <= '0';
tx_frame_p1_o <= '0';
if(fsm_out.dreq = '1' and (tx_flush_latched = '1' or tx_flush_p1_i = '1' or tx_threshold_hit = '1')) then
if(fsm_out.dreq = '1' and tx_fifo_empty = '0' and ( tx_flush_latched = '1' or tx_threshold_hit = '1')) then
state <= SOF;
fsm_out.sof <= '1';
end if;
......@@ -386,6 +551,8 @@ begin -- rtl
fsm_escape <= '0';
when SOF =>
tx_flush_latched <= '0';
fsm_out.sof <= '0';
ser_count <= (others => '0');
state <= ETH_HEADER;
......@@ -394,6 +561,8 @@ begin -- rtl
when ETH_HEADER =>
if(fsm_out.dreq = '1') then
fsm_out.dvalid <= '1';
case count(7 downto 0) is
when x"00" =>
fsm_out.data <= tx_streamer_cfg_i.mac_target(47 downto 32);
......@@ -422,11 +591,23 @@ begin -- rtl
count <= count + 1;
when x"07" =>
if(tx_streamer_cfg_i.qtag_ena = '0') then
fsm_out.data <= tag_valid_latched & "000" & tag_cycles(27 downto 16);
if tag_error = '1' then
fsm_out.data <= x"ffff";
else
fsm_out.data <= "1000" & tag_cycles(27 downto 16);
end if;
if tag_valid_latched = '1' then
count <= count + 1;
fsm_out.dvalid <= '1';
else
fsm_out.dvalid <= '0';
end if;
else
fsm_out.data <= tx_streamer_cfg_i.qtag_prio & '0' & tx_streamer_cfg_i.qtag_vid;
count <= count + 1;
end if;
count <= count + 1;
when x"08" =>
if(tx_streamer_cfg_i.qtag_ena = '0') then
fsm_out.data <= tag_cycles(15 downto 0);
......@@ -436,8 +617,19 @@ begin -- rtl
end if;
count <= count + 1;
when x"09" =>
fsm_out.data <= tag_valid_latched & "000" & tag_cycles(27 downto 16);
count <= count + 1;
if tag_valid_latched = '1' then
count <= count + 1;
fsm_out.dvalid <= '1';
else
fsm_out.dvalid <= '0';
end if;
if tag_error = '1' then
fsm_out.data <= x"ffff";
else
fsm_out.data <= "1000" & tag_cycles(27 downto 16);
end if;
when x"0A" =>
fsm_out.data <= tag_cycles(15 downto 0);
state <= FRAME_SEQ_ID;
......@@ -446,7 +638,6 @@ begin -- rtl
fsm_out.data <= (others => 'X');
count <= (others => 'X');
end case;
fsm_out.dvalid <= '1';
else
fsm_out.dvalid <= '0';
end if;
......@@ -462,7 +653,7 @@ begin -- rtl
crc_reset <= '0';
state <= PAYLOAD;
else
fsm_out.dvalid <= '0';
fsm_out.dvalid <= '0';
end if;
when SUBFRAME_HEADER =>
......@@ -582,16 +773,52 @@ begin -- rtl
else
link_ok_delay_cnt <= c_link_ok_rst_delay;
end if;
link_ok_delay_expired <= '0';
else
-- first initial moments of link_ok_i high are ignored
if(link_ok_i = '1' and link_ok_delay_cnt > 0) then
link_ok_delay_cnt <= link_ok_delay_cnt-1;
end if;
if link_ok_delay_cnt > 0 then
link_ok_delay_expired <= '0';
else
link_ok_delay_expired <= '1';
end if;
end if;
end if;
end process;
tx_dreq_o <= '0' when (link_ok_delay_cnt > 0) else
(not tx_almost_full) and link_ok_i;
U_SyncReset_to_RefClk : gc_sync_ffs
port map (
clk_i => clk_ref_i,
rst_n_i => '1',
data_i => rst_int_n,
synced_o => rst_n_ref);
U_SyncLinkOK_to_RefClk : gc_sync_ffs
port map (
clk_i => clk_ref_i,
rst_n_i => rst_n_ref,
data_i => link_ok_i,
synced_o => link_ok_ref);
U_SyncLinkDelayExpired_to_RefClk : gc_sync_ffs
port map (
clk_i => clk_ref_i,
rst_n_i => rst_n_ref,
data_i => link_ok_delay_expired,
synced_o => link_ok_delay_expired_ref);
p_tx_dreq_gen : process(link_ok_delay_expired_ref, tx_almost_full, link_ok_ref)
begin
if link_ok_delay_expired_ref = '0' then
tx_dreq_o <= '0';
else
tx_dreq_o <= not tx_almost_full and link_ok_ref;
end if;
end process;
end rtl;
......@@ -47,7 +47,7 @@ use work.wrcore_pkg.all; -- needed for t_generic_word_array
-- use work.wr_transmission_wbgen2_pkg.all;
entity xtx_streamers_stats is
generic (
-- Width of frame counters
g_cnt_width : integer := 32 -- minimum 15 bits, max 32
......@@ -68,7 +68,7 @@ entity xtx_streamers_stats is
);
end xtx_streamers_stats;
architecture rtl of xtx_streamers_stats is
signal sent_frame_cnt : unsigned(g_cnt_width-1 downto 0);
......
......@@ -71,6 +71,13 @@ entity xwr_streamers is
-- of them. An application that only receives or only transmits might want to use
-- RX_ONLY or TX_ONLY mode to save resources.
g_streamers_op_mode : t_streamers_op_mode := TX_AND_RX;
-- rate fo the White Rabbit referene clock. By default, this clock is
-- 125MHz for WR Nodes. There are some WR Nodes that work with 62.5MHz.
-- in the future, more frequences might be supported..
g_clk_ref_rate : integer := 125000000;
-----------------------------------------------------------------------------------------
-- Transmission/reception parameters
-----------------------------------------------------------------------------------------
......@@ -89,15 +96,32 @@ entity xwr_streamers is
-----------------------------------------------------------------------------------------
g_slave_mode : t_wishbone_interface_mode := CLASSIC;
g_slave_granularity : t_wishbone_address_granularity := BYTE;
g_simulation : integer := 0
-- indicate that we are simulating so that some processes can be made to take less time
g_simulation : integer := 0;
-- shorten the duration of second to see TAI seconds for simulation only (i.e.
-- only if g_simulation = 1)
g_sim_cycle_counter_range : integer := 125000
);
port (
---------------------------------------------------------------------------
-- Clocks & Resets
---------------------------------------------------------------------------
-- System clock. Used always for the WR fabric interface (src/snk) and
-- for the data path (tx_/rx_ ports) if use_ref_clk_for_data = 0.
clk_sys_i : in std_logic;
-- WR Reference clock, 62.5 or 125 MHz. Frequency must match g_ref_clk_rate
-- generic. Used for latency measurement and timestamping (tm_ ports).
-- It also clocks Tx_/rx_ interfaces if use_ref_clk_for_data != 0.
clk_ref_i : in std_logic := '0';
rst_n_i : in std_logic;
---------------------------------------------------------------------------
-- WR tx/rx interface
-- WR tx/rx interface (clk_sys clock domain)
---------------------------------------------------------------------------
-- Tx
src_i : in t_wrf_source_in;
......@@ -106,8 +130,9 @@ entity xwr_streamers is
snk_i : in t_wrf_sink_in;
snk_o : out t_wrf_sink_out;
---------------------------------------------------------------------------
-- User tx interface
-- User tx interface (clk_data clock domain)
---------------------------------------------------------------------------
-- Data word to be sent.
tx_data_i : in std_logic_vector(g_tx_streamer_params.data_width-1 downto 0);
......@@ -138,12 +163,13 @@ entity xwr_streamers is
-- data word in the subsequent clock cycle.
rx_dreq_i : in std_logic;
rx_late_o : out std_logic;
rx_timeout_o : out std_logic;
---------------------------------------------------------------------------
-- WRC Timing interface, used for latency measurement
---------------------------------------------------------------------------
-- White Rabbit reference clock
clk_ref_i : in std_logic := '0';
-- Time valid flag
tm_time_valid_i : in std_logic := '0';
-- TAI seconds
......@@ -173,11 +199,12 @@ architecture rtl of xwr_streamers is
signal to_wb : t_wr_streamers_in_registers;
signal from_wb : t_wr_streamers_out_registers;
signal dbg_word : std_logic_vector(31 downto 0);
signal start_bit : std_logic_vector(from_wb.dbg_ctrl_start_byte_o'length-1+3 downto 0);
signal rx_data : std_logic_vector(g_rx_streamer_params.data_width-1 downto 0);
signal wb_regs_slave_in : t_wishbone_slave_in;
signal wb_regs_slave_out : t_wishbone_slave_out;
signal wb_regs_slave_out : t_wishbone_slave_out;
signal tx_frame : std_logic;
signal reset_time_tai : std_logic_vector(39 downto 0);
signal latency_acc : std_logic_vector(g_stats_acc_width-1 downto 0);
......@@ -186,8 +213,12 @@ architecture rtl of xwr_streamers is
signal rcvd_frame_cnt_out : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal lost_frame_cnt_out : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal lost_block_cnt_out : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal rx_stat_match_cnt : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal rx_stat_timeout_cnt : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal rx_stat_late_cnt : std_logic_vector(g_stats_cnt_width-1 downto 0);
signal rx_valid : std_logic;
signal rx_latency_valid : std_logic;
signal rx_latency : std_logic_vector(27 downto 0);
signal rx_lost_frames : std_logic;
......@@ -195,6 +226,11 @@ architecture rtl of xwr_streamers is
signal rx_lost_blocks : std_logic;
signal rx_frame : std_logic;
signal rx_stat_match_p1 : std_logic;
signal rx_stat_late_p1 : std_logic;
signal rx_stat_timeout_p1 : std_logic;
signal tx_streamer_cfg : t_tx_streamer_cfg;
signal rx_streamer_cfg : t_rx_streamer_cfg;
......@@ -215,13 +251,15 @@ begin
g_tx_max_words_per_frame => g_tx_streamer_params.max_words_per_frame,
g_tx_timeout => g_tx_streamer_params.timeout,
g_escape_code_disable => g_tx_streamer_params.escape_code_disable,
g_simulation => g_simulation)
g_simulation => g_simulation,
g_clk_ref_rate => g_clk_ref_rate,
g_use_ref_clock_for_data => g_tx_streamer_params.use_ref_clk_for_data)
port map(
clk_sys_i => clk_sys_i,
clk_ref_i => clk_ref_i,
rst_n_i => rst_n_i,
src_i => src_i,
src_o => src_o,
clk_ref_i => clk_ref_i,
tm_time_valid_i => tm_time_valid_i,
tm_tai_i => tm_tai_i,
tm_cycles_i => tm_cycles_i,
......@@ -251,7 +289,11 @@ begin
g_data_width => g_rx_streamer_params.data_width,
g_buffer_size => g_rx_streamer_params.buffer_size,
g_escape_code_disable => g_rx_streamer_params.escape_code_disable,
g_expected_words_number => g_rx_streamer_params.expected_words_number
g_expected_words_number => g_rx_streamer_params.expected_words_number,
g_clk_ref_rate => g_clk_ref_rate,
g_simulation => g_simulation,
g_sim_cycle_counter_range => g_sim_cycle_counter_range,
g_use_ref_clock_for_data => g_rx_streamer_params.use_ref_clk_for_data
)
port map(
clk_sys_i => clk_sys_i,
......@@ -267,9 +309,15 @@ begin
rx_data_o => rx_data,
rx_valid_o => rx_valid,
rx_dreq_i => rx_dreq_i,
rx_late_o => rx_late_o,
rx_timeout_o => rx_timeout_o,
rx_lost_p1_o => rx_lost_blocks,
rx_lost_frames_p1_o => rx_lost_frames,
rx_lost_frames_cnt_o => rx_lost_frames_cnt,
rx_stat_match_p1_o => rx_stat_match_p1,
rx_stat_late_p1_o => rx_stat_late_p1,
rx_stat_timeout_p1_o => rx_stat_timeout_p1,
rx_latency_o => rx_latency,
rx_latency_valid_o => rx_latency_valid,
rx_frame_p1_o => rx_frame,
......@@ -290,9 +338,11 @@ begin
generic map(
g_streamers_op_mode => g_streamers_op_mode,
g_cnt_width => g_stats_cnt_width,
g_acc_width => g_stats_acc_width
g_acc_width => g_stats_acc_width,
g_clk_ref_rate => g_clk_ref_rate
)
port map(
clk_i => clk_sys_i,
rst_n_i => rst_n_i,
sent_frame_i => tx_frame,
......@@ -314,6 +364,13 @@ begin
rcvd_frame_cnt_o => rcvd_frame_cnt_out,
lost_frame_cnt_o => lost_frame_cnt_out,
lost_block_cnt_o => lost_block_cnt_out,
rx_stat_timeout_cnt_o => rx_stat_timeout_cnt,
rx_stat_match_cnt_o => rx_stat_match_cnt,
rx_stat_late_cnt_o => rx_stat_late_cnt,
rx_stat_match_p1_i => rx_stat_match_p1,
rx_stat_late_p1_i => rx_stat_late_p1,
rx_stat_timeout_p1_i => rx_stat_timeout_p1,
latency_cnt_o => latency_cnt,
latency_acc_o => latency_acc,
latency_max_o => to_wb.rx_stat0_rx_latency_max_i,
......@@ -344,6 +401,15 @@ begin
to_wb.rx_stat12_rx_latency_acc_cnt_lsb_i <= latency_cnt (31 downto 0);
to_wb.rx_stat13_rx_latency_acc_cnt_msb_i(c_cw-32-1 downto 0) <= latency_cnt (c_cw-1 downto 32);
-- new stuff added for fixed-latency
to_wb.rx_stat15_rx_late_frames_cnt_lsb_i <= rx_stat_late_cnt(31 downto 0);
to_wb.rx_stat16_rx_late_frames_cnt_msb_i (c_cw-32-1 downto 0) <= rx_stat_late_cnt(c_cw-1 downto 32);
to_wb.rx_stat17_rx_timeout_frames_cnt_lsb_i <= rx_stat_timeout_cnt(31 downto 0);
to_wb.rx_stat18_rx_timeout_frames_cnt_msb_i (c_cw-32-1 downto 0) <= rx_stat_timeout_cnt(c_cw-1 downto 32);
to_wb.rx_stat19_rx_match_frames_cnt_lsb_i <= rx_stat_match_cnt(31 downto 0);
to_wb.rx_stat20_rx_match_frames_cnt_msb_i(c_cw-32-1 downto 0) <= rx_stat_match_cnt(c_cw-1 downto 32);
rx_data_o <= rx_data;
rx_valid_o <= rx_valid;
......@@ -464,4 +530,11 @@ begin
rx_streamer_cfg_i.filter_remote;
rx_streamer_cfg.fixed_latency <= from_wb.rx_cfg5_fixed_latency_o when (from_wb.cfg_or_rx_fix_lat_o='1') else
rx_streamer_cfg_i.fixed_latency;
end rtl;
\ No newline at end of file
rx_streamer_cfg.fixed_latency_timeout <= from_wb.rx_cfg6_rx_fixed_latency_timeout_o when (from_wb.cfg_or_rx_fix_lat_o = '1') else
rx_streamer_cfg_i.fixed_latency_timeout;
rx_streamer_cfg.sw_reset <= from_wb.rstr_rst_sw_o;
tx_streamer_cfg.sw_reset <= from_wb.rstr_rst_sw_o;
end rtl;
`define WBGEN2_WR_STREAMERS_VERSION 32'h00000001
`define WBGEN2_WR_STREAMERS_VERSION 32'h00000002
`define ADDR_WR_STREAMERS_VER 8'h0
`define WR_STREAMERS_VER_ID_OFFSET 0
`define WR_STREAMERS_VER_ID 32'hffffffff
......@@ -135,3 +135,27 @@
`define ADDR_WR_STREAMERS_DUMMY 8'h84
`define WR_STREAMERS_DUMMY_DUMMY_OFFSET 0
`define WR_STREAMERS_DUMMY_DUMMY 32'hffffffff
`define ADDR_WR_STREAMERS_RSTR 8'h88
`define WR_STREAMERS_RSTR_RST_SW_OFFSET 0
`define WR_STREAMERS_RSTR_RST_SW 32'h00000001
`define ADDR_WR_STREAMERS_RX_STAT15 8'h8c
`define WR_STREAMERS_RX_STAT15_RX_LATE_FRAMES_CNT_LSB_OFFSET 0
`define WR_STREAMERS_RX_STAT15_RX_LATE_FRAMES_CNT_LSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_STAT16 8'h90
`define WR_STREAMERS_RX_STAT16_RX_LATE_FRAMES_CNT_MSB_OFFSET 0
`define WR_STREAMERS_RX_STAT16_RX_LATE_FRAMES_CNT_MSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_STAT17 8'h94
`define WR_STREAMERS_RX_STAT17_RX_TIMEOUT_FRAMES_CNT_LSB_OFFSET 0
`define WR_STREAMERS_RX_STAT17_RX_TIMEOUT_FRAMES_CNT_LSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_STAT18 8'h98
`define WR_STREAMERS_RX_STAT18_RX_TIMEOUT_FRAMES_CNT_MSB_OFFSET 0
`define WR_STREAMERS_RX_STAT18_RX_TIMEOUT_FRAMES_CNT_MSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_STAT19 8'h9c
`define WR_STREAMERS_RX_STAT19_RX_MATCH_FRAMES_CNT_LSB_OFFSET 0
`define WR_STREAMERS_RX_STAT19_RX_MATCH_FRAMES_CNT_LSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_STAT20 8'ha0
`define WR_STREAMERS_RX_STAT20_RX_MATCH_FRAMES_CNT_MSB_OFFSET 0
`define WR_STREAMERS_RX_STAT20_RX_MATCH_FRAMES_CNT_MSB 32'hffffffff
`define ADDR_WR_STREAMERS_RX_CFG6 8'ha4
`define WR_STREAMERS_RX_CFG6_RX_FIXED_LATENCY_TIMEOUT_OFFSET 0
`define WR_STREAMERS_RX_CFG6_RX_FIXED_LATENCY_TIMEOUT 32'h0fffffff
......@@ -11,7 +11,7 @@ modules = { "local" : ["../../..",
"../../../modules/wr_streamers",
"../../../top/spec_1_1/wr_streamers_demo",
"../../../ip_cores/general-cores"]}
files = ["main.sv"]
files = ["main.sv","synthesis_descriptor.vhd"]
......@@ -46,8 +46,8 @@ module main;
.clk_125m_pllref_p_i (clk_ref),
.clk_125m_pllref_n_i (~clk_ref),
.fpga_pll_ref_clk_101_p_i (clk_ref),
.fpga_pll_ref_clk_101_n_i (~clk_ref),
.clk_125m_gtp_p_i (clk_ref),
.clk_125m_gtp_n_i (~clk_ref),
.clk_20m_vcxo_i(clk_20m),
......@@ -71,8 +71,8 @@ module main;
.clk_125m_pllref_p_i (clk_ref),
.clk_125m_pllref_n_i (~clk_ref),
.fpga_pll_ref_clk_101_p_i (clk_ref),
.fpga_pll_ref_clk_101_n_i (~clk_ref),
.clk_125m_gtp_p_i (clk_ref),
.clk_125m_gtp_n_i (~clk_ref),
.clk_20m_vcxo_i(clk_20m),
......@@ -91,8 +91,8 @@ module main;
// observe the link LEDs on both sides, and tell us when the link is ready.
wire link_up_a = SPEC_A.U_The_WR_Core.led_link_o;
wire link_up_b = SPEC_B.U_The_WR_Core.led_link_o;
wire link_up_a = SPEC_A.cmp_xwrc_board_spec.led_link_o;
wire link_up_b = SPEC_B.cmp_xwrc_board_spec.led_link_o;
initial begin
// wait until both SPECs see the Ethernet link. Otherwise the packet we're going
......
--------------------------------------------------------------------------------
-- SDB meta information for spec_wr_ref.xise.
--
-- This file was automatically generated by ../../ip_cores/general-cores/tools/sdb_desc_gen.tcl on:
-- Monday, May 13 2019
--
-- ../../ip_cores/general-cores/tools/sdb_desc_gen.tcl is part of OHWR general-cores:
-- https://www.ohwr.org/projects/general-cores/wiki
--
-- For more information on SDB meta information, see also:
-- https://www.ohwr.org/projects/sdb/wiki
--------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
use work.wishbone_pkg.all;
package synthesis_descriptor is
constant c_sdb_synthesis_info : t_sdb_synthesis := (
syn_module_name => "spec_wr_ref ",
syn_commit_id => "94c94685dfc78fe1c2e81ba0467dc7b*",
syn_tool_name => "ISE ",
syn_tool_version => x"00000147",
syn_date => x"20190513",
syn_username => "Maciej Lipinski");
constant c_sdb_repo_url : t_sdb_repo_url := (
repo_url => "https://ohwr.org/project/wr-cores.git ");
end package synthesis_descriptor;
onerror {resume}
quietly WaveActivateNextPane {} 0
add wave -noupdate /main/link_up_a
add wave -noupdate /main/link_up_b
add wave -noupdate -divider {SPEC A-common}
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/clk_ref_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/clk_sys_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/rst_n_i
add wave -noupdate -divider {SPEC A - WR timing}
add wave -noupdate /main/SPEC_A/dio_p_i(1)
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tm_time_valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tm_tai_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tm_cycles_i
add wave -noupdate -radix hexadecimal /main/link_up_a
add wave -noupdate -radix hexadecimal /main/link_up_b
add wave -noupdate -divider {SPEC A - common}
add wave -noupdate -radix hexadecimal /main/SPEC_A/clk_sys_62m5
add wave -noupdate -radix hexadecimal /main/SPEC_A/rst_sys_62m5_n
add wave -noupdate -radix hexadecimal /main/SPEC_A/rst_ref_125m_n
add wave -noupdate -radix hexadecimal /main/SPEC_A/clk_ref_125m
add wave -noupdate -divider {SPEC A - WR Timing}
add wave -noupdate -radix hexadecimal /main/SPEC_A/dio_p_i(1)
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/tm_time_valid_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/tm_tai_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/tm_cycles_o
add wave -noupdate -divider {SPEC A - pulse stamper}
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tag_tai_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tag_cycles_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_Pulse_Stamper/tag_valid_o
add wave -noupdate -divider {SPEC A - TX Streamer}
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_TX_Streamer/tx_data_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_TX_Streamer/tx_valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_TX_Streamer/tx_dreq_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_TX_Streamer/src_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/U_TX_Streamer/src_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/wrs_tx_data_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/wrs_tx_valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/wrs_tx_dreq_o
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/gen_wr_streamers/cmp_xwr_streamers/src_i
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/gen_wr_streamers/cmp_xwr_streamers/src_o
add wave -noupdate -divider {SPEC A - PHY}
add wave -noupdate -radix hexadecimal /main/SPEC_A/phy_tx_data
add wave -noupdate -radix hexadecimal /main/SPEC_A/phy_tx_k
add wave -noupdate -radix hexadecimal /main/SPEC_A/phy_tx_disparity
add wave -noupdate -radix hexadecimal /main/SPEC_A/phy_tx_enc_err
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/phy8_o.tx_data
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/phy8_o.tx_k
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/phy8_i.tx_disparity
add wave -noupdate -radix hexadecimal /main/SPEC_A/cmp_xwrc_board_spec/cmp_board_common/phy8_i.tx_enc_err
add wave -noupdate -divider {SPEC B - PHY}
add wave -noupdate -radix hexadecimal /main/SPEC_B/phy_rx_data
add wave -noupdate -radix hexadecimal /main/SPEC_B/phy_rx_rbclk
add wave -noupdate -radix hexadecimal /main/SPEC_B/phy_rx_k
add wave -noupdate -radix hexadecimal /main/SPEC_B/phy_rx_enc_err
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/phy8_i.rx_data
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/phy8_i.ref_clk
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/phy8_o.tx_k
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/phy8_i.tx_enc_err
add wave -noupdate -divider {SPEC B - WR timing}
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Stamper/tm_time_valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Stamper/tm_tai_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Stamper/tm_cycles_i
add wave -noupdate -divider {SPEC B - RX streamer}
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_RX_Streamer/snk_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_RX_Streamer/snk_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_RX_Streamer/rx_data_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_RX_Streamer/rx_valid_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_RX_Streamer/rx_dreq_i
add wave -noupdate /main/SPEC_B/U_Pulse_Stamper/tm_time_valid_i
add wave -noupdate /main/SPEC_B/U_Pulse_Stamper/tm_tai_i
add wave -noupdate /main/SPEC_B/U_Pulse_Stamper/tm_cycles_i
add wave -noupdate -divider {SPEC B - RX Streamer}
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/gen_wr_streamers/cmp_xwr_streamers/snk_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/gen_wr_streamers/cmp_xwr_streamers/snk_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/rx_data
add wave -noupdate -radix hexadecimal /main/SPEC_B/rx_valid
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/wrs_rx_data_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/wrs_rx_valid_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/cmp_xwrc_board_spec/cmp_board_common/wrs_rx_dreq_i
add wave -noupdate -divider {SPEC B - Timestamp adder}
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/a_tai_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/a_cycles_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/b_tai_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/b_cycles_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/valid_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/q_tai_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/q_cycles_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Add_Delay1/valid_o
add wave -noupdate -divider {SPEC B - pulse generator}
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/trig_ready_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/trig_tai_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/trig_cycles_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/trig_valid_i
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/trig_ready_o
add wave -noupdate -radix hexadecimal /main/SPEC_B/U_Pulse_Generator/pulse_o
TreeUpdate [SetDefaultTree]
WaveRestoreCursors {{Cursor 1} {593239379560 fs} 1} {{Cursor 2} {538394383110 fs} 0}
configure wave -namecolwidth 150
WaveRestoreCursors {{Cursor 1} {560018003180 fs} 0} {{Cursor 2} {530003823340 fs} 0}
configure wave -namecolwidth 221
configure wave -valuecolwidth 152
configure wave -justifyvalue left
configure wave -signalnamewidth 1
......@@ -72,4 +75,4 @@ configure wave -griddelta 40
configure wave -timeline 0
configure wave -timelineunits ns
update
WaveRestoreZoom {0 fs} {839137496540 fs}
WaveRestoreZoom {0 fs} {55629 ns}
action= "simulation"
target= "xilinx"
syn_device="xc6slx45t"
sim_tool="modelsim"
top_module="main"
sim_top="main"
vcom_opt="-mixedsvvh l"
fetchto="../../../ip_cores"
include_dirs=["../../../sim"]
modules = { "local" : ["../../..",
"../../../modules/wr_streamers",
"../../../ip_cores/general-cores"]}
files = ["main.sv"]
//
// White Rabbit Core Hands-On Course
//
// Lesson 04: Simulating the streamers
//
// Objectives:
// - demonstrate packet transfers in WR Core MAC interface
// - demonstrate the user interface of tx_streamer/rx_streamer modules.
// - demonstrate latency measurement feature of the streamers
//
// Brief description:
// A continuous sequence of 64-bit numbers (counting up from 0) is streamed
// via the TX streamer, sent as Ethernet packets over WR MAC interface and decoded
// in the RX streamer module.
//
`include "simdrv_defs.svh"
`include "if_wb_master.svh"
`include "if_wb_link.svh"
`timescale 1ns/1ps
import wishbone_pkg::*;
import streamers_pkg::*;
import wr_fabric_pkg::*;
class WBModule;
protected CBusAccessor m_bus;
protected uint64_t m_base;
function new(CBusAccessor bus, uint64_t base);
m_bus = bus;
m_base = base;
endfunction // new
task automatic writel(uint32_t addr, uint32_t data);
m_bus.write(m_base + addr, data);
endtask // writel
task automatic readl(uint32_t addr, ref uint32_t data);
uint64_t rv;
m_bus.read(m_base + addr, rv);
data = rv;
endtask // writel
endclass // unmatched endclass
class StreamersDriver extends WBModule;
function new(CBusAccessor bus, uint64_t base);
super.new(bus, base);
endfunction // new
task automatic configure();
// set fixed latency
// writel(`ADDR_WR_STREAMERS_RX_CFG5, 10); // in periods of 8ns.
// enable fixed latency (overide register)
// writel(`ADDR_WR_STREAMERS_CFG, 1<<21);
endtask // configure
endclass // WRStreamers
module main;
// Parameters
// Size of data record to be used by the streamers - in our case, a 64-bit
// word.
parameter g_record_size = 64;
parameter g_wr_cycles_per_second = 625000;
// 16-bit data, 2-bit address Wishbone bus that connects the WR MAC interfaces
// of both streamers
IWishboneLink #(16, 2) mac();
// Clock & reset
reg clk_ref = 0;
reg clk_sys = 0;
reg rst = 0;
// TX Streamer signals
reg tx_streamer_dvalid = 0;
reg [g_record_size-1:0] tx_streamer_data = 0;
reg tx_streamer_flush = 0;
reg tx_streamer_last = 0;
wire tx_streamer_dreq;
wire tx_streamer_sync;
// RX Streamer signals
reg rx_streamer_dreq = 0;
wire [g_record_size-1:0] rx_streamer_data;
wire rx_streamer_dvalid;
wire rx_streamer_lost;
wire [27:0] rx_latency;
wire rx_latency_valid;
// Fake White Rabbit reference clock (125 MHz) and cycle counte (we don't use
// TAI counter as the latency never exceeds 1 second...)
reg [27:0] tm_cycles = 0;
reg [39:0] tm_tai = 0;
// Currently transmitted counter value
int tx_counter = 0;
t_rx_streamer_cfg rx_streamer_cfg;
t_tx_streamer_cfg tx_streamer_cfg;
t_wrf_source_out src_out;
t_wrf_source_in src_in;
typedef struct {
bit [g_record_size-1:0] data;
time ts;
} t_queue_entry;
int tx_delay_count = 1;
initial #100 rst = 1;
always #8ns clk_ref <= ~clk_ref;
always #7.9ns clk_sys <= ~clk_sys;
// transfer queue. Used to pass sent data to the verification process.
t_queue_entry queue[$];
// WR clock cycle counter
always@(posedge clk_ref)
if( tm_cycles == g_wr_cycles_per_second - 1 )
begin
tm_cycles <= 0;
tm_tai <= tm_tai + 1;
end else
tm_cycles <= tm_cycles + 1;
// TX data stream generation.
always@(posedge clk_ref)
if(!rst)
begin
tx_streamer_dvalid <= 0;
tx_counter <= 0;
end else begin
// TX streamer is fed with a subsequent data word at random intervals (you can
// change the probability in the condition below). New value is sent only when
// the streamer can accept it (i.e. its tx_dreq_o output is active)
if(tx_delay_count > 0 )
tx_delay_count --;
// $display("txdc %d", tx_delay_count);
if(tx_streamer_dreq && (tx_delay_count == 0) ) begin
automatic t_queue_entry qe;
qe.data = tx_counter;
qe.ts = $time;
tx_delay_count = 300 + {$random} % 100;
queue.push_back(qe);
tx_streamer_data <= tx_counter;
tx_streamer_dvalid <= 1;
tx_streamer_last <= 1;
tx_streamer_flush <= 1;
tx_counter++;
end else
tx_streamer_dvalid <= 0;
end // if (rst)
// Instantiation of the streamers. The TX streamer will assemble packets
// containing max. 8 records, or flush the buffer after 512 clk cycles if
// it contains less than 8 records to prevent latency buildup.
xtx_streamer
#(
.g_data_width (g_record_size),
.g_tx_threshold (8),
.g_tx_buffer_size(16),
.g_tx_max_words_per_frame(16),
.g_tx_timeout (512),
.g_simulation(1),
.g_clk_ref_rate(62500000),
.g_use_ref_clock_for_data(1),
.g_sim_startup_cnt(100)
)
U_TX_Streamer
(
.clk_sys_i(clk_sys),
.rst_n_i (rst),
.src_o (src_out),
.src_i (src_in),
.clk_ref_i(clk_ref), // fake WR time
.tm_time_valid_i(1'b1),
.tm_cycles_i(tm_cycles),
.tm_tai_i(tm_tai),
.tx_data_i (tx_streamer_data),
.tx_valid_i (tx_streamer_dvalid),
.tx_dreq_o (tx_streamer_dreq),
.tx_last_p1_i( tx_streamer_last),
.tx_flush_p1_i( tx_streamer_flush),
.tx_sync_o(tx_streamer_sync),
.tx_streamer_cfg_i(tx_streamer_cfg)
);
// tx config
assign tx_streamer_cfg.ethertype = 16'hdbff;
assign tx_streamer_cfg.mac_local = 48'hdeadbeefcafe;
assign tx_streamer_cfg.mac_target = 48'hffffffffffff;
assign tx_streamer_cfg.qtag_ena = 1'b0;
assign rx_streamer_cfg.ethertype = 16'hdbff;
assign rx_streamer_cfg.mac_local = 48'h000000000000;
assign rx_streamer_cfg.mac_remote = 48'h000000000000;
assign rx_streamer_cfg.accept_broadcasts = 1'b1;
assign rx_streamer_cfg.filter_remote = 1'b0;
assign rx_streamer_cfg.fixed_latency = 200;
xrx_streamer
#(
.g_data_width (g_record_size),
.g_simulation(1),
.g_clk_ref_rate(62500000),
.g_use_ref_clock_for_data(1),
.g_sim_cycle_counter_range(g_wr_cycles_per_second)
)
U_RX_Streamer
(
.clk_sys_i (clk_sys),
.rst_n_i (rst),
.snk_i (src_out),
.snk_o (src_in),
.clk_ref_i(clk_ref), // fake WR time
.tm_time_valid_i(1'b1),
.tm_cycles_i(tm_cycles),
.tm_tai_i(tm_tai),
.rx_data_o (rx_streamer_data),
.rx_valid_o (rx_streamer_dvalid),
.rx_dreq_i (rx_streamer_dreq),
.rx_latency_o (rx_latency),
.rx_latency_valid_o(rx_latency_valid),
.rx_streamer_cfg_i(rx_streamer_cfg)
);
initial rx_streamer_dreq = 1'b1;
// Client-side reception logic. Compares the received records with their copies
// stored in the queue.
always@(posedge clk_ref)
if(!rst)
begin
rx_streamer_dreq <= 1;
end else begin
if(rx_streamer_dvalid)
begin
// Got a record? Compare it against the copy stored in queue.
automatic t_queue_entry qe = queue.pop_front();
automatic time ts_rx = $time, delta;
const time c_pipeline_delay = 64ns;
if( rx_streamer_data != qe.data )
begin
$error("Failure: got rec %x, should be %x", rx_streamer_data, qe.data);
end
// $display("Tx ts %t rx ts %t", qe.ts, ts_rx);
delta = ts_rx - qe.ts - rx_streamer_cfg.fixed_latency * 16ns - c_pipeline_delay;
$display("delta: %.3f us %t", real'(delta) / real'(1us), delta );
end // if (rx_streamer_dvalid)
end // else: !if(!rst)
// Show the latency value when a new frame arrives
// always@(posedge clk)
// if(rst && rx_latency_valid)
// $display("This frame's latency: %.3f microseconds\n", real'(rx_latency) * 0.008);
endmodule // main
# make -f Makefile > /dev/null 2>&1
vsim -L unisim work.main -novopt -suppress 8684,8683
set NumericStdNoWarnings 1
set StdArithNoWarnings 1
do wave.do
run 10us
wave zoomfull
radix -hex
onerror {resume}
quietly WaveActivateNextPane {} 0
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/clk_sys_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/clk_ref_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/rst_n_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/src_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/src_o
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tm_time_valid_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tm_tai_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tm_cycles_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/link_ok_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_data_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_valid_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_dreq_o
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_sync_o
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_last_p1_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_flush_p1_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_reset_seq_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_frame_p1_o
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_streamer_cfg_i
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_threshold_hit
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_timeout_hit
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_flush_latched
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_idle
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_last
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_we
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_full
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_empty
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_rd
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_empty_int
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_rd_int
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_rd_int_d
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_q_int
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_q_reg
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_q_valid
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_q
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_fifo_d
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/state
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/seq_no
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/count
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/ser_count
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/word_count
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/total_words
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/timeout_counter
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/pack_data
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/fsm_out
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/escaper
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/fab_src
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/fsm_escape
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/fsm_escape_enable
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/crc_en
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/crc_en_masked
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/crc_reset
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/crc_value
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_almost_empty
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tx_almost_full
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/buf_frame_count_inc_ref
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/buf_frame_count_dec_sys
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/buf_frame_count
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tag_cycles
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tag_valid
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/tag_valid_latched
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/link_ok_delay_cnt
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/link_ok_delay_expired
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/link_ok_delay_expired_ref
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/link_ok_ref
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/clk_data
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/rst_n_ref
add wave -noupdate -group TxStreamer /main/U_TX_Streamer/stamper_pulse_a
add wave -noupdate -group main /main/clk_ref
add wave -noupdate -group main /main/clk_sys
add wave -noupdate -group main /main/rst
add wave -noupdate -group main /main/tx_streamer_dvalid
add wave -noupdate -group main /main/tx_streamer_data
add wave -noupdate -group main /main/tx_streamer_flush
add wave -noupdate -group main /main/tx_streamer_last
add wave -noupdate -group main /main/tx_streamer_dreq
add wave -noupdate -group main /main/rx_streamer_dreq
add wave -noupdate -group main /main/rx_streamer_data
add wave -noupdate -group main /main/rx_streamer_dvalid
add wave -noupdate -group main /main/rx_streamer_lost
add wave -noupdate -group main /main/rx_latency
add wave -noupdate -group main /main/rx_latency_valid
add wave -noupdate -group main /main/tm_cycles
add wave -noupdate -group main /main/tm_tai
add wave -noupdate -group main /main/tx_counter
add wave -noupdate -group main /main/rx_streamer_cfg
add wave -noupdate -group main /main/tx_streamer_cfg
add wave -noupdate -group main /main/src_out
add wave -noupdate -group main /main/src_in
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rst_n_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/clk_sys_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/clk_ref_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/tm_time_valid_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/tm_tai_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/tm_cycles_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_data_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_last_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_sync_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_target_ts_en_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_valid_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_drop_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_accept_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/d_req_o
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_first_p1_o
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_last_p1_o
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_data_o
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_valid_o
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_dreq_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_streamer_cfg_i
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/State
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rst_n_ref
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/wr_full
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_rd
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/dbuf_d
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/dbuf_q
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_q
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/dbuf_q_valid
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/dbuf_req
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_data
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_sync
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_last
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_target_ts_en
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_target_ts
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_empty
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_we
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/fifo_valid
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/rx_valid
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/delay_arm
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/delay_match
add wave -noupdate -group FixDelay /main/U_RX_Streamer/U_FixLatencyDelay/delay_miss
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/clk_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/rst_n_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/arm_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/ts_latency_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/tm_time_valid_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/tm_tai_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/tm_cycles_i
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/match_o
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/tm_cycles_scaled
add wave -noupdate -expand -group TSCompare /main/U_RX_Streamer/U_FixLatencyDelay/U_Compare/ts_latency_scaled
add wave -noupdate -expand -group Top /main/clk_ref
add wave -noupdate -expand -group Top /main/clk_sys
add wave -noupdate -expand -group Top /main/rst
add wave -noupdate -expand -group Top /main/tx_streamer_dvalid
add wave -noupdate -expand -group Top /main/tx_streamer_data
add wave -noupdate -expand -group Top /main/tx_streamer_flush
add wave -noupdate -expand -group Top /main/tx_streamer_last
add wave -noupdate -expand -group Top /main/tx_streamer_dreq
add wave -noupdate -expand -group Top /main/tx_streamer_sync
add wave -noupdate -expand -group Top /main/rx_streamer_dreq
add wave -noupdate -expand -group Top /main/rx_streamer_data
add wave -noupdate -expand -group Top /main/rx_streamer_dvalid
add wave -noupdate -expand -group Top /main/rx_streamer_lost
add wave -noupdate -expand -group Top /main/rx_latency
add wave -noupdate -expand -group Top /main/rx_latency_valid
add wave -noupdate -expand -group Top /main/tm_cycles
add wave -noupdate -expand -group Top /main/tm_tai
add wave -noupdate -expand -group Top /main/tx_counter
add wave -noupdate -expand -group Top /main/rx_streamer_cfg
add wave -noupdate -expand -group Top /main/tx_streamer_cfg
add wave -noupdate -expand -group Top /main/src_out
add wave -noupdate -expand -group Top /main/src_in
add wave -noupdate -expand -group Top /main/tx_delay_count
TreeUpdate [SetDefaultTree]
WaveRestoreCursors {{Cursor 1} {2269068 ps} 0}
configure wave -namecolwidth 191
configure wave -valuecolwidth 152
configure wave -justifyvalue left
configure wave -signalnamewidth 1
configure wave -snapdistance 10
configure wave -datasetprefix 0
configure wave -rowmargin 4
configure wave -childrowmargin 2
configure wave -gridoffset 0
configure wave -gridperiod 1
configure wave -griddelta 40
configure wave -timeline 0
configure wave -timelineunits ns
update
WaveRestoreZoom {0 ps} {10500 ns}
files = ["spec_top.vhd", "spec_top.ucf", "spec_reset_gen.vhd","timestamp_adder.vhd" ]
files = ["spec_top.vhd", "spec_top.ucf", "timestamp_adder.vhd" ]
modules = { "local" : ["../../../", "../../../platform/xilinx/chipscope"] }
\ No newline at end of file
modules = { "local" : ["../../../", "../../../platform/xilinx/chipscope",
"../../../board/spec/"] }
library ieee;
use ieee.STD_LOGIC_1164.all;
use ieee.NUMERIC_STD.all;
use work.gencores_pkg.all;
entity spec_reset_gen is
port (
clk_sys_i : in std_logic;
rst_pcie_n_a_i : in std_logic;
rst_button_n_a_i : in std_logic;
rst_n_o : out std_logic
);
end spec_reset_gen;
architecture behavioral of spec_reset_gen is
signal powerup_cnt : unsigned(7 downto 0) := x"00";
signal button_synced_n : std_logic;
signal pcie_synced_n : std_logic;
signal powerup_n : std_logic := '0';
begin -- behavioral
U_EdgeDet_PCIe : gc_sync_ffs port map (
clk_i => clk_sys_i,
rst_n_i => '1',
data_i => rst_pcie_n_a_i,
ppulse_o => pcie_synced_n);
U_Sync_Button : gc_sync_ffs port map (
clk_i => clk_sys_i,
rst_n_i => '1',
data_i => rst_button_n_a_i,
synced_o => button_synced_n);
p_powerup_reset : process(clk_sys_i)
begin
if rising_edge(clk_sys_i) then
if(powerup_cnt /= x"ff") then
powerup_cnt <= powerup_cnt + 1;
powerup_n <= '0';
else
powerup_n <= '1';
end if;
end if;
end process;
rst_n_o <= powerup_n and button_synced_n and (not pcie_synced_n);
end behavioral;
#####################
# Clocks, buttons, reset
#####################
#bank 0
NET "clk_20m_vcxo_i" LOC = H12;
NET "clk_20m_vcxo_i" IOSTANDARD = "LVCMOS25";
NET "clk_125m_pllref_n_i" LOC = F10;
NET "clk_125m_pllref_n_i" IOSTANDARD = "LVDS_25";
NET "clk_125m_pllref_p_i" LOC = G9;
NET "clk_125m_pllref_p_i" IOSTANDARD = "LVDS_25";
NET "fpga_pll_ref_clk_101_n_i" LOC = D11;
NET "fpga_pll_ref_clk_101_n_i" IOSTANDARD = "LVDS_25";
NET "fpga_pll_ref_clk_101_p_i" LOC = C11;
NET "fpga_pll_ref_clk_101_p_i" IOSTANDARD = "LVDS_25";
NET "clk_20m_vcxo_i" LOC = H12;
NET "clk_20m_vcxo_i" IOSTANDARD = "LVCMOS25";
NET "l_rst_n" LOC = N20;
NET "l_rst_n" IOSTANDARD = "LVCMOS18";
NET "button1_n_i" LOC = C22;
NET "button1_n_i" IOSTANDARD = "LVCMOS18";
######################
# SFP Pins
######################
NET "clk_125m_gtp_n_i" LOC = D11;
NET "clk_125m_gtp_n_i" IOSTANDARD = "LVDS_25";
NET "clk_125m_gtp_p_i" LOC = C11;
NET "clk_125m_gtp_p_i" IOSTANDARD = "LVDS_25";
###########################################################################
## GN4124 PCIe bridge signals
###########################################################################
NET "gn_rst_n" LOC = N20;
NET "gn_rst_n" IOSTANDARD = "LVCMOS18";
NET "gn_p2l_clk_n" LOC = M19;
NET "gn_p2l_clk_n" IOSTANDARD = "DIFF_SSTL18_I";
NET "gn_p2l_clk_p" LOC = M20;
NET "gn_p2l_clk_p" IOSTANDARD = "DIFF_SSTL18_I";
NET "gn_p2l_rdy" LOC = J16;
NET "gn_p2l_rdy" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_dframe" LOC = J22;
NET "gn_p2l_dframe" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_valid" LOC = L19;
NET "gn_p2l_valid" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[0]" LOC = K20;
NET "gn_p2l_data[0]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[1]" LOC = H22;
NET "gn_p2l_data[1]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[2]" LOC = H21;
NET "gn_p2l_data[2]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[3]" LOC = L17;
NET "gn_p2l_data[3]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[4]" LOC = K17;
NET "gn_p2l_data[4]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[5]" LOC = G22;
NET "gn_p2l_data[5]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[6]" LOC = G20;
NET "gn_p2l_data[6]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[7]" LOC = K18;
NET "gn_p2l_data[7]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[8]" LOC = K19;
NET "gn_p2l_data[8]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[9]" LOC = H20;
NET "gn_p2l_data[9]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[10]" LOC = J19;
NET "gn_p2l_data[10]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[11]" LOC = E22;
NET "gn_p2l_data[11]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[12]" LOC = E20;
NET "gn_p2l_data[12]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[13]" LOC = F22;
NET "gn_p2l_data[13]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[14]" LOC = F21;
NET "gn_p2l_data[14]" IOSTANDARD = "SSTL18_I";
NET "gn_p2l_data[15]" LOC = H19;
NET "gn_p2l_data[15]" IOSTANDARD = "SSTL18_I";
NET "gn_p_wr_req[0]" LOC = M22;
NET "gn_p_wr_req[0]" IOSTANDARD = "SSTL18_I";
NET "gn_p_wr_req[1]" LOC = M21;
NET "gn_p_wr_req[1]" IOSTANDARD = "SSTL18_I";
NET "gn_p_wr_rdy[0]" LOC = L15;
NET "gn_p_wr_rdy[0]" IOSTANDARD = "SSTL18_I";
NET "gn_p_wr_rdy[1]" LOC = K16;
NET "gn_p_wr_rdy[1]" IOSTANDARD = "SSTL18_I";
NET "gn_rx_error" LOC = J17;
NET "gn_rx_error" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_clkn" LOC = K22;
NET "gn_l2p_clkn" IOSTANDARD = "DIFF_SSTL18_I";
NET "gn_l2p_clkp" LOC = K21;
NET "gn_l2p_clkp" IOSTANDARD = "DIFF_SSTL18_I";
NET "gn_l2p_dframe" LOC = U22;
NET "gn_l2p_dframe" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_valid" LOC = T18;
NET "gn_l2p_valid" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_edb" LOC = U20;
NET "gn_l2p_edb" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[0]" LOC = P16;
NET "gn_l2p_data[0]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[1]" LOC = P21;
NET "gn_l2p_data[1]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[2]" LOC = P18;
NET "gn_l2p_data[2]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[3]" LOC = T20;
NET "gn_l2p_data[3]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[4]" LOC = V21;
NET "gn_l2p_data[4]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[5]" LOC = V19;
NET "gn_l2p_data[5]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[6]" LOC = W22;
NET "gn_l2p_data[6]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[7]" LOC = Y22;
NET "gn_l2p_data[7]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[8]" LOC = P22;
NET "gn_l2p_data[8]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[9]" LOC = R22;
NET "gn_l2p_data[9]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[10]" LOC = T21;
NET "gn_l2p_data[10]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[11]" LOC = T19;
NET "gn_l2p_data[11]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[12]" LOC = V22;
NET "gn_l2p_data[12]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[13]" LOC = V20;
NET "gn_l2p_data[13]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[14]" LOC = W20;
NET "gn_l2p_data[14]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_data[15]" LOC = Y21;
NET "gn_l2p_data[15]" IOSTANDARD = "SSTL18_I";
NET "gn_l2p_rdy" LOC = U19;
NET "gn_l2p_rdy" IOSTANDARD = "SSTL18_I";
NET "gn_l_wr_rdy[0]" LOC = R20;
NET "gn_l_wr_rdy[0]" IOSTANDARD = "SSTL18_I";
NET "gn_l_wr_rdy[1]" LOC = T22;
NET "gn_l_wr_rdy[1]" IOSTANDARD = "SSTL18_I";
NET "gn_p_rd_d_rdy[0]" LOC = N16;
NET "gn_p_rd_d_rdy[0]" IOSTANDARD = "SSTL18_I";
NET "gn_p_rd_d_rdy[1]" LOC = P19;
NET "gn_p_rd_d_rdy[1]" IOSTANDARD = "SSTL18_I";
NET "gn_tx_error" LOC = M17;
NET "gn_tx_error" IOSTANDARD = "SSTL18_I";
NET "gn_vc_rdy[0]" LOC = B21;
NET "gn_vc_rdy[0]" IOSTANDARD = "SSTL18_I";
NET "gn_vc_rdy[1]" LOC = B22;
NET "gn_vc_rdy[1]" IOSTANDARD = "SSTL18_I";
NET "gn_gpio[1]" LOC = U16;
NET "gn_gpio[1]" IOSTANDARD = "LVCMOS25";
NET "gn_gpio[0]" LOC = AB19;
NET "gn_gpio[0]" IOSTANDARD = "LVCMOS25";
###########################################################################
## SPI interface to DACs
###########################################################################
NET "plldac_sclk_o" LOC = A4;
NET "plldac_sclk_o" IOSTANDARD = "LVCMOS25";
NET "plldac_din_o" LOC = C4;
NET "plldac_din_o" IOSTANDARD = "LVCMOS25";
NET "pll25dac_cs_n_o" LOC = A3;
NET "pll25dac_cs_n_o" IOSTANDARD = "LVCMOS25";
NET "pll20dac_cs_n_o" LOC = B3;
NET "pll20dac_cs_n_o" IOSTANDARD = "LVCMOS25";
###########################################################################
## SFP I/O for transceiver
###########################################################################
#NET "sfp_txp_o" IOSTANDARD = "LVDS_12";
NET "sfp_txp_o" LOC= B16;
#NET "sfp_txn_o" IOSTANDARD = "LVDS_12";
NET "sfp_txn_o" LOC= A16;
#NET "sfp_rxp_i" IOSTANDARD = "LVDS_12";
NET "sfp_rxp_i" LOC= D15;
#NET "sfp_rxn_i" IOSTANDARD = "LVDS_12";
NET "sfp_rxn_i" LOC= C15;
NET "sfp_det_i" LOC = G15;
NET "sfp_det_i" IOSTANDARD = "LVCMOS25";
NET "sfp_scl_b" LOC = C17;
NET "sfp_scl_b" IOSTANDARD = "LVCMOS25";
NET "sfp_sda_b" LOC = G16;
NET "sfp_sda_b" IOSTANDARD = "LVCMOS25";
NET "sfp_rate_select_b" LOC = H14;
NET "sfp_rate_select_b" IOSTANDARD = "LVCMOS25";
NET "sfp_tx_fault_i" LOC = A17;
NET "sfp_tx_fault_i" IOSTANDARD = "LVCMOS25";
NET "sfp_tx_disable_o" LOC = F17;
NET "sfp_tx_disable_o" IOSTANDARD = "LVCMOS25";
NET "sfp_los_i" LOC = D18;
NET "sfp_los_i" IOSTANDARD = "LVCMOS25";
NET "sfp_led_green_o" LOC = E5;
NET "sfp_led_green_o" IOSTANDARD = "LVCMOS25";
NET "sfp_led_red_o" LOC = D5;
NET "sfp_led_red_o" IOSTANDARD = "LVCMOS25";
#################
# Oscillator control
#################
NET "dac_sclk_o" LOC = A4;
NET "dac_sclk_o" IOSTANDARD = "LVCMOS25";
NET "dac_din_o" LOC = C4;
NET "dac_din_o" IOSTANDARD = "LVCMOS25";
NET "dac_cs1_n_o" LOC = A3;
NET "dac_cs1_n_o" IOSTANDARD = "LVCMOS25";
NET "dac_cs2_n_o" LOC = B3;
NET "dac_cs2_n_o" IOSTANDARD = "LVCMOS25";
#################
# Misc pins
#################
NET "fmc_scl_b" LOC = F7;
NET "fmc_scl_b" IOSTANDARD = "LVCMOS25";
NET "fmc_sda_b" LOC = F8;
NET "fmc_sda_b" IOSTANDARD = "LVCMOS25";
NET "thermo_id_b" LOC = D4;
NET "thermo_id_b" IOSTANDARD = "LVCMOS25";
NET "uart_txd_o" LOC= B2;
NET "uart_txd_o" IOSTANDARD=LVCMOS25;
NET "sfp_mod_def0_i" LOC = G15;
NET "sfp_mod_def0_i" IOSTANDARD = "LVCMOS25";
NET "sfp_mod_def1_b" LOC = C17;
NET "sfp_mod_def1_b" IOSTANDARD = "LVCMOS25";
NET "sfp_mod_def2_b" LOC = G16;
NET "sfp_mod_def2_b" IOSTANDARD = "LVCMOS25";
NET "sfp_rate_select_o" LOC = H14;
NET "sfp_rate_select_o" IOSTANDARD = "LVCMOS25";
NET "sfp_tx_fault_i" LOC = B18;
NET "sfp_tx_fault_i" IOSTANDARD = "LVCMOS25";
NET "sfp_tx_disable_o" LOC = F17;
NET "sfp_tx_disable_o" IOSTANDARD = "LVCMOS25";
NET "sfp_los_i" LOC = D18;
NET "sfp_los_i" IOSTANDARD = "LVCMOS25";
###########################################################################
## Onewire interface -> thermometer
###########################################################################
NET "onewire_b" LOC = D4;
NET "onewire_b" IOSTANDARD = "LVCMOS25";
###########################################################################
## UART
###########################################################################
NET "uart_rxd_i" LOC= A2;
NET "uart_rxd_i" IOSTANDARD=LVCMOS25;
NET "uart_txd_o" LOC= B2;
NET "uart_txd_o" IOSTANDARD=LVCMOS25;
###########################################################################
## Flash memory SPI interface
###########################################################################
NET "flash_ncs_o" LOC = AA3;
NET "flash_ncs_o" IOSTANDARD = "LVCMOS25";
NET "flash_sclk_o" LOC = Y20;
NET "flash_sclk_o" IOSTANDARD = "LVCMOS25";
NET "flash_mosi_o" LOC = AB20;
NET "flash_mosi_o" IOSTANDARD = "LVCMOS25";
NET "flash_miso_i" LOC = AA20;
NET "flash_miso_i" IOSTANDARD = "LVCMOS25";
###########################################################################
## Miscellanous SPEC pins
###########################################################################
NET "led_act_o" LOC = D5;
NET "led_act_o" IOSTANDARD = "LVCMOS25";
NET "led_link_o" LOC = E5;
NET "led_link_o" IOSTANDARD = "LVCMOS25";
NET "button1_i" LOC = C22;
NET "button1_i" IOSTANDARD = "LVCMOS18";
###########################################################################
## Pin definitions for FmcDio5chttl
###########################################################################
NET "dio_clk_p_i" LOC=L20;
NET "dio_clk_p_i" IOSTANDARD=LVDS_25;
NET "dio_clk_n_i" LOC=L22;
NET "dio_clk_n_i" IOSTANDARD=LVDS_25;
NET "dio_p_i[4]" LOC =Y11;
NET "dio_p_i[4]" IOSTANDARD=LVDS_25;
NET "dio_n_i[4]" LOC =AB11;
NET "dio_n_i[4]" IOSTANDARD=LVDS_25;
NET "dio_p_i[3]" LOC =V7;
NET "dio_p_i[3]" IOSTANDARD=LVDS_25;
NET "dio_n_i[3]" LOC =W8;
NET "dio_n_i[3]" IOSTANDARD=LVDS_25;
NET "dio_p_i[2]" LOC =W12;
NET "dio_p_i[2]" IOSTANDARD=LVDS_25;
NET "dio_n_i[2]" LOC =Y12;
NET "dio_n_i[2]" IOSTANDARD=LVDS_25;
NET "dio_p_i[1]" LOC =R11;
NET "dio_p_i[1]" IOSTANDARD=LVDS_25;
NET "dio_n_i[1]" LOC =T11;
NET "dio_n_i[1]" IOSTANDARD=LVDS_25;
NET "dio_p_i[0]" LOC =C19;
NET "dio_p_i[0]" IOSTANDARD=LVDS_25;
NET "dio_n_i[0]" LOC =A19;
NET "dio_n_i[0]" IOSTANDARD=LVDS_25;
########################################################
## Pin definitions for FmcDio5chttl + SPEC v1.1/2.0 ##
########################################################
# DIO outputs
NET "dio_p_o[4]" LOC= T8;
NET "dio_n_o[4]" LOC= U8;
NET "dio_p_o[4]" IOSTANDARD=LVDS_25;
NET "dio_n_o[4]" IOSTANDARD=LVDS_25;
NET "dio_p_o[3]" LOC= U9;
NET "dio_n_o[3]" LOC= V9;
NET "dio_p_o[3]" IOSTANDARD=LVDS_25;
......@@ -108,84 +270,79 @@ NET "dio_n_o[0]" LOC= Y18;
NET "dio_p_o[0]" IOSTANDARD=LVDS_25;
NET "dio_n_o[0]" IOSTANDARD=LVDS_25;
# DIO output enable/termination enable
NET "dio_oe_n_o[4]" LOC= AA6;
NET "dio_oe_n_o[3]" LOC= W10;
NET "dio_oe_n_o[2]" LOC= W11;
NET "dio_oe_n_o[4]" LOC= AA6;
NET "dio_oe_n_o[3]" LOC= W10;
NET "dio_oe_n_o[2]" LOC= W11;
NET "dio_oe_n_o[1]" LOC= Y14;
NET "dio_oe_n_o[0]" LOC= V17;
NET "dio_oe_n_o[4]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[3]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[2]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[1]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[0]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[4]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[3]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[2]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[1]" IOSTANDARD=LVCMOS25;
NET "dio_oe_n_o[0]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[4]" LOC=AB7;
NET "dio_term_en_o[3]" LOC=Y7;
NET "dio_term_en_o[2]" LOC=AB6;
NET "dio_term_en_o[1]" LOC=AB5;
NET "dio_term_en_o[0]" LOC=W18;
NET "dio_term_en_o[4]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[3]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[2]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[1]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[0]" IOSTANDARD=LVCMOS25;
# DIO inputs
NET "dio_p_i[4]" LOC =Y11;
NET "dio_p_i[4]" IOSTANDARD=LVDS_25;
NET "dio_n_i[4]" LOC =AB11;
NET "dio_n_i[4]" IOSTANDARD=LVDS_25;
NET "dio_p_i[3]" LOC =V7;
NET "dio_p_i[3]" IOSTANDARD=LVDS_25;
NET "dio_n_i[3]" LOC =W8;
NET "dio_n_i[3]" IOSTANDARD=LVDS_25;
NET "dio_p_i[2]" LOC =W12;
NET "dio_p_i[2]" IOSTANDARD=LVDS_25;
NET "dio_n_i[2]" LOC =Y12;
NET "dio_n_i[2]" IOSTANDARD=LVDS_25;
NET "dio_p_i[1]" LOC =R11;
NET "dio_p_i[1]" IOSTANDARD=LVDS_25;
NET "dio_n_i[1]" LOC =T11;
NET "dio_n_i[1]" IOSTANDARD=LVDS_25;
NET "dio_p_i[0]" LOC =C19;
NET "dio_p_i[0]" IOSTANDARD=LVDS_25;
NET "dio_n_i[0]" LOC =A19;
NET "dio_n_i[0]" IOSTANDARD=LVDS_25;
NET "dio_term_en_o[4]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[3]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[2]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[1]" IOSTANDARD=LVCMOS25;
NET "dio_term_en_o[0]" IOSTANDARD=LVCMOS25;
NET "dio_led_top_o" LOC= AA12;
NET "dio_led_top_o" IOSTANDARD=LVCMOS25;
NET "dio_led_bot_o" LOC= AB12;
NET "dio_led_bot_o" IOSTANDARD=LVCMOS25;
##Created by Constraints Editor (xc6slx45t-fgg484-3) - 2012/08/07
#ML: INST "U_The_WR_Core/WRPC/U_SOFTPLL/U_Wrapped_Softpll/gen_feedback_dmtds[0].DMTD_FB/clk_in" TNM = skew_limit;
#ML: INST "U_The_WR_Core/WRPC/U_SOFTPLL/U_Wrapped_Softpll/gen_feedback_dmtds[1].DMTD_FB/clk_in" TNM = skew_limit;
#ML: INST "U_The_WR_Core/WRPC/U_SOFTPLL/U_Wrapped_Softpll/gen_ref_dmtds[0].DMTD_REF/clk_in" TNM = skew_limit;
NET "dio_scl_b" LOC = F7;
NET "dio_scl_b" IOSTANDARD = "LVCMOS25";
NET "dio_sda_b" LOC = F8;
NET "dio_sda_b" IOSTANDARD = "LVCMOS25";
INST "*/U_SOFTPLL/U_Wrapped_Softpll/gen_feedback_dmtds*/clk_in" TNM = skew_limit;
INST "*/U_SOFTPLL/U_Wrapped_Softpll/gen_ref_dmtds*/clk_in" TNM = skew_limit;
TIMESPEC TS_ = FROM "skew_limit" TO "FFS" 1 ns DATAPATHONLY;
#Created by Constraints Editor (xc6slx45t-fgg484-3) - 2012/08/08
INST "U_The_WR_Core/WRPC/U_Endpoint/U_Wrapped_Endpoint/U_PCS_1000BASEX/gen_8bit.U_RX_PCS/timestamp_trigger_p_a_o" TNM = rx_ts_trig;
TIMESPEC TS_RXTS = FROM "rx_ts_trig" TO "FFS" 1 ns DATAPATHONLY;
#Created by Constraints Editor (xc6slx45t-fgg484-3) - 2013/03/14
# GN4124
NET "gn_p2l_clk_p" TNM_NET = "gn_p2l_clkp_grp";
NET "gn_p2l_clk_n" TNM_NET = "gn_p2l_clkn_grp";
TIMESPEC TS_cmp_gn4124_core_cmp_clk_in_P_clk = PERIOD "cmp_gn4124_core/cmp_wrapped_gn4124/cmp_clk_in/P_clk" 5 ns HIGH 50%;
NET "gn_rst_n" TIG;
#Created by Constraints Editor (xc6slx45t-fgg484-3) - 2011/01/20
NET "cmp_gn4124_core/cmp_wrapped_gn4124/cmp_clk_in/P_clk" TNM_NET = cmp_gn4124_core/cmp_wrapped_gn4124/cmp_clk_in/P_clk;
#Created by Constraints Editor (xc6slx45t-fgg484-3) - 2011/02/04
NET "clk_20m_vcxo_i" TNM_NET = clk_20m_vcxo_i;
TIMESPEC TS_clk_20m_vcxo_i = PERIOD "clk_20m_vcxo_i" 50 ns HIGH 50%;
NET "clk_125m_pllref_p_i" TNM_NET = clk_125m_pllref_p_i;
TIMESPEC TS_clk_125m_pllref_p_i = PERIOD "clk_125m_pllref_p_i" 8 ns HIGH 50%;
NET "fpga_pll_ref_clk_101_n_i" TNM_NET = fpga_pll_ref_clk_101_n_i;
TIMESPEC TS_fpga_pll_ref_clk_101_n_i = PERIOD "fpga_pll_ref_clk_101_n_i" 8 ns HIGH 50%;
NET "clk_125m_pllref_n_i" TNM_NET = clk_125m_pllref_n_i;
TIMESPEC TS_clk_125m_pllref_n_i = PERIOD "clk_125m_pllref_n_i" 8 ns HIGH 50%;
NET "fpga_pll_ref_clk_101_p_i" TNM_NET = fpga_pll_ref_clk_101_p_i;
TIMESPEC TS_fpga_pll_ref_clk_101_p_i = PERIOD "fpga_pll_ref_clk_101_p_i" 8 ns HIGH 50%;
NET "U_GTP/ch1_gtp_clkout_int<1>" TNM_NET = U_GTP/ch1_gtp_clkout_int<1>;
TIMESPEC TS_U_GTP_ch1_gtp_clkout_int_1_ = PERIOD "U_GTP/ch1_gtp_clkout_int<1>" 8 ns HIGH 50%;
NET "clk_125m_gtp_p_i" TNM_NET = clk_125m_gtp_p_i;
TIMESPEC TS_clk_125m_gtp_p_i = PERIOD "clk_125m_gtp_p_i" 8 ns HIGH 50%;
NET "clk_125m_gtp_n_i" TNM_NET = clk_125m_gtp_n_i;
TIMESPEC TS_clk_125m_gtp_n_i = PERIOD "clk_125m_gtp_n_i" 8 ns HIGH 50%;
# 10MHz reference clock input
NET "dio_clk_p_i" TNM_NET = dio_clk_p_i;
TIMESPEC TS_dio_clk_p_i = PERIOD "dio_clk_p_i" 100 ns HIGH 50%;
NET "dio_clk_n_i" TNM_NET = dio_clk_n_i;
TIMESPEC TS_dio_clk_n_i = PERIOD "dio_clk_n_i" 100 ns HIGH 50%;
# Needed only when DMTD samples 125m refclock (clock has to be fed to D input of
# a flip-flop).
# However, in case of SPEC we use g_divide_input_by_2 generic in the dmtd_with_deglitcher.
# This re-generates 62.5MHz clock from 125Mhz and we don't feed 125M clock directly to D
# input of a flip-flop. This constraint would be needed e.g. for Kintex, where
# refclock is 62.5MHz and we don't use g_divide_input_by_2.
#PIN "WRC_PLATFORM/cmp_pllrefclk_bufg.O" CLOCK_DEDICATED_ROUTE = FALSE;
#Created by Constraints Editor (xc6slx45t-fgg484-3) - 2017/02/20
NET "cmp_xwrc_board_spec/cmp_xwrc_platform/gen_phy_spartan6.cmp_gtp/ch1_gtp_clkout_int<1>" TNM_NET = cmp_xwrc_board_spec/cmp_xwrc_platform/gen_phy_spartan6.cmp_gtp/ch1_gtp_clkout_int<1>;
TIMESPEC TS_cmp_xwrc_board_spec_cmp_xwrc_platform_gen_phy_spartan6_cmp_gtp_ch1_gtp_clkout_int_1_ = PERIOD "cmp_xwrc_board_spec/cmp_xwrc_platform/gen_phy_spartan6.cmp_gtp/ch1_gtp_clkout_int<1>" 8 ns HIGH 50%;
# PIN "cmp_clk_dmtd_buf.O" CLOCK_DEDICATED_ROUTE = FALSE;
##Created by Constraints Editor (xc6slx45t-fgg484-3) - 2012/08/07
INST "*/U_SOFTPLL/U_Wrapped_Softpll/gen_feedback_dmtds*/clk_in" TNM = skew_limit;
INST "*/U_SOFTPLL/U_Wrapped_Softpll/gen_ref_dmtds*/clk_in" TNM = skew_limit;
TIMESPEC TS_ = FROM "skew_limit" TO "FFS" 1 ns DATAPATHONLY;
# Force PPS output to always be placed as IOB register
INST "cmp_xwrc_board_spec/cmp_board_common/cmp_xwr_core/WRPC/PPS_GEN/WRAPPED_PPSGEN/pps_out_o" IOB = FORCE;
-------------------------------------------------------------------------------
-- Title : WR Streamers demo
-- Project : WR PTP Core
-- URL : http://www.ohwr.org/projects/wr-cores/wiki/Wrpc_core
-------------------------------------------------------------------------------
-- File : spec_top.vhd
-- Author(s) : Tomasz Wlostowski (re-done by Maciej Lipinski, based on spec_top)
-- Company : CERN (BE-CO-HT)
-------------------------------------------------------------------------------
-- Description:
--
-- White Rabbit Core Hands-On Course
--
......@@ -16,6 +26,29 @@
-- I/O 1 - PPS output
-- I/O 2 - trigger pulse input
-- I/O 3 - recovered pulse output
--
-------------------------------------------------------------------------------
-- Copyright (c) 2016-2019 CERN
-------------------------------------------------------------------------------
-- GNU LESSER GENERAL PUBLIC LICENSE
--
-- This source file is free software; you can redistribute it
-- and/or modify it under the terms of the GNU Lesser General
-- Public License as published by the Free Software Foundation;
-- either version 2.1 of the License, or (at your option) any
-- later version.
--
-- This source 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 Lesser General Public License for more
-- details.
--
-- You should have received a copy of the GNU Lesser General
-- Public License along with this source; if not, download it
-- from http://www.gnu.org/licenses/lgpl-2.1.html
--
-------------------------------------------------------------------------------
library ieee;
use ieee.std_logic_1164.all;
......@@ -25,38 +58,31 @@ use ieee.numeric_std.all;
library UNISIM;
use UNISIM.vcomponents.all;
-- Use the WR Core package, with xwr_core component defined inside.
use work.wrcore_pkg.all;
library work;
-- Use the General Cores package (for gc_extend_pulse)
use work.gencores_pkg.all;
-- Use the Xilinx White Rabbit platform-specific package (for wr_gtp_phy_spartan6)
use work.wr_xilinx_pkg.all;
-- Use the WR Fabric interface package For WR Fabric interface type definitions
use work.wr_fabric_pkg.all;
-- Use the streamers package for streamer component declarations
-- Use the streamers package for streamer configuration declarations
use work.streamers_pkg.all;
-- -- needed for c_etherbone_sdb
-- use work.etherbone_pkg.all;
-- needed for PIPELINED
use work.wishbone_pkg.all;
-- Needed for generic board support
use work.wr_board_pkg.all;
-- Needed for SPEC-specific board support
use work.wr_spec_pkg.all;
-- Needed for SDB description
use work.synthesis_descriptor.all;
entity spec_top is
generic (
-- setting g_dpram_initf to file path will result in syntesis/simulation using the
-- content of this file to run LM32 microprocessor
-- setting g_dpram_init to empty string (i.e."") will result in synthesis/simulation
-- with empty RAM for the LM32 (it will not work until code is loaded)
-- NOTE: the path is correct when used from the synthesis folder (this is where
-- ISE calls the function to find the file, the path is not correct for where
-- this file is stored, i.e. in the top/ folder)
g_dpram_initf : string := "../../../bin/wrpc/wrc_phy8.bram";
-- Simulation mode enable parameter. Set by default (synthesis) to 0, and
g_dpram_initf : string := "../../bin/wrpc/wrc_phy8.bram";
-- Simulation-mode enable parameter. Set by default (synthesis) to 0, and
-- changed to non-zero in the instantiation of the top level DUT in the testbench.
-- Its purpose is to reduce some internal counters/timeouts to speed up simulations.
g_simulation : integer := 0
);
port (
---------------------------------------------------------------------------
-- Clock signals
---------------------------------------------------------------------------
......@@ -69,8 +95,8 @@ entity spec_top is
-- Dedicated clock for the Xilinx GTP transceiver. Same physical clock as
-- clk_125m_pllref, just coming from another output of CDCM61004 PLL.
fpga_pll_ref_clk_101_p_i : in std_logic;
fpga_pll_ref_clk_101_n_i : in std_logic;
clk_125m_gtp_n_i : in std_logic;
clk_125m_gtp_p_i : in std_logic;
-- Clock input, used to derive the DDMTD clock (check out the general presentation
-- of WR for explanation of its purpose). The clock is produced by the
......@@ -78,32 +104,59 @@ entity spec_top is
-- dac_helper output of the WR Core)
clk_20m_vcxo_i : in std_logic;
-- Reset input, active low. Comes from the Gennum PCI-Express bridge.
l_rst_n : in std_logic := 'H';
-- Button 1 on the SPEC card. In our case, used as an external reset trigger.
button1_n_i : in std_logic := 'H';
---------------------------------------------------------------------------
-- GN4124 PCIe bridge signals
---------------------------------------------------------------------------
-- From GN4124 Local bus
gn_rst_n : in std_logic; -- Reset from GN4124 (RSTOUT18_N)
-- PCIe to Local [Inbound Data] - RX
gn_p2l_clk_n : in std_logic; -- Receiver Source Synchronous Clock-
gn_p2l_clk_p : in std_logic; -- Receiver Source Synchronous Clock+
gn_p2l_rdy : out std_logic; -- Rx Buffer Full Flag
gn_p2l_dframe : in std_logic; -- Receive Frame
gn_p2l_valid : in std_logic; -- Receive Data Valid
gn_p2l_data : in std_logic_vector(15 downto 0); -- Parallel receive data
-- Inbound Buffer Request/Status
gn_p_wr_req : in std_logic_vector(1 downto 0); -- PCIe Write Request
gn_p_wr_rdy : out std_logic_vector(1 downto 0); -- PCIe Write Ready
gn_rx_error : out std_logic; -- Receive Error
-- Local to Parallel [Outbound Data] - TX
gn_l2p_clkn : out std_logic; -- Transmitter Source Synchronous Clock-
gn_l2p_clkp : out std_logic; -- Transmitter Source Synchronous Clock+
gn_l2p_dframe : out std_logic; -- Transmit Data Frame
gn_l2p_valid : out std_logic; -- Transmit Data Valid
gn_l2p_edb : out std_logic; -- Packet termination and discard
gn_l2p_data : out std_logic_vector(15 downto 0); -- Parallel transmit data
-- Outbound Buffer Status
gn_l2p_rdy : in std_logic; -- Tx Buffer Full Flag
gn_l_wr_rdy : in std_logic_vector(1 downto 0); -- Local-to-PCIe Write
gn_p_rd_d_rdy : in std_logic_vector(1 downto 0); -- PCIe-to-Local Read Response Data Ready
gn_tx_error : in std_logic; -- Transmit Error
gn_vc_rdy : in std_logic_vector(1 downto 0); -- Channel ready
-- General Purpose Interface
gn_gpio : inout std_logic_vector(1 downto 0); -- gn_gpio[0] -> GN4124 GPIO8
-- gn_gpio[1] -> GN4124 GPIO9
-------------------------------------------------------------------------
---------------------------------------------------------------------------
-- SFP pins
-------------------------------------------------------------------------
---------------------------------------------------------------------------
-- TX gigabit output
sfp_txp_o : out std_logic;
sfp_txn_o : out std_logic;
sfp_txp_o : out std_logic;
sfp_txn_o : out std_logic;
-- RX gigabit input
sfp_rxp_i : in std_logic;
sfp_rxn_i : in std_logic;
sfp_rxp_i : in std_logic;
sfp_rxn_i : in std_logic;
-- SFP MOD_DEF0 pin (used as a tied-to-ground SFP insertion detect line)
sfp_det_i : in std_logic;
sfp_mod_def0_i : in std_logic; -- sfp detect
-- SFP MOD_DEF1 pin (SCL line of the I2C EEPROM inside the SFP)
sfp_scl_b : inout std_logic;
-- SFP MOD_DEF1 pin (SDA line of the I2C EEPROM inside the SFP)
sfp_sda_b : inout std_logic;
sfp_mod_def1_b : inout std_logic; -- scl
-- SFP MOD_DEF1 pin (SDA line of the I2C EEPROM inside the SFP)
sfp_mod_def2_b : inout std_logic; -- sda
-- SFP RATE_SELECT pin. Unused for most SFPs, in our case tied to 0.
sfp_rate_select_b : inout std_logic;
sfp_rate_select_o : out std_logic;
-- SFP laser fault detection pin. Unused in our design.
sfp_tx_fault_i : in std_logic;
-- SFP laser disable line. In our case, tied to GND.
......@@ -112,44 +165,61 @@ entity spec_top is
-- has its own loss-of-sync detection mechanism.
sfp_los_i : in std_logic;
-- Green LED next to the SFP: indicates if the link is up.
sfp_led_green_o : out std_logic;
-- Red LED next to the SFP: blinking indicates that packets are being
-- transferred.
sfp_led_red_o : out std_logic;
---------------------------------------------------------------------------
-- Oscillator control pins
---------------------------------------------------------------------------
-- A typical SPI bus shared betwen two AD5662 DACs. The first one (CS1) tunes
-- the clk_ref oscillator, the second (CS2) - the clk_dmtd VCXO.
dac_sclk_o : out std_logic;
dac_din_o : out std_logic;
dac_cs1_n_o : out std_logic;
dac_cs2_n_o : out std_logic;
plldac_sclk_o : out std_logic;
plldac_din_o : out std_logic;
pll25dac_cs_n_o : out std_logic; --cs1
pll20dac_cs_n_o : out std_logic; --cs2
---------------------------------------------------------------------------
-- Miscellanous WR Core pins
-- Onewire interface
---------------------------------------------------------------------------
-- I2C bus connected to the EEPROM on the DIO mezzanine. This EEPROM is used
-- for storing WR Core's configuration parameters.
fmc_scl_b : inout std_logic;
fmc_sda_b : inout std_logic;
-- One-wire interface to DS18B20 temperature sensor, which also provides an
-- unique serial number, that WRPC uses to assign itself a unique MAC address.
thermo_id_b : inout std_logic;
onewire_b : inout std_logic;
---------------------------------------------------------------------------
-- UART
---------------------------------------------------------------------------
-- UART pins (connected to the mini-USB port)
uart_txd_o : out std_logic;
uart_rxd_i : in std_logic;
uart_txd_o : out std_logic;
---------------------------------------------------------------------------
-- Flash memory SPI interface
---------------------------------------------------------------------------
-------------------------------------------------------------------------
-- Necessary Digital I/O mezzanine pins
-------------------------------------------------------------------------
flash_sclk_o : out std_logic;
flash_ncs_o : out std_logic;
flash_mosi_o : out std_logic;
flash_miso_i : in std_logic;
---------------------------------------------------------------------------
-- Miscellanous SPEC pins
---------------------------------------------------------------------------
-- Red LED next to the SFP: blinking indicates that packets are being
-- transferred.
led_act_o : out std_logic;
-- Green LED next to the SFP: indicates if the link is up.
led_link_o : out std_logic;
button1_i : in std_logic;
---------------------------------------------------------------------------
-- Digital I/O FMC Pins
-- used in this design to output WR-aligned 1-PPS (in Slave mode) and input
-- 10MHz & 1-PPS from external reference (in GrandMaster mode).
---------------------------------------------------------------------------
-- Clock input from LEMO 5 on the mezzanine front panel. Used as 10MHz
-- external reference input.
dio_clk_p_i : in std_logic;
dio_clk_n_i : in std_logic;
-- Differential inputs, dio_p_i(N) inputs the current state of I/O (N+1) on
-- the mezzanine front panel.
......@@ -170,27 +240,54 @@ entity spec_top is
-- panel is 50-ohm terminated
dio_term_en_o : out std_logic_vector(4 downto 0);
-- Two LEDs on the mezzanine panel
-- Two LEDs on the mezzanine panel. Only Top one is currently used - to
-- blink 1-PPS.
dio_led_top_o : out std_logic;
dio_led_bot_o : out std_logic
);
end spec_top;
dio_led_bot_o : out std_logic;
-- I2C interface for accessing FMC EEPROM. Deprecated, was used in
-- pre-v3.0 releases to store WRPC configuration. Now we use Flash for this.
dio_scl_b : inout std_logic;
dio_sda_b : inout std_logic
);
end entity spec_top;
architecture rtl of spec_top is
architecture top of spec_top is
-----------------------------------------------------------------------------
-- Constants
-----------------------------------------------------------------------------
-- Ethertype we are going to use for the streamer protocol. Value 0xdbff
-- is default for standard WR Core CPU firmware. Other values need re-configuring
-- the WR Core packet filter.
constant c_STREAMER_ETHERTYPE : std_logic_vector(15 downto 0) := x"dbff";
-- Trigger-to-output value, in 8 ns ticks. Set by default to 20us to work
-- for 10km+ fibers.
constant c_PULSE_DELAY : integer := 30000/8;
constant tx_streamer_params : t_tx_streamer_params := (
-- We send each timestamp (40 TAI bits + 28
-- cycle bits) as a single parallel data word of 68 bits. Since data width
-- must be a multiple of 16 bits, we round it up to 80 bits).
data_width => 80,
buffer_size => 256,--default
-- TX threshold = 4 data words. (it's anyway ignored because of
-- g_tx_timeout setting below)
threshold => 4,
max_words_per_frame => 256,--default
-- minimum timeout: sends packets asap to minimize latency (but it's not
-- good for large amounts of data due to encapsulation overhead)
timeout => 1,
use_ref_clk_for_data=> 0, --default
escape_code_disable => FALSE--default
);
constant rx_streamer_params : t_rx_streamer_params := (
-- data width must be identical as in the TX streamer - otherwise, we'll be receiving
-- rubbish
data_width => 80,
buffer_size => 256, --default
escape_code_disable => FALSE,--default
use_ref_clk_for_data => 0, --default
expected_words_number => 0 --default
);
-----------------------------------------------------------------------------
-- Component declarations
-----------------------------------------------------------------------------
......@@ -252,51 +349,45 @@ architecture rtl of spec_top is
q_cycles_o : out std_logic_vector(27 downto 0));
end component;
-----------------------------------------------------------------------------
-- Signals declarations
-- Signals
-----------------------------------------------------------------------------
-- System reset
signal rst_n : std_logic;
-- System clock (62.5 MHz)
signal clk_sys : std_logic;
-- White Rabbit reference clock (125 MHz)
signal clk_ref : std_logic;
-- White Rabbit DDMTD helper clock (62.5-and-something MHz)
signal clk_dmtd : std_logic;
-- 125 MHz GTP clock coming from a dedicated input pin (same as clk_ref)
signal clk_gtp : std_logic;
-- PLL & clock buffer wiring
signal clk_20m_vcxo_buf : std_logic;
signal pllout_clk_sys : std_logic;
signal pllout_clk_fb_pllref : std_logic;
signal pllout_clk_dmtd : std_logic;
signal pllout_clk_fb_dmtd : std_logic;
-- Oscillator control DAC wiring
signal dac_hpll_load_p1 : std_logic;
signal dac_dpll_load_p1 : std_logic;
signal dac_hpll_data : std_logic_vector(15 downto 0);
signal dac_dpll_data : std_logic_vector(15 downto 0);
-- PHY wiring
signal phy_tx_data : std_logic_vector(7 downto 0);
signal phy_tx_k : std_logic_vector(0 downto 0);
signal phy_tx_disparity : std_logic;
signal phy_tx_enc_err : std_logic;
signal phy_rx_data : std_logic_vector(7 downto 0);
signal phy_rx_rbclk : std_logic;
signal phy_rx_k : std_logic_vector(0 downto 0);
signal phy_rx_enc_err : std_logic;
signal phy_rx_bitslide : std_logic_vector(3 downto 0);
signal phy_rst : std_logic;
signal phy_loopen : std_logic;
-- clock and reset
signal clk_sys_62m5 : std_logic;
signal rst_sys_62m5_n : std_logic;
signal rst_ref_125m_n : std_logic;
signal clk_ref_125m : std_logic;
signal clk_ref_div2 : std_logic;
signal clk_ext_10m : std_logic;
-- I2C EEPROM
signal eeprom_sda_in : std_logic;
signal eeprom_sda_out : std_logic;
signal eeprom_scl_in : std_logic;
signal eeprom_scl_out : std_logic;
-- SFP
signal sfp_sda_in : std_logic;
signal sfp_sda_out : std_logic;
signal sfp_scl_in : std_logic;
signal sfp_scl_out : std_logic;
-- OneWire
signal onewire_data : std_logic;
signal onewire_oe : std_logic;
-- LEDs and GPIO
signal wrc_abscal_txts_out : std_logic;
signal wrc_abscal_rxts_out : std_logic;
signal wrc_pps_out : std_logic;
signal wrc_pps_led : std_logic;
signal wrc_pps_in : std_logic;
signal svec_led : std_logic_vector(15 downto 0);
-- DIO Mezzanine
signal dio_in : std_logic_vector(4 downto 0);
signal dio_out : std_logic_vector(4 downto 0);
-- Timing interface
signal tm_time_valid : std_logic;
......@@ -319,26 +410,10 @@ architecture rtl of spec_top is
signal adjusted_ts_tai : std_logic_vector(39 downto 0);
signal adjusted_ts_cycles : std_logic_vector(27 downto 0);
signal pulse_out, pulse_out_long, pulse_in, pulse_in_synced, pps_long : std_logic;
-- Digital I/O mezzanine wiring
signal dio_in : std_logic_vector(4 downto 0);
signal dio_out : std_logic_vector(4 downto 0);
-- Misc signals
signal pps_p, pps_long : std_logic;
signal sfp_scl_out, sfp_sda_out : std_logic;
signal fmc_scl_out, fmc_sda_out : std_logic;
signal owr_enable, owr_in : std_logic_vector(1 downto 0);
signal pulse_out, pulse_in_synced : std_logic;
-- Fabric interface signals, passing packets between the WR Core and the streamers
signal wrcore_snk_out : t_wrf_sink_out;
signal wrcore_snk_in : t_wrf_sink_in;
signal wrcore_src_out : t_wrf_source_out;
signal wrcore_src_in : t_wrf_source_in;
signal tx_streamer_cfg : t_tx_streamer_cfg := c_tx_streamer_cfg_default;
signal rx_streamer_cfg : t_rx_streamer_cfg := c_rx_streamer_cfg_default;
-- ChipScope for histogram readout/debugging
......@@ -360,325 +435,109 @@ architecture rtl of spec_top is
signal control0 : std_logic_vector(35 downto 0);
signal trig0, trig1, trig2, trig3 : std_logic_vector(31 downto 0);
signal rx_latency : std_logic_vector(27 downto 0);
signal rx_latency_valid : std_logic;
begin
-----------------------------------------------------------------------------
-- System/reference clock buffers and PLL
-----------------------------------------------------------------------------
-- Input differential buffer on the 125 MHz reference clock
U_Reference_Clock_Buffer : IBUFGDS
generic map (
DIFF_TERM => true, -- Differential Termination
IBUF_LOW_PWR => true, -- Low power (TRUE) vs. performance (FALSE)
IOSTANDARD => "DEFAULT") -- take the I/O standard from the UCF file
port map (
O => clk_ref, -- Buffer output
I => clk_125m_pllref_p_i, -- Diff_p buffer input (connect directly to top-level port)
IB => clk_125m_pllref_n_i -- Diff_n buffer input (connect directly to top-level port)
);
-- ... and the PLL that derives 62.5 MHz system clock from the 125 MHz reference
U_System_Clock_PLL : PLL_BASE
generic map (
BANDWIDTH => "OPTIMIZED",
CLK_FEEDBACK => "CLKFBOUT",
COMPENSATION => "INTERNAL",
DIVCLK_DIVIDE => 1,
CLKFBOUT_MULT => 8,
CLKFBOUT_PHASE => 0.000,
CLKOUT0_DIVIDE => 16, -- Output 0: 125 MHz * 8 / 16 = 62.5 MHz
CLKOUT0_PHASE => 0.000,
CLKOUT0_DUTY_CYCLE => 0.500,
CLKOUT1_DIVIDE => 16,
CLKOUT1_PHASE => 0.000,
CLKOUT1_DUTY_CYCLE => 0.500,
CLKOUT2_DIVIDE => 16,
CLKOUT2_PHASE => 0.000,
CLKOUT2_DUTY_CYCLE => 0.500,
CLKIN_PERIOD => 8.0,
REF_JITTER => 0.016)
port map (
CLKFBOUT => pllout_clk_fb_pllref,
CLKOUT0 => pllout_clk_sys,
CLKOUT1 => open,
CLKOUT2 => open,
CLKOUT3 => open,
CLKOUT4 => open,
CLKOUT5 => open,
LOCKED => open,
RST => '0',
CLKFBIN => pllout_clk_fb_pllref,
CLKIN => clk_ref);
-- A buffer to drive system clock generated by the PLL above as a global
-- clock net.
U_System_Clock_Buffer : BUFG
port map (
O => clk_sys,
I => pllout_clk_sys);
-----------------------------------------------------------------------------
-- DMTD clock buffers and PLL
-----------------------------------------------------------------------------
-- A global clock buffer to drive the PLL input pin from the 20 MHz VCXO clock
-- input pin on the FPGA
U_DMTD_VCXO_Clock_Buffer : BUFG
port map (
O => clk_20m_vcxo_buf,
I => clk_20m_vcxo_i);
-- The PLL that multiplies the 20 MHz VCXO input to obtain the DDMTD
-- clock, that is sligthly offset in frequency wrs to the reference 125 MHz clock.
-- The WR core additionally requires the DDMTD clock frequency to be divided
-- by 2 (so instead of 125-point-something MHz we get 62.5-point-something
-- MHz). This is to improve internal DDMTD phase detector timing.
U_DMTD_Clock_PLL : PLL_BASE
generic map (
BANDWIDTH => "OPTIMIZED",
CLK_FEEDBACK => "CLKFBOUT",
COMPENSATION => "INTERNAL",
DIVCLK_DIVIDE => 1,
CLKFBOUT_MULT => 50,
CLKFBOUT_PHASE => 0.000,
CLKOUT0_DIVIDE => 16, -- 62.5 MHz
CLKOUT0_PHASE => 0.000,
CLKOUT0_DUTY_CYCLE => 0.500,
CLKOUT1_DIVIDE => 16, -- 62.5 MHz
CLKOUT1_PHASE => 0.000,
CLKOUT1_DUTY_CYCLE => 0.500,
CLKOUT2_DIVIDE => 8,
CLKOUT2_PHASE => 0.000,
CLKOUT2_DUTY_CYCLE => 0.500,
CLKIN_PERIOD => 50.0,
REF_JITTER => 0.016)
port map (
CLKFBOUT => pllout_clk_fb_dmtd,
CLKOUT0 => pllout_clk_dmtd,
CLKOUT1 => open,
CLKOUT2 => open,
CLKOUT3 => open,
CLKOUT4 => open,
CLKOUT5 => open,
LOCKED => open,
RST => '0',
CLKFBIN => pllout_clk_fb_dmtd,
CLKIN => clk_20m_vcxo_buf);
-- A buffer to drive system clock generated by the PLL above as a global
-- clock net.
U_DMTD_Clock_Buffer : BUFG
port map (
O => clk_dmtd,
I => pllout_clk_dmtd);
------------------------------------------------------------------------------
-- Dedicated clock for GTP
------------------------------------------------------------------------------
U_Dedicated_GTP_Clock_Buffer : IBUFGDS
generic map(
DIFF_TERM => true,
IBUF_LOW_PWR => true,
IOSTANDARD => "DEFAULT")
port map (
O => clk_gtp,
I => fpga_pll_ref_clk_101_p_i,
IB => fpga_pll_ref_clk_101_n_i
);
begin -- architecture top
-----------------------------------------------------------------------------
-- Reset signal generator
-- The WR PTP core board package
-----------------------------------------------------------------------------
-- Produces a clean reset signal upon the following
-- conditions:
-- - device is powered up
-- - a PCI-Express bus reset is requested
-- - button 1 is pressed.
U_Reset_Gen : spec_reset_gen
port map (
clk_sys_i => clk_sys,
rst_pcie_n_a_i => L_RST_N,
rst_button_n_a_i => button1_n_i,
rst_n_o => rst_n);
-----------------------------------------------------------------------------
-- The WR Core part. The simplest functional instantiation.
-----------------------------------------------------------------------------
U_The_WR_Core : xwr_core
cmp_xwrc_board_spec : xwrc_board_spec
generic map (
g_simulation => g_simulation,
g_with_external_clock_input => true,
--
g_phys_uart => true,
g_virtual_uart => true,
g_aux_clks => 0,
g_ep_rxbuf_size => 1024,
g_tx_runt_padding => true,
g_pcs_16bit => false,
g_with_external_clock_input => TRUE,
g_dpram_initf => g_dpram_initf,
-- g_aux_sdb => c_etherbone_sdb, --ML
g_dpram_size => 131072/4,
g_interface_mode => PIPELINED,
g_address_granularity => BYTE)
port map (
-- Clocks & resets connections
clk_sys_i => clk_sys,
clk_ref_i => clk_ref,
clk_dmtd_i => clk_dmtd,
rst_n_i => rst_n,
-- Fabric interface pins
wrf_snk_i => wrcore_snk_in,
wrf_snk_o => wrcore_snk_out,
wrf_src_i => wrcore_src_in,
wrf_src_o => wrcore_src_out,
-- Timing interface pins
tm_time_valid_o => tm_time_valid,
tm_tai_o => tm_tai,
tm_cycles_o => tm_cycles,
-- PHY connections
phy_ref_clk_i => clk_ref,
phy_tx_data_o => phy_tx_data,
phy_tx_k_o => phy_tx_k,
phy_tx_disparity_i => phy_tx_disparity,
phy_tx_enc_err_i => phy_tx_enc_err,
phy_rx_data_i => phy_rx_data,
phy_rx_rbclk_i => phy_rx_rbclk,
phy_rx_k_i => phy_rx_k,
phy_rx_enc_err_i => phy_rx_enc_err,
phy_rx_bitslide_i => phy_rx_bitslide,
phy_rst_o => phy_rst,
phy_loopen_o => phy_loopen,
-- Oscillator control DACs connections
dac_hpll_load_p1_o => dac_hpll_load_p1,
dac_hpll_data_o => dac_hpll_data,
dac_dpll_load_p1_o => dac_dpll_load_p1,
dac_dpll_data_o => dac_dpll_data,
-- Miscellanous pins
uart_rxd_i => uart_rxd_i,
uart_txd_o => uart_txd_o,
scl_o => fmc_scl_out,
scl_i => fmc_scl_b,
sda_o => fmc_sda_out,
sda_i => fmc_sda_b,
sfp_scl_o => sfp_scl_out,
sfp_scl_i => sfp_scl_b,
sfp_sda_o => sfp_sda_out,
sfp_sda_i => sfp_sda_b,
sfp_det_i => sfp_det_i,
led_link_o => sfp_led_green_o,
led_act_o => sfp_led_red_o,
owr_en_o => owr_enable,
owr_i => owr_in,
-- The PPS output, which we'll drive to the DIO mezzanine channel 1.
pps_p_o => pps_p
);
-----------------------------------------------------------------------------
-- Dual channel SPI DAC driver
-----------------------------------------------------------------------------
U_DAC_ARB : spec_serial_dac_arb
generic map (
g_invert_sclk => false, -- configured for 2xAD5662. Don't
-- change the parameters.
g_num_extra_bits => 8)
g_fabric_iface => STREAMERS,
g_tx_streamer_params => tx_streamer_params,
g_rx_streamer_params => rx_streamer_params)
port map (
clk_i => clk_sys,
rst_n_i => rst_n,
-- DAC 1 controls the main (clk_ref) oscillator
val1_i => dac_dpll_data,
load1_i => dac_dpll_load_p1,
-- DAC 2 controls the helper (clk_ddmtd) oscillator
val2_i => dac_hpll_data,
load2_i => dac_hpll_load_p1,
dac_cs_n_o(0) => dac_cs1_n_o,
dac_cs_n_o(1) => dac_cs2_n_o,
dac_sclk_o => dac_sclk_o,
dac_din_o => dac_din_o);
-----------------------------------------------------------------------------
-- Gigabit Ethernet PHY using Spartan-6 GTP transceviver.
-----------------------------------------------------------------------------
U_GTP : wr_gtp_phy_spartan6
generic map (
g_enable_ch0 => 0,
-- each GTP has two channels, so does the PHY module.
-- The SFP on the SPEC is connected to the 2nd channel.
g_enable_ch1 => 1,
g_simulation => g_simulation)
port map (
gtp0_clk_i => '0',
gtp1_clk_i => clk_gtp,
ch1_ref_clk_i => clk_ref,
-- TX code stream
ch1_tx_data_i => phy_tx_data,
-- TX control/data select
ch1_tx_k_i => phy_tx_k(0),
-- TX disparity of the previous symbol
ch1_tx_disparity_o => phy_tx_disparity,
-- TX encoding error
ch1_tx_enc_err_o => phy_tx_enc_err,
-- RX recovered byte clock
ch1_rx_rbclk_o => phy_rx_rbclk,
-- RX data stream
ch1_rx_data_o => phy_rx_data,
-- RX control/data select
ch1_rx_k_o => phy_rx_k(0),
-- RX encoding error detection
ch1_rx_enc_err_o => phy_rx_enc_err,
-- RX path comma alignment bit slide delay (crucial for accuracy!)
ch1_rx_bitslide_o => phy_rx_bitslide,
-- Channel reset
ch1_rst_i => phy_rst,
-- Loopback mode enable
ch1_loopen_i => phy_loopen,
pad_txn1_o => sfp_txn_o,
pad_txp1_o => sfp_txp_o,
pad_rxn1_i => sfp_rxn_i,
pad_rxp1_i => sfp_rxp_i);
-- pps_p signal from the WR core is 8ns- (single clk_ref cycle) wide. This is
-- too short to drive outputs such as LEDs. Let's extend its length to some
-- human-noticeable value
U_Extend_PPS : gc_extend_pulse
generic map (
g_width => 10000000) -- output length: 10000000x8ns = 80 ms.
port map (
clk_i => clk_ref,
rst_n_i => rst_n,
pulse_i => pps_p,
extended_o => pps_long);
areset_n_i => button1_i,
areset_edge_n_i => gn_rst_n,
clk_20m_vcxo_i => clk_20m_vcxo_i,
clk_125m_pllref_p_i => clk_125m_pllref_p_i,
clk_125m_pllref_n_i => clk_125m_pllref_n_i,
clk_125m_gtp_n_i => clk_125m_gtp_n_i,
clk_125m_gtp_p_i => clk_125m_gtp_p_i,
clk_10m_ext_i => clk_ext_10m,
clk_sys_62m5_o => clk_sys_62m5,
clk_ref_125m_o => clk_ref_125m,
rst_sys_62m5_n_o => rst_sys_62m5_n,
rst_ref_125m_n_o => rst_ref_125m_n,
plldac_sclk_o => plldac_sclk_o,
plldac_din_o => plldac_din_o,
pll25dac_cs_n_o => pll25dac_cs_n_o,
pll20dac_cs_n_o => pll20dac_cs_n_o,
sfp_txp_o => sfp_txp_o,
sfp_txn_o => sfp_txn_o,
sfp_rxp_i => sfp_rxp_i,
sfp_rxn_i => sfp_rxn_i,
sfp_det_i => sfp_mod_def0_i,
sfp_sda_i => sfp_sda_in,
sfp_sda_o => sfp_sda_out,
sfp_scl_i => sfp_scl_in,
sfp_scl_o => sfp_scl_out,
sfp_rate_select_o => sfp_rate_select_o,
sfp_tx_fault_i => sfp_tx_fault_i,
sfp_tx_disable_o => sfp_tx_disable_o,
sfp_los_i => sfp_los_i,
eeprom_sda_i => eeprom_sda_in,
eeprom_sda_o => eeprom_sda_out,
eeprom_scl_i => eeprom_scl_in,
eeprom_scl_o => eeprom_scl_out,
onewire_i => onewire_data,
onewire_oen_o => onewire_oe,
-- Uart
uart_rxd_i => uart_rxd_i,
uart_txd_o => uart_txd_o,
-- SPI Flash
flash_sclk_o => flash_sclk_o,
flash_ncs_o => flash_ncs_o,
flash_mosi_o => flash_mosi_o,
flash_miso_i => flash_miso_i,
wrs_tx_data_i => tx_data,
wrs_tx_valid_i => tx_valid,
wrs_tx_dreq_o => tx_dreq,
-- every data word we send is the last one, as a single transfer in our
-- case contains only one 80-bit data word.
wrs_tx_last_i => '1',
wrs_tx_flush_i => '0',
wrs_rx_first_o => open,
wrs_rx_last_o => open,
wrs_rx_data_o => rx_data,
wrs_rx_valid_o => rx_valid,
wrs_rx_dreq_i => '1',
wrs_tx_cfg_i => tx_streamer_cfg,
wrs_rx_cfg_i => rx_streamer_cfg,
tm_link_up_o => open,
tm_time_valid_o => tm_time_valid,
tm_tai_o => tm_tai,
tm_cycles_o => tm_cycles,
abscal_txts_o => wrc_abscal_txts_out,
abscal_rxts_o => wrc_abscal_rxts_out,
pps_ext_i => wrc_pps_in,
pps_p_o => wrc_pps_out,
pps_led_o => wrc_pps_led,
led_link_o => led_link_o,
led_act_o => led_act_o);
-- Tristates for SFP EEPROM
sfp_mod_def1_b <= '0' when sfp_scl_out = '0' else 'Z';
sfp_mod_def2_b <= '0' when sfp_sda_out = '0' else 'Z';
sfp_scl_in <= sfp_mod_def1_b;
sfp_sda_in <= sfp_mod_def2_b;
-- tri-state onewire access
onewire_b <= '0' when (onewire_oe = '1') else 'Z';
onewire_data <= onewire_b;
-----------------------------------------------------------------------------
-- Trigger distribution stuff - timestamping & packet transmission part
......@@ -688,10 +547,10 @@ begin
generic map (
g_ref_clk_rate => 125000000)
port map (
clk_ref_i => clk_ref,
clk_sys_i => clk_sys,
rst_n_i => rst_n,
pulse_a_i => dio_in(1), -- I/O 2 = our pulse input
clk_ref_i => clk_ref_125m,
clk_sys_i => clk_sys_62m5,
rst_n_i => rst_sys_62m5_n,
pulse_a_i => pulse_in, -- I/O 2 = our pulse input
tm_time_valid_i => tm_time_valid, -- timing ports of the WR Core
tm_tai_i => tm_tai,
......@@ -701,45 +560,6 @@ begin
tag_cycles_o => tx_tag_cycles,
tag_valid_o => tx_tag_valid);
-- Streamer instantiation.
-- default config: accept broadcast and streamers' Ethertype
U_TX_Streamer : xtx_streamer
generic map (
-- We send each timestamp (40 TAI bits + 28
-- cycle bits) as a single parallel data word of 68 bits. Since data width
-- must be a multiple of 16 bits, we round it up to 80 bits).
g_data_width => 80,
-- TX threshold = 4 data words. (it's anyway ignored because of
-- g_tx_timeout setting below)
g_tx_threshold => 4,
-- minimum timeout: sends packets asap to minimize latency (but it's not
-- good for large amounts of data due to encapsulation overhead)
g_tx_timeout => 1,
-- when simulating, the startup countdown is shorter
g_simulation => g_simulation)
port map (
clk_sys_i => clk_sys,
rst_n_i => rst_n,
-- Wire the packet source of the streamer to the packet sink of the WR Core
src_i => wrcore_snk_out,
src_o => wrcore_snk_in,
clk_ref_i => clk_ref,
tm_time_valid_i => tm_time_valid,
tm_tai_i => tm_tai,
tm_cycles_i => tm_cycles,
tx_data_i => tx_data,
tx_valid_i => tx_valid,
tx_dreq_o => tx_dreq,
-- every data word we send is the last one, as a single transfer in our
-- case contains only one 80-bit data word.
tx_last_p1_i => '1');
-- Pack the time stamp into a 80-bit data word for the streamer
tx_data(27 downto 0) <= tx_tag_cycles;
tx_data(32 + 39 downto 32) <= tx_tag_tai;
......@@ -753,51 +573,23 @@ begin
-- tx_dreq_o output of the streamer is asserted one clock cycle in advance,
-- while the line above drives the valid signal combinatorially. We need a delay.
process(clk_sys)
process(clk_sys_62m5)
begin
if rising_edge(clk_sys) then
if rising_edge(clk_sys_62m5) then
tx_dreq_d0 <= tx_dreq;
end if;
end process;
-----------------------------------------------------------------------------
-- Trigger distribution stuff - packet reception and pulse generation
-----------------------------------------------------------------------------
-- Streamer instantiation
-- default config: accept broadcast and streamers' Ethertype
U_RX_Streamer : xrx_streamer
generic map (
-- data width must be identical as in the TX streamer - otherwise, we'll be receiving
-- rubbish
g_data_width => 80)
port map (
clk_sys_i => clk_sys,
rst_n_i => rst_n,
-- Wire the packet sink of the streamer to the packet source of the WR Core
snk_i => wrcore_src_out,
snk_o => wrcore_src_in,
clk_ref_i => clk_ref,
tm_time_valid_i => tm_time_valid,
tm_tai_i => tm_tai,
tm_cycles_i => tm_cycles,
rx_data_o => rx_data,
rx_valid_o => rx_valid,
rx_dreq_i => '1',
rx_latency_o => rx_latency,
rx_latency_valid_o => rx_latency_valid);
-- Add a fixed delay to the reveived trigger timestamp
U_Add_Delay1 : timestamp_adder
generic map (
g_ref_clk_rate => 125000000)
port map (
clk_i => clk_sys,
rst_n_i => rst_n,
clk_i => clk_sys_62m5,
rst_n_i => rst_sys_62m5_n,
valid_i => rx_valid,
a_tai_i => rx_data(32 + 39 downto 32),
......@@ -816,9 +608,9 @@ begin
generic map (
g_ref_clk_rate => 125000000)
port map (
clk_ref_i => clk_ref,
clk_sys_i => clk_sys,
rst_n_i => rst_n,
clk_ref_i => clk_ref_125m,
clk_sys_i => clk_sys_62m5,
rst_n_i => rst_sys_62m5_n,
pulse_o => pulse_out,
tm_time_valid_i => tm_time_valid,
tm_tai_i => tm_tai,
......@@ -827,6 +619,28 @@ begin
trig_cycles_i => adjusted_ts_cycles,
trig_valid_i => adjusted_ts_valid);
-- pps_p signal from the WR core is 8ns- (single clk_ref cycle) wide. This is
-- too short to drive outputs such as LEDs. Let's extend its length to some
-- human-noticeable value
U_Extend_PPS : gc_extend_pulse
generic map (
g_width => 10000000) -- output length: 10000000x8ns = 80 ms.
port map (
clk_i => clk_ref_125m,
rst_n_i => rst_ref_125m_n,
pulse_i => wrc_pps_out,
extended_o => pps_long);
U_Sync_Trigger_Pulse : gc_sync_ffs
port map (
clk_i => clk_ref_125m,
rst_n_i => rst_ref_125m_n,
data_i => pulse_in,
synced_o => pulse_in_synced);
-- pulse_gen above generates pulses that are single-cycle long. This is too
-- short to observe on a scope, particularly with slower time base (to see 2
-- pulses simulatenously). Let's extend it a bit:
......@@ -835,58 +649,40 @@ begin
-- 1000 * 8ns = 8 us
g_width => 1000)
port map (
clk_i => clk_ref,
rst_n_i => rst_n,
clk_i => clk_ref_125m,
rst_n_i => rst_ref_125m_n,
pulse_i => pulse_out,
extended_o => dio_out(2));
extended_o => pulse_out_long);
-----------------------------------------------------------------------------
-- Differential buffers for the Digital I/O Mezzanine
-----------------------------------------------------------------------------
gen_dio_iobufs : for i in 0 to 4 generate
U_Input_Buffer : IBUFDS
------------------------------------------------------------------------------
-- Digital I/O FMC Mezzanine connections
------------------------------------------------------------------------------
gen_dio_iobufs: for I in 0 to 4 generate
U_ibuf: IBUFDS
generic map (
DIFF_TERM => true)
port map (
O => dio_in(i),
I => dio_p_i(i),
IB => dio_n_i(i)
);
IB => dio_n_i(i));
U_Output_Buffer : OBUFDS
U_obuf : OBUFDS
port map (
I => dio_out(i),
O => dio_p_o(i),
OB => dio_n_o(i)
);
end generate gen_dio_iobufs;
-----------------------------------------------------------------------------
-- Combinatorial pins, tristate buffers, etc.
-----------------------------------------------------------------------------
-- The SFP is permanently enabled
sfp_tx_disable_o <= '0';
sfp_rate_select_b <= '0';
-- Open-drain driver for the Onewire bus
thermo_id_b <= '0' when owr_enable(0) = '1' else 'Z';
owr_in(0) <= thermo_id_b;
-- Open-drain drivers for the I2C busses
fmc_scl_b <= '0' when fmc_scl_out = '0' else 'Z';
fmc_sda_b <= '0' when fmc_sda_out = '0' else 'Z';
sfp_scl_b <= '0' when sfp_scl_out = '0' else 'Z';
sfp_sda_b <= '0' when sfp_sda_out = '0' else 'Z';
-- Connect the PPS output to the I/O 1 of the Digital I/O mezzanine
dio_out(0) <= pps_long;
-- Drive unused DIO outputs to 0.
dio_out(4) <= dio_out(2);
dio_out(3) <= dio_out(2);
dio_out(1) <= '0';
OB => dio_n_o(i));
end generate;
-- DIO_0: (extended) PPS out
dio_out(0) <= pps_long;
-- DIO_1: TX trigger pulse in
pulse_in <= dio_in(1);
dio_out(1) <= '0';
-- DIO_2: (extended) Pulse out (delayed streamer reception)
dio_out(2) <= pulse_out_long;
dio_out(3) <= pulse_out_long;
dio_out(4) <= pulse_out_long;
-- all DIO connectors except I/O 2 (trigger input) are outputs
dio_oe_n_o(0) <= '0';
......@@ -898,31 +694,43 @@ begin
dio_oe_n_o(1) <= '1';
dio_oe_n_o(4 downto 2) <= (others => '0');
dio_term_en_o(1) <= '1';
dio_term_en_o(0) <= '0';
dio_term_en_o(1) <= '1';
dio_term_en_o(4 downto 2) <= (others => '0');
-- Drive one of the LEDs on the mezzanine with out PPS signal (pps_led is a
-- longer version that can be used to directly drive a LED)
dio_led_top_o <= pps_long;
-- EEPROM I2C tri-states
dio_sda_b <= '0' when (eeprom_sda_out = '0') else 'Z';
eeprom_sda_in <= dio_sda_b;
dio_scl_b <= '0' when (eeprom_scl_out = '0') else 'Z';
eeprom_scl_in <= dio_scl_b;
-- The other LED on the DIO serves as an indicator of incoming trigger pulses.
-- Div by 2 reference clock to LEMO connector
process(clk_ref_125m)
begin
if rising_edge(clk_ref_125m) then
clk_ref_div2 <= not clk_ref_div2;
end if;
end process;
U_Sync_Trigger_Pulse : gc_sync_ffs
cmp_ibugds_extref: IBUFGDS
generic map (
DIFF_TERM => true)
port map (
clk_i => clk_ref,
rst_n_i => rst_n,
data_i => dio_in(1),
synced_o => pulse_in_synced);
O => clk_ext_10m,
I => dio_clk_p_i,
IB => dio_clk_n_i);
-- LEDs
dio_led_top_o <= pps_long;
U_Extend_Trigger_Pulse : gc_extend_pulse
generic map (
-- 1000 * 8ns = 8 us
g_width => 1000)
port map (
clk_i => clk_ref,
rst_n_i => rst_n,
clk_i => clk_ref_125m,
rst_n_i => rst_ref_125m_n,
pulse_i => pulse_in_synced,
extended_o => dio_led_bot_o);
......@@ -932,14 +740,13 @@ begin
CS_ILA : chipscope_ila
port map (
CONTROL => CONTROL0,
CLK => clk_sys,
CLK => clk_sys_62m5,
TRIG0 => TRIG0,
TRIG1 => TRIG1,
TRIG2 => TRIG2,
TRIG3 => TRIG3);
trig0(27 downto 0) <= rx_latency;
trig0(31) <= rx_latency_valid;
trig1(31) <= tm_time_valid;
trig1(27 downto 0) <= tm_cycles;
......@@ -952,6 +759,5 @@ begin
trig3(31) <= rx_valid;
trig3(27 downto 0) <= rx_data(27 downto 0);
trig3(30 downto 28) <= rx_data(32 + 2 downto 32);
end rtl;
end architecture top;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment