synth: preliminary support of multiport rams (using shared variable).

For #1069

6 files changed, 648 insertions, 333 deletions

diff --git a/src/synth/ghdlsynth_gates.h b/src/synth/ghdlsynth_gates.h
index 90ea283e8..aa4053010 100644
--- a/src/synth/ghdlsynth_gates.h
+++ b/src/synth/ghdlsynth_gates.h
@@ -79,6 +79,7 @@ enum Module_Id {
    Id_Mem_Rd = 76,
    Id_Mem_Rd_Sync = 77,
    Id_Mem_Wr_Sync = 78,
+   Id_Mem_Multiport = 79,
    Id_Edge = 80,
    Id_Assert = 81,
    Id_Assume = 82,
diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index eb1b984bb..ac1115af7 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -374,6 +374,15 @@ package body Netlists.Builders is
                  4 => Create_Input ("data"));
       Outputs (0 .. 0) := (0 => Create_Output ("oport"));
       Set_Ports_Desc (Res, Inputs (0 .. 4), Outputs (0 .. 0));
+
+      Res := New_User_Module
+        (Ctxt.Design,
+         New_Sname_Artificial (Get_Identifier ("mem_multiport"), No_Sname),
+         Id_Mem_Multiport, 2, 1, 0);
+      Ctxt.M_Mem_Multiport := Res;
+      Inputs (0 .. 1) := (0 => Create_Input ("i0"),
+                          1 => Create_Input ("i1"));
+      Set_Ports_Desc (Res, Inputs (0 .. 1), Outputs (0 .. 0));
    end Create_Memory_Modules;
 
    procedure Create_Edge_Module (Ctxt : Context_Acc;
@@ -1245,6 +1254,21 @@ package body Netlists.Builders is
       return Inst;
    end Build_Mem_Wr_Sync;
 
+   function Build_Mem_Multiport (Ctxt : Context_Acc; I0, I1 : Net) return Net
+   is
+      W : constant Width := Get_Width (I0);
+      pragma Assert (Get_Width (I1) = W);
+      Inst : Instance;
+      O : Net;
+   begin
+      Inst := New_Internal_Instance (Ctxt, Ctxt.M_Mem_Multiport);
+      O := Get_Output (Inst, 0);
+      Set_Width (O, W);
+      Connect (Get_Input (Inst, 0), I0);
+      Connect (Get_Input (Inst, 1), I1);
+      return O;
+   end Build_Mem_Multiport;
+
    function Build_Object (Ctxt : Context_Acc; M : Module; W : Width) return Net
    is
       Inst : Instance;
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index 62c31502b..5c67384be 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -150,6 +150,8 @@ package Netlists.Builders is
                                En : Net;
                                Data : Net) return Instance;
 
+   function Build_Mem_Multiport (Ctxt : Context_Acc; I0, I1 : Net) return Net;
+
    function Build_Output (Ctxt : Context_Acc; W : Width) return Net;
    function Build_Ioutput (Ctxt : Context_Acc; Init : Net) return Net;
    function Build_Inout (Ctxt : Context_Acc; W : Width) return Instance;
@@ -250,6 +252,7 @@ private
       M_Mem_Rd : Module;
       M_Mem_Rd_Sync : Module;
       M_Mem_Wr_Sync : Module;
+      M_Mem_Multiport : Module;
       M_Assert : Module;
       M_Assume : Module;
       M_Cover : Module;
diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads
index 6435b24e9..04920b224 100644
--- a/src/synth/netlists-gates.ads
+++ b/src/synth/netlists-gates.ads
@@ -272,6 +272,9 @@ package Netlists.Gates is
    --  Outputs: NPORT (next memory port)
    Id_Mem_Wr_Sync : constant Module_Id := 78;
 
+   --  Virtual gate to gather 2 dffs of a multiport memory.
+   Id_Mem_Multiport : constant Module_Id := 79;
+
    --  Positive/rising edge detector.  This is a pseudo gate.
    --  A negative edge detector can be made using by negating the clock before
    --  the detector.
diff --git a/src/synth/netlists-memories.adb b/src/synth/netlists-memories.adb
index f490d54e3..d7ec4d8d3 100644
--- a/src/synth/netlists-memories.adb
+++ b/src/synth/netlists-memories.adb
@@ -655,11 +655,15 @@ package body Netlists.Memories is
               | Id_Signal =>
                return Inst;
             when Id_Dff
-              | Id_Idff =>
+              | Id_Idff
+              | Id_Mem_Multiport =>
                O := Get_Output (Inst, 0);
             when others =>
-               Info_Msg_Synth
-                 (+Last, "gate %i cannot be part of a memory", (1 => +Inst));
+               if False then
+                  Info_Msg_Synth
+                    (+Last, "gate %i cannot be part of a memory",
+                     (1 => +Inst));
+               end if;
                return No_Instance;
          end case;
 
@@ -728,15 +732,15 @@ package body Netlists.Memories is
 
    --  Validate that signal SIG is a RAM.  It must be a loop of inserts
    --  and extracts.
-   function Validate_RAM_Simple (Sig : Instance) return Boolean
+   function Validate_RAM_Simple (Last : Net) return Instance
    is
       Inst : Instance;
       N : Net;
       Inp : Input;
-      Ok : Boolean;
    begin
-      Ok := False;
-      N := Get_Output (Sig, 0);
+      --  For each gate of the chain, starting from LAST and going forward
+      --  until the signal.
+      N := Last;
       while N /= No_Net loop
          Inp := Get_First_Sink (N);
          N := No_Net;
