path: root/src/synth/synth-stmts.adb

--  Statements synthesis.
--  Copyright (C) 2017 Tristan Gingold
--
--  This file is part of GHDL.
--
--  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 2 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, write to the Free Software
--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
--  MA 02110-1301, USA.

with Ada.Unchecked_Deallocation;

with Grt.Algos;
with Areapools;
with Name_Table;
with Std_Names;
with Errorout; use Errorout;
with Files_Map;
with Simple_IO;

with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Types;
with Vhdl.Sem_Expr;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
with Vhdl.Ieee.Std_Logic_1164;
with Vhdl.Evaluation;

with PSL.Types;
with PSL.Nodes;
with PSL.NFAs;
with PSL.Errors;

with Synth.Errors; use Synth.Errors;
with Synth.Decls; use Synth.Decls;
with Synth.Expr; use Synth.Expr;
with Synth.Insts; use Synth.Insts;
with Synth.Source;
with Synth.Static_Proc;
with Synth.Heap;
with Synth.Flags;

with Netlists.Builders; use Netlists.Builders;
with Netlists.Gates;
with Netlists.Utils; use Netlists.Utils;
with Netlists.Locations; use Netlists.Locations;
with Netlists.Butils; use Netlists.Butils;

package body Synth.Stmts is
   procedure Synth_Sequential_Statements
     (C : in out Seq_Context; Stmts : Node);

   procedure Set_Location (N : Net; Loc : Node)
     renames Synth.Source.Set_Location;

   function Synth_Waveform (Syn_Inst : Synth_Instance_Acc;
                            Wf : Node;
                            Targ_Type : Type_Acc) return Value_Acc is
   begin
      if Get_Kind (Wf) = Iir_Kind_Unaffected_Waveform then
         --  TODO
         raise Internal_Error;
      end if;
      if Get_Chain (Wf) /= Null_Node then
         --  Warning.
         null;
      end if;
      if Get_Time (Wf) /= Null_Node then
         --  Warning
         null;
      end if;
      if Targ_Type = null then
         return Synth_Expression (Syn_Inst, Get_We_Value (Wf));
      else
         return Synth_Expression_With_Type
           (Syn_Inst, Get_We_Value (Wf), Targ_Type);
      end if;
   end Synth_Waveform;

   procedure Synth_Assign (Wid : Wire_Id;
                           Typ : Type_Acc;
                           Val : Value_Acc;
                           Offset : Uns32;
                           Loc : Source.Syn_Src) is
   begin
      Phi_Assign (Build_Context, Wid,
                  Get_Net (Synth_Subtype_Conversion (Val, Typ, False, Loc)),
                  Offset);
   end Synth_Assign;

   procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc;
                                         Target : Node;
                                         Target_Type : Type_Acc;
                                         Val : Value_Acc;
                                         Loc : Node)
   is
      Choice : Node;
      Assoc : Node;
      Pos : Uns32;
   begin
      if Target_Type.Kind = Type_Vector then
         Choice := Get_Association_Choices_Chain (Target);
         Pos := Target_Type.W;
         while Is_Valid (Choice) loop
            Assoc := Get_Associated_Expr (Choice);
            case Get_Kind (Choice) is
               when Iir_Kind_Choice_By_None =>
                  Pos := Pos - 1;
                  Synth_Assignment
                    (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target), Loc);
               when others =>
                  Error_Kind ("synth_assignment_aggregate", Choice);
            end case;
            Choice := Get_Chain (Choice);
         end loop;
      else
         raise Internal_Error;
      end if;
   end Synth_Assignment_Aggregate;

   procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
                                      Pfx : Node;
                                      Dest_Obj : out Value_Acc;
                                      Dest_Off : out Uns32;
                                      Dest_Voff : out Net;
                                      Dest_Rdwd : out Width;
                                      Dest_Type : out Type_Acc) is
   begin
      case Get_Kind (Pfx) is
         when Iir_Kind_Simple_Name =>
            Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx),
                                     Dest_Obj, Dest_Off,
                                     Dest_Voff, Dest_Rdwd, Dest_Type);
         when Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Interface_Variable_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Anonymous_Signal_Declaration
           | Iir_Kind_Interface_Constant_Declaration
           | Iir_Kind_Constant_Declaration
           | Iir_Kind_File_Declaration
           | Iir_Kind_Interface_File_Declaration
           | Iir_Kind_Object_Alias_Declaration =>
            declare
               Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx);
            begin
               Dest_Voff := No_Net;
               Dest_Rdwd := 0;
               Dest_Type := Targ.Typ;

               if Targ.Kind = Value_Alias then
                  --  Replace alias by the aliased name.
                  Dest_Obj := Targ.A_Obj;
                  Dest_Off := Targ.A_Off;
               else
                  Dest_Obj := Targ;
                  Dest_Off := 0;
               end if;
            end;
         when Iir_Kind_Indexed_Name =>
            declare
               Voff : Net;
               Off : Uns32;
               W : Width;
               Dest_W : Width;
            begin
               Synth_Assignment_Prefix
                 (Syn_Inst, Get_Prefix (Pfx),
                  Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
               Strip_Const (Dest_Obj);
               Dest_W := Dest_Type.W;
               Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Type, Voff, Off, W);

               Dest_Type := Get_Array_Element (Dest_Type);

               if Voff /= No_Net then
                  if Dest_Off /= 0 then
                     --  TODO: add addidx (addoff ?)
                     if Off /= 0 or else Dest_Type.W /= 1 then
                        raise Internal_Error;
                     end if;
                  else
                     Dest_Off := Off;
                  end if;
                  if Dest_Voff = No_Net then
                     Dest_Voff := Voff;
                     Dest_Rdwd := Dest_W;
                  else
                     Dest_Voff := Build_Addidx
                       (Get_Build (Syn_Inst), Dest_Voff, Voff);
                  end if;
               else
                  if Dest_Voff = No_Net then
                     Dest_Off := Dest_Off + Off;

                     Strip_Const (Dest_Obj);
                     if Dest_Obj.Kind in Value_Array .. Value_Const_Array then
                        Dest_Obj := Dest_Obj.Arr.V
                          (Iir_Index32 ((Dest_W - Dest_Off) / W));
                        Dest_Off := 0;
                        Dest_W := W;
                     end if;
                  else
                     if Dest_Off /= 0 then
                        --  TODO.
                        raise Internal_Error;
                     end if;
                     Dest_Off := Dest_Off + Off;
                  end if;
               end if;
            end;

         when Iir_Kind_Selected_Element =>
            declare
               Idx : constant Iir_Index32 :=
                 Get_Element_Position (Get_Named_Entity (Pfx));
            begin
               Synth_Assignment_Prefix
                 (Syn_Inst, Get_Prefix (Pfx),
                  Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
               if Dest_Off /= 0 and then Dest_Voff /= No_Net then
                  --  TODO.
                  raise Internal_Error;
               end if;
               Strip_Const (Dest_Obj);
               if Dest_Obj.Kind = Value_Const_Record then
                  pragma Assert (Dest_Off = 0);
                  Dest_Obj := Dest_Obj.Rec.V (Idx + 1);
               else
                  Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off;
               end if;
               Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ;
            end;

         when Iir_Kind_Slice_Name =>
            declare
               Pfx_Bnd : Bound_Type;
               El_Typ : Type_Acc;
               Res_Bnd : Bound_Type;
               Sl_Voff : Net;
               Sl_Off : Uns32;
               Wd : Uns32;
            begin
               Synth_Assignment_Prefix
                 (Syn_Inst, Get_Prefix (Pfx),
                  Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
               Strip_Const (Dest_Obj);

               Get_Onedimensional_Array_Bounds (Dest_Type, Pfx_Bnd, El_Typ);
               Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ.W,
                                   Res_Bnd, Sl_Voff, Sl_Off, Wd);

               if Sl_Voff /= No_Net then
                  --  Variable slice.
                  if Dest_Off /= 0 then
                     --  Offset before slice is not yet handled.
                     raise Internal_Error;
                  end if;
                  Dest_Off := Dest_Off + Sl_Off;
                  if Dest_Voff /= No_Net then
                     Dest_Voff := Build_Addidx
                       (Get_Build (Syn_Inst), Dest_Voff, Sl_Voff);
                  else
                     Dest_Rdwd := Dest_Type.W;
                     Dest_Voff := Sl_Voff;
                  end if;
                  Dest_Type := Create_Slice_Type (Wd, El_Typ);
               else
                  --  Fixed slice.
                  Dest_Type :=
                    Create_Onedimensional_Array_Subtype (Dest_Type, Res_Bnd);
                  if Dest_Voff /= No_Net then
                     --  Slice of a memory.
                     if Dest_Off /= 0 then
                        raise Internal_Error;
                     end if;
                     Dest_Off := Sl_Off;
                  else
                     if Dest_Obj.Kind in Value_Array .. Value_Const_Array then
                        declare
                           Arr : Value_Array_Acc;
                           Off : Iir_Index32;
                        begin
                           pragma Assert (Dest_Off = 0);
                           Arr := Create_Value_Array
                             (Iir_Index32 (Res_Bnd.Len));
                           case Pfx_Bnd.Dir is
                              when Iir_To =>
                                 Off := Iir_Index32
                                   (Res_Bnd.Left - Pfx_Bnd.Left);
                              when Iir_Downto =>
                                 Off := Iir_Index32
                                   (Pfx_Bnd.Left - Res_Bnd.Left);
                           end case;
                           Arr.V := Dest_Obj.Arr.V
                             (Off + 1 .. Off + Iir_Index32 (Res_Bnd.Len));
                           if Dest_Obj.Kind = Value_Array then
                              Dest_Obj := Create_Value_Array
                                (Dest_Type, Arr);
                           else
                              Dest_Obj := Create_Value_Const_Array
                                (Dest_Type, Arr);
                           end if;
                        end;
                     else
                        --  Slice of a vector.
                        Dest_Off := Dest_Off + Sl_Off;
                     end if;
                  end if;
               end if;
            end;

         when Iir_Kind_Implicit_Dereference
           | Iir_Kind_Dereference =>
            Synth_Assignment_Prefix
              (Syn_Inst, Get_Prefix (Pfx),
               Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
            if Dest_Off /= 0 and then Dest_Voff /= No_Net then
               raise Internal_Error;
            end if;
            Dest_Obj := Heap.Synth_Dereference (Dest_Obj.Acc);
            Dest_Type := Dest_Obj.Typ;

         when others =>
            Error_Kind ("synth_assignment_prefix", Pfx);
      end case;
   end Synth_Assignment_Prefix;

   type Target_Kind is
     (Target_Simple, Target_Aggregate, Target_Memory);

   type Target_Info (Kind : Target_Kind := Target_Simple) is record
      --  In all cases, the type of the target is known or computed.
      Targ_Type : Type_Acc;

      case Kind is
         when Target_Simple =>
            --  For a simple target, the destination is known.
            Obj : Value_Acc;
            Off : Uns32;
         when Target_Aggregate =>
            --  For an aggregate: the type is computed and the details will
            --  be handled at the assignment.
            Aggr : Node;
         when Target_Memory =>
            --  For a memory: the destination is known.
            Mem_Obj : Value_Acc;
            --  The dynamic offset.
            Mem_Voff : Net;
            --  Offset of the memory in the wire (usually 0).
            Mem_Moff : Uns32;
            --  Width of the whole memory
            Mem_Mwidth : Width;
            --  Offset of the data to be accessed from the memory.
            Mem_Doff : Uns32;
      end case;
   end record;

   type Target_Info_Array is array (Natural range <>) of Target_Info;

   function Synth_Target (Syn_Inst : Synth_Instance_Acc;
                          Target : Node) return Target_Info is
   begin
      case Get_Kind (Target) is
         when Iir_Kind_Aggregate =>
            declare
               Targ_Type : constant Node := Get_Type (Target);
               Base_Typ : Type_Acc;
               Bnd : Bound_Type;
            begin
               Base_Typ :=
                 Get_Value_Type (Syn_Inst, Get_Base_Type (Targ_Type));
               case Base_Typ.Kind is
                  when Type_Unbounded_Vector =>
                     Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 0);
                     return Target_Info' (Kind => Target_Aggregate,
                                          Targ_Type => Create_Vector_Type
                                            (Bnd, Base_Typ.Uvec_El),
                                          Aggr => Target);
                  when others =>
                     raise Internal_Error;
               end case;
            end;
         when Iir_Kind_Simple_Name
           | Iir_Kind_Selected_Element
           | Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Anonymous_Signal_Declaration
           | Iir_Kind_Indexed_Name
           | Iir_Kind_Slice_Name
           | Iir_Kind_Dereference =>
            declare
               Obj : Value_Acc;
               Off : Uns32;
               Typ : Type_Acc;

               Voff : Net;
               Rdwd : Width;
            begin
               Synth_Assignment_Prefix (Syn_Inst, Target,
                                        Obj, Off, Voff, Rdwd, Typ);
               if Voff = No_Net then
                  --  FIXME: check index.
                  return Target_Info'(Kind => Target_Simple,
                                      Targ_Type => Typ,
                                      Obj => Obj,
                                      Off => Off);
               else
                  return Target_Info'(Kind => Target_Memory,
                                      Targ_Type => Typ,
                                      Mem_Obj => Obj,
                                      Mem_Mwidth => Rdwd,
                                      Mem_Moff => 0,
                                      Mem_Voff => Voff,
                                      Mem_Doff => Off);
               end if;
            end;
         when others =>
            Error_Kind ("synth_target", Target);
      end case;
   end Synth_Target;

   procedure Assign_Value (Targ : Value_Acc; Val : Value_Acc; Loc : Node) is
   begin
      case Targ.Kind is
         when Value_Discrete =>
            Targ.Scal := Val.Scal;
         when Value_Access =>
            Targ.Acc := Val.Acc;
         when Value_Const_Array
           | Value_Array =>
            declare
               Len : constant Iir_Index32 := Val.Arr.Len;
            begin
               for I in 1 .. Len loop
                  Assign_Value (Targ.Arr.V (Targ.Arr.Len - Len + I),
                                Val.Arr.V (I), Loc);
               end loop;
            end;
         when Value_Const_Record
           | Value_Record =>
            for I in Targ.Rec.V'Range loop
               Assign_Value (Targ.Rec.V (I), Val.Rec.V (I), Loc);
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Assign_Value;

   procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
                               Target : Target_Info;
                               Val : Value_Acc;
                               Loc : Node) is
   begin
      case Target.Kind is
         when Target_Aggregate =>
            Synth_Assignment_Aggregate
              (Syn_Inst, Target.Aggr, Target.Targ_Type, Val, Loc);
         when Target_Simple =>
            if Target.Obj.Kind = Value_Wire then
               Synth_Assign (Target.Obj.W, Target.Targ_Type,
                             Val, Target.Off, Loc);
            else
               if not Is_Static (Val) then
                  --  Maybe the error message is too cryptic ?
                  Error_Msg_Synth
                    (+Loc, "cannot assign a net to a static value");
               else
                  pragma Assert (Target.Off = 0);
                  Assign_Value (Target.Obj, Val, Loc);
               end if;
            end if;
         when Target_Memory =>
            declare
               V : Net;
            begin
               V := Get_Current_Assign_Value
                 (Get_Build (Syn_Inst), Target.Mem_Obj.W, Target.Mem_Moff,
                  Target.Mem_Mwidth);
               V := Build_Dyn_Insert (Get_Build (Syn_Inst), V, Get_Net (Val),
                  Target.Mem_Voff, Target.Mem_Doff);
               Set_Location (V, Loc);
               Synth_Assign
                 (Target.Mem_Obj.W, Target.Targ_Type,
                  Create_Value_Net (V, Target.Targ_Type),
                  Target.Mem_Moff, Loc);
            end;
      end case;
   end Synth_Assignment;

   procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
                               Target : Node;
                               Val : Value_Acc;
                               Loc : Node)
   is
      Info : Target_Info;
   begin
      Info := Synth_Target (Syn_Inst, Target);
      Synth_Assignment (Syn_Inst, Info, Val, Loc);
   end Synth_Assignment;

   function Synth_Read_Memory (Syn_Inst : Synth_Instance_Acc;
                               Obj : Value_Acc;
                               Off : Uns32;
                               Voff : Net;
                               Typ : Type_Acc;
                               Loc : Node) return Value_Acc
   is
      N : Net;
   begin
      if Voff /= No_Net then
         N := Build_Dyn_Extract
           (Get_Build (Syn_Inst), Get_Net (Obj), Voff, Off, Typ.W);
      else
         pragma Assert (not Is_Static (Obj));
         if Off = 0
           and then Typ.W = Obj.Typ.W
           and then Typ /= Get_Array_Element (Obj.Typ)
         then
            --  Nothing to do if extracting the whole object as a slice.
            return Obj;
         end if;
         N := Build_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Off, Typ.W);
      end if;
      Set_Location (N, Loc);
      return Create_Value_Net (N, Typ);
   end Synth_Read_Memory;

   --  Concurrent or sequential simple signal assignment
   procedure Synth_Simple_Signal_Assignment
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Targ : Target_Info;
      Val : Value_Acc;
   begin
      Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
      Val := Synth_Waveform
        (Syn_Inst, Get_Waveform_Chain (Stmt), Targ.Targ_Type);
      Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
   end Synth_Simple_Signal_Assignment;

   procedure Synth_Conditional_Signal_Assignment
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Targ : Target_Info;
      Cond : Node;
      Cwf : Node;
      Val, Cond_Val : Value_Acc;
      First, Last : Net;
      V : Net;
   begin
      Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
      Last := No_Net;
      Cwf := Get_Conditional_Waveform_Chain (Stmt);
      while Cwf /= Null_Node loop
         Val := Synth_Waveform
           (Syn_Inst, Get_Waveform_Chain (Cwf), Targ.Targ_Type);
         V := Get_Net (Val);
         Cond := Get_Condition (Cwf);
         if Cond /= Null_Node then
            Cond_Val := Synth_Expression (Syn_Inst, Cond);
            V := Build_Mux2 (Build_Context,
                             Get_Net (Cond_Val),
                             No_Net, V);
            Set_Location (V, Cwf);
         end if;

         if Last /= No_Net then
            Connect (Get_Input (Get_Net_Parent (Last), 1), V);
         else
            First := V;
         end if;
         Last := V;
         Cwf := Get_Chain (Cwf);
      end loop;
      Val := Create_Value_Net (First, Targ.Targ_Type);
      Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
   end Synth_Conditional_Signal_Assignment;

   procedure Synth_Variable_Assignment
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Targ : Target_Info;
      Val : Value_Acc;
   begin
      Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
      Val := Synth_Expression_With_Type
        (Syn_Inst, Get_Expression (Stmt), Targ.Targ_Type);
      Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
   end Synth_Variable_Assignment;

   procedure Synth_Conditional_Variable_Assignment
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Target : constant Node := Get_Target (Stmt);
      Targ_Type : Type_Acc;
      Cond : Node;
      Ce : Node;
      Val, Cond_Val : Value_Acc;
      V : Net;
      First, Last : Net;
   begin
      Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Target));
      Last := No_Net;
      Ce := Get_Conditional_Expression_Chain (Stmt);
      while Ce /= Null_Node loop
         Val := Synth_Expression_With_Type
           (Syn_Inst, Get_Expression (Ce), Targ_Type);
         V := Get_Net (Val);
         Cond := Get_Condition (Ce);
         if Cond /= Null_Node then
            Cond_Val := Synth_Expression (Syn_Inst, Cond);
            V := Build_Mux2 (Build_Context, Get_Net (Cond_Val), No_Net, V);
            Set_Location (V, Ce);
         end if;

         if Last /= No_Net then
            Connect (Get_Input (Get_Net_Parent (Last), 1), V);
         else
            First := V;
         end if;
         Last := V;
         Ce := Get_Chain (Ce);
      end loop;
      Val := Create_Value_Net (First, Targ_Type);
      Synth_Assignment (Syn_Inst, Target, Val, Stmt);
   end Synth_Conditional_Variable_Assignment;

   procedure Synth_If_Statement (C : in out Seq_Context; Stmt : Node)
   is
      Cond : constant Node := Get_Condition (Stmt);
      Els : constant Node := Get_Else_Clause (Stmt);
      Cond_Val : Value_Acc;
      Phi_True : Phi_Type;
      Phi_False : Phi_Type;
   begin
      Cond_Val := Synth_Expression (C.Inst, Cond);
      if Is_Static (Cond_Val) then
         if Cond_Val.Scal = 1 then
            --  True.
            Synth_Sequential_Statements
              (C, Get_Sequential_Statement_Chain (Stmt));
         else
            pragma Assert (Cond_Val.Scal = 0);
            if Is_Valid (Els) then
               --  Else part
               if Is_Null (Get_Condition (Els)) then
                  --  Final else part.
                  Synth_Sequential_Statements
                    (C, Get_Sequential_Statement_Chain (Els));
               else
                  --  Elsif.  Handled as a nested if.
                  Synth_If_Statement (C, Els);
               end if;
            end if;
         end if;
      else
         Push_Phi;
         Synth_Sequential_Statements
           (C, Get_Sequential_Statement_Chain (Stmt));
         Pop_Phi (Phi_True);

         Push_Phi;
         if Is_Valid (Els) then
            if Is_Null (Get_Condition (Els)) then
               --  Final else part.
               Synth_Sequential_Statements
                 (C, Get_Sequential_Statement_Chain (Els));
            else
               --  Elsif.  Handled as a nested if.
               Synth_If_Statement (C, Els);
            end if;
         end if;
         Pop_Phi (Phi_False);

         Merge_Phis (Get_Build (C.Inst),
                     Get_Net (Cond_Val), Phi_True, Phi_False, Stmt);
      end if;
   end Synth_If_Statement;

   procedure Convert_Bv_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64)
   is
      El_Type : constant Node :=
        Get_Base_Type (Get_Element_Subtype (Get_Type (Expr)));
   begin
      if El_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then
         declare
            use Vhdl.Evaluation.String_Utils;

            Info : constant Str_Info := Get_Str_Info (Expr);
         begin
            if Info.Len > 64 then
               raise Internal_Error;
            end if;
            Val := 0;
            Dc := 0;
            for I in 0 .. Info.Len - 1 loop
               Val := Shift_Left (Val, 1);
               Dc := Shift_Left (Dc, 1);
               case Get_Pos (Info, I) is
                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos =>
                     Val := Val or 0;
                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos =>
                     Val := Val or 1;
                  when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos
                    |  Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos =>
                     Dc := Dc or 1;
                  when others =>
                     raise Internal_Error;
               end case;
            end loop;
         end;
      elsif El_Type = Vhdl.Std_Package.Bit_Type_Definition then
         declare
            use Vhdl.Evaluation.String_Utils;

            Info : constant Str_Info := Get_Str_Info (Expr);
         begin
            if Info.Len > 64 then
               raise Internal_Error;
            end if;
            Val := 0;
            Dc := 0;
            for I in 0 .. Info.Len - 1 loop
               Val := Shift_Left (Val, 1);
               case Get_Pos (Info, I) is
                  when 0 =>
                     Val := Val or 0;
                  when 1 =>
                     Val := Val or 1;
                  when others =>
                     raise Internal_Error;
               end case;
            end loop;
         end;
      else
         raise Internal_Error;
      end if;
   end Convert_Bv_To_Uns64;

   --  EXPR is a choice, so a locally static literal.
   procedure Convert_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64)
   is
      Expr_Type : constant Node := Get_Type (Expr);
   begin
      case Get_Kind (Expr_Type) is
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            Convert_Bv_To_Uns64 (Expr, Val, Dc);
         when Iir_Kind_Enumeration_Type_Definition =>
            Dc := 0;
            Val := Uns64 (Get_Enum_Pos (Strip_Denoting_Name (Expr)));
         when Iir_Kind_Integer_Type_Definition
           | Iir_Kind_Integer_Subtype_Definition =>
            --  TODO: signed values.
            Dc := 0;
            Val := Uns64 (Get_Value (Expr));
         when others =>
            Error_Kind ("convert_to_uns64", Expr_Type);
      end case;
   end Convert_To_Uns64;

   type Alternative_Index is new Int32;

   type Choice_Data_Type is record
      --  Value of the choice
      Val : Uns64;

      --  Corresponding alternative
      Alt : Alternative_Index;
   end record;

   type Choice_Data_Array is array (Natural range <>) of Choice_Data_Type;
   type Choice_Data_Array_Acc is access Choice_Data_Array;
   procedure Free_Choice_Data_Array is new Ada.Unchecked_Deallocation
     (Choice_Data_Array, Choice_Data_Array_Acc);

   type Alternative_Data_Type is record
      Asgns : Seq_Assign;
      Val : Net;
   end record;
   type Alternative_Data_Array is
     array (Alternative_Index range <>) of Alternative_Data_Type;
   type Alternative_Data_Acc is access Alternative_Data_Array;
   procedure Free_Alternative_Data_Array is new Ada.Unchecked_Deallocation
     (Alternative_Data_Array, Alternative_Data_Acc);

   type Wire_Id_Array is array (Natural range <>) of Wire_Id;
   type Wire_Id_Array_Acc is access Wire_Id_Array;
   procedure Free_Wire_Id_Array is new Ada.Unchecked_Deallocation
     (Wire_Id_Array, Wire_Id_Array_Acc);

   procedure Sort_Wire_Id_Array (Arr : in out Wire_Id_Array)
   is
      function Lt (Op1, Op2 : Natural) return Boolean is
      begin
         return Is_Lt (Arr (Op1), Arr (Op2));
      end Lt;

      procedure Swap (From : Natural; To : Natural)
      is
         T : Wire_Id;
      begin
         T := Arr (From);
         Arr (From) := Arr (To);
         Arr (To) := T;
      end Swap;

      procedure Wid_Heap_Sort is
         new Grt.Algos.Heap_Sort (Lt => Lt, Swap => Swap);
   begin
      Wid_Heap_Sort (Arr'Length);
   end Sort_Wire_Id_Array;

   function Count_Wires_In_Alternatives (Alts : Alternative_Data_Array)
                                        return Natural
   is
      Res : Natural;
      Asgn : Seq_Assign;
      W : Wire_Id;
   begin
      Res := 0;
      for I in Alts'Range loop
         Asgn := Alts (I).Asgns;
         while Asgn /= No_Seq_Assign loop
            W := Get_Wire_Id (Asgn);
            if not Get_Wire_Mark (W) then
               Res := Res + 1;
               Set_Wire_Mark (W, True);
            end if;
            Asgn := Get_Assign_Chain (Asgn);
         end loop;
      end loop;
      return Res;
   end Count_Wires_In_Alternatives;

   procedure Fill_Wire_Id_Array (Arr : out Wire_Id_Array;
                                 Alts : Alternative_Data_Array)
   is
      Idx : Natural;
      Asgn : Seq_Assign;
      W : Wire_Id;
   begin
      Idx := Arr'First;
      for I in Alts'Range loop
         Asgn := Alts (I).Asgns;
         while Asgn /= No_Seq_Assign loop
            W := Get_Wire_Id (Asgn);
            if Get_Wire_Mark (W) then
               Arr (Idx) := W;
               Idx := Idx + 1;
               Set_Wire_Mark (W, False);
            end if;
            Asgn := Get_Assign_Chain (Asgn);
         end loop;
      end loop;
      pragma Assert (Idx = Arr'Last + 1);
   end Fill_Wire_Id_Array;

   type Partial_Assign_Array_Acc is access Partial_Assign_Array;
   procedure Free_Partial_Assign_Array is new Ada.Unchecked_Deallocation
     (Partial_Assign_Array, Partial_Assign_Array_Acc);

   procedure Synth_Case_Statement (C : in out Seq_Context; Stmt : Node)
   is
      use Vhdl.Sem_Expr;

      Expr : constant Node := Get_Expression (Stmt);
      Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
      Choice : Node;

      Case_Info : Choice_Info_Type;
      Annex_Arr : Annex_Array_Acc;

      --  Array of alternatives
      Alts : Alternative_Data_Acc;
      Alt_Idx : Alternative_Index;
      Others_Alt_Idx : Alternative_Index;

      --  Array of choices.  Contains tuple of (Value, Alternative).
      Choice_Data : Choice_Data_Array_Acc;
      Choice_Idx : Natural;

      Case_El : Case_Element_Array_Acc;
      Pasgns : Partial_Assign_Array_Acc;
      Nets : Net_Array_Acc;

      Nbr_Wires : Natural;
      Wires : Wire_Id_Array_Acc;

      Sel : Value_Acc;
      Sel_Net : Net;
   begin
      --  Strategies to synthesize a case statement.  Assume the selector is
      --  a net of W bits
      --  - a large mux, with 2**W inputs
      --    - if the number of choices is dense
      --    - if W is small
      --  - a onehot mux.  Each choice is converted to an single bit condition
      --    by adding a comparison operator (equal for single choice,
      --    inequalities for ranges, or for multiple choices). Only one of
      --    these conditions is true (plus 'others').
      --    - if the number of choices is sparse
      --    - large range choices
      --  - a tree of mux/mux2
      --    - large number of choices, densily grouped but sparsed compared
      --       to 2**W (eg: a partially filled memory)
      --    - divide and conquier

      --  Create a net for the expression.
      Sel := Synth_Expression_With_Basetype (C.Inst, Expr);

      --  Count choices and alternatives.
      Count_Choices (Case_Info, Choices);
      Fill_Choices_Array (Case_Info, Choices);

      --  Allocate structures.
      --  Because there is no 1-1 link between choices and alternatives,
      --  create an array for the choices and an array for the alternatives.
      Alts := new Alternative_Data_Array
        (1 .. Alternative_Index (Case_Info.Nbr_Alternatives));
      Choice_Data := new Choice_Data_Array (1 .. Case_Info.Nbr_Choices);
      Annex_Arr := new Annex_Array (1 .. Case_Info.Nbr_Choices);
      Case_Info.Annex_Arr := Annex_Arr;

      --  Synth statements, extract choice value.
      Alt_Idx := 0;
      Others_Alt_Idx := 0;
      Choice_Idx := 0;
      Choice := Choices;
      while Is_Valid (Choice) loop
         if not Get_Same_Alternative_Flag (Choice) then
            Alt_Idx := Alt_Idx + 1;

            declare
               Phi : Phi_Type;
            begin
               Push_Phi;
               Synth_Sequential_Statements (C, Get_Associated_Chain (Choice));
               Pop_Phi (Phi);
               Alts (Alt_Idx).Asgns := Sort_Phi (Phi);
            end;
         end if;

         case Get_Kind (Choice) is
            when Iir_Kind_Choice_By_Expression =>
               Choice_Idx := Choice_Idx + 1;
               Annex_Arr (Choice_Idx) := Int32 (Choice_Idx);
               declare
                  Choice_Expr : constant Node :=
                    Get_Choice_Expression (Choice);
                  Val, Dc : Uns64;
               begin
                  Convert_To_Uns64 (Choice_Expr, Val, Dc);
                  if Dc = 0 then
                     Choice_Data (Choice_Idx) := (Val => Val,
                                                  Alt => Alt_Idx);
                  else
                     Error_Msg_Synth (+Choice_Expr, "meta-values never match");
                     Choice_Data (Choice_Idx) := (Val => 0,
                                                  Alt => 0);
                  end if;
               end;
            when Iir_Kind_Choice_By_Others =>
               Others_Alt_Idx := Alt_Idx;
            when others =>
               raise Internal_Error;
         end case;
         Choice := Get_Chain (Choice);
      end loop;
      pragma Assert (Choice_Idx = Choice_Data'Last);

      --  Sort by order.
      if Get_Kind (Get_Type (Expr)) in Iir_Kinds_Discrete_Type_Definition then
         Sort_Discrete_Choices (Case_Info);
      else
         Sort_String_Choices (Case_Info);
      end if;

      --  Create list of wire_id, sort it.
      Nbr_Wires := Count_Wires_In_Alternatives (Alts.all);
      Wires := new Wire_Id_Array (1 .. Nbr_Wires);
      Fill_Wire_Id_Array (Wires.all, Alts.all);
      Sort_Wire_Id_Array (Wires.all);

      --  Associate each choice with the assign node
      --  For each wire_id:
      --    Build mux2/mux4 tree (group by 4)
      Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices);

      Pasgns := new Partial_Assign_Array (1 .. Int32 (Alts'Last));
      Nets := new Net_Array (1 .. Int32 (Alts'Last));

      Sel_Net := Get_Net (Sel);

      --  For each wire, compute the result.
      for I in Wires'Range loop
         declare
            Wi : constant Wire_Id := Wires (I);
            Last_Val : Net;
            Res : Net;
            Default : Net;
            Ch : Natural;
            Min_Off, Off : Uns32;
            Wd : Width;
            List : Partial_Assign_List;
         begin
            --  Extract the value for each branch.
            for I in Alts'Range loop
               --  If there is an assignment to Wi in Alt, it will define the
               --  value.
               if Get_Wire_Id (Alts (I).Asgns) = Wi then
                  Pasgns (Int32 (I)) := Get_Assign_Partial (Alts (I).Asgns);
                  Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns);
               else
                  Pasgns (Int32 (I)) := No_Partial_Assign;
               end if;
            end loop;

            Partial_Assign_Init (List);
            Min_Off := 0;
            loop
               Off := Min_Off;

               -- Extract value of partial assignments to NETS.
               Extract_Merge_Partial_Assigns
                 (Build_Context, Pasgns.all, Nets.all, Off, Wd);
               exit when Off = Uns32'Last and Wd = Width'Last;

               --  If a branch has no value, use the value before the case.
               Last_Val := No_Net;
               for I in Nets'Range loop
                  if Nets (I) = No_Net then
                     if Last_Val = No_Net then
                        Last_Val := Get_Current_Assign_Value
                          (Build_Context, Wi, Off, Wd);
                     end if;
                     Nets (I) := Last_Val;
                  end if;
               end loop;

               --  Build the map between choices and values.
               for J in Annex_Arr'Range loop
                  Ch := Natural (Annex_Arr (J));
                  Case_El (J) := (Sel => Choice_Data (Ch).Val,
                                  Val => Nets (Int32 (Choice_Data (Ch).Alt)));
               end loop;

               --  Extract default value (for missing alternative).
               if Others_Alt_Idx /= 0 then
                  Default := Nets (Int32 (Others_Alt_Idx));
               else
                  Default := No_Net;
               end if;

               --  Generate the muxes tree.
               Synth_Case (Get_Build (C.Inst),
                           Sel_Net, Case_El.all, Default, Res,
                           Get_Location (Expr));

               Partial_Assign_Append (List, New_Partial_Assign (Res, Off));
               Min_Off := Off + Wd;
            end loop;

            Merge_Partial_Assigns (Build_Context, Wi, List);
         end;
      end loop;

      --  free.
      Free_Case_Element_Array (Case_El);
      Free_Wire_Id_Array (Wires);
      Free_Choice_Data_Array (Choice_Data);
      Free_Annex_Array (Annex_Arr);
      Free_Alternative_Data_Array (Alts);
      Free_Partial_Assign_Array (Pasgns);
      Free_Net_Array (Nets);
   end Synth_Case_Statement;

   procedure Synth_Selected_Signal_Assignment
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      use Vhdl.Sem_Expr;

      Targ : constant Node := Get_Target (Stmt);

      Expr : constant Node := Get_Expression (Stmt);
      Choices : constant Node := Get_Selected_Waveform_Chain (Stmt);
      Choice : Node;

      Targ_Type : Type_Acc;

      Case_Info : Choice_Info_Type;
      Annex_Arr : Annex_Array_Acc;

      --  Array of alternatives
      Alts : Alternative_Data_Acc;
      Alt_Idx : Alternative_Index;
      Others_Alt_Idx : Alternative_Index;

      --  Array of choices.  Contains tuple of (Value, Alternative).
      Choice_Data : Choice_Data_Array_Acc;
      Choice_Idx : Natural;

      Case_El : Case_Element_Array_Acc;

      Sel : Value_Acc;
      Sel_Net : Net;
   begin
      Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Targ));
      --  Create a net for the expression.
      Sel := Synth_Expression_With_Basetype (Syn_Inst, Expr);

      --  Count choices and alternatives.
      Count_Choices (Case_Info, Choices);
      Fill_Choices_Array (Case_Info, Choices);

      --  Allocate structures.
      --  Because there is no 1-1 link between choices and alternatives,
      --  create an array for the choices and an array for the alternatives.
      Alts := new Alternative_Data_Array
        (1 .. Alternative_Index (Case_Info.Nbr_Alternatives));
      Choice_Data := new Choice_Data_Array (1 .. Case_Info.Nbr_Choices);
      Annex_Arr := new Annex_Array (1 .. Case_Info.Nbr_Choices);
      Case_Info.Annex_Arr := Annex_Arr;

      --  Synth statements, extract choice value.
      Alt_Idx := 0;
      Others_Alt_Idx := 0;
      Choice_Idx := 0;
      Choice := Choices;
      while Is_Valid (Choice) loop
         if not Get_Same_Alternative_Flag (Choice) then
            Alt_Idx := Alt_Idx + 1;

            Alts (Alt_Idx).Val := Get_Net
              (Synth_Waveform
                 (Syn_Inst, Get_Associated_Chain (Choice), Targ_Type));
         end if;

         case Get_Kind (Choice) is
            when Iir_Kind_Choice_By_Expression =>
               Choice_Idx := Choice_Idx + 1;
               Annex_Arr (Choice_Idx) := Int32 (Choice_Idx);
               declare
                  Choice_Expr : constant Node :=
                    Get_Choice_Expression (Choice);
                  Val, Dc : Uns64;
               begin
                  Convert_To_Uns64 (Choice_Expr, Val, Dc);
                  if Dc = 0 then
                     Choice_Data (Choice_Idx) := (Val => Val,
                                                  Alt => Alt_Idx);
                  else
                     Error_Msg_Synth (+Choice_Expr, "meta-values never match");
                     Choice_Data (Choice_Idx) := (Val => 0,
                                                  Alt => 0);
                  end if;
               end;
            when Iir_Kind_Choice_By_Others =>
               Others_Alt_Idx := Alt_Idx;
            when others =>
               raise Internal_Error;
         end case;
         Choice := Get_Chain (Choice);
      end loop;
      pragma Assert (Choice_Idx = Choice_Data'Last);

      --  Sort by order.
      if Get_Kind (Get_Type (Expr)) in Iir_Kinds_Discrete_Type_Definition then
         Sort_Discrete_Choices (Case_Info);
      else
         Sort_String_Choices (Case_Info);
      end if;

      --  Associate each choice with the assign node
      --  For each wire_id:
      --    Build mux2/mux4 tree (group by 4)
      Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices);

      Sel_Net := Get_Net (Sel);

      declare
         Res : Net;
         Default : Net;
         C : Natural;
      begin
         --  Build the map between choices and values.
         for J in Annex_Arr'Range loop
            C := Natural (Annex_Arr (J));
            Case_El (J) := (Sel => Choice_Data (C).Val,
                            Val => Alts (Choice_Data (C).Alt).Val);
         end loop;

         --  Extract default value (for missing alternative).
         if Others_Alt_Idx /= 0 then
            Default := Alts (Others_Alt_Idx).Val;
         else
            Default := No_Net;
         end if;

         --  Generate the muxes tree.
         Synth_Case (Get_Build (Syn_Inst),
                     Sel_Net, Case_El.all, Default, Res,
                     Get_Location (Expr));
         Synth_Assignment (Syn_Inst, Get_Target (Stmt),
                           Create_Value_Net (Res, Targ_Type),
                           Stmt);
      end;

      --  free.
      Free_Case_Element_Array (Case_El);
      Free_Choice_Data_Array (Choice_Data);
      Free_Annex_Array (Annex_Arr);
      Free_Alternative_Data_Array (Alts);
   end Synth_Selected_Signal_Assignment;

   function Synth_Label (Stmt : Node) return Sname
   is
      Label : constant Name_Id := Get_Label (Stmt);
   begin
      if Label = Null_Identifier then
         return No_Sname;
      else
         return New_Sname_User (Label);
      end if;
   end Synth_Label;

   function Is_Copyback_Interface (Inter : Node) return Boolean is
   begin
      case Iir_Parameter_Modes (Get_Mode (Inter)) is
         when Iir_In_Mode =>
            return False;
         when Iir_Out_Mode | Iir_Inout_Mode =>
            return Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration;
      end case;
   end Is_Copyback_Interface;

   function Count_Associations (Inter_Chain : Node; Assoc_Chain : Node)
                               return Natural
   is
      Assoc : Node;
      Assoc_Inter : Node;
      Inter : Node;
      Nbr_Inout : Natural;
   begin
      Nbr_Inout := 0;

      Assoc := Assoc_Chain;
      Assoc_Inter := Inter_Chain;
      while Is_Valid (Assoc) loop
         Inter := Get_Association_Interface (Assoc, Assoc_Inter);

         if Is_Copyback_Interface (Inter) then
            Nbr_Inout := Nbr_Inout + 1;
         end if;

         Next_Association_Interface (Assoc, Assoc_Inter);
      end loop;

      return Nbr_Inout;
   end Count_Associations;

   type Association_Iterator is record
      Inter : Node;
      First_Named_Assoc : Node;
      Next_Assoc : Node;
   end record;

   procedure Association_Iterate_Init (Iterator : out Association_Iterator;
                                       Inter_Chain : Node;
                                       Assoc_Chain : Node) is
   begin
      Iterator := (Inter => Inter_Chain,
                   First_Named_Assoc => Null_Node,
                   Next_Assoc => Assoc_Chain);
   end Association_Iterate_Init;

   procedure Association_Iterate_Next (Iterator : in out Association_Iterator;
                                       Inter : out Node;
                                       Assoc : out Node)
   is
      Formal : Node;
   begin
      Inter := Iterator.Inter;
      if Inter = Null_Node then
         --  End of iterator.
         Assoc := Null_Node;
         return;
      else
         --  Advance to the next interface for the next call.
         Iterator.Inter := Get_Chain (Iterator.Inter);
      end if;

      if Iterator.First_Named_Assoc = Null_Node then
         Assoc := Iterator.Next_Assoc;
         if Assoc = Null_Node then
            --  No more association: open association.
            return;
         end if;
         Formal := Get_Formal (Assoc);
         if Formal = Null_Node then
            --  Association by position.
            --  Update for the next call.
            Iterator.Next_Assoc := Get_Chain (Assoc);
            return;
         end if;
         Iterator.First_Named_Assoc := Assoc;
      end if;

      --  Search by name.
      Assoc := Iterator.First_Named_Assoc;
      while Assoc /= Null_Node loop
         Formal := Get_Formal (Assoc);
         pragma Assert (Formal /= Null_Node);
         Formal := Get_Interface_Of_Formal (Formal);
         if Formal = Inter then
            --  Found.
            --  Optimize in case assocs are in order.
            if Assoc = Iterator.First_Named_Assoc then
               Iterator.First_Named_Assoc := Get_Chain (Assoc);
            end if;
            return;
         end if;
         Assoc := Get_Chain (Assoc);
      end loop;

      --  Not found: open association.
      return;
   end Association_Iterate_Next;

   procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
                                           Caller_Inst : Synth_Instance_Acc;
                                           Inter_Chain : Node;
                                           Assoc_Chain : Node;
                                           Infos : out Target_Info_Array)
   is
      pragma Assert (Infos'First = 1);
      Inter : Node;
      Inter_Type : Type_Acc;
      Assoc : Node;
      Actual : Node;
      Val : Value_Acc;
      Nbr_Inout : Natural;
      Iterator : Association_Iterator;
      Info : Target_Info;
   begin
      Set_Instance_Const (Subprg_Inst, True);

      Nbr_Inout := 0;

      --  Process in INTER order.
      Association_Iterate_Init (Iterator, Inter_Chain, Assoc_Chain);
      loop
         Association_Iterate_Next (Iterator, Inter, Assoc);
         exit when Inter = Null_Node;

         Inter_Type := Get_Value_Type (Caller_Inst, Get_Type (Inter));

         case Iir_Parameter_Modes (Get_Mode (Inter)) is
            when Iir_In_Mode =>
               if Assoc = Null_Node
                 or else Get_Kind (Assoc) = Iir_Kind_Association_Element_Open
               then
                  Actual := Get_Default_Value (Inter);
                  Val := Synth_Expression_With_Type
                    (Subprg_Inst, Actual, Inter_Type);
               else
                  case Get_Kind (Assoc) is
                     when Iir_Kind_Association_Element_By_Expression =>
                        Actual := Get_Actual (Assoc);
                        Val := Synth_Expression_With_Type
                          (Caller_Inst, Actual, Inter_Type);
                     when others =>
                        raise Internal_Error;
                  end case;
               end if;
            when Iir_Out_Mode | Iir_Inout_Mode =>
               Actual := Get_Actual (Assoc);
               Info := Synth_Target (Caller_Inst, Actual);

               if Info.Kind /= Target_Simple then
                  raise Internal_Error;
               end if;
               case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter))
                  is
                  when Iir_Kind_Interface_Constant_Declaration =>
                     raise Internal_Error;
                  when Iir_Kind_Interface_Variable_Declaration =>
                     --  Always pass by value.
                     Nbr_Inout := Nbr_Inout + 1;
                     Infos (Nbr_Inout) := Info;
                     if Is_Static (Info.Obj) then
                        if Info.Off /= 0 then
                           raise Internal_Error;
                        end if;
                        Val := Info.Obj;
                     else
                        Val := Synth_Read_Memory
                          (Caller_Inst, Info.Obj, Info.Off, No_Net,
                           Info.Targ_Type, Assoc);
                     end if;
                  when Iir_Kind_Interface_Signal_Declaration =>
                     --  Always pass by reference (use an alias).
                     Val := Create_Value_Alias
                       (Info.Obj, Info.Off, Info.Targ_Type);
                  when Iir_Kind_Interface_File_Declaration =>
                     Val := Info.Obj;
               end case;
         end case;

         --  FIXME: conversion only for constants, reshape for all.
         Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);

         if Get_Instance_Const (Subprg_Inst) and then not Is_Static (Val) then
            Set_Instance_Const (Subprg_Inst, False);
         end if;

         case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is
            when Iir_Kind_Interface_Constant_Declaration =>
               --  Pass by reference.
               Create_Object (Subprg_Inst, Inter, Val);
            when Iir_Kind_Interface_Variable_Declaration =>
               --  Arguments are passed by copy.
               Create_Object (Subprg_Inst, Inter, Unshare (Val, Current_Pool));
            when Iir_Kind_Interface_Signal_Declaration =>
               Create_Object (Subprg_Inst, Inter, Val);
            when Iir_Kind_Interface_File_Declaration =>
               Create_Object (Subprg_Inst, Inter, Val);
         end case;
      end loop;
   end Synth_Subprogram_Association;

   procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
                                           Caller_Inst : Synth_Instance_Acc;
                                           Inter_Chain : Node;
                                           Assoc_Chain : Node)
   is
      Infos : Target_Info_Array (1 .. 0);
      pragma Unreferenced (Infos);
   begin
      Synth_Subprogram_Association (Subprg_Inst, Caller_Inst,
                                    Inter_Chain, Assoc_Chain, Infos);
   end Synth_Subprogram_Association;

   procedure Synth_Subprogram_Back_Association
     (Subprg_Inst : Synth_Instance_Acc;
      Caller_Inst : Synth_Instance_Acc;
      Inter_Chain : Node;
      Assoc_Chain : Node;
      Infos : Target_Info_Array)
   is
      pragma Assert (Infos'First = 1);
      Inter : Node;
      Assoc : Node;
      Assoc_Inter : Node;
      Val : Value_Acc;
      Nbr_Inout : Natural;
   begin
      Nbr_Inout := 0;
      Assoc := Assoc_Chain;
      Assoc_Inter := Inter_Chain;
      while Is_Valid (Assoc) loop
         Inter := Get_Association_Interface (Assoc, Assoc_Inter);

         if Is_Copyback_Interface (Inter) then
            if not Get_Whole_Association_Flag (Assoc) then
               raise Internal_Error;
            end if;
            Nbr_Inout := Nbr_Inout + 1;
            Val := Get_Value (Subprg_Inst, Inter);
            Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc);
         end if;

         Next_Association_Interface (Assoc, Assoc_Inter);
      end loop;
      pragma Assert (Nbr_Inout = Infos'Last);
   end Synth_Subprogram_Back_Association;

   function Synth_Subprogram_Call
     (Syn_Inst : Synth_Instance_Acc; Call : Node) return Value_Acc
   is
      Imp  : constant Node := Get_Implementation (Call);
      Is_Func : constant Boolean := Is_Function_Declaration (Imp);
      Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
      Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
      Bod : constant Node := Get_Subprogram_Body (Imp);
      Nbr_Inout : constant Natural :=
        Count_Associations (Inter_Chain, Assoc_Chain);
      Infos : Target_Info_Array (1 .. Nbr_Inout);
      Area_Mark : Areapools.Mark_Type;
      Res : Value_Acc;
      C : Seq_Context;
      Wire_Mark : Wire_Id;
      Subprg_Phi : Phi_Type;
   begin
      Mark (Wire_Mark);
      Areapools.Mark (Area_Mark, Instance_Pool.all);
      C := (Inst => Make_Instance (Syn_Inst, Bod,
                                   New_Internal_Name (Build_Context)),
            Cur_Loop => null,
            W_En => Alloc_Wire (Wire_Variable, Imp),
            W_Ret => Alloc_Wire (Wire_Variable, Imp),
            W_Val => No_Wire_Id,
            Ret_Init => No_Net,
            Ret_Value => null,
            Ret_Typ => null,
            Nbr_Ret => 0);

      if Is_Func then
         C.W_Val := Alloc_Wire (Wire_Variable, Imp);
      end if;

      Synth_Subprogram_Association
        (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);

      if not Is_Func then
         if Get_Purity_State (Imp) /= Pure then
            Set_Instance_Const (C.Inst, False);
         end if;
      end if;

      Push_Phi;

      if Is_Func then
         --  Set a default value for the return.
         C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
         Set_Wire_Gate (C.W_Val,
                        Build_Signal (Build_Context,
                                      New_Internal_Name (Build_Context),
                                      C.Ret_Typ.W));
         C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W);
         Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0);
      end if;

      Set_Wire_Gate
        (C.W_En, Build_Signal (Build_Context,
                               New_Internal_Name (Build_Context), 1));
      Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);

      Set_Wire_Gate
        (C.W_Ret, Build_Signal (Build_Context,
                                New_Internal_Name (Build_Context), 1));
      Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0);

      Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);

      Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));

      if Is_Func then
         if C.Nbr_Ret = 0 then
            raise Internal_Error;
         elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
            Res := C.Ret_Value;
         else
            Res := Create_Value_Net
              (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ);
         end if;
      else
         Res := null;
         Synth_Subprogram_Back_Association
           (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
      end if;

      Pop_Phi (Subprg_Phi);

      Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
      pragma Unreferenced (Infos);

      --  Propagate assignments.
      Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark);

      --  Free wires.
      Free_Wire (C.W_En);
      Free_Wire (C.W_Ret);
      if Is_Func then
         Free_Wire (C.W_Val);
      end if;

      Free_Instance (C.Inst);
      Areapools.Release (Area_Mark, Instance_Pool.all);

      Release (Wire_Mark);

      return Res;
   end Synth_Subprogram_Call;

   procedure Synth_Implicit_Procedure_Call
     (Syn_Inst : Synth_Instance_Acc; Call : Node)
   is
      Imp  : constant Node := Get_Implementation (Call);
      Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
      Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
      Nbr_Inout : constant Natural :=
        Count_Associations (Inter_Chain, Assoc_Chain);
      Infos : Target_Info_Array (1 .. Nbr_Inout);
      Area_Mark : Areapools.Mark_Type;
      Sub_Inst : Synth_Instance_Acc;
   begin
      Areapools.Mark (Area_Mark, Instance_Pool.all);
      Sub_Inst := Make_Instance (Syn_Inst, Imp,
                                 New_Internal_Name (Build_Context));

      Synth_Subprogram_Association
        (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);

      Synth.Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call);

      Synth_Subprogram_Back_Association
        (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);

      Free_Instance (Sub_Inst);
      Areapools.Release (Area_Mark, Instance_Pool.all);
   end Synth_Implicit_Procedure_Call;

   procedure Synth_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Call : constant Node := Get_Procedure_Call (Stmt);
      Imp  : constant Node := Get_Implementation (Call);
      Res : Value_Acc;
   begin
      case Get_Implicit_Definition (Imp) is
         when Iir_Predefined_None =>
            if Get_Foreign_Flag (Imp) then
               Error_Msg_Synth
                 (+Stmt, "call to foreign %n is not supported", +Imp);
            else
               Res := Synth_Subprogram_Call (Syn_Inst, Call);
               pragma Assert (Res = null);
            end if;
         when others =>
            Synth_Implicit_Procedure_Call (Syn_Inst, Call);
      end case;
   end Synth_Procedure_Call;

   function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean is
   begin
      case Rng.Dir is
         when Iir_To =>
            return V >= Rng.Left and then V <= Rng.Right;
         when Iir_Downto =>
            return V <= Rng.Left and then V >= Rng.Right;
      end case;
   end In_Range;

   procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64) is
   begin
      case Rng.Dir is
         when Iir_To =>
            Idx := Idx + 1;
         when Iir_Downto =>
            Idx := Idx - 1;
      end case;
   end Update_Index;

   procedure Loop_Control_Init (C : Seq_Context; Stmt : Node)
   is
      Lc : constant Loop_Context_Acc := C.Cur_Loop;

   begin
      Mark (C.Cur_Loop.Wire_Mark);

      if (Lc.Prev_Loop /= null and then Lc.Prev_Loop.Need_Quit) then
         Lc.W_Quit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt);
         Set_Wire_Gate
           (Lc.W_Quit, Build_Signal (Get_Build (C.Inst),
                                     New_Internal_Name (Build_Context), 1));
         Phi_Assign (Get_Build (C.Inst), Lc.W_Quit, Get_Inst_Bit1 (C.Inst), 0);
      end if;

      if Get_Exit_Flag (Stmt) or else Get_Next_Flag (Stmt) then
         Lc.Saved_En := Get_Current_Value (null, C.W_En);
         Lc.Need_Quit := True;
      end if;

      if Get_Exit_Flag (Stmt) then
         --  Exit statement for this loop.
         Lc.W_Exit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt);
         Set_Wire_Gate
           (Lc.W_Exit, Build_Signal (Get_Build (C.Inst),
                                     New_Internal_Name (Build_Context), 1));
         Phi_Assign (Get_Build (C.Inst), Lc.W_Exit, Get_Inst_Bit1 (C.Inst), 0);
      end if;
   end Loop_Control_Init;

   function Loop_Control_And (C : Seq_Context; L, R : Net) return Net
   is
      B1 : constant Net := Get_Inst_Bit1 (C.Inst);
   begin
      --  Optimize common cases.
      if L = B1 then
         return R;
      elsif R = B1 then
         return L;
      else
         return Build_Dyadic (Get_Build (C.Inst), Netlists.Gates.Id_And, L, R);
      end if;
   end Loop_Control_And;

   procedure Loop_Control_Update (C : Seq_Context)
   is
      Lc : constant Loop_Context_Acc := C.Cur_Loop;
      Res : Net;
   begin
      --  Execution continue iff:
      --  1. Loop was enabled (Lc.Saved_En)
      Res := Lc.Saved_En;
      if Res = No_Net then
         --  No loop control.
         return;
      end if;

      --  2. No return (C.W_Ret)
      if C.W_Ret /= No_Wire_Id then
         Res := Loop_Control_And (C, Res, Get_Current_Value (null, C.W_Ret));
      end if;

      --  3. No exit.
      if Lc.W_Exit /= No_Wire_Id then
         Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Exit));
      end if;

      --  4. No quit.
      if Lc.W_Quit /= No_Wire_Id then
         Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Quit));
      end if;

      Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0);
   end Loop_Control_Update;

   procedure Loop_Control_Finish (C : Seq_Context)
   is
      Lc : constant Loop_Context_Acc := C.Cur_Loop;
      Res : Net;
   begin
      --  Execute continue iff:
      --  1. Loop was enabled (Lc.Saved_En)
      Res := Lc.Saved_En;
      if Res = No_Net then
         --  No loop control.
         return;
      end if;

      --  2. No return (C.W_Ret)
      if C.W_Ret /= No_Wire_Id then
         Res := Loop_Control_And (C, Res, Get_Current_Value (null, C.W_Ret));
      end if;

      --  3. No quit (C.W_Quit)
      if Lc.W_Quit /= No_Wire_Id then
         Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Quit));
      end if;

      Phi_Discard_Wires (Lc.W_Quit, Lc.W_Exit);

      if Lc.W_Quit /= No_Wire_Id then
         Free_Wire (Lc.W_Quit);
      end if;

      if Lc.W_Exit /= No_Wire_Id then
         Free_Wire (Lc.W_Exit);
      end if;

      Release (C.Cur_Loop.Wire_Mark);

      Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0);
   end Loop_Control_Finish;

   procedure Synth_Exit_Next_Statement (C : in out Seq_Context; Stmt : Node)
   is
      Cond : constant Node := Get_Condition (Stmt);
      Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement;
      Static_Cond : Boolean;
      Loop_Label : Node;
      Lc : Loop_Context_Acc;
      Cond_Val : Value_Acc;
      Phi_True : Phi_Type;
      Phi_False : Phi_Type;
   begin

      if Cond /= Null_Node then
         Cond_Val := Synth_Expression (C.Inst, Cond);
         Static_Cond := Is_Static_Val (Cond_Val);
         if Static_Cond then
            if Get_Static_Discrete (Cond_Val) = 0 then
               --  Not executed.
               return;
            end if;
         else
            Push_Phi;
         end if;
      end if;

      --  Execution is suspended.
      Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0);

      Lc := C.Cur_Loop;

      Loop_Label := Get_Loop_Label (Stmt);
      if Loop_Label = Null_Node then
         Loop_Label := Lc.Loop_Stmt;
      else
         Loop_Label := Get_Named_Entity (Loop_Label);
      end if;

      loop
         if Lc.Loop_Stmt = Loop_Label then
            if Is_Exit then
               Phi_Assign (Get_Build (C.Inst), Lc.W_Exit,
                           Get_Inst_Bit0 (C.Inst), 0);
            end if;
            exit;
         else
            Phi_Assign (Get_Build (C.Inst), Lc.W_Quit,
                        Get_Inst_Bit0 (C.Inst), 0);
         end if;
         Lc := Lc.Prev_Loop;
      end loop;

      if Cond /= Null_Node and not Static_Cond then
         Pop_Phi (Phi_True);
         Push_Phi;
         Pop_Phi (Phi_False);
         Merge_Phis (Build_Context,
                     Get_Net (Cond_Val), Phi_True, Phi_False, Stmt);
      end if;
   end Synth_Exit_Next_Statement;

   procedure Synth_For_Loop_Statement (C : in out Seq_Context; Stmt : Node)
   is
      Iterator : constant Node := Get_Parameter_Specification (Stmt);
      Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
      It_Type : constant Node := Get_Declaration_Type (Iterator);
      It_Rng : Type_Acc;
      Val : Value_Acc;
      Lc : aliased Loop_Context;
   begin
      Lc := (Prev_Loop => C.Cur_Loop,
             Loop_Stmt => Stmt,
             Need_Quit => False,
             Saved_En => No_Net,
             W_Exit => No_Wire_Id,
             W_Quit => No_Wire_Id,
             Wire_Mark => No_Wire_Id);
      C.Cur_Loop := Lc'Unrestricted_Access;

      Loop_Control_Init (C, Stmt);

      if It_Type /= Null_Node then
         Synth_Subtype_Indication (C.Inst, It_Type);
      end if;

      --  Initial value.
      It_Rng := Get_Value_Type (C.Inst, Get_Type (Iterator));
      Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);
      Create_Object (C.Inst, Iterator, Val);

      while In_Range (It_Rng.Drange, Val.Scal) loop
         Synth_Sequential_Statements (C, Stmts);

         Update_Index (It_Rng.Drange, Val.Scal);
         Loop_Control_Update (C);

         --  Constant exit.
         exit when Get_Current_Value (null, C.W_En) = Get_Inst_Bit0 (C.Inst);
      end loop;
      Loop_Control_Finish (C);

      Destroy_Object (C.Inst, Iterator);
      if It_Type /= Null_Node then
         Destroy_Object (C.Inst, It_Type);
      end if;

      C.Cur_Loop := Lc.Prev_Loop;
   end Synth_For_Loop_Statement;

   procedure Synth_While_Loop_Statement (C : in out Seq_Context; Stmt : Node)
   is
      Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
      Cond : constant Node := Get_Condition (Stmt);
      Val : Value_Acc;
      Lc : aliased Loop_Context;
   begin
      Lc := (Prev_Loop => C.Cur_Loop,
             Loop_Stmt => Stmt,
             Need_Quit => False,
             Saved_En => No_Net,
             W_Exit => No_Wire_Id,
             W_Quit => No_Wire_Id,
             Wire_Mark => No_Wire_Id);
      C.Cur_Loop := Lc'Unrestricted_Access;

      Loop_Control_Init (C, Stmt);

      loop
         if Cond /= Null_Node then
            Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type);
            if not Is_Static (Val) then
               Error_Msg_Synth (+Cond, "loop condition must be static");
               exit;
            end if;
            exit when Val.Scal = 0;
         end if;

         Synth_Sequential_Statements (C, Stmts);

         Loop_Control_Update (C);

         --  Exit from the loop if W_Exit = 0
         if Lc.W_Exit /= No_Wire_Id
           and then
           Get_Current_Value (null, Lc.W_Exit) = Get_Inst_Bit0 (C.Inst)
         then
            exit;
         end if;
         --  FIXME: W_Quit = 0, W_Ret = 0 ??
      end loop;
      Loop_Control_Finish (C);

      C.Cur_Loop := Lc.Prev_Loop;
   end Synth_While_Loop_Statement;

   procedure Synth_Return_Statement (C : in out Seq_Context; Stmt : Node)
   is
      Val : Value_Acc;
      Expr : constant Node := Get_Expression (Stmt);
   begin
      if Expr /= Null_Node then
         --  Return in function.
         Val := Synth_Expression_With_Type (C.Inst, Expr, C.Ret_Typ);
         Val := Synth_Subtype_Conversion (Val, C.Ret_Typ, False, Stmt);

         if C.Nbr_Ret = 0 then
            C.Ret_Value := Val;
            if not Is_Bounded_Type (C.Ret_Typ) then
               --  The function was declared with an unconstrained return type.
               --  Now that a value has been returned, we know the subtype of
               --  the returned values.  So adjust it.
               --  All the returned values must have the same length.
               C.Ret_Typ := Val.Typ;
               Set_Width (Get_Wire_Gate (C.W_Val), C.Ret_Typ.W);
               Set_Width (C.Ret_Init, C.Ret_Typ.W);
            end if;
         end if;
         Phi_Assign (Get_Build (C.Inst), C.W_Val, Get_Net (Val), 0);
      end if;

      --  The subprogram has returned.  Do not execute further statements.
      Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0);

      if C.W_Ret /= No_Wire_Id then
         Phi_Assign (Get_Build (C.Inst), C.W_Ret, Get_Inst_Bit0 (C.Inst), 0);
      end if;

      C.Nbr_Ret := C.Nbr_Ret + 1;
   end Synth_Return_Statement;

   procedure Synth_Sequential_Statements
     (C : in out Seq_Context; Stmts : Node)
   is
      Stmt : Node;
      Phi_T, Phi_F : Phi_Type;
      Has_Phi : Boolean;
      En : Net;
   begin
      Stmt := Stmts;
      while Is_Valid (Stmt) loop
         En := Get_Current_Value (null, C.W_En);
         pragma Assert (En /= Get_Inst_Bit0 (C.Inst));
         Has_Phi := En /= Get_Inst_Bit1 (C.Inst);
         if Has_Phi then
            Push_Phi;
         end if;

         if Flags.Flag_Trace_Statements then
            declare
               Name : Name_Id;
               Line : Natural;
               Col : Natural;
            begin
               Files_Map.Location_To_Position
                 (Get_Location (Stmt), Name, Line, Col);
               Simple_IO.Put_Line ("Execute statement at "
                                     & Name_Table.Image (Name)
                                     & Natural'Image (Line));
            end;
         end if;

         case Get_Kind (Stmt) is
            when Iir_Kind_If_Statement =>
               Synth_If_Statement (C, Stmt);
            when Iir_Kind_Simple_Signal_Assignment_Statement =>
               Synth_Simple_Signal_Assignment (C.Inst, Stmt);
            when Iir_Kind_Conditional_Signal_Assignment_Statement =>
               Synth_Conditional_Signal_Assignment (C.Inst, Stmt);
            when Iir_Kind_Variable_Assignment_Statement =>
               Synth_Variable_Assignment (C.Inst, Stmt);
            when Iir_Kind_Conditional_Variable_Assignment_Statement =>
               Synth_Conditional_Variable_Assignment (C.Inst, Stmt);
            when Iir_Kind_Case_Statement =>
               Synth_Case_Statement (C, Stmt);
            when Iir_Kind_For_Loop_Statement =>
               Synth_For_Loop_Statement (C, Stmt);
            when Iir_Kind_While_Loop_Statement =>
               Synth_While_Loop_Statement (C, Stmt);
            when Iir_Kind_Null_Statement =>
               --  Easy
               null;
            when Iir_Kind_Return_Statement =>
               Synth_Return_Statement (C, Stmt);
            when Iir_Kind_Procedure_Call_Statement =>
               Synth_Procedure_Call (C.Inst, Stmt);
            when Iir_Kind_Report_Statement
              | Iir_Kind_Assertion_Statement =>
               --  TODO ?
               null;
            when Iir_Kind_Exit_Statement
              | Iir_Kind_Next_Statement =>
               Synth_Exit_Next_Statement (C, Stmt);
            when others =>
               Error_Kind ("synth_sequential_statements", Stmt);
         end case;
         if Has_Phi then
            Pop_Phi (Phi_T);
            Push_Phi;
            Pop_Phi (Phi_F);
            Merge_Phis (Build_Context,
                        Get_Current_Value (Build_Context, C.W_En),
                        Phi_T, Phi_F, Stmt);
         end if;
         if Get_Current_Value (null, C.W_En) = Get_Inst_Bit0 (C.Inst) then
            return;
         end if;
         Stmt := Get_Chain (Stmt);
      end loop;
   end Synth_Sequential_Statements;

   Proc_Pool : aliased Areapools.Areapool;

   --  Synthesis of statements of a non-sensitized process.
   procedure Synth_Process_Sequential_Statements
     (C : in out Seq_Context; Proc : Node)
   is
      Stmt : Node;
      Cond : Node;
      Cond_Val : Value_Acc;
      Phi_True : Phi_Type;
      Phi_False : Phi_Type;
   begin
      Stmt := Get_Sequential_Statement_Chain (Proc);

      --  The first statement must be a wait statement.
      if Get_Kind (Stmt) /= Iir_Kind_Wait_Statement then
         Error_Msg_Synth (+Stmt, "expect wait as the first statement");
         return;
      end if;

      --  Handle the condition as an if.
      Cond := Get_Condition_Clause (Stmt);
      if Cond = Null_Node then
         Error_Msg_Synth (+Stmt, "expect wait condition");
         return;
      end if;
      Cond_Val := Synth_Expression (C.Inst, Cond);

      Push_Phi;
      Synth_Sequential_Statements (C, Get_Chain (Stmt));
      Pop_Phi (Phi_True);
      Push_Phi;
      Pop_Phi (Phi_False);

      Merge_Phis (Build_Context, Get_Net (Cond_Val),
                  Phi_True, Phi_False, Stmt);
   end Synth_Process_Sequential_Statements;

   procedure Synth_Process_Statement
     (Syn_Inst : Synth_Instance_Acc; Proc : Node)
   is
      use Areapools;
      Label : constant Name_Id := Get_Identifier (Proc);
      Decls_Chain : constant Node := Get_Declaration_Chain (Proc);
      Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
      M : Areapools.Mark_Type;
      C_Sname : Sname;
      C : Seq_Context;
   begin
      if Label = Null_Identifier then
         C_Sname := New_Internal_Name (Build_Context, Get_Sname (Syn_Inst));
      else
         C_Sname := New_Sname (Get_Sname (Syn_Inst), Label);
      end if;
      C := (Inst => Make_Instance (Syn_Inst, Proc, C_Sname),
            Cur_Loop => null,
            W_En => Alloc_Wire (Wire_Variable, Proc),
            W_Ret => No_Wire_Id,
            W_Val => No_Wire_Id,
            Ret_Init => No_Net,
            Ret_Value => null,
            Ret_Typ => null,
            Nbr_Ret => 0);


      Mark (M, Proc_Pool);
      Instance_Pool := Proc_Pool'Access;

      if Is_Valid (Decls_Chain) then
         Synth_Declarations (C.Inst, Decls_Chain);
      end if;

      Set_Wire_Gate (C.W_En, Build_Signal (Build_Context,
                                           New_Internal_Name (Build_Context),
                                           1));
      Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);

      case Iir_Kinds_Process_Statement (Get_Kind (Proc)) is
         when Iir_Kind_Sensitized_Process_Statement =>
            Synth_Sequential_Statements
              (C, Get_Sequential_Statement_Chain (Proc));
            --  FIXME: check sensitivity list.
         when Iir_Kind_Process_Statement =>
            Synth_Process_Sequential_Statements (C, Proc);
      end case;

      --  FIXME: free W_En ?

      Free_Instance (C.Inst);
      Release (M, Proc_Pool);
      Instance_Pool := Prev_Instance_Pool;
   end Synth_Process_Statement;

   function Synth_User_Function_Call
     (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc is
   begin
      --  Is it a call to an ieee function ?
      declare
         Imp  : constant Node := Get_Implementation (Expr);
         Pkg : constant Node := Get_Parent (Imp);
         Unit : Node;
         Lib : Node;
      begin
         if Get_Kind (Pkg) = Iir_Kind_Package_Declaration then
            Unit := Get_Parent (Pkg);
            if Get_Kind (Unit) = Iir_Kind_Design_Unit then
               Lib := Get_Library (Get_Design_File (Unit));
               if Get_Identifier (Lib) = Std_Names.Name_Ieee then
                  Error_Msg_Synth
                    (+Expr, "unhandled call to an ieee function");
                  raise Internal_Error;
               end if;
            end if;
         end if;
      end;

      return Synth_Subprogram_Call (Syn_Inst, Expr);
   end Synth_User_Function_Call;

   procedure Synth_Concurrent_Assertion_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Cond : constant Node := Get_Assertion_Condition (Stmt);
      Val : Value_Acc;
      Inst : Instance;
   begin
      Val := Synth_Expression (Syn_Inst, Cond);
      if Is_Static (Val) then
         if Val.Scal /= 1 then
            raise Internal_Error;
         end if;
         return;
      end if;
      Inst := Build_Assert (Build_Context, Synth_Label (Stmt), Get_Net (Val));
      Set_Location (Inst, Get_Location (Stmt));
   end Synth_Concurrent_Assertion_Statement;

   procedure Synth_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node)
   is
      use Areapools;
      Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
      Blk_Inst : Synth_Instance_Acc;
      Blk_Sname : Sname;
      M : Areapools.Mark_Type;
   begin
      --  No support for guard or header.
      if Get_Block_Header (Blk) /= Null_Node
        or else Get_Guard_Decl (Blk) /= Null_Node
      then
         raise Internal_Error;
      end if;

      Blk_Sname := New_Sname (Get_Sname (Syn_Inst), Get_Identifier (Blk));
      Blk_Inst := Make_Instance (Syn_Inst, Blk, Blk_Sname);
      Mark (M, Proc_Pool);
      Instance_Pool := Proc_Pool'Access;

      Synth_Declarations (Blk_Inst, Get_Declaration_Chain (Blk));
      Synth_Concurrent_Statements
        (Blk_Inst, Get_Concurrent_Statement_Chain (Blk));

      Free_Instance (Blk_Inst);
      Release (M, Proc_Pool);
      Instance_Pool := Prev_Instance_Pool;
   end Synth_Block_Statement;

   function Synth_PSL_Expression
     (Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net
   is
      use PSL.Types;
      use PSL.Nodes;
   begin
      case Get_Kind (Expr) is
         when N_HDL_Expr =>
            declare
               E : constant Vhdl.Types.Vhdl_Node := Get_HDL_Node (Expr);
            begin
               return Get_Net (Synth_Expression (Syn_Inst, E));
            end;
         when N_Not_Bool =>
            return Build_Monadic
              (Build_Context, Netlists.Gates.Id_Not,
               Synth_PSL_Expression (Syn_Inst, Get_Boolean (Expr)));
         when N_And_Bool =>
            declare
               L : constant PSL_Node := Get_Left (Expr);
               R : constant PSL_Node := Get_Right (Expr);
               Edge : Net;
            begin
               --  Handle edge (as it can be in default clock).
               if Get_Kind (L) = N_HDL_Expr and then Get_Kind (R) = N_HDL_Expr
               then
                  Edge := Synth_Clock_Edge
                    (Syn_Inst, Get_HDL_Node (L), Get_HDL_Node (R));
                  if Edge /= No_Net then
                     return Edge;
                  end if;
               end if;
               if Get_Kind (R) = N_EOS then
                  --  It is never EOS!
                  return Build_Const_UB32 (Build_Context, 0, 1);
               end if;
               return Build_Dyadic
                 (Build_Context, Netlists.Gates.Id_And,
                  Synth_PSL_Expression (Syn_Inst, L),
                  Synth_PSL_Expression (Syn_Inst, R));
            end;
         when N_Or_Bool =>
            return Build_Dyadic
              (Build_Context, Netlists.Gates.Id_Or,
               Synth_PSL_Expression (Syn_Inst, Get_Left (Expr)),
               Synth_PSL_Expression (Syn_Inst, Get_Right (Expr)));
         when N_True =>
            return Build_Const_UB32 (Build_Context, 1, 1);
         when N_False
           | N_EOS =>
            return Build_Const_UB32 (Build_Context, 0, 1);
         when others =>
            PSL.Errors.Error_Kind ("translate_psl_expr", Expr);
      end case;
   end Synth_PSL_Expression;

   function Synth_Psl_NFA (Syn_Inst : Synth_Instance_Acc;
                           NFA : PSL.Types.PSL_NFA;
                           Nbr_States : Int32;
                           States : Net) return Net
   is
      use PSL.NFAs;
      S : NFA_State;
      S_Num : Int32;
      D_Num : Int32;
      I : Net;
      Cond : Net;
      E : NFA_Edge;
      D_Arr : Net_Array_Acc;
      Res : Net;
   begin
      D_Arr := new Net_Array'(0 .. Nbr_States - 1 => No_Net);

      --  For each state:
      S := Get_First_State (NFA);
      while S /= No_State loop
         S_Num := Get_State_Label (S);
         I := Build_Extract_Bit (Build_Context, States, Uns32 (S_Num));

         --  For each edge:
         E := Get_First_Src_Edge (S);
         while E /= No_Edge loop
            --  Edge condition.
            Cond := Build_Dyadic
              (Build_Context, Netlists.Gates.Id_And,
               I, Synth_PSL_Expression (Syn_Inst, Get_Edge_Expr (E)));

            --  TODO: if EOS is present, then this is a live state.

            --  Reverse order for final concatenation.
            D_Num := Nbr_States - 1 - Get_State_Label (Get_Edge_Dest (E));
            if D_Arr (D_Num) = No_Net then
               D_Arr (D_Num) := Cond;
            else
               D_Arr (D_Num) := Build_Dyadic
                 (Build_Context, Netlists.Gates.Id_Or, D_Arr (D_Num), Cond);
            end if;

            E := Get_Next_Src_Edge (E);
         end loop;

         S := Get_Next_State (S);
      end loop;

      if D_Arr (Nbr_States - 1) = No_Net then
         D_Arr (Nbr_States - 1) := Build_Const_UB32 (Build_Context, 0, 1);
      end if;

      Res := Concat_Array (D_Arr);
      Free_Net_Array (D_Arr);

      return Res;
   end Synth_Psl_NFA;

   procedure Synth_Psl_Dff (Syn_Inst : Synth_Instance_Acc;
                            Stmt : Node;
                            Next_States : out Net)
   is
      use Netlists.Gates;
      Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt);
      States : Net;
      Init : Net;
      Clk : Net;
      Clk_Inst : Instance;
   begin
      --  create init net, clock net
      pragma Assert (Nbr_States <= 32);
      Init := Build_Const_UB32 (Build_Context, 1, Uns32 (Nbr_States));
      Clk := Synth_PSL_Expression (Syn_Inst, Get_PSL_Clock (Stmt));

      --  Check the clock is an edge and extract it.
      Clk_Inst := Get_Net_Parent (Clk);
      if Get_Id (Clk_Inst) /= Id_Edge then
         Error_Msg_Synth (+Stmt, "clock is not an edge");
         Next_States := No_Net;
         return;
      end if;

      Clk := Get_Input_Net (Clk_Inst, 0);

      --  build idff
      States := Build_Idff (Build_Context, Clk, No_Net, Init);

      --  create update nets
      --  For each state: if set, evaluate all outgoing edges.
      Next_States :=
        Synth_Psl_NFA (Syn_Inst, Get_PSL_NFA (Stmt), Nbr_States, States);
      Connect (Get_Input (Get_Net_Parent (States), 1), Next_States);
   end Synth_Psl_Dff;

   function Synth_Psl_Final
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node; Next_States : Net) return Net
   is
      use PSL.Types;
      use PSL.NFAs;
      NFA : constant PSL_NFA := Get_PSL_NFA (Stmt);
   begin
      return Build_Extract_Bit
        (Get_Build (Syn_Inst), Next_States,
         Uns32 (Get_State_Label (Get_Final_State (NFA))));
   end Synth_Psl_Final;

   function Synth_Psl_Not_Final
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node; Next_States : Net)
     return Net is
   begin
      return Build_Monadic
        (Get_Build (Syn_Inst), Netlists.Gates.Id_Not,
         Synth_Psl_Final (Syn_Inst, Stmt, Next_States));
   end Synth_Psl_Not_Final;

   procedure Synth_Psl_Restrict_Directive
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Next_States : Net;
      Res : Net;
      Inst : Instance;
   begin
      --  Build assume gate.
      --  Note: for synthesis, we assume the next state will be correct.
      --  (If we assume on States, then the first cycle is ignored).
      Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
      if Next_States /= No_Net then
         --  The restriction holds as long as there is a 1 in the NFA state.
         Res := Build_Reduce (Build_Context,
                              Netlists.Gates.Id_Red_Or, Next_States);
         Inst := Build_Assume (Build_Context, Synth_Label (Stmt), Res);
         Set_Location (Inst, Get_Location (Stmt));
      end if;
   end Synth_Psl_Restrict_Directive;

   procedure Synth_Psl_Cover_Directive
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Next_States : Net;
      Res : Net;
      Inst : Instance;
   begin
      --  Build cover gate.
      --  Note: for synthesis, we assume the next state will be correct.
      --  (If we assume on States, then the first cycle is ignored).
      Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
      if Next_States /= No_Net then
         --  The sequence is covered as soon as the final state is reached.
         Res := Synth_Psl_Final (Syn_Inst, Stmt, Next_States);
         Inst := Build_Cover (Build_Context, Synth_Label (Stmt), Res);
         Set_Location (Inst, Get_Location (Stmt));
      end if;
   end Synth_Psl_Cover_Directive;

   procedure Synth_Psl_Assume_Directive
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Next_States : Net;
      Inst : Instance;
   begin
      --  Build assume gate.
      --  Note: for synthesis, we assume the next state will be correct.
      --  (If we assume on States, then the first cycle is ignored).
      Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
      if Next_States /= No_Net then
         Inst := Build_Assume
           (Build_Context, Synth_Label (Stmt),
            Synth_Psl_Not_Final (Syn_Inst, Stmt, Next_States));
         Set_Location (Inst, Get_Location (Stmt));
      end if;
   end Synth_Psl_Assume_Directive;

   procedure Synth_Psl_Assert_Directive
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      use PSL.Types;
      use PSL.NFAs;
      NFA : constant PSL_NFA := Get_PSL_NFA (Stmt);
      Active : NFA_State;
      Next_States : Net;
      Inst : Instance;
      Lab : Sname;
   begin
      --  Build assert gate.
      --  Note: for synthesis, we assume the next state will be correct.
      --  (If we assert on States, then the first cycle is ignored).
      Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
      if Next_States /= No_Net then
         Lab := Synth_Label (Stmt);

         Inst := Build_Assert
           (Build_Context, Lab,
            Synth_Psl_Not_Final (Syn_Inst, Stmt, Next_States));
         Set_Location (Inst, Get_Location (Stmt));

         Active := Get_Active_State (NFA);
         if Active /= No_State then
            if Lab /= No_Sname then
               Lab := New_Sname (Lab, Std_Names.Name_Cover);
            end if;
            Inst := Build_Assert_Cover
              (Get_Build (Syn_Inst), Lab,
               Build_Extract_Bit (Get_Build (Syn_Inst), Next_States,
                                  Uns32 (Get_State_Label (Active))));
            Set_Location (Inst, Get_Location (Stmt));
         end if;
      end if;
   end Synth_Psl_Assert_Directive;

   procedure Synth_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc;
                                            Bod : Node;
                                            Name : Sname;
                                            Iterator : Node := Null_Node;
                                            Iterator_Val : Value_Acc := null)
   is
      use Areapools;
      Decls_Chain : constant Node := Get_Declaration_Chain (Bod);
      Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
      Bod_Inst : Synth_Instance_Acc;
      M : Areapools.Mark_Type;
   begin
      Bod_Inst := Make_Instance (Syn_Inst, Bod, Name);
      Mark (M, Proc_Pool);
      Instance_Pool := Proc_Pool'Access;

      if Iterator /= Null_Node then
         --  Add the iterator (for for-generate).
         Create_Object (Bod_Inst, Iterator, Iterator_Val);
      end if;

      Synth_Declarations (Bod_Inst, Decls_Chain);

      Synth_Concurrent_Statements
        (Bod_Inst, Get_Concurrent_Statement_Chain (Bod));

      Free_Instance (Bod_Inst);
      Release (M, Proc_Pool);
      Instance_Pool := Prev_Instance_Pool;
   end Synth_Generate_Statement_Body;

   procedure Synth_If_Generate_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Gen : Node;
      Bod : Node;
      Cond : Value_Acc;
      Name : Sname;
   begin
      Gen := Stmt;
      Name := New_Sname (Get_Sname (Syn_Inst),
                         Get_Identifier (Stmt));
      loop
         Cond := Synth_Expression (Syn_Inst, Get_Condition (Gen));
         pragma Assert (Cond.Kind = Value_Discrete);
         if Cond.Scal = 1 then
            Bod := Get_Generate_Statement_Body (Gen);
            Apply_Block_Configuration
              (Get_Generate_Block_Configuration (Bod), Bod);
            Synth_Generate_Statement_Body (Syn_Inst, Bod, Name);
            exit;
         end if;
         Gen := Get_Generate_Else_Clause (Gen);
         exit when Gen = Null_Node;
      end loop;
   end Synth_If_Generate_Statement;

   procedure Synth_For_Generate_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Iterator : constant Node := Get_Parameter_Specification (Stmt);
      Bod : constant Node := Get_Generate_Statement_Body (Stmt);
      Configs : constant Node := Get_Generate_Block_Configuration (Bod);
      It_Type : constant Node := Get_Declaration_Type (Iterator);
      Config : Node;
      It_Rng : Type_Acc;
      Val : Value_Acc;
      Name : Sname;
      Lname : Sname;
   begin
      if It_Type /= Null_Node then
         Synth_Subtype_Indication (Syn_Inst, It_Type);
      end if;

      --  Initial value.
      It_Rng := Get_Value_Type (Syn_Inst, Get_Type (Iterator));
      Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);

      Name := New_Sname (Get_Sname (Syn_Inst), Get_Identifier (Stmt));

      while In_Range (It_Rng.Drange, Val.Scal) loop
         --  Find and apply the config block.
         declare
            Spec : Node;
         begin
            Config := Configs;
            while Config /= Null_Node loop
               Spec := Get_Block_Specification (Config);
               case Get_Kind (Spec) is
                  when Iir_Kind_Simple_Name =>
                     exit;
                  when others =>
                     Error_Kind ("synth_for_generate_statement", Spec);
               end case;
               Config := Get_Prev_Block_Configuration (Config);
            end loop;
            if Config = Null_Node then
               raise Internal_Error;
            end if;
            Apply_Block_Configuration (Config, Bod);
         end;

         --  FIXME: get position ?
         Lname := New_Sname_Version (Name, Uns32 (Val.Scal));

         Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val);
         Update_Index (It_Rng.Drange, Val.Scal);
      end loop;
   end Synth_For_Generate_Statement;

   procedure Synth_Concurrent_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is
   begin
      case Get_Kind (Stmt) is
         when Iir_Kind_Concurrent_Simple_Signal_Assignment =>
            Push_Phi;
            Synth_Simple_Signal_Assignment (Syn_Inst, Stmt);
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
            Push_Phi;
            Synth_Conditional_Signal_Assignment (Syn_Inst, Stmt);
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
            Push_Phi;
            Synth_Selected_Signal_Assignment (Syn_Inst, Stmt);
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
            Push_Phi;
            Synth_Procedure_Call (Syn_Inst, Stmt);
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kinds_Process_Statement =>
            Push_Phi;
            Synth_Process_Statement (Syn_Inst, Stmt);
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kind_If_Generate_Statement =>
            Synth_If_Generate_Statement (Syn_Inst, Stmt);
         when Iir_Kind_For_Generate_Statement =>
            Synth_For_Generate_Statement (Syn_Inst, Stmt);
         when Iir_Kind_Component_Instantiation_Statement =>
            Push_Phi;
            if Is_Component_Instantiation (Stmt) then
               declare
                  Comp_Config : constant Node :=
                    Get_Component_Configuration (Stmt);
               begin
                  if Get_Binding_Indication (Comp_Config) = Null_Node then
                     --  Not bound.
                     Synth_Blackbox_Instantiation_Statement (Syn_Inst, Stmt);
                  else
                     Synth_Component_Instantiation_Statement (Syn_Inst, Stmt);
                  end if;
               end;
            else
               Synth_Design_Instantiation_Statement (Syn_Inst, Stmt);
            end if;
            Pop_And_Merge_Phi (Build_Context, Stmt);
         when Iir_Kind_Block_Statement =>
            Synth_Block_Statement (Syn_Inst, Stmt);
         when Iir_Kind_Psl_Default_Clock =>
            null;
         when Iir_Kind_Psl_Restrict_Directive =>
            Synth_Psl_Restrict_Directive (Syn_Inst, Stmt);
         when Iir_Kind_Psl_Assume_Directive =>
            Synth_Psl_Assume_Directive (Syn_Inst, Stmt);
         when Iir_Kind_Psl_Cover_Directive =>
            Synth_Psl_Cover_Directive (Syn_Inst, Stmt);
         when Iir_Kind_Psl_Assert_Directive =>
            Synth_Psl_Assert_Directive (Syn_Inst, Stmt);
         when Iir_Kind_Concurrent_Assertion_Statement =>
            --  Passive statement.
            Synth_Concurrent_Assertion_Statement (Syn_Inst, Stmt);
         when others =>
            Error_Kind ("synth_concurrent_statement", Stmt);
      end case;
   end Synth_Concurrent_Statement;

   procedure Synth_Concurrent_Statements
     (Syn_Inst : Synth_Instance_Acc; Stmts : Node)
   is
      Stmt : Node;
   begin
      Stmt := Stmts;
      while Is_Valid (Stmt) loop
         Synth_Concurrent_Statement (Syn_Inst, Stmt);
         Stmt := Get_Chain (Stmt);
      end loop;
   end Synth_Concurrent_Statements;

   procedure Synth_Attribute_Formal (Syn_Inst : Synth_Instance_Acc;
                                     Val : Node;
                                     Id : Netlists.Gates.Formal_Module_Id)
   is
      Spec : constant Node := Get_Attribute_Specification (Val);
      Sig : constant Node := Get_Designated_Entity (Val);
      V : Value_Acc;
      Targ : Value_Acc;
   begin
      --  The type must be boolean
      if (Get_Base_Type (Get_Type (Val)) /=
            Vhdl.Std_Package.Boolean_Type_Definition)
      then
         Error_Msg_Synth (+Val, "type of attribute %i must be boolean",
                          (1 => +Get_Attribute_Designator (Spec)));
         return;
      end if;

      --  The designated entity must be a signal.
      if Get_Kind (Sig) /= Iir_Kind_Signal_Declaration then
         Error_Msg_Synth (+Val, "attribute %i only applies to signals",
                          (1 => +Get_Attribute_Designator (Spec)));
         return;
      end if;

      --  The value must be true
      V := Synth_Expression_With_Type
        (Syn_Inst, Get_Expression (Spec), Boolean_Type);
      if V.Scal /= 1 then
         return;
      end if;

      declare
         Off : Uns32;
         Voff : Net;
         Wd : Width;
         Typ : Type_Acc;
         N : Net;
      begin
         Synth_Assignment_Prefix (Syn_Inst, Sig, Targ, Off, Voff, Wd, Typ);
         pragma Assert (Off = 0);
         pragma Assert (Voff = No_Net);
         pragma Assert (Targ.Kind = Value_Wire);

         N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W);
         Add_Conc_Assign (Targ.W, N, 0, Val);
      end;

   end Synth_Attribute_Formal;

   procedure Synth_Attribute_Values
     (Syn_Inst : Synth_Instance_Acc; Unit : Node)
   is
      use Std_Names;
      use Netlists.Gates;

      Val : Node;
      Spec : Node;
      Id : Name_Id;
   begin
      Val := Get_Attribute_Value_Chain (Unit);
      while Val /= Null_Node loop
         Spec := Get_Attribute_Specification (Val);
         Id := Get_Identifier (Get_Attribute_Designator (Spec));
         case Id is
            when Name_Allconst =>
               Synth_Attribute_Formal (Syn_Inst, Val, Id_Allconst);
            when Name_Allseq =>
               Synth_Attribute_Formal (Syn_Inst, Val, Id_Allseq);
            when Name_Anyconst =>
               Synth_Attribute_Formal (Syn_Inst, Val, Id_Anyconst);
            when Name_Anyseq =>
               Synth_Attribute_Formal (Syn_Inst, Val, Id_Anyseq);
            when others =>
               Warning_Msg_Synth (+Spec, "unhandled attribute %i", (1 => +Id));
         end case;
         Val := Get_Value_Chain (Val);
      end loop;
   end Synth_Attribute_Values;

   procedure Synth_Verification_Unit
     (Syn_Inst : Synth_Instance_Acc; Unit : Node)
   is
      use Areapools;
      Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
      Unit_Inst : Synth_Instance_Acc;
      Unit_Sname : Sname;
      M : Areapools.Mark_Type;
      Item : Node;
   begin
      Unit_Sname := New_Sname (Get_Sname (Syn_Inst), Get_Identifier (Unit));
      Unit_Inst := Make_Instance (Syn_Inst, Unit, Unit_Sname);
      Mark (M, Proc_Pool);
      Instance_Pool := Proc_Pool'Access;

      Item := Get_Vunit_Item_Chain (Unit);
      while Item /= Null_Node loop
         case Get_Kind (Item) is
            when Iir_Kind_Psl_Default_Clock =>
               null;
            when Iir_Kind_Psl_Assert_Directive =>
               Synth_Psl_Assert_Directive (Unit_Inst, Item);
            when Iir_Kind_Psl_Assume_Directive =>
               Synth_Psl_Assume_Directive (Unit_Inst, Item);
            when Iir_Kind_Psl_Restrict_Directive =>
               Synth_Psl_Restrict_Directive (Unit_Inst, Item);
            when Iir_Kind_Psl_Cover_Directive =>
               Synth_Psl_Cover_Directive (Unit_Inst, Item);
            when Iir_Kind_Signal_Declaration
              | Iir_Kind_Function_Declaration
              | Iir_Kind_Procedure_Declaration
              | Iir_Kind_Function_Body
              | Iir_Kind_Procedure_Body
              | Iir_Kind_Attribute_Declaration
              | Iir_Kind_Attribute_Specification =>
               Synth_Declaration (Unit_Inst, Item, False);
            when Iir_Kind_Concurrent_Simple_Signal_Assignment =>
               Synth_Concurrent_Statement (Unit_Inst, Item);
            when others =>
               Error_Kind ("synth_verification_unit", Item);
         end case;
         Item := Get_Chain (Item);
      end loop;

      Synth_Attribute_Values (Unit_Inst, Unit);

      Free_Instance (Unit_Inst);
      Release (M, Proc_Pool);
      Instance_Pool := Prev_Instance_Pool;
   end Synth_Verification_Unit;
end Synth.Stmts;