vhdl/simulate/simul-execution.adb

--  Interpreted simulation
--  Copyright (C) 2014 Tristan Gingold
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 2 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program.  If not, see <gnu.org/licenses>.

with System;
with Ada.Unchecked_Conversion;
with Simple_IO; use Simple_IO;
with Types; use Types;
with Grt.Types; use Grt.Types;
with Flags; use Flags;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package;
with Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
with Name_Table;
with Simul.File_Operation;
with Simul.Debugger; use Simul.Debugger;
with Std_Names;
with Str_Table;
with Files_Map;
with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
with Simul.Simulation; use Simul.Simulation;
with Grt.Astdio.Vhdl;
with Grt.Stdio;
with Grt.Options;
with Grt.Vstrings;
with Grt.To_Strings;
with Simul.Grt_Interface;
with Grt.Values;
with Grt.Errors;
with Grt.Std_Logic_1164;
with Grt.Lib;
with Grt.Strings;
with Vhdl.Sem_Inst;

package body Simul.Execution is

   function Execute_Function_Call
     (Block: Block_Instance_Acc; Expr: Iir; Imp : Iir)
     return Iir_Value_Literal_Acc;

   procedure Finish_Sequential_Statements
     (Proc : Process_State_Acc; Complex_Stmt : Iir);
   procedure Init_Sequential_Statements
     (Proc : Process_State_Acc; Complex_Stmt : Iir);
   procedure Update_Next_Statement (Proc : Process_State_Acc);

   -- Display a message when an assertion has failed.
   procedure Execute_Failed_Assertion (Msg : String;
                                       Report : String;
                                       Severity : Natural;
                                       Stmt: Iir);

   function Get_Instance_By_Scope
     (Instance: Block_Instance_Acc; Scope: Sim_Info_Acc)
     return Block_Instance_Acc is
   begin
      case Scope.Kind is
         when Kind_Block
           | Kind_Frame
           | Kind_Process =>
            declare
               Current : Block_Instance_Acc;
            begin
               Current := Instance;
               while Current /= null loop
                  if Current.Block_Scope = Scope then
                     return Current;
                  end if;
                  Current := Current.Up_Block;
               end loop;
               raise Internal_Error;
            end;
         when Kind_Protected =>
            declare
               Current : Block_Instance_Acc;
            begin
               Current := Instance;
               while Current /= null loop
                  if Current.Block_Scope = Scope
                    or Current.Uninst_Scope = Scope
                  then
                     return Current;
                  end if;
                  Current := Current.Up_Block;
               end loop;
               raise Internal_Error;
            end;
         when Kind_Package =>
            if Scope.Pkg_Parent = null then
               --  This is a scope for an uninstantiated package.
               declare
                  Current : Block_Instance_Acc;
               begin
                  Current := Instance;
                  while Current /= null loop
                     if Current.Uninst_Scope = Scope then
                        return Current;
                     end if;
                     Current := Current.Up_Block;
                  end loop;
                  raise Internal_Error;
               end;
            else
               --  Instantiated package.
               declare
                  Parent : Block_Instance_Acc;
               begin
                  Parent := Get_Instance_By_Scope (Instance, Scope.Pkg_Parent);
                  return Parent.Objects (Scope.Pkg_Slot).Instance;
               end;
            end if;
         when others =>
            raise Internal_Error;
      end case;
   end Get_Instance_By_Scope;

   function Get_Instance_Object (Instance: Block_Instance_Acc; Obj : Iir)
                                return Iir_Value_Literal_Acc
   is
      Info : constant Sim_Info_Acc := Get_Info (Obj);
      Obj_Inst : Block_Instance_Acc;
   begin
      Obj_Inst := Get_Instance_By_Scope (Instance, Info.Obj_Scope);
      return Obj_Inst.Objects (Info.Slot);
   end Get_Instance_Object;

   function Get_Info_For_Scope (Scope : Iir) return Sim_Info_Acc is
   begin
      --  The info for an architecture is in fact the entity.
      if Get_Kind (Scope) = Iir_Kind_Architecture_Body then
         return Get_Info (Get_Entity (Scope));
      else
         return Get_Info (Scope);
      end if;
   end Get_Info_For_Scope;

   procedure Create_Right_Bound_From_Length
     (Bounds : Iir_Value_Literal_Acc; Len : Iir_Index32) is
   begin
      pragma Assert (Bounds.Right = null);

      case Bounds.Left.Kind is
         when Iir_Value_E32 =>
            declare
               R : Ghdl_E32;
            begin
               case Bounds.Dir is
                  when Dir_To =>
                     R := Bounds.Left.E32 + Ghdl_E32 (Len - 1);
                  when Dir_Downto =>
                     R := Bounds.Left.E32 - Ghdl_E32 (Len - 1);
               end case;
               Bounds.Right := Create_E32_Value (R);
            end;
         when Iir_Value_I64 =>
            declare
               R : Ghdl_I64;
            begin
               case Bounds.Dir is
                  when Dir_To =>
                     R := Bounds.Left.I64 + Ghdl_I64 (Len - 1);
                  when Dir_Downto =>
                     R := Bounds.Left.I64 - Ghdl_I64 (Len - 1);
               end case;
               Bounds.Right := Create_I64_Value (R);
            end;
         when others =>
            raise Internal_Error;
      end case;
   end Create_Right_Bound_From_Length;

   function Create_Bounds_From_Length (Block : Block_Instance_Acc;
                                       Atype : Iir;
                                       Len : Iir_Index32)
                                      return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
      Index_Bounds : Iir_Value_Literal_Acc;
   begin
      Index_Bounds := Execute_Bounds (Block, Atype);

      Res := Create_Range_Value (Left => Index_Bounds.Left,
                                 Right => null,
                                 Dir => Index_Bounds.Dir,
                                 Length => Len);

      if Len = 0 then
         --  Special case.
         Res.Right := Res.Left;
         case Res.Left.Kind is
            when Iir_Value_I64 =>
               case Index_Bounds.Dir is
                  when Dir_To =>
                     Res.Left := Create_I64_Value (Res.Right.I64 + 1);
                  when Dir_Downto =>
                     Res.Left := Create_I64_Value (Res.Right.I64 - 1);
               end case;
            when others =>
               raise Internal_Error;
         end case;
      else
         Create_Right_Bound_From_Length (Res, Len);
      end if;
      return Res;
   end Create_Bounds_From_Length;

   function Execute_High_Limit (Bounds : Iir_Value_Literal_Acc)
                                return Iir_Value_Literal_Acc is
   begin
      if Bounds.Dir = Dir_To then
         return Bounds.Right;
      else
         return Bounds.Left;
      end if;
   end Execute_High_Limit;

   function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc)
                               return Iir_Value_Literal_Acc is
   begin
      if Bounds.Dir = Dir_To then
         return Bounds.Left;
      else
         return Bounds.Right;
      end if;
   end Execute_Low_Limit;

   function Execute_Left_Limit (Bounds : Iir_Value_Literal_Acc)
                                return Iir_Value_Literal_Acc is
   begin
      return Bounds.Left;
   end Execute_Left_Limit;

   function Execute_Right_Limit (Bounds : Iir_Value_Literal_Acc)
                                 return Iir_Value_Literal_Acc is
   begin
      return Bounds.Right;
   end Execute_Right_Limit;

   function Execute_Length (Bounds : Iir_Value_Literal_Acc)
                           return Iir_Value_Literal_Acc is
   begin
      return Create_I64_Value (Ghdl_I64 (Bounds.Length));
   end Execute_Length;

   function Create_Enum_Value (Pos : Natural; Etype : Iir)
                              return Iir_Value_Literal_Acc
   is
      Base_Type : constant Iir := Get_Base_Type (Etype);
      Kind : constant Kind_Enum_Types := Get_Info (Base_Type).Kind;
   begin
      case Kind is
         when Kind_E8_Type
           | Kind_Log_Type =>
            return Create_E8_Value (Ghdl_E8 (Pos));
         when Kind_E32_Type =>
            return Create_E32_Value (Ghdl_E32 (Pos));
         when Kind_Bit_Type =>
            return Create_B1_Value (Ghdl_B1'Val (Pos));
      end case;
   end Create_Enum_Value;

   function String_To_Iir_Value (Str : String) return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      Res := Create_Array_Value (Str'Length, 1);
      Res.Bounds.D (1) := Create_Range_Value
        (Create_I64_Value (1),
         Create_I64_Value (Str'Length),
         Dir_To);
      for I in Str'Range loop
         Res.Val_Array.V (1 + Iir_Index32 (I - Str'First)) :=
           Create_E8_Value (Character'Pos (Str (I)));
      end loop;
      return Res;
   end String_To_Iir_Value;

   function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc;
                                     Expr_Type : Iir)
                                    return String
   is
   begin
      case Get_Kind (Expr_Type) is
         when Iir_Kind_Floating_Type_Definition
           | Iir_Kind_Floating_Subtype_Definition =>
            declare
               Str : String (1 .. 24);
               Last : Natural;
            begin
               Grt.To_Strings.To_String (Str, Last, Val.F64);
               return Str (Str'First .. Last);
            end;
         when Iir_Kind_Integer_Type_Definition
           | Iir_Kind_Integer_Subtype_Definition =>
            declare
               Str : String (1 .. 21);
               First : Natural;
            begin
               Grt.To_Strings.To_String (Str, First, Val.I64);
               return Str (First .. Str'Last);
            end;
         when Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Enumeration_Subtype_Definition =>
            declare
               Lits : constant Iir_Flist :=
                 Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type));
               Pos : Natural;
            begin
               case Iir_Value_Enums (Val.Kind) is
                  when Iir_Value_B1 =>
                     Pos := Ghdl_B1'Pos (Val.B1);
                  when Iir_Value_E8 =>
                     Pos := Ghdl_E8'Pos (Val.E8);
                  when Iir_Value_E32 =>
                     Pos := Ghdl_E32'Pos (Val.E32);
               end case;
               return Name_Table.Image
                 (Get_Identifier (Get_Nth_Element (Lits, Pos)));
            end;
         when Iir_Kind_Physical_Type_Definition
           | Iir_Kind_Physical_Subtype_Definition =>
            declare
               Str : String (1 .. 21);
               First : Natural;
               Id : constant Name_Id :=
                 Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type)));
            begin
               Grt.To_Strings.To_String (Str, First, Val.I64);
               return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id);
            end;
         when others =>
            Error_Kind ("execute_image_attribute", Expr_Type);
      end case;
   end Execute_Image_Attribute;

   function Execute_Image_Attribute (Block: Block_Instance_Acc; Expr: Iir)
                                    return Iir_Value_Literal_Acc
   is
      Val : Iir_Value_Literal_Acc;
      Attr_Type : constant Iir := Get_Type (Get_Prefix (Expr));
   begin
      Val := Execute_Expression (Block, Get_Parameter (Expr));
      return String_To_Iir_Value
        (Execute_Image_Attribute (Val, Attr_Type));
   end Execute_Image_Attribute;

   function Execute_Path_Instance_Name_Attribute
     (Block : Block_Instance_Acc; Attr : Iir) return Iir_Value_Literal_Acc
   is
      use Vhdl.Evaluation;
      use Grt.Vstrings;
      use Name_Table;

      Name : constant Path_Instance_Name_Type :=
        Get_Path_Instance_Name_Suffix (Attr);
      Instance : Block_Instance_Acc;
      Rstr : Rstring;
      Is_Instance : constant Boolean :=
        Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute;
   begin
      if Name.Path_Instance = Null_Iir then
         return String_To_Iir_Value (Name.Suffix);
      end if;

      Instance := Get_Instance_By_Scope
        (Block, Get_Info_For_Scope (Name.Path_Instance));

      loop
         case Get_Kind (Instance.Label) is
            when Iir_Kind_Entity_Declaration =>
               if Instance.Parent = null then
                  Prepend (Rstr, Image (Get_Identifier (Instance.Label)));
                  exit;
               end if;
            when Iir_Kind_Architecture_Body =>
               if Is_Instance then
                  Prepend (Rstr, ')');
                  Prepend (Rstr, Image (Get_Identifier (Instance.Label)));
                  Prepend (Rstr, '(');
               end if;

               if Is_Instance or else Instance.Parent = null then
                  Prepend
                    (Rstr,
                     Image (Get_Identifier (Get_Entity (Instance.Label))));
               end if;
               if Instance.Parent = null then
                  Prepend (Rstr, ':');
                  exit;
               else
                  Instance := Instance.Parent;
               end if;
            when Iir_Kind_Block_Statement =>
               Prepend (Rstr, Image (Get_Label (Instance.Label)));
               Prepend (Rstr, ':');
               Instance := Instance.Parent;
            when Iir_Kind_Iterator_Declaration =>
               declare
                  Val : Iir_Value_Literal_Acc;
               begin
                  Val := Execute_Name (Instance, Instance.Label);
                  Prepend (Rstr, ')');
                  Prepend (Rstr, Execute_Image_Attribute
                             (Val, Get_Type (Instance.Label)));
                  Prepend (Rstr, '(');
               end;
               Instance := Instance.Parent;
            when Iir_Kind_Generate_Statement_Body =>
               Prepend (Rstr, Image (Get_Label (Get_Parent (Instance.Label))));
               Prepend (Rstr, ':');
               Instance := Instance.Parent;
            when Iir_Kind_Component_Instantiation_Statement =>
               if Is_Instance then
                  Prepend (Rstr, '@');
               end if;
               Prepend (Rstr, Image (Get_Label (Instance.Label)));
               Prepend (Rstr, ':');
               Instance := Instance.Parent;
            when others =>
               Error_Kind ("Execute_Path_Instance_Name_Attribute",
                           Instance.Label);
         end case;
      end loop;
      declare
         Str1 : String (1 .. Length (Rstr));
         Len1 : Natural;
      begin
         Copy (Rstr, Str1, Len1);
         Free (Rstr);
         return String_To_Iir_Value (Str1 & ':' & Name.Suffix);
      end;
   end Execute_Path_Instance_Name_Attribute;

   function Execute_Shift_Operator (Left : Iir_Value_Literal_Acc;
                                    Count : Ghdl_I64;
                                    Expr : Iir)
                                   return Iir_Value_Literal_Acc
   is
      Func : constant Iir_Predefined_Shift_Functions :=
        Get_Implicit_Definition (Get_Implementation (Expr));
      Cnt : Iir_Index32;
      Len : constant Iir_Index32 := Left.Bounds.D (1).Length;
      Dir_Left : Boolean;
      P : Iir_Index32;
      Res : Iir_Value_Literal_Acc;
      E : Iir_Value_Literal_Acc;
   begin
      --  LRM93 7.2.3
      --  That is, if R is 0 or if L is a null array, the return value is L.
      if Count = 0 or else Len = 0 then
         return Left;
      end if;

      case Func is
         when Iir_Predefined_Array_Sll
           | Iir_Predefined_Array_Sla
           | Iir_Predefined_Array_Rol =>
            Dir_Left := True;
         when Iir_Predefined_Array_Srl
           | Iir_Predefined_Array_Sra
           | Iir_Predefined_Array_Ror =>
            Dir_Left := False;
      end case;
      if Count < 0 then
         Cnt := Iir_Index32 (-Count);
         Dir_Left := not Dir_Left;
      else
         Cnt := Iir_Index32 (Count);
      end if;

      case Func is
         when Iir_Predefined_Array_Sll
           | Iir_Predefined_Array_Srl =>
            E := Create_Enum_Value
              (0, Get_Element_Subtype (Get_Base_Type (Get_Type (Expr))));
         when Iir_Predefined_Array_Sla
           | Iir_Predefined_Array_Sra =>
            if Dir_Left then
               E := Left.Val_Array.V (Len);
            else
               E := Left.Val_Array.V (1);
            end if;
         when Iir_Predefined_Array_Rol
           | Iir_Predefined_Array_Ror =>
            Cnt := Cnt mod Len;
            if not Dir_Left then
               Cnt := (Len - Cnt) mod Len;
            end if;
      end case;

      Res := Create_Array_Value (1);
      Res.Bounds.D (1) := Left.Bounds.D (1);
      Create_Array_Data (Res, Len);
      P := 1;

      case Func is
         when Iir_Predefined_Array_Sll
           | Iir_Predefined_Array_Srl
           | Iir_Predefined_Array_Sla
           | Iir_Predefined_Array_Sra =>
            if Dir_Left then
               if Cnt < Len then
                  for I in Cnt .. Len - 1 loop
                     Res.Val_Array.V (P) := Left.Val_Array.V (I + 1);
                     P := P + 1;
                  end loop;
               else
                  Cnt := Len;
               end if;
               for I in 0 .. Cnt - 1 loop
                  Res.Val_Array.V (P) := E;
                  P := P + 1;
               end loop;
            else
               if Cnt > Len then
                  Cnt := Len;
               end if;
               for I in 0 .. Cnt - 1 loop
                  Res.Val_Array.V (P) := E;
                  P := P + 1;
               end loop;
               for I in Cnt .. Len - 1 loop
                  Res.Val_Array.V (P) := Left.Val_Array.V (I - Cnt + 1);
                  P := P + 1;
               end loop;
            end if;
         when Iir_Predefined_Array_Rol
           | Iir_Predefined_Array_Ror =>
            for I in 1 .. Len loop
               Res.Val_Array.V (P) := Left.Val_Array.V (Cnt + 1);
               P := P + 1;
               Cnt := Cnt + 1;
               if Cnt = Len then
                  Cnt := 0;
               end if;
            end loop;
      end case;
      return Res;
   end Execute_Shift_Operator;

   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
     "0123456789ABCDEF";

   function Execute_Bit_Vector_To_String (Val : Iir_Value_Literal_Acc;
                                          Log_Base : Natural)
                                         return Iir_Value_Literal_Acc
   is
      Base : constant Natural := 2 ** Log_Base;
      Blen : constant Natural := Natural (Val.Bounds.D (1).Length);
      Str : String (1 .. (Blen + Log_Base - 1) / Log_Base);
      Pos : Natural;
      V : Natural;
      N : Natural;
   begin
      V := 0;
      N := 1;
      Pos := Str'Last;
      for I in reverse Val.Val_Array.V'Range loop
         V := V + Ghdl_B1'Pos (Val.Val_Array.V (I).B1) * N;
         N := N * 2;
         if N = Base or else I = Val.Val_Array.V'First then
            Str (Pos) := Hex_Chars (V);
            Pos := Pos - 1;
            N := 1;
            V := 0;
         end if;
      end loop;
      return String_To_Iir_Value (Str);
   end Execute_Bit_Vector_To_String;

   procedure Assert_Std_Ulogic_Dc (Loc : Iir)
   is
   begin
      Execute_Failed_Assertion
        ("assertion",
         "STD_LOGIC_1164: '-' operand for matching ordering operator",
         1, Loc);
   end Assert_Std_Ulogic_Dc;

   procedure Check_Std_Ulogic_Dc (Loc : Iir; V : Grt.Std_Logic_1164.Std_Ulogic)
   is
      use Grt.Std_Logic_1164;
   begin
      if V = '-' then
         Assert_Std_Ulogic_Dc (Loc);
      end if;
   end Check_Std_Ulogic_Dc;

   --  EXPR is the expression whose implementation is an implicit function.
   function Execute_Implicit_Function (Block : Block_Instance_Acc;
                                       Expr: Iir;
                                       Left_Param : Iir;
                                       Right_Param : Iir;
                                       Res_Type : Iir)
                                      return Iir_Value_Literal_Acc
   is
      pragma Unsuppress (Overflow_Check);

      Imp : constant Iir := Strip_Denoting_Name (Get_Implementation (Expr));
      Func : constant Iir_Predefined_Functions :=
        Get_Implicit_Definition (Imp);

      --  Rename definition for monadic operations.
      Left, Right: Iir_Value_Literal_Acc;
      Operand : Iir_Value_Literal_Acc renames Left;
      Result: Iir_Value_Literal_Acc;

      procedure Eval_Right is
      begin
         Right := Execute_Expression (Block, Right_Param);
      end Eval_Right;

      --  Eval right argument, check left and right have same length,
      --  Create RESULT from left.
      procedure Eval_Array is
      begin
         Eval_Right;
         if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then
            Error_Msg_Constraint (Expr);
         end if;
         --  Need to copy as the result is modified.
         Result := Unshare (Left, Expr_Pool'Access);
      end Eval_Array;
   begin
      --  Eval left operand.
      case Func is
         when Iir_Predefined_Now_Function =>
            Left := null;
         when Iir_Predefined_Bit_Rising_Edge
           | Iir_Predefined_Boolean_Rising_Edge
           | Iir_Predefined_Bit_Falling_Edge
           | Iir_Predefined_Boolean_Falling_Edge=>
            Operand := Execute_Name (Block, Left_Param, True);
         when others =>
            Left := Execute_Expression (Block, Left_Param);
      end case;
      Right := null;

      case Func is
         when Iir_Predefined_Error =>
            raise Internal_Error;

         when Iir_Predefined_Array_Array_Concat
           | Iir_Predefined_Element_Array_Concat
           | Iir_Predefined_Array_Element_Concat
           | Iir_Predefined_Element_Element_Concat =>
            Eval_Right;

            declare
               --  Type of the index.
               Idx_Type : constant Iir :=
                 Get_Nth_Element (Get_Index_Subtype_List (Res_Type), 0);

               -- Array length of the result.
               Len: Iir_Index32;

               -- Index into the result.
               Pos: Iir_Index32;
            begin
               -- Compute the length of the result.
               case Func is
                  when Iir_Predefined_Array_Array_Concat =>
                     Len := Left.Val_Array.Len + Right.Val_Array.Len;
                  when Iir_Predefined_Element_Array_Concat =>
                     Len := 1 + Right.Val_Array.Len;
                  when Iir_Predefined_Array_Element_Concat =>
                     Len := Left.Val_Array.Len + 1;
                  when Iir_Predefined_Element_Element_Concat =>
                     Len := 1 + 1;
                  when others =>
                     raise Program_Error;
               end case;

               if Func = Iir_Predefined_Array_Array_Concat
                 and then Left.Val_Array.Len = 0
               then
                  if Flags.Vhdl_Std = Vhdl_87 then
                     --  LRM87 7.2.3
                     --  [...], unless the left operand is a null array, in
                     --  which case the result of the concatenation is the
                     --  right operand.
                     return Right;
                  else
                     --  LRM93 7.2.4
                     --  If both operands are null arrays, then the result of
                     --  the concatenation is the right operand.
                     if Right.Val_Array.Len = 0 then
                        return Right;
                     end if;
                  end if;
               end if;

               if Flags.Vhdl_Std = Vhdl_87
                 and then (Func = Iir_Predefined_Array_Array_Concat
                             or Func = Iir_Predefined_Array_Element_Concat)
               then
                  --  LRM87 7.2.3 Adding Operators
                  --  The left bound if this result is the left bound of the
                  --  left operand, [...].  The direction of the result is the
                  --  direction of the left operand, unless the left operand
                  --  is a null array, in which case the direction of the
                  --  result is that of the right operand.
                  Result := Create_Array_Value (Len, 1);
                  Result.Bounds.D (1) := Create_Range_Value
                    (Left.Bounds.D (1).Left, null, Left.Bounds.D (1).Dir, Len);
                  Create_Right_Bound_From_Length (Result.Bounds.D (1), Len);
               else
                  --  Create the array result.
                  Result := Create_Array_Value (Len, 1);
                  Result.Bounds.D (1) := Create_Bounds_From_Length
                    (Block, Idx_Type, Len);
               end if;
               Check_Range_Constraints
                 (Block, Result.Bounds.D (1), Idx_Type, Expr);

               -- Fill the result: left.
               case Func is
                  when Iir_Predefined_Array_Array_Concat
                    | Iir_Predefined_Array_Element_Concat =>
                     for I in Left.Val_Array.V'Range loop
                        Result.Val_Array.V (I) := Left.Val_Array.V (I);
                     end loop;
                     Pos := Left.Val_Array.Len;
                  when Iir_Predefined_Element_Array_Concat
                    | Iir_Predefined_Element_Element_Concat =>
                     Result.Val_Array.V (1) := Left;
                     Pos := 1;
                  when others =>
                     raise Program_Error;
               end case;

               -- Note: here POS is equal to the position of the last element
               -- filled, or 0 if no elements were filled.

               --  Fill the result: right.
               case Func is
                  when Iir_Predefined_Array_Array_Concat
                    | Iir_Predefined_Element_Array_Concat =>
                     for I in Right.Val_Array.V'Range loop
                        Result.Val_Array.V (Pos + I) := Right.Val_Array.V (I);
                     end loop;
                  when Iir_Predefined_Array_Element_Concat
                    | Iir_Predefined_Element_Element_Concat =>
                     Result.Val_Array.V (Pos + 1) := Right;
                  when others =>
                     raise Program_Error;
               end case;
            end;

         when Iir_Predefined_Bit_And
           | Iir_Predefined_Boolean_And =>
            if Left.B1 = Lit_Enum_0.B1 then
               --  Short circuit operator.
               Result := Lit_Enum_0;
            else
               Eval_Right;
               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
            end if;
         when Iir_Predefined_Bit_Nand
           | Iir_Predefined_Boolean_Nand =>
            if Left.B1 = Lit_Enum_0.B1 then
               --  Short circuit operator.
               Result := Lit_Enum_1;
            else
               Eval_Right;
               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
            end if;
         when Iir_Predefined_Bit_Or
           | Iir_Predefined_Boolean_Or =>
            if Left.B1 = Lit_Enum_1.B1 then
               --  Short circuit operator.
               Result := Lit_Enum_1;
            else
               Eval_Right;
               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
            end if;
         when Iir_Predefined_Bit_Nor
           | Iir_Predefined_Boolean_Nor =>
            if Left.B1 = Lit_Enum_1.B1 then
               --  Short circuit operator.
               Result := Lit_Enum_0;
            else
               Eval_Right;
               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
            end if;
         when Iir_Predefined_Bit_Xor
           | Iir_Predefined_Boolean_Xor =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.B1 /= Right.B1);
         when Iir_Predefined_Bit_Xnor
           | Iir_Predefined_Boolean_Xnor =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.B1 = Right.B1);
         when Iir_Predefined_Bit_Not
           | Iir_Predefined_Boolean_Not =>
            Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_0.B1);

         when Iir_Predefined_Bit_Condition =>
            Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_1.B1);

         when Iir_Predefined_Array_Sll
           | Iir_Predefined_Array_Srl
           | Iir_Predefined_Array_Sla
           | Iir_Predefined_Array_Sra
           | Iir_Predefined_Array_Rol
           | Iir_Predefined_Array_Ror =>
            Eval_Right;
            Result := Execute_Shift_Operator (Left, Right.I64, Expr);

         when Iir_Predefined_Enum_Equality
           | Iir_Predefined_Integer_Equality
           | Iir_Predefined_Array_Equality
           | Iir_Predefined_Access_Equality
           | Iir_Predefined_Physical_Equality
           | Iir_Predefined_Floating_Equality
           | Iir_Predefined_Record_Equality
           | Iir_Predefined_Bit_Match_Equality
           | Iir_Predefined_Bit_Array_Match_Equality =>
            Eval_Right;
            Result := Boolean_To_Lit (Is_Equal (Left, Right));
         when Iir_Predefined_Enum_Inequality
           | Iir_Predefined_Integer_Inequality
           | Iir_Predefined_Array_Inequality
           | Iir_Predefined_Access_Inequality
           | Iir_Predefined_Physical_Inequality
           | Iir_Predefined_Floating_Inequality
           | Iir_Predefined_Record_Inequality
           | Iir_Predefined_Bit_Match_Inequality
           | Iir_Predefined_Bit_Array_Match_Inequality =>
            Eval_Right;
            Result := Boolean_To_Lit (not Is_Equal (Left, Right));
         when Iir_Predefined_Integer_Less
           | Iir_Predefined_Physical_Less
           | Iir_Predefined_Enum_Less =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) < Equal);
         when Iir_Predefined_Integer_Greater
           | Iir_Predefined_Physical_Greater
           | Iir_Predefined_Enum_Greater =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) > Equal);
         when Iir_Predefined_Integer_Less_Equal
           | Iir_Predefined_Physical_Less_Equal
           | Iir_Predefined_Enum_Less_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) <= Equal);
         when Iir_Predefined_Integer_Greater_Equal
           | Iir_Predefined_Physical_Greater_Equal
           | Iir_Predefined_Enum_Greater_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) >= Equal);

         when Iir_Predefined_Enum_Minimum
           | Iir_Predefined_Physical_Minimum =>
            Eval_Right;
            if Compare_Value (Left, Right) = Less then
               Result := Left;
            else
               Result := Right;
            end if;
         when Iir_Predefined_Enum_Maximum
           | Iir_Predefined_Physical_Maximum =>
            Eval_Right;
            if Compare_Value (Left, Right) = Less then
               Result := Right;
            else
               Result := Left;
            end if;

         when Iir_Predefined_Integer_Plus
           | Iir_Predefined_Physical_Plus =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (Left.I64 + Right.I64);
               when others =>
                  raise Internal_Error;
            end case;
         when Iir_Predefined_Integer_Minus
           | Iir_Predefined_Physical_Minus =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (Left.I64 - Right.I64);
               when others =>
                  raise Internal_Error;
            end case;
         when Iir_Predefined_Integer_Mul =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (Left.I64 * Right.I64);
               when others =>
                  raise Internal_Error;
            end case;
         when Iir_Predefined_Integer_Mod =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  if Right.I64 = 0 then
                     Error_Msg_Constraint (Expr);
                  end if;
                  Result := Create_I64_Value (Left.I64 mod Right.I64);
               when others =>
                  raise Internal_Error;
            end case;
         when Iir_Predefined_Integer_Rem =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  if Right.I64 = 0 then
                     Error_Msg_Constraint (Expr);
                  end if;
                  Result := Create_I64_Value (Left.I64 rem Right.I64);
               when others =>
                  raise Internal_Error;
            end case;
         when Iir_Predefined_Integer_Div =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  if Right.I64 = 0 then
                     Error_Msg_Constraint (Expr);
                  end if;
                  Result := Create_I64_Value (Left.I64 / Right.I64);
               when others =>
                  raise Internal_Error;
            end case;

         when Iir_Predefined_Integer_Absolute
           | Iir_Predefined_Physical_Absolute =>
            case Operand.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (abs Operand.I64);
               when others =>
                  raise Internal_Error;
            end case;

         when Iir_Predefined_Integer_Negation
           | Iir_Predefined_Physical_Negation =>
            case Operand.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (-Operand.I64);
               when others =>
                  raise Internal_Error;
            end case;

         when Iir_Predefined_Integer_Identity
           | Iir_Predefined_Physical_Identity =>
            case Operand.Kind is
               when Iir_Value_I64 =>
                  Result := Create_I64_Value (Operand.I64);
               when others =>
                  raise Internal_Error;
            end case;

         when Iir_Predefined_Integer_Exp =>
            Eval_Right;
            case Left.Kind is
               when Iir_Value_I64 =>
                  if Right.I64 < 0 then
                     Error_Msg_Constraint (Expr);
                  end if;
                  Result := Create_I64_Value (Left.I64 ** Natural (Right.I64));
               when others =>
                  raise Internal_Error;
            end case;

         when Iir_Predefined_Integer_Minimum =>
            Eval_Right;
            Result := Create_I64_Value (Ghdl_I64'Min (Left.I64, Right.I64));
         when Iir_Predefined_Integer_Maximum =>
            Eval_Right;
            Result := Create_I64_Value (Ghdl_I64'Max (Left.I64, Right.I64));

         when Iir_Predefined_Floating_Mul =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 * Right.F64);
         when Iir_Predefined_Floating_Div =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 / Right.F64);
         when Iir_Predefined_Floating_Minus =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 - Right.F64);
         when Iir_Predefined_Floating_Plus =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 + Right.F64);
         when Iir_Predefined_Floating_Exp =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 ** Integer (Right.I64));
         when Iir_Predefined_Floating_Identity =>
            Result := Create_F64_Value (Operand.F64);
         when Iir_Predefined_Floating_Negation =>
            Result := Create_F64_Value (-Operand.F64);
         when Iir_Predefined_Floating_Absolute =>
            Result := Create_F64_Value (abs (Operand.F64));
         when Iir_Predefined_Floating_Less =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.F64 < Right.F64);
         when Iir_Predefined_Floating_Less_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.F64 <= Right.F64);
         when Iir_Predefined_Floating_Greater =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.F64 > Right.F64);
         when Iir_Predefined_Floating_Greater_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Left.F64 >= Right.F64);

         when Iir_Predefined_Floating_Minimum =>
            Eval_Right;
            Result := Create_F64_Value (Ghdl_F64'Min (Left.F64, Right.F64));
         when Iir_Predefined_Floating_Maximum =>
            Eval_Right;
            Result := Create_F64_Value (Ghdl_F64'Max (Left.F64, Right.F64));

         when Iir_Predefined_Integer_Physical_Mul =>
            Eval_Right;
            Result := Create_I64_Value (Left.I64 * Right.I64);
         when Iir_Predefined_Physical_Integer_Mul =>
            Eval_Right;
            Result := Create_I64_Value (Left.I64 * Right.I64);
         when Iir_Predefined_Physical_Physical_Div =>
            Eval_Right;
            Result := Create_I64_Value (Left.I64 / Right.I64);
         when Iir_Predefined_Physical_Integer_Div =>
            Eval_Right;
            Result := Create_I64_Value (Left.I64 / Right.I64);
         when Iir_Predefined_Real_Physical_Mul =>
            Eval_Right;
            Result := Create_I64_Value
              (Ghdl_I64 (Left.F64 * Ghdl_F64 (Right.I64)));
         when Iir_Predefined_Physical_Real_Mul =>
            Eval_Right;
            Result := Create_I64_Value
              (Ghdl_I64 (Ghdl_F64 (Left.I64) * Right.F64));
         when Iir_Predefined_Physical_Real_Div =>
            Eval_Right;
            Result := Create_I64_Value
              (Ghdl_I64 (Ghdl_F64 (Left.I64) / Right.F64));

         when Iir_Predefined_Universal_I_R_Mul =>
            Eval_Right;
            Result := Create_F64_Value (Ghdl_F64 (Left.I64) * Right.F64);
         when Iir_Predefined_Universal_R_I_Mul =>
            Eval_Right;
            Result := Create_F64_Value (Left.F64 * Ghdl_F64 (Right.I64));

         when Iir_Predefined_TF_Array_And =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Array_Nand =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1);
            end loop;
         when Iir_Predefined_TF_Array_Or =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Array_Nor =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1);
            end loop;
         when Iir_Predefined_TF_Array_Xor =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Array_Xnor =>
            Eval_Array;
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1);
            end loop;

         when Iir_Predefined_TF_Array_Element_And =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 and Right.B1;
            end loop;
         when Iir_Predefined_TF_Element_Array_And =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 and Left.B1;
            end loop;

         when Iir_Predefined_TF_Array_Element_Or =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 or Right.B1;
            end loop;
         when Iir_Predefined_TF_Element_Array_Or =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 or Left.B1;
            end loop;

         when Iir_Predefined_TF_Array_Element_Xor =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 xor Right.B1;
            end loop;
         when Iir_Predefined_TF_Element_Array_Xor =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 Result.Val_Array.V (I).B1 xor Left.B1;
            end loop;

         when Iir_Predefined_TF_Array_Element_Nand =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 and Right.B1);
            end loop;
         when Iir_Predefined_TF_Element_Array_Nand =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 and Left.B1);
            end loop;

         when Iir_Predefined_TF_Array_Element_Nor =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 or Right.B1);
            end loop;
         when Iir_Predefined_TF_Element_Array_Nor =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 or Left.B1);
            end loop;

         when Iir_Predefined_TF_Array_Element_Xnor =>
            Eval_Right;
            Result := Unshare (Left, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 xor Right.B1);
            end loop;
         when Iir_Predefined_TF_Element_Array_Xnor =>
            Eval_Right;
            Result := Unshare (Right, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 :=
                 not (Result.Val_Array.V (I).B1 xor Left.B1);
            end loop;

         when Iir_Predefined_TF_Array_Not =>
            --  Need to copy as the result is modified.
            Result := Unshare (Operand, Expr_Pool'Access);
            for I in Result.Val_Array.V'Range loop
               Result.Val_Array.V (I).B1 := not Result.Val_Array.V (I).B1;
            end loop;

         when Iir_Predefined_TF_Reduction_And =>
            Result := Create_B1_Value (True);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 and Operand.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Reduction_Nand =>
            Result := Create_B1_Value (True);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 and Operand.Val_Array.V (I).B1;
            end loop;
            Result.B1 := not Result.B1;
         when Iir_Predefined_TF_Reduction_Or =>
            Result := Create_B1_Value (False);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 or Operand.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Reduction_Nor =>
            Result := Create_B1_Value (False);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 or Operand.Val_Array.V (I).B1;
            end loop;
            Result.B1 := not Result.B1;
         when Iir_Predefined_TF_Reduction_Xor =>
            Result := Create_B1_Value (False);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 xor Operand.Val_Array.V (I).B1;
            end loop;
         when Iir_Predefined_TF_Reduction_Xnor =>
            Result := Create_B1_Value (False);
            for I in Operand.Val_Array.V'Range loop
               Result.B1 := Result.B1 xor Operand.Val_Array.V (I).B1;
            end loop;
            Result.B1 := not Result.B1;

         when Iir_Predefined_Bit_Rising_Edge
           | Iir_Predefined_Boolean_Rising_Edge =>
            return Boolean_To_Lit
              (Execute_Event_Attribute (Operand)
                 and then Execute_Signal_Value (Operand).B1 = True);
         when Iir_Predefined_Bit_Falling_Edge
           | Iir_Predefined_Boolean_Falling_Edge =>
            return Boolean_To_Lit
              (Execute_Event_Attribute (Operand)
                 and then Execute_Signal_Value (Operand).B1 = False);

         when Iir_Predefined_Array_Greater =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) = Greater);

         when Iir_Predefined_Array_Greater_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) >= Equal);

         when Iir_Predefined_Array_Less =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) = Less);

         when Iir_Predefined_Array_Less_Equal =>
            Eval_Right;
            Result := Boolean_To_Lit (Compare_Value (Left, Right) <= Equal);

         when Iir_Predefined_Array_Minimum =>
            Eval_Right;
            if Compare_Value (Left, Right) = Less then
               Result := Left;
            else
               Result := Right;
            end if;
         when Iir_Predefined_Array_Maximum =>
            Eval_Right;
            if Compare_Value (Left, Right) = Less then
               Result := Right;
            else
               Result := Left;
            end if;

         when Iir_Predefined_Vector_Maximum =>
            declare
               El_St : constant Iir :=
                 Get_Return_Type (Get_Implementation (Expr));
               V : Iir_Value_Literal_Acc;
            begin
               Result := Execute_Low_Limit (Execute_Bounds (Block, El_St));
               for I in Left.Val_Array.V'Range loop
                  V := Left.Val_Array.V (I);
                  if Compare_Value (V, Result) = Greater then
                     Result := V;
                  end if;
               end loop;
            end;
         when Iir_Predefined_Vector_Minimum =>
            declare
               El_St : constant Iir :=
                 Get_Return_Type (Get_Implementation (Expr));
               V : Iir_Value_Literal_Acc;
            begin
               Result := Execute_High_Limit (Execute_Bounds (Block, El_St));
               for I in Left.Val_Array.V'Range loop
                  V := Left.Val_Array.V (I);
                  if Compare_Value (V, Result) = Less then
                     Result := V;
                  end if;
               end loop;
            end;

         when Iir_Predefined_Endfile =>
            Result := Boolean_To_Lit (File_Operation.Endfile (Left, Null_Iir));

         when Iir_Predefined_Now_Function =>
            Result := Create_I64_Value (Ghdl_I64 (Grt.Types.Current_Time));

         when Iir_Predefined_Integer_To_String
           | Iir_Predefined_Floating_To_String
           | Iir_Predefined_Physical_To_String =>
            Result := String_To_Iir_Value
              (Execute_Image_Attribute (Left, Get_Type (Left_Param)));

         when Iir_Predefined_Enum_To_String =>
            declare
               use Name_Table;
               Base_Type : constant Iir :=
                 Get_Base_Type (Get_Type (Left_Param));
               Lits : constant Iir_Flist :=
                 Get_Enumeration_Literal_List (Base_Type);
               Pos : constant Natural := Get_Enum_Pos (Left);
               Id : Name_Id;
            begin
               if Base_Type = Vhdl.Std_Package.Character_Type_Definition then
                  Result := String_To_Iir_Value ((1 => Character'Val (Pos)));
               else
                  Id := Get_Identifier (Get_Nth_Element (Lits, Pos));
                  if Is_Character (Id) then
                     Result := String_To_Iir_Value ((1 => Get_Character (Id)));
                  else
                     declare
                        Img : String := Image (Id);
                     begin
                        if Img (Img'First) = '\' then
                           --  Reformat extended identifiers for to_image.
                           pragma Assert (Img (Img'Last) = '\');
                           declare
                              Npos : Natural;
                              K : Natural;
                              C : Character;
                           begin
                              Npos := Img'First;
                              K := Npos + 1;
                              while K < Img'Last loop
                                 C := Img (K);
                                 Img (Npos) := C;
                                 Npos := Npos + 1;
                                 if C = '\' then
                                    K := K + 2;
                                 else
                                    K := K + 1;
                                 end if;
                              end loop;
                              Result := String_To_Iir_Value
                                (Img (Img'First .. Npos - 1));
                           end;
                        else
                           Result := String_To_Iir_Value (Img);
                        end if;
                     end;
                  end if;
               end if;
            end;

         when Iir_Predefined_Array_Char_To_String =>
            declare
               Lits : constant Iir_Flist :=
                 Get_Enumeration_Literal_List
                 (Get_Base_Type
                    (Get_Element_Subtype (Get_Type (Left_Param))));
               Str : String (1 .. Natural (Left.Bounds.D (1).Length));
               Pos : Natural;
            begin
               for I in Left.Val_Array.V'Range loop
                  Pos := Get_Enum_Pos (Left.Val_Array.V (I));
                  Str (Positive (I)) := Name_Table.Get_Character
                    (Get_Identifier (Get_Nth_Element (Lits, Pos)));
               end loop;
               Result := String_To_Iir_Value (Str);
            end;

         when Iir_Predefined_Bit_Vector_To_Hstring =>
            return Execute_Bit_Vector_To_String (Left, 4);

         when Iir_Predefined_Bit_Vector_To_Ostring =>
            return Execute_Bit_Vector_To_String (Left, 3);

         when Iir_Predefined_Real_To_String_Digits =>
            Eval_Right;
            declare
               Str : Grt.To_Strings.String_Real_Format;
               Last : Natural;
            begin
               Grt.To_Strings.To_String
                 (Str, Last, Left.F64, Ghdl_I32 (Right.I64));
               Result := String_To_Iir_Value (Str (1 .. Last));
            end;
         when Iir_Predefined_Real_To_String_Format =>
            Eval_Right;
            declare
               Format : String (1 .. Natural (Right.Val_Array.Len) + 1);
               Str : Grt.To_Strings.String_Real_Format;
               Last : Natural;
            begin
               for I in Right.Val_Array.V'Range loop
                  Format (Positive (I)) :=
                    Character'Val (Right.Val_Array.V (I).E8);
               end loop;
               Format (Format'Last) := ASCII.NUL;
               Grt.To_Strings.To_String
                 (Str, Last, Left.F64, To_Ghdl_C_String (Format'Address));
               Result := String_To_Iir_Value (Str (1 .. Last));
            end;
         when Iir_Predefined_Time_To_String_Unit =>
            Eval_Right;
            declare
               Str : Grt.To_Strings.String_Time_Unit;
               First : Natural;
               Unit : Iir;
            begin
               Unit := Get_Unit_Chain (Vhdl.Std_Package.Time_Type_Definition);
               while Unit /= Null_Iir loop
                  exit when Vhdl.Evaluation.Get_Physical_Value (Unit)
                    = Int64 (Right.I64);
                  Unit := Get_Chain (Unit);
               end loop;
               if Unit = Null_Iir then
                  Error_Msg_Exec
                    ("to_string for time called with wrong unit", Expr);
               end if;
               Grt.To_Strings.To_String (Str, First, Left.I64, Right.I64);
               Result := String_To_Iir_Value
                 (Str (First .. Str'Last) & ' '
                    & Name_Table.Image (Get_Identifier (Unit)));
            end;

         when Iir_Predefined_Std_Ulogic_Match_Equality =>
            Eval_Right;
            declare
               use Grt.Std_Logic_1164;
            begin
               Result := Create_E8_Value
                 (Std_Ulogic'Pos
                    (Match_Eq_Table (Std_Ulogic'Val (Left.E8),
                                     Std_Ulogic'Val (Right.E8))));
            end;
         when Iir_Predefined_Std_Ulogic_Match_Inequality =>
            Eval_Right;
            declare
               use Grt.Std_Logic_1164;
            begin
               Result := Create_E8_Value
                 (Std_Ulogic'Pos
                    (Not_Table (Match_Eq_Table (Std_Ulogic'Val (Left.E8),
                                                Std_Ulogic'Val (Right.E8)))));
            end;
         when Iir_Predefined_Std_Ulogic_Match_Ordering_Functions =>
            Eval_Right;
            declare
               use Grt.Std_Logic_1164;
               L : constant Std_Ulogic := Std_Ulogic'Val (Left.E8);
               R : constant Std_Ulogic := Std_Ulogic'Val (Right.E8);
               Res : Std_Ulogic;
            begin
               Check_Std_Ulogic_Dc (Expr, L);
               Check_Std_Ulogic_Dc (Expr, R);
               case Iir_Predefined_Std_Ulogic_Match_Ordering_Functions (Func)
                  is
                  when Iir_Predefined_Std_Ulogic_Match_Less =>
                     Res := Match_Lt_Table (L, R);
                  when Iir_Predefined_Std_Ulogic_Match_Less_Equal =>
                     Res := Or_Table (Match_Lt_Table (L, R),
                                      Match_Eq_Table (L, R));
                  when Iir_Predefined_Std_Ulogic_Match_Greater =>
                     Res := Not_Table (Or_Table (Match_Lt_Table (L, R),
                                                 Match_Eq_Table (L, R)));
                  when Iir_Predefined_Std_Ulogic_Match_Greater_Equal =>
                     Res := Not_Table (Match_Lt_Table (L, R));
               end case;
               Result := Create_E8_Value (Std_Ulogic'Pos (Res));
            end;

         when Iir_Predefined_Std_Ulogic_Array_Match_Equality
           | Iir_Predefined_Std_Ulogic_Array_Match_Inequality =>
            Eval_Right;
            if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then
               Error_Msg_Constraint (Expr);
            end if;
            declare
               use Grt.Std_Logic_1164;
               Res : Std_Ulogic := '1';
               Le, Re : Std_Ulogic;
               Has_Match_Err : Boolean;
            begin
               Has_Match_Err := False;
               for I in Left.Val_Array.V'Range loop
                  Le := Std_Ulogic'Val (Left.Val_Array.V (I).E8);
                  Re := Std_Ulogic'Val (Right.Val_Array.V (I).E8);
                  if (Le = '-' or Re = '-') and then not Has_Match_Err then
                     Assert_Std_Ulogic_Dc (Expr);
                     Has_Match_Err := True;
                  end if;
                  Res := And_Table (Res, Match_Eq_Table (Le, Re));
               end loop;
               if Func = Iir_Predefined_Std_Ulogic_Array_Match_Inequality then
                  Res := Not_Table (Res);
               end if;
               Result := Create_E8_Value (Std_Ulogic'Pos (Res));
            end;

         when others =>
            Error_Msg_Elab (Expr, "execute_implicit_function: unimplemented " &
                              Iir_Predefined_Functions'Image (Func));
            raise Internal_Error;
      end case;
      return Result;
   exception
      when Constraint_Error =>
         Error_Msg_Constraint (Expr);
   end Execute_Implicit_Function;

   procedure Execute_Implicit_Procedure
     (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call)
   is
      Imp : constant Iir := Get_Implementation (Stmt);
      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
      Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp);
      Assoc: Iir;
      Formal : Iir;
      Val : Iir;
      Args: Iir_Value_Literal_Array (0 .. 3);
      Expr_Mark : Mark_Type;
   begin
      Mark (Expr_Mark, Expr_Pool);
      Assoc := Assoc_Chain;
      Formal := Inter_Chain;
      for I in Iir_Index32 loop
         exit when Assoc = Null_Iir;
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_By_Expression =>
               Val := Get_Actual (Assoc);
            when Iir_Kind_Association_Element_Open =>
               Val := Get_Default_Value (Formal);
            when others =>
               raise Internal_Error;
         end case;
         Args (I) := Execute_Expression (Block, Val);
         Assoc := Get_Chain (Assoc);
         Formal := Get_Chain (Formal);
      end loop;
      case Get_Implicit_Definition (Imp) is
         when Iir_Predefined_Deallocate =>
            if Args (0).Val_Access /= null then
               Free_Heap_Value (Args (0));
               Args (0).Val_Access := null;
            end if;
         when Iir_Predefined_File_Open =>
            File_Operation.File_Open
              (Args (0), Args (1), Args (2), Inter_Chain, Stmt);
         when Iir_Predefined_File_Open_Status =>
            File_Operation.File_Open_Status
              (Args (0), Args (1), Args (2), Args (3),
               Get_Chain (Inter_Chain), Stmt);
         when Iir_Predefined_Write =>
            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
               File_Operation.Write_Text (Args (0), Args (1));
            else
               File_Operation.Write_Binary (Args (0), Args (1));
            end if;
         when Iir_Predefined_Read_Length =>
            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
               File_Operation.Read_Length_Text
                 (Args (0), Args (1), Args (2));
            else
               File_Operation.Read_Length_Binary
                 (Args (0), Args (1), Args (2));
            end if;
         when Iir_Predefined_Read =>
            File_Operation.Read_Binary (Args (0), Args (1));
         when Iir_Predefined_Flush =>
            File_Operation.Flush (Args (0));
         when Iir_Predefined_File_Close =>
            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
               File_Operation.File_Close_Text (Args (0), Stmt);
            else
               File_Operation.File_Close_Binary (Args (0), Stmt);
            end if;
         when others =>
            Error_Kind ("execute_implicit_procedure",
                        Get_Implicit_Definition (Imp));
      end case;
      Release (Expr_Mark, Expr_Pool);
   end Execute_Implicit_Procedure;

   procedure Execute_Foreign_Procedure
     (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call)
   is
      Imp : constant Iir := Get_Implementation (Stmt);
      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
      Assoc: Iir;
      Args: Iir_Value_Literal_Array (0 .. 3) := (others => null);
      Expr_Mark : Mark_Type;
   begin
      Mark (Expr_Mark, Expr_Pool);
      Assoc := Assoc_Chain;
      for I in Args'Range loop
         exit when Assoc = Null_Iir;
         Args (I) := Execute_Expression (Block, Get_Actual (Assoc));
         Assoc := Get_Chain (Assoc);
      end loop;
      case Get_Identifier (Imp) is
         when Std_Names.Name_Untruncated_Text_Read =>
            File_Operation.Untruncated_Text_Read
              (Args (0), Args (1), Args (2));
         when Std_Names.Name_Control_Simulation =>
            --  FIXME: handle stop properly.
            --  FIXME: this is the only place where longjump is called.
            Grt.Lib.Ghdl_Control_Simulation
              (Args (0).B1, Args (1).B1, Std_Integer (Args (2).I64));
            --  Do not return.
         when Std_Names.Name_Textio_Write_Real =>
            File_Operation.Textio_Write_Real
              (Args (0), Args (1), Args (2).F64, Std_Integer (Args (3).I64));
         when others =>
            Error_Msg_Exec ("unsupported foreign procedure call", Stmt);
      end case;
      Release (Expr_Mark, Expr_Pool);
   end Execute_Foreign_Procedure;

   -- Compute the offset for INDEX into a range BOUNDS.
   -- EXPR is only used in case of error.
   function Get_Index_Offset
     (Index: Iir_Value_Literal_Acc;
      Bounds: Iir_Value_Literal_Acc;
      Expr: Iir)
      return Iir_Index32
   is
      Left_Pos, Right_Pos: Iir_Value_Literal_Acc;
   begin
      Left_Pos := Bounds.Left;
      Right_Pos := Bounds.Right;
      if Index.Kind /= Left_Pos.Kind or else Index.Kind /= Right_Pos.Kind then
         raise Internal_Error;
      end if;
      case Iir_Value_Discrete (Index.Kind) is
         when Iir_Value_B1 =>
            case Bounds.Dir is
               when Dir_To =>
                  if Index.B1 >= Left_Pos.B1 and then
                    Index.B1 <= Right_Pos.B1
                  then
                     -- to
                     return Ghdl_B1'Pos (Index.B1) - Ghdl_B1'Pos (Left_Pos.B1);
                  end if;
               when Dir_Downto =>
                  if Index.B1 <= Left_Pos.B1 and then
                    Index.B1 >= Right_Pos.B1
                  then
                     -- downto
                     return Ghdl_B1'Pos (Left_Pos.B1) - Ghdl_B1'Pos (Index.B1);
                  end if;
            end case;
         when Iir_Value_E8 =>
            case Bounds.Dir is
               when Dir_To =>
                  if Index.E8 >= Left_Pos.E8 and then
                    Index.E8 <= Right_Pos.E8
                  then
                     -- to
                     return Iir_Index32 (Index.E8 - Left_Pos.E8);
                  end if;
               when Dir_Downto =>
                  if Index.E8 <= Left_Pos.E8 and then
                    Index.E8 >= Right_Pos.E8
                  then
                     -- downto
                     return Iir_Index32 (Left_Pos.E8 - Index.E8);
                  end if;
            end case;
         when Iir_Value_E32 =>
            case Bounds.Dir is
               when Dir_To =>
                  if Index.E32 >= Left_Pos.E32 and then
                    Index.E32 <= Right_Pos.E32
                  then
                     -- to
                     return Iir_Index32 (Index.E32 - Left_Pos.E32);
                  end if;
               when Dir_Downto =>
                  if Index.E32 <= Left_Pos.E32 and then
                    Index.E32 >= Right_Pos.E32
                  then
                     -- downto
                     return Iir_Index32 (Left_Pos.E32 - Index.E32);
                  end if;
            end case;
         when Iir_Value_I64 =>
            case Bounds.Dir is
               when Dir_To =>
                  if Index.I64 >= Left_Pos.I64 and then
                    Index.I64 <= Right_Pos.I64
                  then
                     -- to
                     return Iir_Index32 (Index.I64 - Left_Pos.I64);
                  end if;
               when Dir_Downto =>
                  if Index.I64 <= Left_Pos.I64 and then
                    Index.I64 >= Right_Pos.I64
                  then
                     -- downto
                     return Iir_Index32 (Left_Pos.I64 - Index.I64);
                  end if;
            end case;
      end case;
      Error_Msg_Constraint (Expr);
      return 0;
   end Get_Index_Offset;

   --  Create an iir_value_literal of kind iir_value_array and of life LIFE.
   --  Allocate the array of bounds, and fill it from A_TYPE.
   --  Allocate the array of values.
   function Create_Array_Bounds_From_Type (Block : Block_Instance_Acc;
                                           A_Type : Iir;
                                           Create_Val_Array : Boolean)
                                          return Iir_Value_Literal_Acc
   is
      --  Only for constrained subtypes.
      pragma Assert (Get_Constraint_State (A_Type) = Fully_Constrained);

      Index_List : constant Iir_Flist := Get_Index_Subtype_List (A_Type);
      Res : Iir_Value_Literal_Acc;
      Len : Iir_Index32;
      Bound : Iir_Value_Literal_Acc;
   begin
      Res := Create_Array_Value (Iir_Index32 (Get_Nbr_Elements (Index_List)));
      Len := 1;
      for I in 1 .. Res.Bounds.Nbr_Dims loop
         Bound := Execute_Bounds
           (Block, Get_Nth_Element (Index_List, Natural (I - 1)));
         Len := Len * Bound.Length;
         Res.Bounds.D (I) := Bound;
      end loop;
      if Create_Val_Array then
         Create_Array_Data (Res, Len);
      end if;
      return Res;
   end Create_Array_Bounds_From_Type;

   --  Return the steps (ie, offset in the array when index DIM is increased
   --  by one) for array ARR and dimension DIM.
   function Get_Step_For_Dim (Arr: Iir_Value_Literal_Acc; Dim : Natural)
     return Iir_Index32
   is
      Bounds : Value_Bounds_Array_Acc renames Arr.Bounds;
      Res : Iir_Index32;
   begin
      Res := 1;
      for I in Iir_Index32 (Dim + 1) .. Bounds.Nbr_Dims loop
         Res := Res * Bounds.D (I).Length;
      end loop;
      return Res;
   end Get_Step_For_Dim;

   --  Create a literal for a string or a bit_string
   function String_To_Enumeration_Array_1 (Str: Iir; El_Type : Iir)
                                          return Iir_Value_Literal_Acc
   is
      pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8);
      Id : constant String8_Id := Get_String8_Id (Str);
      Len : constant Iir_Index32 := Iir_Index32 (Get_String_Length (Str));

      El_Btype : constant Iir := Get_Base_Type (El_Type);

      Lit: Iir_Value_Literal_Acc;
      El : Iir_Value_Literal_Acc;

      Pos : Nat8;
   begin
      Lit := Create_Array_Value (Len, 1);

      for I in Lit.Val_Array.V'Range loop
         -- FIXME: use literal from type ??
         Pos := Str_Table.Element_String8 (Id, Pos32 (I));
         El := Create_Enum_Value (Natural (Pos), El_Btype);
         Lit.Val_Array.V (I) := El;
      end loop;

      return Lit;
   end String_To_Enumeration_Array_1;

   --  Create a literal for a string or a bit_string
   function Execute_String_Literal (Str: Iir; Block_Type : Block_Instance_Acc)
                                   return Iir_Value_Literal_Acc
   is
      Array_Type: constant Iir := Get_Type (Str);
      Index_Types : constant Iir_Flist := Get_Index_Subtype_List (Array_Type);
      Res : Iir_Value_Literal_Acc;
   begin
      --  Array must be unidimensional.
      pragma Assert (Get_Nbr_Elements (Index_Types) = 1);

      Res := String_To_Enumeration_Array_1
        (Str, Get_Element_Subtype (Array_Type));

      --  When created from static evaluation, a string may still have an
      --  unconstrained type.
      if Get_Constraint_State (Array_Type) /= Fully_Constrained then
         Res.Bounds.D (1) :=
           Create_Range_Value (Create_I64_Value (1),
                               Create_I64_Value (Ghdl_I64 (Res.Val_Array.Len)),
                               Dir_To,
                               Res.Val_Array.Len);
      else
         Res.Bounds.D (1) :=
           Execute_Bounds (Block_Type, Get_Nth_Element (Index_Types, 0));
      end if;

      --  The range may not be statically constant.
      if Res.Bounds.D (1).Length /= Res.Val_Array.Len then
         Error_Msg_Constraint (Str);
      end if;

      return Res;
   end Execute_String_Literal;

   --  Fill LENGTH elements of RES, starting at ORIG by steps of STEP.
   --  Use expressions from (BLOCK, AGGREGATE) to fill the elements.
   --  EL_TYPE is the type of the array element.
   procedure Fill_Array_Aggregate_1 (Block : Block_Instance_Acc;
                                     Aggregate : Iir;
                                     Res : Iir_Value_Literal_Acc;
                                     Orig : Iir_Index32;
                                     Step : Iir_Index32;
                                     Dim : Iir_Index32;
                                     Nbr_Dim : Iir_Index32;
                                     El_Type : Iir)
   is
      Value : Iir;
      Bound : constant Iir_Value_Literal_Acc := Res.Bounds.D (Dim);
      Length : constant Iir_Index32 := Bound.Length;

      procedure Set_Elem (Pos : Iir_Index32)
      is
         Val : Iir_Value_Literal_Acc;
      begin
         if Dim = Nbr_Dim then
            --  VALUE is an expression (which may be an aggregate, but not
            --  a sub-aggregate.
            Val := Execute_Expression_With_Type (Block, Value, El_Type);
            --  LRM93 7.3.2.2
            --  For a multi-dimensional aggregate of dimension n, a check
            --  is made that all (n-1)-dimensional subaggregates have the
            --  same bounds.
            --  GHDL: I have added an implicit array conversion, however
            --   it may be useful to allow cases like this:
            --     type str_array is array (natural range <>)
            --        of string (10 downto 1);
            --     constant floats : str_array :=
            --         ( "00000000.0", HT & "+1.5ABCDE");
            --   The subtype of the first sub-aggregate (0.0) is
            --   determinated by the context, according to rule 9 and 4
            --   of LRM93 7.3.2.2 and therefore is string (10 downto 1),
            --   while the subtype of the second sub-aggregate (HT & ...)
            --   is determinated by rules 1 and 2 of LRM 7.2.4, and is
            --   string (1 to 10).
            --   Unless an implicit conversion is used, according to the
            --   LRM, this should fail, but it makes no sens.
            --
            --   FIXME: Add a warning, a flag ?
            --Implicit_Array_Conversion (Block, Val, El_Type, Value);
            --Check_Constraints (Block, Val, El_Type, Value);
            Res.Val_Array.V (1 + Orig + Pos * Step) := Val;
         else
            case Get_Kind (Value) is
               when Iir_Kind_Aggregate =>
                  --  VALUE is a sub-aggregate.
                  Fill_Array_Aggregate_1 (Block, Value, Res,
                                          Orig + Pos * Step,
                                          Step / Res.Bounds.D (Dim + 1).Length,
                                          Dim + 1, Nbr_Dim, El_Type);
               when Iir_Kind_String_Literal8 =>
                  pragma Assert (Dim + 1 = Nbr_Dim);
                  Val := String_To_Enumeration_Array_1 (Value, El_Type);
                  if Val.Val_Array.Len /= Res.Bounds.D (Nbr_Dim).Length then
                     Error_Msg_Constraint (Value);
                  end if;
                  for I in Val.Val_Array.V'Range loop
                     Res.Val_Array.V (Orig + Pos * Step + I) :=
                       Val.Val_Array.V (I);
                  end loop;
               when others =>
                  Error_Kind ("fill_array_aggregate_1", Value);
            end case;
         end if;
      end Set_Elem;

      procedure Set_Elem_By_Expr (Expr : Iir)
      is
         Expr_Pos: Iir_Value_Literal_Acc;
      begin
         Expr_Pos := Execute_Expression (Block, Expr);
         Set_Elem (Get_Index_Offset (Expr_Pos, Bound, Expr));
      end Set_Elem_By_Expr;

      procedure Set_Elem_By_Range (Expr : Iir)
      is
         A_Range : Iir_Value_Literal_Acc;
         High, Low : Iir_Value_Literal_Acc;
      begin
         A_Range := Execute_Bounds (Block, Expr);
         if Is_Null_Range (A_Range) then
            return;
         end if;
         if A_Range.Dir = Dir_To then
            High := A_Range.Right;
            Low := A_Range.Left;
         else
            High := A_Range.Left;
            Low := A_Range.Right;
         end if;

         --  Locally modified (incremented)
         Low := Unshare (Low, Expr_Pool'Access);

         loop
            Set_Elem (Get_Index_Offset (Low, Bound, Expr));
            exit when Is_Equal (Low, High);
            Increment (Low);
         end loop;
      end Set_Elem_By_Range;

      Assoc : Iir;
      Pos : Iir_Index32;
   begin
      Assoc := Get_Association_Choices_Chain (Aggregate);
      Pos := 0;
      while Assoc /= Null_Iir loop
         Value := Get_Associated_Expr (Assoc);
         loop
            case Get_Kind (Assoc) is
               when Iir_Kind_Choice_By_None =>
                  if Get_Element_Type_Flag (Assoc) then
                     if Pos >= Length then
                        Error_Msg_Constraint (Assoc);
                     end if;

                     Set_Elem (Pos);
                     Pos := Pos + 1;
                  else
                     declare
                        Val : Iir_Value_Literal_Acc;
                     begin
                        Val := Execute_Expression (Block, Value);
                        pragma Assert (Val.Kind = Iir_Value_Array);
                        pragma Assert (Val.Bounds.Nbr_Dims = 1);
                        for I in 1 .. Val.Val_Array.Len loop
                           if Pos >= Length then
                              Error_Msg_Constraint (Assoc);
                           end if;
                           Res.Val_Array.V (1 + Orig + Pos * Step) :=
                             Val.Val_Array.V (I);
                           Pos := Pos + 1;
                        end loop;
                     end;
                  end if;
               when Iir_Kind_Choice_By_Expression =>
                  Set_Elem_By_Expr (Get_Choice_Expression (Assoc));
               when Iir_Kind_Choice_By_Range =>
                  Set_Elem_By_Range (Get_Choice_Range (Assoc));
               when Iir_Kind_Choice_By_Others =>
                  for J in 1 .. Length loop
                     if Res.Val_Array.V (Orig + J * Step) = null then
                        Set_Elem (J - 1);
                     end if;
                  end loop;
                  return;
               when others =>
                  raise Internal_Error;
            end case;
            Assoc := Get_Chain (Assoc);
            exit when Assoc = Null_Iir;
            exit when not Get_Same_Alternative_Flag (Assoc);
         end loop;
      end loop;

      --  Check each elements have been set.
      --  FIXME: check directly with type.
      for J in 1 .. Length loop
         if Res.Val_Array.V (Orig + J * Step) = null then
            Error_Msg_Constraint (Aggregate);
         end if;
      end loop;
   end Fill_Array_Aggregate_1;

   --  Use expressions from (BLOCK, AGGREGATE) to fill RES.
   procedure Fill_Array_Aggregate (Block : Block_Instance_Acc;
                                   Aggregate : Iir;
                                   Res : Iir_Value_Literal_Acc)
   is
      Aggr_Type : constant Iir := Get_Type (Aggregate);
      El_Type : constant Iir := Get_Element_Subtype (Aggr_Type);
      Index_List : constant Iir_Flist := Get_Index_Subtype_List (Aggr_Type);
      Nbr_Dim : constant Iir_Index32 :=
        Iir_Index32 (Get_Nbr_Elements (Index_List));
      Step : Iir_Index32;
   begin
      Step := Get_Step_For_Dim (Res, 1);
      Fill_Array_Aggregate_1
        (Block, Aggregate, Res, 0, Step, 1, Nbr_Dim, El_Type);
   end Fill_Array_Aggregate;

   function Execute_Record_Aggregate (Block: Block_Instance_Acc;
                                      Aggregate: Iir;
                                      Aggregate_Type: Iir)
                                     return Iir_Value_Literal_Acc
   is
      List : constant Iir_Flist :=
        Get_Elements_Declaration_List (Get_Base_Type (Aggregate_Type));

      Res: Iir_Value_Literal_Acc;
      Expr : Iir;

      procedure Set_Expr (Pos : Iir_Index32) is
         El : constant Iir := Get_Nth_Element (List, Natural (Pos - 1));
      begin
         Res.Val_Record.V (Pos) :=
           Execute_Expression_With_Type (Block, Expr, Get_Type (El));
      end Set_Expr;

      Pos : Iir_Index32;
      Assoc: Iir;
      N_Expr : Iir;
   begin
      Res := Create_Record_Value (Iir_Index32 (Get_Nbr_Elements (List)));

      Assoc := Get_Association_Choices_Chain (Aggregate);
      Pos := 1;
      loop
         N_Expr := Get_Associated_Expr (Assoc);
         if N_Expr /= Null_Iir then
            Expr := N_Expr;
         end if;
         case Get_Kind (Assoc) is
            when Iir_Kind_Choice_By_None =>
               Set_Expr (Pos);
               Pos := Pos + 1;
            when Iir_Kind_Choice_By_Name =>
               Set_Expr (1 + Get_Element_Position
                           (Get_Named_Entity (Get_Choice_Name (Assoc))));
            when Iir_Kind_Choice_By_Others =>
               for I in Res.Val_Record.V'Range loop
                  if Res.Val_Record.V (I) = null then
                     Set_Expr (I);
                  end if;
               end loop;
            when others =>
               Error_Kind ("execute_record_aggregate", Assoc);
         end case;
         Assoc := Get_Chain (Assoc);
         exit when Assoc = Null_Iir;
      end loop;
      return Res;
   end Execute_Record_Aggregate;

   function Execute_Aggregate (Block: Block_Instance_Acc;
                               Aggregate: Iir;
                               Block_Type : Block_Instance_Acc;
                               Aggregate_Type: Iir)
                              return Iir_Value_Literal_Acc is
   begin
      case Get_Kind (Aggregate_Type) is
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            declare
               Res : Iir_Value_Literal_Acc;
            begin
               Res := Create_Array_Bounds_From_Type
                 (Block_Type, Aggregate_Type, True);
               Fill_Array_Aggregate (Block, Aggregate, Res);
               return Res;
            end;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            return Execute_Record_Aggregate (Block, Aggregate, Aggregate_Type);
         when others =>
            Error_Kind ("execute_aggregate", Aggregate_Type);
      end case;
   end Execute_Aggregate;

   function Execute_Association_Expression
     (Actual_Instance : Block_Instance_Acc;
      Actual : Iir;
      Formal_Instance : Block_Instance_Acc)
     return Iir_Value_Literal_Acc
   is
   begin
      case Get_Kind (Actual) is
         when Iir_Kind_String_Literal8 =>
            return Execute_String_Literal (Actual, Formal_Instance);
         when Iir_Kind_Aggregate =>
            return Execute_Aggregate
              (Actual_Instance, Actual, Formal_Instance, Get_Type (Actual));
         when others =>
            null;
      end case;
      return Execute_Expression (Actual_Instance, Actual);
   end Execute_Association_Expression;


   function Execute_Simple_Aggregate (Block: Block_Instance_Acc; Aggr : Iir)
                                     return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
      List : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr);
   begin
      Res := Create_Array_Bounds_From_Type (Block, Get_Type (Aggr), True);
      for I in Res.Val_Array.V'Range loop
         Res.Val_Array.V (I) :=
           Execute_Expression (Block, Get_Nth_Element (List, Natural (I - 1)));
      end loop;
      return Res;
   end Execute_Simple_Aggregate;

   --  Fill LENGTH elements of RES, starting at ORIG by steps of STEP.
   --  Use expressions from (BLOCK, AGGREGATE) to fill the elements.
   --  EL_TYPE is the type of the array element.
   procedure Execute_Name_Array_Aggregate (Block : Block_Instance_Acc;
                                           Aggregate : Iir;
                                           Res : Iir_Value_Literal_Acc;
                                           Orig : Iir_Index32;
                                           Step : Iir_Index32;
                                           Dim : Iir_Index32;
                                           Nbr_Dim : Iir_Index32;
                                           El_Type : Iir)
   is
      Value : Iir;
      Bound : Iir_Value_Literal_Acc;

      procedure Set_Elem (Pos : Iir_Index32)
      is
         Val : Iir_Value_Literal_Acc;
         Is_Sig : Boolean;
      begin
         if Dim = Nbr_Dim then
            --  VALUE is an expression (which may be an aggregate, but not
            --  a sub-aggregate.
            Execute_Name_With_Base (Block, Value, null, Val, Is_Sig);
            Res.Val_Array.V (1 + Orig + Pos * Step) := Val;
         else
            --  VALUE is a sub-aggregate.
            Execute_Name_Array_Aggregate
              (Block, Value, Res,
               Orig + Pos * Step,
               Step / Res.Bounds.D (Dim + 1).Length,
               Dim + 1, Nbr_Dim, El_Type);
         end if;
      end Set_Elem;

      Assoc : Iir;
      Pos : Iir_Index32;
   begin
      Assoc := Get_Association_Choices_Chain (Aggregate);
      Bound := Res.Bounds.D (Dim);
      Pos := 0;
      while Assoc /= Null_Iir loop
         Value := Get_Associated_Expr (Assoc);
         case Get_Kind (Assoc) is
            when Iir_Kind_Choice_By_None =>
               null;
            when Iir_Kind_Choice_By_Expression =>
               declare
                  Expr_Pos: Iir_Value_Literal_Acc;
                  Val : constant Iir := Get_Expression (Assoc);
               begin
                  Expr_Pos := Execute_Expression (Block, Val);
                  Pos := Get_Index_Offset (Expr_Pos, Bound, Val);
               end;
            when others =>
               raise Internal_Error;
         end case;
         Set_Elem (Pos);
         Pos := Pos + 1;
         Assoc := Get_Chain (Assoc);
      end loop;
   end Execute_Name_Array_Aggregate;

   function Execute_Record_Name_Aggregate (Block: Block_Instance_Acc;
                                           Aggregate: Iir;
                                           Aggregate_Type: Iir)
                                          return Iir_Value_Literal_Acc
   is
      List : constant Iir_Flist :=
        Get_Elements_Declaration_List (Get_Base_Type (Aggregate_Type));
      Res: Iir_Value_Literal_Acc;
      Expr : Iir;
      Pos : Iir_Index32;
      El_Pos : Iir_Index32;
      Is_Sig : Boolean;
      Assoc: Iir;
   begin
      Res := Create_Record_Value (Iir_Index32 (Get_Nbr_Elements (List)));
      Assoc := Get_Association_Choices_Chain (Aggregate);
      Pos := 0;
      loop
         Expr := Get_Associated_Expr (Assoc);
         if Expr = Null_Iir then
            --  List of choices is not allowed.
            raise Internal_Error;
         end if;
         case Get_Kind (Assoc) is
            when Iir_Kind_Choice_By_None =>
               El_Pos := Pos;
               Pos := Pos + 1;
            when Iir_Kind_Choice_By_Name =>
               El_Pos := Get_Element_Position (Get_Name (Assoc));
            when Iir_Kind_Choice_By_Others =>
               raise Internal_Error;
            when others =>
               Error_Kind ("execute_record_name_aggregate", Assoc);
         end case;
         Execute_Name_With_Base
           (Block, Expr, null, Res.Val_Record.V (1 + El_Pos), Is_Sig);
         Assoc := Get_Chain (Assoc);
         exit when Assoc = Null_Iir;
      end loop;
      return Res;
   end Execute_Record_Name_Aggregate;

   function Execute_Name_Aggregate (Block: Block_Instance_Acc;
                                    Aggregate: Iir;
                                    Aggregate_Type: Iir)
                                   return Iir_Value_Literal_Acc is
   begin
      case Get_Kind (Aggregate_Type) is
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            declare
               El_Type : constant Iir := Get_Element_Subtype (Aggregate_Type);
               Index_List : constant Iir_Flist :=
                 Get_Index_Subtype_List (Aggregate_Type);
               Nbr_Dim : constant Iir_Index32 :=
                 Iir_Index32 (Get_Nbr_Elements (Index_List));
               Res : Iir_Value_Literal_Acc;
               Step : Iir_Index32;
            begin
               pragma Assert
                 (Get_Constraint_State (Aggregate_Type) = Fully_Constrained);
               Res := Create_Array_Bounds_From_Type
                 (Block, Aggregate_Type, True);
               Step := Get_Step_For_Dim (Res, 1);
               Execute_Name_Array_Aggregate
                 (Block, Aggregate, Res, 0, Step, 1, Nbr_Dim, El_Type);
               return Res;
            end;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            return Execute_Record_Name_Aggregate
              (Block, Aggregate, Aggregate_Type);
         when others =>
            Error_Kind ("execute_name_aggregate", Aggregate_Type);
      end case;
   end Execute_Name_Aggregate;

   --  Return the indexes range for prefix of ATTR.
   function Execute_Indexes (Block: Block_Instance_Acc; Attr : Iir)
                            return Iir_Value_Literal_Acc
   is
      Prefix : constant Iir := Strip_Denoting_Name (Get_Prefix (Attr));
      Dim : constant Natural :=
        Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr);
   begin
      case Get_Kind (Prefix) is
         when Iir_Kind_Type_Declaration
           | Iir_Kind_Subtype_Declaration =>
            declare
               Index : Iir;
            begin
               Index := Get_Nth_Element
                 (Get_Index_Subtype_List (Get_Type (Prefix)), Dim - 1);
               return Execute_Bounds (Block, Index);
            end;
         when Iir_Kind_Array_Type_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            Error_Kind ("execute_indexes", Prefix);
         when others =>
            declare
               Orig : Iir_Value_Literal_Acc;
            begin
               Orig := Execute_Name (Block, Prefix, True);
               return Orig.Bounds.D (Iir_Index32 (Dim));
            end;
      end case;
   end Execute_Indexes;

   function Execute_Bounds (Block: Block_Instance_Acc; Prefix: Iir)
      return Iir_Value_Literal_Acc
   is
      Bound : Iir_Value_Literal_Acc;
   begin
      case Get_Kind (Prefix) is
         when Iir_Kind_Range_Expression =>
            declare
               Info : constant Sim_Info_Acc := Get_Info (Prefix);
            begin
               if Info = null then
                  Bound := Create_Range_Value
                    (Execute_Expression (Block, Get_Left_Limit (Prefix)),
                     Execute_Expression (Block, Get_Right_Limit (Prefix)),
                     Get_Direction (Prefix));
               elsif Info.Kind = Kind_Object then
                  Bound := Get_Instance_Object (Block, Prefix);
               else
                  raise Internal_Error;
               end if;
            end;

         when Iir_Kind_Subtype_Declaration =>
            return Execute_Bounds (Block, Get_Type (Prefix));

         when Iir_Kind_Integer_Subtype_Definition
           | Iir_Kind_Floating_Subtype_Definition
           | Iir_Kind_Enumeration_Subtype_Definition
           | Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Physical_Subtype_Definition =>
            --  FIXME: move this block before and avoid recursion.
            return Execute_Bounds (Block, Get_Range_Constraint (Prefix));

         when Iir_Kind_Range_Array_Attribute =>
            Bound := Execute_Indexes (Block, Prefix);
         when Iir_Kind_Reverse_Range_Array_Attribute =>
            Bound := Execute_Indexes (Block, Prefix);
            case Bound.Dir is
               when Dir_To =>
                  Bound := Create_Range_Value
                    (Bound.Right, Bound.Left, Dir_Downto, Bound.Length);
               when Dir_Downto =>
                  Bound := Create_Range_Value
                    (Bound.Right, Bound.Left, Dir_To, Bound.Length);
            end case;

         when Iir_Kind_Floating_Type_Definition
           | Iir_Kind_Integer_Type_Definition =>
            return Execute_Bounds
              (Block,
               Get_Range_Constraint (Get_Type (Get_Type_Declarator (Prefix))));

         when Iir_Kinds_Denoting_Name =>
            return Execute_Bounds (Block, Get_Named_Entity (Prefix));

         when Iir_Kind_Subtype_Attribute =>
            return Execute_Bounds (Block, Get_Type (Prefix));

         when others =>
            -- Error_Kind ("execute_bounds", Get_Kind (Prefix));
            declare
               Prefix_Val: Iir_Value_Literal_Acc;
            begin
               Prefix_Val := Execute_Expression (Block, Prefix);
               Bound := Prefix_Val.Bounds.D (1);
            end;
      end case;
      if not Bound.Dir'Valid then
         raise Internal_Error;
      end if;
      return Bound;
   end Execute_Bounds;

   -- Perform type conversion as desribed in LRM93 7.3.5
   function Execute_Type_Conversion (Block: Block_Instance_Acc;
                                     Val : Iir_Value_Literal_Acc;
                                     Target_Type : Iir;
                                     Loc : Iir)
                                    return Iir_Value_Literal_Acc
   is
      Res: Iir_Value_Literal_Acc;
   begin
      Res := Val;
      case Get_Kind (Target_Type) is
         when Iir_Kind_Integer_Type_Definition
           | Iir_Kind_Integer_Subtype_Definition =>
            case Iir_Value_Numerics (Res.Kind) is
               when Iir_Value_I64 =>
                  null;
               when Iir_Value_F64 =>
                  if Res.F64 > Ghdl_F64 (Int64'Last) or
                    Res.F64 < Ghdl_F64 (Int64'First)
                  then
                     Error_Msg_Constraint (Loc);
                  end if;
                  Res := Create_I64_Value (Ghdl_I64 (Res.F64));
            end case;
         when Iir_Kind_Floating_Type_Definition
           | Iir_Kind_Floating_Subtype_Definition =>
            case Iir_Value_Numerics (Res.Kind) is
               when Iir_Value_F64 =>
                  null;
               when Iir_Value_I64 =>
                  Res := Create_F64_Value (Ghdl_F64 (Res.I64));
            end case;
         when Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Enumeration_Subtype_Definition =>
            --  Must be same type.
            null;
         when Iir_Kind_Physical_Type_Definition
           | Iir_Kind_Physical_Subtype_Definition =>
            --  Same type.
            null;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            --  Same type.
            null;
         when Iir_Kind_Array_Subtype_Definition
           | Iir_Kind_Array_Type_Definition =>
            --  LRM93 7.3.5
            --  if the type mark denotes an unconstrained array type and the
            --  operand is not a null array, then for each index position, the
            --  bounds of the result are obtained by converting the bounds of
            --  the operand to the corresponding index type of the target type.
            --
            --  LRM93 7.3.5
            --  If the type mark denotes a constrained array subtype, then the
            --  bounds of the result are those imposed by the type mark.
            if Get_Constraint_State (Target_Type) = Fully_Constrained then
               Implicit_Array_Conversion (Block, Res, Target_Type, Loc);
            else
               declare
                  Idx_List : constant Iir_Flist :=
                    Get_Index_Subtype_List (Target_Type);
                  Idx_Type : Iir;
               begin
                  Res := Create_Array_Value (Val.Bounds.Nbr_Dims);
                  Res.Val_Array := Val.Val_Array;
                  for I in Val.Bounds.D'Range loop
                     Idx_Type := Get_Index_Type (Idx_List, Natural (I - 1));
                     Res.Bounds.D (I) := Create_Range_Value
                       (Left => Execute_Type_Conversion
                          (Block, Val.Bounds.D (I).Left, Idx_Type, Loc),
                        Right => Execute_Type_Conversion
                          (Block, Val.Bounds.D (I).Right, Idx_Type, Loc),
                        Dir => Val.Bounds.D (I).Dir,
                        Length => Val.Bounds.D (I).Length);
                  end loop;
               end;
               end if;
         when others =>
            Error_Kind ("execute_type_conversion", Target_Type);
      end case;
      Check_Constraints (Block, Res, Target_Type, Loc);
      return Res;
   end Execute_Type_Conversion;

   --  Decrement VAL.
   --  May raise a constraint error using EXPR.
   function Execute_Dec (Val : Iir_Value_Literal_Acc; Expr : Iir)
     return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      case Iir_Value_Discrete (Val.Kind) is
         when Iir_Value_B1 =>
            if Val.B1 = False then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_B1_Value (False);
         when Iir_Value_E8 =>
            if Val.E8 = 0 then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_E8_Value (Val.E8 - 1);
         when Iir_Value_E32 =>
            if Val.E32 = 0 then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_E32_Value (Val.E32 - 1);
         when Iir_Value_I64 =>
            if Val.I64 = Ghdl_I64'First then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_I64_Value (Val.I64 - 1);
      end case;
      return Res;
   end Execute_Dec;

   --  Increment VAL.
   --  May raise a constraint error using EXPR.
   function Execute_Inc (Val : Iir_Value_Literal_Acc; Expr : Iir)
     return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      case Iir_Value_Discrete (Val.Kind) is
         when Iir_Value_B1 =>
            if Val.B1 = True then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_B1_Value (True);
         when Iir_Value_E32 =>
            if Val.E32 = Ghdl_E32'Last then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_E32_Value (Val.E32 + 1);
         when Iir_Value_E8 =>
            if Val.E8 = Ghdl_E8'Last then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_E8_Value (Val.E8 + 1);
         when Iir_Value_I64 =>
            if Val.I64 = Ghdl_I64'Last then
               Error_Msg_Constraint (Expr);
            end if;
            Res := Create_I64_Value (Val.I64 + 1);
      end case;
      return Res;
   end Execute_Inc;

   function Execute_Expression_With_Type (Block: Block_Instance_Acc;
                                          Expr: Iir;
                                          Expr_Type : Iir)
                                         return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      if Get_Kind (Expr) = Iir_Kind_Aggregate
        and then not Is_Fully_Constrained_Type (Get_Type (Expr))
      then
         return Execute_Aggregate (Block, Expr, Block, Expr_Type);
      else
         Res := Execute_Expression (Block, Expr);
         Implicit_Array_Conversion (Block, Res, Expr_Type, Expr);
         Check_Constraints (Block, Res, Expr_Type, Expr);
         return Res;
      end if;
   end Execute_Expression_With_Type;

   function Execute_Signal_Name
     (Block : Block_Instance_Acc; Expr : Iir; Kind : Signal_Slot)
     return Iir_Value_Literal_Acc
   is
      Base : constant Iir := Get_Object_Prefix (Expr, False);
      Info : constant Sim_Info_Acc := Get_Info (Base);
      Bblk : Block_Instance_Acc;
      Slot : Object_Slot_Type;
      Base_Val : Iir_Value_Literal_Acc;
      Res : Iir_Value_Literal_Acc;
      Is_Sig : Boolean;
   begin
      if Get_Kind (Base) = Iir_Kind_Object_Alias_Declaration then
         Bblk := Get_Instance_By_Scope (Block, Info.Obj_Scope);
         Base_Val := Execute_Signal_Name (Bblk, Get_Name (Base), Kind);
      else
         Bblk := Get_Instance_By_Scope (Block, Info.Obj_Scope);
         case Kind is
            when Signal_Sig =>
               Slot := Info.Slot;
            when Signal_Val =>
               Slot := Info.Slot + 1;
            when Signal_Init =>
               Slot := Info.Slot + 2;
         end case;
         Base_Val := Bblk.Objects (Slot);
      end if;
      Execute_Name_With_Base (Block, Expr, Base_Val, Res, Is_Sig);
      pragma Assert (Is_Sig);
      return Res;
   end Execute_Signal_Name;

   --  Indexed element will be at Pfx.Val_Array.V (Pos + 1)
   procedure Execute_Indexed_Name (Block: Block_Instance_Acc;
                                   Expr: Iir;
                                   Pfx : Iir_Value_Literal_Acc;
                                   Pos : out Iir_Index32)
   is
      pragma Assert (Get_Kind (Expr) = Iir_Kind_Indexed_Name);
      Index_List : constant Iir_Flist := Get_Index_List (Expr);
      Nbr_Dimensions : constant Iir_Index32 :=
        Iir_Index32 (Get_Nbr_Elements (Index_List));
      Index: Iir;
      Value: Iir_Value_Literal_Acc;
      Off : Iir_Index32;
   begin
      for I in 1 .. Nbr_Dimensions loop
         Index := Get_Nth_Element (Index_List, Natural (I - 1));
         Value := Execute_Expression (Block, Index);
         Off := Get_Index_Offset (Value, Pfx.Bounds.D (I), Expr);
         if I = 1 then
            Pos := Off;
         else
            Pos := Pos * Pfx.Bounds.D (I).Length + Off;
         end if;
      end loop;
   end Execute_Indexed_Name;

   --  Indexed element will be at Pfx.Val_Array.V (Pos)
   procedure Execute_Slice_Name (Prefix_Array: Iir_Value_Literal_Acc;
                                 Srange : Iir_Value_Literal_Acc;
                                 Low : out Iir_Index32;
                                 High : out Iir_Index32;
                                 Loc : Iir)
   is
      Index_Order : Order;
      -- Lower and upper bounds of the slice.
   begin
      pragma Assert (Prefix_Array /= null);

      --  LRM93 6.5
      --  It is an error if the direction of the discrete range is not
      --  the same as that of the index range of the array denoted by
      --  the prefix of the slice name.
      if Srange.Dir /= Prefix_Array.Bounds.D (1).Dir then
         Error_Msg_Exec ("slice direction mismatch", Loc);
      end if;

      --  LRM93 6.5
      --  It is an error if either of the bounds of the
      --  discrete range does not belong to the index range of the
      --  prefixing array, unless the slice is a null slice.
      Index_Order := Compare_Value (Srange.Left, Srange.Right);
      if (Srange.Dir = Dir_To and Index_Order = Greater)
        or (Srange.Dir = Dir_Downto and Index_Order = Less)
      then
         --  Null slice.
         Low := 1;
         High := 0;
      else
         Low := Get_Index_Offset
           (Srange.Left, Prefix_Array.Bounds.D (1), Loc);
         High := Get_Index_Offset
           (Srange.Right, Prefix_Array.Bounds.D (1), Loc);
      end if;
   end Execute_Slice_Name;

   procedure Execute_Name_With_Base (Block: Block_Instance_Acc;
                                     Expr: Iir;
                                     Base : Iir_Value_Literal_Acc;
                                     Res : out Iir_Value_Literal_Acc;
                                     Is_Sig : out Boolean) is
   begin
      --  Default value
      Is_Sig := False;

      case Get_Kind (Expr) is
         when Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Guard_Signal_Declaration
           | Iir_Kind_Stable_Attribute
           | Iir_Kind_Quiet_Attribute
           | Iir_Kind_Delayed_Attribute
           | Iir_Kind_Transaction_Attribute =>
            Is_Sig := True;
            if Base /= null then
               Res := Base;
            else
               Res := Get_Instance_Object (Block, Expr);
            end if;

         when Iir_Kind_Object_Alias_Declaration =>
            --  FIXME: add a flag ?
            Is_Sig := Is_Signal_Object (Expr);
            if Base /= null then
               Res := Base;
            else
               Res := Get_Instance_Object (Block, Expr);
            end if;

         when Iir_Kind_Interface_Constant_Declaration
           | Iir_Kind_Constant_Declaration
           | Iir_Kind_Interface_Variable_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Interface_File_Declaration
           | Iir_Kind_File_Declaration
           | Iir_Kind_Attribute_Value
           | Iir_Kind_Iterator_Declaration
           | Iir_Kind_Terminal_Declaration
           | Iir_Kinds_Quantity_Declaration
           | Iir_Kind_Psl_Endpoint_Declaration =>
            if Base /= null then
               Res := Base;
            else
               Res := Get_Instance_Object (Block, Expr);
            end if;

         when Iir_Kind_Indexed_Name =>
            declare
               Pfx : Iir_Value_Literal_Acc;
               Pos : Iir_Index32;
            begin
               Execute_Name_With_Base
                 (Block, Get_Prefix (Expr), Base, Pfx, Is_Sig);
               Execute_Indexed_Name (Block, Expr, Pfx, Pos);
               Res := Pfx.Val_Array.V (Pos + 1);
            end;

         when Iir_Kind_Slice_Name =>
            declare
               Prefix_Array: Iir_Value_Literal_Acc;
               Srange : Iir_Value_Literal_Acc;
               Low, High: Iir_Index32;
            begin
               Execute_Name_With_Base
                 (Block, Get_Prefix (Expr), Base, Prefix_Array, Is_Sig);

               Srange := Execute_Bounds (Block, Get_Suffix (Expr));
               Execute_Slice_Name (Prefix_Array, Srange, Low, High, Expr);

               Res := Create_Array_Value (High - Low + 1, 1);
               Res.Bounds.D (1) := Srange;
               for I in Low .. High loop
                  Res.Val_Array.V (1 + I - Low) :=
                    Prefix_Array.Val_Array.V (1 + I);
               end loop;
            end;

         when Iir_Kind_Selected_Element =>
            declare
               Prefix: Iir_Value_Literal_Acc;
               Pos: Iir_Index32;
            begin
               Execute_Name_With_Base
                 (Block, Get_Prefix (Expr), Base, Prefix, Is_Sig);
               Pos := Get_Element_Position (Get_Named_Entity (Expr));
               Res := Prefix.Val_Record.V (Pos + 1);
            end;

         when Iir_Kind_Dereference
           | Iir_Kind_Implicit_Dereference =>
            declare
               Prefix: Iir_Value_Literal_Acc;
            begin
               Prefix := Execute_Name (Block, Get_Prefix (Expr));
               Res := Prefix.Val_Access;
               if Res = null then
                  Error_Msg_Exec ("deferencing null access", Expr);
               end if;
            end;

         when Iir_Kinds_Denoting_Name
           | Iir_Kind_Attribute_Name =>
            Execute_Name_With_Base
              (Block, Get_Named_Entity (Expr), Base, Res, Is_Sig);

         when Iir_Kind_Function_Call =>
            --  A prefix can be an expression
            if Base /= null then
               raise Internal_Error;
            end if;
            Res := Execute_Expression (Block, Expr);

         when Iir_Kind_Aggregate =>
            Res := Execute_Name_Aggregate (Block, Expr, Get_Type (Expr));

         when Iir_Kind_Image_Attribute =>
            Res := Execute_Image_Attribute (Block, Expr);

         when Iir_Kind_Path_Name_Attribute
           | Iir_Kind_Instance_Name_Attribute =>
            Res := Execute_Path_Instance_Name_Attribute (Block, Expr);

         when others =>
            Error_Kind ("execute_name_with_base", Expr);
      end case;
   end Execute_Name_With_Base;

   function Execute_Name (Block: Block_Instance_Acc;
                          Expr: Iir;
                          Ref : Boolean := False)
                         return Iir_Value_Literal_Acc
   is
      Res: Iir_Value_Literal_Acc;
      Is_Sig : Boolean;
   begin
      Execute_Name_With_Base (Block, Expr, null, Res, Is_Sig);
      if not Is_Sig or else Ref then
         return Res;
      else
         return Execute_Signal_Value (Res);
      end if;
   end Execute_Name;

   function Execute_Value_Attribute (Block: Block_Instance_Acc;
                                     Str_Val : Iir_Value_Literal_Acc;
                                     Expr: Iir)
                                    return Iir_Value_Literal_Acc
   is
      use Grt_Interface;
      use Name_Table;
      pragma Unreferenced (Block);

      Expr_Type : constant Iir := Get_Type (Expr);
      Res : Iir_Value_Literal_Acc;

      Str_Bnd : aliased Std_String_Bound := Build_Bound (Str_Val);
      Str_Str : aliased Std_String_Uncons (1 .. Str_Bnd.Dim_1.Length);
      Str : aliased Std_String := (To_Std_String_Basep (Str_Str'Address),
                                   To_Std_String_Boundp (Str_Bnd'Address));
   begin
      Set_Std_String_From_Iir_Value (Str, Str_Val);
      case Get_Kind (Expr_Type) is
         when Iir_Kind_Integer_Type_Definition
           | Iir_Kind_Integer_Subtype_Definition =>
            Res := Create_I64_Value
              (Grt.Values.Ghdl_Value_I64 (Str'Unrestricted_Access));
         when Iir_Kind_Floating_Type_Definition
           | Iir_Kind_Floating_Subtype_Definition =>
            Res := Create_F64_Value
              (Grt.Values.Ghdl_Value_F64 (Str'Unrestricted_Access));
         when Iir_Kind_Physical_Type_Definition
           | Iir_Kind_Physical_Subtype_Definition =>
            declare
               Is_Real : Boolean;
               Lit_Pos : Ghdl_Index_Type;
               Lit_End : Ghdl_Index_Type;
               Unit_Pos : Ghdl_Index_Type;
               Unit_Len : Ghdl_Index_Type;
               Mult : Ghdl_I64;
               Unit : Iir;
               Unit_Id : Name_Id;
            begin
               Grt.Values.Ghdl_Value_Physical_Split
                 (Str'Unrestricted_Access,
                  Is_Real, Lit_Pos, Lit_End, Unit_Pos);

               --  Find unit.
               Unit_Len := 0;
               Unit_Pos := Unit_Pos + 1;   --  From 0 based to 1 based
               for I in Unit_Pos .. Str_Bnd.Dim_1.Length loop
                  exit when Grt.Strings.Is_Whitespace (Str_Str (I));
                  Unit_Len := Unit_Len + 1;
                  Str_Str (I) := Grt.Strings.To_Lower (Str_Str (I));
               end loop;

               Unit := Get_Primary_Unit (Expr_Type);
               while Unit /= Null_Iir loop
                  Unit_Id := Get_Identifier (Unit);
                  exit when Get_Name_Length (Unit_Id) = Natural (Unit_Len)
                    and then Image (Unit_Id) =
                    String (Str_Str (Unit_Pos .. Unit_Pos + Unit_Len - 1));
                  Unit := Get_Chain (Unit);
               end loop;

               if Unit = Null_Iir then
                  Error_Msg_Exec ("incorrect unit name", Expr);
               end if;
               Mult := Ghdl_I64 (Get_Value (Get_Physical_Literal (Unit)));

               Str_Bnd.Dim_1.Length := Lit_End;
               if Is_Real then
                  Res := Create_I64_Value
                    (Ghdl_I64
                       (Grt.Values.Ghdl_Value_F64 (Str'Unrestricted_Access)
                          * Ghdl_F64 (Mult)));
               else
                  Res := Create_I64_Value
                    (Grt.Values.Ghdl_Value_I64 (Str'Unrestricted_Access)
                       * Mult);
               end if;
            end;
         when Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Enumeration_Subtype_Definition =>
            declare
               Enums : constant Iir_Flist :=
                 Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type));
               Lit_Start : Ghdl_Index_Type;
               Lit_End : Ghdl_Index_Type;
               Enum : Iir;
               Lit_Id : Name_Id;
               Enum_Id : Name_Id;
            begin
               --  Remove leading and trailing blanks
               for I in Str_Str'Range loop
                  if not Grt.Strings.Is_Whitespace (Str_Str (I)) then
                     Lit_Start := I;
                     exit;
                  end if;
               end loop;
               for I in reverse Lit_Start .. Str_Str'Last loop
                  if not Grt.Strings.Is_Whitespace (Str_Str (I)) then
                     Lit_End := I;
                     exit;
                  end if;
               end loop;

               if Str_Str (Lit_Start) = '''
                 and then Str_Str (Lit_End) = '''
                 and then Lit_End = Lit_Start + 2
               then
                  --  Enumeration literal.
                  Lit_Id := Get_Identifier (Str_Str (Lit_Start + 1));

                  for I in Natural loop
                     Enum := Get_Nth_Element (Enums, I);
                     exit when Enum = Null_Iir;
                     exit when Get_Identifier (Enum) = Lit_Id;
                  end loop;
               else
                  --  Literal identifier.
                  --  Convert to lower case.
                  for I in Lit_Start .. Lit_End loop
                     Str_Str (I) := Grt.Strings.To_Lower (Str_Str (I));
                  end loop;

                  for I in Natural loop
                     Enum := Get_Nth_Element (Enums, I);
                     exit when Enum = Null_Iir;
                     Enum_Id := Get_Identifier (Enum);
                     exit when (Get_Name_Length (Enum_Id) =
                                  Natural (Lit_End - Lit_Start + 1))
                       and then (Image (Enum_Id) =
                                   String (Str_Str (Lit_Start .. Lit_End)));
                  end loop;
               end if;

               if Enum = Null_Iir then
                  Error_Msg_Exec
                    ("incorrect enumeration literal for 'value", Expr);
               end if;

               return Create_Enum_Value
                 (Natural (Get_Enum_Pos (Enum)), Expr_Type);
            end;
         when others =>
            Error_Kind ("value_attribute", Expr_Type);
      end case;
      return Res;
   end Execute_Value_Attribute;

   --  For 'Last_Event and 'Last_Active: convert the absolute last time to
   --  a relative delay.
   function To_Relative_Time (T : Ghdl_I64) return Iir_Value_Literal_Acc
   is
      A : Ghdl_I64;
   begin
      if T = -Ghdl_I64'Last then
         A := Ghdl_I64'Last;
      else
         A := Ghdl_I64 (Grt.Types.Current_Time) - T;
      end if;
      return Create_I64_Value (A);
   end To_Relative_Time;

   -- Evaluate an expression.
   function Execute_Expression (Block: Block_Instance_Acc; Expr: Iir)
                               return Iir_Value_Literal_Acc
   is
      Res: Iir_Value_Literal_Acc;
   begin
      case Get_Kind (Expr) is
         when Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Guard_Signal_Declaration
           | Iir_Kind_Stable_Attribute
           | Iir_Kind_Quiet_Attribute
           | Iir_Kind_Delayed_Attribute
           | Iir_Kind_Transaction_Attribute
           | Iir_Kind_Object_Alias_Declaration =>
            Res := Execute_Name (Block, Expr);
            return Res;

         when Iir_Kind_Interface_Constant_Declaration
           | Iir_Kind_Constant_Declaration
           | Iir_Kind_Interface_Variable_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Interface_File_Declaration
           | Iir_Kind_File_Declaration
           | Iir_Kind_Attribute_Value
           | Iir_Kind_Iterator_Declaration
           | Iir_Kind_Indexed_Name
           | Iir_Kind_Slice_Name
           | Iir_Kind_Selected_Element
           | Iir_Kind_Dereference
           | Iir_Kind_Implicit_Dereference
           | Iir_Kind_Psl_Endpoint_Declaration =>
            return Execute_Name (Block, Expr);

         when Iir_Kinds_Denoting_Name
           | Iir_Kind_Attribute_Name =>
            return Execute_Expression (Block, Get_Named_Entity (Expr));

         when Iir_Kind_Aggregate =>
            return Execute_Aggregate (Block, Expr, Block, Get_Type (Expr));
         when Iir_Kind_Simple_Aggregate =>
            return Execute_Simple_Aggregate (Block, Expr);

         when Iir_Kinds_Dyadic_Operator
           | Iir_Kinds_Monadic_Operator =>
            declare
               Imp : constant Iir := Get_Implementation (Expr);
            begin
               if Get_Implicit_Definition (Imp) in Iir_Predefined_Explicit then
                  return Execute_Function_Call (Block, Expr, Imp);
               else
                  if Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator then
                     Res := Execute_Implicit_Function
                       (Block, Expr, Get_Left (Expr), Get_Right (Expr),
                        Get_Type (Expr));
                  else
                     Res := Execute_Implicit_Function
                       (Block, Expr, Get_Operand (Expr), Null_Iir,
                        Get_Type (Expr));
                  end if;
                  return Res;
               end if;
            end;

         when Iir_Kind_Function_Call =>
            declare
               Imp : constant Iir := Get_Implementation (Expr);
               Assoc : Iir;
               Args : Iir_Array (0 .. 1);
            begin
               if Get_Implicit_Definition (Imp) in Iir_Predefined_Explicit then
                  return Execute_Function_Call (Block, Expr, Imp);
               else
                  Assoc := Get_Parameter_Association_Chain (Expr);
                  if Assoc /= Null_Iir then
                     Args (0) := Get_Actual (Assoc);
                     Assoc := Get_Chain (Assoc);
                  else
                     Args (0) := Null_Iir;
                  end if;
                  if Assoc /= Null_Iir  then
                     Args (1) := Get_Actual (Assoc);
                  else
                     Args (1) := Null_Iir;
                  end if;
                  return Execute_Implicit_Function
                    (Block, Expr, Args (0), Args (1), Get_Type (Expr));
               end if;
            end;

         when Iir_Kind_Integer_Literal =>
            declare
               Lit_Type : constant Iir := Get_Base_Type (Get_Type (Expr));
               Lit : constant Int64 := Get_Value (Expr);
            begin
               case Get_Info (Lit_Type).Kind is
                  when Kind_I64_Type =>
                     return Create_I64_Value (Ghdl_I64 (Lit));
                  when others =>
                     raise Internal_Error;
               end case;
            end;

         when Iir_Kind_Floating_Point_Literal =>
            return Create_F64_Value (Ghdl_F64 (Get_Fp_Value (Expr)));

         when Iir_Kind_Enumeration_Literal =>
            return Create_Enum_Value (Natural (Get_Enum_Pos (Expr)),
                                      Get_Type (Expr));

         when Iir_Kind_Physical_Int_Literal
           | Iir_Kind_Physical_Fp_Literal
           | Iir_Kind_Unit_Declaration =>
            return Create_I64_Value
              (Ghdl_I64 (Vhdl.Evaluation.Get_Physical_Value (Expr)));

         when Iir_Kind_String_Literal8 =>
            return Execute_String_Literal (Expr, Block);

         when Iir_Kind_Null_Literal =>
            return Null_Lit;

         when Iir_Kind_Overflow_Literal =>
            Error_Msg_Constraint (Expr);
            return null;

         when Iir_Kind_Parenthesis_Expression =>
            return Execute_Expression (Block, Get_Expression (Expr));

         when Iir_Kind_Type_Conversion =>
            return Execute_Type_Conversion
              (Block, Execute_Expression (Block, Get_Expression (Expr)),
               Get_Type (Expr), Expr);

         when Iir_Kind_Qualified_Expression =>
            Res := Execute_Expression_With_Type
              (Block, Get_Expression (Expr), Get_Type (Get_Type_Mark (Expr)));
            return Res;

         when Iir_Kind_Allocator_By_Expression =>
            Res := Execute_Expression (Block, Get_Expression (Expr));
            Res := Unshare_Heap (Res);
            return Create_Access_Value (Res);

         when Iir_Kind_Allocator_By_Subtype =>
            Res := Create_Value_For_Type
              (Block,
               Get_Type_Of_Subtype_Indication (Get_Subtype_Indication (Expr)),
               Init_Value_Default);
            Res := Unshare_Heap (Res);
            return Create_Access_Value (Res);

         when Iir_Kind_Left_Type_Attribute =>
            Res := Execute_Bounds (Block, Get_Prefix (Expr));
            return Execute_Left_Limit (Res);

         when Iir_Kind_Right_Type_Attribute =>
            Res := Execute_Bounds (Block, Get_Prefix (Expr));
            return Execute_Right_Limit (Res);

         when Iir_Kind_High_Type_Attribute =>
            Res := Execute_Bounds (Block, Get_Prefix (Expr));
            return Execute_High_Limit (Res);

         when Iir_Kind_Low_Type_Attribute =>
            Res := Execute_Bounds (Block, Get_Prefix (Expr));
            return Execute_Low_Limit (Res);

         when Iir_Kind_High_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Execute_High_Limit (Res);

         when Iir_Kind_Low_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Execute_Low_Limit (Res);

         when Iir_Kind_Left_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Execute_Left_Limit (Res);

         when Iir_Kind_Right_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Execute_Right_Limit (Res);

         when Iir_Kind_Length_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Execute_Length (Res);

         when Iir_Kind_Ascending_Array_Attribute =>
            Res := Execute_Indexes (Block, Expr);
            return Boolean_To_Lit (Res.Dir = Dir_To);

         when Iir_Kind_Event_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return Boolean_To_Lit (Execute_Event_Attribute (Res));

         when Iir_Kind_Active_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return Boolean_To_Lit (Execute_Active_Attribute (Res));

         when Iir_Kind_Driving_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return Boolean_To_Lit (Execute_Driving_Attribute (Res));

         when Iir_Kind_Last_Value_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return Execute_Last_Value_Attribute (Res);

         when Iir_Kind_Driving_Value_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return Execute_Driving_Value_Attribute (Res);

         when Iir_Kind_Last_Event_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return To_Relative_Time (Execute_Last_Event_Attribute (Res));

         when Iir_Kind_Last_Active_Attribute =>
            Res := Execute_Name (Block, Get_Prefix (Expr), True);
            return To_Relative_Time (Execute_Last_Active_Attribute (Res));

         when Iir_Kind_Val_Attribute =>
            declare
               Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr));
               Base_Type : constant Iir := Get_Base_Type (Prefix_Type);
               Kind : constant Kind_Discrete_Types :=
                 Get_Info (Base_Type).Kind;
            begin
               Res := Execute_Expression (Block, Get_Parameter (Expr));
               case Kind is
                  when Kind_I64_Type =>
                     null;
                  when Kind_E8_Type
                    | Kind_Log_Type =>
                     Res := Create_E8_Value (Ghdl_E8 (Res.I64));
                  when Kind_E32_Type =>
                     Res := Create_E32_Value (Ghdl_E32 (Res.I64));
                  when Kind_Bit_Type =>
                     Res := Create_B1_Value (Ghdl_B1'Val (Res.I64));
               end case;
               Check_Constraints (Block, Res, Prefix_Type, Expr);
               return Res;
            end;

         when Iir_Kind_Pos_Attribute =>
            declare
               N_Res: Iir_Value_Literal_Acc;
               Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr));
               Base_Type : constant Iir := Get_Base_Type (Prefix_Type);
               Mode : constant Kind_Discrete_Types :=
                 Get_Info (Base_Type).Kind;
            begin
               Res := Execute_Expression (Block, Get_Parameter (Expr));
               case Mode is
                  when Kind_I64_Type =>
                     null;
                  when Kind_Bit_Type =>
                     N_Res := Create_I64_Value (Ghdl_B1'Pos (Res.B1));
                     Res := N_Res;
                  when Kind_E8_Type
                    | Kind_Log_Type =>
                     N_Res := Create_I64_Value (Ghdl_I64 (Res.E8));
                     Res := N_Res;
                  when Kind_E32_Type =>
                     N_Res := Create_I64_Value (Ghdl_I64 (Res.E32));
                     Res := N_Res;
               end case;
               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
               return Res;
            end;

         when Iir_Kind_Succ_Attribute =>
            Res := Execute_Expression (Block, Get_Parameter (Expr));
            Res := Execute_Inc (Res, Expr);
            Check_Constraints (Block, Res, Get_Type (Expr), Expr);
            return Res;

         when Iir_Kind_Pred_Attribute =>
            Res := Execute_Expression (Block, Get_Parameter (Expr));
            Res := Execute_Dec (Res, Expr);
            Check_Constraints (Block, Res, Get_Type (Expr), Expr);
            return Res;

         when Iir_Kind_Leftof_Attribute =>
            declare
               Bound : Iir_Value_Literal_Acc;
            begin
               Res := Execute_Expression (Block, Get_Parameter (Expr));
               Bound := Execute_Bounds
                 (Block, Get_Type (Get_Prefix (Expr)));
               case Bound.Dir is
                  when Dir_To =>
                     Res := Execute_Dec (Res, Expr);
                  when Dir_Downto =>
                     Res := Execute_Inc (Res, Expr);
               end case;
               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
               return Res;
            end;

         when Iir_Kind_Rightof_Attribute =>
            declare
               Bound : Iir_Value_Literal_Acc;
            begin
               Res := Execute_Expression (Block, Get_Parameter (Expr));
               Bound := Execute_Bounds
                 (Block, Get_Type (Get_Prefix (Expr)));
               case Bound.Dir is
                  when Dir_Downto =>
                     Res := Execute_Dec (Res, Expr);
                  when Dir_To =>
                     Res := Execute_Inc (Res, Expr);
               end case;
               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
               return Res;
            end;

         when Iir_Kind_Image_Attribute =>
            return Execute_Image_Attribute (Block, Expr);

         when Iir_Kind_Value_Attribute =>
            Res := Execute_Expression (Block, Get_Parameter (Expr));
            return Execute_Value_Attribute (Block, Res, Expr);

         when Iir_Kind_Path_Name_Attribute
           | Iir_Kind_Instance_Name_Attribute =>
            return Execute_Path_Instance_Name_Attribute (Block, Expr);

         when others =>
            Error_Kind ("execute_expression", Expr);
      end case;
   end Execute_Expression;

   procedure Execute_Dyadic_Association (Out_Block: Block_Instance_Acc;
                                         In_Block: Block_Instance_Acc;
                                         Expr : Iir;
                                         Inter_Chain: Iir)
   is
      Inter: Iir;
      Val: Iir_Value_Literal_Acc;
   begin
      Inter := Inter_Chain;
      for I in 0 .. 1 loop
         if I = 0 then
            Val := Execute_Expression (Out_Block, Get_Left (Expr));
         else
            Val := Execute_Expression (Out_Block, Get_Right (Expr));
         end if;
         Implicit_Array_Conversion (In_Block, Val, Get_Type (Inter), Expr);
         Check_Constraints (In_Block, Val, Get_Type (Inter), Expr);

         Elaboration.Create_Object (In_Block, Inter);
         In_Block.Objects (Get_Info (Inter).Slot) :=
           Unshare (Val, Instance_Pool);
         Inter := Get_Chain (Inter);
      end loop;
   end Execute_Dyadic_Association;

   procedure Execute_Monadic_Association (Out_Block: Block_Instance_Acc;
                                          In_Block: Block_Instance_Acc;
                                          Expr : Iir;
                                          Inter: Iir)
   is
      Val: Iir_Value_Literal_Acc;
   begin
      Val := Execute_Expression (Out_Block, Get_Operand (Expr));
      Implicit_Array_Conversion (In_Block, Val, Get_Type (Inter), Expr);
      Check_Constraints (In_Block, Val, Get_Type (Inter), Expr);

      Elaboration.Create_Object (In_Block, Inter);
      In_Block.Objects (Get_Info (Inter).Slot) :=
        Unshare (Val, Instance_Pool);
   end Execute_Monadic_Association;

   --  Like Get_Protected_Type_Body, but also works for instances, where
   --  instantiated nodes have no bodies.
   --  FIXME: maybe fix the issue directly in Sem_Inst ?
   function Get_Protected_Type_Body_Origin (Spec : Iir) return Iir
   is
      Res : constant Iir := Get_Protected_Type_Body (Spec);
      Orig : Iir;
   begin
      if Res /= Null_Iir then
         return Res;
      else
         Orig := Vhdl.Sem_Inst.Get_Origin (Spec);
         return Get_Protected_Type_Body_Origin (Orig);
      end if;
   end Get_Protected_Type_Body_Origin;

   --  Create a block instance for subprogram IMP.
   function Create_Subprogram_Instance (Instance : Block_Instance_Acc;
                                        Prot_Obj : Block_Instance_Acc;
                                        Imp : Iir)
                                       return Block_Instance_Acc
   is
      Parent : Iir;
      Bod : Iir;

      Up_Block: Block_Instance_Acc;
      Up_Info : Sim_Info_Acc;

      Label : Iir;
   begin
      case Get_Kind (Imp) is
         when Iir_Kinds_Subprogram_Declaration =>
            Bod := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp);
            Parent := Get_Parent (Imp);
            Label := Get_Subprogram_Specification (Bod);
         when Iir_Kind_Protected_Type_Declaration =>
            --  The parent of the protected type body must have the same scope
            --  as the parent of the protected type declaration.
            Bod := Get_Protected_Type_Body_Origin (Imp);
            Parent := Get_Parent (Get_Type_Declarator (Imp));
            Label := Imp;
         when others =>
            Error_Kind ("create_subprogram_instance", Imp);
      end case;

      if Prot_Obj /= null then
         --  This is a call to a method (from the outside to a subprogram of
         --  a protected type). Put the protected object as upblock.
         Up_Block := Prot_Obj;
      else
         --  This is a normal subprogram call.
         Up_Info := Get_Info_For_Scope (Parent);
         Up_Block := Get_Instance_By_Scope (Instance, Up_Info);
      end if;

      --  Extract the info from the body, as it is complete (has slot for
      --  internal declarations).  Usually, body and spec share the same info,
      --  but there are exceptions: there can be multiple spec for the same
      --  body for shared generic packages.
      declare
         Func_Info : constant Sim_Info_Acc := Get_Info (Bod);

         subtype Block_Type is Block_Instance_Type (Func_Info.Nbr_Objects);
         function To_Block_Instance_Acc is new
           Ada.Unchecked_Conversion (System.Address, Block_Instance_Acc);
         function Alloc_Block_Instance is new
           Alloc_On_Pool_Addr (Block_Type);

         Res : Block_Instance_Acc;
      begin
         Res := To_Block_Instance_Acc
           (Alloc_Block_Instance
              (Instance_Pool,
               Block_Instance_Type'(Max_Objs => Func_Info.Nbr_Objects,
                                    Id => No_Block_Instance_Id,
                                    Block_Scope => Get_Info (Label),
                                    Uninst_Scope => null,
                                    Up_Block => Up_Block,
                                    Label => Imp,
                                    Bod => Bod,
                                    Stmt => Null_Iir,
                                    Parent => Instance,
                                    Children => null,
                                    Brother => null,
                                    Marker => Empty_Marker,
                                    Objects => (others => null),
                                    Elab_Objects => 0,
                                    In_Wait_Flag => False,
                                    Actuals_Ref => null,
                                    Result => null)));
         return Res;
      end;
   end Create_Subprogram_Instance;

   function Get_Protected_Object_Instance
     (Block : Block_Instance_Acc; Call : Iir) return Block_Instance_Acc
   is
      Meth_Obj : constant Iir := Get_Method_Object (Call);
      Obj : Iir_Value_Literal_Acc;
   begin
      if Meth_Obj = Null_Iir then
         return null;
      else
         Obj := Execute_Name (Block, Meth_Obj, True);
         return Protected_Table.Table (Obj.Prot);
      end if;
   end Get_Protected_Object_Instance;

   -- Destroy a dynamic block_instance.
   procedure Execute_Subprogram_Call_Final (Instance : Block_Instance_Acc) is
   begin
      Finalize_Declarative_Part
        (Instance, Get_Declaration_Chain (Instance.Bod));
   end Execute_Subprogram_Call_Final;

   function Execute_Function_Body (Instance : Block_Instance_Acc)
                                  return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      Current_Process.Instance := Instance;

      Elaborate_Declarative_Part
        (Instance, Get_Declaration_Chain (Instance.Bod));

      -- execute statements
      Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Bod);
      Execute_Sequential_Statements (Current_Process);
      pragma Assert (Current_Process.Instance = Instance);

      if Instance.Result = null then
         Error_Msg_Exec
           ("function scope exited without a return statement",
            Instance.Label);
      end if;

      -- Free variables, slots...
      -- Need to copy the return value, because it can contains values from
      -- arguments.
      Res := Instance.Result;

      Current_Process.Instance := Instance.Parent;
      Execute_Subprogram_Call_Final (Instance);

      return Res;
   end Execute_Function_Body;

   function Execute_Assoc_Function_Conversion (Block : Block_Instance_Acc;
                                               Func : Iir;
                                               Prot_Block : Block_Instance_Acc;
                                               Val : Iir_Value_Literal_Acc)
                                              return Iir_Value_Literal_Acc
   is
      Inter : Iir;
      Instance : Block_Instance_Acc;
      Res : Iir_Value_Literal_Acc;
      Marker : Mark_Type;
   begin
      Mark (Marker, Instance_Pool.all);

      -- Create an instance for this function.
      Instance := Create_Subprogram_Instance (Block, Prot_Block, Func);

      Inter := Get_Interface_Declaration_Chain (Func);
      Elaboration.Create_Object (Instance, Inter);
      --  FIXME: implicit conversion
      Instance.Objects (Get_Info (Inter).Slot) := Val;

      Res := Execute_Function_Body (Instance);
      Res := Unshare (Res, Expr_Pool'Access);
      Release (Marker, Instance_Pool.all);
      return Res;
   end Execute_Assoc_Function_Conversion;

   function Execute_Assoc_Conversion
     (Block : Block_Instance_Acc; Conv : Iir; Val : Iir_Value_Literal_Acc)
     return Iir_Value_Literal_Acc
   is
      Ent : Iir;
      Prot_Block : Block_Instance_Acc;
   begin
      case Get_Kind (Conv) is
         when Iir_Kind_Function_Call =>
            --  FIXME: shouldn't CONV always be a denoting_name ?
            Prot_Block := Get_Protected_Object_Instance (Block, Conv);
            return Execute_Assoc_Function_Conversion
              (Block, Get_Implementation (Conv), Prot_Block, Val);
         when Iir_Kind_Type_Conversion =>
            --  FIXME: shouldn't CONV always be a denoting_name ?
            return Execute_Type_Conversion (Block, Val, Get_Type (Conv), Conv);
         when Iir_Kinds_Denoting_Name
           | Iir_Kind_Function_Declaration =>
            Ent := Strip_Denoting_Name (Conv);
            if Get_Kind (Ent) = Iir_Kind_Function_Declaration then
               return Execute_Assoc_Function_Conversion
                 (Block, Ent, null, Val);
            elsif Get_Kind (Ent) in Iir_Kinds_Type_Declaration then
               return Execute_Type_Conversion
                 (Block, Val, Get_Type (Ent), Ent);
            else
               Error_Kind ("execute_assoc_conversion(1)", Ent);
            end if;
         when others =>
            Error_Kind ("execute_assoc_conversion(2)", Conv);
      end case;
   end Execute_Assoc_Conversion;

   procedure Associate_By_Reference (Block : Block_Instance_Acc;
                                     Formal : Iir;
                                     Formal_Base : Iir_Value_Literal_Acc;
                                     Actual : Iir_Value_Literal_Acc)
   is
      Prefix : constant Iir := Strip_Denoting_Name (Get_Prefix (Formal));
      Is_Sig : Boolean;
      Pfx : Iir_Value_Literal_Acc;
      Pos : Iir_Index32;
   begin
      if Get_Kind (Prefix) = Iir_Kind_Slice_Name then
         --  That case is not handled correctly.
         raise Program_Error;
      end if;
      Execute_Name_With_Base (Block, Prefix, Formal_Base, Pfx, Is_Sig);

      case Get_Kind (Formal) is
         when Iir_Kind_Indexed_Name =>
            Execute_Indexed_Name (Block, Formal, Pfx, Pos);
            Store (Pfx.Val_Array.V (Pos + 1), Actual);
         when Iir_Kind_Slice_Name =>
            declare
               Low, High : Iir_Index32;
               Srange : Iir_Value_Literal_Acc;
            begin
               Srange := Execute_Bounds (Block, Get_Suffix (Formal));
               Execute_Slice_Name (Pfx, Srange, Low, High, Formal);
               for I in 1 .. High - Low + 1 loop
                  Store (Pfx.Val_Array.V (Low + I), Actual.Val_Array.V (I));
               end loop;
            end;
         when Iir_Kind_Selected_Element =>
            Pos := Get_Element_Position (Get_Named_Entity (Formal));
            Store (Pfx.Val_Record.V (Pos + 1), Actual);
         when others =>
            Error_Kind ("associate_by_reference", Formal);
      end case;
   end Associate_By_Reference;

   --  Establish correspondance for association list ASSOC_LIST from block
   --  instance OUT_BLOCK for subprogram of block SUBPRG_BLOCK.
   procedure Execute_Association (Out_Block : Block_Instance_Acc;
                                  Subprg_Block : Block_Instance_Acc;
                                  Inter_Chain : Iir;
                                  Assoc_Chain : Iir)
   is
      Nbr_Assoc : constant Natural := Get_Chain_Length (Assoc_Chain);
      Assoc: Iir;
      Assoc_Inter : Iir;
      Actual : Iir;
      Inter: Iir;
      Formal : Iir;
      Conv : Iir;
      Val: Iir_Value_Literal_Acc;
      Assoc_Idx : Iir_Index32;
      Last_Individual : Iir_Value_Literal_Acc;
      Mode : Iir_Mode;
      Marker : Mark_Type;
   begin
      Subprg_Block.Actuals_Ref := null;
      Mark (Marker, Expr_Pool);

      Assoc := Assoc_Chain;
      Assoc_Inter := Inter_Chain;
      Assoc_Idx := 1;
      while Assoc /= Null_Iir loop
         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
         Formal := Get_Association_Formal (Assoc, Inter);

         --  Extract the actual value.
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_Open =>
               --  Not allowed in individual association.
               pragma Assert (Formal = Inter);
               pragma Assert (Get_Whole_Association_Flag (Assoc));
               Actual := Get_Default_Value (Inter);
            when Iir_Kind_Association_Element_By_Expression =>
               Actual := Get_Actual (Assoc);
            when Iir_Kind_Association_Element_By_Individual =>
               --  Directly create the whole value on the instance pool, as its
               --  life is longer than the statement.
               if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
                  Last_Individual := Create_Value_For_Type
                    (Out_Block, Get_Actual_Type (Assoc), Init_Value_Signal);
               else
                  Last_Individual := Create_Value_For_Type
                    (Out_Block, Get_Actual_Type (Assoc), Init_Value_Any);
               end if;
               Last_Individual :=
                 Unshare (Last_Individual, Instance_Pool);
               Elaboration.Create_Object (Subprg_Block, Inter);
               Subprg_Block.Objects (Get_Info (Inter).Slot) := Last_Individual;
               goto Continue;
            when others =>
               Error_Kind ("execute_association(1)", Assoc);
         end case;

         --  Compute actual value.
         case Get_Kind (Inter) is
            when Iir_Kind_Interface_Constant_Declaration
              | Iir_Kind_Interface_File_Declaration =>
               Val := Execute_Expression (Out_Block, Actual);
               Implicit_Array_Conversion
                 (Out_Block, Val, Get_Type (Formal), Assoc);
               Check_Constraints (Out_Block, Val, Get_Type (Formal), Assoc);
            when Iir_Kind_Interface_Signal_Declaration =>
               Val := Execute_Name (Out_Block, Actual, True);
               Implicit_Array_Conversion
                 (Out_Block, Val, Get_Type (Formal), Assoc);
            when Iir_Kind_Interface_Variable_Declaration =>
               Mode := Get_Mode (Inter);
               if Mode = Iir_In_Mode then
                  --  FIXME: Ref ?
                  Val := Execute_Expression (Out_Block, Actual);
               else
                  Val := Execute_Name (Out_Block, Actual, False);
               end if;

               --  FIXME: by value for scalars ?

               --  Keep ref for back-copy
               if Mode /= Iir_In_Mode then
                  if Subprg_Block.Actuals_Ref = null then
                     declare
                        subtype Actuals_Ref_Type is
                          Value_Array (Iir_Index32 (Nbr_Assoc));
                        function To_Value_Array_Acc is new
                          Ada.Unchecked_Conversion (System.Address,
                                                    Value_Array_Acc);
                        function Alloc_Actuals_Ref is new
                          Alloc_On_Pool_Addr (Actuals_Ref_Type);

                     begin
                        Subprg_Block.Actuals_Ref := To_Value_Array_Acc
                          (Alloc_Actuals_Ref
                             (Instance_Pool,
                              Actuals_Ref_Type'(Len => Iir_Index32 (Nbr_Assoc),
                                                V => (others => null))));
                     end;
                  end if;
                  Subprg_Block.Actuals_Ref.V (Assoc_Idx) :=
                    Unshare_Bounds (Val, Instance_Pool);
               end if;

               if Mode = Iir_Out_Mode then
                  if Get_Formal_Conversion (Assoc) /= Null_Iir then
                     --  For an OUT variable using an out conversion, don't
                     --  associate with the actual, create a temporary value.
                     Val := Create_Value_For_Type
                       (Out_Block, Get_Type (Formal), Init_Value_Default);
                  elsif Get_Kind (Get_Type (Formal)) in
                    Iir_Kinds_Scalar_Type_And_Subtype_Definition
                  then
                     --  These are passed by value.  Must be reset.
                     Val := Create_Value_For_Type
                       (Out_Block, Get_Type (Formal), Init_Value_Default);
                  end if;
               else
                  if Get_Kind (Assoc) =
                    Iir_Kind_Association_Element_By_Expression
                  then
                     Conv := Get_Actual_Conversion (Assoc);
                     if Conv /= Null_Iir then
                        Val := Execute_Assoc_Conversion
                          (Out_Block, Conv, Val);
                     end if;
                  end if;

                  --  FIXME: check constraints ?
               end if;

               Implicit_Array_Conversion
                 (Out_Block, Val, Get_Type (Formal), Assoc);

            when others =>
               Error_Kind ("execute_association(2)", Inter);
         end case;

         if Get_Whole_Association_Flag (Assoc) then
            case Get_Kind (Inter) is
               when Iir_Kind_Interface_Constant_Declaration
                 | Iir_Kind_Interface_Variable_Declaration
                 | Iir_Kind_Interface_File_Declaration =>
                  --  FIXME: Arguments are passed by copy.
                  Elaboration.Create_Object (Subprg_Block, Inter);
                  Subprg_Block.Objects (Get_Info (Inter).Slot) :=
                    Unshare (Val, Instance_Pool);
               when Iir_Kind_Interface_Signal_Declaration =>
                  Elaboration.Create_Signal (Subprg_Block, Inter);
                  Subprg_Block.Objects (Get_Info (Inter).Slot) :=
                    Unshare_Bounds (Val, Instance_Pool);
               when others =>
                  Error_Kind ("execute_association", Inter);
            end case;
         else
            Associate_By_Reference
              (Subprg_Block, Formal, Last_Individual, Val);
         end if;

         << Continue >> null;
         Next_Association_Interface (Assoc, Assoc_Inter);
         Assoc_Idx := Assoc_Idx + 1;
      end loop;

      Release (Marker, Expr_Pool);
   end Execute_Association;

   procedure Execute_Back_Association (Instance : Block_Instance_Acc)
   is
      Call : constant Iir := Get_Procedure_Call (Instance.Parent.Stmt);
      Imp : constant Iir := Get_Implementation (Call);
      Assoc : Iir;
      Assoc_Inter : Iir;
      Inter : Iir;
      Formal : Iir;
      Assoc_Idx : Iir_Index32;
   begin
      Assoc := Get_Parameter_Association_Chain (Call);
      Assoc_Inter := Get_Interface_Declaration_Chain (Imp);
      Assoc_Idx := 1;
      while Assoc /= Null_Iir loop
         if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then
            Inter := Get_Association_Interface (Assoc, Assoc_Inter);
            Formal := Get_Association_Formal (Assoc, Inter);

            case Get_Kind (Inter) is
               when Iir_Kind_Interface_Variable_Declaration =>
                  if Get_Mode (Inter) /= Iir_In_Mode
                    and then Get_Kind (Get_Type (Inter)) /=
                    Iir_Kind_File_Type_Definition
                  then
                     --  For out/inout variable interface, the value must
                     --  be copied (FIXME: unless when passed by reference ?).
                     declare
                        Targ : constant Iir_Value_Literal_Acc :=
                          Instance.Actuals_Ref.V (Assoc_Idx);
                        Base : constant Iir_Value_Literal_Acc :=
                          Instance.Objects (Get_Info (Inter).Slot);
                        Val : Iir_Value_Literal_Acc;
                        Conv : Iir;
                        Is_Sig : Boolean;
                        Expr_Mark : Mark_Type;
                     begin
                        Mark (Expr_Mark, Expr_Pool);

                        --  Extract for individual association.
                        Execute_Name_With_Base
                          (Instance, Formal, Base, Val, Is_Sig);
                        Conv := Get_Formal_Conversion (Assoc);
                        if Conv /= Null_Iir then
                           Val := Execute_Assoc_Conversion
                             (Instance, Conv, Val);
                           --  FIXME: free val ?
                        end if;
                        Store (Targ, Val);

                        Release (Expr_Mark, Expr_Pool);
                     end;
                  end if;
               when Iir_Kind_Interface_File_Declaration =>
                  null;
               when Iir_Kind_Interface_Signal_Declaration
                 | Iir_Kind_Interface_Constant_Declaration =>
                  null;
               when others =>
                  Error_Kind ("execute_back_association", Inter);
            end case;
         end if;
         Next_Association_Interface (Assoc, Assoc_Inter);
         Assoc_Idx := Assoc_Idx + 1;
      end loop;
   end Execute_Back_Association;

   function Execute_Foreign_Function_Call
     (Block: Block_Instance_Acc; Expr : Iir; Imp : Iir)
      return Iir_Value_Literal_Acc
   is
      Res : Iir_Value_Literal_Acc;
   begin
      case Get_Identifier (Imp) is
         when Std_Names.Name_Get_Resolution_Limit =>
            Res := Create_I64_Value (1);
         when Std_Names.Name_Textio_Read_Real =>
            Res := Create_F64_Value
              (File_Operation.Textio_Read_Real (Block.Objects (1)));
         when others =>
            Error_Msg_Exec ("unsupported foreign function call", Expr);
      end case;
      return Res;
   end Execute_Foreign_Function_Call;

   -- BLOCK is the block instance in which the function call appears.
   function Execute_Function_Call
     (Block: Block_Instance_Acc; Expr: Iir; Imp : Iir)
      return Iir_Value_Literal_Acc
   is
      Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp);
      Subprg_Block: Block_Instance_Acc;
      Prot_Block : Block_Instance_Acc;
      Assoc_Chain: Iir;
      Res : Iir_Value_Literal_Acc;
   begin
      Mark (Block.Marker, Instance_Pool.all);

      case Get_Kind (Expr) is
         when Iir_Kind_Function_Call =>
            Prot_Block := Get_Protected_Object_Instance (Block, Expr);
            Subprg_Block :=
              Create_Subprogram_Instance (Block, Prot_Block, Imp);
            Assoc_Chain := Get_Parameter_Association_Chain (Expr);
            Execute_Association
              (Block, Subprg_Block, Inter_Chain, Assoc_Chain);
            --  No out/inout interface for functions.
            pragma Assert (Subprg_Block.Actuals_Ref = null);
         when Iir_Kinds_Dyadic_Operator =>
            Subprg_Block := Create_Subprogram_Instance (Block, null, Imp);
            Execute_Dyadic_Association
              (Block, Subprg_Block, Expr, Inter_Chain);
         when Iir_Kinds_Monadic_Operator =>
            Subprg_Block := Create_Subprogram_Instance (Block, null, Imp);
            Execute_Monadic_Association
              (Block, Subprg_Block, Expr, Inter_Chain);
         when others =>
            Error_Kind ("execute_subprogram_call_init", Expr);
      end case;

      if Get_Foreign_Flag (Imp) then
         Res := Execute_Foreign_Function_Call (Subprg_Block, Expr, Imp);
      else
         Res := Execute_Function_Body (Subprg_Block);
      end if;

      --  Unfortunately, we don't know where the result has been allocated,
      --  so copy it before releasing the instance pool.
      Res := Unshare (Res, Expr_Pool'Access);

      Release (Block.Marker, Instance_Pool.all);

      return Res;
   end Execute_Function_Call;

   --  Slide an array VALUE using bounds from REF_VALUE.  Do not modify
   --  VALUE if not an array.
   procedure Implicit_Array_Conversion (Value : in out Iir_Value_Literal_Acc;
                                        Ref_Value : Iir_Value_Literal_Acc;
                                        Expr : Iir)
   is
      Res : Iir_Value_Literal_Acc;
   begin
      if Value.Kind /= Iir_Value_Array then
         return;
      end if;
      Res := Create_Array_Value (Value.Bounds.Nbr_Dims);
      Res.Val_Array := Value.Val_Array;
      for I in Value.Bounds.D'Range loop
         if Value.Bounds.D (I).Length /= Ref_Value.Bounds.D (I).Length then
            Error_Msg_Constraint (Expr);
            return;
         end if;
         Res.Bounds.D (I) := Ref_Value.Bounds.D (I);
      end loop;
      Value := Res;
   end Implicit_Array_Conversion;

   procedure Implicit_Array_Conversion (Instance : Block_Instance_Acc;
                                        Value : in out Iir_Value_Literal_Acc;
                                        Ref_Type : Iir;
                                        Expr : Iir)
   is
      Ref_Value : Iir_Value_Literal_Acc;
   begin
      --  Do array conversion only if REF_TYPE is a constrained array type
      --  definition.
      if Value.Kind /= Iir_Value_Array then
         return;
      end if;
      if Get_Constraint_State (Ref_Type) /= Fully_Constrained then
         return;
      end if;
      Ref_Value := Create_Array_Bounds_From_Type (Instance, Ref_Type, True);
      for I in Value.Bounds.D'Range loop
         if Value.Bounds.D (I).Length /= Ref_Value.Bounds.D (I).Length then
            Error_Msg_Constraint (Expr);
            return;
         end if;
      end loop;
      Ref_Value.Val_Array.V := Value.Val_Array.V;
      Value := Ref_Value;
   end Implicit_Array_Conversion;

   procedure Check_Range_Constraints (Instance : Block_Instance_Acc;
                                      Rng : Iir_Value_Literal_Acc;
                                      Rng_Type : Iir;
                                      Loc : Iir) is
   begin
      if not Is_Null_Range (Rng) then
         Check_Constraints (Instance, Rng.Left, Get_Type (Rng_Type), Loc);
         Check_Constraints (Instance, Rng.Right, Get_Type (Rng_Type), Loc);
      end if;
   end Check_Range_Constraints;

   procedure Check_Array_Constraints (Instance: Block_Instance_Acc;
                                      Value: Iir_Value_Literal_Acc;
                                      Def: Iir;
                                      Expr: Iir)
   is
      Index_List : Iir_Flist;
      Element_Subtype : Iir;
      New_Bounds : Iir_Value_Literal_Acc;
   begin
      --  Nothing to check for unconstrained arrays.
      if not Get_Index_Constraint_Flag (Def) then
         return;
      end if;

      Index_List := Get_Index_Subtype_List (Def);
      for I in Value.Bounds.D'Range loop
         New_Bounds := Execute_Bounds
           (Instance, Get_Nth_Element (Index_List, Natural (I - 1)));
         if not Is_Equal (Value.Bounds.D (I), New_Bounds) then
            Error_Msg_Constraint (Expr);
            return;
         end if;
      end loop;

      if Boolean'(False) then
         Index_List := Get_Index_List (Def);
         Element_Subtype := Get_Element_Subtype (Def);
         for I in Value.Val_Array.V'Range loop
            Check_Constraints
              (Instance, Value.Val_Array.V (I), Element_Subtype, Expr);
         end loop;
      end if;
   end Check_Array_Constraints;

   --  Check DEST and SRC are array compatible.
   procedure Check_Array_Match (Instance: Block_Instance_Acc;
                                Dest: Iir_Value_Literal_Acc;
                                Src : Iir_Value_Literal_Acc;
                                Expr: Iir)
   is
      pragma Unreferenced (Instance);
   begin
      for I in Dest.Bounds.D'Range loop
         if Dest.Bounds.D (I).Length /= Src.Bounds.D (I).Length then
            Error_Msg_Constraint (Expr);
            exit;
         end if;
      end loop;
   end Check_Array_Match;
   pragma Unreferenced (Check_Array_Match);

   procedure Check_Constraints (Instance: Block_Instance_Acc;
                                Value: Iir_Value_Literal_Acc;
                                Def: Iir;
                                Expr: Iir)
   is
      High, Low: Iir_Value_Literal_Acc;
      Bound : Iir_Value_Literal_Acc;
   begin
      case Get_Kind (Def) is
         when Iir_Kind_Integer_Subtype_Definition
           | Iir_Kind_Floating_Subtype_Definition
           | Iir_Kind_Enumeration_Subtype_Definition
           | Iir_Kind_Physical_Subtype_Definition
           | Iir_Kind_Enumeration_Type_Definition =>
            Bound := Execute_Bounds (Instance, Def);
            if Bound.Dir = Dir_To then
               High := Bound.Right;
               Low := Bound.Left;
            else
               High := Bound.Left;
               Low := Bound.Right;
            end if;
            case Iir_Value_Scalars (Value.Kind) is
               when Iir_Value_I64 =>
                  if Value.I64 in Low.I64 .. High.I64 then
                     return;
                  end if;
               when Iir_Value_E8 =>
                  if Value.E8 in Low.E8 .. High.E8 then
                     return;
                  end if;
               when Iir_Value_E32 =>
                  if Value.E32 in Low.E32 .. High.E32 then
                     return;
                  end if;
               when Iir_Value_F64 =>
                  if Value.F64 in Low.F64 .. High.F64 then
                     return;
                  end if;
               when Iir_Value_B1 =>
                  if Value.B1 in Low.B1 .. High.B1 then
                     return;
                  end if;
            end case;
         when Iir_Kind_Array_Subtype_Definition
           | Iir_Kind_Array_Type_Definition =>
            Check_Array_Constraints (Instance, Value, Def, Expr);
            return;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            declare
               List : constant Iir_Flist :=
                 Get_Elements_Declaration_List (Get_Base_Type (Def));
               El : Iir_Element_Declaration;
            begin
               for I in Flist_First .. Flist_Last (List) loop
                  El := Get_Nth_Element (List, I);
                  Check_Constraints
                    (Instance,
                     Value.Val_Record.V (Get_Element_Position (El) + 1),
                     Get_Type (El),
                     Expr);
               end loop;
            end;
            return;
         when Iir_Kind_Integer_Type_Definition =>
            return;
         when Iir_Kind_Floating_Type_Definition =>
            return;
         when Iir_Kind_Physical_Type_Definition =>
            return;
         when Iir_Kind_Access_Type_Definition
           | Iir_Kind_Access_Subtype_Definition =>
            return;
         when Iir_Kind_File_Type_Definition =>
            return;
         when others =>
            Error_Kind ("check_constraints", Def);
      end case;
      Error_Msg_Constraint (Expr);
   end Check_Constraints;

   function Execute_Resolution_Function
     (Block: Block_Instance_Acc; Imp : Iir; Arr : Iir_Value_Literal_Acc)
      return Iir_Value_Literal_Acc
   is
      Inter : Iir;
      Instance : Block_Instance_Acc;
   begin
      -- Create a frame for this function.
      Instance := Create_Subprogram_Instance (Block, null, Imp);

      Inter := Get_Interface_Declaration_Chain (Imp);
      Elaboration.Create_Object (Instance, Inter);
      Instance.Objects (Get_Info (Inter).Slot) := Arr;

      return Execute_Function_Body (Instance);
   end Execute_Resolution_Function;

   procedure Execute_Signal_Assignment (Instance: Block_Instance_Acc;
                                        Stmt: Iir_Signal_Assignment_Statement;
                                        Wf : Iir)
   is
      Nbr_We : constant Natural := Get_Chain_Length (Wf);

      Transactions : Transaction_Type (Nbr_We);

      We: Iir_Waveform_Element;
      Res: Iir_Value_Literal_Acc;
      Rdest: Iir_Value_Literal_Acc;
      Targ_Type : Iir;
      Marker : Mark_Type;
   begin
      Mark (Marker, Expr_Pool);

      Rdest := Execute_Name (Instance, Get_Target (Stmt), True);
      Targ_Type := Get_Type (Get_Target (Stmt));

      --  Disconnection statement.
      if Wf = Null_Iir then
         Disconnect_Signal (Rdest);
         Release (Marker, Expr_Pool);
         return;
      elsif Get_Kind (Wf) = Iir_Kind_Unaffected_Waveform then
         return;
      end if;

      Transactions.Stmt := Stmt;

      -- LRM93 8.4.1
      -- Evaluation of a waveform consists of the evaluation of each waveform
      -- elements in the waveform.
      We := Wf;
      for I in Transactions.Els'Range loop
         declare
            Trans : Transaction_El_Type renames Transactions.Els (I);
         begin
            if Get_Time (We) /= Null_Iir then
               Res := Execute_Expression (Instance, Get_Time (We));
               -- LRM93 8.4.1
               -- It is an error if the time expression in a waveform element
               -- evaluates to a negative value.
               if Res.I64 < 0 then
                  Error_Msg_Exec ("time value is negative", Get_Time (We));
               end if;
               Trans.After := Std_Time (Res.I64);
            else
               -- LRM93 8.4.1
               -- If the after clause of a waveform element is not present,
               -- then an implicit "after 0 ns" is assumed.
               Trans.After := 0;
            end if;

            -- LRM93 8.4.1
            -- It is an error if the sequence of new transactions is not in
            -- ascending order with respect to time.
            if I > 1
              and then Trans.After <= Transactions.Els (I - 1).After
            then
               Error_Msg_Exec
                 ("sequence not in ascending order with respect to time", We);
            end if;

            if Get_Kind (Get_We_Value (We)) = Iir_Kind_Null_Literal then
               -- null transaction.
               Trans.Value := null;
            else
               -- LRM93 8.4.1
               -- For the first form of waveform element, the value component
               -- of the transaction is determined by the value expression in
               -- the waveform element.
               Trans.Value := Execute_Expression_With_Type
                 (Instance, Get_We_Value (We), Targ_Type);
            end if;
         end;
         We := Get_Chain (We);
      end loop;
      pragma Assert (We = Null_Iir);

      case Get_Delay_Mechanism (Stmt) is
         when Iir_Transport_Delay =>
            Transactions.Reject := 0;
         when Iir_Inertial_Delay =>
            -- LRM93 8.4
            -- or, in the case that a pulse rejection limit is specified,
            -- a pulse whose duration is shorter than that limit will not
            -- be transmitted.
            -- Every inertially delayed signal assignment has a pulse
            -- rejection limit.
            if Get_Reject_Time_Expression (Stmt) /= Null_Iir then
               -- LRM93 8.4
               -- If the delay mechanism specifies inertial delay, and if the
               -- reserved word reject followed by a time expression is
               -- present, then the time expression specifies the pulse
               -- rejection limit.
               Res := Execute_Expression
                 (Instance, Get_Reject_Time_Expression (Stmt));
               -- LRM93 8.4
               -- It is an error if the pulse rejection limit for any
               -- inertially delayed signal assignement statement is either
               -- negative ...
               if Res.I64 < 0 then
                  Error_Msg_Exec ("reject time negative", Stmt);
               end if;
               -- LRM93 8.4
               -- ... or greather than the time expression associated with
               -- the first waveform element.
               Transactions.Reject := Std_Time (Res.I64);
               if Transactions.Reject > Transactions.Els (1).After then
                  Error_Msg_Exec
                    ("reject time greather than time expression", Stmt);
               end if;
            else
               -- LRM93 8.4
               -- In all other cases, the pulse rejection limit is the time
               -- expression associated ith the first waveform element.
               Transactions.Reject := Transactions.Els (1).After;
            end if;
      end case;

      --  FIXME: slice Transactions to remove transactions after end of time.
      Assign_Value_To_Signal (Instance, Rdest, Transactions);

      Release (Marker, Expr_Pool);
   end Execute_Signal_Assignment;

   -- Display a message when an assertion has failed.
   -- REPORT is the value (string) to display, or null to use default message.
   -- SEVERITY is the severity or null to use default (error).
   -- STMT is used to display location.
   procedure Execute_Failed_Assertion (Msg : String;
                                       Report : String;
                                       Severity : Natural;
                                       Stmt: Iir) is
   begin
      -- LRM93 8.2
      -- The error message consists of at least:

      -- 4: name of the design unit containing the assertion.
      Put (Disp_Location (Stmt));

      Put (":@");
      Grt.Astdio.Vhdl.Put_Time (Grt.Stdio.stdout, Current_Time);

      -- 1: an indication that this message is from an assertion.
      Put (":(");
      Put (Msg);
      Put (' ');

      -- 2: the value of the severity level.
      case Severity is
         when 0 =>
            Put ("note");
         when 1 =>
            Put ("warning");
         when 2 =>
            Put ("error");
         when 3 =>
            Put ("failure");
         when others =>
            Error_Internal (Null_Iir, "execute_failed_assertion");
      end case;
      Put ("): ");

      -- 3: the value of the message string.
      Put_Line (Report);

      -- Stop execution if the severity is too high.
      if Severity >= Grt.Options.Severity_Level then
         Debug (Reason_Assert);
         Grt.Errors.Fatal_Error;
      end if;
   end Execute_Failed_Assertion;

   procedure Execute_Failed_Assertion (Instance: Block_Instance_Acc;
                                       Label : String;
                                       Stmt : Iir;
                                       Default_Msg : String;
                                       Default_Severity : Natural)
   is
      Expr: Iir;
      Report, Severity_Lit: Iir_Value_Literal_Acc;
      Severity : Natural;
      Marker : Mark_Type;
   begin
      Mark (Marker, Expr_Pool);
      Expr := Get_Report_Expression (Stmt);
      if Expr /= Null_Iir then
         Report := Execute_Expression (Instance, Expr);
      else
         Report := null;
      end if;
      Expr := Get_Severity_Expression (Stmt);
      if Expr /= Null_Iir then
         Severity_Lit := Execute_Expression (Instance, Expr);
         Severity := Natural'Val (Severity_Lit.E8);
      else
         Severity := Default_Severity;
      end if;
      if Report /= null then
         declare
            Msg : String (1 .. Natural (Report.Val_Array.Len));
         begin
            for I in Report.Val_Array.V'Range loop
               Msg (Positive (I)) :=
                 Character'Val (Report.Val_Array.V (I).E8);
            end loop;
            Execute_Failed_Assertion (Label, Msg, Severity, Stmt);
         end;
      else
         Execute_Failed_Assertion (Label, Default_Msg, Severity, Stmt);
      end if;
      Release (Marker, Expr_Pool);
   end Execute_Failed_Assertion;

   function Is_In_Choice (Instance : Block_Instance_Acc;
                          Choice : Iir;
                          Expr : Iir_Value_Literal_Acc)
                         return Boolean
   is
      Res : Boolean;
   begin
      case Get_Kind (Choice) is
         when Iir_Kind_Choice_By_Others =>
            return True;
         when Iir_Kind_Choice_By_Expression =>
            declare
               Expr1: Iir_Value_Literal_Acc;
            begin
               Expr1 := Execute_Expression
                 (Instance, Get_Choice_Expression (Choice));
               Res := Is_Equal (Expr, Expr1);
               return Res;
            end;
         when Iir_Kind_Choice_By_Range =>
            declare
               A_Range : Iir_Value_Literal_Acc;
            begin
               A_Range := Execute_Bounds
                 (Instance, Get_Choice_Range (Choice));
               Res := Is_In_Range (Expr, A_Range);
            end;
            return Res;
         when others =>
            Error_Kind ("is_in_choice", Choice);
      end case;
   end Is_In_Choice;

   function Execute_Choice (Instance : Block_Instance_Acc;
                            Expr : Iir;
                            First_Assoc : Iir) return Iir
   is
      Value: Iir_Value_Literal_Acc;
      Assoc: Iir;
      Assoc_Res : Iir;
      Marker : Mark_Type;
   begin
      Mark (Marker, Expr_Pool);
      Assoc := First_Assoc;

      Value := Execute_Expression (Instance, Expr);
      if Get_Type_Staticness (Get_Type (Expr)) /= Locally
        and then Get_Kind (Assoc) = Iir_Kind_Choice_By_Expression
      then
         --  Choice is not locally constrained, check length.
         declare
            Choice_Type : constant Iir :=
              Get_Type (Get_Choice_Expression (Assoc));
            Choice_Len : Int64;
         begin
            Choice_Len := Vhdl.Evaluation.Eval_Discrete_Type_Length
              (Get_String_Type_Bound_Type (Choice_Type));
            if Choice_Len /= Int64 (Value.Bounds.D (1).Length) then
               Error_Msg_Constraint (Expr);
            end if;
         end;
      end if;

      while Assoc /= Null_Iir loop
         if not Get_Same_Alternative_Flag (Assoc) then
            Assoc_Res := Assoc;
         end if;

         if Is_In_Choice (Instance, Assoc, Value) then
            Release (Marker, Expr_Pool);
            return Assoc_Res;
         end if;

         Assoc := Get_Chain (Assoc);
      end loop;
      --  FIXME: infinite loop???
      Error_Msg_Exec ("no choice for expression", Expr);
      raise Internal_Error;
   end Execute_Choice;

   --  Return TRUE iff VAL is in the range defined by BOUNDS.
   function Is_In_Range (Val : Iir_Value_Literal_Acc;
                         Bounds : Iir_Value_Literal_Acc)
     return Boolean
   is
      Max, Min : Iir_Value_Literal_Acc;
   begin
      case Bounds.Dir is
         when Dir_To =>
            Min := Bounds.Left;
            Max := Bounds.Right;
         when Dir_Downto =>
            Min := Bounds.Right;
            Max := Bounds.Left;
      end case;

      case Iir_Value_Discrete (Val.Kind) is
         when Iir_Value_E8 =>
            return Val.E8 >= Min.E8 and Val.E8 <= Max.E8;
         when Iir_Value_E32 =>
            return Val.E32 >= Min.E32 and Val.E32 <= Max.E32;
         when Iir_Value_B1 =>
            return Val.B1 >= Min.B1 and Val.B1 <= Max.B1;
         when Iir_Value_I64 =>
            return Val.I64 >= Min.I64 and Val.I64 <= Max.I64;
      end case;
   end Is_In_Range;

   --  Increment or decrement VAL according to BOUNDS.DIR.
   --  FIXME: use increment ?
   procedure Update_Loop_Index (Val : Iir_Value_Literal_Acc;
                                Bounds : Iir_Value_Literal_Acc)
   is
   begin
      case Iir_Value_Discrete (Val.Kind) is
         when Iir_Value_E8 =>
            case Bounds.Dir is
               when Dir_To =>
                  Val.E8 := Val.E8 + 1;
               when Dir_Downto =>
                  Val.E8 := Val.E8 - 1;
            end case;
         when Iir_Value_E32 =>
            case Bounds.Dir is
               when Dir_To =>
                  Val.E32 := Val.E32 + 1;
               when Dir_Downto =>
                  Val.E32 := Val.E32 - 1;
            end case;
         when Iir_Value_B1 =>
            case Bounds.Dir is
               when Dir_To =>
                  Val.B1 := True;
               when Dir_Downto =>
                  Val.B1 := False;
            end case;
         when Iir_Value_I64 =>
            case Bounds.Dir is
               when Dir_To =>
                  Val.I64 := Val.I64 + 1;
               when Dir_Downto =>
                  Val.I64 := Val.I64 - 1;
            end case;
      end case;
   end Update_Loop_Index;

   procedure Finalize_For_Loop_Statement (Instance : Block_Instance_Acc;
                                          Stmt : Iir)
   is
   begin
      Destroy_Iterator_Declaration
        (Instance, Get_Parameter_Specification (Stmt));
   end Finalize_For_Loop_Statement;

   procedure Finalize_Loop_Statement (Instance : Block_Instance_Acc;
                                      Stmt : Iir)
   is
   begin
      if Get_Kind (Stmt) = Iir_Kind_For_Loop_Statement then
         Finalize_For_Loop_Statement (Instance, Stmt);
      end if;
   end Finalize_Loop_Statement;

   procedure Execute_For_Loop_Statement (Proc : Process_State_Acc)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir_For_Loop_Statement := Instance.Stmt;
      Iterator : constant Iir := Get_Parameter_Specification (Stmt);
      Bounds : Iir_Value_Literal_Acc;
      Index : Iir_Value_Literal_Acc;
      Stmt_Chain : Iir;
      Is_Nul : Boolean;
      Marker : Mark_Type;
   begin
      --  Elaborate the iterator (and its type).
      Elaborate_Declaration (Instance, Iterator);

      -- Extract bounds.
      Mark (Marker, Expr_Pool);
      Bounds := Execute_Bounds (Instance, Get_Type (Iterator));
      Index := Instance.Objects (Get_Info (Iterator).Slot);
      Store (Index, Bounds.Left);
      Is_Nul := Is_Null_Range (Bounds);
      Release (Marker, Expr_Pool);

      if Is_Nul then
         -- Loop is complete.
         Finalize_For_Loop_Statement (Instance, Stmt);
         Update_Next_Statement (Proc);
      else
         Stmt_Chain := Get_Sequential_Statement_Chain (Stmt);
         if Stmt_Chain = Null_Iir then
            --  Nothing to do for an empty loop.
            Finalize_For_Loop_Statement (Instance, Stmt);
            Update_Next_Statement (Proc);
         else
            Instance.Stmt := Stmt_Chain;
         end if;
      end if;
   end Execute_For_Loop_Statement;

   --  This function is called when there is no more statements to execute
   --  in the statement list of a for_loop.  Returns FALSE in case of end of
   --  loop.
   function Finish_For_Loop_Statement (Instance : Block_Instance_Acc)
                                      return Boolean
   is
      Iterator : constant Iir := Get_Parameter_Specification (Instance.Stmt);
      Bounds : Iir_Value_Literal_Acc;
      Index : Iir_Value_Literal_Acc;
      Marker : Mark_Type;
   begin
      --  FIXME: avoid allocation.
      Mark (Marker, Expr_Pool);
      Bounds := Execute_Bounds (Instance, Get_Type (Iterator));
      Index := Instance.Objects (Get_Info (Iterator).Slot);

      if Is_Equal (Index, Bounds.Right) then
         -- Loop is complete.
         Release (Marker, Expr_Pool);
         Finalize_For_Loop_Statement (Instance, Instance.Stmt);
         return False;
      else
         -- Update the loop index.
         Update_Loop_Index (Index, Bounds);

         Release (Marker, Expr_Pool);

         -- start the loop again.
         Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt);
         return True;
      end if;
   end Finish_For_Loop_Statement;

   --  Evaluate boolean condition COND.  If COND is Null_Iir, returns true.
   function Execute_Condition (Instance : Block_Instance_Acc;
                               Cond : Iir) return Boolean
   is
      V : Iir_Value_Literal_Acc;
      Res : Boolean;
      Marker : Mark_Type;
   begin
      if Cond = Null_Iir then
         return True;
      end if;

      Mark (Marker, Expr_Pool);
      V := Execute_Expression (Instance, Cond);
      Res := V.B1 = True;
      Release (Marker, Expr_Pool);
      return Res;
   end Execute_Condition;

   --  Start a while loop statement, or return FALSE if the loop is not
   --  executed.
   procedure Execute_While_Loop_Statement (Proc : Process_State_Acc)
   is
      Instance: constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir := Instance.Stmt;
      Cond : Boolean;
   begin
      Cond := Execute_Condition (Instance, Get_Condition (Stmt));
      if Cond then
         Init_Sequential_Statements (Proc, Stmt);
      else
         Update_Next_Statement (Proc);
      end if;
   end Execute_While_Loop_Statement;

   --  This function is called when there is no more statements to execute
   --  in the statement list of a while loop.  Returns FALSE iff loop is
   --  completed.
   function Finish_While_Loop_Statement (Instance : Block_Instance_Acc)
                                        return Boolean
   is
      Cond : Boolean;
   begin
      Cond := Execute_Condition (Instance, Get_Condition (Instance.Stmt));

      if Cond then
         -- start the loop again.
         Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt);
         return True;
      else
         -- Loop is complete.
         return False;
      end if;
   end Finish_While_Loop_Statement;

   --  Return TRUE if the loop must be executed again
   function Finish_Loop_Statement (Instance : Block_Instance_Acc; Stmt : Iir)
                                  return Boolean is
   begin
      Instance.Stmt := Stmt;
      case Get_Kind (Stmt) is
         when Iir_Kind_While_Loop_Statement =>
            return Finish_While_Loop_Statement (Instance);
         when Iir_Kind_For_Loop_Statement =>
            return Finish_For_Loop_Statement (Instance);
         when others =>
            Error_Kind ("finish_loop_statement", Stmt);
      end case;
   end Finish_Loop_Statement;

   --  Return FALSE if the next statement should be executed (possibly
   --  updated).
   procedure Execute_Exit_Next_Statement (Proc : Process_State_Acc;
                                          Is_Exit : Boolean)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir := Instance.Stmt;
      Label : constant Iir := Get_Named_Entity (Get_Loop_Label (Stmt));
      Cond : Boolean;
      Parent : Iir;
   begin
      Cond := Execute_Condition (Instance, Get_Condition (Stmt));
      if not Cond then
         Update_Next_Statement (Proc);
         return;
      end if;

      Parent := Stmt;
      loop
         Parent := Get_Parent (Parent);
         case Get_Kind (Parent) is
            when Iir_Kind_For_Loop_Statement
              | Iir_Kind_While_Loop_Statement =>
               if Label = Null_Iir or else Label = Parent then
                  --  Target is this statement.
                  if Is_Exit then
                     Finalize_Loop_Statement (Instance, Parent);
                     Instance.Stmt := Parent;
                     Update_Next_Statement (Proc);
                  elsif not Finish_Loop_Statement (Instance, Parent) then
                     Update_Next_Statement (Proc);
                  else
                     Init_Sequential_Statements (Proc, Parent);
                  end if;
                  return;
               else
                  Finalize_Loop_Statement (Instance, Parent);
               end if;
            when others =>
               null;
         end case;
      end loop;
   end Execute_Exit_Next_Statement;

   procedure Execute_Case_Statement (Proc : Process_State_Acc)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir := Instance.Stmt;
      Assoc: Iir;
      Stmt_Chain : Iir;
   begin
      Assoc := Execute_Choice (Instance, Get_Expression (Stmt),
                               Get_Case_Statement_Alternative_Chain (Stmt));
      Stmt_Chain := Get_Associated_Chain (Assoc);
      if Stmt_Chain = Null_Iir then
         Update_Next_Statement (Proc);
      else
         Instance.Stmt := Stmt_Chain;
      end if;
   end Execute_Case_Statement;

   procedure Execute_Call_Statement (Proc : Process_State_Acc)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir := Instance.Stmt;
      Call : constant Iir := Get_Procedure_Call (Stmt);
      Imp  : constant Iir := Get_Implementation (Call);
      Subprg_Instance : Block_Instance_Acc;
      Prot_Block : Block_Instance_Acc;
      Assoc_Chain: Iir;
      Inter_Chain : Iir;
   begin
      if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then
         Execute_Implicit_Procedure (Instance, Call);
         Update_Next_Statement (Proc);
      elsif Get_Foreign_Flag (Imp) then
         Execute_Foreign_Procedure (Instance, Call);
         Update_Next_Statement (Proc);
      else
         Mark (Instance.Marker, Instance_Pool.all);
         Prot_Block := Get_Protected_Object_Instance (Instance, Call);
         Subprg_Instance :=
           Create_Subprogram_Instance (Instance, Prot_Block, Imp);
         Assoc_Chain := Get_Parameter_Association_Chain (Call);
         Inter_Chain := Get_Interface_Declaration_Chain (Imp);
         Execute_Association
           (Instance, Subprg_Instance, Inter_Chain, Assoc_Chain);

         Current_Process.Instance := Subprg_Instance;
         Elaborate_Declarative_Part
           (Subprg_Instance, Get_Declaration_Chain (Subprg_Instance.Bod));

         Init_Sequential_Statements (Proc, Subprg_Instance.Bod);
      end if;
   end Execute_Call_Statement;

   procedure Finish_Procedure_Frame (Proc : Process_State_Acc)
   is
      Old_Instance : constant Block_Instance_Acc := Proc.Instance;
   begin
      Execute_Back_Association (Old_Instance);
      Proc.Instance := Old_Instance.Parent;
      Execute_Subprogram_Call_Final (Old_Instance);
      Release (Proc.Instance.Marker, Instance_Pool.all);
   end Finish_Procedure_Frame;

   procedure Execute_If_Statement (Proc : Process_State_Acc; Stmt : Iir)
   is
      Clause: Iir;
      Cond: Boolean;
   begin
      Clause := Stmt;
      loop
         Cond := Execute_Condition (Proc.Instance, Get_Condition (Clause));
         if Cond then
            Init_Sequential_Statements (Proc, Clause);
            return;
         end if;
         Clause := Get_Else_Clause (Clause);
         exit when Clause = Null_Iir;
      end loop;
      Update_Next_Statement (Proc);
   end Execute_If_Statement;

   procedure Execute_Variable_Assignment (Proc : Process_State_Acc; Stmt : Iir)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Target : constant Iir := Get_Target (Stmt);
      Target_Type : constant Iir := Get_Type (Target);
      Expr : constant Iir := Get_Expression (Stmt);
      Expr_Type : constant Iir := Get_Type (Expr);
      Target_Val: Iir_Value_Literal_Acc;
      Res : Iir_Value_Literal_Acc;
      Marker : Mark_Type;
   begin
      Mark (Marker, Expr_Pool);
      Target_Val := Execute_Expression (Instance, Target);

      --  If the type of the target is not static and the value is
      --  an aggregate, then the aggregate may be contrained by the
      --  target.
      if Get_Kind (Expr) = Iir_Kind_Aggregate
        and then Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition
      then
         Res := Copy_Array_Bound (Target_Val);
         Fill_Array_Aggregate (Instance, Expr, Res);
      else
         Res := Execute_Expression (Instance, Expr);
      end if;
      if Get_Kind (Target_Type) in Iir_Kinds_Array_Type_Definition then
         --  Note: target_type may be dynamic (slice case), so
         --  check_constraints is not called.
         Implicit_Array_Conversion (Res, Target_Val, Stmt);
      else
         Check_Constraints (Instance, Res, Target_Type, Stmt);
      end if;

      --  Note: we need to unshare before copying to avoid
      --  overwrites (in assignments like: v (1 to 4) := v (3 to 6)).
      --  FIXME: improve that handling (detect overlaps before).
      Store (Target_Val, Unshare (Res, Expr_Pool'Access));

      Release (Marker, Expr_Pool);
   end Execute_Variable_Assignment;

   function Execute_Return_Statement (Proc : Process_State_Acc)
                                     return Boolean
   is
      Res : Iir_Value_Literal_Acc;
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : constant Iir := Instance.Stmt;
      Expr : constant Iir := Get_Expression (Stmt);
   begin
      if Expr /= Null_Iir then
         Res := Execute_Expression (Instance, Expr);
         Implicit_Array_Conversion (Instance, Res, Get_Type (Stmt), Stmt);
         Check_Constraints (Instance, Res, Get_Type (Stmt), Stmt);
         Instance.Result := Res;
      end if;

      case Get_Kind (Instance.Label) is
         when Iir_Kind_Procedure_Declaration =>
            Finish_Procedure_Frame (Proc);
            Update_Next_Statement (Proc);
            return False;
         when Iir_Kind_Function_Declaration =>
            return True;
         when others =>
            raise Internal_Error;
      end case;
   end Execute_Return_Statement;

   procedure Finish_Sequential_Statements
     (Proc : Process_State_Acc; Complex_Stmt : Iir)
   is
      Instance : Block_Instance_Acc := Proc.Instance;
      Stmt : Iir;
   begin
      Stmt := Complex_Stmt;
      loop
         Instance.Stmt := Stmt;
         case Get_Kind (Stmt) is
            when Iir_Kind_For_Loop_Statement =>
               if Finish_For_Loop_Statement (Instance) then
                  return;
               end if;
            when Iir_Kind_While_Loop_Statement =>
               if Finish_While_Loop_Statement (Instance) then
                  return;
               end if;
            when Iir_Kind_Case_Statement
              | Iir_Kind_If_Statement =>
               null;
            when Iir_Kind_Sensitized_Process_Statement =>
               Instance.Stmt := Null_Iir;
               return;
            when Iir_Kind_Process_Statement =>
               --  Start again.
               Instance.Stmt := Get_Sequential_Statement_Chain (Stmt);
               return;
            when Iir_Kind_Procedure_Body =>
               Finish_Procedure_Frame (Proc);
               Instance := Proc.Instance;
            when Iir_Kind_Function_Body =>
               Error_Msg_Exec ("missing return statement in function", Stmt);
            when others =>
               Error_Kind ("execute_next_statement", Stmt);
         end case;
         Stmt := Get_Chain (Instance.Stmt);
         if Stmt /= Null_Iir then
            Instance.Stmt := Stmt;
            return;
         end if;
         Stmt := Get_Parent (Instance.Stmt);
      end loop;
   end Finish_Sequential_Statements;

   procedure Init_Sequential_Statements
     (Proc : Process_State_Acc; Complex_Stmt : Iir)
   is
      Stmt : Iir;
   begin
      Stmt := Get_Sequential_Statement_Chain (Complex_Stmt);
      if Stmt /= Null_Iir then
         Proc.Instance.Stmt := Stmt;
      else
         Finish_Sequential_Statements (Proc, Complex_Stmt);
      end if;
   end Init_Sequential_Statements;

   procedure Update_Next_Statement (Proc : Process_State_Acc)
   is
      Instance : constant Block_Instance_Acc := Proc.Instance;
      Stmt : Iir;
   begin
      Stmt := Get_Chain (Instance.Stmt);
      if Stmt /= Null_Iir then
         Instance.Stmt := Stmt;
         return;
      end if;
      Finish_Sequential_Statements (Proc, Get_Parent (Instance.Stmt));
   end Update_Next_Statement;

   procedure Execute_Sequential_Statements (Proc : Process_State_Acc)
   is
      Instance : Block_Instance_Acc;
      Stmt: Iir;
   begin
      loop
         Instance := Proc.Instance;
         Stmt := Instance.Stmt;

         --  End of process or subprogram.
         exit when Stmt = Null_Iir;

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

         if Flag_Need_Debug then
            Debug (Reason_Break);
         end if;

         -- execute statement STMT.
         case Get_Kind (Stmt) is
            when Iir_Kind_Null_Statement =>
               Update_Next_Statement (Proc);

            when Iir_Kind_If_Statement =>
               Execute_If_Statement (Proc, Stmt);

            when Iir_Kind_Simple_Signal_Assignment_Statement =>
               Execute_Signal_Assignment
                 (Instance, Stmt, Get_Waveform_Chain (Stmt));
               Update_Next_Statement (Proc);

            when Iir_Kind_Selected_Waveform_Assignment_Statement =>
               declare
                  Assoc : Iir;
               begin
                  Assoc := Execute_Choice (Instance, Get_Expression (Stmt),
                                           Get_Selected_Waveform_Chain (Stmt));
                  Execute_Signal_Assignment
                    (Instance, Stmt, Get_Associated_Chain (Assoc));
                  Update_Next_Statement (Proc);
               end;
            when Iir_Kind_Assertion_Statement =>
               declare
                  Res : Boolean;
               begin
                  Res := Execute_Condition
                    (Instance, Get_Assertion_Condition (Stmt));
                  if not Res then
                     Execute_Failed_Assertion (Instance, "assertion", Stmt,
                                               "Assertion violation.", 2);
                  end if;
               end;
               Update_Next_Statement (Proc);

            when Iir_Kind_Report_Statement =>
               Execute_Failed_Assertion (Instance, "report", Stmt,
                                         "Assertion violation.", 0);
               Update_Next_Statement (Proc);

            when Iir_Kind_Variable_Assignment_Statement =>
               Execute_Variable_Assignment (Proc, Stmt);
               Update_Next_Statement (Proc);

            when Iir_Kind_Return_Statement =>
               if Execute_Return_Statement (Proc) then
                  return;
               end if;

            when Iir_Kind_For_Loop_Statement =>
               Execute_For_Loop_Statement (Proc);

            when Iir_Kind_While_Loop_Statement =>
               Execute_While_Loop_Statement (Proc);

            when Iir_Kind_Case_Statement =>
               Execute_Case_Statement (Proc);

            when Iir_Kind_Wait_Statement =>
               if Execute_Wait_Statement (Instance, Stmt) then
                  return;
               end if;
               Update_Next_Statement (Proc);

            when Iir_Kind_Procedure_Call_Statement =>
               Execute_Call_Statement (Proc);

            when Iir_Kind_Exit_Statement =>
               Execute_Exit_Next_Statement (Proc, True);
            when Iir_Kind_Next_Statement =>
               Execute_Exit_Next_Statement (Proc, False);

            when others =>
               Error_Kind ("execute_sequential_statements", Stmt);
         end case;
      end loop;
   end Execute_Sequential_Statements;
end Simul.Execution;