@@ -744,36 +748,66 @@ package body Netlists.Memories is
          while Inp /= No_Input loop
             Inst := Get_Input_Parent (Inp);
             case Get_Id (Inst) is
-               when Id_Dyn_Insert_En =>
+               when Id_Dyn_Insert_En
+                 | Id_Dff
+                 | Id_Idff
+                 | Id_Mem_Multiport =>
                   if N /= No_Net then
-                     --  There must be only one dyn_insert.
-                     return False;
+                     --  There must be only one such gate per stage.
+                     return No_Instance;
                   end if;
                   N := Get_Output (Inst, 0);
                when Id_Dyn_Extract =>
                   null;
                when Id_Isignal
                  | Id_Signal =>
-                  if Inst /= Sig then
-                     return False;
-                  end if;
-                  Ok := True;
-               when Id_Dff
-                 | Id_Idff =>
-                  if N /= No_Net then
-                     --  There must be only one dff.
-                     return False;
-                  end if;
-                  N := Get_Output (Inst, 0);
+                  return Inst;
                when others =>
-                  return False;
+                  return No_Instance;
             end case;
             Inp := Get_Next_Sink (Inp);
          end loop;
       end loop;
-      return Ok;
+      return No_Instance;
    end Validate_RAM_Simple;
 
+   --  Validate that signal SIG is a RAM.  It must be a loop of inserts
+   --  and extracts.
+   function Validate_RAM_Multiple (Sig : Instance) return Boolean
+   is
+      Ok : Boolean;
+      Inst : Instance;
+      N : Net;
+      Inp : Input;
+   begin
+      Ok := False;
+      N := Get_Output (Sig, 0);
+      Inp := Get_First_Sink (N);
+
+      --  For multiple ports, there can be parallel pathes.
+      while Inp /= No_Input loop
+         Inst := Get_Input_Parent (Inp);
+         case Get_Id (Inst) is
+            when Id_Dyn_Insert_En
+              | Id_Dyn_Insert =>
+               --  Look.
+               N := Get_Output (Inst, 0);
+               if Validate_RAM_Simple (N) /= Sig then
+                  return False;
+               end if;
+               Ok := True;
+            when Id_Dyn_Extract =>
+               null;
+            when others =>
+               return False;
+         end case;
+         Inp := Get_Next_Sink (Inp);
+      end loop;
+
+      --  Need at least one dyn_insert.
+      return Ok;
+   end Validate_RAM_Multiple;
+
    --  Extract the step (equivalent to data width) of a dyn_insert/dyn_extract
    --  address.  This is either a memidx or an addidx gate.
    function Extract_Memidx_Step (Memidx : Instance) return Width
@@ -946,6 +980,450 @@ package body Netlists.Memories is
       end case;
    end Extract_Sub_Constant;
 
