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

reorder_transpose.vhd

Blame
  • user avatar
    Pepping authored
    ee86e310
    History
    Code owners
    Assign users and groups as approvers for specific file changes. Learn more.
    reorder_transpose.vhd 14.69 KiB
    --------------------------------------------------------------------------------
    --
    -- Copyright (C) 2011
    -- ASTRON (Netherlands Institute for Radio Astronomy) <http://www.astron.nl/>
    -- JIVE (Joint Institute for VLBI in Europe) <http://www.jive.nl/>
    -- P.O.Box 2, 7990 AA Dwingeloo, The Netherlands
    --
    -- This program is free software: you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation, either version 3 of the License, or
    -- (at your option) any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
    --
    --------------------------------------------------------------------------------
    
    -- Purpose: Performing a transpose (reordering data) on one or more streaming 
    --          inputs using external memory.
    --
    -- Description: The input of multiple streams (g_nof_streams) is concatenated into a 
    --              single stream. Either the data field or the complex fields can be 
    --              used, based on the g_use_complex generic.
    -- 
    --              Data on this single stream is than transposed according to the settings 
    --              of g_frame_size_in and g_reorder_seq. 
    --              The actual transpose is divided in two stages. The first stage (pre_transpose) 
    --              is done using a subband select module (reorder_col in RadioHDL).
    --              The second stage is done in external memory (DDR3, DDR4,...). 
    --         
    --              Stage 1: Pre Transpose 
    --              This stage is used to reorder data with a resolution as high as a single 
    --              sample, because the second stage (if using DDR3 for instance) has a resolution
    --              of 16 or more samples. The ss_ss_transp mm interface can be used to specify
    --              the desired reordering for the pre transpose. 
    --
    --              Stage 2: Reorder Sequencer
    --              After the pre transpose the data is send to the external memory 
    --              interface (to_mem_src_out). The reorder sequencer module provides the address
    --              and control signals for the external memory. Writing and reading is done in a 
    --              alternating way. Data from the external memory is received via the 
    --              from_mem_snk_in interface. The sequencers rhythm is based on the settings of 
    --              the g_reorder_seq generic.  
    -- 
    --              At the output the data from the single stream is split up in the original 
    --              g_nof_streams again. A block_gen module is used to generate the SYNC, SOP and EOP 
    --              signals. 
    --  
    --              SYNC and BSN
    --              At the input the BSN number at every SYNC is written to a fifo. This BSN number
    --              is inserted in the output data again when a SYNC is applied at the output. 
    -- 
    --              SYNC Period
    --              The SYNC period (the number of blocks per sync interval) is monitored with a counter.
    --              In case the number of blocks within a syncperiod is not equal to the specified 
    --              g_reorder_seq.nof_blocks the sequencer will reset and start again when the number of 
    --              received blocksdoes match the g_reorder_seq.nof_blocks. 
    --
    -- Remarks:
    
    
    LIBRARY IEEE, common_lib, dp_lib;                   
    USE IEEE.STD_LOGIC_1164.ALL;    
    USE IEEE.numeric_std.ALL;
    USE common_lib.common_pkg.ALL;
    USE common_lib.common_mem_pkg.ALL;
    USE dp_lib.dp_stream_pkg.ALL;
    USE work.reorder_pkg.ALL;
    
    ENTITY reorder_transpose IS
      GENERIC(
        g_nof_streams    : NATURAL := 4;
        g_in_dat_w       : NATURAL := 8;
        g_frame_size_in  : NATURAL := 256;
        g_frame_size_out : NATURAL := 256;
        g_use_complex    : BOOLEAN := TRUE;
        g_mem_dat_w      : NATURAL := 256;       -- The data width to the attached memory. 
        g_ena_pre_transp : BOOLEAN := TRUE;
        g_reorder_seq    : t_reorder_seq := c_reorder_seq;
        g_select_file    : STRING := "UNUSED"
      );                      
      PORT (
        mm_rst                : IN  STD_LOGIC;  -- reset synchronous with mm_clk
        mm_clk                : IN  STD_LOGIC;  -- memory-mapped bus clock                       
        dp_clk                : IN  STD_LOGIC;
        dp_rst                : IN  STD_LOGIC;
                              
        -- ST sinks           
        snk_out_arr           : OUT t_dp_siso_arr(g_nof_streams-1 DOWNTO 0);
        snk_in_arr            : IN  t_dp_sosi_arr(g_nof_streams-1 DOWNTO 0);
        -- ST source          
        src_in_arr            : IN  t_dp_siso_arr(g_nof_streams-1 DOWNTO 0);
        src_out_arr           : OUT t_dp_sosi_arr(g_nof_streams-1 DOWNTO 0);
        
        -- Memory Mapped                                           
        ram_ss_ss_transp_mosi : IN  t_mem_mosi;  -- channel select control
        ram_ss_ss_transp_miso : OUT t_mem_miso;                           
    
        -- Control interface to the external memory
        dvr_miso              : IN  t_mem_ctlr_miso;   
        dvr_mosi              : OUT t_mem_ctlr_mosi;   
        
        -- Data interface to the external memory
        to_mem_src_out        : OUT t_dp_sosi;        
        to_mem_src_in         : IN  t_dp_siso;
        
        from_mem_snk_in       : IN  t_dp_sosi;
        from_mem_snk_out      : OUT t_dp_siso := c_dp_siso_rdy
       );
    END reorder_transpose;
    
    
    ARCHITECTURE str OF reorder_transpose IS  
      
      CONSTANT c_blocksize        : POSITIVE := g_reorder_seq.wr_chunksize + g_reorder_seq.gapsize;
      CONSTANT c_pagesize         : POSITIVE := g_reorder_seq.nof_blocks * c_blocksize;  
      CONSTANT c_mem_size         : POSITIVE := 2*c_pagesize;
      CONSTANT c_mem_size_w       : POSITIVE := ceil_log2(c_mem_size);
     
      CONSTANT c_total_data_w     : NATURAL  := g_nof_streams*g_in_dat_w;
      CONSTANT c_complex_data_w   : NATURAL  := c_total_data_w*c_nof_complex;
      CONSTANT c_data_w           : NATURAL  := sel_a_b(g_use_complex, c_complex_data_w, c_total_data_w);
                                             
      CONSTANT c_nof_ch_in        : NATURAL  := g_frame_size_in*g_reorder_seq.rd_chunksize;
      CONSTANT c_nof_ch_sel       : NATURAL  := g_reorder_seq.wr_chunksize*g_reorder_seq.rd_chunksize;
                                             
      CONSTANT c_data_w_ratio     : POSITIVE := g_mem_dat_w/c_data_w;
    
      SIGNAL sync_check_in_sosi   : t_dp_sosi;          
      SIGNAL sync_check_in_siso   : t_dp_siso := c_dp_siso_rdy;          
      
      SIGNAL packet_merge_in_sosi : t_dp_sosi;          
      SIGNAL packet_merge_in_siso : t_dp_siso; 
                                  
      SIGNAL ss_in_sosi           : t_dp_sosi;          
      SIGNAL ss_in_siso           : t_dp_siso := c_dp_siso_rdy;          
      
      -- ctrl & status DDR3 driver
      SIGNAL dvr_done             : STD_LOGIC;
      SIGNAL dvr_en               : STD_LOGIC;
      SIGNAL dvr_wr_not_rd        : STD_LOGIC;
      SIGNAL dvr_start_address    : STD_LOGIC_VECTOR(c_mem_size_w-1 DOWNTO 0); 
      SIGNAL dvr_nof_data         : STD_LOGIC_VECTOR(c_mem_size_w-1 DOWNTO 0);
      SIGNAL dvr_wr_flush_en      : STD_LOGIC;
      
      SIGNAL to_mem_src_out_i     : t_dp_sosi;    
                                  
      SIGNAL block_gen_out_sosi   : t_dp_sosi;
      SIGNAL pipeline_out_sosi    : t_dp_sosi;  
      
      SIGNAL sync_bsn             : STD_LOGIC_VECTOR(c_dp_stream_bsn_w-1 DOWNTO 0);
      SIGNAL wr_req               : STD_LOGIC;
      SIGNAL rd_req_i             : STD_LOGIC;
      SIGNAL rd_dat_i             : STD_LOGIC_VECTOR(c_dp_stream_bsn_w-1 DOWNTO 0);
      SIGNAL rd_val_i             : STD_LOGIC;
         
    BEGIN 
    
      g_merge_in_complex : IF g_use_complex = TRUE GENERATE 
        PROCESS(snk_in_arr)
        BEGIN 
          sync_check_in_sosi <= snk_in_arr(0);
          FOR i IN 0 TO g_nof_streams-1 LOOP
            sync_check_in_sosi.data((2*i+1)*g_in_dat_w-1 DOWNTO 2*i*g_in_dat_w)     <= snk_in_arr(i).re(g_in_dat_w-1 DOWNTO 0);
            sync_check_in_sosi.data((2*i+2)*g_in_dat_w-1 DOWNTO (2*i+1)*g_in_dat_w) <= snk_in_arr(i).im(g_in_dat_w-1 DOWNTO 0);
          END LOOP;
        END PROCESS;     
      END GENERATE;
        
      g_merge_in_data : IF g_use_complex = FALSE GENERATE 
        PROCESS(snk_in_arr)
        BEGIN 
          sync_check_in_sosi <= snk_in_arr(0);
          FOR i IN 0 TO g_nof_streams-1 LOOP
            sync_check_in_sosi.data((i+1)*g_in_dat_w-1 DOWNTO i*g_in_dat_w) <= snk_in_arr(i).data(g_in_dat_w-1 DOWNTO 0);
          END LOOP;
        END PROCESS;     
      END GENERATE;  
      
      g_siso : FOR J IN 0 TO g_nof_streams-1 GENERATE
        snk_out_arr(J) <= sync_check_in_siso;
      END GENERATE;
      
      u_sync_check_and_restore : ENTITY dp_lib.dp_sync_checker
      GENERIC MAP (
        g_nof_blk_per_sync => g_reorder_seq.nof_blocks
      )
      PORT MAP (
        mm_rst  => mm_rst,
        mm_clk  => mm_clk,
        dp_rst  => dp_rst,
        dp_clk  => dp_clk,
        snk_out => sync_check_in_siso,     
        snk_in  => sync_check_in_sosi,
        src_in  => packet_merge_in_siso,    
        src_out => packet_merge_in_sosi
      );
      
      u_dp_packet_merge : ENTITY dp_lib.dp_packet_merge
      GENERIC MAP (
        g_nof_pkt => g_reorder_seq.rd_chunksize
      )
      PORT MAP (
        rst         => dp_rst,
        clk         => dp_clk,
    
        snk_out     => packet_merge_in_siso,
        snk_in      => packet_merge_in_sosi,
    
        src_in      => ss_in_siso,
        src_out     => ss_in_sosi
      );
    
      gen_pre_transpose : IF g_ena_pre_transp = TRUE GENERATE 
        u_single_ss : ENTITY work.ss
        GENERIC MAP (
          g_dsp_data_w         => c_total_data_w,
          g_nof_ch_in          => c_nof_ch_in,
          g_nof_ch_sel         => c_nof_ch_sel,
          g_select_file_name   => g_select_file,
          g_use_complex        => FALSE
        )
        PORT MAP (
          mm_rst         => mm_rst,
          mm_clk         => mm_clk,
          dp_rst         => dp_rst,
          dp_clk         => dp_clk,
          
          -- Memory Mapped
          ram_ss_ss_mosi => ram_ss_ss_transp_mosi,
          ram_ss_ss_miso => ram_ss_ss_transp_miso,
          
          -- Streaming
          input_sosi     => ss_in_sosi,
          input_siso     => OPEN,                  -- Don't allow backpressure. 
                         
          output_sosi    => to_mem_src_out_i,
          output_siso    => to_mem_src_in
        );
        
      END GENERATE;  
      
      to_mem_src_out <= to_mem_src_out_i;
      
      gen_not_pre_transpose : IF g_ena_pre_transp = FALSE GENERATE
        to_mem_src_out_i <= ss_in_sosi;
        ss_in_siso       <= to_mem_src_in;
      END GENERATE;  
       
      -- Map original dvr interface signals to t_mem_ctlr_mosi/miso
      dvr_done            <= dvr_miso.done;           -- Requested wr or rd sequence is done
      dvr_mosi.burstbegin <= dvr_en;
      dvr_mosi.wr         <= dvr_wr_not_rd;           -- No need to use dvr_mosi.rd
      dvr_mosi.address    <= RESIZE_MEM_CTLR_ADDRESS(dvr_start_address);
      dvr_mosi.burstsize  <= RESIZE_MEM_CTLR_BURSTSIZE(dvr_nof_data);
      dvr_mosi.flush      <= dvr_wr_flush_en;
      dvr_wr_flush_en     <= '0';
      
      u_ddr_sequencer: ENTITY work.reorder_sequencer
      GENERIC MAP(
        g_reorder_seq  => g_reorder_seq,
        g_data_w_ratio => c_data_w_ratio
      )                      
      PORT MAP (       
        dp_rst    => dp_rst,
        dp_clk    => dp_clk,
                  
        en_evt    => dvr_en, 
        wr_not_rd => dvr_wr_not_rd,
                  
        address   => dvr_start_address,
        burstsize => dvr_nof_data,
                  
        done      =>  dvr_done
      );
        
      ---------------------------------------------------------------
      -- FIFO FOR SYNC-BSN
      ---------------------------------------------------------------   
      wr_req <= snk_in_arr(0).sync;
      
      u_sync_bsn_fifo : ENTITY common_lib.common_fifo_sc 
      GENERIC MAP (
        g_use_lut   => TRUE,   -- Make this FIFO in logic, since it's only 2 words deep. 
        g_reset     => FALSE,
        g_init      => FALSE,
        g_dat_w     => c_dp_stream_bsn_w,
        g_nof_words => 16
      )
      PORT MAP (
        rst     => dp_rst,
        clk     => dp_clk,
        wr_dat  => snk_in_arr(0).bsn,
        wr_req  => wr_req,
        wr_ful  => OPEN ,
        rd_dat  => rd_dat_i,
        rd_req  => rd_req_i,
        rd_emp  => open,
        rd_val  => rd_val_i, 
        usedw   => OPEN
      );  
      
      ---------------------------------------------------------------
      -- CREATE READ-AHEAD FIFO INTERFACE FOR SYNC-BSN
      ---------------------------------------------------------------
      u_fifo_adapter : ENTITY common_lib.common_fifo_rd
      GENERIC MAP (
        g_dat_w => c_dp_stream_bsn_w
      )
      PORT MAP(
        rst        => dp_rst, 
        clk        => dp_clk, 
        -- ST sink: RL = 1
        fifo_req   => rd_req_i,
        fifo_dat   => rd_dat_i,
        fifo_val   => rd_val_i,
        -- ST source: RL = 0
        rd_req     => block_gen_out_sosi.sync,
        rd_dat     => sync_bsn,
        rd_val     => OPEN
      );
      
      -----------------------
      -- Pipeline
      -----------------------
      u_dp_pipeline : ENTITY dp_lib.dp_pipeline
      GENERIC MAP(
        g_pipeline => 1
      )
      PORT MAP (
        rst          => dp_rst,
        clk          => dp_clk,
        -- ST sink
        snk_out      => OPEN,
        snk_in       => from_mem_snk_in,
        -- ST source
        src_in       => OPEN,
        src_out      => pipeline_out_sosi
      );
      
      --------------------
      -- DP BLOCK GEN (providing sop/eop)
      --------------------
      u_dp_block_gen : ENTITY dp_lib.dp_block_gen
      GENERIC MAP( 
        g_use_src_in       => FALSE,
        g_nof_data         => g_frame_size_out,
        g_nof_blk_per_sync => g_reorder_seq.nof_blocks,
        g_empty            => 0,
        g_channel          => 0,
        g_error            => 0
      )
      PORT MAP(
        rst        => dp_rst,
        clk        => dp_clk,
        snk_in     => from_mem_snk_in,
        
        -- Use incoming data to generate more data  
        src_in     => c_dp_siso_rdy,
        src_out    => block_gen_out_sosi,
        en         => '1'
      ); 
      
      from_mem_snk_out <= src_in_arr(0);
      
      g_merge_out_complex : IF g_use_complex = TRUE GENERATE 
        gen_merge_out : PROCESS(block_gen_out_sosi, pipeline_out_sosi)
        BEGIN 
          FOR i IN 0 TO g_nof_streams-1 LOOP
            src_out_arr(i)       <= block_gen_out_sosi; 
            src_out_arr(i).valid <= pipeline_out_sosi.valid; 
            src_out_arr(i).re    <= RESIZE_DP_DSP_DATA(pipeline_out_sosi.data((2*i+1)*g_in_dat_w-1 DOWNTO 2*i*g_in_dat_w));
            src_out_arr(i).im    <= RESIZE_DP_DSP_DATA(pipeline_out_sosi.data((2*i+2)*g_in_dat_w-1 DOWNTO (2*i+1)*g_in_dat_w));
            IF (block_gen_out_sosi.sync = '1') THEN 
              src_out_arr(i).bsn <= sync_bsn;
            END IF; 
          END LOOP;
        END PROCESS;
      END GENERATE;
      
      g_merge_out_data : IF g_use_complex = FALSE GENERATE 
        gen_merge_out : PROCESS(block_gen_out_sosi, pipeline_out_sosi)
        BEGIN
          FOR i IN 0 TO g_nof_streams-1 LOOP
            src_out_arr(i)       <= block_gen_out_sosi; 
            src_out_arr(i).valid <= pipeline_out_sosi.valid; 
            src_out_arr(i).data  <= RESIZE_DP_DATA(pipeline_out_sosi.data((i+1)*g_in_dat_w-1 DOWNTO i*g_in_dat_w));
            IF (block_gen_out_sosi.sync = '1') THEN 
              src_out_arr(i).bsn <= sync_bsn;
            END IF; 
          END LOOP;  
        END PROCESS;        
      END GENERATE;
                  
    END str;