Skip to content
Snippets Groups Projects
Select Git revision
  • fadf06530e31a517c277b5f5488ce2fb432c76b4
  • master default protected
  • L2SDP-LIFT
  • L2SDP-1113
  • HPR-158
5 results

dp_bsn_sync_interval.vhd

Blame
  • Code owners
    Assign users and groups as approvers for specific file changes. Learn more.
    dp_bsn_sync_interval.vhd 13.47 KiB
    -------------------------------------------------------------------------------
    --
    -- Copyright (C) 2012
    -- ASTRON (Netherlands Institute for Radio Astronomy) <http://www.astron.nl/>
    -- P.O.Box 2, 7990 AA Dwingeloo, The Netherlands
    --
    -- This program is free software: you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation, either version 3 of the License, or
    -- (at your option) any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
    --
    -------------------------------------------------------------------------------
    
    -- Author: Eric Kooistra, 30 July 2021
    -- Purpose : 
    --   Create programmable sync interval for input stream.
    -- Description:
    -- * ctrl_start_bsn:
    --   The output sync interval starts at an in_sosi.bsn that is programmable via
    --   ctrl_start_bsn. The c_ctrl_start_bsn must be in the future to enable
    --   output, otherwise the output is not enabled. The alternative to enable the
    --   output immediately in case the BSN is in the passed is easy for a user,
    --   because it then starts at any BSN, but that is not synchronous between
    --   FPGAs.
    -- * ctrl_interval_size:
    --   The output sync interval is programmable via ctrl_interval_size. The
    --   ctrl_interval_size is the number data samples per output sync interval,
    --   so an integer multiple sample periods. The g_block_size is the number of
    --   data samples per block.
    --   The output sync intervals are controlled such that on average the number
    --   of blocks per sync interval is nof_blk = ctrl_interval_size /
    --   g_block_size, also when they are not integer dividable.
    -- * ctrl_enable:
    --   The output is enabled at the ctrl_start_bsn when ctrl_enable = '1' and the
    --   output is disable after an in_sosi.eop when ctrl_enable = '0'. If the
    --   output is diabled, then the sosai control fields are forced to '0', the
    --   other sosi fields of the in_sosi are passed on to the out_sosi.
    -- * mon_input_current_bsn:
    --   The user can read mon_input_current_bsn to determine a suitable
    --   ctrl_start_bsn in the future.
    -- * mon_input_bsn_at_sync:
    --   The user can read mon_input_current_bsn to determine a suitable
    --   ctrl_start_bsn in the future to create a output sync interval that is
    --   aligned with the in_sosi.sync.
    -- * mon_output_enable:
    --   The user can read mon_output_enable to check whether the output is indeed
    --   enabled or not.
    -- * mon_output_sync_bsn:
    --   The sync interval calculation is robust to lost in_sosi blocks. As soon
    --   as it receives a new in_sosi block it will try to determine the next
    --   output_sync_bsn, even if blocks were lost for multiple output sync
    --   intervals. If mon_output_sync_bsn - mon_input_current_bsn < 0 then the
    --   output sync interval calculation should catch up after some in_sosi
    --   blocks. If mon_output_sync_bsn - mon_input_current_bsn > nof_blk then
    --   something went wrong and then it may be necessary to recover using
    --   ctrl_enable. If mon_output_sync_bsn - mon_input_current_bsn < nof_blk and
    --   > 0 then that yields the number of blocks until the next output sync.
    -- For example:
    --   . sample period Ts = 5 ns
    --   . g_block_size = 1024 samples
    --   . ctrl_start_bsn = 0
    --   . ctrl_interval_size = 200M
    --   ==>
    --   One block is g_block_size * Ts = 5.12 us
    --   nof_blk = ctrl_interval_size / g_block_size = 195312.5
    --   nof_blk_max = ceil(nof_blk) = 195313 = 1.00000256 s
    --   nof_blk_min = floor(nof_blk) = 195312 = 0.99999744 s
    --   The output sync interval is exactly 1 s on average, the even output sync
    --   periods (starting from inex 0 is even) will use nof_blk_max and the odd
    --   output sync periods will use nof_blk_min.
    --   If all FPGAs are started at the same ctrl_start_bsn, then the output sync
    --   interval is synchonous in the entire array of FPGAs.
    -- Remark:
    -- * The implementation avoids using division and modulo on signals (e.g.
    --   ctrl_interval_size / g_block_size) by using counters and fractions.
    
    
    LIBRARY IEEE, common_lib;
    USE IEEE.STD_LOGIC_1164.ALL;
    USE IEEE.NUMERIC_STD.ALL;
    USE common_lib.common_pkg.ALL;
    USE work.dp_stream_pkg.ALL;
    
    ENTITY dp_bsn_sync_interval IS
      GENERIC (
        g_bsn_w           : NATURAL := c_dp_stream_bsn_w;
        g_block_size      : NATURAL := 256;  -- = number of data valid per BSN block
        g_pipeline        : NATURAL := 1     -- use '1' on HW, use '0' for easier debugging in Wave window
      );
      PORT (
        rst                   : IN  STD_LOGIC;
        clk                   : IN  STD_LOGIC;
    
        -- M&C
        ctrl_enable           : IN  STD_LOGIC;
        ctrl_enable_evt       : IN  STD_LOGIC;
        ctrl_interval_size    : IN  NATURAL;
        ctrl_start_bsn        : IN  STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0) := (OTHERS=>'0');
        mon_input_current_bsn : OUT STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
        mon_input_bsn_at_sync : OUT STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
        mon_output_enable     : OUT STD_LOGIC;
        mon_output_sync_bsn   : OUT STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
    
        -- Streaming
        in_sosi               : IN t_dp_sosi;
        out_sosi              : OUT t_dp_sosi;
        out_start             : OUT STD_LOGIC;
        out_enable            : OUT STD_LOGIC
      );
    END dp_bsn_sync_interval;
    
    
    ARCHITECTURE rtl OF dp_bsn_sync_interval IS
    
      TYPE t_reg IS RECORD
        enable_init       : STD_LOGIC;
        enable            : STD_LOGIC;
        blk_cnt           : NATURAL;
        interval_size     : NATURAL;
        start_bsn         : STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
        input_bsn         : STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
        nof_blk_min       : NATURAL;
        nof_blk_max       : NATURAL;
        nof_blk           : NATURAL;
        extra             : INTEGER;-- RANGE -g_block_size TO g_block_size;
        accumulate        : INTEGER;-- RANGE -g_block_size TO g_block_size;
        hold_eop          : STD_LOGIC;
        update_bsn        : STD_LOGIC;
        output_enable     : STD_LOGIC;
        output_sync_bsn   : STD_LOGIC_VECTOR(g_bsn_w-1 DOWNTO 0);
      END RECORD;
    
      CONSTANT c_reg_rst  : t_reg := ('0', '0', 0, 0, (OTHERS=>'0'), (OTHERS=>'0'), 0, 0, 0, 0, 0, '1', '0', '0', (OTHERS=>'0'));
    
      -- Local registers
      SIGNAL r            : t_reg;
      SIGNAL nxt_r        : t_reg;
    
      SIGNAL output_start : STD_LOGIC;
      SIGNAL output_sync  : STD_LOGIC;
      SIGNAL output_sosi  : t_dp_sosi;
    
    BEGIN
    
      -- Capture monitoring info
      mon_input_current_bsn <= in_sosi.bsn(g_bsn_w-1 DOWNTO 0) WHEN rising_edge(clk) AND in_sosi.sop = '1';
      mon_input_bsn_at_sync <= in_sosi.bsn(g_bsn_w-1 DOWNTO 0) WHEN rising_edge(clk) AND in_sosi.sync = '1';
      mon_output_enable     <= r.output_enable;
      mon_output_sync_bsn   <= r.output_sync_bsn;
    
      p_clk : PROCESS(rst, clk)
      BEGIN
        IF rst='1' THEN
          r <= c_reg_rst;
        ELSIF rising_edge(clk) THEN
          r <= nxt_r;
        END IF;
      END PROCESS;
    
      p_comb : PROCESS(r, ctrl_enable, ctrl_enable_evt, ctrl_interval_size, ctrl_start_bsn, in_sosi)
        VARIABLE v      : t_reg;
        VARIABLE v_size : NATURAL;
      BEGIN
        v := r;
        output_start <= '0';
        output_sync <= '0';
    
        -- Detect ctrl_enable rising event
        IF ctrl_enable = '1' AND ctrl_enable_evt = '1' THEN
          v.enable_init := '1';
        END IF;
    
        -- Initialization: calculate number of blocks per output sync interval
        IF r.enable_init = '1' THEN
          -- Assume ctrl_start_bsn is scheduled more than nof_blk block clk cycles
          -- after the ctrl_enable_evt, so there is sufficient time until
          -- v.output_enable = '1', to perform the calculation of nof_blk_min and
          -- nof_blk_max sequentially. This avoids using division in logic to
          -- calculate ctrl_interval_size / g_block_size.
          v_size := r.blk_cnt * g_block_size;
          IF v_size = ctrl_interval_size THEN
            -- Support integer number of blocks per output sync interval
            v.interval_size := ctrl_interval_size;  -- hold ctrl_interval_size
            v.start_bsn := ctrl_start_bsn;          -- hold ctrl_start_bsn
            -- Fixed sync interval control, effectively disable fractional sync interval control:
            v.nof_blk_min := r.blk_cnt;
            v.nof_blk_max := r.blk_cnt;
            v.nof_blk := r.blk_cnt;                 -- nof_blk = nof_blk_max = nof_blk_min
            v.extra := 0;
            v.accumulate := 0;
            v.enable_init := '0';                   -- enable initialization is done
          ELSIF v_size > ctrl_interval_size THEN
            -- Support fractional number of blocks per output sync interval
            v.interval_size := ctrl_interval_size;  -- hold ctrl_interval_size
            v.start_bsn := ctrl_start_bsn;          -- hold ctrl_start_bsn
            -- Fractional sync interval control:
            v.nof_blk_min := r.blk_cnt - 1;
            v.nof_blk_max := r.blk_cnt;
            v.nof_blk := r.blk_cnt;                 -- start with nof_blk_max sync interval
            v.extra := v_size - ctrl_interval_size; -- number of extra samples in nof_blk_max compared to ctrl_interval_size
            v.accumulate := v.extra;                -- start with nof_blk_max sync interval
            v.enable_init := '0';                   -- enable initialization is done
          ELSE
            v.blk_cnt := r.blk_cnt + 1;
          END IF;
        ELSE
          v.blk_cnt := 0;
        END IF;
    
        -- If ctrl_enable is still active after initialization then continue with enable
        IF ctrl_enable = '0' THEN
          v.enable := '0';
        ELSIF r.enable_init = '0' THEN
          v.enable := '1';
        END IF;
    
        -- Hold input eop to detect when input has finished a block and to detect
        -- gaps between in_sosi.eop and in_sosi.sop
        IF in_sosi.sop = '1' THEN
          v.hold_eop := '0';
        END IF;
        IF in_sosi.eop = '1' THEN
          v.hold_eop := '1';
        END IF;
    
        IF r.enable = '1' THEN
          -- Output enable at in_sosi.sop start_bsn
          IF in_sosi.sop = '1' THEN
            IF UNSIGNED(in_sosi.bsn) = UNSIGNED(r.start_bsn) THEN
              v.output_enable := '1';
              output_start <= '1';  -- Pulse at start of output enable at start BSN of output sync intervals
              v.output_sync_bsn := r.start_bsn;  -- Initialize output sync at start BSN of output sync intervals
            END IF;
          END IF;
        ELSE
          -- Output disable after in_sosi.eop
          IF r.hold_eop = '1' THEN
            v.output_enable := '0';
          END IF;
        END IF;
    
        -- Generate output sync interval based on input BSN and ctrl_interval_size
        IF v.output_enable = '1' THEN
          IF in_sosi.sop = '1' THEN
            IF UNSIGNED(in_sosi.bsn) = UNSIGNED(v.output_sync_bsn) THEN
              -- Matching input block
              output_sync <= '1';  -- The output sync interval
              v.update_bsn := '1';
            ELSIF UNSIGNED(in_sosi.bsn) > UNSIGNED(v.output_sync_bsn) THEN
              -- Missed one or more input blocks, so cannot output sync, look for
              -- next opportunity
              v.update_bsn := '1';
            END IF;
          END IF;
        END IF;
    
        -- Determine BSN for next output sync
        IF r.update_bsn = '1' THEN
          -- Similar code as in proc_dp_verify_sync(), the difference is that:
          -- . Here r.extra is number of extra samples in nof_blk_max compared to
          --   ctrl_interval_size,
          -- . in proc_dp_verify_sync() r.extra is number of extra samples in
          --   ctrl_interval_size compared to nof_blk_min.
          -- Both schemes are valid, by using different schemes here and in tb the
          -- verification coverage improves.
          v.output_sync_bsn := ADD_UVEC(r.output_sync_bsn, TO_UVEC(r.nof_blk, c_natural_w));  -- next BSN
    
          v.nof_blk := r.nof_blk_max;
          v.accumulate := r.accumulate + r.extra;  -- account for nof_blk_max
          IF v.accumulate >= g_block_size THEN
            v.nof_blk := r.nof_blk_min;
            v.accumulate := v.accumulate - g_block_size;  -- adjust for nof_blk_min
          END IF;
    
          -- Assume output_sync_bsn is in future
          v.update_bsn := '0';
    
          -- else last r.input_bsn will be used to keep update_bsn active for
          -- more clk cycles to catch up for lost input blocks.
        END IF;
    
        -- Hold input bsn
        IF in_sosi.sop = '1' THEN
          v.input_bsn := in_sosi.bsn(g_bsn_w-1 DOWNTO 0);
        END IF;
    
        -- Catch up with output_sync_bsn in case of lost input blocks
        IF v.output_enable = '1' THEN
          IF UNSIGNED(r.input_bsn) > UNSIGNED(v.output_sync_bsn) THEN
            -- Missed one or more input blocks, fast forward to look for next
            -- output_sync_bsn
            v.update_bsn := '1';
          END IF;
        END IF;
    
        nxt_r <= v;
      END PROCESS;
    
      -- Output in_sosi with programmed sync interval or disable the output
      p_output_sosi : PROCESS(in_sosi, nxt_r, output_sync)
      BEGIN
        output_sosi <= in_sosi;
        IF nxt_r.output_enable = '1' THEN
          output_sosi.sync <= output_sync;
        ELSE
          output_sosi.sync  <= '0';
          output_sosi.sop   <= '0';
          output_sosi.eop   <= '0';
          output_sosi.valid <= '0';
        END IF;
      END PROCESS;
    
      -- Pipeline output to avoid timing closure problems due to use of nxt_r.output_enable
      u_out_sosi : ENTITY work.dp_pipeline
      GENERIC MAP (
        g_pipeline  => g_pipeline
      )
      PORT MAP (
        rst          => rst,
        clk          => clk,
        -- ST sink
        snk_in       => output_sosi,
        -- ST source
        src_out      => out_sosi
      );
    
      gen_pipe_out_start : IF g_pipeline = 1 GENERATE
        out_start <= output_start WHEN rising_edge(clk);
        out_enable <= r.output_enable;
      END GENERATE;
      no_pipe_out_start : IF g_pipeline = 0 GENERATE
        out_start <= output_start;
        out_enable <= nxt_r.output_enable;
      END GENERATE;
    
    END rtl;