+   --  Subroutine of Convert_To_Memory.
+   --
+   --  Compute the number of ports (dyn_extract and dyn_insert) and the width
+   --  of the memory.  Just walk all the gates.
+   procedure Compute_Ports_And_Width
+     (Sig : Instance; Nbr_Ports : out Int32; Wd : out Width)
+   is
+      procedure Add_Port_And_Width (Memidx : Instance) is
+      begin
+         Nbr_Ports := Nbr_Ports + 1;
+         if Wd = 0 then
+            Wd := Extract_Memidx_Step (Memidx);
+         elsif Wd /= Extract_Memidx_Step (Memidx) then
+            Info_Msg_Synth (+Sig, "memory %n uses different widths",
+                            (1 => +Sig));
+            Nbr_Ports := 0;
+            return;
+         end if;
+      end Add_Port_And_Width;
+
+      Inst, Inst2 : Instance;
+      Inp2 : Input;
+   begin
+      Nbr_Ports := 0;
+      Wd := 0;
+
+      --  Top-level loop, for each parallel path of multiport RAMs.
+      Inp2 := Get_First_Sink (Get_Output (Sig, 0));
+      while Inp2 /= No_Input loop
+         Inst2 := Get_Input_Parent (Inp2);
+         case Get_Id (Inst2) is
+            when Id_Dyn_Extract =>
+               Add_Port_And_Width (Get_Input_Instance (Inst2, 1));
+               if Nbr_Ports = 0 then
+                  return;
+               end if;
+            when Id_Dyn_Insert
+              | Id_Dyn_Insert_En =>
+               Add_Port_And_Width (Get_Input_Instance (Inst2, 2));
+               if Nbr_Ports = 0 then
+                  return;
+               end if;
+               --  Walk till the signal.
+               Inst := Inst2;
+               loop
+                  declare
+                     Inp : Input;
+                     N_Inst : Instance;
+                     In_Inst : Instance;
+                  begin
+                     --  Check gates connected to the output.
+                     Inp := Get_First_Sink (Get_Output (Inst, 0));
+                     N_Inst := No_Instance;
+                     while Inp /= No_Input loop
+                        In_Inst := Get_Input_Parent (Inp);
+                        case Get_Id (In_Inst) is
+                           when Id_Dyn_Extract =>
+                              Add_Port_And_Width
+                                (Get_Input_Instance (In_Inst, 1));
+                              if Nbr_Ports = 0 then
+                                 return;
+                              end if;
+                           when Id_Dyn_Insert_En
+                             | Id_Dyn_Insert =>
+                              Add_Port_And_Width
+                                (Get_Input_Instance (In_Inst, 2));
+                              if Nbr_Ports = 0 then
+                                 return;
+                              end if;
+                              pragma Assert (N_Inst = No_Instance);
+                              N_Inst := In_Inst;
+                           when Id_Dff
+                             | Id_Idff
+                             | Id_Signal
+                             | Id_Isignal
+                             | Id_Mem_Multiport =>
+                              pragma Assert (N_Inst = No_Instance);
+                              N_Inst := In_Inst;
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                        Inp := Get_Next_Sink (Inp);
+                     end loop;
+                     Inst := N_Inst;
+                     exit when Inst = Sig;
+                  end;
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Inp2 := Get_Next_Sink (Inp2);
+      end loop;
+   end Compute_Ports_And_Width;
+
+   --  Subroutine of Convert_To_Memory.
+   --
+   --  Extract offsets/width of each port.
+   procedure Extract_Ports_Offsets
+     (Sig : Instance; Offs : Off_Array_Acc; Nbr_Offs : out Int32)
+   is
+      procedure Add_Offset (Off : Uns32; Wd : Uns32)
+      is
+         Ow : Off_Array (1 .. 2);
+      begin
+         Ow := (Off, Off + Wd);
+         if Nbr_Offs = 0 or else Ow /= Offs (1 .. 2) then
+            Nbr_Offs := Nbr_Offs + 2;
+            Offs (Nbr_Offs -1 .. Nbr_Offs) := Ow;
+         end if;
+      end Add_Offset;
+
+      procedure Add_Extract_Offset (Inst : Instance) is
+      begin
+         Add_Offset (Get_Param_Uns32 (Inst, 0),
+                     Get_Width (Get_Output (Inst, 0)));
+      end Add_Extract_Offset;
+
+      procedure Add_Insert_Offset (Inst : Instance) is
+      begin
+         Add_Offset (Get_Param_Uns32 (Inst, 0),
+                     Get_Width (Get_Input_Net (Inst, 1)));
+      end Add_Insert_Offset;
+
+      Inst, Inst2 : Instance;
+      Inp2 : Input;
+   begin
+      Nbr_Offs := 0;
+
+      --  Top-level loop, for each parallel path of multiport RAMs.
+      Inp2 := Get_First_Sink (Get_Output (Sig, 0));
+      while Inp2 /= No_Input loop
+         Inst2 := Get_Input_Parent (Inp2);
+         case Get_Id (Inst2) is
+            when Id_Dyn_Extract =>
+               Add_Extract_Offset (Inst2);
+            when Id_Dyn_Insert_En
+              | Id_Dyn_Insert =>
+               Add_Insert_Offset (Inst2);
+               Inst := Inst2;
+               loop
+                  declare
+                     Inp : Input;
+                     N_Inst : Instance;
+                     In_Inst : Instance;
+                  begin
+                     --  Check gates connected to the output.
+                     Inp := Get_First_Sink (Get_Output (Inst, 0));
+                     N_Inst := No_Instance;
+                     while Inp /= No_Input loop
+                        In_Inst := Get_Input_Parent (Inp);
+                        case Get_Id (In_Inst) is
+                           when Id_Dyn_Extract =>
+                              Add_Extract_Offset (In_Inst);
+                           when Id_Dyn_Insert_En
+                             | Id_Dyn_Insert =>
+                              Add_Insert_Offset (In_Inst);
+                              pragma Assert (N_Inst = No_Instance);
+                              N_Inst := In_Inst;
+                           when Id_Dff
+                             | Id_Idff
+                             | Id_Signal
+                             | Id_Isignal
+                             | Id_Mem_Multiport =>
+                              pragma Assert (N_Inst = No_Instance);
+                              N_Inst := In_Inst;
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                        Inp := Get_Next_Sink (Inp);
+                     end loop;
+                     Inst := N_Inst;
+                     exit when Inst = Sig;
+                  end;
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Inp2 := Get_Next_Sink (Inp2);
+      end loop;
+   end Extract_Ports_Offsets;
+
+   procedure Convert_Memory_Read_Port (Ctxt : Context_Acc;
+                                       In_Inst : Instance;
+                                       Mem_Sz : Uns32;
+                                       Mem_W : Width;
+                                       Offs : Off_Array_Acc;
+                                       Tails : Net_Array_Acc;
+                                       Outs : Net_Array_Acc)
+   is
+      Off : constant Uns32 := Get_Param_Uns32 (In_Inst, 0);
+      Wd : constant Width := Get_Width (Get_Output (In_Inst, 0));
+      Idx : Int32;
+      Len : Int32;
+      Addr : Net;
+      Rd_Inst : Instance;
+      Rd : Net;
+      Inp2 : Input;
+      En : Net;
+      Clk : Net;
+      Last_Inst : Instance;
+   begin
+      Off_Array_To_Idx (Offs.all, Off, Wd, Idx, Len);
+      Inp2 := Get_Input (In_Inst, 1);
+      Addr := Get_Driver (Inp2);
+      Disconnect (Inp2);
+      Convert_Memidx (Ctxt, Mem_Sz, Addr, Mem_W);
+      Extract_Extract_Dff (Ctxt, In_Inst, Last_Inst, Clk, En);
+      if Clk /= No_Net and then En = No_Net then
+         En := Build_Const_UB32 (Ctxt, 1, 1);
+      end if;
+      --  iterate to build mem_rd/mem_rd_sync
+      for I in Idx .. Idx + Len - 1 loop
+         if Clk /= No_Net then
+            Rd_Inst := Build_Mem_Rd_Sync (Ctxt, Tails (I), Addr, Clk, En,
+                                          Offs (Idx + 1) - Offs (Idx));
+         else
+            Rd_Inst := Build_Mem_Rd (Ctxt, Tails (I), Addr,
+                                     Offs (Idx + 1) - Offs (Idx));
+         end if;
+         Tails (I) := Get_Output (Rd_Inst, 0);
+         Outs (I) := Get_Output (Rd_Inst, 1);
+      end loop;
+      Rd := Build2_Concat (Ctxt, Outs (Idx .. Idx + Len - 1));
+      Redirect_Inputs (Get_Output (Last_Inst, 0), Rd);
+      if Last_Inst /= In_Inst then
+         Remove_Instance (Last_Inst);
+      end if;
+   end Convert_Memory_Read_Port;
+
+   --  Subroutine of Convert_To_Memory.
+   --
+   --  Convert dyn_insert/dyn_extract to memory write/read ports.
+   --  TAILS is the output of memories (so the next value to be read).
+   --  OUTS is a temporary array.
+   procedure Create_Memory_Ports (Ctxt : Context_Acc;
+                                  Sig : Instance;
+                                  Mem_Sz : Uns32;
+                                  Mem_W : Width;
+                                  Offs : Off_Array_Acc;
+                                  Tails : Net_Array_Acc;
+                                  Outs : Net_Array_Acc)
+   is
+      Inst, Inst2 : Instance;
+      Inp, Inp2 : Input;
+      N_Inp, N_Inp2 : Input;
+      N_Inst : Instance;
+      In_Inst : Instance;
+      Dff_Clk : Net;
+   begin
+      --  Start from the end.
+      --  First: the read ports at the end.
+      Inp2 := Get_First_Sink (Get_Output (Sig, 0));
+      while Inp2 /= No_Input loop
+         N_Inp2 := Get_Next_Sink (Inp2);
+         Inst2 := Get_Input_Parent (Inp2);
+         case Get_Id (Inst2) is
+            when Id_Dyn_Extract =>
+               Convert_Memory_Read_Port
+                 (Ctxt, Inst2, Mem_Sz, Mem_W, Offs, Tails, Outs);
+               Disconnect (Get_Input (Inst2, 0));
+               Remove_Instance (Inst2);
+            when Id_Dyn_Insert_En
+              | Id_Dyn_Insert =>
+               null;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Inp2 := N_Inp2;
+      end loop;
+
+      --  Second, the chains.
+      Inp2 := Get_First_Sink (Get_Output (Sig, 0));
+      while Inp2 /= No_Input loop
+         N_Inp2 := Get_Next_Sink (Inp2);
+         Inst2 := Get_Input_Parent (Inp2);
+
+         --  Find the dff (if any).
+         Dff_Clk := No_Net;
+         Inst := Inst2;
+         while Inst /= No_Instance loop
+            Inp := Get_First_Sink (Get_Output (Inst, 0));
+            Inst := No_Instance;
+            while Inp /= No_Input loop
+               In_Inst := Get_Input_Parent (Inp);
+               case Get_Id (In_Inst) is
+                  when Id_Dyn_Extract =>
+                     null;
+                  when Id_Dyn_Insert_En
+                    | Id_Dyn_Insert =>
+                     Inst := Get_Net_Parent (Get_Output (In_Inst, 0));
+                     exit;
+                  when Id_Signal
+                    | Id_Isignal =>
+                     --  No dff.
+                     exit;
+                  when Id_Dff
+                    | Id_Idff =>
+                     Dff_Clk := Get_Input_Net (In_Inst, 0);
+                     exit;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               Inp := Get_Next_Sink (Inp);
+            end loop;
+         end loop;
+
+         --  Do the real work: transform gates to ports.
+         Disconnect (Get_Input (Inst2, 0));
+         Inst := Inst2;
+         loop
+            --  Handle Inst.  If the output is connected to a write port,
+            --  add it (after the read ports).
+            case Get_Id (Inst) is
+               when Id_Dyn_Insert_En
+                 | Id_Dyn_Insert =>
+                  declare
+                     Off : constant Uns32 := Get_Param_Uns32 (Inst, 0);
+                     Wd : constant Width :=
+                       Get_Width (Get_Input_Net (Inst, 1));
+                     Idx : Int32;
+                     Len : Int32;
+                     Addr : Net;
+                     Wr_Inst : Instance;
+                     Inp2 : Input;
+                     Dat : Net;
+                     En : Net;
+                     Clk : Net;
+                  begin
+                     Off_Array_To_Idx (Offs.all, Off, Wd, Idx, Len);
+                     Inp2 := Get_Input (Inst, 2);
+                     Addr := Get_Driver (Inp2);
+                     Disconnect (Inp2);
+                     Convert_Memidx (Ctxt, Mem_Sz, Addr, Mem_W);
+                     if Get_Id (Inst) = Id_Dyn_Insert_En then
+                        Inp2 := Get_Input (Inst, 3);
+                        En := Get_Driver (Inp2);
+                        Disconnect (Inp2);
+                        Clk := Dff_Clk;
+                     else
+                        Clk := Dff_Clk;
+                        En := No_Net;
+                     end if;
+                     pragma Assert (Clk /= No_Net);
+                     if En = No_Net then
+                        En := Build_Const_UB32 (Ctxt, 1, 1);
+                     end if;
+                     Inp2 := Get_Input (Inst, 1);
+                     Dat := Get_Driver (Inp2);
+                     for I in Idx .. Idx + Len - 1 loop
+                        Wr_Inst := Build_Mem_Wr_Sync
+                          (Ctxt, Tails (I), Addr, Clk, En,
+                           Build2_Extract (Ctxt, Dat, Offs (I) - Offs (Idx),
+                                           Offs (I + 1) - Offs (I)));
+                        Tails (I) := Get_Output (Wr_Inst, 0);
+                     end loop;
+                     Disconnect (Inp2);
+                  end;
+               when Id_Dff
+                 | Id_Idff =>
+                  null;
+               when Id_Signal
+                 | Id_Isignal =>
+                  null;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            --  Check gates connected to the output.
+            --  First the read ports (dyn_extract), and also find the next
+            --  gate in the loop.
+            N_Inst := No_Instance;
+            Inp := Get_First_Sink (Get_Output (Inst, 0));
+            while Inp /= No_Input loop
+               In_Inst := Get_Input_Parent (Inp);
+               N_Inp := Get_Next_Sink (Inp);
+               case Get_Id (In_Inst) is
+                  when Id_Dyn_Extract =>
+                     Convert_Memory_Read_Port
+                       (Ctxt, In_Inst, Mem_Sz, Mem_W, Offs, Tails, Outs);
+                     pragma Assert (Inp = Get_Input (In_Inst, 0));
+                     Disconnect (Inp);
+                     Remove_Instance (In_Inst);
+                  when Id_Dyn_Insert_En
+                    | Id_Dyn_Insert
+                    | Id_Signal
+                    | Id_Isignal =>
+                     pragma Assert (Inp = Get_Input (In_Inst, 0));
+                     Disconnect (Inp);
+                     --  This is the next instance (and there must be only
+                     --  one next instance).
+                     pragma Assert (N_Inst = No_Instance);
+                     N_Inst := In_Inst;
+                  when Id_Idff
+                    | Id_Dff =>
+                     pragma Assert (Inp = Get_Input (In_Inst, 1));
+                     Disconnect (Inp);
+                     --  This is the next instance (and there must be only
+                     --  one next instance).
+                     pragma Assert (N_Inst = No_Instance);
+                     N_Inst := In_Inst;
+                  when Id_Mem_Multiport =>
+                     Disconnect (Inp);
+                     pragma Assert (N_Inst = No_Instance);
+                     N_Inst := In_Inst;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               Inp := N_Inp;
+            end loop;
+
+            --  Remove INST.
+            case Get_Id (Inst) is
+               when Id_Dyn_Insert_En
+                 | Id_Dyn_Insert =>
+                  Remove_Instance (Inst);
+               when Id_Dff
+                 | Id_Idff =>
+                  --  Disconnect clock and init value.
+                  Disconnect (Get_Input (Inst, 0));
+                  if Get_Id (Inst) = Id_Idff then
+                     Disconnect (Get_Input (Inst, 2));
+                  end if;
+                  Remove_Instance (Inst);
+               when Id_Signal
+                 | Id_Isignal =>
+                  null;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            Inst := N_Inst;
+            case Get_Id (Inst) is
+               when Id_Signal
+                 | Id_Isignal
+                 | Id_Mem_Multiport =>
+                  exit;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         Inp2 := N_Inp2;
+      end loop;
+   end Create_Memory_Ports;
+
    procedure Convert_To_Memory (Ctxt : Context_Acc; Sig : Instance)
    is
       --  Size of RAM (in bits).
