diff --git a/libraries/io/aduh/src/vhdl/aduh_dd.vhd b/libraries/io/aduh/src/vhdl/aduh_dd.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..13d838a8b1eb87899f9c45da3a417b01b034b9ea
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_dd.vhd
@@ -0,0 +1,333 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+USE work.aduh_dd_pkg.ALL;
+
+-- Purpose: ADUH = ADU Handler using DDIO (no PLL).
+--          Handles the LVDS Rx interface between a BN and two ADCs on one ADU.
+-- Description:
+-- Remarks:
+-- . Compensate for DQ port rewire on ADU
+-- . Convert offset binary of ADCs on ADU to two's complement.
+-- . The c_rx_fifo_fill is set as a constant and not made programmable via MM
+--   control, because this would require using a separate FIFO for each signal
+--   path. This is not needed for Apertif where the A and B can share a FIFO
+--   in lvds_dd, similar as C and D.
+-- . This aduh_dd can not use the config IO interface on lvdsh_dd to set the
+--   input delays, because this is not supported by all ADC_BI pins. Instead
+--   use setup and hold times via set_input_delay in a SDC file to effectively
+--   let the fitter control these delays.
+--   For more details on the input timing constraints see:
+--   . common/build/synth/quartus_iobuf_in_dd/common_iobuf_in_dd.qsf
+--   . aduh/build/synth/quartus/aduh_dd.qsf
+--   . an433
+-- . The ADU ADC can output the data relative to the DCLK clock either at:
+--   . phase  0 degrees = source aligned
+--   . phase 90 degrees = center aligned
+--   The input timing constrainst in the SDC must be set accordingly.
+-- . Output reset pulse:
+--   . use g_ai.clk_rst_invert is TRUE to compensate when connected to pin _N,
+--   . use g_ai.clk_rst_invert is FALSE              when connected to pin _P,
+--   see also in BACK_NODE_adc_pins.tcl and adu_half.vhd
+  
+ENTITY aduh_dd IS
+  GENERIC (
+    g_nof_dp_phs_clk    : NATURAL := 1;      -- nof dp_phs_clk that can be used to detect the word phase
+    g_ai                : t_c_aduh_dd_ai := c_aduh_dd_ai
+  );
+  PORT (
+    -- LVDS Interface
+    -- . g_ai.nof_sp = 4, fixed support 4 signal paths A,B,C,D
+    ADC_BI_A             : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');  -- fixed ADC_BI port width port_w = 8
+    ADC_BI_B             : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');  -- each ADC_BI port carries the data from 1 signal path
+    ADC_BI_C             : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');  -- ports A,B connect to one ADU, ports C,D connect to another ADU
+    ADC_BI_D             : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');
+    
+    ADC_BI_A_CLK         : IN  STD_LOGIC := '0';  -- lvds clock from ADU_AB
+    ADC_BI_D_CLK         : IN  STD_LOGIC := '0';  -- lvds clock from ADU_CD
+    
+    ADC_BI_A_CLK_RST     : OUT STD_LOGIC;         -- release synchronises ADU_AB DCLK divider
+    ADC_BI_D_CLK_RST     : OUT STD_LOGIC;         -- release synchronises ADU_CD DCLK divider
+    
+    -- MM Interface
+    ab_status            : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    ab_locked            : OUT STD_LOGIC;
+    ab_stable            : OUT STD_LOGIC;
+    ab_stable_ack        : IN  STD_LOGIC := '0';
+    ab_dp_phs_clk_en_vec : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0) := (OTHERS=>'1');
+  
+    cd_status            : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    cd_locked            : OUT STD_LOGIC;
+    cd_stable            : OUT STD_LOGIC;
+    cd_stable_ack        : IN  STD_LOGIC := '0';
+    cd_dp_phs_clk_en_vec : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0) := (OTHERS=>'1');
+    
+    -- DP Interface
+    dp_rst               : IN  STD_LOGIC;
+    dp_clk               : IN  STD_LOGIC;
+    dp_phs_clk_vec       : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+    
+    -- . Streaming
+    src_out_arr          : OUT t_dp_sosi_arr(0 TO g_ai.nof_sp-1)
+  );
+END aduh_dd;
+
+
+ARCHITECTURE str OF aduh_dd IS
+
+  CONSTANT c_use_lvdsh_dd_phs4   : BOOLEAN := g_nof_dp_phs_clk>1;
+  
+  CONSTANT c_dp_factor           : NATURAL := g_ai.rx_factor * g_ai.dd_factor;
+  
+  CONSTANT c_in_dat_w            : NATURAL :=               g_ai.nof_ports * g_ai.port_w;
+  CONSTANT c_rx_dat_w            : NATURAL := c_dp_factor * g_ai.nof_ports * g_ai.port_w;
+  
+  -- Delay values (range 0..15) for input D1 delay for input clock and data[]
+  CONSTANT c_in_clk_delay_a      : NATURAL := g_ai.deskew.clk_delay_a;
+  CONSTANT c_in_clk_delay_d      : NATURAL := g_ai.deskew.clk_delay_d;
+  CONSTANT c_in_dat_delay_arr_ab : t_natural_arr(g_ai.nof_ports*g_ai.port_w-1 DOWNTO 0) := g_ai.deskew.dat_delay_arr_a & g_ai.deskew.dat_delay_arr_b;
+  CONSTANT c_in_dat_delay_arr_cd : t_natural_arr(g_ai.nof_ports*g_ai.port_w-1 DOWNTO 0) := g_ai.deskew.dat_delay_arr_c & g_ai.deskew.dat_delay_arr_d;
+  
+  -- Use c_rx_fifo_fill sufficiently larger than the moment where *_CLK_RST gets applied
+  CONSTANT c_rx_fifo_size        : NATURAL := 32;  -- see common_fifo_dc_lock_control used in lvds_dd for comment
+  CONSTANT c_rx_fifo_fill        : NATURAL := 17;  -- see common_fifo_dc_lock_control used in lvds_dd for comment
+  CONSTANT c_rx_fifo_margin      : NATURAL := 2;   -- use +-2 because with fill level 10001b = 17 accept +-1 so 10000b = 16 and 10010b = 18,
+                                                   -- but also +2 for misvalue 10011b = 19 in case rd_usedw is not clocked in reliably
+  
+  SIGNAL ADC_BI_A_rewire     : STD_LOGIC_VECTOR(ADC_BI_A'RANGE);
+  SIGNAL ADC_BI_B_rewire     : STD_LOGIC_VECTOR(ADC_BI_B'RANGE);
+  SIGNAL ADC_BI_C_rewire     : STD_LOGIC_VECTOR(ADC_BI_C'RANGE);
+  SIGNAL ADC_BI_D_rewire     : STD_LOGIC_VECTOR(ADC_BI_D'RANGE);
+    
+  SIGNAL in_clk_ab_rst       : STD_LOGIC;
+  SIGNAL in_clk_cd_rst       : STD_LOGIC;
+  
+  SIGNAL in_dat_ab           : STD_LOGIC_VECTOR(c_in_dat_w-1 DOWNTO 0);
+  SIGNAL in_dat_cd           : STD_LOGIC_VECTOR(c_in_dat_w-1 DOWNTO 0);
+  
+  SIGNAL obin_dat_ab         : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL obin_dat_cd         : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL obin_val_ab         : STD_LOGIC;
+  SIGNAL obin_val_cd         : STD_LOGIC;
+  
+  SIGNAL rx_dat_ab           : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL rx_dat_cd           : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL rx_val_ab           : STD_LOGIC;
+  SIGNAL rx_val_cd           : STD_LOGIC;
+  
+BEGIN
+
+  ASSERT g_ai.nof_sp = 4 AND g_ai.nof_adu = 2 AND g_ai.nof_ports = 2
+    REPORT "aduh_dd : expects input 4 signal paths via 2 ports from 2 ADU"
+    SEVERITY FAILURE;
+    
+  -- I port A and C wire default
+  ADC_BI_A_rewire <= ADC_BI_A;
+  ADC_BI_C_rewire <= ADC_BI_C;
+  
+  -- Q port B and D are rewired on ADU:
+  ADC_BI_B_rewire(0) <= ADC_BI_B(6);
+  ADC_BI_B_rewire(1) <= ADC_BI_B(7);
+  ADC_BI_B_rewire(2) <= ADC_BI_B(4);
+  ADC_BI_B_rewire(3) <= ADC_BI_B(5);
+  ADC_BI_B_rewire(4) <= ADC_BI_B(2);
+  ADC_BI_B_rewire(5) <= ADC_BI_B(3);
+  ADC_BI_B_rewire(6) <= ADC_BI_B(0);
+  ADC_BI_B_rewire(7) <= ADC_BI_B(1);
+    
+  ADC_BI_D_rewire(0) <= ADC_BI_D(6);
+  ADC_BI_D_rewire(1) <= ADC_BI_D(7);
+  ADC_BI_D_rewire(2) <= ADC_BI_D(4);
+  ADC_BI_D_rewire(3) <= ADC_BI_D(5);
+  ADC_BI_D_rewire(4) <= ADC_BI_D(2);
+  ADC_BI_D_rewire(5) <= ADC_BI_D(3);
+  ADC_BI_D_rewire(6) <= ADC_BI_D(0);
+  ADC_BI_D_rewire(7) <= ADC_BI_D(1);
+  
+  -- Concatenate per half ADU (i.e. per clock)
+  in_dat_ab <= ADC_BI_A_rewire & ADC_BI_B_rewire;
+  in_dat_cd <= ADC_BI_C_rewire & ADC_BI_D_rewire;
+  
+  -- c_dp_factor = 4 time samples per src_out_arr data word
+  p_src_out_arr : PROCESS(rx_dat_ab, rx_val_ab, rx_dat_cd, rx_val_cd)
+  BEGIN
+    src_out_arr <= (OTHERS=>c_dp_sosi_rst);
+    FOR I IN 0 TO c_dp_factor-1 LOOP
+      src_out_arr(0).data((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= rx_dat_ab((I+1)*c_in_dat_w            -1 DOWNTO I*c_in_dat_w+g_ai.port_w);  -- A at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+      src_out_arr(1).data((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= rx_dat_ab((I+1)*c_in_dat_w-g_ai.port_w-1 DOWNTO I*c_in_dat_w            );  -- B at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+      src_out_arr(2).data((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= rx_dat_cd((I+1)*c_in_dat_w            -1 DOWNTO I*c_in_dat_w+g_ai.port_w);  -- C at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+      src_out_arr(3).data((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= rx_dat_cd((I+1)*c_in_dat_w-g_ai.port_w-1 DOWNTO I*c_in_dat_w            );  -- D at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    END LOOP;
+    src_out_arr(0).valid <= rx_val_ab;
+    src_out_arr(1).valid <= rx_val_ab;
+    src_out_arr(2).valid <= rx_val_cd;
+    src_out_arr(3).valid <= rx_val_cd;
+  END PROCESS;
+  
+  -- Connect ADU 0 via port A and B using only clock from A
+  gen_lvdsh_dd : IF c_use_lvdsh_dd_phs4=FALSE GENERATE
+  ab_status <= (OTHERS=>'0');
+  cd_status <= (OTHERS=>'0');
+  
+  u_ab : ENTITY work.lvdsh_dd
+  GENERIC MAP (
+    g_in_dat_w          => c_in_dat_w,
+    g_in_dat_delay_arr  => c_in_dat_delay_arr_ab,
+    g_in_clk_delay      => c_in_clk_delay_a,
+    g_in_clk_rst_invert => g_ai.clk_rst_invert,
+    g_rx_big_endian     => TRUE,
+    g_rx_factor         => g_ai.rx_factor,
+    g_rx_fifo_size      => c_rx_fifo_size,
+    g_rx_fifo_fill      => c_rx_fifo_fill,
+    g_rx_fifo_margin    => c_rx_fifo_margin
+  )
+  PORT MAP (
+    -- PHY input interface
+    in_clk        => ADC_BI_A_CLK,
+    in_dat        => in_dat_ab,
+    in_clk_rst    => ADC_BI_A_CLK_RST,
+    
+    -- DD --> Rx domain interface at in_clk rate or g_rx_factor lower rate (via FIFO)
+    rx_rst        => dp_rst,
+    rx_clk        => dp_clk,
+    rx_dat        => obin_dat_ab,  -- big endian rx_dat output for rx_factor = 2, samples AB at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    rx_val        => obin_val_ab,
+    
+    rx_locked     => ab_locked,
+    rx_stable     => ab_stable,
+    rx_stable_ack => ab_stable_ack
+  );
+  
+  -- Connect ADU 1 via port C and D using only clock from D
+  u_cd : ENTITY work.lvdsh_dd
+  GENERIC MAP (
+    g_in_dat_w          => c_in_dat_w,
+    g_in_dat_delay_arr  => c_in_dat_delay_arr_cd,
+    g_in_clk_delay      => c_in_clk_delay_d,
+    g_in_clk_rst_invert => g_ai.clk_rst_invert,
+    g_rx_big_endian     => TRUE,
+    g_rx_factor         => g_ai.rx_factor,
+    g_rx_fifo_size      => c_rx_fifo_size,
+    g_rx_fifo_fill      => c_rx_fifo_fill,
+    g_rx_fifo_margin    => c_rx_fifo_margin
+  )
+  PORT MAP (
+    -- PHY input interface
+    in_clk        => ADC_BI_D_CLK,
+    in_dat        => in_dat_cd,
+    in_clk_rst    => ADC_BI_D_CLK_RST,
+    
+    -- DD --> Rx domain interface at in_clk rate or g_rx_factor lower rate (via FIFO)
+    rx_rst        => dp_rst,
+    rx_clk        => dp_clk,
+    rx_dat        => obin_dat_cd,  -- big endian rx_dat output for rx_factor = 2, samples CD at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    rx_val        => obin_val_cd,
+    
+    rx_locked     => cd_locked,
+    rx_stable     => cd_stable,
+    rx_stable_ack => cd_stable_ack
+  );
+  END GENERATE;
+  
+  gen_lvdsh_dd_phs4 : IF c_use_lvdsh_dd_phs4=TRUE GENERATE
+    -- Connect ADU 0 via port A and B using only clock from A
+    ADC_BI_A_CLK_RST <= in_clk_ab_rst WHEN g_ai.clk_rst_invert=FALSE ELSE NOT in_clk_ab_rst;
+    
+    in_clk_ab_rst <= '0';  -- no ADC clk reset
+    
+    u_lvdsh_dd_phs4_ab : ENTITY work.lvdsh_dd_phs4
+    GENERIC MAP (
+      g_wb_factor      => c_dp_factor,       -- fixed wideband factor = 4
+      g_nof_dp_phs_clk => g_nof_dp_phs_clk,  -- nof dp_phs_clk that can be used to detect lock
+      g_in_dat_w       => c_in_dat_w         -- nof PHY data bits
+    )
+    PORT MAP (
+      -- PHY input interface
+      in_clk              => ADC_BI_A_CLK,
+      in_dat              => in_dat_ab,    -- input samples AB [t0], [t1], [t2], [t3], [t4], [t5], [t6], [t7], ... --> time
+      
+      -- DD --> Rx domain interface at in_clk rate or g_wb_factor lower rate (via FIFO)
+      dp_rst              => dp_rst,
+      dp_clk              => dp_clk,
+      dp_phs_clk_vec      => dp_phs_clk_vec,
+      dp_phs_clk_en_vec   => ab_dp_phs_clk_en_vec,
+      dp_dat              => obin_dat_ab,  -- big endian output samples AB at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+      dp_val              => obin_val_ab,
+      
+      -- Rx status monitor
+      out_status          => ab_status,
+      out_word_locked     => ab_locked,
+      out_word_stable     => ab_stable,
+      out_word_stable_ack => ab_stable_ack
+    );
+    
+    -- Connect ADU 1 via port C and D using only clock from D
+    ADC_BI_D_CLK_RST <= in_clk_cd_rst WHEN g_ai.clk_rst_invert=FALSE ELSE NOT in_clk_cd_rst;
+    
+    in_clk_cd_rst <= '0';  -- no ADC clk reset
+    
+    u_lvdsh_dd_phs4_cd : ENTITY work.lvdsh_dd_phs4
+    GENERIC MAP (
+      g_wb_factor      => c_dp_factor,       -- fixed wideband factor = 4
+      g_nof_dp_phs_clk => g_nof_dp_phs_clk,  -- nof dp_phs_clk that can be used to detect lock
+      g_in_dat_w       => c_in_dat_w         -- nof PHY data bits
+    )
+    PORT MAP (
+      -- PHY input interface
+      in_clk              => ADC_BI_D_CLK,
+      in_dat              => in_dat_cd,    -- input samples CD [t0], [t1], [t2], [t3], [t4], [t5], [t6], [t7], ... --> time
+      
+      -- DD --> Rx domain interface at in_clk rate or g_wb_factor=4 lower rate (via FIFO)
+      dp_rst              => dp_rst,
+      dp_clk              => dp_clk,
+      dp_phs_clk_vec      => dp_phs_clk_vec,
+      dp_phs_clk_en_vec   => cd_dp_phs_clk_en_vec,
+      dp_dat              => obin_dat_cd,  -- big endian output samples CD at [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+      dp_val              => obin_val_cd,
+      
+      -- Rx status monitor
+      out_status          => cd_status,
+      out_word_locked     => cd_locked,
+      out_word_stable     => cd_stable,
+      out_word_stable_ack => cd_stable_ack
+    );  
+  END GENERATE;
+  
+  
+  -- Use register stage to map offset binary to two's complement, this will allow synthesis to use the FF q_not output for the high bit and the FF q output for the other bits
+  p_dp_clk : PROCESS(dp_clk)
+  BEGIN
+    IF rising_edge(dp_clk) THEN
+      FOR I IN 0 TO c_dp_factor*g_ai.nof_ports-1 LOOP
+        rx_dat_ab((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= offset_binary(obin_dat_ab((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w));
+        rx_dat_cd((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w) <= offset_binary(obin_dat_cd((I+1)*g_ai.port_w-1 DOWNTO I*g_ai.port_w));
+      END LOOP;
+      rx_val_ab <= obin_val_ab;
+      rx_val_cd <= obin_val_cd;
+    END IF;
+  END PROCESS;
+
+END str;
diff --git a/libraries/io/aduh/src/vhdl/aduh_dd_pkg.vhd b/libraries/io/aduh/src/vhdl/aduh_dd_pkg.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..65bc30a807528c1dd6d2de3c501195780352d34b
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_dd_pkg.vhd
@@ -0,0 +1,61 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+
+PACKAGE aduh_dd_pkg IS
+
+  -- ADU Interface
+  TYPE t_c_aduh_delays IS RECORD  -- Input de-skew buffer delays: unit 50 ps, range 0..15
+    clk_delay_a       : NATURAL;
+    clk_delay_d       : NATURAL;
+    dat_delay_arr_a   : t_natural_arr(7 DOWNTO 0);  -- width is c_aduh_dd_ai.port_w = 8
+    dat_delay_arr_b   : t_natural_arr(7 DOWNTO 0);
+    dat_delay_arr_c   : t_natural_arr(7 DOWNTO 0);
+    dat_delay_arr_d   : t_natural_arr(7 DOWNTO 0);
+  END RECORD;
+  
+  CONSTANT c_aduh_delays : t_c_aduh_delays := (0, 0, (OTHERS=>0), (OTHERS=>0), (OTHERS=>0), (OTHERS=>0));
+  
+  TYPE t_c_aduh_dd_ai IS RECORD
+    nof_sp         : NATURAL;  -- = 4;     -- Fixed support 4 signal paths A,B,C,D, whether they contain active data depends on nof_adu
+    nof_adu        : NATURAL;  -- = 2;     -- When 2 ADUs then use all 4 ports A,B,C,D, one ADU on ports A,B and one ADU on ports C,D,
+                                           -- when 1 ADU then only use ports C,D
+    nof_ports      : NATURAL;  -- = 2;     -- Fixed 2 ADC BI ports per ADU
+    port_w         : NATURAL;  -- = 8;     -- Fixed 8 bit ADC BI port width, the ADC sample width is also 8 bit
+    dd_factor      : NATURAL;  -- = 2;     -- Fixed double data rate factor for lvds data (800 MSps) and lvds clock (400 MHz)
+    rx_factor      : NATURAL;  -- = 2;     -- when 1 then the data path processing clock frequency is 400 MHz (= lvds clock / 1)
+                                           -- when 2 then the data path processing clock frequency is 200 MHz (= lvds clock / 2)
+    clk_rst_enable : BOOLEAN;  -- = TRUE;  -- default TRUE for initial DCLK_RST pulse to control the ADC DCLK phase, else FALSE for no DCLK_RST pulse
+    clk_rst_invert : BOOLEAN;  -- = FALSE; -- default FALSE because DCLK_RST pulse on ADC is active high, use TRUE for active low pulse to compensate for P/N cross
+    deskew         : t_c_aduh_delays;      -- Input de-skew buffer delays
+  END RECORD;
+  
+  CONSTANT c_aduh_dd_ai  : t_c_aduh_dd_ai := (4, 2, 2, 8, 2, 2, TRUE, FALSE, c_aduh_delays);
+  
+  
+END aduh_dd_pkg;
+
+PACKAGE BODY aduh_dd_pkg IS
+END aduh_dd_pkg;
diff --git a/libraries/io/aduh/src/vhdl/aduh_mean_sum.vhd b/libraries/io/aduh/src/vhdl/aduh_mean_sum.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..c25a6d3e1d685bf27d253e5b460bc62dcfafe2ad
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_mean_sum.vhd
@@ -0,0 +1,160 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+
+
+ENTITY aduh_mean_sum IS
+  GENERIC (
+    g_symbol_w             : NATURAL := 12;
+    g_nof_symbols_per_data : NATURAL := 4;          -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    : NATURAL := 800*10**6;  -- integration time in symbols
+    g_sum_truncate         : BOOLEAN := TRUE;       -- when TRUE truncate (keep MS part) else resize (keep sign and LS part)
+    g_sum_w                : NATURAL := 32          -- typcially MM word width
+  );
+  PORT (
+    clk         : IN  STD_LOGIC;
+    rst         : IN  STD_LOGIC;
+    
+    -- Streaming inputs
+    in_data     : IN  STD_LOGIC_VECTOR(g_nof_symbols_per_data*g_symbol_w-1 DOWNTO 0);
+    in_val      : IN  STD_LOGIC;
+    in_sync     : IN  STD_LOGIC;
+    
+    -- Accumulation outputs
+    sum         : OUT STD_LOGIC_VECTOR(g_sum_w-1 DOWNTO 0);
+    sum_sync    : OUT STD_LOGIC;                    -- after sync there is a new sum
+    sum_sop     : OUT STD_LOGIC                     -- at    sop  there is a new sum
+  );
+END aduh_mean_sum;
+
+
+ARCHITECTURE rtl OF aduh_mean_sum IS
+
+  CONSTANT c_acc_w              : NATURAL := g_symbol_w + ceil_log2(g_nof_accumulations/g_nof_symbols_per_data);
+  CONSTANT c_acc_sum_nof_stages : NATURAL := ceil_log2(g_nof_symbols_per_data);
+  CONSTANT c_acc_sum_pipeline   : NATURAL := 1;
+  CONSTANT c_acc_sum_w          : NATURAL := c_acc_w + c_acc_sum_nof_stages;
+  
+  TYPE t_symbol_arr IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(g_symbol_w-1 DOWNTO 0);
+  TYPE t_acc_arr    IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(   c_acc_w-1 DOWNTO 0);
+  
+  SIGNAL acc_load     : STD_LOGIC;
+  SIGNAL nxt_acc_load : STD_LOGIC;
+  SIGNAL acc_load_p   : STD_LOGIC;
+
+  SIGNAL symbol_arr   : t_symbol_arr(0 TO g_nof_symbols_per_data-1);
+  SIGNAL acc_arr      : t_acc_arr(   0 TO g_nof_symbols_per_data-1);
+  SIGNAL acc_vec      : STD_LOGIC_VECTOR(g_nof_symbols_per_data*c_acc_w-1 DOWNTO 0);
+  
+  SIGNAL acc_sum      : STD_LOGIC_VECTOR(c_acc_sum_w-1 DOWNTO 0);
+
+  SIGNAL i_sum        : STD_LOGIC_VECTOR(g_sum_w-1 DOWNTO 0);
+  SIGNAL nxt_sum      : STD_LOGIC_VECTOR(g_sum_w-1 DOWNTO 0);
+
+  SIGNAL i_sum_sync   : STD_LOGIC;
+  
+BEGIN
+
+  sum      <= i_sum;
+  sum_sync <= i_sum_sync;
+  
+  regs : PROCESS(rst,clk)
+  BEGIN
+    IF rst='1' THEN
+      acc_load <= '0';
+      i_sum    <= (OTHERS => '0');
+      sum_sop  <= '0';
+    ELSIF rising_edge(clk) THEN
+      acc_load <= nxt_acc_load;
+      i_sum    <= nxt_sum;
+      sum_sop  <= i_sum_sync;
+    END IF;
+  END PROCESS;
+  
+  -- Reload the accumlators with 0 or with the valid sample after the sync
+  nxt_acc_load <= in_sync;
+
+  -- Accumulate per symbol stream in the in_data 
+  gen_acc : FOR I IN 0 TO g_nof_symbols_per_data-1 GENERATE
+    symbol_arr(I) <= in_data((g_nof_symbols_per_data-I)*g_symbol_w-1 DOWNTO (g_nof_symbols_per_data-I-1)*g_symbol_w);  -- put big endian MS part t0 at array index 0
+    
+    u_acc : ENTITY common_lib.common_accumulate
+    GENERIC MAP (
+      g_representation => "SIGNED"
+    )
+    PORT MAP(
+      rst     => rst,
+      clk     => clk,
+      sload   => acc_load,
+      in_val  => in_val,
+      in_dat  => symbol_arr(I),
+      out_dat => acc_arr(I)
+    );
+    
+    acc_vec((g_nof_symbols_per_data-I)*c_acc_w-1 DOWNTO (g_nof_symbols_per_data-I-1)*c_acc_w) <= acc_arr(I);  -- put array index 0 at big endian MS part t0
+  END GENERATE;
+  
+  no_tree : IF g_nof_symbols_per_data = 1 GENERATE
+    -- Capture the current accumulator values at the reload
+    nxt_sum <= truncate_or_resize_svec(acc_vec, g_sum_truncate, g_sum_w) WHEN acc_load_p = '1' ELSE i_sum;
+    
+    -- The accumulator has a latency of 1 clk cycle
+    i_sum_sync <= acc_load;
+  END GENERATE;
+  
+  gen_tree : IF g_nof_symbols_per_data > 1 GENERATE
+    u_sum : ENTITY common_lib.common_adder_tree
+    GENERIC MAP (
+      g_representation => "SIGNED",
+      g_pipeline       => c_acc_sum_pipeline,      -- amount of pipelining per stage
+      g_nof_inputs     => g_nof_symbols_per_data,  -- >= 1, nof stages = ceil_log2(g_nof_inputs)
+      g_dat_w          => c_acc_w,
+      g_sum_w          => c_acc_sum_w
+    )
+    PORT MAP (
+      clk    => clk,
+      in_dat => acc_vec,
+      sum    => acc_sum
+    );
+    
+    u_load_p : ENTITY common_lib.common_pipeline_sl
+    GENERIC MAP (
+      g_pipeline    => c_acc_sum_nof_stages*c_acc_sum_pipeline,
+      g_reset_value => 0
+    )
+    PORT MAP (
+      rst     => rst,
+      clk     => clk,
+      in_dat  => acc_load,
+      out_dat => acc_load_p
+    );
+    
+    -- Capture the current accumulator values at the reload
+    nxt_sum <= truncate_or_resize_svec(acc_sum, g_sum_truncate, g_sum_w) WHEN acc_load_p = '1' ELSE i_sum;
+    
+    -- The accumulators have a latency of 1 clk cycle 
+    i_sum_sync <= acc_load_p;
+  END GENERATE;
+ 
+END rtl;
diff --git a/libraries/io/aduh/src/vhdl/aduh_monitor.vhd b/libraries/io/aduh/src/vhdl/aduh_monitor.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..db94568b40d069a716f9dbd488548e6d8157bfa4
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_monitor.vhd
@@ -0,0 +1,154 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib, dp_lib, diag_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE common_lib.common_mem_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+
+-- Purpose : Monitor ADC statistics for the 4 ADCs on ADU
+-- Description :
+--   For one input signal path provide MM access to:
+--   . ADC mean
+--   . ADC power
+--   . ADC data buffer time samples stored in big endian order:
+--
+--   31             24 23             16 15              8 7               0  wi
+--  |-----------------|-----------------|-----------------|-----------------|
+--  |          t0[7:0]           t1[7:0]           t2[7:0]           t3[7:0]|  0
+--  |-----------------------------------------------------------------------|
+--  |          t4[7:0]           t5[7:0]           t6[7:0]           t7[7:0]|  1
+--  |-----------------------------------------------------------------------|
+--  |                                 ...                                   | ..
+--  |-----------------------------------------------------------------------|
+--  |       t1020[7:0]        t1021[7:0]        t1022[7:0]        t1023[7:0]|255
+--  |-----------------------------------------------------------------------|
+--
+-- Remarks:
+
+ENTITY aduh_monitor IS
+  GENERIC (
+    g_symbol_w             : NATURAL := 8;
+    g_nof_symbols_per_data : NATURAL := 4;          -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    : NATURAL := 800*10**6;  -- integration time in symbols, defines internal accumulator widths
+    g_buffer_nof_symbols   : NATURAL := 1024;
+    g_buffer_use_sync      : BOOLEAN := FALSE       -- when TRUE start filling the buffer after the in_sync, else after the last word was read
+  );
+  PORT (
+    mm_rst         : IN  STD_LOGIC;
+    mm_clk         : IN  STD_LOGIC;
+    
+    buf_mosi       : IN  t_mem_mosi;  -- read and overwrite access to the data buffer
+    buf_miso       : OUT t_mem_miso;
+    
+    -- Streaming inputs
+    st_rst         : IN  STD_LOGIC;
+    st_clk         : IN  STD_LOGIC;
+    
+    in_sosi        : IN t_dp_sosi;  -- Signal path with data 4 800MHz 8b samples in time per one 32b word @ 200MHz
+    
+    -- Monitor outputs
+    stat_mean_sum  : OUT STD_LOGIC_VECTOR(63 DOWNTO 0);  -- use fixed 64 bit sum width
+    stat_pwr_sum   : OUT STD_LOGIC_VECTOR(63 DOWNTO 0);  -- use fixed 64 bit sum width
+    stat_sop       : OUT STD_LOGIC                       -- at the sop there are new mean_sum and pwr_sum statistics available
+  );
+END aduh_monitor;
+
+
+ARCHITECTURE str OF aduh_monitor IS
+
+  CONSTANT c_data_w          : NATURAL := g_nof_symbols_per_data*g_symbol_w;  -- = 32, must be <= 32 to fit the u_data_buffer
+  CONSTANT c_stat_w          : NATURAL := 2*c_word_w;                         -- support upto 64 bit sum width, this is more than enough without truncation and no accumulator overflow  
+  CONSTANT c_buffer_nof_data : NATURAL := g_buffer_nof_symbols/g_nof_symbols_per_data;
+  
+BEGIN
+
+  u_mean : ENTITY work.aduh_mean_sum
+  GENERIC MAP (
+    g_symbol_w             => g_symbol_w,
+    g_nof_symbols_per_data => g_nof_symbols_per_data,  -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    => g_nof_accumulations,     -- integration time in symbols
+    g_sum_truncate         => FALSE,                   -- when TRUE truncate (keep MS part) else resize (keep sign and LS part)
+    g_sum_w                => c_stat_w                 -- typcially MM word width = 32
+  )
+  PORT MAP (
+    clk         => st_clk,
+    rst         => st_rst,
+    
+    -- Streaming inputs
+    in_data     => in_sosi.data(c_data_w-1 DOWNTO 0),
+    in_val      => in_sosi.valid,
+    in_sync     => in_sosi.sync,
+    
+    -- Accumulation outputs
+    sum         => stat_mean_sum,
+    sum_sync    => OPEN,
+    sum_sop     => OPEN
+  );
+
+  u_power : ENTITY work.aduh_power_sum
+  GENERIC MAP (
+    g_symbol_w             => g_symbol_w,
+    g_nof_symbols_per_data => g_nof_symbols_per_data,  -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    => g_nof_accumulations,     -- integration time in symbols
+    g_pwr_sum_truncate     => FALSE,                   -- when TRUE truncate (keep MS part) else resize (keep sign and LS part)
+    g_pwr_sum_w            => c_stat_w                 -- typcially MM word width = 32
+  )
+  PORT MAP (
+    clk          => st_clk,
+    rst          => st_rst,
+    
+    -- Streaming inputs
+    in_data      => in_sosi.data(c_data_w-1 DOWNTO 0),
+    in_val       => in_sosi.valid,
+    in_sync      => in_sosi.sync,
+    
+    -- Accumulation outputs
+    pwr_sum      => stat_pwr_sum,
+    pwr_sum_sync => OPEN,
+    pwr_sum_sop  => stat_sop
+  );
+
+  u_data_mon: ENTITY diag_lib.diag_data_buffer
+  GENERIC MAP (
+    g_data_w      => c_data_w,           -- <= c_word_w = 32b, the MM word width
+    g_nof_data    => c_buffer_nof_data,
+    g_use_in_sync => g_buffer_use_sync   -- when TRUE start filling the buffer after the in_sync, else after the last word was read
+  )
+  PORT MAP (
+    -- Memory-mapped clock domain
+    mm_rst      => mm_rst,
+    mm_clk      => mm_clk,
+
+    ram_mm_mosi => buf_mosi,  -- read and overwrite access to the data buffer
+    ram_mm_miso => buf_miso,
+    
+    -- Streaming clock domain
+    st_rst      => st_rst,
+    st_clk      => st_clk,
+
+    in_data     => in_sosi.data(c_data_w-1 DOWNTO 0),
+    in_sync     => in_sosi.sync,
+    in_val      => in_sosi.valid
+  );  
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/aduh_monitor_reg.vhd b/libraries/io/aduh/src/vhdl/aduh_monitor_reg.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..86ee0b0f4f16e8ae49821fbf5d0ff1e5331bd6bf
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_monitor_reg.vhd
@@ -0,0 +1,196 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+-- Purpose: Provide MM slave register for the mean_sum and the power_sum
+-- Description:
+--
+--   31             24 23             16 15              8 7               0  wi
+--  |-----------------|-----------------|-----------------|-----------------|
+--  |                             mean_sum[31:0]                            |  0
+--  |-----------------------------------------------------------------------|
+--  |                             mean_sum[63:32]                           |  1
+--  |-----------------------------------------------------------------------|
+--  |                            power_sum[31:0]                            |  2
+--  |-----------------------------------------------------------------------|
+--  |                            power_sum[63:32]                           |  3
+--  |-----------------------------------------------------------------------|
+--
+-- . The new mean_sum and the power_sum are passed on the MM side when
+--   st_mon_sop pulses.
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE common_lib.common_mem_pkg.ALL;
+
+ENTITY aduh_monitor_reg IS
+  GENERIC (
+    g_cross_clock_domain : BOOLEAN := TRUE  -- use FALSE when mm_clk and st_clk are the same, else use TRUE to cross the clock domain
+  );
+  PORT (
+    -- Clocks and reset
+    mm_rst            : IN  STD_LOGIC;   -- reset synchronous with mm_clk
+    mm_clk            : IN  STD_LOGIC;   -- memory-mapped bus clock
+    st_rst            : IN  STD_LOGIC;   -- reset synchronous with st_clk
+    st_clk            : IN  STD_LOGIC;   -- other clock domain clock
+    
+    -- Memory Mapped Slave in mm_clk domain
+    sla_in            : IN  t_mem_mosi;  -- actual ranges defined by c_mm_reg
+    sla_out           : OUT t_mem_miso;  -- actual ranges defined by c_mm_reg
+    
+    -- MM registers in st_clk domain
+    st_mon_mean_sum   : IN  STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);  -- use fixed 64 bit sum width
+    st_mon_power_sum  : IN  STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);  -- use fixed 64 bit sum width
+    st_mon_sop        : IN  STD_LOGIC    -- at the mon_sop there are new mean_sum and pwr_sum statistics available
+  );
+END aduh_monitor_reg;
+
+
+ARCHITECTURE rtl OF aduh_monitor_reg IS
+
+  -- Define the actual size of the MM slave register
+  CONSTANT c_mm_reg : t_c_mem := (latency  => 1,
+                                  adr_w    => 2,
+                                  dat_w    => c_word_w,       -- Use MM bus data width = c_word_w = 32 for all MM registers
+                                  nof_dat  => 2**2,
+                                  init_sl  => '0');
+                                               
+  -- Registers in mm_clk domain
+  SIGNAL mm_mon_mean_sum          : STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);
+  SIGNAL mm_mon_mean_sum_hi       : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_mon_power_sum         : STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);
+  SIGNAL mm_mon_power_sum_hi      : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  
+  -- Registers in st_clk domain
+    
+BEGIN
+
+  ------------------------------------------------------------------------------
+  -- MM register access in the mm_clk domain
+  -- . Hardcode the shared MM slave register directly in RTL instead of using
+  --   the common_reg_r_w instance. Directly using RTL is easier when the large
+  --   MM register has multiple different fields and with different read and
+  --   write options per field in one MM register.
+  ------------------------------------------------------------------------------
+  
+  p_mm_reg : PROCESS (mm_rst, mm_clk)
+  BEGIN
+    IF mm_rst = '1' THEN
+      -- Read access
+      sla_out              <= c_mem_miso_rst;
+      mm_mon_mean_sum_hi   <= (OTHERS=>'0');
+      mm_mon_power_sum_hi  <= (OTHERS=>'0');
+    ELSIF rising_edge(mm_clk) THEN
+      -- Read access defaults
+      sla_out.rdval <= '0';
+      
+      -- Write access: set register value
+      IF sla_in.wr = '1' THEN
+        -- no write registers
+        
+      -- Read access: get register value
+      ELSIF sla_in.rd = '1' THEN
+        sla_out       <= c_mem_miso_rst;    -- set unused rddata bits to '0' when read
+        sla_out.rdval <= '1';               -- c_mm_reg.latency = 1
+        CASE TO_UINT(sla_in.address(c_mm_reg.adr_w-1 DOWNTO 0)) IS
+          WHEN 0 =>
+            sla_out.rddata(31 DOWNTO 0) <= mm_mon_mean_sum(31 DOWNTO 0);
+            mm_mon_mean_sum_hi          <= mm_mon_mean_sum(63 DOWNTO 32);  -- first read low part and preserve high part
+          WHEN 1 =>
+            sla_out.rddata(31 DOWNTO 0) <= mm_mon_mean_sum_hi;
+          WHEN 2 =>
+            sla_out.rddata(31 DOWNTO 0) <= mm_mon_power_sum(31 DOWNTO 0);
+            mm_mon_power_sum_hi         <= mm_mon_power_sum(63 DOWNTO 32);  -- first read low part and preserve high part
+          WHEN 3 =>
+            sla_out.rddata(31 DOWNTO 0) <= mm_mon_power_sum_hi;
+          WHEN OTHERS => NULL;  -- not used MM addresses
+        END CASE;
+      END IF;
+    END IF;
+  END PROCESS;
+
+  ------------------------------------------------------------------------------
+  -- Transfer register value between mm_clk and st_clk domain.
+  -- If the function of the register ensures that the value will not be used
+  -- immediately when it was set, then the transfer between the clock domains
+  -- can be done by wires only. Otherwise if the change in register value can
+  -- have an immediate effect then the bit or word value needs to be transfered
+  -- using:
+  --
+  -- . common_async            --> for single-bit level signal
+  -- . common_spulse           --> for single-bit pulse signal
+  -- . common_reg_cross_domain --> for a multi-bit (a word) signal
+  --
+  -- Typically always use a crossing component for the single bit signals (to
+  -- be on the save side) and only use a crossing component for the word
+  -- signals if it is necessary (to avoid using more logic than necessary).
+  ------------------------------------------------------------------------------
+  
+  no_cross : IF g_cross_clock_domain = FALSE GENERATE  -- so mm_clk = st_clk
+    p_mm_clk : PROCESS(mm_rst, mm_clk)
+    BEGIN
+      IF mm_rst='1' THEN
+        mm_mon_mean_sum  <= (OTHERS=>'0');
+        mm_mon_power_sum <= (OTHERS=>'0');
+      ELSIF rising_edge(mm_clk) THEN
+        IF st_mon_sop='1' THEN
+          mm_mon_mean_sum  <= st_mon_mean_sum;
+          mm_mon_power_sum <= st_mon_power_sum;
+        END IF;
+      END IF;
+    END PROCESS;
+  END GENERATE;  -- no_cross
+
+  gen_cross : IF g_cross_clock_domain = TRUE GENERATE
+    u_mean_sum : ENTITY common_lib.common_reg_cross_domain
+    GENERIC MAP (
+      g_in_new_latency => 0
+    )
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_new      => st_mon_sop,       -- when '1' then new in_dat is available after g_in_new_latency
+      in_dat      => st_mon_mean_sum,
+      in_done     => OPEN,             -- pulses when no more pending in_new
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_mon_mean_sum,
+      out_new     => OPEN              -- when '1' then the out_dat was updated with in_dat due to in_new
+    );
+    
+    u_pwr_sum : ENTITY common_lib.common_reg_cross_domain
+    GENERIC MAP (
+      g_in_new_latency => 0
+    )
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_new      => st_mon_sop,       -- when '1' then new in_dat is available after g_in_new_latency
+      in_dat      => st_mon_power_sum,
+      in_done     => OPEN,             -- pulses when no more pending in_new
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_mon_power_sum,
+      out_new     => OPEN              -- when '1' then the out_dat was updated with in_dat due to in_new
+    );
+  END GENERATE;  -- gen_cross
+
+END rtl;
diff --git a/libraries/io/aduh/src/vhdl/aduh_pll.vhd b/libraries/io/aduh/src/vhdl/aduh_pll.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..d9c38e67740fa7b721eee2e68eedc8ba3eefa850
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_pll.vhd
@@ -0,0 +1,455 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+USE work.aduh_pll_pkg.ALL;
+
+-- Purpose: ADUH = ADU Handler using a PLL. Handles the LVDS Rx interface
+--          between a BN and the corresponding ADCs on one or two ADUs
+-- Description:
+--   The aduh_pll merely wires up one or two lvdsh_pll dependent on
+--   g_ai.nof_clocks = 1 or 2 to receive the ADU samples.
+--
+--   Each UniBoard connects to 2 ADU. Ports A and B carry the data from ADU1
+--   and ports C and D carry the data from ADU0. The aduh_pll can take the data
+--   input from nof_adu = 1 or 2 ADUs. Each ADU has fixed nof_ports = 2 signal
+--   paths. The aduh_pll outputs 4 signal path data streams A, B, C, D in the
+--   dp_clk domain. If nof_adu=2 then all 4 signal paths are active. If nof_adu
+--   = 1 then only the input from ADU0 so ports C and D is used.
+--
+--   The aduh_pll can use one or two LVDS data reference clocks, ADC_BI_A_CLK
+--   and ADC_BI_D_CLK. Use g_ai.nof_clocks = 2 if it should be possible to use
+--   the data from ADU1 when ADU0 is not present, or vice versa. The
+--   ADC_BI_B_CLK and ADC_BI_C_CLK are not used. If g_ai.nof_clocks = 1 and
+--   use_lvds_clk = TRUE then only ADC_BI_D_CLK is used. If g_ai.nof_clocks = 1
+--   and use_lvds_clk = FALSE then the dp_clk is used as LVDS data reference
+--   clock.
+--
+--   The port data needs to be deserialized by a dp_deser_factor = 4, because
+--   the ADC sample clock frequency is lvds_data_rate = 800 Mbps and the data
+--   path processing clock frequency is 200 MHz (= 800 Mbps / dp_deser_factor).
+--   The ADC_BI_A_CLK and ADC_BI_D_CLK that come with the ADU data run at
+--   400 MHz (= 800 MHz / lvds_deser_factor). Hence the lvdsh_pll supports
+--   using a LVDS reference clock that has a different rate than the
+--   de-serialized clock.
+--
+--   The restart input is a level signal that resets the aduh_pll input when
+--   active.
+--
+-- Remarks:
+-- . The unused BN_BI IO may be used for other signalling if necessary:
+--   - Input ADC overflow indication ADC_BI_*_OVR per ADU (so one bit per two
+--     ADCs)
+--   - Output ADC 400 MHz DDR clock phase reset ADC_BI_*_CLK_RST per ADU
+-- . The ADU control via the ADC_SCL[3:0], ADC_SDA[3:0] I2C can be handled at
+--   SOPC system level, by means of the avs_i2c_master MM peripheral. Each pair
+--   of signal paths on ADU has an I2C control interface, therefor only 2 of
+--   the 4 ADC_SCL and ADC_SDA lines will need to be used per BN.
+-- . The serial control of the adc08d1020 ADC needs to be done by means of bit
+--   banging via the I2C IO-expander on ADU.
+-- . If use_lvds_clk=TRUE and nof_clocks=1 then ADC_BI_D_CLK is used, because:
+--   - ADC_BI_A_CLK pairs with PLL_R3, but PLL_R3 is also used by the TSE clock
+--   - ADC_BI_D_CLK pairs with PLL_R2
+    
+ENTITY aduh_pll IS
+  GENERIC (
+    g_ai  : t_c_aduh_pll_ai := c_aduh_pll_ai
+  );
+  PORT (
+    -- LVDS Interface
+    
+    -- . ADU_AB
+    ADC_BI_AB_OVR    : IN    STD_LOGIC := '0';                          -- the ADU outputs one overflow bit, shared per 2 signal paths A,B
+    ADC_BI_A         : IN    STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);  -- fixed ADC_BI port width port_w = 8
+    ADC_BI_B         : IN    STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);  -- each ADC_BI port carries the data from 1 signal path
+    ADC_BI_A_CLK     : IN    STD_LOGIC;                                 -- lvdsh_clk(1)
+    ADC_BI_A_CLK_RST : OUT   STD_LOGIC;                                 -- release synchronises port A DCLK divider
+    
+    -- . ADU_CD
+    ADC_BI_CD_OVR    : IN    STD_LOGIC := '0';
+    ADC_BI_C         : IN    STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);
+    ADC_BI_D         : IN    STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);  -- ports A,B connect to one ADU, ports C,D connect to another ADU
+    ADC_BI_D_CLK     : IN    STD_LOGIC;                                 -- lvdsh_clk(0)
+    ADC_BI_D_CLK_RST : OUT   STD_LOGIC;                                 -- release synchronises port D DCLK divider
+     
+    -- DP Interface
+    dp_clk           : IN    STD_LOGIC;
+    
+    -- . Control
+    restart          : IN    STD_LOGIC_VECTOR(g_ai.nof_clocks-1 DOWNTO 0);  -- [  0] = [       ADU_CD] Shared   restart control for ADU-CD (nof_adu=1) or both ADU-AB and ADU-CD (nof_adu=2)
+                                                                            -- [1:0] = [ADU_AB ADU_CD] Seperate restart control for per ADU (nof_adu=2)
+    delay_settings   : IN    t_natural_arr(func_aduh_pll_lvds_dat_w(g_ai)-1 DOWNTO 0) := (OTHERS=>0);  -- [ovrAB, portA, portB, ovrCD, portC, portD] or [ovrCD, portC, portD] : IOE data delay settings when g_use_dpa = FALSE
+    cda_settings     : IN    t_natural_arr(func_aduh_pll_lvds_dat_w(g_ai)-1 DOWNTO 0) := (OTHERS=>0);  -- [ovrAB, portA, portB, ovrCD, portC, portD] or [ovrCD, portC, portD] : channel data alignment settings
+    
+    -- . Streaming
+    src_out          : OUT   t_dp_sosi_arr(0 TO g_ai.nof_sp-1)  -- = [0:3] = ADC_BI ports [A,B,C,D] when nof_adu=2,
+                                                                -- = [0:3] = ADC_BI ports [0,0,C,D] when nof_adu=1
+  );
+END aduh_pll;
+
+
+ARCHITECTURE str OF aduh_pll IS
+
+  -----------------------------------------------------------------------------
+  -- LVDS domain
+  -----------------------------------------------------------------------------
+  
+  CONSTANT c_lvds_clk_freq       : NATURAL := g_ai.lvds_data_rate/g_ai.lvds_deser_factor;   -- 400 MHz, when lvds_clk from the adc08d1020 ADC on ADU provides the DDR of the sample clock
+                                                                                            -- 200 MHz, when lvdsh_clk is connected to the dp_clk
+  -- Treat the LVDS input interface per reference clock, so use 1 or 2 lvdsh_pll
+  CONSTANT c_lvdsh_dat_w         : NATURAL := func_aduh_pll_lvdsh_dat_w(g_ai);              -- lvdsh_dat_w = lvds_dat_w / g_ai.nof_clocks
+  CONSTANT c_rcvdh_dat_w         : NATURAL := c_lvdsh_dat_w * g_ai.dp_deser_factor;
+  
+  TYPE t_lvdsh_dat_arr IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(c_lvdsh_dat_w-1 DOWNTO 0);
+  TYPE t_rcvdh_dat_arr IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(c_rcvdh_dat_w-1 DOWNTO 0);
+  
+  -- The dp_dat carries dp_deser_factor=4 samples for t0,t1,t2,t3 at 31:0, the optional overflow bit is carried via dp_ovr
+  CONSTANT c_dp_dat_w            : NATURAL := g_ai.port_w * g_ai.dp_deser_factor;  -- [31:0] = [t0,t1,t2,t3]
+  
+  TYPE t_dp_dat_arr   IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(c_dp_dat_w-1 DOWNTO 0);
+  
+  -----------------------------------------------------------------------------
+  -- LVDS clock domain
+  -----------------------------------------------------------------------------
+  
+  -- LVDS output
+  SIGNAL lvdsh_clk_rst           : t_sl_arr(       g_ai.nof_clocks-1 DOWNTO 0);
+  
+  -- LVDS input
+  SIGNAL lvdsh_clk               : t_sl_arr(       g_ai.nof_clocks-1 DOWNTO 0);
+  SIGNAL lvdsh_dat               : t_lvdsh_dat_arr(g_ai.nof_clocks-1 DOWNTO 0);  -- serialized LVDS Rx input data
+  
+  -----------------------------------------------------------------------------
+  -- Data Path clock domain, after clock domain crossing FIFO in LVDSH
+  -----------------------------------------------------------------------------
+  
+  -- Index related to g_ai.nof_clocks, similar as for lvdsh_dat
+  SIGNAL rcvdh_dat               : t_rcvdh_dat_arr(g_ai.nof_clocks-1 DOWNTO 0);  -- received de-serialized data
+  SIGNAL rcvdh_val               : t_sl_arr(       g_ai.nof_clocks-1 DOWNTO 0);
+  SIGNAL porth_dat               : t_rcvdh_dat_arr(g_ai.nof_clocks-1 DOWNTO 0);  -- received transpose rewired data
+  SIGNAL porth_val               : t_sl_arr(       g_ai.nof_clocks-1 DOWNTO 0);
+  
+  -- Index related to g_ai.nof_adu, similar as for src_out
+  SIGNAL dp_ovr                  : t_sl_arr(    0 TO g_ai.nof_sp-1);  -- [0:3]=[AB,AB,CD,CD] or [0:3]=[ 0, 0, CD,CD], vector OR of porth_dat overflow bits at t0,t1,t2,t3
+  SIGNAL dp_dat                  : t_dp_dat_arr(0 TO g_ai.nof_sp-1);  -- [0:3]=[ A, B, C, D] or [0:3]=[ 0, 0,  C, D]
+  SIGNAL dp_val                  : t_sl_arr(    0 TO g_ai.nof_sp-1);  -- [0:3]=[ A, B, C, D] or [0:3]=[ 0, 0,  C, D]
+  
+BEGIN
+
+  -- nof_clocks  use_lvds_clk  supported
+  --   1           TRUE          YES
+  --   1           FALSE         YES       , use dp_clk
+  --   2           TRUE          YES
+  --   2           FALSE         NO
+  ASSERT NOT(g_ai.use_lvds_clk=FALSE AND g_ai.nof_clocks>1)
+    REPORT "aduh_pll.vhd: When the dp_clk is used to capture the LVDS data, then nof_clocks must be 1" SEVERITY FAILURE;
+
+  -- nof_clocks  nof_adu  Supported
+  --   1           1        YES         
+  --   1           2        YES
+  --   2           1        NO
+  --   2           2        YES
+  ASSERT NOT(g_ai.nof_clocks > g_ai.nof_adu)
+    REPORT "aduh_pll.vhd: When only one ADU is used then the nof clocks must be 1" SEVERITY FAILURE;
+    
+  -----------------------------------------------------------------------------
+  -- Prepare lvdsh_pll input
+  -----------------------------------------------------------------------------
+  
+  -- nof_clocks  nof_adu  Supported  LVDSH[1]  LVDSH[0]
+  --   1           1        YES         -          oCD,  o = overflow bit
+  --   1           2        YES         -       oABoCD
+  --   2           2        YES       oAB          oCD
+  
+  input_one_lvdsh_pll : IF g_ai.nof_clocks=1 GENERATE  -- Use 1 clock, so there can be 1 or 2 ADUs
+    ADC_BI_D_CLK_RST <= lvdsh_clk_rst(0);                                  -- ADU lvdsh_clk phase reset control
+    lvdsh_clk(0) <= ADC_BI_D_CLK WHEN g_ai.use_lvds_clk=TRUE ELSE dp_clk;  -- Only use the lvdsh_clk from ADU on port CD or use the dp_clk as LVDS Rx reference clock
+    one_adu : IF g_ai.nof_adu=1 GENERATE  -- Use ADU on port CD
+      no_ovr  : IF g_ai.nof_ovr=0 GENERATE lvdsh_dat(0) <=                 ADC_BI_C & ADC_BI_D; END GENERATE;
+      gen_ovr : IF g_ai.nof_ovr=1 GENERATE lvdsh_dat(0) <= ADC_BI_CD_OVR & ADC_BI_C & ADC_BI_D; END GENERATE;
+    END GENERATE;
+    two_adu : IF g_ai.nof_adu=2 GENERATE  -- Use both ADUs
+      no_ovr  : IF g_ai.nof_ovr=0 GENERATE lvdsh_dat(0) <=                 ADC_BI_A & ADC_BI_B &                 ADC_BI_C & ADC_BI_D; END GENERATE;
+      gen_ovr : IF g_ai.nof_ovr=1 GENERATE lvdsh_dat(0) <= ADC_BI_AB_OVR & ADC_BI_A & ADC_BI_B & ADC_BI_CD_OVR & ADC_BI_C & ADC_BI_D; END GENERATE;
+    END GENERATE;
+  END GENERATE;
+  
+  input_two_lvdsh_pll : IF g_ai.nof_clocks=2 GENERATE  -- Use 2 clocks, so there are also 2 ADU
+    ADC_BI_A_CLK_RST <= lvdsh_clk_rst(1);
+    ADC_BI_D_CLK_RST <= lvdsh_clk_rst(0);
+    
+    lvdsh_clk(1) <= ADC_BI_A_CLK;
+    lvdsh_clk(0) <= ADC_BI_D_CLK;
+    
+    no_ovr  : IF g_ai.nof_ovr=0 GENERATE lvdsh_dat(1) <=                 ADC_BI_A & ADC_BI_B; lvdsh_dat(0) <=                 ADC_BI_C & ADC_BI_D; END GENERATE;
+    gen_ovr : IF g_ai.nof_ovr=1 GENERATE lvdsh_dat(1) <= ADC_BI_AB_OVR & ADC_BI_A & ADC_BI_B; lvdsh_dat(0) <= ADC_BI_CD_OVR & ADC_BI_C & ADC_BI_D; END GENERATE;
+  END GENERATE;
+  
+  -----------------------------------------------------------------------------
+  -- One or two LVDS Handlers
+  -----------------------------------------------------------------------------
+  
+  gen_clk : FOR I IN g_ai.nof_clocks-1 DOWNTO 0 GENERATE
+    u_lvdsh_pll : ENTITY work.lvdsh_pll
+    GENERIC MAP (
+      g_lvds_w           => c_lvdsh_dat_w,
+      g_lvds_data_rate   => g_ai.lvds_data_rate,
+      g_lvds_clk_freq    => c_lvds_clk_freq,
+      g_lvds_clk_phase   => g_ai.lvds_clk_phase,
+      g_use_lvds_clk_rst => g_ai.use_lvds_clk_rst,
+      g_deser_factor     => g_ai.dp_deser_factor,
+      g_use_dpa          => g_ai.use_dpa
+    )
+    PORT MAP (
+      -- PHY LVDS Interface
+      lvds_clk_rst      => lvdsh_clk_rst(I),
+      lvds_clk          => lvdsh_clk(I),     -- the lvdsh_clk frequency is c_lvds_clk_freq
+      lvds_dat          => lvdsh_dat(I),
+      
+      -- DP Streaming Interface
+      dp_clk            => dp_clk,          -- the dp_clk frequency is g_lvds_data_rate / g_dp_deser_factor
+      
+      -- . Control
+      dp_lvds_reset     => restart(I),
+      dp_delay_settings => delay_settings((I+1)*c_lvdsh_dat_w-1 DOWNTO I*c_lvdsh_dat_w),
+      dp_cda_settings   => cda_settings((I+1)*c_lvdsh_dat_w-1 DOWNTO I*c_lvdsh_dat_w),
+      
+      -- . Streaming
+      dp_dat            => rcvdh_dat(I),
+      dp_val            => rcvdh_val(I)
+    );
+  END GENERATE;  -- gen_clk
+  
+  -----------------------------------------------------------------------------
+  -- Handle lvdsh_pll output
+  -----------------------------------------------------------------------------
+  
+  -- Example:
+  --
+  -- lvdsh_dat[16:0][  t0, t1, t2, t3]
+  --                J= 3,  2,  1,  0
+  -- I=16             67, 66, 65, 64 -- OVR_CD
+  --   15             63, 62, 61, 60 -- Port C
+  --   14             59, 58, 57, 56
+  --   13             55, 54, 53, 52
+  --   12             51, 50, 49, 48
+  --   11             47, 46, 45, 44
+  --   10             43, 42, 41, 40
+  --    9             39, 38, 37, 36
+  --    8             35, 34, 33, 32
+  --    7             31, 30, 29, 28 -- Port D
+  --    6             27, 26, 25, 24
+  --    5             23, 22, 21, 20
+  --    4             19, 18, 17, 16
+  --    3             15, 14, 13, 12
+  --    2             11, 10,  9,  8
+  --    1              7,  6,  5,  4
+  --    0              3,  2,  1,  0
+  --
+  -- So: 
+  --   nof_adu=1, nof_clocks=1, nof_ovr=1:  lvdsh    --> rcvdh_dat[0  ][ 67:0] =                                                       [0][OVR_CD(t0:t3), C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[0  ][ 67:0] =                                                       [0][OVR_CD(t0:t3), C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+  --
+  -- and idem for the other supported cases:
+  --   nof_adu=1, nof_clocks=1, nof_ovr=0:  lvdsh    --> rcvdh_dat[0  ][ 63:0] =                                                       [0][               C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[0  ][ 63:0] =                                                       [0][               C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+  --   
+  --   nof_adu=2, nof_clocks=1, nof_ovr=1:  lvdsh    --> rcvdh_dat[0  ][135:0] = [0][OVR_AB(t0:t3), A(t0:t3)(b7:b0), B(t0:t3)(b7:b0),      OVR_CD(t0:t3), C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[0  ][135:0] = [0][OVR_AB(t0:t3), A(b7:b0)(t0:t3), B(b7:b0)(t0:t3),      OVR_CD(t0:t3), C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+  --   
+  --   nof_adu=2, nof_clocks=1, nof_ovr=0:  lvdsh    --> rcvdh_dat[0  ][127:0] = [0][               A(t0:t3)(b7:b0), B(t0:t3)(b7:b0)                      C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[0  ][127:0] = [0][               A(b7:b0)(t0:t3), B(b7:b0)(t0:t3)                      C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+  --   
+  --   nof_adu=2, nof_clocks=2, nof_ovr=1:  lvdsh    --> rcvdh_dat[1:0][ 67:0] = [1][OVR_AB(t0:t3), A(t0:t3)(b7:b0), B(t0:t3)(b7:b0)], [0][OVR_CD(t0:t3), C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[1:0][ 67:0] = [1][OVR_AB(t0:t3), A(b7:b0)(t0:t3), B(b7:b0)(t0:t3)], [0][OVR_CD(t0:t3), C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+  --   
+  --   nof_adu=2, nof_clocks=2, nof_ovr=0:  lvdsh    --> rcvdh_dat[1:0][ 63:0] = [1][               A(t0:t3)(b7:b0), B(t0:t3)(b7:b0)], [0][               C(t0:t3)(b7:b0), D(t0:t3)(b7:b0)]
+  --                                        p_rewire --> porth_dat[1:0][ 63:0] = [1][               A(b7:b0)(t0:t3), B(b7:b0)(t0:t3)], [0][               C(b7:b0)(t0:t3), D(b7:b0)(t0:t3)]
+
+  -- * Generate transpose for each supported case, combining cases makes the code less clear because various combinations are possible
+  -- * Wire porth_dat(g_ai.nof_clocks-1:0) to dp_dat(0:g_ai.nof_adu-1)
+  -- * Use vector OR of the porth overflow bits per ADU
+  -- * Wire dp_ovr and dp_dat to src_out for each supported case
+  --   . src_out[0:3] = [A,B,C,D] if nof_adu=2
+  --   . src_out[0:3] = [0,0,C,D] if nof_adu=1
+  --     Each data field contains dp_deser_factor=4 number of ADC samples that are each g_ai.port_w=8 bits wide,
+  --     so e.g. for port A: src_out[0][31:0]=[A0,A1,A2,A3] whereby A0 is the first sample in time, A1 the next, etc.
+  --     If the OVR_AC bit is used then the OR of the dp_deser_factor=4 overflow bits is passed on via src_out[0][32]
+  --     and via src_out[1][32]
+  
+  porth_val <= rcvdh_val;
+
+  gen_dp_1_1_1 : IF g_ai.nof_adu=1 AND g_ai.nof_clocks=1 AND g_ai.nof_ovr=1 GENERATE
+    porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ) <=           rcvdh_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  );                                      -- bit  OVR_CD
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    -- port [0:1]=[A,B] is not used
+    dp_ovr(2) <= dp_ovr(3);                                                                           -- bit  OVR_C = OVR_CD
+    dp_ovr(3) <= vector_or(porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w));  -- bit  OVR_D = OVR_CD
+    dp_dat(2) <=           porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);   -- port C
+    dp_dat(3) <=           porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);   -- port D
+    dp_val(2) <=           porth_val(0);  -- port C
+    dp_val(3) <=           porth_val(0);  -- port D
+    
+    src_out(0)       <= c_dp_sosi_rst;                          
+    src_out(1)       <= c_dp_sosi_rst;
+    src_out(2).data  <= RESIZE_DP_DATA(dp_ovr(2) & dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_ovr(3) & dp_dat(3));  -- port D
+    src_out(2).valid <=                            dp_val(2);   -- port C
+    src_out(3).valid <=                            dp_val(3);   -- port D
+  END GENERATE;
+
+  gen_dp_1_1_0 : IF g_ai.nof_adu=1 AND g_ai.nof_clocks=1 AND g_ai.nof_ovr=0 GENERATE
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    -- port [0:1]=[A,B] is not used
+    dp_dat(2) <= porth_dat(0)(2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);  -- port C
+    dp_dat(3) <= porth_dat(0)(1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);  -- port D
+    dp_val(2) <= porth_val(0);  -- port C
+    dp_val(3) <= porth_val(0);  -- port D
+    
+    src_out(0)       <= c_dp_sosi_rst;
+    src_out(1)       <= c_dp_sosi_rst;
+    src_out(2).data  <= RESIZE_DP_DATA(dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_dat(3));  -- port D
+    src_out(2).valid <=                dp_val(2);   -- port C
+    src_out(3).valid <=                dp_val(3);   -- port D
+  END GENERATE;
+  
+  gen_dp_2_1_1 : IF g_ai.nof_adu=2 AND g_ai.nof_clocks=1 AND g_ai.nof_ovr=1 GENERATE
+    porth_dat(0)(g_ai.dp_deser_factor + 4*c_dp_dat_w   DOWNTO 4*c_dp_dat_w+1) <=           rcvdh_dat(0)(g_ai.dp_deser_factor + 4*c_dp_dat_w   DOWNTO 4*c_dp_dat_w+1);                                      -- bit  OVR_AB
+    porth_dat(0)(                       4*c_dp_dat_w   DOWNTO 3*c_dp_dat_w+1) <= transpose(rcvdh_dat(0)(                       4*c_dp_dat_w   DOWNTO 3*c_dp_dat_w+1), g_ai.dp_deser_factor, g_ai.port_w);  -- port A
+    porth_dat(0)(                       3*c_dp_dat_w   DOWNTO 2*c_dp_dat_w+1) <= transpose(rcvdh_dat(0)(                       3*c_dp_dat_w   DOWNTO 2*c_dp_dat_w+1), g_ai.dp_deser_factor, g_ai.port_w);  -- port B
+    porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ) <=           rcvdh_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  );                                      -- bit  OVR_CD
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    dp_ovr(0) <= dp_ovr(1);                                                                             -- bit  OVR_A = OVR_AB
+    dp_ovr(1) <= vector_or(porth_dat(0)(g_ai.dp_deser_factor + 4*c_dp_dat_w   DOWNTO 4*c_dp_dat_w+1));  -- bit  OVR_B = OVR_AB
+    dp_ovr(2) <= dp_ovr(3);                                                                             -- bit  OVR_C = OVR_CD
+    dp_ovr(3) <= vector_or(porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ));  -- bit  OVR_D = OVR_CD
+    dp_dat(0) <=           porth_dat(0)(                       4*c_dp_dat_w   DOWNTO 3*c_dp_dat_w+1);   -- port A
+    dp_dat(1) <=           porth_dat(0)(                       3*c_dp_dat_w   DOWNTO 2*c_dp_dat_w+1);   -- port B
+    dp_dat(2) <=           porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  );   -- port C
+    dp_dat(3) <=           porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  );   -- port D
+    dp_val(0) <=           porth_val(0);  -- port A
+    dp_val(1) <=           porth_val(0);  -- port B
+    dp_val(2) <=           porth_val(0);  -- port C
+    dp_val(3) <=           porth_val(0);  -- port D
+    
+    src_out(0).data  <= RESIZE_DP_DATA(dp_ovr(0) & dp_dat(0));  -- port A
+    src_out(1).data  <= RESIZE_DP_DATA(dp_ovr(1) & dp_dat(1));  -- port B
+    src_out(2).data  <= RESIZE_DP_DATA(dp_ovr(2) & dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_ovr(3) & dp_dat(3));  -- port D
+    src_out(0).valid <=                            dp_val(0);   -- port A
+    src_out(1).valid <=                            dp_val(1);   -- port B
+    src_out(2).valid <=                            dp_val(2);   -- port C
+    src_out(3).valid <=                            dp_val(3);   -- port D
+  END GENERATE;
+  
+  gen_dp_2_1_0 : IF g_ai.nof_adu=2 AND g_ai.nof_clocks=1 AND g_ai.nof_ovr=0 GENERATE
+    porth_dat(0)(                       4*c_dp_dat_w-1 DOWNTO 3*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       4*c_dp_dat_w-1 DOWNTO 3*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port A
+    porth_dat(0)(                       3*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       3*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port B
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    dp_dat(0) <= porth_dat(0)(4*c_dp_dat_w-1 DOWNTO 3*c_dp_dat_w);  -- port A
+    dp_dat(1) <= porth_dat(0)(3*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w);  -- port B
+    dp_dat(2) <= porth_dat(0)(2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);  -- port C
+    dp_dat(3) <= porth_dat(0)(1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);  -- port D
+    dp_val(0) <= porth_val(0);  -- port A
+    dp_val(1) <= porth_val(0);  -- port B
+    dp_val(2) <= porth_val(0);  -- port C
+    dp_val(3) <= porth_val(0);  -- port D
+    
+    src_out(0).data  <= RESIZE_DP_DATA(dp_dat(0));  -- port A
+    src_out(1).data  <= RESIZE_DP_DATA(dp_dat(1));  -- port B
+    src_out(2).data  <= RESIZE_DP_DATA(dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_dat(3));  -- port D
+    src_out(0).valid <=                dp_val(0);   -- port A
+    src_out(1).valid <=                dp_val(1);   -- port B
+    src_out(2).valid <=                dp_val(2);   -- port C
+    src_out(3).valid <=                dp_val(3);   -- port D
+  END GENERATE;
+  
+  gen_dp_2_2_1 : IF g_ai.nof_adu=2 AND g_ai.nof_clocks=2 AND g_ai.nof_ovr=1 GENERATE
+    porth_dat(1)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ) <=           rcvdh_dat(1)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  );                                      -- bit  OVR_AB
+    porth_dat(1)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(1)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port A
+    porth_dat(1)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(1)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port B
+    porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  ) <=           rcvdh_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w  );                                      -- bit  OVR_CD
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    dp_ovr(0) <= dp_ovr(1);                                                                           -- bit  OVR_A = OVR_AB
+    dp_ovr(1) <= vector_or(porth_dat(1)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w));  -- bit  OVR_B = OVR_AB
+    dp_ovr(2) <= dp_ovr(3);                                                                           -- bit  OVR_C = OVR_CD
+    dp_ovr(3) <= vector_or(porth_dat(0)(g_ai.dp_deser_factor + 2*c_dp_dat_w-1 DOWNTO 2*c_dp_dat_w));  -- bit  OVR_D = OVR_CD
+    dp_dat(0) <=           porth_dat(1)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);   -- port A
+    dp_dat(1) <=           porth_dat(1)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);   -- port B
+    dp_dat(2) <=           porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);   -- port C
+    dp_dat(3) <=           porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);   -- port D
+    dp_val(0) <=           porth_val(1);  -- port A
+    dp_val(1) <=           porth_val(1);  -- port B
+    dp_val(2) <=           porth_val(0);  -- port C
+    dp_val(3) <=           porth_val(0);  -- port D
+    
+    src_out(0).data  <= RESIZE_DP_DATA(dp_ovr(0) & dp_dat(0));  -- port A
+    src_out(1).data  <= RESIZE_DP_DATA(dp_ovr(1) & dp_dat(1));  -- port B
+    src_out(2).data  <= RESIZE_DP_DATA(dp_ovr(2) & dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_ovr(3) & dp_dat(3));  -- port D
+    src_out(0).valid <=                            dp_val(0);   -- port A
+    src_out(1).valid <=                            dp_val(1);   -- port B
+    src_out(2).valid <=                            dp_val(2);   -- port C
+    src_out(3).valid <=                            dp_val(3);   -- port D
+  END GENERATE;
+  
+  gen_dp_2_2_0 : IF g_ai.nof_adu=2 AND g_ai.nof_clocks=2 AND g_ai.nof_ovr=0 GENERATE
+    porth_dat(1)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(1)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port A
+    porth_dat(1)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(1)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port B
+    porth_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port C
+    porth_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ) <= transpose(rcvdh_dat(0)(                       1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w  ), g_ai.dp_deser_factor, g_ai.port_w);  -- port D
+    
+    dp_dat(0) <= porth_dat(1)(2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);  -- port A
+    dp_dat(1) <= porth_dat(1)(1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);  -- port B
+    dp_dat(2) <= porth_dat(0)(2*c_dp_dat_w-1 DOWNTO 1*c_dp_dat_w);  -- port C
+    dp_dat(3) <= porth_dat(0)(1*c_dp_dat_w-1 DOWNTO 0*c_dp_dat_w);  -- port D
+    dp_val(0) <= porth_val(1);  -- port A
+    dp_val(1) <= porth_val(1);  -- port B
+    dp_val(2) <= porth_val(0);  -- port C
+    dp_val(3) <= porth_val(0);  -- port D
+
+    src_out(0).data  <= RESIZE_DP_DATA(dp_dat(0));  -- port A
+    src_out(1).data  <= RESIZE_DP_DATA(dp_dat(1));  -- port B
+    src_out(2).data  <= RESIZE_DP_DATA(dp_dat(2));  -- port C
+    src_out(3).data  <= RESIZE_DP_DATA(dp_dat(3));  -- port D
+    src_out(0).valid <=                dp_val(0);   -- port A
+    src_out(1).valid <=                dp_val(1);   -- port B
+    src_out(2).valid <=                dp_val(2);   -- port C
+    src_out(3).valid <=                dp_val(3);   -- port D
+  END GENERATE;
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/aduh_pll_pkg.vhd b/libraries/io/aduh/src/vhdl/aduh_pll_pkg.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..bdb8581829895fa01e4b6cf5982c0e56b6eb6c1d
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_pll_pkg.vhd
@@ -0,0 +1,88 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+
+PACKAGE aduh_pll_pkg IS
+
+  -- ADU Interface
+  TYPE t_c_aduh_pll_ai IS RECORD
+    nof_sp            : NATURAL;  -- = 4;     -- Fixed support 4 signal paths A,B,C,D, whether they contain active data depends on nof_adu
+    nof_adu           : NATURAL;  -- = 2;     -- When 2 ADUs then use all 4 ports A,B,C,D, one ADU on ports A,B and one ADU on ports C,D,
+                                              -- when 1 ADU then only use ports C,D
+    nof_ports         : NATURAL;  -- = 2;     -- Fixed 2 ADC BI ports per ADU
+    port_w            : NATURAL;  -- = 8;     -- Fixed 8 bit ADC BI port width, the ADC sample width is also 8 bit
+    nof_ovr           : NATURAL;  -- = 0;     -- There is 1 overflow bit per ADU, use 0 to ignore the overflow input
+    lvds_data_rate    : NATURAL;  -- = 800;   -- The ADC sample rate is 800 Msps, so the LVDS rate is 800 Mbps per ADC BI data line, 
+    use_dpa           : BOOLEAN;  -- = TRUE;  -- When TRUE use LVDS_RX with DPA, else used fixed IOE delays and/or lvds_clk_phase instead of DPA
+    use_lvds_clk      : BOOLEAN;  -- = TRUE;  -- When TRUE use the one or both ADC BI lvds_clk, else use the single dp_clk to capture the lvds data
+    use_lvds_clk_rst  : BOOLEAN;  -- = FALSE; -- When TRUE then support reset pulse to ADU to align the lvds_clk to the dp_clk, else no support
+    lvds_clk_phase    : NATURAL;  -- = 0;     -- Use PLL phase 0 for edge aligned, phase 180 for center aligned. Only for no DPA
+    nof_clocks        : NATURAL;  -- = 2;     -- Must be <= nof_adu
+                                              -- 1 --> Use ADC BI clock D or dp_clk for one or both ADU
+                                              -- 2 --> Use ADC BI clock A for/from ADU-AB and clock D for/from the ADU-CD
+    lvds_deser_factor : NATURAL;  -- = 2;     -- The ADC sampled data comes in with a DDR lvds_clk, so lvds_data_rate / 2 or
+                                              -- the 4 when the Data Path clock dp_clk is also used as LVDS data reference lvds_clk clock
+    dp_deser_factor   : NATURAL;  -- = 4;     -- The Data Path clock dp_clk frequency is 200 MHz, so lvds_data_rate / 4
+  END RECORD;
+  
+  CONSTANT c_aduh_pll_ai  : t_c_aduh_pll_ai := (4, 2, 2, 8, 0, 800, TRUE, TRUE, FALSE, 0, 2, 2, 4);
+  
+  FUNCTION func_aduh_pll_adu_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL;    -- LVDS data width per ADU: two ADCs with one optional overflow bit
+  FUNCTION func_aduh_pll_lvds_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL;   -- LVDS data width per ADUH: one or two ADUs
+  FUNCTION func_aduh_pll_lvdsh_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL;  -- LVDS data width per LVDSH: dependent on whether one or two LVDS reference clocks are used
+
+END aduh_pll_pkg;
+
+
+PACKAGE BODY aduh_pll_pkg IS
+
+  FUNCTION func_aduh_pll_adu_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL IS
+  BEGIN
+    -- fixed      fixed
+    -- nof_ports  port_w  nov_ovr 
+    --     2         8       0    --> 16, two ADC with each 8 bit samples and no overflow bit, or
+    --     2         8       1    --> 17, two ADC with each 8 bit samples and sharing 1 overflow bit
+    RETURN ai.nof_ports * ai.port_w + ai.nof_ovr;
+  END;
+  
+  FUNCTION func_aduh_pll_lvds_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL IS
+  BEGIN
+    -- nof_adu  nov_ovr
+    --    1        0      --> 16 bit
+    --    1        1      --> 17 bit
+    --    2        0      --> 32 bit
+    --    2        1      --> 34 bit
+    RETURN ai.nof_adu * func_aduh_pll_adu_dat_w(ai);
+  END;
+  
+  FUNCTION func_aduh_pll_lvdsh_dat_w(ai : t_c_aduh_pll_ai) RETURN NATURAL IS
+  BEGIN
+    -- nof_adu  c_nof_clocks
+    --   1           1        -->                             one LVDSH for ADU on CD --> 1 LVDSH
+    --   2           1        --> one LVDSH for ADU on AB and one LVDSH for ADU on CD --> 2 LVDSH
+    --   2           2        --> one LVDSH for ADU on AB and           for ADU on CD --> 1 LVDSH
+    RETURN func_aduh_pll_lvds_dat_w(ai) / ai.nof_clocks;
+  END;
+  
+END aduh_pll_pkg;
diff --git a/libraries/io/aduh/src/vhdl/aduh_power_sum.vhd b/libraries/io/aduh/src/vhdl/aduh_power_sum.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..579b23621694dbff45e31c66381f94a7a0cc0914
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_power_sum.vhd
@@ -0,0 +1,142 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2011
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+
+
+ENTITY aduh_power_sum IS
+  GENERIC (
+    g_symbol_w             : NATURAL := 12;
+    g_nof_symbols_per_data : NATURAL := 4;          -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    : NATURAL := 800*10**6;  -- integration time in symbols
+    g_pwr_sum_truncate     : BOOLEAN := TRUE;       -- when TRUE truncate (keep MS part) else resize (keep sign and LS part)
+    g_pwr_sum_w            : NATURAL := 32          -- typcially MM word width (= 32) or double MM word width (= 64)
+  );
+  PORT (
+    clk          : IN  STD_LOGIC;
+    rst          : IN  STD_LOGIC;
+    
+    -- Streaming inputs
+    in_data      : IN  STD_LOGIC_VECTOR(g_nof_symbols_per_data*g_symbol_w-1 DOWNTO 0);
+    in_val       : IN  STD_LOGIC;
+    in_sync      : IN  STD_LOGIC;
+    
+    -- Accumulation outputs
+    pwr_sum      : OUT STD_LOGIC_VECTOR(g_pwr_sum_w-1 DOWNTO 0);
+    pwr_sum_sync : OUT STD_LOGIC;                   -- after sync there is a new sum
+    pwr_sum_sop  : OUT STD_LOGIC                    -- at    sop  there is a new sum
+  );
+END aduh_power_sum;
+
+
+ARCHITECTURE str OF aduh_power_sum IS
+
+  CONSTANT c_prod_w        : NATURAL := 2*g_symbol_w;
+  CONSTANT c_pipeline_prod : NATURAL := 1;
+  
+  TYPE t_symbol_arr IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(g_symbol_w-1 DOWNTO 0);
+  TYPE t_prod_arr   IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(c_prod_w-1 DOWNTO 0);
+  
+  SIGNAL prod_data : STD_LOGIC_VECTOR(g_nof_symbols_per_data*c_prod_w-1 DOWNTO 0);
+  SIGNAL prod_val  : STD_LOGIC;
+  SIGNAL prod_sync : STD_LOGIC;
+
+  -- Debug signals
+  SIGNAL symbol_arr   : t_symbol_arr(0 TO g_nof_symbols_per_data-1);
+  SIGNAL prod_arr     : t_prod_arr(0 TO g_nof_symbols_per_data-1);
+  
+BEGIN
+
+  u_prod_data : ENTITY common_lib.common_mult(rtl)
+  GENERIC MAP (
+    g_in_a_w           => g_symbol_w,
+    g_in_b_w           => g_symbol_w,
+    g_out_p_w          => c_prod_w,                -- <= g_in_a_w + g_in_b_w
+    g_nof_mult         => g_nof_symbols_per_data,  -- using 2 for 18x18, 4 for 9x9 may yield better results when inferring * is used
+    g_pipeline_input   => 0,                       -- 0 or 1
+    g_pipeline_product => 1,                       -- 0 or 1
+    g_pipeline_output  => 0,                       -- >= 0
+    g_representation   => "SIGNED"
+  )
+  PORT MAP (
+    rst        => rst,
+    clk        => clk,
+    in_a       => in_data,
+    in_b       => in_data,
+    out_p      => prod_data
+  );
+
+  u_prod_sync : ENTITY common_lib.common_pipeline_sl
+  GENERIC MAP (
+    g_pipeline    => c_pipeline_prod,   -- = 1, must match total pipelining of u_prod_data
+    g_reset_value => 0
+  )
+  PORT MAP (
+    rst     => rst,
+    clk     => clk,
+    in_dat  => in_sync,
+    out_dat => prod_sync
+  );
+  
+  u_prod_val : ENTITY common_lib.common_pipeline_sl
+  GENERIC MAP (
+    g_pipeline    => c_pipeline_prod,   -- = 1, must match total pipelining of u_prod_data
+    g_reset_value => 0
+  )
+  PORT MAP (
+    rst     => rst,
+    clk     => clk,
+    in_dat  => in_val,
+    out_dat => prod_val
+  );
+  
+  u_pwr_sum : ENTITY work.aduh_mean_sum
+  GENERIC MAP (
+    g_symbol_w             => c_prod_w,
+    g_nof_symbols_per_data => g_nof_symbols_per_data,
+    g_nof_accumulations    => g_nof_accumulations,
+    g_sum_truncate         => g_pwr_sum_truncate,
+    g_sum_w                => g_pwr_sum_w
+  )
+  PORT MAP (
+    clk         => clk,
+    rst         => rst,
+    
+    -- Streaming inputs
+    in_data     => prod_data,
+    in_val      => prod_val,
+    in_sync     => prod_sync,
+    
+    -- Accumulation outputs
+    sum         => pwr_sum,
+    sum_sync    => pwr_sum_sync,
+    sum_sop     => pwr_sum_sop
+  );
+  
+  -- Debug wire signal arrays for easier data interpretation in the Wave window
+  dbg_arr : FOR I IN 0 TO g_nof_symbols_per_data-1 GENERATE
+    symbol_arr(I) <= in_data((g_nof_symbols_per_data-I)*g_symbol_w-1 DOWNTO (g_nof_symbols_per_data-I-1)*g_symbol_w);
+    prod_arr(I) <= prod_data((g_nof_symbols_per_data-I)*c_prod_w-1   DOWNTO (g_nof_symbols_per_data-I-1)*c_prod_w);
+  END GENERATE;
+
+END str;
diff --git a/libraries/io/aduh/src/vhdl/aduh_quad.vhd b/libraries/io/aduh/src/vhdl/aduh_quad.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..c6915422015c61c5c2ce0ae52161f95e66fd3a56
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_quad.vhd
@@ -0,0 +1,165 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+-- Purpose: Capture input from four ADC [A,B,C,D] on two ADU and support
+--          pattern verify for each ADC
+
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+USE work.aduh_dd_pkg.ALL;
+
+ENTITY aduh_quad IS
+  GENERIC (
+    -- ADC Interface
+    g_nof_dp_phs_clk  : NATURAL := 1;      -- nof dp_phs_clk that can be used to detect the word phase
+    g_ai              : t_c_aduh_dd_ai := c_aduh_dd_ai
+  );
+  PORT (
+    -- ADC Interface
+    -- . ADU_AB
+    ADC_BI_A               : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);
+    ADC_BI_B               : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);
+    ADC_BI_A_CLK           : IN  STD_LOGIC;
+    ADC_BI_A_CLK_RST       : OUT STD_LOGIC;
+    
+    -- . ADU_CD
+    ADC_BI_C               : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);
+    ADC_BI_D               : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0);
+    ADC_BI_D_CLK           : IN  STD_LOGIC;
+    ADC_BI_D_CLK_RST       : OUT STD_LOGIC;
+    
+    -- Streaming clock domain
+    dp_rst                 : IN  STD_LOGIC;
+    dp_clk                 : IN  STD_LOGIC;
+    dp_phs_clk_vec         : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+    
+    -- . data
+    aduh_sosi_arr          : OUT t_dp_sosi_arr(0 TO g_ai.nof_sp-1);  -- = [0:3] = ADC_BI ports [A,B,C,D]
+    
+    -- . status
+    aduh_ab_status         : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    aduh_ab_locked         : OUT STD_LOGIC;
+    aduh_ab_stable         : OUT STD_LOGIC;
+    aduh_ab_stable_ack     : IN  STD_LOGIC;
+    aduh_ab_control        : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  
+    aduh_cd_status         : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    aduh_cd_locked         : OUT STD_LOGIC;
+    aduh_cd_stable         : OUT STD_LOGIC;
+    aduh_cd_stable_ack     : IN  STD_LOGIC;
+    aduh_cd_control        : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+      
+    aduh_verify_res        : OUT t_slv_32_arr(0 TO g_ai.nof_sp-1);  -- [8,7:0]
+    aduh_verify_res_val    : OUT STD_LOGIC_VECTOR(0 TO g_ai.nof_sp-1);
+    aduh_verify_res_ack    : IN  STD_LOGIC_VECTOR(0 TO g_ai.nof_sp-1)
+  );
+END aduh_quad;
+
+
+ARCHITECTURE str OF aduh_quad IS
+
+  CONSTANT c_dp_factor       : NATURAL := g_ai.rx_factor * g_ai.dd_factor;
+  CONSTANT c_wideband_factor : NATURAL := c_dp_factor;   -- Wideband rate factor = 4 for dp_clk is 200 MHz frequency and sample frequency Fs is 800 MHz
+  
+  CONSTANT c_adc_pattern_sel : t_natural_arr(0 TO g_ai.nof_sp-1) := (0, 1, 0, 1);  -- signal path [A, B, C, D] = ADC [I, Q, I, Q]
+  
+  SIGNAL aduh_ab_dp_phs_clk_en_vec  : STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+  SIGNAL aduh_cd_dp_phs_clk_en_vec  : STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+  
+  SIGNAL i_aduh_sosi_arr            : t_dp_sosi_arr(0 TO g_ai.nof_sp-1);  -- = [0:3] = ADC_BI ports [A,B,C,D]
+  
+BEGIN
+
+  -- ADC [A,B,C,D] input samples
+  aduh_sosi_arr <= i_aduh_sosi_arr;
+  
+  aduh_ab_dp_phs_clk_en_vec <= aduh_ab_control(g_nof_dp_phs_clk-1 DOWNTO 0);
+  aduh_cd_dp_phs_clk_en_vec <= aduh_cd_control(g_nof_dp_phs_clk-1 DOWNTO 0);
+  
+  u_aduh : ENTITY work.aduh_dd
+  GENERIC MAP (
+    g_nof_dp_phs_clk => g_nof_dp_phs_clk,
+    g_ai             => g_ai
+  )
+  PORT MAP (
+    -- LVDS Interface
+    ADC_BI_A             => ADC_BI_A,
+    ADC_BI_B             => ADC_BI_B,
+    ADC_BI_C             => ADC_BI_C,
+    ADC_BI_D             => ADC_BI_D,
+    
+    ADC_BI_A_CLK         => ADC_BI_A_CLK,         -- lvds clock from ADU_AB
+    ADC_BI_D_CLK         => ADC_BI_D_CLK,         -- lvds clock from ADU_CD
+    
+    ADC_BI_A_CLK_RST     => ADC_BI_A_CLK_RST,     -- release synchronises ADU_AB DCLK divider
+    ADC_BI_D_CLK_RST     => ADC_BI_D_CLK_RST,     -- release synchronises ADU_CD DCLK divider
+    
+    -- DP Interface
+    dp_rst               => dp_rst,
+    dp_clk               => dp_clk,
+    dp_phs_clk_vec       => dp_phs_clk_vec,
+    
+    -- . Control
+    ab_status            => aduh_ab_status,
+    ab_locked            => aduh_ab_locked,
+    ab_stable            => aduh_ab_stable,
+    ab_stable_ack        => aduh_ab_stable_ack,
+    ab_dp_phs_clk_en_vec => aduh_ab_dp_phs_clk_en_vec,
+
+    cd_status            => aduh_cd_status,
+    cd_locked            => aduh_cd_locked,
+    cd_stable            => aduh_cd_stable,
+    cd_stable_ack        => aduh_cd_stable_ack,
+    cd_dp_phs_clk_en_vec => aduh_cd_dp_phs_clk_en_vec,
+    
+    -- . Streaming
+    src_out_arr      => i_aduh_sosi_arr
+  );
+  
+  
+  -- ADC pattern verification
+  gen_verify : FOR I IN 0 TO g_ai.nof_sp-1 GENERATE
+    aduh_verify_res(I)(c_word_w-1 DOWNTO g_ai.port_w+1) <= (OTHERS=>'0');  -- unused bits [31:9]
+    
+    u_adc : ENTITY work.aduh_verify
+    GENERIC MAP (
+      g_symbol_w             => g_ai.port_w,       -- = 8, fixed
+      g_nof_symbols_per_data => c_wideband_factor  -- = 4, fixed, big endian in_sosi.data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    )
+    PORT MAP (
+      rst            => dp_rst,
+      clk            => dp_clk,
+      
+      -- ST input
+      in_sosi        => i_aduh_sosi_arr(I),
+                                                               
+      -- Static control input (connect via MM or leave open to use default)
+      pattern_sel    => c_adc_pattern_sel(I),
+      verify_res     => aduh_verify_res(I)(g_ai.port_w DOWNTO 0),  -- [8,7:0]
+      verify_res_val => aduh_verify_res_val(I),
+      verify_res_ack => aduh_verify_res_ack(I)
+    );
+  END GENERATE;
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/aduh_quad_reg.vhd b/libraries/io/aduh/src/vhdl/aduh_quad_reg.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..36483201f8557a450cec52c1a0968c450c3fea22
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_quad_reg.vhd
@@ -0,0 +1,539 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+-- Purpose: Provide MM slave read only register for aduh_quad
+-- Description:
+-- . Report the locked status for ADU-AB and CD
+-- . Report pattern verification result for each ADC [A,B,C,D]
+-- . Control for dp_phs_clk_en_vec[g_nof_dp_phs_clk-1:0]
+--
+--   31             24 23             16 15              8 7               0  wi
+--  |-----------------|-----------------|-----------------|-----------------|
+--  |         xxx                              ab_stable & ab_locked = [1:0]|  0
+--  |-----------------------------------------------------------------------|
+--  |         xxx                              cd_stable & cd_locked = [1:0]|  1
+--  |-----------------------------------------------------------------------|
+--  |         xxx            a_verify_res_val[12]|   xxx   a_verify_res[8:0]|  2
+--  |-----------------------------------------------------------------------|
+--  |         xxx            b_verify_res_val[12]|   xxx   b_verify_res[8:0]|  3
+--  |-----------------------------------------------------------------------|
+--  |         xxx            c_verify_res_val[12]|   xxx   c_verify_res[8:0]|  4
+--  |-----------------------------------------------------------------------|
+--  |         xxx            d_verify_res_val[12]|   xxx   d_verify_res[8:0]|  5
+--  |-----------------------------------------------------------------------|
+--  |                                                       ab_control[31:0]|  6
+--  |-----------------------------------------------------------------------|
+--  |                                                       cd_control[31:0]|  7
+--  |-----------------------------------------------------------------------|
+--
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE common_lib.common_mem_pkg.ALL;
+
+ENTITY aduh_quad_reg IS
+  GENERIC (
+    g_cross_clock_domain : BOOLEAN := TRUE;  -- use FALSE when mm_clk and st_clk are the same, else use TRUE to cross the clock domain
+    g_nof_dp_phs_clk     : NATURAL := 1      -- nof dp_phs_clk that can be used to detect the word phase
+  );
+  PORT (
+    -- Clocks and reset
+    mm_rst                   : IN  STD_LOGIC;   -- reset synchronous with mm_clk
+    mm_clk                   : IN  STD_LOGIC;   -- memory-mapped bus clock
+    st_rst                   : IN  STD_LOGIC;   -- reset synchronous with st_clk
+    st_clk                   : IN  STD_LOGIC;   -- other clock domain clock
+    
+    -- Memory Mapped Slave in mm_clk domain
+    sla_in                   : IN  t_mem_mosi;  -- actual ranges defined by c_mm_reg
+    sla_out                  : OUT t_mem_miso;  -- actual ranges defined by c_mm_reg
+    
+    -- MM registers in st_clk domain
+    st_aduh_ab_status        : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_ab_locked        : IN  STD_LOGIC;
+    st_aduh_ab_stable        : IN  STD_LOGIC;
+    st_aduh_ab_stable_ack    : OUT STD_LOGIC;
+    st_aduh_ab_control       : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  
+    st_aduh_cd_status        : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_cd_locked        : IN  STD_LOGIC;
+    st_aduh_cd_stable        : IN  STD_LOGIC;
+    st_aduh_cd_stable_ack    : OUT STD_LOGIC;
+    st_aduh_cd_control       : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+      
+    st_aduh_a_verify_res     : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_a_verify_res_val : IN  STD_LOGIC;
+    st_aduh_a_verify_res_ack : OUT STD_LOGIC;
+    
+    st_aduh_b_verify_res     : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_b_verify_res_val : IN  STD_LOGIC;
+    st_aduh_b_verify_res_ack : OUT STD_LOGIC;
+    
+    st_aduh_c_verify_res     : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_c_verify_res_val : IN  STD_LOGIC;
+    st_aduh_c_verify_res_ack : OUT STD_LOGIC;
+    
+    st_aduh_d_verify_res     : IN  STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    st_aduh_d_verify_res_val : IN  STD_LOGIC;
+    st_aduh_d_verify_res_ack : OUT STD_LOGIC
+  );
+END aduh_quad_reg;
+
+
+ARCHITECTURE rtl OF aduh_quad_reg IS
+
+  -- Define the actual size of the MM slave register
+  CONSTANT c_nof_dat : NATURAL := 8;
+  CONSTANT c_mm_reg  : t_c_mem := (latency  => 1,
+                                   adr_w    => ceil_log2(c_nof_dat),
+                                   dat_w    => c_word_w,       -- Use MM bus data width = c_word_w = 32 for all MM registers
+                                   nof_dat  => c_nof_dat,
+                                   init_sl  => '0');
+                                               
+  -- Register access control signal in mm_clk domain
+  SIGNAL mm_aduh_ab_stable_ack    : STD_LOGIC;
+  SIGNAL mm_aduh_cd_stable_ack    : STD_LOGIC;
+      
+  SIGNAL mm_aduh_a_verify_res_ack : STD_LOGIC;
+  SIGNAL mm_aduh_b_verify_res_ack : STD_LOGIC;
+  SIGNAL mm_aduh_c_verify_res_ack : STD_LOGIC;
+  SIGNAL mm_aduh_d_verify_res_ack : STD_LOGIC;
+  
+  -- Registers in mm_clk domain
+  SIGNAL mm_aduh_ab_status        : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_ab_locked        : STD_LOGIC;
+  SIGNAL mm_aduh_ab_stable        : STD_LOGIC;
+  SIGNAL mm_aduh_ab_control       : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_cd_status        : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_cd_locked        : STD_LOGIC;
+  SIGNAL mm_aduh_cd_stable        : STD_LOGIC;
+  SIGNAL mm_aduh_cd_control       : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+      
+  SIGNAL mm_aduh_a_verify_res     : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_a_verify_res_val : STD_LOGIC;
+  SIGNAL mm_aduh_b_verify_res     : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_b_verify_res_val : STD_LOGIC;
+  SIGNAL mm_aduh_c_verify_res     : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_c_verify_res_val : STD_LOGIC;
+  SIGNAL mm_aduh_d_verify_res     : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL mm_aduh_d_verify_res_val : STD_LOGIC;
+    
+BEGIN
+
+  ------------------------------------------------------------------------------
+  -- MM register access in the mm_clk domain
+  -- . Hardcode the shared MM slave register directly in RTL instead of using
+  --   the common_reg_r_w instance. Directly using RTL is easier when the large
+  --   MM register has multiple different fields and with different read and
+  --   write options per field in one MM register.
+  ------------------------------------------------------------------------------
+  
+  p_mm_reg : PROCESS (mm_rst, mm_clk)
+  BEGIN
+    IF mm_rst = '1' THEN
+      -- Read access
+      sla_out                  <= c_mem_miso_rst;
+      
+      -- Access event, register values
+      mm_aduh_ab_stable_ack    <= '0';
+      mm_aduh_cd_stable_ack    <= '0';
+      mm_aduh_ab_control                              <= (OTHERS=>'0');  -- default reset all unused control bits
+      mm_aduh_cd_control                              <= (OTHERS=>'0');  -- default reset all unused control bits
+      mm_aduh_ab_control(g_nof_dp_phs_clk-1 DOWNTO 0) <= (OTHERS=>'1');  -- default enable all dp_phs_clk for ADU-AB
+      mm_aduh_cd_control(g_nof_dp_phs_clk-1 DOWNTO 0) <= (OTHERS=>'1');  -- default enable all dp_phs_clk for ADU-CD
+      
+      mm_aduh_a_verify_res_ack <= '0';
+      mm_aduh_b_verify_res_ack <= '0';
+      mm_aduh_c_verify_res_ack <= '0';
+      mm_aduh_d_verify_res_ack <= '0';
+      
+    ELSIF rising_edge(mm_clk) THEN
+      -- Read access defaults
+      sla_out.rdval <= '0';
+      
+      -- Access event defaults
+      mm_aduh_ab_stable_ack <= '0';
+      mm_aduh_cd_stable_ack <= '0';
+      
+      mm_aduh_a_verify_res_ack <= '0';
+      mm_aduh_b_verify_res_ack <= '0';
+      mm_aduh_c_verify_res_ack <= '0';
+      mm_aduh_d_verify_res_ack <= '0';
+      
+      -- Write access: set register value
+      IF sla_in.wr = '1' THEN
+        CASE TO_UINT(sla_in.address(c_mm_reg.adr_w-1 DOWNTO 0)) IS
+          -- Write dp_phs_clk select control
+          WHEN 6 =>
+            mm_aduh_ab_control <= sla_in.wrdata(31 DOWNTO 0);
+          WHEN 7 =>
+            mm_aduh_cd_control <= sla_in.wrdata(31 DOWNTO 0);
+          WHEN OTHERS => NULL;  -- not used MM addresses
+        END CASE;
+        
+      -- Read access: get register value
+      ELSIF sla_in.rd = '1' THEN
+        sla_out       <= c_mem_miso_rst;    -- set unused rddata bits to '0' when read
+        sla_out.rdval <= '1';               -- c_mm_reg.latency = 1
+        CASE TO_UINT(sla_in.address(c_mm_reg.adr_w-1 DOWNTO 0)) IS
+          -- Read ADUH locked status
+          WHEN 0 =>
+            mm_aduh_ab_stable_ack        <= '1';
+            sla_out.rddata(0)            <= mm_aduh_ab_locked;  -- ADU AB
+            sla_out.rddata(1)            <= mm_aduh_ab_stable;
+            sla_out.rddata(31 DOWNTO 2)  <= mm_aduh_ab_status(31 DOWNTO 2);  -- extra status info for debug
+          WHEN 1 =>
+            mm_aduh_cd_stable_ack        <= '1';
+            sla_out.rddata(0)            <= mm_aduh_cd_locked;  -- ADU CD
+            sla_out.rddata(1)            <= mm_aduh_cd_stable;
+            sla_out.rddata(31 DOWNTO 2)  <= mm_aduh_cd_status(31 DOWNTO 2);  -- extra status info for debug
+            
+          -- Read ADUH ADC verify test pattern status
+          WHEN 2 =>
+            mm_aduh_a_verify_res_ack     <= '1';
+            sla_out.rddata(8 DOWNTO 0)   <= mm_aduh_a_verify_res(8 DOWNTO 0);  -- ADC A
+            sla_out.rddata(12)           <= mm_aduh_a_verify_res_val;
+          WHEN 3 =>
+            mm_aduh_b_verify_res_ack     <= '1';
+            sla_out.rddata(8 DOWNTO 0)   <= mm_aduh_b_verify_res(8 DOWNTO 0);  -- ADC B
+            sla_out.rddata(12)           <= mm_aduh_b_verify_res_val;
+          WHEN 4 =>
+            mm_aduh_c_verify_res_ack     <= '1';
+            sla_out.rddata(8 DOWNTO 0)   <= mm_aduh_c_verify_res(8 DOWNTO 0);  -- ADC C
+            sla_out.rddata(12)           <= mm_aduh_c_verify_res_val;
+          WHEN 5 =>
+            mm_aduh_d_verify_res_ack     <= '1';
+            sla_out.rddata(8 DOWNTO 0)   <= mm_aduh_d_verify_res(8 DOWNTO 0);  -- ADC D
+            sla_out.rddata(12)           <= mm_aduh_d_verify_res_val;
+            
+          WHEN 6 =>
+            -- Read back dp_phs_clk select control
+            sla_out.rddata(31 DOWNTO 0)  <= mm_aduh_ab_control;
+          WHEN 7 =>
+            -- Read back dp_phs_clk select control
+            sla_out.rddata(31 DOWNTO 0)  <= mm_aduh_cd_control;
+          WHEN OTHERS => NULL;  -- not used MM addresses
+        END CASE;
+      END IF;
+    END IF;
+  END PROCESS;
+
+  ------------------------------------------------------------------------------
+  -- Transfer register value between mm_clk and st_clk domain.
+  -- If the function of the register ensures that the value will not be used
+  -- immediately when it was set, then the transfer between the clock domains
+  -- can be done by wires only. Otherwise if the change in register value can
+  -- have an immediate effect then the bit or word value needs to be transfered
+  -- using:
+  --
+  -- . common_async            --> for single-bit level signal
+  -- . common_spulse           --> for single-bit pulse signal
+  -- . common_reg_cross_domain --> for a multi-bit (a word) signal
+  --
+  -- Typically always use a crossing component for the single bit signals (to
+  -- be on the save side) and only use a crossing component for the word
+  -- signals if it is necessary (to avoid using more logic than necessary).
+  ------------------------------------------------------------------------------
+  
+  no_cross : IF g_cross_clock_domain = FALSE GENERATE  -- so mm_clk = st_clk
+    mm_aduh_ab_status        <= st_aduh_ab_status;
+    mm_aduh_ab_locked        <= st_aduh_ab_locked;
+    mm_aduh_ab_stable        <= st_aduh_ab_stable;
+    st_aduh_ab_stable_ack    <= mm_aduh_ab_stable_ack;
+    st_aduh_ab_control       <= mm_aduh_ab_control;
+  
+    mm_aduh_cd_status        <= st_aduh_cd_status;
+    mm_aduh_cd_locked        <= st_aduh_cd_locked;
+    mm_aduh_cd_stable        <= st_aduh_cd_stable;
+    st_aduh_cd_stable_ack    <= mm_aduh_cd_stable_ack;
+    st_aduh_cd_control       <= mm_aduh_cd_control;
+    
+    mm_aduh_a_verify_res     <= st_aduh_a_verify_res;
+    mm_aduh_a_verify_res_val <= st_aduh_a_verify_res_val;
+    st_aduh_a_verify_res_ack <= mm_aduh_a_verify_res_ack;
+    
+    mm_aduh_b_verify_res     <= st_aduh_b_verify_res;
+    mm_aduh_b_verify_res_val <= st_aduh_b_verify_res_val;
+    st_aduh_b_verify_res_ack <= mm_aduh_b_verify_res_ack;
+    
+    mm_aduh_c_verify_res     <= st_aduh_c_verify_res;
+    mm_aduh_c_verify_res_val <= st_aduh_c_verify_res_val;
+    st_aduh_c_verify_res_ack <= mm_aduh_c_verify_res_ack;
+    
+    mm_aduh_d_verify_res     <= st_aduh_d_verify_res;
+    mm_aduh_d_verify_res_val <= st_aduh_d_verify_res_val;
+    st_aduh_d_verify_res_ack <= mm_aduh_d_verify_res_ack;
+  END GENERATE;  -- no_cross
+
+  gen_cross : IF g_cross_clock_domain = TRUE GENERATE
+    -- ADUH extra status registers
+    -- . no need to use in_new, continuously cross the clock domain
+    u_aduh_ab_status : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_ab_status,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_ab_status
+    );
+    
+    u_aduh_cd_status : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_cd_status,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_cd_status
+    );
+
+    -- ADUH locked registers
+    u_aduh_ab_locked : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_ab_locked,
+      dout => mm_aduh_ab_locked
+    );
+  
+    u_aduh_ab_stable : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_ab_stable,
+      dout => mm_aduh_ab_stable
+    );
+    
+    u_aduh_ab_stable_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_ab_stable_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_ab_stable_ack
+    );
+    
+    u_aduh_ab_control : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_dat    => mm_aduh_ab_control,
+      in_done   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_dat   => st_aduh_ab_control,
+      out_new   => OPEN
+    );
+    
+    u_aduh_cd_locked : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_cd_locked,
+      dout => mm_aduh_cd_locked
+    );
+    
+    u_aduh_cd_stable : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_cd_stable,
+      dout => mm_aduh_cd_stable
+    );
+    
+    u_aduh_cd_stable_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_cd_stable_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_cd_stable_ack
+    );
+    
+    u_aduh_cd_control : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_dat    => mm_aduh_cd_control,
+      in_done   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_dat   => st_aduh_cd_control,
+      out_new   => OPEN
+    );
+    
+    -- ADUH ADC verification registers
+    u_aduh_a_verify_res : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_a_verify_res,
+      in_done     => OPEN,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_a_verify_res,
+      out_new     => OPEN
+    );
+
+    u_aduh_a_verify_res_val : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_a_verify_res_val,
+      dout => mm_aduh_a_verify_res_val
+    );
+  
+    u_aduh_a_verify_res_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_a_verify_res_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_a_verify_res_ack
+    );
+
+    u_aduh_b_verify_res : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_b_verify_res,
+      in_done     => OPEN,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_b_verify_res,
+      out_new     => OPEN
+    );
+
+    u_aduh_b_verify_res_val : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_b_verify_res_val,
+      dout => mm_aduh_b_verify_res_val
+    );
+  
+    u_aduh_b_verify_res_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_b_verify_res_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_b_verify_res_ack
+    );
+    
+    u_aduh_c_verify_res : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_c_verify_res,
+      in_done     => OPEN,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_c_verify_res,
+      out_new     => OPEN
+    );
+
+    u_aduh_c_verify_res_val : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_c_verify_res_val,
+      dout => mm_aduh_c_verify_res_val
+    );
+  
+    u_aduh_c_verify_res_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_c_verify_res_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_c_verify_res_ack
+    );
+    
+    u_aduh_d_verify_res : ENTITY common_lib.common_reg_cross_domain
+    PORT MAP (
+      in_rst      => st_rst,
+      in_clk      => st_clk,
+      in_dat      => st_aduh_d_verify_res,
+      in_done     => OPEN,
+      out_rst     => mm_rst,
+      out_clk     => mm_clk,
+      out_dat     => mm_aduh_d_verify_res,
+      out_new     => OPEN
+    );
+
+    u_aduh_d_verify_res_val : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rst_level => '0'
+    )
+    PORT MAP (
+      rst  => mm_rst,
+      clk  => mm_clk,
+      din  => st_aduh_d_verify_res_val,
+      dout => mm_aduh_d_verify_res_val
+    );
+  
+    u_aduh_d_verify_res_ack : ENTITY common_lib.common_spulse
+    PORT MAP (
+      in_rst    => mm_rst,
+      in_clk    => mm_clk,
+      in_pulse  => mm_aduh_d_verify_res_ack,
+      in_busy   => OPEN,
+      out_rst   => st_rst,
+      out_clk   => st_clk,
+      out_pulse => st_aduh_d_verify_res_ack
+    );
+  END GENERATE;  -- gen_cross
+
+END rtl;
+
diff --git a/libraries/io/aduh/src/vhdl/aduh_quad_scope.vhd b/libraries/io/aduh/src/vhdl/aduh_quad_scope.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..3c5e420329e27b7a8cdedc260450e0b70a2d7450
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_quad_scope.vhd
@@ -0,0 +1,81 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+-- Purpose: Scope component to show the captured quad ADC samples [A,B,C,D] at
+--          the sample rate in the Wave Window
+-- Remark:
+-- . Only for simulation
+
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+USE work.aduh_dd_pkg.ALL;
+
+ENTITY aduh_quad_scope IS
+  GENERIC (
+    -- General
+    g_sim  : BOOLEAN := FALSE;
+    -- ADC Interface
+    g_ai   : t_c_aduh_dd_ai := c_aduh_dd_ai
+  );
+  PORT (
+    -- Sample clock
+    SCLK         : IN STD_LOGIC := '0';  -- sample clk, use only for simulation purposes
+    
+    -- Streaming samples (can be from ADU or from internal WG)
+    sp_sosi_arr  : IN t_dp_sosi_arr(0 TO g_ai.nof_sp-1)  -- = [0:3] = Signal Paths [A,B,C,D]
+  );
+END aduh_quad_scope;
+
+
+ARCHITECTURE beh OF aduh_quad_scope IS
+
+  CONSTANT c_wideband_factor : NATURAL := g_ai.rx_factor * g_ai.dd_factor;   -- Wideband rate factor = 4 for dp_clk is 200 MHz frequency and sample frequency Fs is 800 MHz
+  
+  SIGNAL dp_sosi_arr         : t_dp_sosi_arr(0 TO g_ai.nof_sp-1);     -- = DP [3:0] = ADU Signal Paths [D,C,B,A]
+  
+BEGIN
+
+  -- Reverse wire ADUH range [0:3] = A,B,C,D to DP [3:0] range
+  rewire : FOR I IN 0 TO g_ai.nof_sp-1 GENERATE
+    dp_sosi_arr(I) <= sp_sosi_arr(I);
+  END GENERATE;
+  
+  -- View sp_sosi_arr at the sample rate
+  u_dp_scope : ENTITY dp_lib.dp_wideband_sp_arr_scope
+  GENERIC MAP (
+    g_sim                 => g_sim,
+    g_nof_streams         => g_ai.nof_sp,
+    g_wideband_factor     => c_wideband_factor,
+    g_wideband_big_endian => FALSE,
+    g_dat_w               => g_ai.port_w
+  )
+  PORT MAP (
+    -- Sample clock
+    SCLK         => SCLK,
+    
+    -- Streaming samples
+    sp_sosi_arr  => dp_sosi_arr   -- = [3:0] = Signal Paths [D,C,B,A]
+  );
+  
+END beh;
diff --git a/libraries/io/aduh/src/vhdl/aduh_verify.vhd b/libraries/io/aduh/src/vhdl/aduh_verify.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..4e952c079be422515fab332a80c942faacb8c631
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_verify.vhd
@@ -0,0 +1,249 @@
+--------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+--------------------------------------------------------------------------------
+ 
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.std_logic_1164.ALL;
+USE IEEE.numeric_std.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+
+
+-- Purpose: Verify the adc08d1020 test pattern on ADU for one signal path
+-- Description:
+--   The adc08d1020 has two ADCs I and Q, so it outputs two signal paths. Both
+--   use different test patterns, therefore via pattern_sel one can select
+--   whether to verify for the I or the Q signal path. The test pattern data is
+--   periodic over 10 samples:
+-- 
+--        TP_I TP_Q  TP_OV
+--     T0 02h  01h   0
+--     T1 FDh  FEh   1
+--     T2 02h  01h   0
+--     T3 02h  01h   0
+--     T4 FDh  FEh   1
+--     T5 FDh  FEh   1
+--     T6 02h  01h   0
+--     T7 02h  01h   0
+--     T8 FDh  FEh   1
+--     T9 02h  01h   0
+--
+--   The verification is always ready to accept data, therefore it has no
+--   in_siso.ready output. The verification is always enabled. After reset and
+--   when verify_res_ack pulses then verify_res_val = '0'.
+--   The verification needs two words to initialize its local reference pattern
+--   generator and then the next words can be verified. At the third valid
+--   input word the verify_res_val goes active '1' and remains active until the
+--   next verify_res_ack pulse. If the received data is a mismatch with the
+--   local reference pattern then the verify_res goes high '1' and remains '1'
+--   until the next verify_res_ack pulse.
+--   The verify_res[8] contains the matching result for the aggregate symbol
+--   values, and verify_res[7:0] contains the result per corresponding symbol
+--   bit [7:0]. Via verify_res[7:0] the skew between LVDS input lines can be
+--   measured. Via verify_res[8] it becomes clear whether the skew is
+--   sufficiently small to have an open sampling eye for the entire symbol
+--   value.
+--   The duration of the verification interval depends on verify_res_ack, each
+--   time verify_res_ack pulses a new verification interval starts.
+--
+-- Remarks:
+-- . The overflow bit is not verified
+-- . The TP_I and TP_Q test symbols effectively only contain two values (0x02,
+--   0xFD) or (0x01, 0xFE) respectively. Hence these can be mapped on single
+--   bit values '0' and '1' as is doen via the signal symb.
+-- . The TP_I and TP_Q symbols are verified per bit and for the entire symbol
+--   via the mapped symb signal. The 8 symbol bits and the mapped symb signal 
+--   all have the test pattern of 10 values: 0 1 0 0 1 1 0 0 1 0.
+-- . The data arrives with g_nof_symbols_per_data=4 symbols per data, so a
+--   sequence of two test patterns (2*10 divides by 4) can appear at 10
+--   different phases as:
+--
+--   Phase Pattern     Pattern        Nibble hex values
+--     0   0100 1100 1001 0011 0010 = 4 C 9 3 2
+--     1   1001 1001 0010 0110 0100 = 9 9 2 6 4
+--     2   0011 0010 0100 1100 1001 = 3 2 4 C 9
+--     3   0110 0100 1001 1001 0010 = 6 4 9 9 2
+--     4   1100 1001 0011 0010 0100 = C 9 3 2 4
+--     5   1001 0010 0110 0100 1001 = 9 2 6 4 9
+--     6   0010 0100 1100 1001 0011 = 2 4 C 9 3
+--     7   0100 1001 1001 0010 0110 = 4 9 9 2 6
+--     8   1001 0011 0010 0100 1100 = 9 3 2 4 C
+--     9   0010 0110 0100 1001 1001 = 2 6 4 9 9
+--
+--   Hence for phase 0 to 9 the 4-bit nibbles can either be repeated
+--   <4 C 9 3 2> or <9 9 2 6 4>. E.g. if the first two data words map to 4 C
+--   then the next expected data word is 9. One data word (i.e. 4 symbols of
+--   the 10) is not enough to know the next test pattern data word. Two data
+--   words (i.e. 8 symbols of the 10) are sufficient to know the next test
+--   pattern data word. This is implemented by func_tp_seq in aduh_verify_bit.
+
+
+ENTITY aduh_verify IS
+  GENERIC (
+    g_symbol_w             : NATURAL := 8;   -- Fixed
+    g_nof_symbols_per_data : NATURAL := 4    -- Fixed, big endian in_sosi.data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+  );
+  PORT (
+    rst            : IN  STD_LOGIC;
+    clk            : IN  STD_LOGIC;
+    
+    -- ST input
+    in_sosi        : IN  t_dp_sosi;  -- signal path data with 4 800MHz 8b samples in time per one 32b word @ 200MHz
+                                                             
+    -- Static control input (connect via MM or leave open to use default)
+    pattern_sel    : IN  NATURAL RANGE 0 TO 1 := 0;    -- 0 = DI, 1 = DQ
+    verify_res     : OUT STD_LOGIC_VECTOR(g_symbol_w DOWNTO 0);
+    verify_res_val : OUT STD_LOGIC;
+    verify_res_ack : IN  STD_LOGIC
+  );
+END aduh_verify;
+
+
+ARCHITECTURE rtl OF aduh_verify IS
+
+  CONSTANT c_tp_symbol   : t_slv_8_arr(0 TO 1) := (X"02", X"01");  -- = (I, Q), use patter_sel to select
+  
+  TYPE t_nibble_arr IS ARRAY (INTEGER RANGE <>) OF STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);  -- here use index [0:3] for the big endian nibbles
+  
+  SIGNAL symbols             : t_slv_8_arr(0 TO g_nof_symbols_per_data-1);
+  SIGNAL symb                : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);  -- here use index [0:3] for the big endian nibbles
+  SIGNAL symb_err            : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  SIGNAL bits                : t_nibble_arr(g_symbol_w-1 DOWNTO 0);
+  
+  SIGNAL in_val              : STD_LOGIC;
+  SIGNAL nxt_in_val          : STD_LOGIC;
+  SIGNAL in_symb             : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);  -- here use index [0:3] for the big endian nibbles
+  SIGNAL nxt_in_symb         : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  SIGNAL in_symb_err         : STD_LOGIC;
+  SIGNAL nxt_in_symb_err     : STD_LOGIC;
+  SIGNAL in_bits             : t_nibble_arr(g_symbol_w-1 DOWNTO 0);
+  SIGNAL nxt_in_bits         : t_nibble_arr(g_symbol_w-1 DOWNTO 0);
+  
+BEGIN
+
+  ------------------------------------------------------------------------------
+  -- 1) Prepare the nibble (width g_nof_symbols_per_data) streams for:
+  -- . the aggregate symbol bit (in_symb)
+  -- . the g_symbol_w = 8 individual bits (in_bits)
+  ------------------------------------------------------------------------------
+  
+  p_reg : PROCESS (rst, clk)
+  BEGIN
+    IF rst='1' THEN
+      in_val           <= '0';
+      in_symb          <= (OTHERS=>'0');
+      in_symb_err      <= '1';
+      in_bits          <= (OTHERS=>(OTHERS=>'0'));
+    ELSIF rising_edge(clk) THEN
+      in_val           <= nxt_in_val;
+      in_symb          <= nxt_in_symb;
+      in_symb_err      <= nxt_in_symb_err;
+      in_bits          <= nxt_in_bits;
+    END IF;
+  END PROCESS;
+  
+  p_symbols : PROCESS(in_sosi, pattern_sel)
+  BEGIN
+    FOR I IN 0 TO g_nof_symbols_per_data-1 LOOP
+      -- Big endian symbols in data. After applying the I or Q mask (from c_tp_symbol) the symbol can be 0x00 or 0xFF if it is a test symbol.
+      symbols(I) <= offset_binary(in_sosi.data((g_nof_symbols_per_data-I)*g_symbol_w-1 DOWNTO (g_nof_symbols_per_data-I-1)*g_symbol_w)) XOR c_tp_symbol(pattern_sel);
+    END LOOP;
+  END PROCESS;
+  
+  p_symb : PROCESS(symbols)
+  BEGIN
+    -- If the symbol is a test symbol 0x00 and 0xFF then these result in symb() is '0' and '1' respectively, and with symb_err() = '0'.
+    -- If the symbol is not a test symbol this is indicated via symb_err() = '1'.
+    FOR I IN 0 TO g_nof_symbols_per_data-1 LOOP
+      IF UNSIGNED(symbols(I))=0 THEN
+        symb(I)     <= '0';
+        symb_err(I) <= '0';
+      ELSIF UNSIGNED(symbols(I))=16#FF# THEN
+        symb(I)     <= '1';
+        symb_err(I) <= '0';
+      ELSE
+        symb(I)     <= '0';
+        symb_err(I) <= '1';
+      END IF;
+    END LOOP;
+  END PROCESS;
+  
+  p_bits : PROCESS(symbols)
+  BEGIN
+    FOR I IN g_symbol_w-1 DOWNTO 0 LOOP
+      FOR J IN 0 TO g_nof_symbols_per_data-1 LOOP
+        bits(I)(J) <= symbols(J)(I);
+      END LOOP;
+    END LOOP;
+  END PROCESS;
+  
+  nxt_in_val       <= in_sosi.valid;
+  nxt_in_symb      <= symb;                  -- 1 nibbles stream for the mapped symbols
+  nxt_in_symb_err  <= vector_or(symb_err);
+  nxt_in_bits      <= bits;                  -- 8 nibbles streams, one per symbol bit
+  
+  ------------------------------------------------------------------------------  
+  -- 2) Verify the test pattern for:
+  -- . the aggregate symbol bit (in_symb)
+  -- . the g_symbol_w = 8 individual bits (in_bits)
+  ------------------------------------------------------------------------------  
+  
+  u_verify_symb : ENTITY work.aduh_verify_bit
+  GENERIC MAP (
+    g_nof_symbols_per_data => g_nof_symbols_per_data
+  )
+  PORT MAP (
+    rst            => rst,
+    clk            => clk,
+    
+    -- ST input
+    in_val         => in_val,
+    in_dat         => in_symb,
+    in_dat_err     => in_symb_err,
+                                                             
+    -- Static control input (connect via MM or leave open to use default)
+    verify_res     => verify_res(g_symbol_w),
+    verify_res_val => verify_res_val,
+    verify_res_ack => verify_res_ack
+  );
+  
+  gen_verify : FOR I IN g_symbol_w-1 DOWNTO 0 GENERATE
+    u_bit : ENTITY work.aduh_verify_bit
+    GENERIC MAP (
+      g_nof_symbols_per_data => g_nof_symbols_per_data
+    )
+    PORT MAP (
+      rst            => rst,
+      clk            => clk,
+      
+      -- ST input
+      in_val         => in_val,
+      in_dat         => in_bits(I),
+      in_dat_err     => '0',
+                                                               
+      -- Static control input (connect via MM or leave open to use default)
+      verify_res     => verify_res(I),
+      verify_res_val => OPEN,
+      verify_res_ack => verify_res_ack
+    );
+  END GENERATE;
+  
+END rtl;
diff --git a/libraries/io/aduh/src/vhdl/aduh_verify_bit.vhd b/libraries/io/aduh/src/vhdl/aduh_verify_bit.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..c2fee8c5d9ffaf818a60a5ff1d47d067b661fe17
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/aduh_verify_bit.vhd
@@ -0,0 +1,162 @@
+--------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+--------------------------------------------------------------------------------
+ 
+LIBRARY IEEE, common_lib;
+USE IEEE.std_logic_1164.ALL;
+USE IEEE.numeric_std.ALL;
+USE common_lib.common_pkg.ALL;
+
+
+-- Purpose: Verify the adc08d1020 test pattern 0 1 0 0 1 1 0 0 1 0 per bit
+-- Description:
+--   Used in aduh_verify, see there for explanation
+
+ENTITY aduh_verify_bit IS
+  GENERIC (
+    g_nof_symbols_per_data : NATURAL := 4    -- Fixed, big endian in_sosi.data, t0 in MSsymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+  );
+  PORT (
+    rst            : IN  STD_LOGIC;
+    clk            : IN  STD_LOGIC;
+    
+    -- ST input
+    in_val         : IN  STD_LOGIC;
+    in_dat         : IN  STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+    in_dat_err     : IN  STD_LOGIC := '0';
+                                                             
+    -- Static control input (connect via MM or leave open to use default)
+    verify_res     : OUT STD_LOGIC;
+    verify_res_val : OUT STD_LOGIC;
+    verify_res_ack : IN  STD_LOGIC
+  );
+END aduh_verify_bit;
+
+
+ARCHITECTURE rtl OF aduh_verify_bit IS
+
+  CONSTANT c_nof_init    : NATURAL := 2;   -- need two dat words to initialize the ref_dat
+  
+  TYPE t_state IS (s_init, s_verify);
+
+  FUNCTION func_tp_seq(prev_nibble, nibble : STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS
+  BEGIN
+    IF UNSIGNED(prev_nibble)=16#4# AND UNSIGNED(nibble)=16#C# THEN RETURN TO_UVEC(16#9#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#C# AND UNSIGNED(nibble)=16#9# THEN RETURN TO_UVEC(16#3#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#9# AND UNSIGNED(nibble)=16#3# THEN RETURN TO_UVEC(16#2#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#3# AND UNSIGNED(nibble)=16#2# THEN RETURN TO_UVEC(16#4#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#2# AND UNSIGNED(nibble)=16#4# THEN RETURN TO_UVEC(16#C#, g_nof_symbols_per_data); END IF;
+    
+    IF UNSIGNED(prev_nibble)=16#9# AND UNSIGNED(nibble)=16#9# THEN RETURN TO_UVEC(16#2#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#9# AND UNSIGNED(nibble)=16#2# THEN RETURN TO_UVEC(16#6#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#2# AND UNSIGNED(nibble)=16#6# THEN RETURN TO_UVEC(16#4#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#6# AND UNSIGNED(nibble)=16#4# THEN RETURN TO_UVEC(16#9#, g_nof_symbols_per_data); END IF;
+    IF UNSIGNED(prev_nibble)=16#4# AND UNSIGNED(nibble)=16#9# THEN RETURN TO_UVEC(16#9#, g_nof_symbols_per_data); END IF;
+    
+    RETURN TO_UVEC(0, g_nof_symbols_per_data);  -- else return invalid value
+  END;
+
+  SIGNAL ref_dat             : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  SIGNAL nxt_ref_dat         : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  SIGNAL prev_ref_dat        : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  SIGNAL nxt_prev_ref_dat    : STD_LOGIC_VECTOR(0 TO g_nof_symbols_per_data-1);
+  
+  SIGNAL state               : t_state;
+  SIGNAL nxt_state           : t_state;
+  SIGNAL init_done           : STD_LOGIC;  -- fits NATURAL RANGE 0 TO c_nof_init-1;
+  SIGNAL nxt_init_done       : STD_LOGIC;
+  SIGNAL i_verify_res        : STD_LOGIC;
+  SIGNAL nxt_verify_res      : STD_LOGIC;
+  SIGNAL i_verify_res_val    : STD_LOGIC;
+  SIGNAL nxt_verify_res_val  : STD_LOGIC;
+
+BEGIN
+
+  verify_res     <= i_verify_res;
+  verify_res_val <= i_verify_res_val;
+    
+  p_reg : PROCESS (rst, clk)
+  BEGIN
+    IF rst='1' THEN
+      ref_dat          <= (OTHERS=>'0');
+      prev_ref_dat     <= (OTHERS=>'0');
+      init_done        <= '0';
+      i_verify_res     <= '0';
+      i_verify_res_val <= '0';
+      state            <= s_init;
+    ELSIF rising_edge(clk) THEN
+      ref_dat          <= nxt_ref_dat;
+      prev_ref_dat     <= nxt_prev_ref_dat;
+      init_done        <= nxt_init_done;
+      i_verify_res     <= nxt_verify_res;
+      i_verify_res_val <= nxt_verify_res_val;
+      state            <= nxt_state;
+    END IF;
+  END PROCESS;
+  
+  
+  p_state : PROCESS(ref_dat, prev_ref_dat, init_done, i_verify_res, i_verify_res_val, state, in_val, in_dat_err, in_dat, verify_res_ack)
+  BEGIN
+    nxt_ref_dat        <= ref_dat;
+    nxt_prev_ref_dat   <= prev_ref_dat;
+    nxt_init_done      <= init_done;
+    nxt_verify_res     <= i_verify_res;
+    nxt_verify_res_val <= i_verify_res_val;
+    nxt_state          <= state;
+    
+    IF state=s_init THEN
+      IF in_val='1' THEN
+        IF in_dat_err='1' THEN
+          nxt_verify_res <= '1';   -- if the first two data word already contain incorrect pattern symbols
+        END IF;
+        IF init_done='0' THEN
+          nxt_ref_dat   <= in_dat;
+          nxt_init_done <= '1';    -- init done because c_nof_init-1 = 1 valid in_dat have been received
+        ELSE
+          nxt_prev_ref_dat   <= in_dat;  -- prepare prev_ref_dat and ref_dat for next in_dat
+          nxt_ref_dat        <= func_tp_seq(ref_dat, in_dat);
+          nxt_verify_res_val <= '1';
+          nxt_state          <= s_verify;
+        END IF;
+      END IF;
+    ELSE  -- state = s_verify
+      IF verify_res_ack='1' THEN
+        -- prepare for new verification interval
+        nxt_init_done      <= '0';
+        nxt_verify_res     <= '0';
+        nxt_verify_res_val <= '0';
+        nxt_state          <= s_init;
+      ELSE
+        -- update verify_res during this verification interval
+        -- . operate independent of in_val='1', because the ADC data is continous
+        nxt_prev_ref_dat <= ref_dat;  -- prepare prev_ref_dat and prev_ref_dat for next in_dat
+        nxt_ref_dat      <= func_tp_seq(prev_ref_dat, ref_dat);
+        IF in_dat_err='1' THEN
+          nxt_verify_res <= '1';   -- capture incorrect pattern symbols
+        END IF;
+        IF UNSIGNED(in_dat)/=UNSIGNED(ref_dat) THEN
+          nxt_verify_res <= '1';   -- capture incorrect pattern sequence
+        END IF;
+      END IF;
+    END IF;
+  END PROCESS;
+  
+END rtl;
diff --git a/libraries/io/aduh/src/vhdl/lvdsh_dd.vhd b/libraries/io/aduh/src/vhdl/lvdsh_dd.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..23ab7f6676965194a3468ed0cba6598a3964c213
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/lvdsh_dd.vhd
@@ -0,0 +1,391 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2010
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+
+-- Purpose: Handle an double data rate input interface without using a PLL
+-- Description:
+--   The in_clk is a double data rate clock. The DDIO elements near the pins
+--   capture the in_dat using the out_clk into two parts out_dat_hi and
+--   out_dat_lo. The nominal data rate out_clk is the delayed in_clk. The
+--   double width output data out_dat_hi and out_dat_lo are available at the
+--   output, but can also be read via a FIFO.
+--   Dependend on g_rx_factor the FIFO rx_clk can run at the same rate as the
+--   out_clk (= delayed in_clk) or at a lower rate. The rx_clk must be locked
+--   to the in_clk or relatively faster to avoid FIFO overflow.
+--   With ADU the in_clk is the 800M sample clock divided by 2 and the rx_clk
+--   is the sample clock divided by 4. The phase of the in_clk depends on the
+--   divider phase of the ADC and can be set by in_clk_rst. The phase of the
+--   rx_clk with respect to the in_clk depends on the divide by 2 that is done
+--   by the mixed width FIFO and can be set by wr_fifo_rst.
+--   The in_clk and the rx_clk have a fixed but unknown phase relation. It is
+--   important to maintain this phase relation inside the FPGA. This is taken
+--   care of thanks to:
+--   . the synchronous clock tree network inside an FPGA that is balanced such
+--     that the clock has the same phase at any location in the FPGA
+--   . using a DDIO register near the pin to output in_clk_rst
+--   . using a LogicLock region constraint on u_acapture to have a fixed timing
+--     of wr_fifo_rst
+-- Remarks:
+-- . The input data and clock can be delayed via the g_in_dat_delay_arr and
+--   g_in_clk_delay generics. For the Stratix4 the delay can be 0..15 steps of
+--   50 ps via delay element D1 in the IO input buffer. If the input buffer
+--   supports dynamic delay configuration via MM interface then that requires
+--   using the config_clk. The common_iobuf_in then needs to support the
+--   generic delay setting as input signals. For the UniBoard back nodes it
+--   appears that not all in_dat input buffers support config_clk. Therefore
+--   instead of using the generics the input buffer delays are set via 
+--   constraints in the synthesis file.
+-- . Default the rx_dat output is little endian meaning that the first input
+--   data appears in the LSpart. Use g_rx_big_endian=TRUE to have big endian
+--   rx_dat conform the streaming interface data.
+    
+ENTITY lvdsh_dd IS
+  GENERIC (
+    g_dd_factor         : NATURAL := 2;      -- = 2, fixed double data rate factor
+    g_in_dat_w          : NATURAL := 16;     -- nof PHY data bits
+    g_in_dat_delay_arr  : t_natural_arr := array_init(0, 16);  -- nof must match g_in_dat_w
+    g_in_clk_delay      : NATURAL := 0;
+    g_in_clk_rst_invert : BOOLEAN := FALSE;
+    g_use_in_delay      : BOOLEAN := FALSE;
+    g_rx_big_endian     : BOOLEAN := FALSE;
+    g_rx_factor         : NATURAL := 1;      -- 1, 2, 4, ... must be a power of 2 because of the mixed width FIFO
+    g_rx_fifo_size      : NATURAL := 32;     -- see common_fifo_dc_lock_control for comment
+    g_rx_fifo_fill      : NATURAL := 16;     -- see common_fifo_dc_lock_control for comment
+    g_rx_fifo_margin    : NATURAL := 0       -- use 0, 1 independend of g_rx_factor, because the mixed width FIFO (g_rx_factor > 1) goes from narrow wr to wide rx, so +-1 is enough for wide side.
+  );
+  PORT (
+    -- PHY input delay config clock
+    config_rst    : IN  STD_LOGIC := '1';
+    config_clk    : IN  STD_LOGIC := '1';
+    config_done   : OUT STD_LOGIC;
+    
+    -- PHY input interface
+    in_clk        : IN  STD_LOGIC;
+    in_dat        : IN  STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- sample [t0], [t1], [t2], [t3], [t4], [t5], [t6], [t7], ... --> time
+    in_clk_rst    : OUT STD_LOGIC;
+    
+    -- DD domain output interface (no FIFO)
+    out_clk       : OUT STD_LOGIC;
+    out_dat_hi    : OUT STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- sample [t1], [t3], [t5], [t7], ...
+    out_dat_lo    : OUT STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- sample [t0], [t2], [t4], [t6], ...
+    
+    -- DD --> Rx domain interface at in_clk rate or g_rx_factor lower rate (via FIFO)
+    rx_rst        : IN  STD_LOGIC := '1';
+    rx_clk        : IN  STD_LOGIC := '1';                                                 -- default little endian rx_dat output:
+    rx_dat        : OUT STD_LOGIC_VECTOR(g_rx_factor*g_dd_factor*g_in_dat_w-1 DOWNTO 0);  -- . sample [t1, t0], [t3, t2], [t5, t4], [t7, t6],  ... when g_rx_factor = 1
+    rx_val        : OUT STD_LOGIC;                                                        -- . sample [t3, t2, t1, t0],   [t7, t6, t5, t4],    ... when g_rx_factor = 2
+    
+    -- Rx FIFO control
+    rx_locked     : OUT STD_LOGIC;
+    rx_stable     : OUT STD_LOGIC;
+    rx_stable_ack : IN  STD_LOGIC := '0'
+  );
+END lvdsh_dd;
+
+
+ARCHITECTURE str OF lvdsh_dd IS
+
+  CONSTANT c_rx_fifo_lsusedw_w  : NATURAL := true_log2(g_rx_factor);      -- nof least significant bits of wrusedw that are skipped for rdusedw due to parallelization by g_rx_factor
+  CONSTANT c_rx_fifo_rdusedw_w  : NATURAL := ceil_log2(g_rx_fifo_size);
+  CONSTANT c_rx_fifo_wrusedw_w  : NATURAL := c_rx_fifo_rdusedw_w + c_rx_fifo_lsusedw_w;
+
+  CONSTANT c_in_dly_w        : NATURAL := 1 + g_in_dat_w;                                                    -- 1 extra for the in_clk
+  CONSTANT c_in_delay_arr    : t_natural_arr(c_in_dly_w-1 DOWNTO 0) := g_in_clk_delay & g_in_dat_delay_arr;  -- [16, 15:0]
+  
+  CONSTANT c_out_dat_w       : NATURAL := g_dd_factor*g_in_dat_w;  -- hi & lo
+  
+  -- DD clock domain (in_clk = wr_clk = out_clk)
+  SIGNAL in_vec              : STD_LOGIC_VECTOR(c_in_dly_w-1 DOWNTO 0);
+  SIGNAL in_dly              : STD_LOGIC_VECTOR(c_in_dly_w-1 DOWNTO 0);
+
+  SIGNAL wr_clk              : STD_LOGIC;
+  SIGNAL wr_dat_hi           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+  SIGNAL wr_dat_lo           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+  
+  SIGNAL fifo_wr_ful         : STD_LOGIC;
+  SIGNAL fifo_wr_req         : STD_LOGIC := '0';
+  SIGNAL fifo_wr_dat         : STD_LOGIC_VECTOR(c_out_dat_w-1 DOWNTO 0);  -- hi & lo
+  SIGNAL nxt_fifo_wr_dat     : STD_LOGIC_VECTOR(c_out_dat_w-1 DOWNTO 0);  -- hi & lo
+  
+  -- Cross clock domains from wr_clk to rd_clk
+  SIGNAL fifo_wrusedw        : STD_LOGIC_VECTOR(c_rx_fifo_wrusedw_w-1 DOWNTO 0);  -- wr_clk domain
+  SIGNAL fifo_rdusedw        : STD_LOGIC_VECTOR(c_rx_fifo_rdusedw_w-1 DOWNTO 0);  -- wr_clk domain
+  SIGNAL rx_fifo_rdusedw     : STD_LOGIC_VECTOR(c_rx_fifo_rdusedw_w-1 DOWNTO 0);  -- rd_clk domain
+  
+  -- Cross clock domains from rd_clk to wr_clk
+  SIGNAL wr_clk_rst          : STD_LOGIC_VECTOR(0 DOWNTO 0);  -- rd_clk domain
+  SIGNAL rx_clk_rst          : STD_LOGIC_VECTOR(0 DOWNTO 0);  -- rd_clk domain
+  SIGNAL i_in_clk_rst        : STD_LOGIC_VECTOR(0 DOWNTO 0);  -- wr_clk domain
+  
+  SIGNAL dc_fifo_rst         : STD_LOGIC;  -- rd_clk domain
+  SIGNAL wr_fifo_rst         : STD_LOGIC;  -- wr_clk domain
+  
+  -- Rx clock domain (rx_clk = rd_clk) for DSP
+  SIGNAL rx_fifo_rd_req      : STD_LOGIC;
+  SIGNAL rx_fifo_rd_dat      : STD_LOGIC_VECTOR(rx_dat'RANGE);
+  
+BEGIN
+  
+  -----------------------------------------------------------------------------
+  -- Optional input buffer delay control via generic
+  -----------------------------------------------------------------------------
+  
+  -- Input delay
+  in_vec <= in_clk & in_dat;  -- [16, 15:0]
+
+  gen_in_dly : IF g_use_in_delay=TRUE GENERATE
+    u_buf_in : ENTITY common_lib.common_iobuf_in
+    GENERIC MAP (
+      g_width     => c_in_dly_w,
+      g_delay_arr => c_in_delay_arr
+    )
+    PORT MAP (
+      config_rst  => config_rst,
+      config_clk  => config_clk,
+      config_done => config_done,
+      in_dat      => in_vec,
+      out_dat     => in_dly
+    );
+  END GENERATE;
+  
+  no_in_dly : IF g_use_in_delay=FALSE GENERATE
+    -- Define the required input delay via the fitter assignment settings
+    config_done <= '1';
+    in_dly      <= in_vec;
+  END GENERATE;
+  
+  
+  -----------------------------------------------------------------------------
+  -- Register double data rate input data
+  -----------------------------------------------------------------------------
+  
+  -- Input double data rate at pin, also ensures deterministic input timing
+  u_dd_in : ENTITY common_lib.common_ddio_in
+  GENERIC MAP (
+    g_width    => g_in_dat_w
+  )
+  PORT MAP (
+    in_dat      => in_dly(c_in_dly_w-2 DOWNTO 0),
+    in_clk      => in_dly(c_in_dly_w-1),
+    in_clk_en   => '1',
+    rst         => '0',
+    out_dat_hi  => wr_dat_hi,
+    out_dat_lo  => wr_dat_lo
+  );
+  
+  
+  -----------------------------------------------------------------------------
+  -- Reset in_clk from rx_clk domain
+  -----------------------------------------------------------------------------
+  
+  -- Use output register at pin for in_clk_rst to ensure deterministic output timing
+  rx_clk_rst(0) <= wr_clk_rst(0) WHEN g_in_clk_rst_invert=FALSE ELSE NOT wr_clk_rst(0);
+  
+  u_dd_out : ENTITY common_lib.common_ddio_out
+  GENERIC MAP (
+    g_width  => 1
+  )
+  PORT MAP (
+    rst        => '0',
+    in_clk     => rx_clk,
+    in_clk_en  => '1',
+    in_dat_hi  => rx_clk_rst,
+    in_dat_lo  => rx_clk_rst,
+    out_dat    => i_in_clk_rst
+  );
+  
+  in_clk_rst  <= i_in_clk_rst(0);
+  
+  
+  -----------------------------------------------------------------------------
+  -- Register release of dc_fifo_rst into the wr_clk domain with 'fixed' delay
+  -----------------------------------------------------------------------------
+  
+  -- Use a LogicLock region of 1 LAB on this instance to avoid variation in placement, in order to achieve a sufficiently 'fixed' data delay
+  -- between the two clock domains that does not vary dependent on the size of the rest of the design.
+  
+  u_acapture_fifo_rst : ENTITY common_lib.common_acapture
+  GENERIC MAP (
+    g_rst_level     => '1',
+    g_in_delay_len  => 1,
+    g_out_delay_len => 1
+  )
+  PORT MAP (
+    in_rst  => dc_fifo_rst,  -- need to apply dc_fifo_rst asynchronously to reset rd_usedw in case of dc lock lost due to stopped wr_clk
+    in_clk  => rx_clk,
+    in_dat  => '0',          -- connecting '0' is equivalent to connecting dc_fifo_rst
+    out_clk => wr_clk,
+    out_cap => wr_fifo_rst
+  );  
+  
+  
+  -----------------------------------------------------------------------------
+  -- Register wrusedw into the rd_clk domain with 'fixed' delay
+  -----------------------------------------------------------------------------
+  
+  -- Use a LogicLock region of 1 LAB on this instance to avoid variation in placement, in order to achieve a sufficiently 'fixed' data delay
+  -- between the two clock domains that does not vary dependent on the size of the rest of the design.
+  
+  -- Can not use the rdusedw from the FIFO, because for that the path delay depends on the size of the rest of the design. The common_acapture_slv
+  -- registers the wrused into FF0 with the wr_clk and captures it with the rd_clk into FF1. For g_rx_factor>1 the LSBit(s) of the captured
+  -- wrusedw can be ignored, e.g. for g_rx_factor=2 bit 0 is always '0'. By using one FF0 the timing of the rd_clk with respect to the wr_usedw(h:1)
+  -- is such that the eye-window has maximum size. Using an even number of FF0 would make the rd_clk sample the wr_usedw(h:1) closer to the edge
+  -- of the eye.
+  
+  u_acapture_slv_fifo_rdusedw : ENTITY common_lib.common_acapture_slv
+  GENERIC MAP (
+    g_rst_level     => '0',
+    g_in_delay_len  => 1,
+    g_out_delay_len => 1
+  )
+  PORT MAP (
+    in_rst  => wr_fifo_rst,
+    in_clk  => wr_clk,
+    in_dat  => fifo_rdusedw,
+    out_clk => rx_clk,
+    out_cap => rx_fifo_rdusedw
+  );
+  
+  
+  ------------------------------------------------------------------------------
+  -- Output direct at input clock rate and double width
+  ------------------------------------------------------------------------------
+  
+  wr_clk <= in_dly(c_in_dly_w-1);
+  
+  out_clk    <= wr_clk;
+  out_dat_hi <= wr_dat_hi;
+  out_dat_lo <= wr_dat_lo;
+  
+  
+  ------------------------------------------------------------------------------
+  -- Output via FIFO at same clock rate or at lower clock rate in rx_clk domain
+  ------------------------------------------------------------------------------
+  
+  -- Register fifo_wr_dat to ease timing closure between DDIO and FIFO at input clock rate
+  nxt_fifo_wr_dat <= wr_dat_hi & wr_dat_lo;
+  
+  u_dd_reg : ENTITY common_lib.common_pipeline
+  GENERIC MAP (
+    g_pipeline    => 1,
+    g_in_dat_w    => c_out_dat_w,
+    g_out_dat_w   => c_out_dat_w
+  )
+  PORT MAP (
+    clk     => wr_clk,
+    in_dat  => nxt_fifo_wr_dat,
+    out_dat => fifo_wr_dat
+  );
+  
+  
+  -- Input FIFO dual clock lock control
+  u_fifo_dc_lock_control : ENTITY common_lib.common_fifo_dc_lock_control
+  GENERIC MAP (
+    g_hold_wr_clk_rst  => 2,   -- >= 1, nof cycles to hold the wr_clk_rst
+    g_hold_dc_fifo_rst => 31,  -- >= 1, nof cycles to hold the dc_fifo_rst, sufficiently long for wr_clk to have restarted after wr_clk_rst release
+    g_rd_fill_level    => g_rx_fifo_fill,
+    g_rd_fill_margin   => g_rx_fifo_margin
+  )
+  PORT MAP (
+    -- FIFO rd_clk domain
+    rd_rst        => rx_rst,
+    rd_clk        => rx_clk,
+    rd_usedw      => rx_fifo_rdusedw,
+    rd_req        => rx_fifo_rd_req,
+    wr_clk_rst    => wr_clk_rst(0),
+    dc_fifo_rst   => dc_fifo_rst,
+    
+    -- MM in rd_clk domain
+    rd_fill_level => g_rx_fifo_fill,
+    dc_locked     => rx_locked,
+    dc_stable     => rx_stable,
+    dc_stable_ack => rx_stable_ack
+  );  
+
+  
+  -- No need to check on fifo_wr_ful for fifo_wr_req, because wr_init in common_fifo_dc* takes care that fifo_wr_req is only passed on after fifo_wr_ful went low after reset release.
+  fifo_wr_req <= '1';
+  
+  -- Dual clock FIFO, same width
+  gen_same_rate : IF g_rx_factor = 1 GENERATE
+    u_fifo_dc : ENTITY common_lib.common_fifo_dc
+    GENERIC MAP (
+      g_dat_w     => c_out_dat_w,
+      g_nof_words => g_rx_fifo_size
+    )
+    PORT MAP (
+      rst     => wr_fifo_rst,
+      wr_clk  => wr_clk,
+      wr_dat  => fifo_wr_dat,
+      wr_req  => fifo_wr_req,
+      wr_ful  => fifo_wr_ful,
+      wrusedw => fifo_wrusedw,
+      rd_clk  => rx_clk,
+      rd_dat  => rx_fifo_rd_dat,
+      rd_req  => rx_fifo_rd_req,
+      rd_emp  => OPEN,
+      rdusedw => OPEN,  -- instead use wrusedw via common_acapture_slv
+      rd_val  => rx_val
+    );
+    
+    fifo_rdusedw <= fifo_wrusedw;
+  END GENERATE;
+  
+  -- Dual clock FIFO, mixed width
+  gen_lower_rate : IF g_rx_factor > 1 GENERATE
+    u_fifo_n2w : ENTITY common_lib.common_fifo_dc_mixed_widths
+    GENERIC MAP (
+      g_nof_words => g_rx_fifo_size * g_rx_factor,  -- FIFO size in nof wr_dat words
+      g_wr_dat_w  => c_out_dat_w,
+      g_rd_dat_w  => c_out_dat_w * g_rx_factor
+    )
+    PORT MAP (
+      rst     => wr_fifo_rst,
+      wr_clk  => wr_clk,
+      wr_dat  => fifo_wr_dat,
+      wr_req  => fifo_wr_req,
+      wr_ful  => fifo_wr_ful,
+      wrusedw => fifo_wrusedw,
+      rd_clk  => rx_clk,
+      rd_dat  => rx_fifo_rd_dat,
+      rd_req  => rx_fifo_rd_req,
+      rd_emp  => OPEN,
+      rdusedw => OPEN,  -- instead use wrusedw via common_acapture_slv
+      rd_val  => rx_val
+    );
+    
+    fifo_rdusedw <= fifo_wrusedw(fifo_wrusedw'HIGH DOWNTO c_rx_fifo_lsusedw_w);
+  END GENERATE;
+  
+  gen_little_endian : IF g_rx_big_endian=FALSE GENERATE
+    rx_dat <= rx_fifo_rd_dat;
+  END GENERATE;
+  
+  gen_big_endian : IF g_rx_big_endian=TRUE GENERATE
+    rx_dat <= hton(rx_fifo_rd_dat, g_in_dat_w, g_rx_factor*g_dd_factor);  -- rewire
+  END GENERATE;
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4.vhd b/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..cea6d8446bf45e2f210bc96d8018d1f0c6777c71
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4.vhd
@@ -0,0 +1,767 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2014
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+
+-- Purpose: Detect the wide band factor phase 0, 1, 2 or 3 of the 200 MHz
+--          dp_clk using the rising and falling edge of the double data rate
+--          400 MHz in_clk clock.
+-- Description:
+--   The edges of the in_clk occur at the 800 MHz sample rate of the ADC. The
+--   in_clk is a double data rate (DDR) 400 MHz clock as indicated by
+--   c_dd_factor=2. The DDIO elements near the pins capture the in_dat using
+--   the in_clk into two  parts in_dat_hi and in_dat_lo.
+--   The dp_clk runs at a c_rx_factor=2 lower rate than the in_clk so at 200
+--   MHz. The dp_clk is locked to the in_clk. The dp_clk phase detector detects
+--   the g_wb_factor=4 sample phase uncertainty that can occur between the 
+--   sample clock and the processing clock. With ADU the in_clk is the 800M
+--   sample clock divided by c_dd_factor=2 and the dp_clk is the sample clock
+--   divided by g_wb_factor=4.
+--   The phase of the in_clk depends on the divider phase of the ADC. The phase
+--   of the dp_clk with respect to the in_clk depends on the divide by 2 that
+--   packs the dual sample words of the single data rate (SDR) rising edge
+--   in_clk domain into 4 sample words for the dp_clk domain. The in_clk and
+--   the dp_clk have a fixed but unknown phase relation between 0 and 3 = 
+--   g_wb_factor-1 samples.
+--   The sample phase alignment within a g_wb_factor=4 sample word is done by
+--   lvdsh_dd_phs4_align. After that the word phase is also aligned by
+--   adjusting the latency between wb_sync and dp_sync which. 
+--   Both the sample phase alignment and the word phase alignment use the
+--   dp_phs_clk as reference. For the sample phase alignment within a word the
+--   dp_phs_clk could run at the same 200 MHz rate as the dp_clk. However to
+--   support a word latency of about 16 dp_clk cycles the dp_phs_clk are
+--   divided by 32 at the PLL and only their rising edge is used to do the
+--   alignments.
+--   The g_nof_dp_phs_clk>= 1 and maximum 6. When g_nof_dp_phs_clk=6 then 
+--   typically each dp_phs_clk is shifted by 11.25 or 22.5 degrees where 90
+--   degrees corresponds to 1.25 ns so 1 800MHz sample or a quarter dp_clk
+--   period. By selecting one suitable out of a range of phase shifted
+--   dp_phs_clk it is possible to find a proper dp_phs_clk reference for all
+--   signal paths in the different nodes.
+--   The whole sample phase realingment scheme relies on fixed clock
+--   distribution delays on the boards and in the FPGA. Therefore a clock tree
+--   network is used for the dp_phs_clk as well, even though the dp_phs_clk
+--   does not clock any logic. The dp_phs_clk gets sampled by the dp_clk to
+--   get wb_sync and by the in_clk to get dd_sync. The assumption is that the
+--   setup time for this signal is small and nearly constant independent of
+--   the size of the design and independent of the clock trees that are used.
+--   The dd_sync is passed on to the dp_clk domain via a dual clock FIFO to
+--   become dp_sync.
+-- Remark:
+-- . Support fixed raw data mode via g_nof_dp_phs_clk=0.
+-- . Support dynamic MM selection between realigned data mode and raw data
+--   mode via r_dp.dp_phs_align_en that depends on dp_phs_clk_en_vec/=0.
+-- . The maximum g_nof_dp_phs_clk=6 because otherwise it does not fit in PLL_L3
+--   that is near the input CLK pin. It seems preferable to use PLL_L3 with
+--   CLK pin rather than a more remote PLL.
+-- . The 6 dp_phs_clk at 200/32 MHz do not take extra power (< 0.1W) as was
+--   measured for 4 BN on a UniBoard.
+-- . On the Apertif subrack hardware with 16 BN and 8 ADU (so 64 SP = signal
+--   paths) stable lock is always found and delta of 2 samples or multiple
+--   of 4 samples (= 1 word @ 200MHz) between signal paths do not occur.
+--   However there can still occur delta of 1 sample between signal paths. It
+--   is important that the selected dp_phs_clk_vec phase always falls in the
+--   same sample period, because otherwise there arises again an uncertainty
+--   of 1 sample in the sample phase. A suitable ADU lock mechanism may be
+--   either:
+--   1) using 2 phase clocks with delta 22.5 degrees and that the phase is
+--      found automatically, or
+--   2) using 4 or 6 phase clocks with delta 22.5 or 11.25 degrees to cover
+--      an entire sample period and via MM control one phase is selected per
+--      BN- ADU pair. The MM control is then needed to select always the same
+--      phase in case not always the same phase is found automatically.
+    
+ENTITY lvdsh_dd_phs4 IS
+  GENERIC (
+    g_sim                : BOOLEAN := FALSE;
+    g_wb_factor          : NATURAL := 4;      -- fixed wideband factor 4 = c_rx_factor*c_dd_factor
+    g_dp_phs_clk_period  : NATURAL := 32;     -- number of dp_clk periods per dp_phs_clk period, must match g_clk*_divide_by in unb_clk200_pll
+    g_nof_dp_phs_clk     : NATURAL := 2;      -- nof dp_phs_clk that can be used to detect lock
+    g_wb_use_rising_edge : BOOLEAN := FALSE;  -- when TRUE using rising edge of dp_clk domain to capture wb_sync as reference for dp_sync from in_clk domain, else use falling edge
+    g_in_dat_w           : NATURAL := 8       -- nof PHY data bits
+  );
+  PORT (
+    -- PHY input interface
+    in_clk               : IN  STD_LOGIC := '1';
+    in_dat               : IN  STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t0], [t1], [t2], [t3], [t4], [t5], [t6], [t7], ... --> time
+    
+    -- DD --> Rx domain interface at in_clk rate or g_wb_factor lower rate (via FIFO)
+    dp_rst               : IN  STD_LOGIC := '1';
+    dp_clk               : IN  STD_LOGIC := '1';
+    dp_phs_clk_vec       : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+    dp_phs_clk_en_vec    : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);  -- only the enabled dp_phs_clk will be used
+    dp_dat               : OUT STD_LOGIC_VECTOR(g_wb_factor*g_in_dat_w-1 DOWNTO 0);   -- big endian output samples [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    dp_val               : OUT STD_LOGIC;
+    
+    -- Rx status monitor
+    out_status           : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);     -- extra status information for debug
+    out_phs_locked       : OUT STD_LOGIC;
+    out_word_locked      : OUT STD_LOGIC;
+    out_word_stable      : OUT STD_LOGIC;
+    out_word_stable_ack  : IN  STD_LOGIC := '0'
+  );
+END lvdsh_dd_phs4;
+
+
+ARCHITECTURE str OF lvdsh_dd_phs4 IS
+
+  CONSTANT c_word_align_en          : BOOLEAN := TRUE;
+
+  CONSTANT c_dd_factor              : NATURAL := 2;                       -- fixed double data rate factor
+  CONSTANT c_rx_factor              : NATURAL := 2;                       -- fixed for g_wb_factor = c_rx_factor*c_dd_factor = 4
+  CONSTANT c_dp_phs_align_en        : BOOLEAN := g_nof_dp_phs_clk>0;      -- if there are no dp_phs_clk then fall back to raw data mode
+  CONSTANT c_nof_dp_phs_clk         : NATURAL := sel_a_b(c_dp_phs_align_en, g_nof_dp_phs_clk, 1);  -- map to dummy 1 when g_nof_dp_phs_clk=0 to avoid compile error on NATURAL RANGE 0 TO -1
+  
+  CONSTANT c_in_period_w            : NATURAL := 3;                       -- large enough to account for dd_factor and small to be able to detect short in_clk inactive period
+  CONSTANT c_dp_detect_period       : NATURAL := 2**c_in_period_w / c_dd_factor;
+  
+  CONSTANT c_raw_phs_w              : NATURAL := g_wb_factor;             -- = 4 * 1b = 4b
+  CONSTANT c_sync_w                 : NATURAL := 1;
+  CONSTANT c_dp_dat_w               : NATURAL := g_wb_factor*g_in_dat_w;  -- = 4 * 8b = 32b
+  CONSTANT c_fifo_dat_w             : NATURAL := c_raw_phs_w + c_sync_w + c_dp_dat_w;
+  CONSTANT c_fifo_size              : NATURAL := 256;                     -- 36b * 256 = 1 M9K
+  CONSTANT c_fifo_size_w            : NATURAL := ceil_log2(c_fifo_size);
+  CONSTANT c_fifo_wr_pipeline       : NATURAL := 1;  -- 0 or 1 optionally to pipeline FIFO wr_req to have mor margin with dp_clk edge
+  CONSTANT c_in_rst_delay_len       : NATURAL := 16;
+  CONSTANT c_delay_len              : NATURAL := c_meta_delay_len;
+  CONSTANT c_word_req_lat           : NATURAL := 4;
+  CONSTANT c_dp_phs_align_restart_w : NATURAL := 5;
+  
+  CONSTANT c_in_dd_phs_locked_w     : NATURAL := sel_a_b(g_sim, 12, 25);    -- used to ensure that dd_phs_locked is only declared if dd_phs is detected ok for at least 2**(g_dd_phs_locked_w-1) in_clk cycles
+  CONSTANT c_dp_dd_phs_timeout_w    : NATURAL := c_in_dd_phs_locked_w + 0;  -- dd_phs locked timeout in dp_clk domain, use c_dd_factor longer or more than c_in_dd_phs_locked_w
+  CONSTANT c_wb_sync_offset         : INTEGER := g_dp_phs_clk_period/2;
+  CONSTANT c_wb_sync_delta          : INTEGER := 0;                         -- use c_wb_sync_offset for default FIFO fill level and c_wb_sync_delta < 0 or > 0 to decrease or increase it somewhat
+  CONSTANT c_wb_sync_latency        : NATURAL := c_wb_sync_offset + c_wb_sync_delta;  -- nof dp_clk cycles from getting wb_sync back via dp_sync
+  CONSTANT c_wb_sync_period         : NATURAL := g_dp_phs_clk_period;                 -- nof dp_clk cycles for wb_sync period, must be > c_wb_sync_latency
+  CONSTANT c_wb_cnt_w               : NATURAL := ceil_log2(c_wb_sync_period);
+  CONSTANT c_wb_fifo_latency        : NATURAL := c_wb_sync_latency-9;       -- estimated FIFO fill level based on simulation and measurement on hardware (6, 7 and 8 occur)
+  CONSTANT c_wb_fifo_fill_margin    : NATURAL := 2;                         -- some symmetrical FIFO filled margin >= 0, use 0 in theory, use 1 to allow some timing uncertainty in rdusedw of dual clock FIFO
+  CONSTANT c_wb_fifo_fill_margin_p  : NATURAL := c_wb_fifo_fill_margin;                      -- some FIFO more filled margin >= 0, use 0 or 1 to allow 8 and 9
+  CONSTANT c_wb_fifo_fill_margin_n  : NATURAL := c_wb_fifo_fill_margin;                      -- some FIFO less filled margin >= 0, use 1 or 2 to allow 7 and 6
+  CONSTANT c_wb_fifo_fill_max       : NATURAL := c_wb_fifo_latency+c_wb_fifo_fill_margin_p;  -- maximum FIFO fill level at any time
+  CONSTANT c_wb_fifo_fill_min       : NATURAL := c_wb_fifo_latency-c_wb_fifo_fill_margin_n;  -- minimum FIFO fill level during lock
+  
+  -- view debug signals in Wave Window
+  SIGNAL dbg_c_dp_phs_align_en      : BOOLEAN := c_dp_phs_align_en;
+  SIGNAL dbg_c_wb_sync_latency      : NATURAL := c_wb_sync_latency;
+  SIGNAL dbg_c_wb_fifo_fill_max     : NATURAL := c_wb_fifo_fill_max;
+  SIGNAL dbg_c_wb_fifo_latency      : NATURAL := c_wb_fifo_latency;
+  SIGNAL dbg_c_wb_fifo_fill_min     : NATURAL := c_wb_fifo_fill_min;
+  
+  -- in_clk domain
+  TYPE t_in_reg IS RECORD
+    -- data with realignment
+    dd_sync_locked      : STD_LOGIC;
+    -- data without realignment
+    in_dat_hi           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+    in_dat_lo           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+    dd_in_data          : STD_LOGIC_VECTOR(c_dp_dat_w-1 DOWNTO 0);
+    dd_in_val           : STD_LOGIC;
+    -- write FIFO
+    fifo_wr_dat         : STD_LOGIC_VECTOR(c_fifo_dat_w-1 DOWNTO 0);
+    fifo_wr_dat_p       : STD_LOGIC_VECTOR(c_fifo_dat_w-1 DOWNTO 0);
+    fifo_wr_req         : STD_LOGIC;
+    fifo_wr_req_p       : STD_LOGIC;
+  END RECORD;
+  
+  SIGNAL in_rst              : STD_LOGIC;
+  SIGNAL in_fifo_wr_dat      : STD_LOGIC_VECTOR(c_fifo_dat_w-1 DOWNTO 0);
+  SIGNAL in_fifo_wr_req      : STD_LOGIC;
+  SIGNAL in_phs_align_en     : STD_LOGIC;
+  
+  SIGNAL r_in                : t_in_reg;
+  SIGNAL nxt_r_in            : t_in_reg;
+  
+  SIGNAL in_dat_hi           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t1], [t3], [t5], [t7], ... --> time
+  SIGNAL in_dat_lo           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t0], [t2], [t4], [t6], ... --> time
+  
+  SIGNAL raw_phs             : STD_LOGIC_VECTOR(g_wb_factor-1 DOWNTO 0);  -- measured dd phase before realignment
+  SIGNAL dd_phs_locked       : STD_LOGIC;
+  SIGNAL dd_sync             : STD_LOGIC_VECTOR(g_wb_factor-1 DOWNTO 0);
+  SIGNAL dd_sync_sl          : STD_LOGIC;
+  SIGNAL dd_dat              : STD_LOGIC_VECTOR(c_dp_dat_w-1 DOWNTO 0);
+  SIGNAL dd_val              : STD_LOGIC;
+    
+  SIGNAL fifo_wrusedw        : STD_LOGIC_VECTOR(c_fifo_size_w-1 DOWNTO 0);
+  
+  -- dp_clk domain
+  TYPE t_dp_reg IS RECORD
+    wb_sync_cap          : STD_LOGIC;
+    wb_sync              : STD_LOGIC;
+    dp_in_rst_req        : STD_LOGIC;
+    fifo_rd_req          : STD_LOGIC;
+    le_sync              : STD_LOGIC;
+    le_raw_phs           : STD_LOGIC_VECTOR(g_wb_factor-1 DOWNTO 0);
+    le_dat               : STD_LOGIC_VECTOR(c_dp_dat_w-1 DOWNTO 0);
+    le_val               : STD_LOGIC;
+    dp_raw_phs           : STD_LOGIC_VECTOR(g_wb_factor-1 DOWNTO 0);
+    dp_dat               : STD_LOGIC_VECTOR(g_wb_factor*g_in_dat_w-1 DOWNTO 0);   -- big endian output samples [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    dp_val               : STD_LOGIC;
+    dp_phs_locked        : STD_LOGIC;
+    dp_phs_align_en      : STD_LOGIC;
+    dp_phs_clk_en_vec    : STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+    dp_phs_clk_select    : NATURAL RANGE 0 TO c_nof_dp_phs_clk-1;
+    dp_sync_cap          : STD_LOGIC;
+    prev_dp_sync_cap     : STD_LOGIC;
+    dp_sync              : STD_LOGIC;
+    wb_cnt_clr           : STD_LOGIC;
+    wb_cnt_latency       : STD_LOGIC_VECTOR(c_wb_cnt_w-1 DOWNTO 0);
+    wb_cnt_latency_hold  : STD_LOGIC_VECTOR(c_wb_cnt_w-1 DOWNTO 0);
+    dp_word_req          : STD_LOGIC;
+    dp_word_req_dly      : STD_LOGIC_VECTOR(c_word_req_lat-1 DOWNTO 0);
+    dp_word_locked       : STD_LOGIC;
+    dp_word_lock_failed  : STD_LOGIC;
+  END RECORD;
+  
+  SIGNAL r_dp                        : t_dp_reg;
+  SIGNAL nxt_r_dp                    : t_dp_reg;  
+  
+  SIGNAL dp_in_clk_stopped           : STD_LOGIC;
+  SIGNAL dp_in_clk_detected          : STD_LOGIC;
+  SIGNAL dp_in_clk_stable            : STD_LOGIC;
+  SIGNAL dp_in_enabled               : STD_LOGIC;
+  
+  SIGNAL fifo_rd_dat                 : STD_LOGIC_VECTOR(c_fifo_dat_w-1 DOWNTO 0);
+  SIGNAL fifo_rd_val                 : STD_LOGIC;
+  SIGNAL fifo_rd_emp                 : STD_LOGIC;
+  SIGNAL fifo_rdusedw                : STD_LOGIC_VECTOR(c_fifo_size_w-1 DOWNTO 0);
+  
+  SIGNAL dp_phs_clk_en_vec_evt       : STD_LOGIC;  
+  SIGNAL dp_phs_timeout_cnt          : STD_LOGIC_VECTOR(c_dp_dd_phs_timeout_w-1 DOWNTO 0);
+  SIGNAL dp_phs_timeout_cnt_clr      : STD_LOGIC;
+  SIGNAL dp_phs_timeout              : STD_LOGIC;
+  SIGNAL dp_phs_val                  : STD_LOGIC;
+  SIGNAL dp_phs_lock_lost            : STD_LOGIC;
+  
+  SIGNAL dp_phs_align_restart        : STD_LOGIC;  
+  SIGNAL dp_phs_align_restart_extend : STD_LOGIC;
+  SIGNAL dp_phs_align_restart_revt   : STD_LOGIC;  
+  
+  SIGNAL wb_phs_clk                  : STD_LOGIC;
+  SIGNAL wb_sync_cap                 : STD_LOGIC;
+  SIGNAL wb_cnt                      : STD_LOGIC_VECTOR(c_wb_cnt_w-1 DOWNTO 0);
+  
+BEGIN
+
+  ------------------------------------------------------------------------------
+  -- Reset input section when lock is lost
+  ------------------------------------------------------------------------------
+  
+  --  Multiple triggers for dp_phs_align_restart
+  dp_phs_align_restart <= dp_phs_timeout OR dp_phs_lock_lost OR r_dp.dp_word_lock_failed;
+  
+  -- Extend dp_phs_align_restart to filter out any subsequent restart triggers
+  u_common_pulse_extend : ENTITY common_lib.common_pulse_extend
+  GENERIC MAP (
+    g_rst_level    => '0',
+    g_p_in_level   => '1',
+    g_ep_out_level => '1',
+    g_extend_w     => c_dp_phs_align_restart_w
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    p_in    => dp_phs_align_restart,
+    ep_out  => dp_phs_align_restart_extend
+  );
+  
+  -- Ensure dp_phs_align_restart will cause only a single increment for dp_phs_clk_select
+  u_common_evt_0 : ENTITY common_lib.common_evt
+  GENERIC MAP (
+    g_evt_type   => "RISING",
+    g_out_reg    => FALSE     -- if TRUE then the output is registered, else it is not
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    in_sig  => dp_phs_align_restart_extend,
+    out_evt => dp_phs_align_restart_revt
+  );
+  
+  -- Ensure that the FIFO is not read when it is reset, to avoid dp_dat becoming 0 which would complicate the verification in the tb
+  dp_in_enabled <= '1' WHEN dp_phs_align_restart='0' AND dp_phs_align_restart_extend='0' ELSE '0';
+  
+  -- Reset the input when:
+  -- . the in_clk has stopped, or
+  -- . the dp_phs_clk_en_vec was changed via MM, or
+  -- . an internal dp_phs_align_restart request occured
+  nxt_r_dp.dp_in_rst_req <= dp_in_clk_stopped OR dp_phs_clk_en_vec_evt OR dp_phs_align_restart_extend;
+  
+  u_common_async_in_rst : ENTITY common_lib.common_async
+  GENERIC MAP (
+    g_rst_level => '1',
+    g_delay_len => c_in_rst_delay_len
+  )
+  PORT MAP (
+    rst  => r_dp.dp_in_rst_req,  -- asynchronous rst ensures that it will take effect also when in_clk is not running
+    clk  => in_clk,
+    din  => '0',
+    dout => in_rst
+  );
+
+  ------------------------------------------------------------------------------
+  -- Detect whether the in_clk is active
+  ------------------------------------------------------------------------------
+  
+  u_common_clock_active_detector : ENTITY common_lib.common_clock_active_detector
+  GENERIC MAP (
+    g_in_period_w       => c_in_period_w,
+    g_dp_detect_period  => c_dp_detect_period,
+    g_dp_detect_margin  => 1
+  )
+  PORT MAP (
+    -- PHY input interface
+    in_clk               => in_clk,
+    dp_clk               => dp_clk,
+    dp_in_clk_detected   => dp_in_clk_detected,
+    dp_in_clk_stable     => dp_in_clk_stable,
+    dp_in_clk_stable_ack => out_word_stable_ack
+  );
+  
+  dp_in_clk_stopped <= NOT dp_in_clk_detected;
+  
+  ------------------------------------------------------------------------------
+  -- Capture the double data rate input sample data
+  ------------------------------------------------------------------------------
+  
+  -- Double data rate input cell at pin, also ensures deterministic input timing
+  u_common_ddio_in : ENTITY common_lib.common_ddio_in
+  GENERIC MAP (
+    g_width => g_in_dat_w
+  )
+  PORT MAP (
+    in_dat      => in_dat,
+    in_clk      => in_clk,
+    out_dat_hi  => in_dat_hi,
+    out_dat_lo  => in_dat_lo
+  );
+  
+  nxt_r_in.in_dat_hi <= in_dat_hi;
+  nxt_r_in.in_dat_lo <= in_dat_lo;
+  
+  gen_dp_phs_align_en_1 : IF c_dp_phs_align_en=TRUE GENERATE
+    ------------------------------------------------------------------------------
+    -- Capture the '0' to '1' transition of the dp_phs_clk
+    ------------------------------------------------------------------------------
+    
+    wb_phs_clk <= dp_phs_clk_vec(0);
+    
+    u_common_async_wb_sync : ENTITY common_lib.common_async
+    GENERIC MAP (
+      g_rising_edge => g_wb_use_rising_edge,
+      g_rst_level   => '0',
+      g_delay_len   => c_delay_len      -- typically 1 should be sufficient, but more is fine too
+    )
+    PORT MAP (
+      rst  => dp_rst,
+      clk  => dp_clk,
+      din  => wb_phs_clk,
+      dout => wb_sync_cap
+    );
+    
+    nxt_r_dp.wb_sync_cap <= wb_sync_cap;
+    
+    nxt_r_dp.wb_sync <= '1' WHEN wb_sync_cap='1' AND r_dp.wb_sync_cap='0' ELSE '0';
+    
+      
+    ------------------------------------------------------------------------------
+    -- Detect and align to the dp_clk phase
+    ------------------------------------------------------------------------------
+    
+    u_lvdsh_dd_phs4_align : ENTITY work.lvdsh_dd_phs4_align
+    GENERIC MAP (
+      g_wb_factor       => g_wb_factor,
+      g_nof_dp_phs_clk  => g_nof_dp_phs_clk,
+      g_dd_phs_locked_w => c_in_dd_phs_locked_w,
+      g_in_dat_w        => g_in_dat_w
+    )
+    PORT MAP (
+      -- DP clock reference for word alignment
+      dp_phs_clk_vec     => dp_phs_clk_vec,
+      dp_phs_clk_select  => r_dp.dp_phs_clk_select,
+      
+      -- PHY input interface
+      in_rst             => in_rst,
+      in_clk             => in_clk,
+      in_dat_hi          => in_dat_hi,
+      in_dat_lo          => in_dat_lo,
+      
+      raw_phs            => raw_phs,
+      out_phs_locked     => dd_phs_locked,
+      out_sync           => dd_sync,
+      out_dat            => dd_dat,
+      out_val            => dd_val
+    );
+    
+    dd_sync_sl <= andv(dd_sync);  -- after sample phase realignment the dd_sync derived from dp_clk_phs in the in_clk domain toggles between 0x0 and 0xF.
+    
+    nxt_r_in.dd_sync_locked <= '0' WHEN dd_phs_locked='0' ELSE
+                               '1' WHEN dd_sync_sl='1' ELSE r_in.dd_sync_locked;  -- dd_phs_locked goes '1' when dd_sync_sl='0', so dd_sync_locked starts after next dd_sync_sl rising event
+  END GENERATE;  -- gen_dp_phs_align_en_1
+                             
+  ------------------------------------------------------------------------------
+  -- Support raw data without realignment
+  ------------------------------------------------------------------------------
+  
+  u_common_async_1 : ENTITY common_lib.common_async
+  GENERIC MAP (
+    g_delay_len   => c_delay_len
+  )
+  PORT MAP (
+    rst  => '0',
+    clk  => in_clk,
+    din  => r_dp.dp_phs_align_en,
+    dout => in_phs_align_en
+  );
+                             
+  nxt_r_in.dd_in_data <= in_dat_hi & in_dat_lo & r_in.in_dat_hi & r_in.in_dat_lo;
+  nxt_r_in.dd_in_val  <= NOT r_in.dd_in_val;    -- toggle to implement c_dd_factor=2 divider
+  
+  ------------------------------------------------------------------------------
+  -- Use a dual clock FIFO to bring the data to the dp_clk domain
+  ------------------------------------------------------------------------------
+  
+  -- Register fifo_wr_dat to ease timing closure between DDIO and FIFO at input clock rate
+  -- . dd_val toggles due dd_factor between in_clk rate and dp_clk rate
+  -- . use dd_phs_locked seems not needed, but could help to ensure the FIFO does not get filled with spurious initial samples
+  -- . use dd_sync_locked to align start of fifo_wr_req seems not needed, but could help to ensure proper word aligment between nodes
+  nxt_r_in.fifo_wr_dat <= raw_phs        &        dd_sync_sl     &   dd_dat WHEN in_phs_align_en='1' ELSE "1111" & '1' & r_in.dd_in_data;
+  nxt_r_in.fifo_wr_req <=  dd_phs_locked AND r_in.dd_sync_locked AND dd_val WHEN in_phs_align_en='1' ELSE                r_in.dd_in_val;
+  
+  nxt_r_in.fifo_wr_dat_p <= r_in.fifo_wr_dat;
+  nxt_r_in.fifo_wr_req_p <= r_in.fifo_wr_req;
+  
+  in_fifo_wr_dat <= r_in.fifo_wr_dat WHEN c_fifo_wr_pipeline=0 ELSE r_in.fifo_wr_dat_p;
+  in_fifo_wr_req <= r_in.fifo_wr_req WHEN c_fifo_wr_pipeline=0 ELSE r_in.fifo_wr_req_p;
+  
+  -- Dual clock FIFO
+  u_common_fifo_dc : ENTITY common_lib.common_fifo_dc
+  GENERIC MAP (
+    g_dat_w      => c_fifo_dat_w,
+    g_nof_words  => c_fifo_size
+  )
+  PORT MAP (
+    rst     => in_rst,
+    wr_clk  => in_clk,
+    wr_dat  => in_fifo_wr_dat,
+    wr_req  => in_fifo_wr_req,
+    wr_ful  => OPEN,
+    wrusedw => fifo_wrusedw,
+    rd_clk  => dp_clk,
+    rd_dat  => fifo_rd_dat,
+    rd_req  => r_dp.fifo_rd_req,
+    rd_emp  => fifo_rd_emp,
+    rdusedw => fifo_rdusedw,
+    rd_val  => fifo_rd_val
+  );
+  
+  nxt_r_dp.le_raw_phs      <= fifo_rd_dat(c_raw_phs_w+c_sync_w+c_dp_dat_w-1 DOWNTO c_sync_w+c_dp_dat_w);   -- 4b
+  nxt_r_dp.le_sync         <= fifo_rd_dat(                                                  c_dp_dat_w);   -- 1b
+  nxt_r_dp.le_dat          <= fifo_rd_dat(                     c_dp_dat_w-1 DOWNTO                   0);   -- 32b
+  nxt_r_dp.le_val          <= fifo_rd_val;
+  
+  nxt_r_dp.dp_raw_phs      <=      r_dp.le_raw_phs                       WHEN r_dp.le_val='1' ELSE r_dp.dp_raw_phs;  -- Keep measured phase in little endian order
+  nxt_r_dp.dp_sync_cap     <=      r_dp.le_sync                          WHEN r_dp.le_val='1' ELSE r_dp.dp_sync_cap;      -- Hold to avoid false dp_sync_cap due to fifo_rd_req='0'
+  nxt_r_dp.dp_dat          <= hton(r_dp.le_dat, g_in_dat_w, g_wb_factor) WHEN r_dp.le_val='1' ELSE r_dp.dp_dat;  -- Rewire le_dat data words with [t3, t2, t1, t0] to big endian dp_dat data words with sample order [t0, t1, t2, t3]
+  nxt_r_dp.dp_val          <=      r_dp.le_val;
+  
+  nxt_r_dp.prev_dp_sync_cap <= r_dp.dp_sync_cap;
+  nxt_r_dp.dp_sync <= '1' WHEN r_dp.dp_sync_cap='1' AND r_dp.prev_dp_sync_cap='0' ELSE '0';
+    
+  dp_dat <= r_dp.dp_dat;
+  dp_val <= r_dp.dp_val;
+  
+  dp_phs_val <= '1' WHEN r_dp.dp_val='1' OR r_dp.dp_word_req_dly(c_word_req_lat-1)='0' ELSE '0';  -- Mask the gaps in dp_val due to fifo_rd_req='0'
+  
+  nxt_r_dp.dp_phs_locked <= dp_phs_val;  -- The input phase is locked when the FIFO does not run empty, so the in_clk is running active AND that dd_phs=c_exp_phs.
+  
+  out_phs_locked <= r_dp.dp_phs_locked;
+  
+  u_common_evt_1 : ENTITY common_lib.common_evt
+  GENERIC MAP (
+    g_evt_type => "FALLING"
+  )
+  PORT MAP (
+    rst      => dp_rst,
+    clk      => dp_clk,
+    in_sig   => r_dp.dp_phs_locked,
+    out_evt  => dp_phs_lock_lost
+  );  
+  
+  ------------------------------------------------------------------------------
+  -- Select dp_phs_clk
+  ------------------------------------------------------------------------------
+  
+  -- Detect dp_phs_clk_en_vec=0 to disable realignment
+  nxt_r_dp.dp_phs_align_en <= '1' WHEN c_dp_phs_align_en=TRUE AND UNSIGNED(dp_phs_clk_en_vec)/=0 ELSE '0';
+  
+  -- Detect MM change in dp_phs_clk_en_vec
+  nxt_r_dp.dp_phs_clk_en_vec <= dp_phs_clk_en_vec;
+  
+  dp_phs_clk_en_vec_evt <= '1' WHEN c_dp_phs_align_en=TRUE AND UNSIGNED(r_dp.dp_phs_clk_en_vec)/=UNSIGNED(dp_phs_clk_en_vec) ELSE '0';
+  
+  gen_dp_phs_align_en_2 : IF c_dp_phs_align_en=TRUE GENERATE
+    -- Control dp_phs_clk_select
+    p_dp_phs_clk_select : PROCESS (r_dp, dp_in_clk_stopped, dp_phs_clk_en_vec_evt, dp_phs_align_restart_revt, dp_phs_clk_en_vec)
+    BEGIN
+      nxt_r_dp.dp_phs_clk_select <= r_dp.dp_phs_clk_select;
+      
+      IF dp_in_clk_stopped='1' OR dp_phs_clk_en_vec_evt='1' THEN
+        -- in_clk inactive        : reset to initial dp_clk_phs
+        -- phs_clk_en_vec changed : restart from initial dp_clk_phs
+        nxt_r_dp.dp_phs_clk_select  <= 0;
+      ELSE
+        -- in_clk active: select next dp_clk_phs
+        -- . dp_phs_align_restart_revt:
+        --   . dp_phs_timeout      : cannot achieve lock with in_clk on this dp_clk_phs, so try next dp_clk_phs
+        --   . dp_phs_lock_lost    : lock lost due to meta stable timing error between in_clk and this dp_clk_phs, so try next dp_clk_phs
+        --   . dp_word_lock_failed : word lock lost, avoid remaining unable to achieve word lock on this dp_clk_phs, so try next dp_clk_phs
+        -- . dp_phs_clk_en_vec     : if dp_phs_clk is not enabled then select next dp_phs_clk
+        IF dp_phs_align_restart_revt='1' OR dp_phs_clk_en_vec(r_dp.dp_phs_clk_select)='0' THEN
+          IF r_dp.dp_phs_clk_select=g_nof_dp_phs_clk-1 THEN
+            nxt_r_dp.dp_phs_clk_select <= 0;
+          ELSE
+            nxt_r_dp.dp_phs_clk_select <= r_dp.dp_phs_clk_select+1;
+          END IF;
+        END IF;
+      END IF;
+    END PROCESS;
+  END GENERATE;  -- gen_dp_phs_align_en_2
+  
+  ------------------------------------------------------------------------------
+  -- DD phase lock timeout
+  ------------------------------------------------------------------------------
+  u_common_counter_dp_phs_timeout_cnt : ENTITY common_lib.common_counter
+  GENERIC MAP (
+    g_width => c_dp_dd_phs_timeout_w
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    cnt_clr => dp_phs_timeout_cnt_clr,
+    count   => dp_phs_timeout_cnt
+  );
+  
+  dp_phs_timeout_cnt_clr <= dp_in_clk_stopped OR r_dp.dp_phs_locked OR dp_phs_timeout;  -- clear the dp_phs_timeout timer when there is no active in_clk or when the dp_phs is locked
+  dp_phs_timeout <= dp_phs_timeout_cnt(dp_phs_timeout_cnt'HIGH);                        -- dp_phs_timeout pulse also restarts the timer
+  
+  ------------------------------------------------------------------------------
+  -- Determine DP word lock based on the wb_sync - dp_sync latency
+  ------------------------------------------------------------------------------
+  
+  -- Measure and align the wb_sync to dp_sync latency
+  u_common_counter_wb_cnt : ENTITY common_lib.common_counter
+  GENERIC MAP (
+    g_width => c_wb_cnt_w
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    cnt_clr => r_dp.wb_cnt_clr,
+    count   => wb_cnt
+  );
+
+  -- Default read when not empty, so the FIFO cannot run full
+  nxt_r_dp.fifo_rd_req <= NOT fifo_rd_emp AND dp_in_enabled AND r_dp.dp_word_req;
+  
+  nxt_r_dp.dp_word_req_dly(c_word_req_lat-1 DOWNTO 0) <= r_dp.dp_word_req_dly(c_word_req_lat-2 DOWNTO 0) & r_dp.dp_word_req;
+  
+  p_dp_word_lock : PROCESS (r_dp, wb_cnt, fifo_rd_emp, fifo_rdusedw)
+  BEGIN
+    nxt_r_dp.wb_cnt_clr          <= '1';
+    nxt_r_dp.wb_cnt_latency      <= (OTHERS=>'0');
+    nxt_r_dp.wb_cnt_latency_hold <= (OTHERS=>'0');
+    
+    nxt_r_dp.dp_word_req         <= '1';
+    nxt_r_dp.dp_word_locked      <= '0';
+    nxt_r_dp.dp_word_lock_failed <= '0';
+    
+    IF r_dp.dp_phs_align_en='1' THEN
+      --------------------------------------------------------------------------
+      -- Realignment enabled
+      --------------------------------------------------------------------------
+      IF r_dp.dp_phs_locked='1' THEN
+        -- Measure wb_sync - dp_sync latency
+        nxt_r_dp.wb_cnt_clr          <= r_dp.wb_cnt_clr;
+        nxt_r_dp.wb_cnt_latency      <= r_dp.wb_cnt_latency;
+        nxt_r_dp.wb_cnt_latency_hold <= r_dp.wb_cnt_latency_hold;
+        IF r_dp.wb_sync='1' THEN
+          nxt_r_dp.wb_cnt_clr <= '0';
+        ELSIF r_dp.dp_sync='1' THEN
+          nxt_r_dp.wb_cnt_clr <= '1';
+          nxt_r_dp.wb_cnt_latency <= wb_cnt;
+          nxt_r_dp.wb_cnt_latency_hold <= r_dp.wb_cnt_latency;
+        END IF;
+        
+        -- Word lock control
+        -- . Note: In practise it appears necessary to add dp_word_lock_failed check, because it is not sufficient to rely on dp_phs_lock_lost alone
+        nxt_r_dp.dp_word_locked <= r_dp.dp_word_locked;
+        IF r_dp.dp_word_locked='0' THEN
+          -- Word lock acquisition
+          IF r_dp.dp_sync='1' THEN  -- dp_sync implies also that the FIFO is not empty, so no need to check fifo_rd_emp to avoid false dp_phs_val via dp_word_req_dly
+            -- Adjust wb_sync - dp_sync latency to become c_wb_sync_latency
+            IF UNSIGNED(wb_cnt) < c_wb_sync_latency THEN
+              nxt_r_dp.dp_word_req <= '0';                   -- too early dp_sync so slip 1 word
+            ELSIF UNSIGNED(wb_cnt) = c_wb_sync_latency THEN
+              nxt_r_dp.dp_word_locked <= '1';                -- declare word locked
+              
+              -- Fine check FIFO fill level when lock is declared
+              IF UNSIGNED(fifo_rdusedw) < c_wb_fifo_fill_min THEN
+                nxt_r_dp.dp_word_lock_failed <= '1';         -- unexpected FIFO latency, so recover via in_rst
+              END IF;
+            END IF;
+            
+            -- Fine check that latency is incrementing properly during word lock acquisition
+            IF UNSIGNED(r_dp.wb_cnt_latency_hold)>0 THEN
+              IF UNSIGNED(r_dp.wb_cnt_latency_hold)/=UNSIGNED(r_dp.wb_cnt_latency)-1 THEN
+                nxt_r_dp.dp_word_lock_failed <= '1';         -- wrong latency increment, so recover via in_rst
+              END IF;
+            END IF;
+          END IF;
+        ELSE
+          -- *** Word locked, this is the correct end state for the ALIGNED data processing ***
+          
+          -- Fine check latency during stable word lock
+          IF UNSIGNED(r_dp.wb_cnt_latency) /= c_wb_sync_latency THEN
+            nxt_r_dp.dp_word_lock_failed <= '1';             -- word lock lost, so recover via in_rst
+          END IF;
+          -- Fine check FIFO fill level during stable word lock
+          IF UNSIGNED(fifo_rdusedw) < c_wb_fifo_fill_min THEN
+            nxt_r_dp.dp_word_lock_failed <= '1';             -- unexpected FIFO latency, so recover via in_rst
+          END IF;
+        END IF;
+      END IF;
+      
+    ELSE
+      --------------------------------------------------------------------------
+      -- Realignment disabled : raw data
+      --------------------------------------------------------------------------
+      IF r_dp.dp_phs_locked='1' THEN
+        -- Word lock control
+        nxt_r_dp.dp_word_locked <= r_dp.dp_word_locked;
+        IF r_dp.dp_word_locked='0' THEN
+          -- Word lock acquisition
+          IF fifo_rd_emp='0' THEN  -- no dp_sync in raw mode, so need to use fifo_rd_emp to check that FIFO is not empty to avoid false dp_phs_val due to dp_word_req_dly
+            IF UNSIGNED(fifo_rdusedw) <= c_wb_fifo_latency-c_word_req_lat THEN
+              nxt_r_dp.dp_word_req <= '0';             -- too few words in FIFO so slip 1 word
+            ELSIF UNSIGNED(fifo_rdusedw) >= c_wb_fifo_fill_min THEN
+              nxt_r_dp.dp_word_locked <= '1';          -- declare word locked
+            END IF;
+          END IF;
+        ELSE
+          -- *** Word locked, this is the correct end state for the RAW data processing ***
+          
+          -- Fine check FIFO fill level during stable word lock
+          IF UNSIGNED(fifo_rdusedw) < c_wb_fifo_fill_min THEN
+            nxt_r_dp.dp_word_lock_failed <= '1';     -- unexpected FIFO latency, so recover via in_rst
+          END IF;
+        END IF;
+      END IF;
+      
+    END IF;
+    
+    -- Course check latency and FIFO fill level at any time
+    IF UNSIGNED(wb_cnt) > c_wb_sync_latency+1 THEN
+      nxt_r_dp.dp_word_lock_failed <= '1';                 -- timeout dp_sync, so recover via in_rst
+    END IF;
+    IF UNSIGNED(fifo_rdusedw) > c_wb_fifo_fill_max THEN
+      nxt_r_dp.dp_word_lock_failed <= '1';                 -- unexpected FIFO latency, so recover via in_rst
+    END IF;
+  END PROCESS;  
+  
+  ------------------------------------------------------------------------------
+  -- Monitor the dp_clk phase alignment
+  ------------------------------------------------------------------------------
+  
+  p_out_status : PROCESS(r_dp, dp_in_clk_stable, dp_in_clk_detected, fifo_rdusedw)
+  BEGIN
+    -- Debug monitor status
+    out_status               <= (OTHERS=>'0');
+    out_status(           4) <= r_dp.dp_phs_locked;                     -- 1 bit
+    out_status( 7 DOWNTO  6) <= dp_in_clk_stable & dp_in_clk_detected;  -- 2 bit
+    out_status(15 DOWNTO  8) <= fifo_rdusedw;                           -- c_fifo_size_w = 8
+    out_status(23 DOWNTO 16) <= RESIZE_UVEC(r_dp.wb_cnt_latency, 8);    -- c_wb_cnt_w <= 8
+    out_status(27 DOWNTO 24) <= TO_UVEC(r_dp.dp_phs_clk_select, 4);     -- g_nof_dp_phs_clk <= 6, fits in 4 bit
+    out_status(31 DOWNTO 28) <= r_dp.dp_raw_phs;                        -- g_wb_factor = 4
+  END PROCESS;
+  
+  u_common_stable_monitor : ENTITY common_lib.common_stable_monitor
+  PORT MAP (
+    rst          => dp_rst,
+    clk          => dp_clk,
+    -- MM
+    r_in         => r_dp.dp_word_locked,
+    r_stable     => out_word_stable,
+    r_stable_ack => out_word_stable_ack
+  );
+    
+  out_word_locked <= r_dp.dp_word_locked;
+  
+  ------------------------------------------------------------------------------
+  -- Registers
+  ------------------------------------------------------------------------------
+
+  p_in_reg : PROCESS(in_rst, in_clk)
+  BEGIN
+    IF in_rst='1' THEN
+      r_in.dd_sync_locked <= '0';
+      r_in.dd_in_val      <= '0';
+      r_in.fifo_wr_req    <= '0';
+      r_in.fifo_wr_req_p  <= '0';
+    ELSIF rising_edge(in_clk) THEN
+      r_in <= nxt_r_in;
+    END IF;
+  END PROCESS;
+  
+  p_dp_reg : PROCESS(dp_rst, dp_clk)
+  BEGIN
+    IF dp_rst='1' THEN
+      r_dp.wb_sync_cap         <= '0';
+      r_dp.dp_in_rst_req       <= '1';
+      r_dp.fifo_rd_req         <= '0';
+      r_dp.le_sync             <= '0';
+      r_dp.le_raw_phs          <= (OTHERS=>'0');
+      r_dp.le_val              <= '0';
+      r_dp.dp_raw_phs          <= (OTHERS=>'0');
+      r_dp.dp_dat              <= (OTHERS=>'0');  -- to avoid Warning: NUMERIC_STD.TO_INTEGER: metavalue detected, returning 0 in simulation
+      r_dp.dp_val              <= '0';
+      r_dp.dp_phs_locked       <= '0';
+      r_dp.dp_phs_align_en     <= '0';
+      r_dp.dp_phs_clk_en_vec   <= (OTHERS=>'1');
+      r_dp.dp_phs_clk_select   <= 0;
+      r_dp.dp_sync_cap         <= '0';
+      r_dp.prev_dp_sync_cap    <= '0';
+      r_dp.dp_sync             <= '0';
+      r_dp.wb_cnt_clr          <= '1';
+      r_dp.wb_cnt_latency      <= (OTHERS=>'1');
+      r_dp.dp_word_req         <= '1';
+      r_dp.dp_word_req_dly     <= (OTHERS=>'1');
+      r_dp.dp_word_locked      <= '0';
+      r_dp.dp_word_lock_failed <= '0';
+    ELSIF rising_edge(dp_clk) THEN
+      r_dp <= nxt_r_dp;
+    END IF;
+  END PROCESS;
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4_align.vhd b/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4_align.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..da1c701c704003b20f3966a89c4e6f19c5685753
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/lvdsh_dd_phs4_align.vhd
@@ -0,0 +1,361 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2014
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+
+-- Purpose: Word align the 800M Hz sample data to 200 MHz data path clock.
+-- Description:
+--   The 800 MHz in_dat samples have already been captured at the pin by
+--   a common_ddio_in component.
+    
+ENTITY lvdsh_dd_phs4_align IS
+  GENERIC (
+    g_wb_factor         : NATURAL := 4;      -- fixed wideband factor 4 = c_rx_factor*c_dd_factor
+    g_nof_dp_phs_clk    : NATURAL := 2;      -- nof dp_phs_clk that can be used to detect lock
+    g_dd_phs_locked_w   : NATURAL := 8;      -- used to ensure that dd_phs_locked is only declared if dd_phs_detected is stable for at least 2**(g_dd_phs_locked_w-1) cycles
+    g_in_dat_w          : NATURAL := 8       -- nof PHY data bits
+  );
+  PORT (
+    -- DP clock reference for word alignment
+    dp_phs_clk_vec     : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);  -- used as data input for in_clk domain
+    dp_phs_clk_select  : IN  NATURAL RANGE 0 TO g_nof_dp_phs_clk-1 := 0;
+    
+    -- PHY input interface
+    in_rst             : IN  STD_LOGIC := '0';
+    in_clk             : IN  STD_LOGIC := '1';
+    in_dat_hi          : IN  STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t1], [t3], [t5], [t7], ... --> time
+    in_dat_lo          : IN  STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t0], [t2], [t4], [t6], ... --> time
+    
+    raw_phs            : OUT STD_LOGIC_VECTOR(           g_wb_factor-1 DOWNTO 0);  -- the measured sample phase before realignment
+    out_phs_locked     : OUT STD_LOGIC;                                            -- '1' when realigned sample phase is stable and correct for at least 2**(g_dd_phs_locked_w-1) cycles
+    out_sync           : OUT STD_LOGIC_VECTOR(           g_wb_factor-1 DOWNTO 0);  -- the measured word   phase after realignment
+    out_dat            : OUT STD_LOGIC_VECTOR(g_in_dat_w*g_wb_factor-1 DOWNTO 0);  -- output words in little endian format [t3, t2, t1, t0] 
+    out_val            : OUT STD_LOGIC
+  );
+END lvdsh_dd_phs4_align;
+
+
+ARCHITECTURE str OF lvdsh_dd_phs4_align IS
+
+  CONSTANT c_delay_len          : NATURAL := c_meta_delay_len;
+  CONSTANT c_ref_pipeline       : NATURAL := 1;  -- need pipeline to achieve 400 MHz when g_nof_dp_phs_clk=8
+  CONSTANT c_dd_factor          : NATURAL := 2;                       -- fixed double data rate factor
+  CONSTANT c_rx_factor          : NATURAL := 2;                       -- fixed for g_wb_factor = c_rx_factor*c_dd_factor = 4
+  CONSTANT c_dd_phs_w           : NATURAL := g_wb_factor;             -- = 4 * 1b = 4b
+  CONSTANT c_dd_dat_w           : NATURAL := g_wb_factor*g_in_dat_w;  -- = 4 * 8b = 32b
+  CONSTANT c_exp_raw_phs_arr    : t_natural_arr(g_wb_factor-1 DOWNTO 0) := (3, 6, 12, 9);  -- the expected word phase before realignment is fixed, the other values in the range indicate incorrect phase detection
+  CONSTANT c_exp_phs            : NATURAL := 3;  -- the expected word phase after realignment is fixed, the other values in the range indicate incorrect phase detection
+
+  SIGNAL ref_r_vec           : STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+  SIGNAL ref_f_vec           : STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+  SIGNAL sel_r               : STD_LOGIC;
+  SIGNAL sel_f               : STD_LOGIC;
+  SIGNAL ref_r               : STD_LOGIC;
+  SIGNAL ref_f               : STD_LOGIC;
+  SIGNAL sync_r              : STD_LOGIC;
+  SIGNAL sync_f              : STD_LOGIC;
+  
+  TYPE t_in_reg IS RECORD
+    -- 1 sample adjust
+    ref_init        : STD_LOGIC;
+    ref_r_val       : STD_LOGIC;
+    ref_f_val       : STD_LOGIC;
+    ref_r           : STD_LOGIC;
+    ref_f           : STD_LOGIC;
+    phs_r           : STD_LOGIC;
+    prev_phs_r      : STD_LOGIC;
+    phs_f           : STD_LOGIC;
+    prev_phs_f      : STD_LOGIC;
+    sync_init       : STD_LOGIC;
+    sync_r          : STD_LOGIC;
+    prev_sync_r     : STD_LOGIC;
+    sync_f          : STD_LOGIC;
+    prev_in_dat_hi  : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+    in_dat_hi       : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+    in_dat_lo       : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+    phs_r_evt       : STD_LOGIC;
+    phs_f_evt       : STD_LOGIC;
+    phs_evt         : STD_LOGIC;
+    -- 2 sample adjust
+    phs_even        : BOOLEAN;
+    d_raw_phs       : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    d_phs           : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    prev_d_raw_phs  : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    prev_d_phs      : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    d_sync          : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    prev_d_sync     : STD_LOGIC_VECTOR(c_dd_factor-1 DOWNTO 0);
+    d_dat           : STD_LOGIC_VECTOR(c_dd_factor*g_in_dat_w-1 DOWNTO 0);
+    prev_d_dat      : STD_LOGIC_VECTOR(c_dd_factor*g_in_dat_w-1 DOWNTO 0);
+    -- 4 sample output
+    dd_raw_phs      : STD_LOGIC_VECTOR(c_dd_phs_w-1 DOWNTO 0);
+    prev_dd_raw_phs : STD_LOGIC_VECTOR(c_dd_phs_w-1 DOWNTO 0);
+    dd_raw_phs_evt  : STD_LOGIC;
+    dd_raw_phs_err  : STD_LOGIC;
+    dd_phs          : STD_LOGIC_VECTOR(c_dd_phs_w-1 DOWNTO 0);
+    dd_phs_err      : STD_LOGIC;
+    dd_phs_detected : STD_LOGIC;
+    dd_phs_locked   : STD_LOGIC;
+    dd_sync         : STD_LOGIC_VECTOR(c_dd_phs_w-1 DOWNTO 0);
+    dd_dat          : STD_LOGIC_VECTOR(c_dd_dat_w-1 DOWNTO 0);
+    dd_val          : STD_LOGIC;
+  END RECORD;
+  
+  SIGNAL r                  : t_in_reg;
+  SIGNAL nxt_r              : t_in_reg;
+  
+  SIGNAL dd_phs_detected_ok : STD_LOGIC;
+  
+BEGIN
+
+  ------------------------------------------------------------------------------
+  -- Detect the dp_phs_clk reference
+  ------------------------------------------------------------------------------
+  
+  gen_detectors : FOR I IN g_nof_dp_phs_clk-1 DOWNTO 0 GENERATE
+    u_common_clock_phase_detector_r: ENTITY common_lib.common_clock_phase_detector
+    GENERIC MAP (
+      g_rising_edge      => TRUE,
+      g_phase_rst_level  => '1',
+      g_meta_delay_len   => c_delay_len,
+      g_offset_delay_len => -c_ref_pipeline,
+      g_clk_factor       => c_rx_factor
+    )
+    PORT MAP (
+      in_clk    => dp_phs_clk_vec(I),  -- used as data input for in_clk domain
+      rst       => in_rst,
+      clk       => in_clk,
+      phase     => ref_r_vec(I),
+      phase_det => OPEN
+    );
+    
+    u_common_clock_phase_detector_f: ENTITY common_lib.common_clock_phase_detector
+    GENERIC MAP (
+      g_rising_edge      => FALSE,
+      g_phase_rst_level  => '1',
+      g_meta_delay_len   => c_delay_len,
+      g_offset_delay_len => -c_ref_pipeline,
+      g_clk_factor       => c_rx_factor
+    )
+    PORT MAP (
+      in_clk    => dp_phs_clk_vec(I),  -- used as data input for in_clk domain
+      rst       => in_rst,
+      clk       => in_clk,
+      phase     => ref_f_vec(I),
+      phase_det => OPEN
+    );
+  END GENERATE;
+  
+  -- No need to transfer dp_phs_clk_select to in_clk domain because it remains stable after every in_rst
+  sel_r <= ref_r_vec(dp_phs_clk_select);
+  sel_f <= ref_f_vec(dp_phs_clk_select);
+  
+  u_pipeline_ref_r : ENTITY common_lib.common_pipeline_sl
+  GENERIC MAP (
+    g_pipeline    => c_ref_pipeline,
+    g_reset_value => 1
+  )
+  PORT MAP (
+    rst     => in_rst,
+    clk     => in_clk,
+    in_dat  => sel_r,
+    out_dat => ref_r
+  );
+  
+  u_pipeline_ref_f : ENTITY common_lib.common_pipeline_sl
+  GENERIC MAP (
+    g_pipeline    => c_ref_pipeline,
+    g_reset_value => 1
+  )
+  PORT MAP (
+    rst     => in_rst,
+    clk     => in_clk,
+    in_dat  => sel_f,
+    out_dat => ref_f
+  );
+  
+  ------------------------------------------------------------------------------
+  -- Detect the word phase
+  ------------------------------------------------------------------------------
+    
+  nxt_r.ref_r <= ref_r;
+  nxt_r.ref_f <= ref_f;
+  
+  -- derive toggling phs_r and phs_f in phase with '0' to '1' transition in ref_r and ref_f to support dp_phs_clk that runs some factors 2 slower than dp_clk
+  nxt_r.ref_init <= '0' WHEN r.ref_r='0' AND r.ref_f='0' ELSE r.ref_init;     -- wait for dp_phs_clk low after in_rst release
+  
+  nxt_r.ref_r_val <= '1' WHEN r.ref_init='0' AND ref_r='1' ELSE r.ref_r_val;  -- wait for dp_phs_clk high
+  nxt_r.ref_f_val <= '1' WHEN r.ref_init='0' AND ref_f='1' ELSE r.ref_f_val;  -- wait for dp_phs_clk high
+  
+  nxt_r.phs_r <= '0' WHEN r.ref_r_val='0' OR (ref_r='1' AND r.ref_r='0') ELSE NOT r.phs_r;
+  nxt_r.phs_f <= '0' WHEN r.ref_f_val='0' OR (ref_f='1' AND r.ref_f='0') ELSE NOT r.phs_f;
+  
+  -- use ref_r and ref_f via phs to adjust the sample phase within a word of wb_factor samples and via sync to measure the word phase
+  sync_r <= r.ref_r;  -- use registered r.ref_r and r.ref_f instead of ref_r and ref_f direct to have dd_sync = 0xF instead of 0xC, 0x3
+  sync_f <= r.ref_f;
+  
+  nxt_r.sync_init <= '0' WHEN sync_r='0' AND sync_f='0' ELSE r.sync_init;  -- wait for dp_phs_clk low after in_rst release
+  
+  nxt_r.sync_r <= '0' WHEN r.sync_init='1' ELSE sync_r;
+  nxt_r.sync_f <= '0' WHEN r.sync_init='1' ELSE sync_f;
+  
+  
+  ------------------------------------------------------------------------------
+  -- Adjust single sample phase offset
+  ------------------------------------------------------------------------------
+  
+  -- Register input to keep previous single input sample
+  nxt_r.prev_phs_r     <= r.phs_r;
+  nxt_r.prev_phs_f     <= r.phs_f;
+  nxt_r.prev_sync_r    <= r.sync_r;
+  nxt_r.prev_in_dat_hi <= r.in_dat_hi;
+  
+  -- Register in_dat_hi and in_dat_lo to ease timing closure
+  nxt_r.in_dat_hi      <= in_dat_hi;
+  nxt_r.in_dat_lo      <= in_dat_lo;
+    
+  -- Detect single sample phase shift event
+  nxt_r.phs_r_evt <= '1' WHEN r.phs_r = r.prev_phs_r ELSE '0';
+  nxt_r.phs_f_evt <= '1' WHEN r.phs_f = r.prev_phs_f ELSE '0';
+  
+  nxt_r.phs_evt <= r.phs_r_evt OR r.phs_f_evt;
+  
+  -- Show single sample phase, which it TRUE when the sample phase in a word is 0 or 2 and FALSE for sample phase is 1 or 3
+  nxt_r.phs_even <= TRUE WHEN r.phs_r = r.phs_f ELSE FALSE;
+  
+  -- Realign to halfword
+  --                 phs_even = TRUE:                                    phs_even = FALSE:
+  nxt_r.d_phs     <= r.phs_r     & r.phs_f     WHEN r.phs_r=r.phs_f ELSE r.phs_f     & r.prev_phs_r;
+  nxt_r.d_sync    <= r.sync_r    & r.sync_f    WHEN r.phs_r=r.phs_f ELSE r.sync_f    & r.prev_sync_r;
+  nxt_r.d_dat     <= r.in_dat_hi & r.in_dat_lo WHEN r.phs_r=r.phs_f ELSE r.in_dat_lo & r.prev_in_dat_hi;
+  nxt_r.d_raw_phs <= r.phs_r     & r.phs_f;   -- preserve captured d phase for monitoring purposes
+  
+  ------------------------------------------------------------------------------
+  -- Adjust double sample phase offset
+  ------------------------------------------------------------------------------
+  
+  -- Register input to keep previous double input sample
+  nxt_r.prev_d_phs     <= r.d_phs;
+  nxt_r.prev_d_sync    <= r.d_sync;
+  nxt_r.prev_d_dat     <= r.d_dat;
+  nxt_r.prev_d_raw_phs <= r.d_raw_phs;
+  
+  -- Realign to word
+  --                                                    phs_even = TRUE:                 phs_even = FALSE:
+  nxt_r.dd_phs     <= r.d_phs     & r.prev_d_phs  WHEN (r.phs_r='1' AND r.phs_f='1') OR (r.phs_r='0' AND r.phs_f='1') ELSE r.dd_phs;
+  nxt_r.dd_sync    <= r.d_sync    & r.prev_d_sync WHEN (r.phs_r='1' AND r.phs_f='1') OR (r.phs_r='0' AND r.phs_f='1') ELSE r.dd_sync;
+  nxt_r.dd_dat     <= r.d_dat     & r.prev_d_dat  WHEN (r.phs_r='1' AND r.phs_f='1') OR (r.phs_r='0' AND r.phs_f='1') ELSE r.dd_dat;
+  nxt_r.dd_val     <=                         '1' WHEN (r.phs_r='1' AND r.phs_f='1') OR (r.phs_r='0' AND r.phs_f='1') ELSE '0';
+  nxt_r.dd_raw_phs <= r.d_raw_phs & r.prev_d_raw_phs;  -- preserve captured dd phase for monitoring purposes
+  
+  nxt_r.prev_dd_raw_phs <= r.dd_raw_phs;
+  
+  nxt_r.dd_raw_phs_evt <= '1' WHEN r.prev_dd_raw_phs /= NOT r.dd_raw_phs ELSE '0';
+  nxt_r.dd_raw_phs_err <= '1' WHEN TO_UINT(r.dd_raw_phs)/=c_exp_raw_phs_arr(0) AND
+                                   TO_UINT(r.dd_raw_phs)/=c_exp_raw_phs_arr(1) AND
+                                   TO_UINT(r.dd_raw_phs)/=c_exp_raw_phs_arr(2) AND
+                                   TO_UINT(r.dd_raw_phs)/=c_exp_raw_phs_arr(3) ELSE '0';
+  
+  nxt_r.dd_phs_err <= '1' WHEN TO_UINT(r.dd_phs)/=c_exp_phs ELSE '0';
+  
+  ------------------------------------------------------------------------------
+  -- Monitor the word phase alignment
+  ------------------------------------------------------------------------------
+
+  -- Define detected, locked when the dp_phs = c_exp_phs, so not only that dp_phs does not change but also that it has the expected value.
+  -- . Note: a single sample phase shift due to missing a sample (when g_clk_drift=-2 ps in tb) is not noticed in realigned dd_phs. Therefore also check phs_evt and raw_phs.
+  nxt_r.dd_phs_detected <= '1' WHEN r.phs_evt='0' AND r.dd_raw_phs_evt='0' AND r.dd_phs_err='0' AND r.dd_raw_phs_err='0' ELSE '0';
+
+  u_common_stable_delayed : ENTITY common_lib.common_stable_delayed
+  GENERIC MAP (
+    g_active_level  => '1',
+    g_delayed_w     => g_dd_phs_locked_w
+  )
+  PORT MAP (
+    rst       => in_rst,
+    clk       => in_clk,
+    -- MM
+    r_in      => r.dd_phs_detected,
+    r_stable  => dd_phs_detected_ok
+  );
+  
+  -- Declare dd_phs_locked when dd_sync=0 to ensure the dd_sync will be detected when it is becoming 1 again.
+  nxt_r.dd_phs_locked <= '0' WHEN dd_phs_detected_ok='0' ELSE
+                         '1' WHEN dd_phs_detected_ok='1' AND r.dd_sync="0000" ELSE r.dd_phs_locked;
+  
+  
+  ------------------------------------------------------------------------------
+  -- Output
+  ------------------------------------------------------------------------------
+  
+  raw_phs          <= r.dd_raw_phs;
+  out_phs_locked   <= r.dd_phs_locked;
+  out_sync         <= r.dd_sync;
+  out_dat          <= r.dd_dat;
+  out_val          <= r.dd_val;
+  
+  ------------------------------------------------------------------------------
+  -- Registers
+  ------------------------------------------------------------------------------
+
+  p_reg : PROCESS(in_rst, in_clk)
+  BEGIN
+    IF in_rst='1' THEN
+      r.ref_init         <= '1';
+      r.ref_r_val        <= '0';
+      r.ref_f_val        <= '0';
+      r.ref_r            <= '1';
+      r.ref_f            <= '1';
+      r.phs_r_evt        <= '0';
+      r.phs_f_evt        <= '0';
+      r.phs_evt          <= '0';
+      r.phs_r            <= '0';
+      r.prev_phs_r       <= '0';
+      r.phs_f            <= '0';
+      r.prev_phs_f       <= '0';
+      r.sync_init        <= '1';
+      r.sync_r           <= '1';
+      r.prev_sync_r      <= '1';
+      r.sync_f           <= '1';
+      r.d_raw_phs        <= "00";
+      r.d_phs            <= "00";
+      r.prev_d_raw_phs   <= "00";
+      r.prev_d_phs       <= "00";
+      r.d_sync           <= "00";
+      r.prev_d_sync      <= "00";
+      r.dd_raw_phs       <= "0000";
+      r.prev_dd_raw_phs  <= "0000";
+      r.dd_raw_phs_evt   <= '0';
+      r.dd_raw_phs_err   <= '1';
+      r.dd_phs           <= "0000";
+      r.dd_phs_err       <= '1';
+      r.dd_phs_detected  <= '0';
+      r.dd_phs_locked    <= '0';
+      r.dd_sync          <= "0000";
+      r.dd_val           <= '0';
+    ELSIF rising_edge(in_clk) THEN
+      r <= nxt_r;
+    END IF;
+  END PROCESS;
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/lvdsh_dd_wb4.vhd b/libraries/io/aduh/src/vhdl/lvdsh_dd_wb4.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..5fc65b231d96fae591622344265a8e955332571f
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/lvdsh_dd_wb4.vhd
@@ -0,0 +1,590 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2014
+-- ASTRON (Netherlands Institute for Radio Astronomy) <http://www.astron.nl/>
+-- JIVE (Joint Institute for VLBI in Europe) <http://www.jive.nl/>
+-- P.O.Box 2, 7990 AA Dwingeloo, The Netherlands
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+
+-- Purpose: Handle the ADU-BN double data rate LVDS input interface with auto
+--          sample phase adjust for fixed g_wb_factor=4.
+-- Description:
+--   The in_clk is a double data rate clock as indicated by c_dd_factor=2. The
+--   DDIO elements near the pins capture the in_dat using the in_clk into two 
+--   parts in_dat_hi and in_dat_lo.
+--   The dp_clk runs at a c_rx_factor=2 lower rate than the in_clk. A mixed 
+--   width FIFO doubles the read data width of dp_dat.
+--   The dp_clk must be locked to the in_clk to avoid FIFO overflow and to be
+--   able to adjust for the g_wb_factor=4 sample phase uncertainty. With ADU
+--   the in_clk is the 800M sample clock divided by c_dd_factor=2 and the
+--   dp_clk is the sample clock divided by g_wb_factor=4.
+--   The phase of the in_clk depends on the divider phase of the ADC. The phase
+--   of the dp_clk with respect to the in_clk depends on the divide by 2 that
+--   is done by the mixed width FIFO. The in_clk and the dp_clk have a fixed
+--   but unknown phase relation between 0 and 3 = g_wb_factor-1 samples. The
+--   clock domain crossing from in_clk domain to dp_clk domain via the dual
+--   clock FIFO can also cause an extra uncertainty of 1 dp_clk cycle, so 4
+--   samples.
+--   An wb_sync pulse created in the dp_clk domain and read back via the FIFO
+--   is used to measure the actual in_clk - dp_clk phase relation (0, 1, 2
+--   or 3 sampes) and to measure the FIFO latency (integer multiple of 4
+--   samples). The phase offset and FIFO latency are then compensated for to
+--   ensure the same sample time t0 is captured by the same dp_clk cycle in all
+--   nodes. If the FIFO has the same latency for wb_sync - dp_sync then that
+--   means that t0 is aligned across all nodes, because dp_clk has the same
+--   phase in all nodes. The phase relation becomes fixed independent of the
+--   design that synthesizes it and also independent of system (ADU-BN) power
+--   up timing.
+--   It is important to maintain this phase relation inside the FPGA. This is
+--   taken care of thanks to the synchronous clock tree network inside an FPGA
+--   that is balanced such that the clock has the same phase at any location
+--   in the FPGA. The wb_sync pulse setup time from the dp_clk domain to the 
+--   in_clk domain needs to be as fixed as possible, independent of how it was 
+--   synthesized. This can be achieved by placing a logic lock region on the
+--   common_ddreg instance that takes care of the clock domain crossing. By
+--   forcing the logic to be placed within one ALM the setup time becomes
+--   sufficiently constant (delta ~< 100 ps) because the physical paths as
+--   short as feasible.
+-- Remarks:
+-- . Input buffer delays need to be set via constraints in the synthesis file.
+-- . The dp_dat output is big endian meaning that the first input data sample
+--   appears in the MS symbol. Using big endian format is conform the DP
+--   streaming interface.
+-- . The lvdsh_dd_wb4 avoids using a state machine with more than 2 states,
+--   because the more complex the state machine is the more difficult it is
+--   to ensure that it can not get into a dead-lock situation. Instead 
+--   implementation uses independ processes that take care of a single task. 
+    
+ENTITY lvdsh_dd_wb4 IS
+  GENERIC (
+    g_sim               : BOOLEAN := FALSE;
+    g_sim_phase         : NATURAL := 0;      -- range 0:3 (= g_wb_factor-1)
+    g_use_in_clk_rst    : BOOLEAN := FALSE;
+    g_wb_factor         : NATURAL := 4;      -- fixed wideband factor 4 = c_rx_factor*c_dd_factor
+    g_in_dat_w          : NATURAL := 8       -- nof PHY data bits
+  );
+  PORT (
+    -- PHY input interface
+    in_clk_rst    : OUT STD_LOGIC;
+    in_clk        : IN  STD_LOGIC;
+    in_dat        : IN  STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);   -- input samples [t0], [t1], [t2], [t3], [t4], [t5], [t6], [t7], ... --> time
+    
+    -- DD --> Rx domain interface at in_clk rate or g_dp_factor lower rate (via FIFO)
+    dp_rst        : IN  STD_LOGIC := '1';
+    dp_clk        : IN  STD_LOGIC := '1';
+    dp_clkq       : IN  STD_LOGIC := '0';
+    dp_dat        : OUT STD_LOGIC_VECTOR(g_wb_factor*g_in_dat_w-1 DOWNTO 0);   -- big endian output samples [t0, t1, t2, t3], [t4, t5, t6, t7], ...
+    dp_val        : OUT STD_LOGIC;
+    
+    -- Rx status monitor
+    dp_sync_phase : OUT NATURAL RANGE 0 TO 2*g_wb_factor-1;     -- valid dclk phases are 0:3 because g_wb_factor=4, however the detection need twice this range
+    dp_status     : OUT STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);  -- extra status information for debug
+    dp_locked     : OUT STD_LOGIC;
+    dp_stable     : OUT STD_LOGIC;
+    dp_stable_ack : IN  STD_LOGIC := '0'
+  );
+END lvdsh_dd_wb4;
+
+
+ARCHITECTURE str OF lvdsh_dd_wb4 IS
+
+  -- Debug constants for development only, default FALSE for functional
+  CONSTANT c_use_dbg_dat        : BOOLEAN := FALSE;
+  CONSTANT c_swap_in_hi_lo      : BOOLEAN := FALSE;
+  CONSTANT c_tsetup_delay_in_hi : BOOLEAN := FALSE;
+  CONSTANT c_tsetup_delay_in_lo : BOOLEAN := FALSE;
+    
+  CONSTANT c_dd_factor          : NATURAL := 2;                    -- fixed double data rate factor
+  CONSTANT c_rx_factor          : NATURAL := 2;                    -- fixed for g_wb_factor = c_rx_factor*c_dd_factor = 4
+  CONSTANT c_wb_sync_latency    : NATURAL := 16;                   -- nof dp_clk cycles from getting wb_sync back via dp_sync
+  CONSTANT c_wb_sync_period     : NATURAL := 32;                   -- nof dp_clk cycles for wb_sync period, must be > c_wb_sync_latency
+  CONSTANT c_wb_sync_timeout    : NATURAL := 1024;                 -- nof dp_clk cycles for wb_sync timeout, must be >>> c_wb_sync_latency
+  CONSTANT c_dp_fifo_margin     : NATURAL := 16;                                  -- rd side, almost full or almost empty margin
+  CONSTANT c_dp_fifo_size       : NATURAL := c_wb_sync_latency+c_dp_fifo_margin;  -- rd side
+  CONSTANT c_in_fifo_size       : NATURAL := c_rx_factor*c_dp_fifo_size;          -- wr side
+  
+  CONSTANT c_wb_cnt_w           : NATURAL := ceil_log2(c_wb_sync_timeout+1);
+  
+  CONSTANT c_wb_sync_w          : NATURAL := 1;
+  CONSTANT c_sync_in_dat_w      : NATURAL := c_wb_sync_w+g_in_dat_w;
+  
+  CONSTANT c_in_rst_extend_w    : NATURAL := 8;
+  CONSTANT c_in_rst_delay_len   : NATURAL := 4;  -- choose even value to fit expected g_sim_phase
+  
+  CONSTANT c_fifo_wr_dat_w      : NATURAL := c_dd_factor*c_sync_in_dat_w;
+  CONSTANT c_fifo_rd_dat_w      : NATURAL := c_rx_factor*c_fifo_wr_dat_w;
+  
+  CONSTANT c_rx_sync_w          : NATURAL := c_rx_factor*c_dd_factor*c_wb_sync_w;   -- = 4*1
+  CONSTANT c_rx_dat_w           : NATURAL := c_rx_factor*c_dd_factor*g_in_dat_w;
+  
+  TYPE t_reg IS RECORD
+    lock_state        : NATURAL RANGE 0 TO 255;
+    status            : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+    be_sync           : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+    be_dat            : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+    sync_phase        : NATURAL RANGE 0 TO 2*g_wb_factor-1;   -- valid dclk phases are 0:3 because g_wb_factor=4, however the detection need twice this range
+    dat_phase         : NATURAL RANGE 0 TO g_wb_factor-1;  -- valid dclk phases are 0:3 because g_wb_factor=4
+    rx_sync           : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+    rx_dat            : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+    rx_val            : STD_LOGIC;
+    dp_sync           : STD_LOGIC;
+    dp_fifo_rd_req    : STD_LOGIC;
+    dp_in_rst_req     : STD_LOGIC;
+    dp_locked         : STD_LOGIC;
+  END RECORD;
+  
+  -- DD clock domain (in_clk)
+  SIGNAL in_sync_hi_cap      : STD_LOGIC;
+  SIGNAL in_sync_lo_cap      : STD_LOGIC;
+  SIGNAL in_sync_hi          : STD_LOGIC;
+  SIGNAL in_sync_lo          : STD_LOGIC;
+  
+  SIGNAL in_dat_hi           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+  SIGNAL in_dat_lo           : STD_LOGIC_VECTOR(g_in_dat_w-1 DOWNTO 0);
+  
+  SIGNAL in_fifo_wr_req      : STD_LOGIC := '0';
+  SIGNAL in_fifo_wr_dat      : STD_LOGIC_VECTOR(c_fifo_wr_dat_w-1 DOWNTO 0);
+  SIGNAL in_fifo_wrusedw     : STD_LOGIC_VECTOR(ceil_log2(c_in_fifo_size)-1 DOWNTO 0);
+  SIGNAL dp_fifo_rdusedw     : STD_LOGIC_VECTOR(ceil_log2(c_dp_fifo_size)-1 DOWNTO 0);
+  
+  -- Rx-DD-Rx clock domain
+  SIGNAL dp_in_clk_rst       : STD_LOGIC_VECTOR(0 DOWNTO 0);
+  SIGNAL i_in_clk_rst        : STD_LOGIC_VECTOR(0 DOWNTO 0);
+  
+  SIGNAL dp_in_rst_ext       : STD_LOGIC;
+  SIGNAL in_rst_cap          : STD_LOGIC;
+  SIGNAL in_rst              : STD_LOGIC;
+  SIGNAL dp_rst_cap          : STD_LOGIC;
+  SIGNAL dp_cnt_rst          : STD_LOGIC;
+  SIGNAL dp_cnt_clr          : STD_LOGIC;
+  SIGNAL wb_cnt_clr          : STD_LOGIC;
+  SIGNAL wb_cnt              : STD_LOGIC_VECTOR(c_wb_cnt_w-1 DOWNTO 0);
+  SIGNAL wb_sync             : STD_LOGIC;
+  
+  -- Rx clock domain (dp_clk = rd_clk) for DSP
+  SIGNAL r, nxt_r            : t_reg;
+  
+  SIGNAL dp_fifo_rd_dat      : STD_LOGIC_VECTOR(c_fifo_rd_dat_w-1 DOWNTO 0);
+  SIGNAL dp_fifo_rd_val      : STD_LOGIC;
+  SIGNAL le_sync             : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+  SIGNAL le_dat              : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL be_sync             : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+  SIGNAL be_dat              : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  
+  SIGNAL dbg_dat             : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  
+  -- DD phase measurement
+  SIGNAL dd_phase            : STD_LOGIC;
+  SIGNAL prev_dd_phase       : STD_LOGIC;
+  SIGNAL dd_phase_det        : STD_LOGIC;
+  
+BEGIN
+
+  -- Map outputs
+  in_clk_rst <= i_in_clk_rst(0) WHEN g_use_in_clk_rst=TRUE ELSE '0';
+
+  dp_sync_phase <= r.sync_phase;
+  dp_status     <= r.status;
+  dp_locked     <= r.dp_locked;
+  dp_dat        <= r.rx_dat WHEN c_use_dbg_dat=FALSE ELSE dbg_dat;
+  dp_val        <= r.rx_val;
+  
+  p_dbg_dat : PROCESS(r, wb_cnt)
+  BEGIN
+    dbg_dat <= r.rx_dat;
+    dbg_dat( 7 DOWNTO  0) <= offset_binary(be_sync & TO_UVEC(r.sync_phase, 4));
+    dbg_dat(15 DOWNTO  8) <= offset_binary(TO_UVEC(r.lock_state, 8));
+    dbg_dat(23 DOWNTO 16) <= offset_binary(            wb_cnt(           7 DOWNTO 0));
+    dbg_dat(31 DOWNTO 24) <= offset_binary(RESIZE_UVEC(wb_cnt(c_wb_cnt_w-1 DOWNTO 8),8));
+  END PROCESS;
+  
+  -- Registers
+  p_dp_clk : PROCESS(dp_rst, dp_clk)
+  BEGIN
+    IF dp_rst='1' THEN
+      r.lock_state        <= 0;
+      r.status            <= (OTHERS=>'0');
+      r.be_sync           <= (OTHERS=>'0');
+      r.be_dat            <= (OTHERS=>'0');
+      r.sync_phase        <= 0;
+      r.dat_phase         <= 0;
+      r.rx_sync           <= (OTHERS=>'0');
+      r.rx_dat            <= (OTHERS=>'0');
+      r.rx_val            <= '0';
+      r.dp_sync           <= '0';
+      r.dp_fifo_rd_req    <= '1';
+      r.dp_in_rst_req     <= '1';
+      r.dp_locked         <= '0';
+    ELSIF rising_edge(dp_clk) THEN
+      r <= nxt_r;
+    END IF;
+  END PROCESS;
+  
+  -- Reset input section when lock is lost
+  u_common_pulse_extend : ENTITY common_lib.common_pulse_extend
+  GENERIC MAP (
+    g_rst_level    => '1',
+    g_p_in_level   => '1',
+    g_ep_out_level => '1',
+    g_extend_w     => c_in_rst_extend_w
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    p_in    => r.dp_in_rst_req,
+    ep_out  => dp_in_rst_ext
+  );
+  
+  u_common_async_in : ENTITY common_lib.common_async
+  GENERIC MAP (
+    g_rst_level => '1',
+    g_delay_len => c_in_rst_delay_len
+  )
+  PORT MAP (
+    rst  => dp_in_rst_ext,
+    clk  => in_clk,
+    din  => '0',
+    dout => in_rst_cap
+  );
+  
+  u_common_async_dp : ENTITY common_lib.common_async
+  GENERIC MAP (
+    g_rst_level => '1',
+    g_delay_len => c_in_rst_delay_len
+  )
+  PORT MAP (
+    rst  => in_rst_cap,
+    clk  => dp_clk,
+    din  => '0',
+    dout => dp_rst_cap
+  );
+  
+  gen_hw : IF g_sim=FALSE GENERATE
+    in_rst <= in_rst_cap;
+  END GENERATE;
+  gen_sim : IF g_sim=TRUE GENERATE
+    -- Model in_clk to dp_clk divide by 2 uncertainty by delaying the in_rst one in_clk cycle in case g_sim_phase is even
+    gen_even : IF g_sim_phase=0 OR g_sim_phase=1 GENERATE in_rst <= in_rst_cap WHEN rising_edge(in_clk); END GENERATE;
+    gen_odd  : IF g_sim_phase=2 OR g_sim_phase=3 GENERATE in_rst <= in_rst_cap;                          END GENERATE;
+  END GENERATE;
+  
+  -- Double data rate input cell at pin, also ensures deterministic input timing
+  u_common_ddio_in : ENTITY common_lib.common_ddio_in
+  GENERIC MAP (
+    g_width => g_in_dat_w
+  )
+  PORT MAP (
+    in_dat      => in_dat,
+    in_clk      => in_clk,
+    rst         => in_rst,
+    out_dat_hi  => in_dat_hi,
+    out_dat_lo  => in_dat_lo
+  );
+  
+  u_common_ddreg : ENTITY common_lib.common_ddreg
+  GENERIC MAP (
+    g_in_delay_len    => 1,
+    g_out_delay_len   => 2+c_meta_delay_len,
+    g_tsetup_delay_hi => c_tsetup_delay_in_hi,
+    g_tsetup_delay_lo => c_tsetup_delay_in_lo
+  )
+  PORT MAP (
+    in_clk      => dp_clk,
+    in_dat      => wb_sync,
+    rst         => in_rst,
+    out_clk     => in_clk,
+    out_dat_hi  => in_sync_hi_cap,
+    out_dat_lo  => in_sync_lo_cap
+  );  
+  
+  in_sync_hi <= in_sync_hi_cap WHEN c_swap_in_hi_lo=FALSE ELSE in_sync_lo_cap;
+  in_sync_lo <= in_sync_lo_cap WHEN c_swap_in_hi_lo=FALSE ELSE in_sync_hi_cap;
+  
+  -- Register fifo_wr_dat to ease timing closure between DDIO and FIFO at input clock rate
+  in_fifo_wr_dat <= (in_sync_hi & in_dat_hi) & (in_sync_lo & in_dat_lo) WHEN rising_edge(in_clk);  
+  in_fifo_wr_req <= '1';
+  
+  -- Dual clock FIFO, mixed width
+  u_common_fifo_dc_mixed_widths : ENTITY common_lib.common_fifo_dc_mixed_widths
+  GENERIC MAP (
+    g_nof_words => c_in_fifo_size,  -- FIFO size in nof wr_dat words
+    g_wr_dat_w  => c_fifo_wr_dat_w,
+    g_rd_dat_w  => c_fifo_rd_dat_w
+  )
+  PORT MAP (
+    rst     => in_rst,
+    wr_clk  => in_clk,
+    wr_dat  => in_fifo_wr_dat,
+    wr_req  => in_fifo_wr_req,
+    wr_ful  => OPEN,
+    wrusedw => in_fifo_wrusedw,
+    rd_clk  => dp_clk,
+    rd_dat  => dp_fifo_rd_dat,
+    rd_req  => r.dp_fifo_rd_req,
+    rd_emp  => OPEN,
+    rdusedw => dp_fifo_rdusedw,
+    rd_val  => dp_fifo_rd_val
+  );
+  
+  -- Double data rate capture dp_clk phase using wb_sync
+  u_common_pulser : ENTITY common_lib.common_pulser
+  GENERIC MAP (
+    g_pulse_period => c_wb_sync_period
+  )
+  PORT MAP (
+    rst       => dp_rst,
+    clk       => dp_clk,
+    pulse_out => wb_sync
+  );
+  
+  -- Extract sync and data. The FIFO output is in little endian order, symbol index [3:0] = sample [t3 t2 t1 t0]
+  gen_le : FOR I IN 0 TO g_wb_factor-1 GENERATE
+    le_sync(                         I           ) <= dp_fifo_rd_dat(g_in_dat_w+I*c_sync_in_dat_w) AND dp_fifo_rd_val;          -- only accept sync when there is valid FIFO read data
+    le_dat((I+1)*g_in_dat_w-1 DOWNTO I*g_in_dat_w) <= dp_fifo_rd_dat(g_in_dat_w+I*c_sync_in_dat_w-1 DOWNTO I*c_sync_in_dat_w);
+  END GENERATE;
+  
+  -- Rewire to big endian sample order, symbol index [3:0] = sample [t0 t1 t2 t3]
+  be_sync <= hton(le_sync, c_wb_sync_w, g_wb_factor);
+  be_dat  <= hton(le_dat,   g_in_dat_w, g_wb_factor);  
+  
+  -- Determine in_clk - dp_clk phase
+  nxt_r.be_sync <= be_sync;
+  nxt_r.be_dat  <= be_dat;
+
+  p_phase_detect : PROCESS(r, be_sync, wb_cnt)
+  BEGIN
+    -- It is not necessary to have:
+    -- . a phase_val signal that is active when a valid be_sync is detected for every c_wb_sync_latency period,
+    -- . a phase_evt signal that pulses when the detected phase changes,
+    -- because these cases of a missed phase sync and a changed phase are handled in p_locked.
+    
+    -- Set phase based on where the valid be_sync "1111" is detected in two cycles
+    -- Signal illegal be_sync combinations that can occur if the in_clk and dp_clk edges are too close
+    nxt_r.sync_phase <= r.sync_phase;
+    IF r.be_sync="1111" AND be_sync="0000" THEN nxt_r.sync_phase <= 0; END IF;  -- F0
+    IF r.be_sync="0111" AND be_sync="1000" THEN nxt_r.sync_phase <= 1; END IF;  -- 78
+    IF r.be_sync="0011" AND be_sync="1100" THEN nxt_r.sync_phase <= 2; END IF;  -- 3C
+    IF r.be_sync="0001" AND be_sync="1110" THEN nxt_r.sync_phase <= 3; END IF;  -- 1E
+    IF r.be_sync="1011" AND be_sync="0100" THEN nxt_r.sync_phase <= 5; END IF;  -- B4 = swap hi lo of 78, so map to phase 4+1=5
+    IF r.be_sync="0010" AND be_sync="1101" THEN nxt_r.sync_phase <= 7; END IF;  -- 2D = swap hi lo of 1E, so map to phase 4+3=7
+                                                                                -- F0 = swap hi lo of F0, so phase 4 cannot be distinghuised from phase 0
+                                                                                -- 3C = swap hi lo of 3C, so phase 6 cannot be distinghuised from phase 2
+    -- Map sync_phase 0:3 and 5:7 on dat_phase 0:3
+    IF r.sync_phase<g_wb_factor THEN
+      nxt_r.dat_phase <= r.sync_phase;
+    ELSE
+      nxt_r.dat_phase <= r.sync_phase-g_wb_factor;
+    END IF;
+  END PROCESS;
+    
+  p_debug_status : PROCESS(r, be_sync, wb_cnt, dd_phase)
+  BEGIN
+    -- Debug status
+    nxt_r.status <= r.status;
+    nxt_r.status(7 DOWNTO 4) <= TO_UVEC(r.sync_phase, 4);
+    nxt_r.status(7 DOWNTO 4) <= "000"& dd_phase;
+    IF r.be_sync="1111" OR (r.be_sync/="0000" AND be_sync/="0000") THEN
+      nxt_r.status(15 DOWNTO 8) <= r.be_sync & be_sync;
+    END IF;
+    IF be_sync/="0000" THEN
+      nxt_r.status(23 DOWNTO 16) <= r.be_sync & be_sync;
+    ELSIF UNSIGNED(wb_cnt)>c_wb_sync_latency THEN
+      nxt_r.status(23 DOWNTO 16) <= (OTHERS=>'0');
+    END IF;
+    nxt_r.status(31 DOWNTO 24) <= TO_UVEC(r.lock_state, 8);
+  END PROCESS;
+  
+  p_phase_adjust : PROCESS(r, be_sync, be_dat)
+    VARIABLE v_rsync : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+    VARIABLE v_sync  : STD_LOGIC_VECTOR(c_rx_sync_w-1 DOWNTO 0);
+  BEGIN
+    v_rsync := r.be_sync(2) & r.be_sync(3) & r.be_sync(0) & r.be_sync(1);  -- swap hi lo
+    v_sync  :=   be_sync(2) &   be_sync(3) &   be_sync(0) &   be_sync(1);  -- swap hi lo
+  
+    nxt_r.rx_sync <= (OTHERS=>'0');
+    CASE r.sync_phase IS
+      WHEN 0      => nxt_r.rx_sync <= r.be_sync;
+      WHEN 1      => nxt_r.rx_sync <= r.be_sync(2 DOWNTO 0) & be_sync(3);
+      WHEN 2      => nxt_r.rx_sync <= r.be_sync(1 DOWNTO 0) & be_sync(3 DOWNTO 2);
+      WHEN 3      => nxt_r.rx_sync <= r.be_sync(0)          & be_sync(3 DOWNTO 1);
+      WHEN 5      => nxt_r.rx_sync <=   v_rsync(2 DOWNTO 0) &  v_sync(3);           -- as phase 1
+      WHEN 7      => nxt_r.rx_sync <=   v_rsync(0)          &  v_sync(3 DOWNTO 1);  -- as phase 3
+      WHEN OTHERS => NULL;
+    END CASE;
+    
+    nxt_r.rx_dat <= r.be_dat;
+    CASE r.dat_phase IS
+      WHEN 0      => nxt_r.rx_dat <= r.be_dat;
+      WHEN 1      => nxt_r.rx_dat <= r.be_dat(3*g_in_dat_w-1 DOWNTO 0) & be_dat(4*g_in_dat_w-1 DOWNTO 3*g_in_dat_w);
+      WHEN 2      => nxt_r.rx_dat <= r.be_dat(2*g_in_dat_w-1 DOWNTO 0) & be_dat(4*g_in_dat_w-1 DOWNTO 2*g_in_dat_w);
+      WHEN 3      => nxt_r.rx_dat <= r.be_dat(1*g_in_dat_w-1 DOWNTO 0) & be_dat(4*g_in_dat_w-1 DOWNTO 1*g_in_dat_w);
+      WHEN OTHERS => NULL;
+    END CASE;
+  END PROCESS;
+  
+  nxt_r.rx_val <= dp_fifo_rd_val;
+  
+  -- By means of a lock region on u_common_ddreg and a suitable PLL phase offset for the dp_clk it can be ensured that both:
+  -- . be_sync_hi = be_sync(3) & be_sync(1) captured by in_clk rising edge, and
+  -- . be_sync_lo = be_sync(2) & be_sync(0) captured by in_clk falling edge are "11" at the same time and "00" otherwise.
+  -- Both be_sync_hi and be_sync_lo must have reliably captured the wb_sync, because we need both to detect the g_wb_factor=4 possible phases for r.sync_phase.
+  -- For example with only be_sync_hi the phase detect would yield:
+  --   IF r.be_sync_hi="11" AND be_sync="00" THEN nxt_r.sync_phase <= 0; END IF;
+  --   IF r.be_sync_hi="01" AND be_sync="10" THEN nxt_r.sync_phase <= 1; END IF;
+  --   IF r.be_sync_hi="01" AND be_sync="10" THEN nxt_r.sync_phase <= 2; END IF;   -- 1=2, and
+  --   IF r.be_sync_hi="00" AND be_sync="11" THEN nxt_r.sync_phase <= 3; END IF;   -- 0=3, so using only be_sync_hi or only be_sync_lo is not enough
+  -- Therefore the recovered dp_sync is only detected when rx_sync="1111" or "0000".
+  nxt_r.dp_sync <= vector_and(r.rx_sync);
+  
+  -- Measure wb_sync to dp_sync latency
+  u_common_counter : ENTITY common_lib.common_counter
+  GENERIC MAP (
+    g_width => c_wb_cnt_w
+  )
+  PORT MAP (
+    rst     => dp_rst,
+    clk     => dp_clk,
+    cnt_clr => wb_cnt_clr,
+    count   => wb_cnt
+  );
+  
+  wb_cnt_clr <= dp_cnt_clr OR dp_cnt_rst;
+
+  u_common_switch_dp_cnt_rst : ENTITY common_lib.common_switch
+  GENERIC MAP (
+    g_rst_level    => '1',    -- Defines the output level at reset.
+    g_priority_lo  => FALSE,  -- When TRUE then input switch_low has priority, else switch_high. Don't care when switch_high and switch_low are pulses that do not occur simultaneously.
+    g_or_high      => FALSE,  -- When TRUE and priority hi then the registered switch_level is OR-ed with the input switch_high to get out_level, else out_level is the registered switch_level
+    g_and_low      => FALSE   -- When TRUE and priority lo then the registered switch_level is AND-ed with the input switch_low to get out_level, else out_level is the registered switch_level
+  )
+  PORT MAP (
+    rst         => dp_rst,
+    clk         => dp_clk,
+    switch_high => dp_rst_cap,
+    switch_low  => wb_sync,
+    out_level   => dp_cnt_rst
+  );
+    
+  u_common_switch_dp_cnt_clr : ENTITY common_lib.common_switch
+  GENERIC MAP (
+    g_rst_level    => '1',    -- Defines the output level at reset.
+    g_priority_lo  => TRUE,   -- When TRUE then input switch_low has priority, else switch_high. Don't care when switch_high and switch_low are pulses that do not occur simultaneously.
+    g_or_high      => TRUE,   -- When TRUE and priority hi then the registered switch_level is OR-ed with the input switch_high to get out_level, else out_level is the registered switch_level
+    g_and_low      => FALSE   -- When TRUE and priority lo then the registered switch_level is AND-ed with the input switch_low to get out_level, else out_level is the registered switch_level
+  )
+  PORT MAP (
+    rst         => dp_rst,
+    clk         => dp_clk,
+    switch_high => r.dp_sync,
+    switch_low  => wb_sync,
+    out_level   => dp_cnt_clr
+  );
+  
+  p_locked : PROCESS(r, wb_cnt)
+  BEGIN
+    nxt_r.dp_fifo_rd_req <= '1';
+    nxt_r.dp_in_rst_req  <= '0';
+    nxt_r.dp_locked      <= r.dp_locked;
+    nxt_r.lock_state     <= r.lock_state;
+    IF UNSIGNED(wb_cnt)<c_wb_sync_timeout THEN
+      IF r.dp_locked='0' THEN
+        -- Find lock
+        nxt_r.lock_state <= 1;
+        IF r.dp_sync='1' THEN
+          IF UNSIGNED(wb_cnt)<c_wb_sync_latency THEN
+            -- too early r.dp_sync so slip 1 cycle to adjust the FIFO latency to c_wb_sync_latency
+            nxt_r.dp_fifo_rd_req <= '0';
+            nxt_r.lock_state <= 2;
+          ELSIF UNSIGNED(wb_cnt)=c_wb_sync_latency THEN
+            -- aligned r.dp_sync so declare locked
+            nxt_r.dp_locked <= '1';
+            nxt_r.lock_state <= 3;
+          ELSE
+            -- too late r.dp_sync
+            nxt_r.dp_in_rst_req <= '1';  -- recover by resetting the input
+            nxt_r.lock_state <= 4;
+          END IF;
+        END IF;
+      ELSE
+        -- Maintain lock
+        -- . do not accept unexpected sync
+        -- . do allow missing an r.dp_sync, but require at least one r.dp_sync per c_wb_sync_timeout)
+        IF r.dp_sync='1' THEN
+          IF UNSIGNED(wb_cnt)/=c_wb_sync_latency THEN
+            -- unexpected r.dp_sync
+            nxt_r.dp_in_rst_req <= '1';  -- recover by resetting the input,
+            nxt_r.dp_locked     <= '0';  -- and finding lock again
+            nxt_r.lock_state <= 5;
+          END IF;
+        END IF;
+      END IF;
+    ELSE
+      -- Timeout r.dp_sync
+      nxt_r.dp_in_rst_req <= '1';  -- recover by resetting the input,
+      nxt_r.dp_locked     <= '0';  -- and finding lock again
+      nxt_r.lock_state <= 6;
+    END IF;
+  END PROCESS;
+    
+  u_common_clock_phase_detector : ENTITY common_lib.common_clock_phase_detector
+  GENERIC MAP (
+    g_rising_edge    => TRUE,
+    g_meta_delay_len => c_meta_delay_len
+  )
+  PORT MAP (
+    in_clk    => in_clk,    -- used as data input for dp_clk
+    rst       => dp_rst,
+    clk       => dp_clk,
+    --clk       => dp_clkq,
+    phase     => dd_phase,
+    phase_det => OPEN
+  );  
+  
+  prev_dd_phase <= dd_phase WHEN rising_edge(dp_clk);
+  dd_phase_det <= '1' WHEN prev_dd_phase=dd_phase ELSE '0';
+  
+  u_common_stable_monitor : ENTITY common_lib.common_stable_monitor
+  PORT MAP (
+    rst          => dp_rst,
+    clk          => dp_clk,
+    -- MM
+    r_in         => dd_phase_det,
+    --r_in         => r.dp_locked,
+    r_stable     => dp_stable,
+    r_stable_ack => dp_stable_ack
+  );
+  
+  dp_in_clk_rst(0) <= r.dp_in_rst_req;
+  
+  u_common_ddio_out : ENTITY common_lib.common_ddio_out
+  GENERIC MAP (
+    g_width  => 1
+  )
+  PORT MAP (
+    rst        => '0',
+    in_clk     => dp_clk,
+    in_dat_hi  => dp_in_clk_rst,
+    in_dat_lo  => dp_in_clk_rst,
+    out_dat    => i_in_clk_rst
+  );
+
+END str;
diff --git a/libraries/io/aduh/src/vhdl/lvdsh_pll.vhd b/libraries/io/aduh/src/vhdl/lvdsh_pll.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..dfba89a7dfd77de78854a6eca6c5d02b8cc3aca6
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/lvdsh_pll.vhd
@@ -0,0 +1,446 @@
+-------------------------------------------------------------------------------
+--
+-- Copyright (C) 2010
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE IEEE.NUMERIC_STD.ALL;
+USE common_lib.common_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+
+-- Purpose: Handle an LVDS Rx interface on a BN using a PLL
+-- Description:
+--   The LVDS Rx interface has input data at a rate g_lvds_data_rate = 800 Mbps.
+--   The frequency of the reference clock for this LVDS Rx data is given by
+--   g_lvds_clk_freq = 400 MHz for the LVDS clock from ADU or e.g. 200 MHz in
+--   case the dp_clk digital processing clock is also used as LVDS clock (i.e.
+--   then externally dp_clk connects to dp_clk as well as to lvds_clk).
+--   The phase skew of the reference clock relative to the LVDS data can be
+--   given via g_lvds_clk_phase.
+--   The actual g_deser_factor depends on the ratio of the LVDS data rate and 
+--   the digital processing clock frequency and is given by g_deser_factor. 
+--   When the digital processing clock runs at 200 MHz then g_deser_factor=4
+--   and then this lvdsh_pll needs to uses a PLL to de-serialize the LVDS Rx
+--   data. However when g_use_ddio = TRUE and the digital processing clock runs
+--   at 400 MHz (so g_deser_factor=2) and then this lvdsh_pll can use DDIO to
+--   capture the LVDS data without using a PLL.
+--   DPA requires using a PLL, so then g_use_ddio must be FALSE.
+--
+-- Remarks:
+-- . With ADU the lvds_dat data comes in with a DDR lvds_clk clock, so a deser
+--   factor of 2, but the fabric logic in the FPGA needs to process it at a 4
+--   times lower rate, so g_deser_factor = 4. Therefore this lvdsh_pll supports
+--   these different deser factors by having two separate generics
+--   g_lvds_clk_freq for the ADU side and g_deser_factor for the FPGA fabric
+--   side.
+--
+-- . DPA can only be used with the two PLLs on the BN LVDS side. Using DPA
+--   assumes that the LVDS data has transitions for each line. For an ADC
+--   that outputs signed numbers that will be true provided that any DC offset
+--   is smaller than the input signal peak-peak range. Otherwise we may have
+--   to initially use the ADC test pattern mode to train the DPA.
+--
+-- . The dp_pll_reset input could also be connected inside this component by
+--   adding rx_clk active detection logic based on the dp_clk. Both the dp_clk
+--   and the rx_clk run at the same frequency. Hence if both clock a counter
+--   and the rx_clk counter starts to differ to much from the dp_clk counter,
+--   then the dp_pll_reset can be asserted. This can also be detected by means
+--   of the rx_clk - dp_clk clock domain crossing FIFO. If this u_cross_fifo
+--   runs full or empty then there is something wrong with the dp_clk - rx_clk
+--   relation (e.g. rx_clk stopped, because ADU was removed, or one or both
+--   of the clocks have lost lock to their common source).
+    
+ENTITY lvdsh_pll IS
+  GENERIC (
+    g_lvds_w           : NATURAL := 16;     -- bits
+    g_lvds_data_rate   : NATURAL := 800;    -- Msps
+    g_lvds_clk_freq    : NATURAL := 400;    -- MHz
+    g_lvds_clk_phase   : NATURAL := 0;      -- degrees, only for no DPA
+    g_use_lvds_clk_rst : BOOLEAN := FALSE;
+    g_deser_factor     : NATURAL := 4;
+    g_use_dpa          : BOOLEAN := TRUE;
+    g_use_ddio         : BOOLEAN := FALSE
+  );
+  PORT (
+    -- PHY LVDS Interface
+    lvds_clk_rst      : OUT   STD_LOGIC;          -- release synchronises lvds_clk phase
+    lvds_clk          : IN    STD_LOGIC;
+    lvds_dat          : IN    STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);
+    
+    -- DP Streaming Interface
+    dp_clk            : IN    STD_LOGIC;          -- dp_clk frequency is g_lvds_data_rate / g_deser_factor
+    
+    -- . Control
+    dp_lvds_reset     : IN    STD_LOGIC := '0';   -- LVDS interface reset, necessary if the lvds_clk was not present at power up or if it was temporarily removed
+    dp_delay_settings : IN    t_natural_arr(g_lvds_w-1 DOWNTO 0) := array_init(0, g_lvds_w);  -- only used for non DPA mode
+    dp_cda_settings   : IN    t_natural_arr(g_lvds_w-1 DOWNTO 0) := array_init(0, g_lvds_w);
+    
+    -- . Streaming
+    dp_dat            : OUT   STD_LOGIC_VECTOR(g_deser_factor*g_lvds_w-1 DOWNTO 0);
+    dp_val            : OUT   STD_LOGIC
+  );
+END lvdsh_pll;
+
+
+ARCHITECTURE rtl OF lvdsh_pll IS
+
+  -- Default use c_use_dp_clk_for_cda_reset is TRUE to use dp_clk to reset the
+  -- CDA to avoid g_deser_factor lvds_clk divider phase uncertainty. Else use
+  -- rx_clk for investigation purposes to try whether lvds_clk divider phase
+  -- uncertainty will occur or on target. The uncertainty appears independend
+  -- of wheteher dp_clk is used or not, because the CDA IP function internally
+  -- probably reclocks the CDA reset to the rx_clk domain.
+  CONSTANT c_use_dp_clk_for_cda_reset : BOOLEAN := TRUE;
+  
+  CONSTANT c_wait_cnt_w               : NATURAL := 5;  -- >=1, use wider, e.g. 5, to be able to recognize the rx_dat result during each CDA control step in simulation
+  
+  CONSTANT c_rx_dat_w                 : NATURAL := g_deser_factor*g_lvds_w;
+  
+  TYPE t_cda_state IS (s_cda_reset, s_cda_ctrl, s_cda_wait, s_cda_done);
+  
+  -- PLL control
+  SIGNAL dp_lvds_reset_release : STD_LOGIC;
+  SIGNAL dp_pll_reset          : STD_LOGIC;
+  SIGNAL pll_locked            : STD_LOGIC;  -- LVDS_RX PLL locked (called rx_locked, but simulation shows it is asynchronous to rx_clk)
+  SIGNAL rx_pll_locked         : STD_LOGIC;
+  
+  -- DPA control
+  SIGNAL rx_cda_settings      : t_natural_arr(g_lvds_w-1 DOWNTO 0) := array_init(0, g_lvds_w);
+  SIGNAL rx_dpa_reset         : STD_LOGIC;                              -- LVDS DPA reset (called rx_reset)
+  SIGNAL rx_dpa_reset_slv     : STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);
+  SIGNAL rx_dpa_locked_slv    : STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);  -- LVDS DPA locked
+  SIGNAL rx_dpa_locked        : STD_LOGIC;
+  SIGNAL rx_fifo_reset        : STD_LOGIC;
+  SIGNAL rx_fifo_reset_slv    : STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);
+  
+  -- Deserialized data
+  SIGNAL rx_clk               : STD_LOGIC;  -- same frequency as dp_clk, but with unknown phase offset
+  SIGNAL rx_eye_locked        : STD_LOGIC;  -- sampling occurs in the eye
+  SIGNAL nxt_rx_eye_locked    : STD_LOGIC;
+  
+  -- Channel Data Alignment
+  SIGNAL dp_cda_reset         : STD_LOGIC;
+  SIGNAL rx_cda_reset         : STD_LOGIC;
+  SIGNAL cda_reset_slv        : STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);
+  SIGNAL rx_cda_state         : t_cda_state;
+  SIGNAL nxt_rx_cda_state     : t_cda_state;
+  SIGNAL rx_cda_ctrl          : STD_LOGIC_VECTOR(g_lvds_w-1 DOWNTO 0);
+  SIGNAL nxt_rx_cda_ctrl      : STD_LOGIC_VECTOR(rx_cda_ctrl'RANGE);
+  SIGNAL rx_cda_cnt           : NATURAL RANGE 0 TO g_deser_factor-1;
+  SIGNAL nxt_rx_cda_cnt       : NATURAL;
+  SIGNAL rx_cda_cnt_en        : STD_LOGIC;
+  SIGNAL rx_wait_cnt          : STD_LOGIC_VECTOR(c_wait_cnt_w-1 DOWNTO 0);
+  SIGNAL nxt_rx_wait_cnt      : STD_LOGIC_VECTOR(c_wait_cnt_w-1 DOWNTO 0);
+  SIGNAL rx_wait_cnt_clr      : STD_LOGIC;
+  
+  -- Deserialized word aligned data
+  SIGNAL rx_dat               : STD_LOGIC_VECTOR(c_rx_dat_w-1 DOWNTO 0);
+  SIGNAL rx_val               : STD_LOGIC;
+  SIGNAL nxt_rx_val           : STD_LOGIC;
+  
+BEGIN
+
+  ASSERT g_use_ddio=FALSE
+    REPORT "lvdsh_pll.vhd: LVDS Rx using DDIO without PLL is not supported yet" SEVERITY FAILURE;
+    
+  no_lvds_clk_rst : IF g_use_lvds_clk_rst=FALSE GENERATE
+    lvds_clk_rst <= '0';
+    dp_pll_reset <= dp_lvds_reset;
+  END GENERATE;
+  
+  gen_lvds_clk_rst : IF g_use_lvds_clk_rst=TRUE GENERATE
+    ---------------------------------------------------------------------------
+    -- Synchronise SCLK -> DCLK divider using dp_clk
+    ---------------------------------------------------------------------------
+    
+    -- Assign fixed output delay for D5 (0-15 steps of 50 ps, so 750 ps max)
+    -- and D6 (0-7 steps of 50 ps, so 350 ps max) via the Quartus, because the
+    -- ALTIOBUF MegaWizard IP component can not set this from VHDL.
+    -- The ALTIOBUF can be used in case dynamic output delay is needed, but
+    -- since all ADU - BN interfaces have the same skew between SCLK and
+    -- DCLK_RST using a fixed output delay setting seems OK.
+    
+    -- Use the release of dp_lvds_reset to start the lvds_clk_rst pulse.
+    u_lvds_reset_release : ENTITY common_lib.common_evt
+    GENERIC MAP (
+      g_evt_type => "FALLING",
+      g_out_reg  => TRUE
+    )
+    PORT MAP (
+      clk      => dp_clk,
+      in_sig   => dp_lvds_reset,
+      out_evt  => dp_lvds_reset_release
+    );
+    
+    -- Keep the lvds_clk_rst active for at least 4 sample clock in case of
+    -- adc08d1020, so at least 4/g_deser_factor=1 dp_clk cycles.
+    u_lvds_clk_reset : ENTITY common_lib.common_pulse_extend
+    GENERIC MAP (
+      g_rst_level    => '0',
+      g_p_in_level   => '1',
+      g_ep_out_level => '1',
+      g_extend_w     => 1  -- ep_out will be active for 2**1 = 2 dp_clk cyles
+    )
+    PORT MAP (
+      clk     => dp_clk,
+      p_in    => dp_lvds_reset_release,
+      ep_out  => lvds_clk_rst
+    );
+    
+    -- Release the LVDS_RX PLL reset somewhat later to be sure that the lvds_clk
+    -- is active again after the lvds_clk_rst.
+    u_pll_reset : ENTITY common_lib.common_pulse_extend
+    GENERIC MAP (
+      g_rst_level    => '1',
+      g_p_in_level   => '1',
+      g_ep_out_level => '1',
+      g_extend_w     => 4  -- ep_out will be active for 2**4 = 16 dp_clk cyles
+    )
+    PORT MAP (
+      clk     => dp_clk,
+      p_in    => dp_lvds_reset,
+      ep_out  => dp_pll_reset
+    );
+  END GENERATE;
+  
+  ---------------------------------------------------------------------------
+  -- Input no DPA
+  ---------------------------------------------------------------------------
+  
+  no_dpa : IF g_use_dpa=FALSE GENERATE
+
+    u_lvds_rx : ENTITY work.lvds_rx
+    GENERIC MAP (
+      g_lvds_w         => g_lvds_w,
+      g_lvds_data_rate => g_lvds_data_rate,
+      g_lvds_clk_freq  => g_lvds_clk_freq,
+      g_lvds_clk_phase => g_lvds_clk_phase,
+      g_deser_factor   => g_deser_factor
+    )
+    PORT MAP (
+      pll_areset            => dp_pll_reset,      -- asynchronous, minimum pulse width is 10 ns
+      rx_cda_reset          => cda_reset_slv,     -- asynchronous, minimum pulse width is 1 rx_outclock cycle
+      rx_channel_data_align => rx_cda_ctrl,       -- the data slips one bit for every pulse, minimum pulse width is 1 rx_outclock cycle
+      rx_in                 => lvds_dat,
+      rx_inclock            => lvds_clk,
+      rx_locked             => pll_locked,
+      rx_out                => rx_dat,
+      rx_outclock           => rx_clk
+    );
+    
+    nxt_rx_eye_locked <= rx_pll_locked;
+  
+  END GENERATE;  -- no_dpa
+
+  ---------------------------------------------------------------------------
+  -- Input use DPA
+  ---------------------------------------------------------------------------
+
+  gen_dpa : IF g_use_dpa=TRUE GENERATE
+  
+    u_lvds_rx_dpa : ENTITY work.lvds_rx_dpa
+    GENERIC MAP (
+      g_lvds_w         => g_lvds_w,
+      g_lvds_data_rate => g_lvds_data_rate,
+      g_lvds_clk_freq  => g_lvds_clk_freq,
+      g_deser_factor   => g_deser_factor
+    )
+    PORT MAP (
+         pll_areset            => dp_pll_reset,       -- asynchronous, minimum pulse width is 10 ns
+         rx_cda_reset          => cda_reset_slv,      -- asynchronous, minimum pulse width is 1 rx_outclock cycle
+         rx_channel_data_align => rx_cda_ctrl,        -- the data slips one bit for every pulse, minimum pulse width is 1 rx_outclock cycle
+         rx_fifo_reset         => rx_fifo_reset_slv,  -- asynchronous, minimum pulse width is 1 rx_outclock cycle
+         rx_in                 => lvds_dat,
+         rx_inclock            => lvds_clk,
+         rx_reset              => rx_dpa_reset_slv,   -- asynchronous, minimum pulse width is 1 rx_outclock cycle
+         rx_dpa_locked         => rx_dpa_locked_slv,
+         rx_locked             => pll_locked,
+         rx_out                => rx_dat,
+         rx_outclock           => rx_clk
+    );
+    
+    p_rx_dpa_reset : PROCESS(dp_pll_reset, rx_clk)
+    BEGIN
+      IF dp_pll_reset='1' THEN
+        rx_dpa_reset <= '1';
+      ELSIF rising_edge(rx_clk) THEN
+        rx_dpa_reset <= NOT rx_pll_locked;  -- release the DPA reset after the PLL has locked
+      END IF;
+    END PROCESS;
+    
+    rx_dpa_reset_slv <= (OTHERS=>rx_dpa_reset);
+    
+    rx_dpa_locked <= vector_and(rx_dpa_locked_slv);
+    
+    nxt_rx_eye_locked <= rx_dpa_locked;
+        
+    u_rx_fifo_reset_evt : ENTITY common_lib.common_evt
+    GENERIC MAP (
+      g_evt_type => "RISING",
+      g_out_reg  => TRUE
+    )
+    PORT MAP (
+      rst      => dp_pll_reset,
+      clk      => rx_clk,
+      in_sig   => rx_eye_locked,
+      out_evt  => rx_fifo_reset       -- reset the DPA FIFO after the DPA got locked
+    );
+    
+    rx_fifo_reset_slv <= (OTHERS=>rx_fifo_reset);
+    
+  END GENERATE;  -- gen_dpa
+  
+  p_rx_dpa_reg : PROCESS(dp_pll_reset, rx_clk)
+  BEGIN
+    IF dp_pll_reset='1' THEN
+      rx_pll_locked <= '0';
+      rx_eye_locked <= '0';
+    ELSIF rising_edge(rx_clk) THEN
+      rx_pll_locked <= pll_locked;
+      rx_eye_locked <= nxt_rx_eye_locked;
+    END IF;
+  END PROCESS;
+    
+  
+  ---------------------------------------------------------------------------
+  -- Apply Channel Data Alignment (CDA)
+  ---------------------------------------------------------------------------
+  
+  -- release the rx_cda_reset when the eye in the LVDS data was found
+  -- use the rx_clk to time the CDA reset to try to have the deser_factor divide phase uncertainty in the rx_clk
+  p_rx_cda_reset : PROCESS(dp_pll_reset, rx_clk)
+  BEGIN
+    IF dp_pll_reset='1' THEN
+      rx_cda_reset <= '1';
+    ELSIF rising_edge(rx_clk) THEN
+      rx_cda_reset <= NOT rx_eye_locked;  -- release the CDA reset when the LVDS data is sampled in the eye
+    END IF;
+  END PROCESS;
+  
+  -- use the dp_clk to time the CDA reset to avoid the deser_factor divide phase uncertainty in the rx_clk
+  u_dp_cda_reset : ENTITY common_lib.common_async
+  GENERIC MAP (
+    g_rst_level => '1'
+  )
+  PORT MAP (
+    rst  => rx_cda_reset,   -- use rx_cda_reset in rx_clk domain
+    clk  => dp_clk,
+    din  => '0',
+    dout => dp_cda_reset    -- use dp_cda_reset in dp_clk domain
+  );
+    
+  -- release the CDA reset when the LVDS data is sampled in the eye
+  cda_reset_slv <= (OTHERS=>dp_cda_reset) WHEN c_use_dp_clk_for_cda_reset=TRUE ELSE (OTHERS=>rx_cda_reset);
+  
+  -- use the rx_cda_reset also for the rx_cda_ctrl[] in the rx_clk domain
+  p_rx_cda_reg : PROCESS(rx_cda_reset, rx_clk)
+  BEGIN
+    -- use the rx_clk because rx_cda_ctrl is in that clock domain and because the rx_clk will be active for sure now
+    IF rx_cda_reset='1' THEN
+      rx_cda_state  <= s_cda_reset;
+      rx_cda_ctrl   <= (OTHERS=>'0');
+      rx_cda_cnt    <= 0;
+      rx_wait_cnt   <= (OTHERS=>'0');
+      rx_val        <= '0';
+    ELSIF rising_edge(rx_clk) THEN
+      rx_cda_state  <= nxt_rx_cda_state;
+      rx_cda_ctrl   <= nxt_rx_cda_ctrl;     -- apply the preset nof bit slip pulses
+      rx_cda_cnt    <= nxt_rx_cda_cnt;
+      rx_wait_cnt   <= nxt_rx_wait_cnt;
+      rx_val        <= nxt_rx_val;
+    END IF;
+  END PROCESS;
+
+  -- The CDA may need 0:g_deser_factor-1 number of bit slip pulses to align the
+  -- deserialized g_deser_factor number of bit wide words.
+  -- All ADU-BN connection have the same skew per LVDS data line. The skew 
+  -- between LVDS data lines may differ. Therefore a fixed number of bit slip
+  -- pulses per LVDS data line should be enough to get CDA. This avoids having
+  -- to use a training pattern (on ADU we could use the test pattern from the
+  -- adc08d1020).
+  
+  -- Immediately after rx_cda_reset release apply the preset number of CDA bit
+  -- slip pulses for each LVDS data line as set by the dp_cda_settings.
+  
+  rx_cda_settings <= dp_cda_settings;  -- the dp_cda_settings are stable, so no need to use register stages to synchronise them into the rx_clk domain
+  
+  nxt_rx_cda_cnt  <= rx_cda_cnt + 1 WHEN rx_cda_cnt_en='1'   ELSE rx_cda_cnt;
+  nxt_rx_wait_cnt <= (OTHERS=>'0')  WHEN rx_wait_cnt_clr='1' ELSE INCR_UVEC(rx_wait_cnt, 1);
+  
+  p_rx_cda_state : PROCESS(rx_cda_state, rx_cda_settings, rx_cda_cnt, rx_wait_cnt)
+  BEGIN
+    nxt_rx_cda_state <= rx_cda_state;
+    
+    rx_cda_cnt_en   <= '0';
+    rx_wait_cnt_clr <= '1';
+    
+    nxt_rx_cda_ctrl <= (OTHERS=>'0');
+    nxt_rx_val <= '0';
+    
+    CASE rx_cda_state IS
+      WHEN s_cda_reset =>
+        nxt_rx_cda_state <= s_cda_ctrl;
+      WHEN s_cda_ctrl =>
+        IF rx_cda_cnt < g_deser_factor-1 THEN
+          rx_cda_cnt_en <= '1';
+          FOR I IN 0 TO g_lvds_w-1 LOOP
+            IF rx_cda_settings(I) > rx_cda_cnt THEN
+              nxt_rx_cda_ctrl(I) <= '1';
+            END IF;
+          END LOOP;
+          nxt_rx_cda_state <= s_cda_wait;
+        ELSE
+          nxt_rx_cda_state <= s_cda_done;
+        END IF;
+      WHEN s_cda_wait =>
+        rx_wait_cnt_clr <= '0';
+        IF rx_wait_cnt(rx_wait_cnt'HIGH)='1' THEN
+          nxt_rx_cda_state <= s_cda_ctrl;
+        END IF;
+      WHEN OTHERS =>  -- = s_cda_done
+        nxt_rx_val <= '1';
+    END CASE;
+  END PROCESS;
+
+  -----------------------------------------------------------------------------
+  -- Output cross from the rx_clk domain to the dp_clk domain
+  -----------------------------------------------------------------------------
+
+  u_cross_fifo : ENTITY common_lib.common_fifo_dc
+  GENERIC MAP (
+    g_dat_w     => c_rx_dat_w,
+    g_nof_words => c_meta_fifo_depth
+  )
+  PORT MAP (
+    rst     => rx_cda_reset,
+    wr_clk  => rx_clk,
+    wr_dat  => rx_dat,
+    wr_req  => rx_val,
+    wr_ful  => OPEN,
+    wrusedw => OPEN,
+    rd_clk  => dp_clk,
+    rd_dat  => dp_dat,
+    rd_req  => '1',
+    rd_emp  => OPEN,
+    rdusedw => OPEN,
+    rd_val  => dp_val
+  );
+END rtl;
diff --git a/libraries/io/aduh/src/vhdl/mms_aduh_monitor.vhd b/libraries/io/aduh/src/vhdl/mms_aduh_monitor.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..811208d26064d6a215a466cf31422864531981bf
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/mms_aduh_monitor.vhd
@@ -0,0 +1,121 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+LIBRARY IEEE, common_lib, dp_lib, diag_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE common_lib.common_mem_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+
+-- Purpose : Monitor signal path statistics
+-- Description :
+--   For one input signal path provide MM access to:
+--   . ADC mean  via reg_miso
+--   . ADC power via reg_miso
+--   . ADC data buffer via buf_miso
+-- Remarks:
+
+ENTITY mms_aduh_monitor IS
+  GENERIC (
+    g_cross_clock_domain   : BOOLEAN := TRUE;       -- use FALSE when mm_clk and st_clk are the same, else use TRUE to cross the clock domain
+    g_symbol_w             : NATURAL := 8;
+    g_nof_symbols_per_data : NATURAL := 4;          -- big endian in_data, t0 in MSSymbol, so [h:0] = [t0]&[t1]&[t2]&[t3]
+    g_nof_accumulations    : NATURAL := 800*10**6;  -- integration time in symbols, defines internal accumulator widths
+    g_buffer_nof_symbols   : NATURAL := 1024;
+    g_buffer_use_sync      : BOOLEAN := FALSE       -- when TRUE start filling the buffer after the in_sync, else after the last word was read
+  );
+  PORT (
+    -- Memory-mapped clock domain
+    mm_rst     : IN  STD_LOGIC;
+    mm_clk     : IN  STD_LOGIC;
+    
+    reg_mosi   : IN  t_mem_mosi;  -- read only access to the mean_sum and power_sum
+    reg_miso   : OUT t_mem_miso;
+    buf_mosi   : IN  t_mem_mosi;  -- read and overwrite access to the data buffer
+    buf_miso   : OUT t_mem_miso;
+    
+    -- Streaming clock domain
+    st_rst     : IN  STD_LOGIC;
+    st_clk     : IN  STD_LOGIC;
+    
+    in_sosi    : IN t_dp_sosi     -- Signal path with data g_nof_symbols_per_data=4 8bit samples in time per one 32bit word
+  );
+END mms_aduh_monitor;
+
+
+ARCHITECTURE str OF mms_aduh_monitor IS
+
+  -- Monitor outputs
+  SIGNAL mon_mean_sum  : STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);  -- use fixed 64 bit sum width
+  SIGNAL mon_power_sum : STD_LOGIC_VECTOR(c_longword_w-1 DOWNTO 0);  -- use fixed 64 bit sum width
+  SIGNAL mon_sop       : STD_LOGIC;  -- at the sop there are new mean_sum and pwr_sum statistics available
+  
+BEGIN
+
+  u_mm_reg : ENTITY work.aduh_monitor_reg
+  GENERIC MAP (
+    g_cross_clock_domain => g_cross_clock_domain
+  )
+  PORT MAP (
+    -- Clocks and reset
+    mm_rst            => mm_rst,
+    mm_clk            => mm_clk,
+    st_rst            => st_rst,
+    st_clk            => st_clk,
+    
+    -- Memory Mapped Slave in mm_clk domain
+    sla_in            => reg_mosi,
+    sla_out           => reg_miso,
+    
+    -- MM registers in st_clk domain
+    st_mon_mean_sum   => mon_mean_sum,
+    st_mon_power_sum  => mon_power_sum,
+    st_mon_sop        => mon_sop
+  );
+  
+  u_monitor : ENTITY work.aduh_monitor
+  GENERIC MAP (
+    g_symbol_w             => g_symbol_w,
+    g_nof_symbols_per_data => g_nof_symbols_per_data,
+    g_nof_accumulations    => g_nof_accumulations,
+    g_buffer_nof_symbols   => g_buffer_nof_symbols,
+    g_buffer_use_sync      => g_buffer_use_sync
+  )
+  PORT MAP (
+    mm_rst         => mm_rst,
+    mm_clk         => mm_clk,
+    
+    buf_mosi       => buf_mosi,
+    buf_miso       => buf_miso,
+    
+    -- Streaming inputs
+    st_rst         => st_rst,
+    st_clk         => st_clk,
+    
+    in_sosi        => in_sosi,
+    
+    -- Monitor outputs
+    stat_mean_sum  => mon_mean_sum,
+    stat_pwr_sum   => mon_power_sum,
+    stat_sop       => mon_sop
+  );
+  
+END str;
diff --git a/libraries/io/aduh/src/vhdl/mms_aduh_quad.vhd b/libraries/io/aduh/src/vhdl/mms_aduh_quad.vhd
new file mode 100644
index 0000000000000000000000000000000000000000..d44b109a3c42b380b12d6e3b71d30851118b3f84
--- /dev/null
+++ b/libraries/io/aduh/src/vhdl/mms_aduh_quad.vhd
@@ -0,0 +1,191 @@
+-------------------------------------------------------------------------------
+--
+-- 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/>.
+--
+-------------------------------------------------------------------------------
+
+-- Purpose: Capture input from four ADC [A,B,C,D] and provide MM slave read
+--          only register for aduh_quad
+
+
+LIBRARY IEEE, common_lib, dp_lib;
+USE IEEE.STD_LOGIC_1164.ALL;
+USE common_lib.common_pkg.ALL;
+USE common_lib.common_mem_pkg.ALL;
+USE dp_lib.dp_stream_pkg.ALL;
+USE work.aduh_dd_pkg.ALL;
+
+ENTITY mms_aduh_quad IS
+  GENERIC (
+    -- General
+    g_cross_clock_domain : BOOLEAN := TRUE;  -- use FALSE when mm_clk and dp_clk are the same, else use TRUE to cross the clock domain
+    -- ADC Interface
+    g_nof_dp_phs_clk     : NATURAL := 1;     -- nof dp_phs_clk that can be used to detect the word phase
+    g_ai                 : t_c_aduh_dd_ai := c_aduh_dd_ai
+  );
+  PORT (
+    -- ADC Interface
+    -- . ADU_AB
+    ADC_BI_A          : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');
+    ADC_BI_B          : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');
+    ADC_BI_A_CLK      : IN  STD_LOGIC := '0';
+    ADC_BI_A_CLK_RST  : OUT STD_LOGIC;
+    
+    -- . ADU_CD
+    ADC_BI_C          : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');
+    ADC_BI_D          : IN  STD_LOGIC_VECTOR(g_ai.port_w-1 DOWNTO 0) := (OTHERS=>'0');
+    ADC_BI_D_CLK      : IN  STD_LOGIC := '0';
+    ADC_BI_D_CLK_RST  : OUT STD_LOGIC;
+    
+    -- MM clock domain
+    mm_rst            : IN  STD_LOGIC;
+    mm_clk            : IN  STD_LOGIC;
+    
+    reg_mosi          : IN  t_mem_mosi;
+    reg_miso          : OUT t_mem_miso;
+    
+    -- Streaming clock domain
+    dp_rst            : IN  STD_LOGIC;
+    dp_clk            : IN  STD_LOGIC;
+    dp_phs_clk_vec    : IN  STD_LOGIC_VECTOR(g_nof_dp_phs_clk-1 DOWNTO 0);
+    
+    -- . data
+    aduh_sosi_arr     : OUT t_dp_sosi_arr(0 TO g_ai.nof_sp-1)   -- = [0:3] = ADC_BI ports [A,B,C,D]
+  );
+END mms_aduh_quad;
+
+
+ARCHITECTURE str OF mms_aduh_quad IS
+
+  SIGNAL aduh_ab_status         : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL aduh_ab_locked         : STD_LOGIC;
+  SIGNAL aduh_ab_stable         : STD_LOGIC;
+  SIGNAL aduh_ab_stable_ack     : STD_LOGIC;
+  SIGNAL aduh_ab_control        : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  
+  SIGNAL aduh_cd_status         : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+  SIGNAL aduh_cd_locked         : STD_LOGIC;
+  SIGNAL aduh_cd_stable         : STD_LOGIC;
+  SIGNAL aduh_cd_stable_ack     : STD_LOGIC;
+  SIGNAL aduh_cd_control        : STD_LOGIC_VECTOR(c_word_w-1 DOWNTO 0);
+      
+  SIGNAL aduh_verify_res        : t_slv_32_arr(0 TO g_ai.nof_sp-1);  -- [8,7:0]
+  SIGNAL aduh_verify_res_val    : STD_LOGIC_VECTOR(0 TO g_ai.nof_sp-1);
+  SIGNAL aduh_verify_res_ack    : STD_LOGIC_VECTOR(0 TO g_ai.nof_sp-1);
+  
+BEGIN
+
+  -----------------------------------------------------------------------------
+  -- MM control register for the data input modules
+  -----------------------------------------------------------------------------
+  
+  u_mm_reg : ENTITY work.aduh_quad_reg
+  GENERIC MAP (
+    g_cross_clock_domain => g_cross_clock_domain,
+    g_nof_dp_phs_clk     => g_nof_dp_phs_clk
+  )
+  PORT MAP (
+    -- Clocks and reset
+    mm_rst                   => mm_rst,
+    mm_clk                   => mm_clk,
+    st_rst                   => dp_rst,
+    st_clk                   => dp_clk,
+    
+    -- Memory Mapped Slave in mm_clk domain
+    sla_in                   => reg_mosi,
+    sla_out                  => reg_miso,
+    
+    -- MM registers in st_clk domain
+    -- . ADU status
+    st_aduh_ab_status        => aduh_ab_status,
+    st_aduh_ab_locked        => aduh_ab_locked,
+    st_aduh_ab_stable        => aduh_ab_stable,
+    st_aduh_ab_stable_ack    => aduh_ab_stable_ack,
+    st_aduh_ab_control       => aduh_ab_control,
+  
+    st_aduh_cd_status        => aduh_cd_status,
+    st_aduh_cd_locked        => aduh_cd_locked,
+    st_aduh_cd_stable        => aduh_cd_stable,
+    st_aduh_cd_stable_ack    => aduh_cd_stable_ack,
+    st_aduh_cd_control       => aduh_cd_control,
+    
+    -- . ADU pattern verify
+    st_aduh_a_verify_res     => aduh_verify_res(0),
+    st_aduh_a_verify_res_val => aduh_verify_res_val(0),
+    st_aduh_a_verify_res_ack => aduh_verify_res_ack(0),
+    
+    st_aduh_b_verify_res     => aduh_verify_res(1),
+    st_aduh_b_verify_res_val => aduh_verify_res_val(1),
+    st_aduh_b_verify_res_ack => aduh_verify_res_ack(1),
+    
+    st_aduh_c_verify_res     => aduh_verify_res(2),
+    st_aduh_c_verify_res_val => aduh_verify_res_val(2),
+    st_aduh_c_verify_res_ack => aduh_verify_res_ack(2),
+    
+    st_aduh_d_verify_res     => aduh_verify_res(3),
+    st_aduh_d_verify_res_val => aduh_verify_res_val(3),
+    st_aduh_d_verify_res_ack => aduh_verify_res_ack(3)
+  );
+
+  u_aduh_quad : ENTITY work.aduh_quad
+  GENERIC MAP (
+    -- ADC Interface
+    g_nof_dp_phs_clk => g_nof_dp_phs_clk,
+    g_ai             => g_ai
+  )
+  PORT MAP (
+    -- ADC Interface
+    -- . ADU_AB
+    ADC_BI_A               => ADC_BI_A,
+    ADC_BI_B               => ADC_BI_B,
+    ADC_BI_A_CLK           => ADC_BI_A_CLK,
+    ADC_BI_A_CLK_RST       => ADC_BI_A_CLK_RST,
+    
+    -- . ADU_CD
+    ADC_BI_C               => ADC_BI_C,
+    ADC_BI_D               => ADC_BI_D,
+    ADC_BI_D_CLK           => ADC_BI_D_CLK,
+    ADC_BI_D_CLK_RST       => ADC_BI_D_CLK_RST,
+    
+    -- Streaming clock domain
+    dp_rst                 => dp_rst,
+    dp_clk                 => dp_clk,
+    dp_phs_clk_vec         => dp_phs_clk_vec,
+    
+    -- . data
+    aduh_sosi_arr          => aduh_sosi_arr,
+    
+    -- . status
+    aduh_ab_status         => aduh_ab_status,
+    aduh_ab_locked         => aduh_ab_locked,
+    aduh_ab_stable         => aduh_ab_stable,
+    aduh_ab_stable_ack     => aduh_ab_stable_ack,
+    aduh_ab_control        => aduh_ab_control,
+  
+    aduh_cd_status         => aduh_cd_status,
+    aduh_cd_locked         => aduh_cd_locked,
+    aduh_cd_stable         => aduh_cd_stable,
+    aduh_cd_stable_ack     => aduh_cd_stable_ack,
+    aduh_cd_control        => aduh_cd_control,
+      
+    aduh_verify_res        => aduh_verify_res,
+    aduh_verify_res_val    => aduh_verify_res_val,
+    aduh_verify_res_ack    => aduh_verify_res_ack
+  );
+    
+END str;