path: root/src/vhdl/simulate/simul-simulation-main.adb

--  Interpreted simulation
--  Copyright (C) 2014-2017 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 Types; use Types;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
with Vhdl.Errors; use Vhdl.Errors;
with PSL.Nodes;
with PSL.NFAs;
with PSL.NFAs.Utils;
with Vhdl.Std_Package;
with Trans_Analyzes;
with Simul.Elaboration; use Simul.Elaboration;
with Simul.Execution; use Simul.Execution;
with Simul.Annotations; use Simul.Annotations;
with Vhdl.Ieee.Std_Logic_1164;
with Grt.Main;
with Simul.Debugger; use Simul.Debugger;
with Simul.Debugger.AMS;
with Grt.Errors;
with Grt.Processes;
with Grt.Signals;
with Areapools; use Areapools;

package body Simul.Simulation.Main is
   --  Configuration for the whole design
   Top_Config : Iir_Design_Unit;

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

   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 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;

   -- 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;
                         Sig : Iir_Value_Literal_Acc;
                         Val : Iir_Value_Literal_Acc) is
   begin
      case Val.Kind is
         when Iir_Value_B1 =>
            Grt.Signals.Ghdl_Signal_Add_Port_Driver_B1 (Sig.Sig, Val.B1);
         when Iir_Value_E8 =>
            Grt.Signals.Ghdl_Signal_Add_Port_Driver_E8 (Sig.Sig, Val.E8);
         when Iir_Value_E32 =>
            Grt.Signals.Ghdl_Signal_Add_Port_Driver_E32 (Sig.Sig, Val.E32);
         when Iir_Value_I64 =>
            Grt.Signals.Ghdl_Signal_Add_Port_Driver_I64 (Sig.Sig, Val.I64);
         when Iir_Value_F64 =>
            Grt.Signals.Ghdl_Signal_Add_Port_Driver_F64 (Sig.Sig, Val.F64);
         when Iir_Value_Array =>
            for I in Sig.Val_Array.V'Range loop
               Add_Source (Instance, Sig.Val_Array.V (I), Val.Val_Array.V (I));
            end loop;
         when Iir_Value_Record =>
            for I in Sig.Val_Record.V'Range loop
               Add_Source
                 (Instance, Sig.Val_Record.V (I), Val.Val_Record.V (I));
            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;
      It : List_Iterator;
      El: Iir;
      Val : Iir_Value_Literal_Acc;
      Sig : 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).
      It := List_Iterate_Safe (Driver_List);
      while Is_Valid (It) loop
         El := Get_Element (It);
         if Trace_Drivers then
            Put_Line (' ' & Disp_Node (El));
         end if;

         Mark (Marker, Expr_Pool);
         --  The signal name is evaluated twice, but as it is globally static,
         --  it shouldn't have any side-effect.  So not optimized but safe.
         Sig := Execute_Signal_Name (Instance, El, Signal_Sig);
         Val := Execute_Signal_Name (Instance, El, Signal_Init);
         Add_Source (Instance, Sig, Val);
         Release (Marker, Expr_Pool);

         Next (It);
      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 Register_Sensitivity
     (Instance : Block_Instance_Acc; List : Iir_List)
   is
      It : List_Iterator;
      Sig : Iir;
      Marker : Mark_Type;
   begin
      It := List_Iterate (List);
      while Is_Valid (It) loop
         Sig := Get_Element (It);
         Mark (Marker, Expr_Pool);
         Process_Add_Sensitivity (Execute_Name (Instance, Sig, True));
         Release (Marker, Expr_Pool);
         Next (It);
      end loop;
   end Register_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.
               Register_Sensitivity (Instance, Get_Sensitivity_List (El));

            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;

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

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

   type PSL_Entry_Acc is access all PSL_Entry;
   function To_PSL_Entry_Acc is new Ada.Unchecked_Conversion
     (Grt.Processes.Instance_Acc, PSL_Entry_Acc);

   function Execute_Psl_Expr (Instance : Block_Instance_Acc;
                              Expr : PSL_Node;
                              Eos : Boolean)
                             return Boolean
   is
      use PSL.Nodes;
   begin
      case Get_Kind (Expr) is
         when N_HDL_Expr =>
            declare
               E : constant Iir := Get_HDL_Node (Expr);
               Rtype : constant Iir := Get_Base_Type (Get_Type (E));
               Res   : Iir_Value_Literal_Acc;
            begin
               Res := Execute_Expression (Instance, E);
               if Rtype = Vhdl.Std_Package.Boolean_Type_Definition then
                  return Res.B1 = True;
               elsif Rtype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then
                  return Res.E8 = 3 or Res.E8 = 7; --  1 or H
               else
                  Error_Kind ("execute_psl_expr", Expr);
               end if;
            end;
         when N_True =>
            return True;
         when N_EOS =>
            return Eos;
         when N_Not_Bool =>
            return not Execute_Psl_Expr (Instance, Get_Boolean (Expr), Eos);
         when N_And_Bool =>
            return Execute_Psl_Expr (Instance, Get_Left (Expr), Eos)
              and Execute_Psl_Expr (Instance, Get_Right (Expr), Eos);
         when N_Or_Bool =>
            return Execute_Psl_Expr (Instance, Get_Left (Expr), Eos)
              or Execute_Psl_Expr (Instance, Get_Right (Expr), Eos);
         when others =>
            Error_Kind ("execute_psl_expr", Expr);
      end case;
   end Execute_Psl_Expr;

   procedure PSL_Process_Executer (Self : Grt.Processes.Instance_Acc)
   is
      use PSL.NFAs;

      E : constant PSL_Entry_Acc := To_PSL_Entry_Acc (Self);
      Nvec : Boolean_Vector (E.States.all'Range);
      Marker : Mark_Type;
      V : Boolean;

      NFA : PSL_NFA;
      S : NFA_State;
      S_Num : Nat32;
      Ed : NFA_Edge;
      Sd : NFA_State;
      Sd_Num : Nat32;
   begin
      --  Exit now if already covered (never set for assertion).
      if E.Done then
         return;
      end if;

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

      Mark (Marker, Expr_Pool);
      V := Execute_Psl_Expr (E.Instance, Get_PSL_Clock (E.Stmt), False);
      Release (Marker, Expr_Pool);
      if V then
         Nvec := (others => False);
         case Get_Kind (E.Stmt) is
            when Iir_Kind_Psl_Cover_Statement
              | Iir_Kind_Psl_Endpoint_Declaration =>
               Nvec (0) := True;
            when others =>
               null;
         end case;

         --  For each state: if set, evaluate all outgoing edges.
         NFA := Get_PSL_NFA (E.Stmt);
         S := Get_First_State (NFA);
         while S /= No_State loop
            S_Num := Get_State_Label (S);

            if E.States (S_Num) then
               Ed := Get_First_Src_Edge (S);
               while Ed /= No_Edge loop
                  Sd := Get_Edge_Dest (Ed);
                  Sd_Num := Get_State_Label (Sd);

                  if not Nvec (Sd_Num) then
                     Mark (Marker, Expr_Pool);
                     V := Execute_Psl_Expr
                       (E.Instance, Get_Edge_Expr (Ed), False);
                     Release (Marker, Expr_Pool);
                     if V then
                        Nvec (Sd_Num) := True;
                     end if;
                  end if;

                  Ed := Get_Next_Src_Edge (Ed);
               end loop;
            end if;

            S := Get_Next_State (S);
         end loop;

         --  Check fail state.
         S := Get_Final_State (NFA);
         S_Num := Get_State_Label (S);
         pragma Assert (S_Num = Get_PSL_Nbr_States (E.Stmt) - 1);
         case Get_Kind (E.Stmt) is
            when Iir_Kind_Psl_Assert_Statement =>
               if Nvec (S_Num) then
                  Execute_Failed_Assertion
                    (E.Instance, "psl assertion", E.Stmt,
                     "assertion violation", 2);
               end if;
            when Iir_Kind_Psl_Cover_Statement =>
               if Nvec (S_Num) then
                  if Get_Report_Expression (E.Stmt) /= Null_Iir then
                     Execute_Failed_Assertion
                       (E.Instance, "psl cover", E.Stmt,
                        "sequence covered", 0);
                  end if;
                  E.Done := True;
               end if;
            when Iir_Kind_Psl_Endpoint_Declaration =>
               declare
                  Info : constant Sim_Info_Acc := Get_Info (E.Stmt);
               begin
                  E.Instance.Objects (Info.Slot).B1 := Ghdl_B1 (Nvec (S_Num));
               end;
            when others =>
               Error_Kind ("PSL_Process_Executer", E.Stmt);
         end case;

         E.States.all := Nvec;
      end if;

      Instance_Pool := null;
      Current_Process := null;
   end PSL_Process_Executer;

   procedure PSL_Assert_Finalizer (Self : Grt.Processes.Instance_Acc)
   is
      use PSL.NFAs;
      Ent : constant PSL_Entry_Acc := To_PSL_Entry_Acc (Self);

      NFA : constant PSL_NFA := Get_PSL_NFA (Ent.Stmt);
      S : NFA_State;
      E : NFA_Edge;
      Sd : NFA_State;
      S_Num : Int32;
   begin
      S := Get_Final_State (NFA);
      E := Get_First_Dest_Edge (S);
      while E /= No_Edge loop
         Sd := Get_Edge_Src (E);

         if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then

            S_Num := Get_State_Label (Sd);

            if Ent.States (S_Num)
              and then
              Execute_Psl_Expr (Ent.Instance, Get_Edge_Expr (E), True)
            then
               Execute_Failed_Assertion
                 (Ent.Instance, "psl assertion", Ent.Stmt,
                  "assertion violation", 2);
               exit;
            end if;
         end if;

         E := Get_Next_Dest_Edge (E);
      end loop;
   end PSL_Assert_Finalizer;

   procedure Create_PSL is
   begin
      for I in PSL_Table.First .. PSL_Table.Last loop
         declare
            E : PSL_Entry renames PSL_Table.Table (I);
         begin
            --  Create the vector.
            E.States := new Boolean_Vector'
              (0 .. Get_PSL_Nbr_States (E.Stmt) - 1 => False);
            E.States (0) := True;

            Grt.Processes.Ghdl_Process_Register
              (To_Instance_Acc (E'Address), PSL_Process_Executer'Access,
               null, System.Null_Address);

            Register_Sensitivity
              (E.Instance, Get_PSL_Clock_Sensitivity (E.Stmt));

            case Get_Kind (E.Stmt) is
               when Iir_Kind_Psl_Assert_Statement =>
                  if Get_PSL_EOS_Flag (E.Stmt) then
                     Grt.Processes.Ghdl_Finalize_Register
                       (To_Instance_Acc (E'Address),
                        PSL_Assert_Finalizer'Access);
                  end if;
               when Iir_Kind_Psl_Cover_Statement =>
                  --  TODO
                  null;
               when others =>
                  null;
            end case;
         end;
      end loop;

      --  Finalizer ?
   end Create_PSL;

   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_E8 =>
                  Val.E8 := 0;
                  return Create_Signal_Value
                    (Grt.Signals.Ghdl_Create_Signal_E8
                       (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_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_Instance =>
            raise Internal_Error;
      end case;
   end Create_Shadow_Signal;

   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;

   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 Iir_Value_E8 =>
            if Mode = Connect_Source then
               raise Internal_Error;
            end if;
            Grt.Signals.Ghdl_Signal_Associate_E8 (Port.Sig, Sig.E8);
         when others =>
            raise Internal_Error;
      end case;
   end Connect;

   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;
      Inter : Iir;
      Assoc : Iir_Association_Element_By_Expression)
   is
      pragma Unreferenced (Formal_Instance);
      Formal : constant Iir := Get_Formal (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_Formal_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_Actual_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 => 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.Inter, E.Assoc);
         end;
      end loop;

      Instance_Pool := null;
   end Create_Connects;

   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;

   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_It : List_Iterator;
      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);
      Dep_It := List_Iterate (Dep_List);
      while Is_Valid (Dep_It) loop
         Dep := Get_Element (Dep_It);
         Add_Guard_Sensitivity (Execute_Name (Instance, Dep, True));
         Next (Dep_It);
      end loop;

      --  FIXME: free mem
   end Create_Guard_Signal;

   procedure Create_Implicit_Signal (Sig : Iir_Value_Literal_Acc;
                                     Val : Iir_Value_Literal_Acc;
                                     Time : Std_Time;
                                     Prefix : Iir_Value_Literal_Acc;
                                     Kind : Mode_Signal_Type)
   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 Mode_Stable =>
            Sig.Sig := Grt.Signals.Ghdl_Create_Stable_Signal
              (To_Ghdl_Value_Ptr (Val.B1'Address), Time);
         when Mode_Quiet =>
            Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal
              (To_Ghdl_Value_Ptr (Val.B1'Address), Time);
         when Mode_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 Iir_Value_Scalars (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 Iir_Value_E8 =>
                  Val_Ptr := To_Ghdl_Value_Ptr (Val.E8'Address);
            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;
                                 Mode : Mode_Signal_Type;
                                 Signal: Iir;
                                 Sig : Iir_Value_Literal_Acc;
                                 Val : Iir_Value_Literal_Acc)
   is
      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
                  List : constant Iir_Flist := Get_Elements_Declaration_List
                    (Get_Base_Type (Sig_Type));
                  El : Iir_Element_Declaration;
               begin
                  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_E8 =>
               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E8
                 (To_Ghdl_Value_Ptr (Val.E8'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_Instance =>
               raise Internal_Error;
         end case;
      end Create_Signal;

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

      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
      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 Mode_Guard =>
                  Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl);
               when Mode_Stable | Mode_Quiet | Mode_Transaction =>
                  Create_Implicit_Signal
                    (E.Sig, E.Val, E.Time, E.Prefix, E.Kind);
               when Mode_Delayed =>
                  Create_Delayed_Signal (E.Sig, E.Val, E.Prefix, E.Time);
               when Mode_Signal_User =>
                  Create_User_Signal
                    (E.Instance, E.Kind, E.Decl, E.Sig, E.Val);
               when Mode_Conv_In | Mode_Conv_Out | Mode_End =>
                  raise Internal_Error;
            end case;
         end;
      end loop;
   end Create_Signals;

   procedure Ghdl_Elaborate is
   begin
      Elaboration.Elaborate_Design (Top_Config);

      if Disp_Stats then
         Disp_Design_Stats;
      end if;

      if Disp_Ams then
         Debugger.AMS.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;
      Create_PSL;

      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
      use Grt.Errors;
      Stop : Boolean;
      Status : Integer;
   begin
      Break_Time := Std_Time'Last;

      Top_Config := Top_Conf;

      Grt.Errors.Error_Hook := Debug_Error'Access;

      if Flag_Interractive then
         Debug (Reason_Start);
      end if;

      Grt.Main.Run_Elab (Stop);
      if Stop then
         return;
      end if;

      Status := Grt.Main.Run_Through_Longjump
        (Grt.Processes.Simulation_Init'Access);

      if Status = 0 then
         loop
            Status := Grt.Main.Run_Through_Longjump
              (Grt.Processes.Simulation_Cycle'Access);
            exit when Status < 0 or Status = Run_Stop or Status = Run_Finished;

            if Grt.Processes.Next_Time >= Break_Time
              and then Break_Time /= Std_Time'Last
            then
               Debug (Reason_Time);
            end if;

            exit when Grt.Processes.Has_Simulation_Timeout;
         end loop;
      end if;

      Grt.Processes.Simulation_Finish;

      Grt.Main.Run_Finish (Status);
   exception
      when Debugger_Quit =>
         null;
      when Simulation_Finished =>
         null;
   end Simulation_Entity;
end Simul.Simulation.Main;