@@ -977,55 +1455,10 @@ package body Netlists.Memories is
       Nbr_Ports := 0;
       Mem_W := 0;
       Inst := Sig;
-      loop
-         declare
-            Inp : Input;
-            N_Inst : Instance;
-            In_Inst : Instance;
-            Memidx : Instance;
-         begin
-            --  Check gates connected to the output.
-            Inp := Get_First_Sink (Get_Output (Inst, 0));
-            N_Inst := No_Instance;
-            while Inp /= No_Input loop
-               In_Inst := Get_Input_Parent (Inp);
-               Memidx := No_Instance;
-               case Get_Id (In_Inst) is
-                  when Id_Dyn_Extract =>
-                     Nbr_Ports := Nbr_Ports + 1;
-                     Memidx := Get_Input_Instance (In_Inst, 1);
-                  when Id_Dyn_Insert_En
-                    | Id_Dyn_Insert =>
-                     Nbr_Ports := Nbr_Ports + 1;
-                     Memidx := Get_Input_Instance (In_Inst, 2);
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when Id_Dff
-                    | Id_Idff
-                    | Id_Signal
-                    | Id_Isignal =>
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when others =>
-                     raise Internal_Error;
-               end case;
-               if Memidx /= No_Instance then
-                  if Mem_W = 0 then
-                     Mem_W := Extract_Memidx_Step (Memidx);
-                  elsif Mem_W /= Extract_Memidx_Step (Memidx) then
-                     Info_Msg_Synth
-                       (+Inst, "memory %n uses different widths",
-                        (1 => +Inst));
-                     return;
-                  end if;
-               end if;
-               Inp := Get_Next_Sink (Inp);
-            end loop;
-
-            Inst := N_Inst;
-            exit when Inst = Sig;
-         end;
-      end loop;
+      Compute_Ports_And_Width (Sig, Nbr_Ports, Mem_W);
+      if Nbr_Ports = 0 then
+         return;
+      end if;
 
       if Mem_W = 0 then
          --  No ports ?
