path: root/src/vhdl/simulate/simulation.adb

--  Interpreted simulation
--  Copyright (C) 2014 Tristan Gingold
--
--  GHDL 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, or (at your option) any later
--  version.
--
--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.

with Ada.Unchecked_Conversion;
with Ada.Text_IO; use Ada.Text_IO;
with Errorout; use Errorout;
with Iirs_Utils; use Iirs_Utils;
with Trans_Analyzes;
with Types; use Types;
with Debugger; use Debugger;
with Simulation.AMS.Debugger;
with Areapools; use Areapools;
with Grt.Signals;
with Grt.Processes;
with Grt.Main;
with Grt.Errors;
with Grt.Rtis;

package body Simulation is

   function Value_To_Iir_Value (Mode : Mode_Type; Val : Value_Union)
                               return Iir_Value_Literal_Acc is
   begin
      case Mode is
         when Mode_B1 =>
            return Create_B1_Value (Val.B1);
         when Mode_E32 =>
            return Create_E32_Value (Val.E32);
         when Mode_I64 =>
            return Create_I64_Value (Val.I64);
         when Mode_F64 =>
            return Create_F64_Value (Val.F64);
         when others =>
            raise Internal_Error;  -- FIXME
      end case;
   end Value_To_Iir_Value;

   procedure Iir_Value_To_Value (Src : Iir_Value_Literal_Acc;
                                 Dst : out Value_Union) is
   begin
      case Src.Kind is
         when Iir_Value_B1 =>
            Dst.B1 := Src.B1;
         when Iir_Value_E32 =>
            Dst.E32 := Src.E32;
         when Iir_Value_I64 =>
            Dst.I64 := Src.I64;
         when Iir_Value_F64 =>
            Dst.F64 := Src.F64;
         when others =>
            raise Internal_Error;  -- FIXME
      end case;
   end Iir_Value_To_Value;

   type Read_Signal_Flag_Enum is
     (Read_Signal_Event,
      Read_Signal_Active,
      --  In order to reuse the same code (that returns immediately if the
      --  attribute is true), we use not driving.
      Read_Signal_Not_Driving);

   function Read_Signal_Flag (Lit: Iir_Value_Literal_Acc;
                              Kind : Read_Signal_Flag_Enum)
                             return Boolean
   is
   begin
      case Lit.Kind is
         when Iir_Value_Array =>
            for I in Lit.Val_Array.V'Range loop
               if Read_Signal_Flag (Lit.Val_Array.V (I), Kind) then
                  return True;
               end if;
            end loop;
            return False;
         when Iir_Value_Record =>
            for I in Lit.Val_Record.V'Range loop
               if Read_Signal_Flag (Lit.Val_Record.V (I), Kind) then
                  return True;
               end if;
            end loop;
            return False;
         when Iir_Value_Signal =>
            case Kind is
               when Read_Signal_Event =>
                  return Lit.Sig.Event;
               when Read_Signal_Active =>
                  return Lit.Sig.Active;
               when Read_Signal_Not_Driving =>
                  if Grt.Signals.Ghdl_Signal_Driving (Lit.Sig) = True then
                     return False;
                  else
                     return True;
                  end if;
            end case;
         when others =>
            raise Internal_Error;
      end case;
   end Read_Signal_Flag;

   function Execute_Event_Attribute (Lit: Iir_Value_Literal_Acc)
                                    return Boolean is
   begin
      return Read_Signal_Flag (Lit, Read_Signal_Event);
   end Execute_Event_Attribute;

   function Execute_Active_Attribute (Lit: Iir_Value_Literal_Acc)
                                     return Boolean is
   begin
      return Read_Signal_Flag (Lit, Read_Signal_Active);
   end Execute_Active_Attribute;

   function Execute_Driving_Attribute (Lit: Iir_Value_Literal_Acc)
                                      return Boolean is
   begin
      return not Read_Signal_Flag (Lit, Read_Signal_Not_Driving);
   end Execute_Driving_Attribute;

   type Read_Signal_Value_Enum is
     (Read_Signal_Last_Value,

      --  For conversion functions.
      Read_Signal_Driving_Value,
      Read_Signal_Effective_Value,

      --  'Driving_Value
      Read_Signal_Driver_Value);

   function Execute_Read_Signal_Value (Sig: Iir_Value_Literal_Acc;
                                       Attr : Read_Signal_Value_Enum)
     return Iir_Value_Literal_Acc
   is
      Res: Iir_Value_Literal_Acc;
   begin
      case Sig.Kind is
         when Iir_Value_Array =>
            Res := Copy_Array_Bound (Sig);
            for I in Sig.Val_Array.V'Range loop
               Res.Val_Array.V (I) :=
                 Execute_Read_Signal_Value (Sig.Val_Array.V (I), Attr);
            end loop;
            return Res;
         when Iir_Value_Record =>
            Res := Create_Record_Value (Sig.Val_Record.Len);
            for I in Sig.Val_Record.V'Range loop
               Res.Val_Record.V (I) :=
                 Execute_Read_Signal_Value (Sig.Val_Record.V (I), Attr);
            end loop;
            return Res;
         when Iir_Value_Signal =>
            case Attr is
               when Read_Signal_Last_Value =>
                  return Value_To_Iir_Value
                    (Sig.Sig.Mode, Sig.Sig.Last_Value);
               when Read_Signal_Driver_Value =>
                  case Sig.Sig.Mode is
                     when Mode_F64 =>
                        return Create_F64_Value
                          (Grt.Signals.Ghdl_Signal_Driving_Value_F64
                             (Sig.Sig));
                     when Mode_I64 =>
                        return Create_I64_Value
                          (Grt.Signals.Ghdl_Signal_Driving_Value_I64
                             (Sig.Sig));
                     when Mode_E32 =>
                        return Create_E32_Value
                          (Grt.Signals.Ghdl_Signal_Driving_Value_E32
                             (Sig.Sig));
                     when Mode_B1 =>
                        return Create_B1_Value
                          (Grt.Signals.Ghdl_Signal_Driving_Value_B1
                             (Sig.Sig));
                     when others =>
                        raise Internal_Error;
                  end case;
               when Read_Signal_Effective_Value =>
                  return Value_To_Iir_Value
                    (Sig.Sig.Mode, Sig.Sig.Value_Ptr.all);
               when Read_Signal_Driving_Value =>
                  return Value_To_Iir_Value
                    (Sig.Sig.Mode, Sig.Sig.Driving_Value);
            end case;
         when others =>
            raise Internal_Error;
      end case;
   end Execute_Read_Signal_Value;

   type Write_Signal_Enum is
     (Write_Signal_Driving_Value,
      Write_Signal_Effective_Value);

   procedure Execute_Write_Signal (Sig: Iir_Value_Literal_Acc;
                                   Val : Iir_Value_Literal_Acc;
                                   Attr : Write_Signal_Enum) is
   begin
      case Sig.Kind is
         when Iir_Value_Array =>
            pragma Assert (Val.Kind = Iir_Value_Array);
            pragma Assert (Sig.Val_Array.Len = Val.Val_Array.Len);
            for I in Sig.Val_Array.V'Range loop
               Execute_Write_Signal
                 (Sig.Val_Array.V (I), Val.Val_Array.V (I), Attr);
            end loop;
         when Iir_Value_Record =>
            pragma Assert (Val.Kind = Iir_Value_Record);
            pragma Assert (Sig.Val_Record.Len = Val.Val_Record.Len);
            for I in Sig.Val_Record.V'Range loop
               Execute_Write_Signal
                 (Sig.Val_Record.V (I), Val.Val_Record.V (I), Attr);
            end loop;
         when Iir_Value_Signal =>
            pragma Assert (Val.Kind in Iir_Value_Scalars);
            case Attr is
               when Write_Signal_Driving_Value =>
                  Iir_Value_To_Value (Val, Sig.Sig.Driving_Value);
               when Write_Signal_Effective_Value =>
                  Iir_Value_To_Value (Val, Sig.Sig.Value_Ptr.all);
            end case;
         when others =>
            raise Internal_Error;
      end case;
   end Execute_Write_Signal;

   function Execute_Last_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
     return Iir_Value_Literal_Acc is
   begin
      return Execute_Read_Signal_Value (Indirect, Read_Signal_Last_Value);
   end Execute_Last_Value_Attribute;

   function Execute_Driving_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
                                            return Iir_Value_Literal_Acc is
   begin
      return Execute_Read_Signal_Value (Indirect, Read_Signal_Driver_Value);
   end Execute_Driving_Value_Attribute;

   type Signal_Read_Last_Type is
     (Read_Last_Event,
      Read_Last_Active);

   --  Return the Last_Event absolute time.
   function Execute_Read_Signal_Last (Indirect: Iir_Value_Literal_Acc;
                                      Kind : Signal_Read_Last_Type)
                                     return Ghdl_I64
   is
      Res: Ghdl_I64;
   begin
      case Indirect.Kind is
         when Iir_Value_Array =>
            Res := Ghdl_I64'First;
            for I in Indirect.Val_Array.V'Range loop
               Res := Ghdl_I64'Max
                 (Res, Execute_Read_Signal_Last (Indirect.Val_Array.V (I),
                                                 Kind));
            end loop;
            return Res;
         when Iir_Value_Record =>
            Res := Ghdl_I64'First;
            for I in Indirect.Val_Record.V'Range loop
               Res := Ghdl_I64'Max
                 (Res, Execute_Read_Signal_Last (Indirect.Val_Record.V (I),
                                                 Kind));
            end loop;
            return Res;
         when Iir_Value_Signal =>
            case Kind is
               when Read_Last_Event =>
                  return Ghdl_I64 (Indirect.Sig.Last_Event);
               when Read_Last_Active =>
                  return Ghdl_I64 (Indirect.Sig.Last_Active);
            end case;
         when others =>
            raise Internal_Error;
      end case;
   end Execute_Read_Signal_Last;

   function Execute_Last_Event_Attribute (Indirect: Iir_Value_Literal_Acc)
                                         return Ghdl_I64 is
   begin
      return Execute_Read_Signal_Last (Indirect, Read_Last_Event);
   end Execute_Last_Event_Attribute;

   function Execute_Last_Active_Attribute (Indirect: Iir_Value_Literal_Acc)
                                          return Ghdl_I64 is
   begin
      return Execute_Read_Signal_Last (Indirect, Read_Last_Active);
   end Execute_Last_Active_Attribute;

   function Execute_Signal_Value (Indirect: Iir_Value_Literal_Acc)
     return Iir_Value_Literal_Acc
   is
      Res: Iir_Value_Literal_Acc;
   begin
      case Indirect.Kind is
         when Iir_Value_Array =>
            Res := Copy_Array_Bound (Indirect);
            for I in Indirect.Val_Array.V'Range loop
               Res.Val_Array.V (I) :=
                 Execute_Signal_Value (Indirect.Val_Array.V (I));
            end loop;
            return Res;
         when Iir_Value_Record =>
            Res := Create_Record_Value (Indirect.Val_Record.Len);
            for I in Indirect.Val_Record.V'Range loop
               Res.Val_Record.V (I) :=
                 Execute_Signal_Value (Indirect.Val_Record.V (I));
            end loop;
            return Res;
         when Iir_Value_Signal =>
            return Value_To_Iir_Value
              (Indirect.Sig.Mode, Indirect.Sig.Value_Ptr.all);
         when others =>
            raise Internal_Error;
      end case;
   end Execute_Signal_Value;

   procedure Assign_Value_To_Array_Signal
     (Instance: Block_Instance_Acc;
      Target: Iir_Value_Literal_Acc;
      Transactions: Transaction_Type)
   is
      Sub_Trans : Transaction_Type (Transactions.Len);
   begin
      Sub_Trans.Stmt := Transactions.Stmt;
      Sub_Trans.Reject := Transactions.Reject;

      for J in Target.Val_Array.V'Range loop
         for K in Transactions.Els'Range loop
            declare
               T : Transaction_El_Type renames Transactions.Els (K);
               S : Transaction_El_Type renames Sub_Trans.Els (K);
            begin
               S.After := T.After;

               if T.Value = null then
                  S.Value := null;
               else
                  S.Value := T.Value.Val_Array.V (J);
               end if;
            end;
         end loop;

         Assign_Value_To_Signal
           (Instance, Target.Val_Array.V (J), Sub_Trans);
      end loop;
   end Assign_Value_To_Array_Signal;

   procedure Assign_Value_To_Record_Signal
     (Instance: Block_Instance_Acc;
      Target: Iir_Value_Literal_Acc;
      Transactions: Transaction_Type)
   is
      Sub_Trans : Transaction_Type (Transactions.Len);
   begin
      Sub_Trans.Stmt := Transactions.Stmt;
      Sub_Trans.Reject := Transactions.Reject;

      for J in Target.Val_Record.V'Range loop
         for K in Transactions.Els'Range loop
            declare
               T : Transaction_El_Type renames Transactions.Els (K);
               S : Transaction_El_Type renames Sub_Trans.Els (K);
            begin
               S.After := T.After;

               if T.Value = null then
                  S.Value := null;
               else
                  S.Value := T.Value.Val_Record.V (J);
               end if;
            end;
         end loop;

         Assign_Value_To_Signal
           (Instance, Target.Val_Record.V (J), Sub_Trans);
      end loop;
   end Assign_Value_To_Record_Signal;

   procedure Assign_Value_To_Scalar_Signal
     (Instance: Block_Instance_Acc;
      Target: Iir_Value_Literal_Acc;
      Transactions: Transaction_Type)
   is
      pragma Unreferenced (Instance);
      use Grt.Signals;
   begin
      declare
         El : Transaction_El_Type renames Transactions.Els (1);
      begin
         if El.Value = null then
            Ghdl_Signal_Start_Assign_Null
              (Target.Sig, Transactions.Reject, El.After);
            if Transactions.Els'Last /= 1 then
               raise Internal_Error;
            end if;
            return;
         end if;

         --  FIXME: null transaction, check constraints.
         case Iir_Value_Scalars (El.Value.Kind) is
            when Iir_Value_B1 =>
               Ghdl_Signal_Start_Assign_B1
                 (Target.Sig, Transactions.Reject, El.Value.B1, El.After);
            when Iir_Value_E32 =>
               Ghdl_Signal_Start_Assign_E32
                 (Target.Sig, Transactions.Reject, El.Value.E32, El.After);
            when Iir_Value_I64 =>
               Ghdl_Signal_Start_Assign_I64
                 (Target.Sig, Transactions.Reject, El.Value.I64, El.After);
            when Iir_Value_F64 =>
               Ghdl_Signal_Start_Assign_F64
                 (Target.Sig, Transactions.Reject, El.Value.F64, El.After);
         end case;
      end;

      for I in 2 .. Transactions.Els'Last loop
         declare
            El : Transaction_El_Type renames Transactions.Els (I);
         begin
            case Iir_Value_Scalars (El.Value.Kind) is
               when Iir_Value_B1 =>
                  Ghdl_Signal_Next_Assign_B1
                    (Target.Sig, El.Value.B1, El.After);
               when Iir_Value_E32 =>
                  Ghdl_Signal_Next_Assign_E32
                    (Target.Sig, El.Value.E32, El.After);
               when Iir_Value_I64 =>
                  Ghdl_Signal_Next_Assign_I64
                    (Target.Sig, El.Value.I64, El.After);
               when Iir_Value_F64 =>
                  Ghdl_Signal_Next_Assign_F64
                    (Target.Sig, El.Value.F64, El.After);
            end case;
         end;
      end loop;
   end Assign_Value_To_Scalar_Signal;

   procedure Assign_Value_To_Signal
     (Instance: Block_Instance_Acc;
      Target: Iir_Value_Literal_Acc;
      Transaction: Transaction_Type)
   is
   begin
      case Target.Kind is
         when Iir_Value_Array =>
            Assign_Value_To_Array_Signal
              (Instance, Target, Transaction);
         when Iir_Value_Record =>
            Assign_Value_To_Record_Signal
              (Instance, Target, Transaction);
         when Iir_Value_Signal =>
            Assign_Value_To_Scalar_Signal
              (Instance, Target, Transaction);
         when Iir_Value_Scalars
           | Iir_Value_Range
           | Iir_Value_File
           | Iir_Value_Access
           | Iir_Value_Protected
           | Iir_Value_Quantity
           | Iir_Value_Terminal
           | Iir_Value_Environment =>
            raise Internal_Error;
      end case;
   end Assign_Value_To_Signal;

   procedure Disconnect_Signal (Sig : Iir_Value_Literal_Acc) is
   begin
      case Sig.Kind is
         when Iir_Value_Array =>
            for I in Sig.Val_Array.V'Range loop
               Disconnect_Signal (Sig.Val_Array.V (I));
            end loop;
         when Iir_Value_Record =>
            for I in Sig.Val_Array.V'Range loop
               Disconnect_Signal (Sig.Val_Record.V (I));
            end loop;
         when Iir_Value_Signal =>
            Grt.Signals.Ghdl_Signal_Disconnect (Sig.Sig);
         when others =>
            raise Internal_Error;
      end case;
   end Disconnect_Signal;

   --  Call Ghdl_Process_Wait_Add_Sensitivity for each scalar subelement of
   --  SIG.
   procedure Wait_Add_Sensitivity (Sig: Iir_Value_Literal_Acc)
   is
   begin
      case Sig.Kind is
         when Iir_Value_Signal =>
            Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity (Sig.Sig);
         when Iir_Value_Array =>
            for I in Sig.Val_Array.V'Range loop
               Wait_Add_Sensitivity (Sig.Val_Array.V (I));
            end loop;
         when Iir_Value_Record =>
            for I in Sig.Val_Record.V'Range loop
               Wait_Add_Sensitivity (Sig.Val_Record.V (I));
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Wait_Add_Sensitivity;

   -- Return true if the process should be suspended.
   function Execute_Wait_Statement (Instance : Block_Instance_Acc;
                                    Stmt: Iir_Wait_Statement)
                                   return Boolean
   is
      Expr: Iir;
      El : Iir;
      List: Iir_List;
      Res: Iir_Value_Literal_Acc;
      Status : Boolean;
      Marker : Mark_Type;
   begin
      if not Instance.In_Wait_Flag then
         Mark (Marker, Expr_Pool);

         -- LRM93 8.1
         -- The execution of a wait statement causes the time expression to
         -- be evaluated to determine the timeout interval.
         Expr := Get_Timeout_Clause (Stmt);
         if Expr /= Null_Iir then
            Res := Execute_Expression (Instance, Expr);
            Grt.Processes.Ghdl_Process_Wait_Set_Timeout (Std_Time (Res.I64));
         end if;

         -- LRM93 8.1
         -- The suspended process may also resume as a result of an event
         -- occuring on any signal in the sensitivity set of the wait
         -- statement.
         List := Get_Sensitivity_List (Stmt);
         if List /= Null_Iir_List then
            for J in Natural loop
               El := Get_Nth_Element (List, J);
               exit when El = Null_Iir;
               Wait_Add_Sensitivity (Execute_Name (Instance, El, True));
            end loop;
         end if;

         --  LRM93 8.1
         --  It also causes the execution of the corresponding process
         --  statement to be suspended.
         Grt.Processes.Ghdl_Process_Wait_Suspend;
         Instance.In_Wait_Flag := True;
         Release (Marker, Expr_Pool);
         return True;
      else
         --  LRM93 8.1
         --  The suspended process will resume, at the latest, immediately
         --  after the timeout interval has expired.
         if not Grt.Processes.Ghdl_Process_Wait_Timed_Out then
            --  Compute the condition clause only if the timeout has not
            --  expired.

            -- LRM93 8.1
            -- If such an event occurs, the condition in the condition clause
            -- is evaluated.
            --
            -- if no condition clause appears, the condition clause until true
            -- is assumed.
            Status :=
              Execute_Condition (Instance, Get_Condition_Clause (Stmt));
            if not Status then
               -- LRM93 8.1
               -- If the value of the condition is FALSE, the process will
               -- re-suspend.
               -- Such re-suspension does not involve the recalculation of
               -- the timeout interval.
               Grt.Processes.Ghdl_Process_Wait_Suspend;
               return True;
            end if;
         end if;

         -- LRM93 8.1
         --   If the value of the condition is TRUE, the process will resume.
         -- next statement.
         Grt.Processes.Ghdl_Process_Wait_Close;

         Instance.In_Wait_Flag := False;
         return False;
      end if;
   end Execute_Wait_Statement;

   function To_Instance_Acc is new Ada.Unchecked_Conversion
     (System.Address, Grt.Processes.Instance_Acc);

   procedure Process_Executer (Self : Grt.Processes.Instance_Acc);
   pragma Convention (C, Process_Executer);

   procedure Process_Executer (Self : Grt.Processes.Instance_Acc)
   is
      function To_Process_State_Acc is new Ada.Unchecked_Conversion
        (Grt.Processes.Instance_Acc, Process_State_Acc);

      Process : Process_State_Acc renames
        To_Process_State_Acc (Self);
   begin
      --  For debugger
      Current_Process := Process;

      Instance_Pool := Process.Pool'Access;

      if Trace_Simulation then
         Put (" run process: ");
         Disp_Instance_Name (Process.Top_Instance);
         Put_Line (" (" & Disp_Location (Process.Proc) & ")");
      end if;

      Execute_Sequential_Statements (Process);

      --  Sanity checks.
      if not Is_Empty (Expr_Pool) then
         raise Internal_Error;
      end if;

      case Get_Kind (Process.Proc) is
         when Iir_Kind_Sensitized_Process_Statement =>
            if Process.Instance.In_Wait_Flag then
               raise Internal_Error;
            end if;
            if Process.Instance.Stmt = Null_Iir then
               Process.Instance.Stmt :=
                 Get_Sequential_Statement_Chain (Process.Proc);
            end if;
         when Iir_Kind_Process_Statement =>
            if not Process.Instance.In_Wait_Flag then
               raise Internal_Error;
            end if;
         when others =>
            raise Internal_Error;
      end case;

      Instance_Pool := null;
      Current_Process := null;
   end Process_Executer;

   type Resolver_Read_Mode is (Read_Port, Read_Driver);

   function Resolver_Read_Value (Sig : Iir_Value_Literal_Acc;
                                 Mode : Resolver_Read_Mode;
                                 Index : Ghdl_Index_Type)
                                return Iir_Value_Literal_Acc
   is
      use Grt.Signals;
      Val : Ghdl_Value_Ptr;
      Res : Iir_Value_Literal_Acc;
   begin
      case Sig.Kind is
         when Iir_Value_Array =>
            Res := Copy_Array_Bound (Sig);
            for I in Sig.Val_Array.V'Range loop
               Res.Val_Array.V (I) :=
                 Resolver_Read_Value (Sig.Val_Array.V (I), Mode, Index);
            end loop;
         when Iir_Value_Record =>
            Res := Create_Record_Value (Sig.Val_Record.Len);
            for I in Sig.Val_Record.V'Range loop
               Res.Val_Record.V (I) :=
                 Resolver_Read_Value (Sig.Val_Record.V (I), Mode, Index);
            end loop;
         when Iir_Value_Signal =>
            case Mode is
               when Read_Port =>
                  Val := Ghdl_Signal_Read_Port (Sig.Sig, Index);
               when Read_Driver =>
                  Val := Ghdl_Signal_Read_Driver (Sig.Sig, Index);
            end case;
            Res := Value_To_Iir_Value (Sig.Sig.Mode, Val.all);
         when others =>
            raise Internal_Error;
      end case;
      return Res;
   end Resolver_Read_Value;

   procedure Resolution_Proc (Instance_Addr : System.Address;
                              Val : System.Address;
                              Bool_Vec : System.Address;
                              Vec_Len : Ghdl_Index_Type;
                              Nbr_Drv : Ghdl_Index_Type;
                              Nbr_Ports : Ghdl_Index_Type)
   is
      pragma Unreferenced (Val);

      Instance : Resolv_Instance_Type;
      pragma Import (Ada, Instance);
      for Instance'Address use Instance_Addr;

      type Bool_Array is array (1 .. Nbr_Drv) of Boolean;
      Vec : Bool_Array;
      pragma Import (Ada, Vec);
      for Vec'Address use Bool_Vec;
      Off : Iir_Index32;

      Arr : Iir_Value_Literal_Acc;
      Arr_Type : constant Iir :=
        Get_Type (Get_Interface_Declaration_Chain (Instance.Func));

      Res : Iir_Value_Literal_Acc;

      Len : constant Iir_Index32 := Iir_Index32 (Vec_Len + Nbr_Ports);
      Instance_Mark, Expr_Mark : Mark_Type;
   begin
      pragma Assert (Instance_Pool = null);
      Instance_Pool := Global_Pool'Access;
      Mark (Instance_Mark, Instance_Pool.all);
      Mark (Expr_Mark, Expr_Pool);
      Current_Process := No_Process;

      Arr := Create_Array_Value (Len, 1);
      Arr.Bounds.D (1) := Create_Bounds_From_Length
        (Instance.Block,
         Get_First_Element (Get_Index_Subtype_List (Arr_Type)),
         Len);

      --  First ports
      for I in 1 .. Nbr_Ports loop
         Arr.Val_Array.V (Iir_Index32 (I)) := Resolver_Read_Value
           (Instance.Sig, Read_Port, I - 1);
      end loop;

      --  Then drivers.
      Off := Iir_Index32 (Nbr_Ports) + 1;
      for I in 1 .. Nbr_Drv loop
         if Vec (I) then
            Arr.Val_Array.V (Off) := Resolver_Read_Value
              (Instance.Sig, Read_Driver, I - 1);
            Off := Off + 1;
         end if;
      end loop;

      --  Call resolution function.
      Res := Execute_Resolution_Function (Instance.Block, Instance.Func, Arr);

      --  Set driving value.
      Execute_Write_Signal (Instance.Sig, Res, Write_Signal_Driving_Value);

      Release (Instance_Mark, Instance_Pool.all);
      Release (Expr_Mark, Expr_Pool);
      Instance_Pool := null;
   end Resolution_Proc;

   type Convert_Mode is (Convert_In, Convert_Out);

   type Convert_Instance_Type is record
      Mode : Convert_Mode;
      Instance : Block_Instance_Acc;
      Func : Iir;
      Src : Iir_Value_Literal_Acc;
      Dst : Iir_Value_Literal_Acc;
   end record;

   type Convert_Instance_Acc is access Convert_Instance_Type;

   procedure Conversion_Proc (Data : System.Address) is
      Conv : Convert_Instance_Type;
      pragma Import (Ada, Conv);
      for Conv'Address use Data;

      Src : Iir_Value_Literal_Acc;
      Dst : Iir_Value_Literal_Acc;

      Expr_Mark : Mark_Type;
   begin
      pragma Assert (Instance_Pool = null);
      Instance_Pool := Global_Pool'Access;
      Mark (Expr_Mark, Expr_Pool);
      Current_Process := No_Process;

      case Conv.Mode is
         when Convert_In =>
            Src := Execute_Read_Signal_Value
              (Conv.Src, Read_Signal_Effective_Value);
         when Convert_Out =>
            Src := Execute_Read_Signal_Value
              (Conv.Src, Read_Signal_Driving_Value);
      end case;

      Dst := Execute_Assoc_Conversion (Conv.Instance, Conv.Func, Src);

      Check_Bounds (Conv.Dst, Dst, Conv.Func);

      case Conv.Mode is
         when Convert_In =>
            Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Effective_Value);
         when Convert_Out =>
            Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Driving_Value);
      end case;

      Release (Expr_Mark, Expr_Pool);
      Instance_Pool := null;
   end Conversion_Proc;

   function Guard_Func (Data : System.Address) return Ghdl_B1
   is
      Guard : Guard_Instance_Type;
      pragma Import (Ada, Guard);
      for Guard'Address use Data;

      Val : Boolean;

      Prev_Instance_Pool : Areapool_Acc;
   begin
      pragma Assert (Instance_Pool = null
                       or else Instance_Pool = Global_Pool'Access);
      Prev_Instance_Pool := Instance_Pool;

      Instance_Pool := Global_Pool'Access;
      Current_Process := No_Process;

      Val := Execute_Condition
        (Guard.Instance, Get_Guard_Expression (Guard.Guard));

      Instance_Pool := Prev_Instance_Pool;

      return Ghdl_B1'Val (Boolean'Pos (Val));
   end Guard_Func;

   -- Add a driver for signal designed by VAL (via index field) for instance
   -- INSTANCE of process PROC.
   -- FIXME: default value.
   procedure Add_Source
     (Instance: Block_Instance_Acc; Val: Iir_Value_Literal_Acc; Proc: Iir)
   is
   begin
      case Val.Kind is
         when Iir_Value_Signal =>
            if Proc = Null_Iir then
               -- Can this happen ?
               raise Internal_Error;
            end if;
            Grt.Signals.Ghdl_Process_Add_Driver (Val.Sig);
         when Iir_Value_Array =>
            for I in Val.Val_Array.V'Range loop
               Add_Source (Instance, Val.Val_Array.V (I), Proc);
            end loop;
         when Iir_Value_Record =>
            for I in Val.Val_Record.V'Range loop
               Add_Source (Instance, Val.Val_Record.V (I), Proc);
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Add_Source;

   --  Add drivers for process PROC.
   --  Note: this is done recursively on the callees of PROC.
   procedure Elaborate_Drivers (Instance: Block_Instance_Acc; Proc: Iir)
   is
      Driver_List: Iir_List;
      El: Iir;
      Val: Iir_Value_Literal_Acc;
      Marker : Mark_Type;
   begin
      if Trace_Drivers then
         Ada.Text_IO.Put ("Drivers for ");
         Disp_Instance_Name (Instance);
         Ada.Text_IO.Put_Line (": " & Disp_Node (Proc));
      end if;

      Driver_List := Trans_Analyzes.Extract_Drivers (Proc);

      -- Some processes have no driver list (assertion).
      if Driver_List = Null_Iir_List then
         return;
      end if;

      for I in Natural loop
         El := Get_Nth_Element (Driver_List, I);
         exit when El = Null_Iir;
         if Trace_Drivers then
            Put_Line (' ' & Disp_Node (El));
         end if;

         Mark (Marker, Expr_Pool);
         Val := Execute_Name (Instance, El, True);
         Add_Source (Instance, Val, Proc);
         Release (Marker, Expr_Pool);
      end loop;
   end Elaborate_Drivers;

   --  Call Ghdl_Process_Add_Sensitivity for each scalar subelement of
   --  SIG.
   procedure Process_Add_Sensitivity (Sig: Iir_Value_Literal_Acc) is
   begin
      case Sig.Kind is
         when Iir_Value_Signal =>
            Grt.Processes.Ghdl_Process_Add_Sensitivity (Sig.Sig);
         when Iir_Value_Array =>
            for I in Sig.Val_Array.V'Range loop
               Process_Add_Sensitivity (Sig.Val_Array.V (I));
            end loop;
         when Iir_Value_Record =>
            for I in Sig.Val_Record.V'Range loop
               Process_Add_Sensitivity (Sig.Val_Record.V (I));
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Process_Add_Sensitivity;

   procedure Create_Processes
   is
      use Grt.Processes;
      El : Iir;
      Instance : Block_Instance_Acc;
      Instance_Grt : Grt.Processes.Instance_Acc;
   begin
      Processes_State := new Process_State_Array (1 .. Processes_Table.Last);

      for I in Processes_Table.First .. Processes_Table.Last loop
         Instance := Processes_Table.Table (I);
         El := Instance.Label;

         Instance_Pool := Processes_State (I).Pool'Access;
         Instance.Stmt := Get_Sequential_Statement_Chain (El);

         Processes_State (I).Top_Instance := Instance;
         Processes_State (I).Proc := El;
         Processes_State (I).Instance := Instance;

         Current_Process := Processes_State (I)'Access;
         Instance_Grt := To_Instance_Acc (Processes_State (I)'Address);
         case Get_Kind (El) is
            when Iir_Kind_Sensitized_Process_Statement =>
               if Get_Postponed_Flag (El) then
                  Ghdl_Postponed_Sensitized_Process_Register
                    (Instance_Grt,
                     Process_Executer'Access,
                     null, System.Null_Address);
               else
                  Ghdl_Sensitized_Process_Register
                    (Instance_Grt,
                     Process_Executer'Access,
                     null, System.Null_Address);
               end if;

               --  Register sensitivity.
               declare
                  Sig_List : Iir_List;
                  Sig : Iir;
                  Marker : Mark_Type;
               begin
                  Sig_List := Get_Sensitivity_List (El);
                  for J in Natural loop
                     Sig := Get_Nth_Element (Sig_List, J);
                     exit when Sig = Null_Iir;
                     Mark (Marker, Expr_Pool);
                     Process_Add_Sensitivity
                       (Execute_Name (Instance, Sig, True));
                     Release (Marker, Expr_Pool);
                  end loop;
               end;

            when Iir_Kind_Process_Statement =>
               if Get_Postponed_Flag (El) then
                  Ghdl_Postponed_Process_Register
                    (Instance_Grt,
                     Process_Executer'Access,
                     null, System.Null_Address);
               else
                  Ghdl_Process_Register
                    (Instance_Grt,
                     Process_Executer'Access,
                     null, System.Null_Address);
               end if;

            when others =>
               raise Internal_Error;
         end case;

         --  LRM93 §12.4.4  Other Concurrent Statements
         --  All other concurrent statements are either process
         --  statements or are statements for which there is an
         --  equivalent process statement.
         --  Elaboration of a process statement proceeds as follows:
         --  1.  The process declarative part is elaborated.
         Elaborate_Declarative_Part
           (Instance, Get_Declaration_Chain (El));

         --  2.  The drivers required by the process statement
         --      are created.
         --  3.  The initial transaction defined by the default value
         --      associated with each scalar signal driven by the
         --      process statement is inserted into the corresponding
         --      driver.
         --  FIXME: do it for drivers in called subprograms too.
         Elaborate_Drivers (Instance, El);

         if not Is_Empty (Expr_Pool) then
            raise Internal_Error;
         end if;

         --  Elaboration of all concurrent signal assignment
         --  statements and concurrent assertion statements consists
         --  of the construction of the equivalent process statement
         --  followed by the elaboration of the equivalent process
         --  statement.
         --  [GHDL:  this is done by canonicalize.  ]

         --  FIXME: check passive statements,
         --  check no wait statement in sensitized processes.

         Instance_Pool := null;
      end loop;

      if Trace_Simulation then
         Disp_Signals_Value;
      end if;
   end Create_Processes;

   --  Configuration for the whole design
   Top_Config : Iir_Design_Unit;

   --  Elaborate the design
   procedure Ghdl_Elaborate;
   pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE");

   procedure Set_Disconnection (Val : Iir_Value_Literal_Acc;
                                Time : Iir_Value_Time)
   is
   begin
      case Val.Kind is
         when Iir_Value_Signal =>
            Grt.Signals.Ghdl_Signal_Set_Disconnect (Val.Sig, Std_Time (Time));
         when Iir_Value_Record =>
            for I in Val.Val_Record.V'Range loop
               Set_Disconnection (Val.Val_Record.V (I), Time);
            end loop;
         when Iir_Value_Array =>
            for I in Val.Val_Array.V'Range loop
               Set_Disconnection (Val.Val_Array.V (I), Time);
            end loop;
         when others =>
            raise Internal_Error;
      end case;
   end Set_Disconnection;

   procedure Create_Disconnections is
   begin
      for I in Disconnection_Table.First .. Disconnection_Table.Last loop
         declare
            E : Disconnection_Entry renames Disconnection_Table.Table (I);
         begin
            Set_Disconnection (E.Sig, E.Time);
         end;
      end loop;
   end Create_Disconnections;

   type Connect_Mode is (Connect_Source, Connect_Effective);

   -- Add a driving value PORT to signal SIG, ie: PORT is a source for SIG.
   -- As a side effect, this connect the signal SIG with the port PORT.
   -- PORT is the formal, while SIG is the actual.
   procedure Connect (Sig: Iir_Value_Literal_Acc;
                      Port: Iir_Value_Literal_Acc;
                      Mode : Connect_Mode)
   is
   begin
      case Sig.Kind is
         when Iir_Value_Array =>
            if Port.Kind /= Sig.Kind then
               raise Internal_Error;
            end if;

            if Sig.Val_Array.Len /= Port.Val_Array.Len then
               raise Internal_Error;
            end if;
            for I in Sig.Val_Array.V'Range loop
               Connect (Sig.Val_Array.V (I), Port.Val_Array.V (I), Mode);
            end loop;
            return;
         when Iir_Value_Record =>
            if Port.Kind /= Sig.Kind then
               raise Internal_Error;
            end if;
            if Sig.Val_Record.Len /= Port.Val_Record.Len then
               raise Internal_Error;
            end if;
            for I in Sig.Val_Record.V'Range loop
               Connect (Sig.Val_Record.V (I), Port.Val_Record.V (I), Mode);
            end loop;
            return;
         when Iir_Value_Signal =>
            pragma Assert (Port.Kind = Iir_Value_Signal);
            -- Here, SIG and PORT are simple signals (not composite).
            -- PORT is a source for SIG.
            case Mode is
               when Connect_Source =>
                  Grt.Signals.Ghdl_Signal_Add_Source
                    (Sig.Sig, Port.Sig);
               when Connect_Effective =>
                  Grt.Signals.Ghdl_Signal_Effective_Value
                    (Port.Sig, Sig.Sig);
            end case;
         when Iir_Value_E32 =>
            if Mode = Connect_Source then
               raise Internal_Error;
            end if;
            Grt.Signals.Ghdl_Signal_Associate_E32 (Port.Sig, Sig.E32);
         when Iir_Value_I64 =>
            if Mode = Connect_Source then
               raise Internal_Error;
            end if;
            Grt.Signals.Ghdl_Signal_Associate_I64 (Port.Sig, Sig.I64);
         when Iir_Value_B1 =>
            if Mode = Connect_Source then
               raise Internal_Error;
            end if;
            Grt.Signals.Ghdl_Signal_Associate_B1 (Port.Sig, Sig.B1);
         when others =>
            raise Internal_Error;
      end case;
   end Connect;

   function Get_Leftest_Signal (Val : Iir_Value_Literal_Acc)
                               return Iir_Value_Literal_Acc is
   begin
      case Val.Kind is
         when Iir_Value_Signal =>
            return Val;
         when Iir_Value_Array =>
            return Get_Leftest_Signal (Val.Val_Array.V (1));
         when Iir_Value_Record =>
            return Get_Leftest_Signal (Val.Val_Record.V (1));
         when others =>
            raise Internal_Error;
      end case;
   end Get_Leftest_Signal;

   procedure Add_Conversion (Conv : Convert_Instance_Acc)
   is
      Src_Left : Grt.Signals.Ghdl_Signal_Ptr;
      Src_Len : Ghdl_Index_Type;
      Dst_Left : Grt.Signals.Ghdl_Signal_Ptr;
      Dst_Len : Ghdl_Index_Type;
   begin
      Conv.Src := Unshare_Bounds (Conv.Src, Instance_Pool);
      Conv.Dst := Unshare_Bounds (Conv.Dst, Instance_Pool);

      Src_Left := Get_Leftest_Signal (Conv.Src).Sig;
      Src_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Src));

      Dst_Left := Get_Leftest_Signal (Conv.Dst).Sig;
      Dst_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Dst));

      case Conv.Mode is
         when Convert_In =>
            Grt.Signals.Ghdl_Signal_In_Conversion (Conversion_Proc'Address,
                                                   Conv.all'Address,
                                                   Src_Left, Src_Len,
                                                   Dst_Left, Dst_Len);
         when Convert_Out =>
            Grt.Signals.Ghdl_Signal_Out_Conversion (Conversion_Proc'Address,
                                                    Conv.all'Address,
                                                    Src_Left, Src_Len,
                                                    Dst_Left, Dst_Len);
      end case;
   end Add_Conversion;

   function Create_Shadow_Signal (Sig : Iir_Value_Literal_Acc)
                                 return Iir_Value_Literal_Acc
   is
      Val : Ghdl_Value_Ptr;
   begin
      case Sig.Kind is
         when Iir_Value_Signal =>
            Val := new Value_Union;
            case Sig.Sig.Mode is
               when Mode_I64 =>
                  Val.I64 := 0;
                  return Create_Signal_Value
                    (Grt.Signals.Ghdl_Create_Signal_I64
                       (Val, null, System.Null_Address));
               when Mode_B1 =>
                  Val.B1 := False;
                  return Create_Signal_Value
                    (Grt.Signals.Ghdl_Create_Signal_B1
                       (Val, null, System.Null_Address));
               when Mode_E32 =>
                  Val.E32 := 0;
                  return Create_Signal_Value
                    (Grt.Signals.Ghdl_Create_Signal_E32
                       (Val, null, System.Null_Address));
               when Mode_F64 =>
                  Val.F64 := 0.0;
                  return Create_Signal_Value
                    (Grt.Signals.Ghdl_Create_Signal_F64
                       (Val, null, System.Null_Address));
               when Mode_E8
                 | Mode_I32 =>
                  raise Internal_Error;
            end case;
         when Iir_Value_Array =>
            declare
               Res : Iir_Value_Literal_Acc;
            begin
               Res := Unshare_Bounds (Sig, Instance_Pool);
               for I in Res.Val_Array.V'Range loop
                  Res.Val_Array.V (I) :=
                    Create_Shadow_Signal (Sig.Val_Array.V (I));
               end loop;
               return Res;
            end;
         when Iir_Value_Record =>
            declare
               Res : Iir_Value_Literal_Acc;
            begin
               Res := Create_Record_Value
                 (Sig.Val_Record.Len, Instance_Pool);
               for I in Res.Val_Record.V'Range loop
                  Res.Val_Record.V (I) :=
                    Create_Shadow_Signal (Sig.Val_Record.V (I));
               end loop;
               return Res;
            end;
         when Iir_Value_Scalars
           | Iir_Value_Access
           | Iir_Value_Range
           | Iir_Value_Protected
           | Iir_Value_Terminal
           | Iir_Value_Quantity
           | Iir_Value_File
           | Iir_Value_Environment =>
            raise Internal_Error;
      end case;
   end Create_Shadow_Signal;

   procedure Set_Connect
     (Formal_Instance : Block_Instance_Acc;
      Formal_Expr : Iir_Value_Literal_Acc;
      Local_Instance : Block_Instance_Acc;
      Local_Expr : Iir_Value_Literal_Acc;
      Assoc : Iir_Association_Element_By_Expression)
   is
      pragma Unreferenced (Formal_Instance);
      Formal : constant Iir := Get_Formal (Assoc);
      Inter : constant Iir := Get_Association_Interface (Assoc);
   begin
      if False and Trace_Elaboration then
         Put ("connect formal ");
         Put (Iir_Mode'Image (Get_Mode (Inter)));
         Put (" ");
         Disp_Iir_Value (Formal_Expr, Get_Type (Formal));
         Put (" with actual ");
         Disp_Iir_Value (Local_Expr, Get_Type (Get_Actual (Assoc)));
         New_Line;
      end if;

      case Get_Mode (Inter) is
         when Iir_Out_Mode
           | Iir_Inout_Mode
           | Iir_Buffer_Mode
           | Iir_Linkage_Mode =>
            --  FORMAL_EXPR is a source for LOCAL_EXPR.
            declare
               Out_Conv : constant Iir := Get_Out_Conversion (Assoc);
               Src : Iir_Value_Literal_Acc;
            begin
               if Out_Conv /= Null_Iir then
                  Src := Create_Shadow_Signal (Local_Expr);
                  Add_Conversion
                    (new Convert_Instance_Type'
                       (Mode => Convert_Out,
                        Instance => Local_Instance,
                        Func => Out_Conv,
                        Src => Formal_Expr,
                        Dst => Src));
               else
                  Src := Formal_Expr;
               end if;
               --  LRM93 §12.6.2
               --  A signal is said to be active [...] if one of its source
               --  is active.
               Connect (Local_Expr, Src, Connect_Source);
            end;

         when Iir_In_Mode =>
            null;
         when Iir_Unknown_Mode =>
            raise Internal_Error;
      end case;

      case Get_Mode (Inter) is
         when Iir_In_Mode
           | Iir_Inout_Mode
           | Iir_Buffer_Mode
           | Iir_Linkage_Mode =>
            declare
               In_Conv : constant Iir := Get_In_Conversion (Assoc);
               Src : Iir_Value_Literal_Acc;
            begin
               if In_Conv /= Null_Iir then
                  Src := Create_Shadow_Signal (Formal_Expr);
                  Add_Conversion
                    (new Convert_Instance_Type'
                       (Mode => Convert_In,
                        Instance => Local_Instance,
                        Func => Get_Implementation (In_Conv),
                        Src => Local_Expr,
                        Dst => Src));
               else
                  Src := Local_Expr;
               end if;
               Connect (Src, Formal_Expr, Connect_Effective);
            end;
         when Iir_Out_Mode =>
            null;
         when Iir_Unknown_Mode =>
            raise Internal_Error;
      end case;
   end Set_Connect;

   procedure Create_Connects is
   begin
      --  New signals may be created (because of conversions).
      Instance_Pool := Global_Pool'Access;

      for I in Connect_Table.First .. Connect_Table.Last loop
         declare
            E : Connect_Entry renames Connect_Table.Table (I);
         begin
            Set_Connect (E.Formal_Instance, E.Formal,
                         E.Actual_Instance, E.Actual,
                         E.Assoc);
         end;
      end loop;

      Instance_Pool := null;
   end Create_Connects;

   procedure Create_Guard_Signal (Instance : Block_Instance_Acc;
                                  Sig_Guard : Iir_Value_Literal_Acc;
                                  Val_Guard : Iir_Value_Literal_Acc;
                                  Guard : Iir)
   is
      procedure Add_Guard_Sensitivity (Sig : Iir_Value_Literal_Acc) is
      begin
         case Sig.Kind is
            when Iir_Value_Signal =>
               Grt.Signals.Ghdl_Signal_Guard_Dependence (Sig.Sig);
            when Iir_Value_Array =>
               for I in Sig.Val_Array.V'Range loop
                  Add_Guard_Sensitivity (Sig.Val_Array.V (I));
               end loop;
            when Iir_Value_Record =>
               for I in Sig.Val_Record.V'Range loop
                  Add_Guard_Sensitivity (Sig.Val_Record.V (I));
               end loop;
            when others =>
               raise Internal_Error;
         end case;
      end Add_Guard_Sensitivity;

      Dep_List : Iir_List;
      Dep : Iir;
      Data : Guard_Instance_Acc;
   begin
      Data := new Guard_Instance_Type'(Instance => Instance,
                                       Guard => Guard);
      Sig_Guard.Sig := Grt.Signals.Ghdl_Signal_Create_Guard
        (To_Ghdl_Value_Ptr (Val_Guard.B1'Address),
         Data.all'Address, Guard_Func'Access);
      Dep_List := Get_Guard_Sensitivity_List (Guard);
      for I in Natural loop
         Dep := Get_Nth_Element (Dep_List, I);
         exit when Dep = Null_Iir;
         Add_Guard_Sensitivity (Execute_Name (Instance, Dep, True));
      end loop;

      --  FIXME: free mem
   end Create_Guard_Signal;

   procedure Create_Implicit_Signal (Sig : Iir_Value_Literal_Acc;
                                     Val : Iir_Value_Literal_Acc;
                                     Time : Ghdl_I64;
                                     Prefix : Iir_Value_Literal_Acc;
                                     Kind : Signal_Type_Kind)
   is
      procedure Register_Prefix (Pfx : Iir_Value_Literal_Acc) is
      begin
         case Pfx.Kind is
            when Iir_Value_Signal =>
               Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix (Pfx.Sig);
            when Iir_Value_Array =>
               for I in Pfx.Val_Array.V'Range loop
                  Register_Prefix (Pfx.Val_Array.V (I));
               end loop;
            when Iir_Value_Record =>
               for I in Pfx.Val_Record.V'Range loop
                  Register_Prefix (Pfx.Val_Record.V (I));
               end loop;
            when others =>
               raise Internal_Error;
         end case;
      end Register_Prefix;
   begin
      case Kind is
         when Implicit_Stable =>
            Sig.Sig := Grt.Signals.Ghdl_Create_Stable_Signal
              (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time));
         when Implicit_Quiet =>
            Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal
              (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time));
         when Implicit_Transaction =>
            Sig.Sig := Grt.Signals.Ghdl_Create_Transaction_Signal
              (To_Ghdl_Value_Ptr (Val.B1'Address));
         when others =>
            raise Internal_Error;
      end case;
      Register_Prefix (Prefix);
   end Create_Implicit_Signal;

   procedure Create_Delayed_Signal (Sig : Iir_Value_Literal_Acc;
                                    Val : Iir_Value_Literal_Acc;
                                    Pfx : Iir_Value_Literal_Acc;
                                    Time : Std_Time)
   is
      Val_Ptr : Ghdl_Value_Ptr;
   begin
      case Pfx.Kind is
         when Iir_Value_Array =>
            for I in Sig.Val_Array.V'Range loop
               Create_Delayed_Signal
                 (Sig.Val_Array.V (I), Val.Val_Array.V (I),
                  Pfx.Val_Array.V (I), Time);
               end loop;
         when Iir_Value_Record =>
            for I in Pfx.Val_Record.V'Range loop
               Create_Delayed_Signal
                 (Sig.Val_Record.V (I), Val.Val_Record.V (I),
                  Pfx.Val_Array.V (I), Time);
            end loop;
         when Iir_Value_Signal =>
            case Val.Kind is
               when Iir_Value_I64 =>
                  Val_Ptr := To_Ghdl_Value_Ptr (Val.I64'Address);
               when Iir_Value_E32 =>
                  Val_Ptr := To_Ghdl_Value_Ptr (Val.E32'Address);
               when Iir_Value_F64 =>
                  Val_Ptr := To_Ghdl_Value_Ptr (Val.F64'Address);
               when Iir_Value_B1 =>
                  Val_Ptr := To_Ghdl_Value_Ptr (Val.B1'Address);
               when others =>
                  raise Internal_Error;
            end case;
            Sig.Sig := Grt.Signals.Ghdl_Create_Delayed_Signal
              (Pfx.Sig, Val_Ptr, Time);
         when others =>
            raise Internal_Error;
      end case;
   end Create_Delayed_Signal;

   -- Create a new signal, using DEFAULT as initial value.
   -- Set its number.
   procedure Create_User_Signal (Block: Block_Instance_Acc;
                                 Signal: Iir;
                                 Sig : Iir_Value_Literal_Acc;
                                 Val : Iir_Value_Literal_Acc)
   is
      use Grt.Rtis;
      use Grt.Signals;

      procedure Create_Signal (Val : Iir_Value_Literal_Acc;
                               Sig : Iir_Value_Literal_Acc;
                               Sig_Type: Iir;
                               Already_Resolved : Boolean)
      is
         Sub_Resolved : Boolean := Already_Resolved;
         Resolv_Func : Iir;
         Resolv_Instance : Resolv_Instance_Acc;
      begin
         if not Already_Resolved
           and then Get_Kind (Sig_Type) in Iir_Kinds_Subtype_Definition
         then
            Resolv_Func := Get_Resolution_Indication (Sig_Type);
         else
            Resolv_Func := Null_Iir;
         end if;
         if Resolv_Func /= Null_Iir then
            Sub_Resolved := True;
            Resolv_Instance := new Resolv_Instance_Type'
              (Func => Get_Named_Entity (Resolv_Func),
               Block => Block,
               Sig => Sig);
            Grt.Signals.Ghdl_Signal_Create_Resolution
              (Resolution_Proc'Access,
               Resolv_Instance.all'Address,
               System.Null_Address,
               Ghdl_Index_Type (Get_Nbr_Of_Scalars (Val)));
         end if;
         case Val.Kind is
            when Iir_Value_Array =>
               declare
                  Sig_El_Type : constant Iir :=
                    Get_Element_Subtype (Get_Base_Type (Sig_Type));
               begin
                  for I in Val.Val_Array.V'Range loop
                     Create_Signal (Val.Val_Array.V (I), Sig.Val_Array.V (I),
                                    Sig_El_Type, Sub_Resolved);
                  end loop;
               end;
            when Iir_Value_Record =>
               declare
                  El : Iir_Element_Declaration;
                  List : Iir_List;
               begin
                  List := Get_Elements_Declaration_List
                    (Get_Base_Type (Sig_Type));
                  for I in Val.Val_Record.V'Range loop
                     El := Get_Nth_Element (List, Natural (I - 1));
                     Create_Signal (Val.Val_Record.V (I), Sig.Val_Record.V (I),
                                    Get_Type (El), Sub_Resolved);
                  end loop;
               end;

            when Iir_Value_I64 =>
               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_I64
                 (To_Ghdl_Value_Ptr (Val.I64'Address),
                  null, System.Null_Address);
            when Iir_Value_B1 =>
               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_B1
                 (To_Ghdl_Value_Ptr (Val.B1'Address),
                  null, System.Null_Address);
            when Iir_Value_E32 =>
               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E32
                 (To_Ghdl_Value_Ptr (Val.E32'Address),
                  null, System.Null_Address);
            when Iir_Value_F64 =>
               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_F64
                 (To_Ghdl_Value_Ptr (Val.F64'Address),
                  null, System.Null_Address);

            when Iir_Value_Signal
              | Iir_Value_Range
              | Iir_Value_File
              | Iir_Value_Access
              | Iir_Value_Protected
              | Iir_Value_Quantity
              | Iir_Value_Terminal
              | Iir_Value_Environment =>
               raise Internal_Error;
         end case;
      end Create_Signal;

      Sig_Type: constant Iir := Get_Type (Signal);
      Mode : Mode_Signal_Type;
      Kind : Kind_Signal_Type;

      type Iir_Mode_To_Mode_Signal_Type is
        array (Iir_Mode) of Mode_Signal_Type;
      Iir_Mode_To_Mode_Signal : constant Iir_Mode_To_Mode_Signal_Type :=
        (Iir_Unknown_Mode => Mode_Signal,
         Iir_Linkage_Mode => Mode_Linkage,
         Iir_Buffer_Mode => Mode_Buffer,
         Iir_Out_Mode => Mode_Out,
         Iir_Inout_Mode => Mode_Inout,
         Iir_In_Mode => Mode_In);

      type Iir_Kind_To_Kind_Signal_Type is
        array (Iir_Signal_Kind) of Kind_Signal_Type;
      Iir_Kind_To_Kind_Signal : constant Iir_Kind_To_Kind_Signal_Type :=
        (Iir_Register_Kind  => Kind_Signal_Register,
         Iir_Bus_Kind       => Kind_Signal_Bus);
   begin
      case Get_Kind (Signal) is
         when Iir_Kind_Interface_Signal_Declaration =>
            Mode := Iir_Mode_To_Mode_Signal (Get_Mode (Signal));
         when Iir_Kind_Signal_Declaration =>
            Mode := Mode_Signal;
         when others =>
            Error_Kind ("elaborate_signal", Signal);
      end case;

      if Get_Guarded_Signal_Flag (Signal) then
         Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal));
      else
         Kind := Kind_Signal_No;
      end if;

      Grt.Signals.Ghdl_Signal_Set_Mode (Mode, Kind, True);

      Create_Signal (Val, Sig, Sig_Type, False);
   end Create_User_Signal;

   procedure Create_Signals is
   begin
      for I in Signals_Table.First .. Signals_Table.Last loop
         declare
            E : Signal_Entry renames Signals_Table.Table (I);
         begin
            case E.Kind is
               when Guard_Signal =>
                  Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl);
               when Implicit_Stable | Implicit_Quiet | Implicit_Transaction =>
                  Create_Implicit_Signal
                    (E.Sig, E.Val, E.Time, E.Prefix, E.Kind);
               when Implicit_Delayed =>
                  Create_Delayed_Signal (E.Sig, E.Val,
                                         E.Prefix, Std_Time (E.Time));
               when User_Signal =>
                  Create_User_Signal (E.Instance, E.Decl, E.Sig, E.Val);
            end case;
         end;
      end loop;
   end Create_Signals;

   procedure Ghdl_Elaborate
   is
      Entity: Iir_Entity_Declaration;

      -- Number of input ports of the top entity.
      In_Signals: Natural;
      El : Iir;
   begin
      Instance_Pool := Global_Pool'Access;

      Elaboration.Elaborate_Design (Top_Config);
      Entity := Iirs_Utils.Get_Entity (Get_Library_Unit (Top_Config));

      if not Is_Empty (Expr_Pool) then
         raise Internal_Error;
      end if;

      Instance_Pool := null;

      -- Be sure there is no IN ports in the top entity.
      El := Get_Port_Chain (Entity);
      In_Signals := 0;
      while El /= Null_Iir loop
         if Get_Mode (El) = Iir_In_Mode then
            In_Signals := In_Signals + 1;
         end if;
         El := Get_Chain (El);
      end loop;

      if In_Signals /= 0 then
         Error_Msg_Elab ("top entity should not have inputs signals", Entity);
         -- raise Simulation_Error;
      end if;

      if Disp_Stats then
         Disp_Design_Stats;
      end if;

      if Disp_Ams then
         Simulation.AMS.Debugger.Disp_Characteristic_Expressions;
      end if;

      -- There is no inputs.
      -- All the simulation is done via time, so it must be displayed.
      Disp_Time_Before_Values := True;

      -- Initialisation.
      if Trace_Simulation then
         Put_Line ("Initialisation:");
      end if;

      Create_Signals;
      Create_Connects;
      Create_Disconnections;
      Create_Processes;

      if Disp_Tree then
         Debugger.Disp_Instances_Tree;
      end if;

      if Flag_Interractive then
         Debug (Reason_Elab);
      end if;
   end Ghdl_Elaborate;

   procedure Simulation_Entity (Top_Conf : Iir_Design_Unit) is
   begin
      Top_Config := Top_Conf;

      Grt.Errors.Error_Hook := Debug_Error'Access;

      if Flag_Interractive then
         Debug (Reason_Start);
      end if;

      Grt.Main.Run;
   exception
      when Debugger_Quit =>
         null;
      when Simulation_Finished =>
         null;
   end Simulation_Entity;

end Simulation;