@@ -1040,55 +1473,7 @@ package body Netlists.Memories is
 
       --  2. Walk to extract offsets/width
       Offs := new Off_Array (1 .. 2 * Nbr_Ports);
-      Nbr_Offs := 0;
-      Inst := Sig;
-      loop
-         declare
-            Inp : Input;
-            N_Inst : Instance;
-            In_Inst : Instance;
-            Ow : Off_Array (1 .. 2);
-         begin
-            --  Check gates connected to the output.
-            Inp := Get_First_Sink (Get_Output (Inst, 0));
-            N_Inst := No_Instance;
-            while Inp /= No_Input loop
-               In_Inst := Get_Input_Parent (Inp);
-               Ow := (0, 0);
-               case Get_Id (In_Inst) is
-                  when Id_Dyn_Extract =>
-                     Ow := (1 => Get_Param_Uns32 (In_Inst, 0),
-                            2 => Get_Width (Get_Output (In_Inst, 0)));
-                  when Id_Dyn_Insert_En
-                    | Id_Dyn_Insert =>
-                     Ow := (1 => Get_Param_Uns32 (In_Inst, 0),
-                            2 => Get_Width (Get_Input_Net (In_Inst, 1)));
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when Id_Dff
-                    | Id_Idff
-                    | Id_Signal
-                    | Id_Isignal =>
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when others =>
-                     raise Internal_Error;
-               end case;
-               if Ow (2) /= 0 then
-                  --  Ow (2) was just a width, convert it to an offset.
-                  Ow (2) := Ow (1) + Ow (2);
-                  if Nbr_Offs = 0 or else Ow /= Offs (1 .. 2) then
-                     Nbr_Offs := Nbr_Offs + 2;
-                     Offs (Nbr_Offs -1 .. Nbr_Offs) := Ow;
-                  end if;
-               end if;
-               Inp := Get_Next_Sink (Inp);
-            end loop;
-
-            Inst := N_Inst;
-            exit when Inst = Sig;
-         end;
-      end loop;
+      Extract_Ports_Offsets (Sig, Offs, Nbr_Offs);
 
       --  2.1 Sort the offsets.
       declare
@@ -1163,209 +1548,45 @@ package body Netlists.Memories is
       end loop;
 
       --  5. For each part of the data, create memory ports
-      declare
-         Inp : Input;
-         N_Inp : Input;
-         N_Inst : Instance;
-         In_Inst : Instance;
-         Dff_Clk : Net;
-      begin
-         --  Try to extract clock from dff.
-         --  FIXME: this is wrong as it assumes there is only one dff.
-         Dff_Clk := No_Net;
-         Inst := Get_Input_Instance (Sig, 0);
-         case Get_Id (Inst) is
-            when Id_Dff
-              | Id_Idff =>
-               Dff_Clk := Get_Input_Net (Inst, 0);
-            when others =>
-               null;
-         end case;
+      Create_Memory_Ports (Ctxt, Sig, Mem_Sz, Mem_W, Offs, Tails, Outs);
 
-         --  Do the real work: transform gates to ports.
-         Inst := Sig;
-         loop
-            --  Check gates connected to the output.
-            --  First the read ports (dyn_extract), and also find the next
-            --  gate in the loop.
-            N_Inst := No_Instance;
-            Inp := Get_First_Sink (Get_Output (Inst, 0));
-            while Inp /= No_Input loop
-               In_Inst := Get_Input_Parent (Inp);
-               N_Inp := Get_Next_Sink (Inp);
-               case Get_Id (In_Inst) is
-                  when Id_Dyn_Extract =>
-                     declare
-                        Off : constant Uns32 := Get_Param_Uns32 (In_Inst, 0);
-                        Wd : constant Width := Get_Width (Get_Output
-                                                            (In_Inst, 0));
-                        Idx : Int32;
-                        Len : Int32;
-                        Addr : Net;
-                        Rd_Inst : Instance;
-                        Rd : Net;
-                        Inp2 : Input;
-                        En : Net;
-                        Clk : Net;
-                        Last_Inst : Instance;
-                     begin
-                        Off_Array_To_Idx (Offs.all, Off, Wd, Idx, Len);
-                        Inp2 := Get_Input (In_Inst, 1);
-                        Addr := Get_Driver (Inp2);
-                        Disconnect (Inp2);
-                        Convert_Memidx (Ctxt, Mem_Sz, Addr, Mem_W);
-                        Extract_Extract_Dff
-                          (Ctxt, In_Inst, Last_Inst, Clk, En);
-                        if Clk /= No_Net and then En = No_Net then
-                           En := Build_Const_UB32 (Ctxt, 1, 1);
-                        end if;
-                        --  iterate to build mem_rd/mem_rd_sync
-                        for I in Idx .. Idx + Len - 1 loop
-                           if Clk /= No_Net then
-                              Rd_Inst := Build_Mem_Rd_Sync
-                                (Ctxt, Tails (I), Addr, Clk, En,
-                                 Offs (Idx + 1) - Offs (Idx));
-                           else
-                              Rd_Inst := Build_Mem_Rd
-                                (Ctxt, Tails (I), Addr,
-                                 Offs (Idx + 1) - Offs (Idx));
-                           end if;
-                           Tails (I) := Get_Output (Rd_Inst, 0);
-                           Outs (I) := Get_Output (Rd_Inst, 1);
-                        end loop;
-                        if Len = 1 then
-                           Rd := Outs (Idx);
-                        else
-                           Rd := Build2_Concat
-                             (Ctxt, Outs (Idx .. Idx + Len - 1));
-                        end if;
-                        Redirect_Inputs (Get_Output (Last_Inst, 0), Rd);
-                        Disconnect (Get_Input (In_Inst, 0));
-                        if Last_Inst /= In_Inst then
-                           Remove_Instance (Last_Inst);
-                        end if;
-                        Remove_Instance (In_Inst);
-                     end;
-                  when Id_Dyn_Insert_En
-                    | Id_Dyn_Insert
-                    | Id_Signal
-                    | Id_Isignal =>
-                     Inp := Get_Input (In_Inst, 0);
-                     Disconnect (Inp);
-                     --  This is the next instance (and there must be only
-                     --  one next instance).
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when Id_Idff
-                    | Id_Dff =>
-                     Inp := Get_Input (In_Inst, 1);
-                     Disconnect (Inp);
-                     --  This is the next instance (and there must be only
-                     --  one next instance).
-                     pragma Assert (N_Inst = No_Instance);
-                     N_Inst := In_Inst;
-                  when others =>
-                     raise Internal_Error;
-               end case;
-               Inp := N_Inp;
-            end loop;
-
-            --  Handle N_Inst.  If the output is connected to a write port,
-            --  add it (after the read ports).
-            case Get_Id (N_Inst) is
-               when Id_Dyn_Insert_En
-                 | Id_Dyn_Insert =>
-                  declare
-                     Off : constant Uns32 := Get_Param_Uns32 (N_Inst, 0);
-                     Wd : constant Width :=
-                       Get_Width (Get_Input_Net (N_Inst, 1));
-                     Idx : Int32;
-                     Len : Int32;
-                     Addr : Net;
-                     Wr_Inst : Instance;
-                     Inp2 : Input;
-                     Dat : Net;
-                     En : Net;
-                     Clk : Net;
-                  begin
-                     Off_Array_To_Idx (Offs.all, Off, Wd, Idx, Len);
-                     Inp2 := Get_Input (N_Inst, 2);
-                     Addr := Get_Driver (Inp2);
-                     Disconnect (Inp2);
-                     Convert_Memidx (Ctxt, Mem_Sz, Addr, Mem_W);
-                     if Get_Id (N_Inst) = Id_Dyn_Insert_En then
-                        Inp2 := Get_Input (N_Inst, 3);
-                        En := Get_Driver (Inp2);
-                        Disconnect (Inp2);
-                        Clk := Dff_Clk;
-                     else
-                        Clk := Dff_Clk;
-                        En := No_Net;
-                     end if;
-                     pragma Assert (Clk /= No_Net);
-                     if En = No_Net then
-                        En := Build_Const_UB32 (Ctxt, 1, 1);
-                     end if;
-                     Inp2 := Get_Input (N_Inst, 1);
-                     Dat := Get_Driver (Inp2);
-                     for I in Idx .. Idx + Len - 1 loop
-                        Wr_Inst := Build_Mem_Wr_Sync
-                          (Ctxt, Tails (I), Addr, Clk, En,
-                           Build2_Extract (Ctxt, Dat, Offs (I) - Offs (Idx),
-                                           Offs (I + 1) - Offs (I)));
-                        Tails (I) := Get_Output (Wr_Inst, 0);
-                     end loop;
-                     Disconnect (Inp2);
-                  end;
-               when Id_Dff
-                 | Id_Idff =>
-                  null;
-               when Id_Signal
-                 | Id_Isignal =>
-                  null;
-               when others =>
-                  raise Internal_Error;
-            end case;
-
-            --  Remove INST.
-            case Get_Id (Inst) is
-               when Id_Dyn_Insert_En
-                 | Id_Dyn_Insert =>
-                  Remove_Instance (Inst);
-               when Id_Dff
-                 | Id_Idff =>
-                  --  Disconnect clock and init value.
-                  Disconnect (Get_Input (Inst, 0));
-                  if Get_Id (Inst) = Id_Idff then
-                     Disconnect (Get_Input (Inst, 2));
-                  end if;
-                  Remove_Instance (Inst);
-               when Id_Signal
-                 | Id_Isignal =>
-                  null;
-               when others =>
-                  raise Internal_Error;
-            end case;
+      --  Close loops.
+      for I in Heads'Range loop
+         Connect (Get_Input (Heads (I), 0), Tails (I));
+      end loop;
 
-            Inst := N_Inst;
-            case Get_Id (Inst) is
-               when Id_Signal =>
-                  exit;
-               when Id_Isignal =>
-                  Disconnect (Get_Input (Inst, 1));
-                  exit;
-               when others =>
-                  null;
-            end case;
-         end loop;
+      --  Finish to remove the signal/isignal.
+      case Get_Id (Inst) is
+         when Id_Isignal =>
+            Disconnect (Get_Input (Inst, 1));
+         when Id_Signal =>
+            null;
+         when others =>
+            raise Internal_Error;
+      end case;
 
-         --  Close loops.
-         for I in Heads'Range loop
-            Connect (Get_Input (Heads (I), 0), Tails (I));
+      declare
+         Inst2 : Instance;
+         Inp2 : Input;
+         N2 : Net;
+      begin
+         --  The multiport.
+         Inst2 := Inst;
+         Inp2 := Get_Input (Inst2, 0);
+         loop
+            N2 := Get_Driver (Inp2);
+            if N2 /= No_Net then
+               Disconnect (Inp2);
+               Remove_Instance (Inst2);
+            else
+               Remove_Instance (Inst2);
+               exit;
+            end if;
+            Inst2 := Get_Net_Parent (N2);
+            pragma Assert (Get_Id (Inst2) = Id_Mem_Multiport);
+            pragma Assert (Get_Driver (Get_Input (Inst2, 0)) = No_Net);
+            Inp2 := Get_Input (Inst2, 1);
          end loop;
-
-         --  Finish to remove the signal/isignal.
-         Remove_Instance (Inst);
       end;
 
       --  6. Cleanup.
@@ -1475,7 +1696,7 @@ package body Netlists.Memories is
                   Replace_ROM_Memory (Ctxt, Inst);
                end if;
             else
-               if Validate_RAM_Simple (Inst) then
+               if Validate_RAM_Multiple (Inst) then
                   Convert_To_Memory (Ctxt, Inst);
                end if;
             end if;
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index b32ebfe49..f170d6093 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -541,17 +541,57 @@ package body Synth.Environment is
       end if;
    end Sort_Conc_Assign;
 
+   --  Return True iff PREV and NEXT are two concurrent assignments for
+   --  a multiport memory.
+   function Is_Finalize_Assignment_Multiport (Prev, Next : Conc_Assign)
+                                             return Boolean
+   is
+      use Netlists.Gates;
+      P_Val : Net;
+      N_Val : Net;
+   begin
+      --  The assignemnts must fully overlap (same offset and same width).
+      if Get_Conc_Offset (Prev) /= Get_Conc_Offset (Next) then
+         return False;
+      end if;
+      P_Val := Get_Conc_Value (Prev);
+      N_Val := Get_Conc_Value (Next);
+      if Get_Width (P_Val) /= Get_Width (N_Val) then
+         return False;
+      end if;
+
+      --  Both assignments must be a dff.
+      case Get_Id (Get_Net_Parent (P_Val)) is
+         when Id_Idff
+           | Id_Dff =>
+            null;
+         when others =>
+            return False;
+      end case;
+      case Get_Id (Get_Net_Parent (N_Val)) is
+         when Id_Idff
+           | Id_Dff =>
+            null;
+         when others =>
+            return False;
+      end case;
+
+      return True;
+   end Is_Finalize_Assignment_Multiport;
+
+   --  Compute the VALUE to be assigned to WIRE_REC.  Handle partial
+   --  assignment, multiple assignments and error cases.
    procedure Finalize_Complex_Assignment (Ctxt : Builders.Context_Acc;
                                           Wire_Rec : Wire_Id_Record;
                                           Value : out Net)
    is
+      Wire_Width : constant Width := Get_Width (Wire_Rec.Gate);
       First_Assign : Conc_Assign;
       Asgn : Conc_Assign;
       Last_Asgn : Conc_Assign;
       New_Asgn : Conc_Assign;
       Next_Off : Uns32;
       Expected_Off : Uns32;
-      Last_Off : Uns32;
       Nbr_Assign : Natural;
    begin
       Nbr_Assign := Wire_Rec.Nbr_Final_Assign;
@@ -563,13 +603,16 @@ package body Synth.Environment is
       --  Report overlaps and holes, count number of inputs
       Last_Asgn := No_Conc_Assign;
       Expected_Off := 0;
-      Last_Off := Get_Width (Wire_Rec.Gate);
-      while (Expected_Off < Last_Off) or Asgn /= No_Conc_Assign loop
+      while (Expected_Off < Wire_Width) or Asgn /= No_Conc_Assign loop
+         --  NEXT_OFF is the offset of the next assignment.
+         --  EXPECTED_OFF is the offset just after the previous assignment.
          if Asgn /= No_Conc_Assign then
             Next_Off := Get_Conc_Offset (Asgn);
          else
-            Next_Off := Last_Off;
+            --  If there is no more assignment, simulate a hole until the end.
+            Next_Off := Wire_Width;
          end if;
+
          if Next_Off = Expected_Off then
             --  Normal case.
             pragma Assert (Asgn /= No_Conc_Assign);
@@ -606,14 +649,33 @@ package body Synth.Environment is
 
             Expected_Off := Next_Off;
          else
+            --  Overlap.
             pragma Assert (Next_Off < Expected_Off);
-            Error_Msg_Synth
-              (+Wire_Rec.Decl, "multiple assignments for offsets %v:%v",
-               (+Next_Off, +(Expected_Off - 1)));
-            --  TODO: insert resolver
             pragma Assert (Asgn /= No_Conc_Assign);
-            Expected_Off := Expected_Off + Get_Width (Get_Conc_Value (Asgn));
-            Last_Asgn := Asgn;
+
+            if Wire_Rec.Kind = Wire_Variable
+              and then Is_Finalize_Assignment_Multiport (Last_Asgn, Asgn)
+            then
+               --  Insert a multiport.
+               declare
+                  Last_Asgn_Rec : Conc_Assign_Record renames
+                    Conc_Assign_Table.Table (Last_Asgn);
+               begin
+                  Last_Asgn_Rec.Value := Build_Mem_Multiport
+                    (Ctxt, Last_Asgn_Rec.Value, Get_Conc_Value (Asgn));
+               end;
+               --  Remove this assignment.
+               Nbr_Assign := Nbr_Assign - 1;
+               Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn));
+            else
+               Error_Msg_Synth
+                 (+Wire_Rec.Decl, "multiple assignments for offsets %v:%v",
+                  (+Next_Off, +(Expected_Off - 1)));
+               --  TODO: insert resolver
+               Expected_Off :=
+                 Expected_Off + Get_Width (Get_Conc_Value (Asgn));
+               Last_Asgn := Asgn;
+            end if;
             Asgn := Get_Conc_Chain (Asgn);
          end if;
       end loop;
@@ -627,7 +689,7 @@ package body Synth.Environment is
                                  Get_Conc_Value (Last_Asgn),
                                  Get_Conc_Value (First_Assign));
       else
-         Value := Build_Concatn (Ctxt, Last_Off, Uns32 (Nbr_Assign));
+         Value := Build_Concatn (Ctxt, Wire_Width, Uns32 (Nbr_Assign));
          declare
             Inst : constant Instance := Get_Net_Parent (Value);
          begin
@@ -673,11 +735,12 @@ package body Synth.Environment is
                   --  Single and full assignment.
                   Value := Conc_Asgn.Value;
                else
-                  --  Partial or multiple assignments.
+                  --  Partial assignment.
                   Finalize_Complex_Assignment (Ctxt, Wire_Rec, Value);
                end if;
             end;
          when others =>
+            --  Multiple assignments.
             Finalize_Complex_Assignment (Ctxt, Wire_Rec, Value);
       end case;