Move translate and simulate.

1 files changed, 0 insertions, 1066 deletions

diff --git a/src/simulate/iir_values.adb b/src/simulate/iir_values.adb
deleted file mode 100644
index d80f3bf0a..000000000
--- a/src/simulate/iir_values.adb
+++ /dev/null
@@ -1,1066 +0,0 @@
---  Naive values for interpreted simulation
---  Copyright (C) 2014 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  along with GHDL; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
-
-with System;
-with Ada.Unchecked_Conversion;
-with GNAT.Debug_Utilities;
-with Name_Table;
-with Debugger; use Debugger;
-with Iirs_Utils; use Iirs_Utils;
-
-package body Iir_Values is
-
-   -- Functions for iir_value_literal
-   function Is_Equal (Left, Right: Iir_Value_Literal_Acc) return Boolean is
-   begin
-      if Left.Kind /= Right.Kind then
-         raise Internal_Error;
-      end if;
-      case Left.Kind is
-         when Iir_Value_B1 =>
-            return Left.B1 = Right.B1;
-         when Iir_Value_E32 =>
-            return Left.E32 = Right.E32;
-         when Iir_Value_I64 =>
-            return Left.I64 = Right.I64;
-         when Iir_Value_F64 =>
-            return Left.F64 = Right.F64;
-         when Iir_Value_Access =>
-            return Left.Val_Access = Right.Val_Access;
-         when Iir_Value_File =>
-            raise Internal_Error;
-         when Iir_Value_Array =>
-            if Left.Bounds.Nbr_Dims /= Right.Bounds.Nbr_Dims then
-               raise Internal_Error;
-            end if;
-            for I in Left.Bounds.D'Range loop
-               if Left.Bounds.D (I).Length /= Right.Bounds.D (I).Length then
-                  return False;
-               end if;
-            end loop;
-            for I in Left.Val_Array.V'Range loop
-               if not Is_Equal (Left.Val_Array.V (I),
-                                Right.Val_Array.V (I)) then
-                  return False;
-               end if;
-            end loop;
-            return True;
-         when Iir_Value_Record =>
-            if Left.Val_Record.Len /= Right.Val_Record.Len then
-               raise Constraint_Error;
-            end if;
-            for I in Left.Val_Record.V'Range loop
-               if not Is_Equal (Left.Val_Record.V (I),
-                                Right.Val_Record.V (I)) then
-                  return False;
-               end if;
-            end loop;
-            return True;
-         when Iir_Value_Range =>
-            if Left.Dir /= Right.Dir then
-               return False;
-            end if;
-            if not Is_Equal (Left.Left, Right.Left) then
-               return False;
-            end if;
-            if not Is_Equal (Left.Right, Right.Right) then
-               return False;
-            end if;
-            return True;
-         when Iir_Value_Signal
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-   end Is_Equal;
-
-   function Compare_Value (Left, Right : Iir_Value_Literal_Acc)
-                           return Order is
-   begin
-      if Left.Kind /= Right.Kind then
-         raise Constraint_Error;
-      end if;
-      case Left.Kind is
-         when Iir_Value_B1 =>
-            if Left.B1 < Right.B1 then
-               return Less;
-            elsif Left.B1 = Right.B1 then
-               return Equal;
-            else
-               return Greater;
-            end if;
-         when Iir_Value_E32 =>
-            if Left.E32 < Right.E32 then
-               return Less;
-            elsif Left.E32 = Right.E32 then
-               return Equal;
-            else
-               return Greater;
-            end if;
-         when Iir_Value_I64 =>
-            if Left.I64 < Right.I64 then
-               return Less;
-            elsif Left.I64 = Right.I64 then
-               return Equal;
-            else
-               return Greater;
-            end if;
-         when Iir_Value_F64 =>
-            if Left.F64 < Right.F64 then
-               return Less;
-            elsif Left.F64 = Right.F64 then
-               return Equal;
-            elsif Left.F64 > Right.F64 then
-               return Greater;
-            else
-               raise Constraint_Error;
-            end if;
-         when Iir_Value_Array =>
-            --  LRM93 §7.2.2
-            --  For discrete array types, the relation < (less than) is defined
-            --  such as the left operand is less than the right operand if
-            --  and only if:
-            --  *  the left operand is a null array and the right operand is
-            --     a non-null array; otherwise
-            --  *  both operands are non-null arrays, and one of the following
-            --     conditions is satisfied:
-            --     -  the leftmost element of the left operand is less than
-            --        that of the right; or
-            --     -  the leftmost element of the left operand is equal to
-            --        that of the right, and the tail of the left operand is
-            --        less than that of the right (the tail consists of the
-            --        remaining elements to the rights of the leftmost element
-            --        and can be null)
-            --  The relation <= (less than or equal) for discrete array types
-            --  is defined to be the inclusive disjunction of the results of
-            --  the < and = operators for the same two operands.
-            --  The relation > (greater than) and >= (greater than of equal)
-            --  are defined to be the complements of the <= and < operators
-            --  respectively for the same two operands.
-            if Left.Bounds.Nbr_Dims /= 1 or Right.Bounds.Nbr_Dims /= 1 then
-               raise Internal_Error;
-            end if;
-            for I in 1 .. Iir_Index32'Min (Left.Bounds.D (1).Length,
-                                           Right.Bounds.D (1).Length)
-            loop
-               case Compare_Value (Left.Val_Array.V (I),
-                                   Right.Val_Array.V (I)) is
-                  when Less =>
-                     return Less;
-                  when Greater =>
-                     return Greater;
-                  when Equal =>
-                     null;
-               end case;
-            end loop;
-            if Left.Bounds.D (1).Length < Right.Bounds.D (1).Length then
-               return Less;
-            elsif Left.Bounds.D (1).Length = Right.Bounds.D (1).Length then
-               return Equal;
-            else
-               return Greater;
-            end if;
-         when Iir_Value_Signal
-           | Iir_Value_Access
-           | Iir_Value_Range
-           | Iir_Value_Record
-           | Iir_Value_File
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-   end Compare_Value;
-
-   function Is_Nul_Range (Arange : Iir_Value_Literal_Acc) return Boolean
-   is
-      Cmp : Order;
-   begin
-      Cmp := Compare_Value (Arange.Left, Arange.Right);
-      case Arange.Dir is
-         when Iir_To =>
-            return Cmp = Greater;
-         when Iir_Downto =>
-            return Cmp = Less;
-      end case;
-   end Is_Nul_Range;
-
-   procedure Increment (Val : Iir_Value_Literal_Acc) is
-   begin
-      case Val.Kind is
-         when Iir_Value_B1 =>
-            if Val.B1 = False then
-               Val.B1 := True;
-            else
-               raise Constraint_Error;
-            end if;
-         when Iir_Value_E32 =>
-            Val.E32 := Val.E32 + 1;
-         when Iir_Value_I64 =>
-            Val.I64 := Val.I64 + 1;
-         when Iir_Value_F64
-           | Iir_Value_Array
-           | Iir_Value_Record
-           | Iir_Value_Range
-           | Iir_Value_File
-           | Iir_Value_Access
-           | Iir_Value_Signal
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-   end Increment;
-
-   procedure Store (Dest : Iir_Value_Literal_Acc; Src : Iir_Value_Literal_Acc)
-   is
-   begin
-      if Dest.Kind /= Src.Kind then
-         raise Constraint_Error;
-      end if;
-      case Dest.Kind is
-         when Iir_Value_Array =>
-            if Dest.Val_Array.Len /= Src.Val_Array.Len then
-               raise Constraint_Error;
-            end if;
-            for I in Dest.Val_Array.V'Range loop
-               Store (Dest.Val_Array.V (I), Src.Val_Array.V (I));
-            end loop;
-         when Iir_Value_Record =>
-            if Dest.Val_Record.Len /= Src.Val_Record.Len then
-               raise Constraint_Error;
-            end if;
-            for I in Dest.Val_Record.V'Range loop
-               Store (Dest.Val_Record.V (I), Src.Val_Record.V (I));
-            end loop;
-         when Iir_Value_B1 =>
-            Dest.B1 := Src.B1;
-         when Iir_Value_E32 =>
-            Dest.E32 := Src.E32;
-         when Iir_Value_I64 =>
-            Dest.I64 := Src.I64;
-         when Iir_Value_F64 =>
-            Dest.F64 := Src.F64;
-         when Iir_Value_Access =>
-            Dest.Val_Access := Src.Val_Access;
-         when Iir_Value_File =>
-            Dest.File := Src.File;
-         when Iir_Value_Protected =>
-            Dest.Prot := Src.Prot;
-         when Iir_Value_Signal
-           | Iir_Value_Range
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-   end Store;
-
-   procedure Check_Bounds (Dest : Iir_Value_Literal_Acc;
-                           Src : Iir_Value_Literal_Acc;
-                           Loc : Iir)
-   is
-   begin
-      case Dest.Kind is
-         when Iir_Value_Array =>
-            if Src.Kind /= Iir_Value_Array then
-               raise Internal_Error;
-            end if;
-            if Dest.Val_Array.Len /= Src.Val_Array.Len then
-               Error_Msg_Constraint (Loc);
-            end if;
-            if Dest.Val_Array.Len /= 0 then
-               Check_Bounds (Dest.Val_Array.V (1), Src.Val_Array.V (1), Loc);
-            end if;
-         when Iir_Value_Record =>
-            if Src.Kind /= Iir_Value_Record then
-               raise Internal_Error;
-            end if;
-            if Dest.Val_Record.Len /= Src.Val_Record.Len then
-               raise Internal_Error;
-            end if;
-            for I in Dest.Val_Record.V'Range loop
-               Check_Bounds (Dest.Val_Record.V (I), Src.Val_Record.V (I), Loc);
-            end loop;
-         when Iir_Value_Access
-           | Iir_Value_File
-           | Iir_Value_Range
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            if Src.Kind /= Dest.Kind then
-               raise Internal_Error;
-            end if;
-         when Iir_Value_B1
-           | Iir_Value_E32
-           | Iir_Value_I64
-           | Iir_Value_F64
-           | Iir_Value_Signal =>
-            return;
-      end case;
-   end Check_Bounds;
-
-   function To_Iir_Value_Literal_Acc is new Ada.Unchecked_Conversion
-     (System.Address, Iir_Value_Literal_Acc);
-   function To_Value_Array_Acc is new Ada.Unchecked_Conversion
-     (System.Address, Value_Array_Acc);
-   function To_Value_Bounds_Array_Acc is new Ada.Unchecked_Conversion
-     (System.Address, Value_Bounds_Array_Acc);
-
-   function Create_Signal_Value (Sig : Ghdl_Signal_Ptr)
-                                return Iir_Value_Literal_Acc
-   is
-      subtype Signal_Value is Iir_Value_Literal (Iir_Value_Signal);
-      function Alloc is new Alloc_On_Pool_Addr (Signal_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Global_Pool'Access,
-                (Kind => Iir_Value_Signal, Sig => Sig)));
-   end Create_Signal_Value;
-
-   function Create_Terminal_Value (Terminal : Terminal_Index_Type)
-                                  return Iir_Value_Literal_Acc
-   is
-      subtype Terminal_Value is Iir_Value_Literal (Iir_Value_Terminal);
-      function Alloc is new Alloc_On_Pool_Addr (Terminal_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Global_Pool'Access,
-                (Kind => Iir_Value_Terminal, Terminal => Terminal)));
-   end Create_Terminal_Value;
-
-   function Create_Quantity_Value (Quantity : Quantity_Index_Type)
-                                  return Iir_Value_Literal_Acc
-   is
-      subtype Quantity_Value is Iir_Value_Literal (Iir_Value_Quantity);
-      function Alloc is new Alloc_On_Pool_Addr (Quantity_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Global_Pool'Access,
-                (Kind => Iir_Value_Quantity, Quantity => Quantity)));
-   end Create_Quantity_Value;
-
-   function Create_Protected_Value (Prot : Protected_Index_Type)
-                                  return Iir_Value_Literal_Acc
-   is
-      subtype Protected_Value is Iir_Value_Literal (Iir_Value_Protected);
-      function Alloc is new Alloc_On_Pool_Addr (Protected_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Global_Pool'Access,
-                (Kind => Iir_Value_Protected, Prot => Prot)));
-   end Create_Protected_Value;
-
-   function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc
-   is
-      subtype B1_Value is Iir_Value_Literal (Iir_Value_B1);
-      function Alloc is new Alloc_On_Pool_Addr (B1_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool, (Kind => Iir_Value_B1, B1 => Val)));
-   end Create_B1_Value;
-
-   function Create_E32_Value (Val : Ghdl_E32) return Iir_Value_Literal_Acc
-   is
-      subtype E32_Value is Iir_Value_Literal (Iir_Value_E32);
-      function Alloc is new Alloc_On_Pool_Addr (E32_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool, (Kind => Iir_Value_E32, E32 => Val)));
-   end Create_E32_Value;
-
-   function Create_I64_Value (Val : Ghdl_I64) return Iir_Value_Literal_Acc
-   is
-      subtype I64_Value is Iir_Value_Literal (Iir_Value_I64);
-      function Alloc is new Alloc_On_Pool_Addr (I64_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool, (Kind => Iir_Value_I64, I64 => Val)));
-   end Create_I64_Value;
-
-   function Create_F64_Value (Val : Ghdl_F64) return Iir_Value_Literal_Acc
-   is
-      subtype F64_Value is Iir_Value_Literal (Iir_Value_F64);
-      function Alloc is new Alloc_On_Pool_Addr (F64_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool, (Kind => Iir_Value_F64, F64 => Val)));
-   end Create_F64_Value;
-
-   function Create_Access_Value (Val : Iir_Value_Literal_Acc)
-                                return Iir_Value_Literal_Acc
-   is
-      subtype Access_Value is Iir_Value_Literal (Iir_Value_Access);
-      function Alloc is new Alloc_On_Pool_Addr (Access_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool,
-                (Kind => Iir_Value_Access, Val_Access => Val)));
-   end Create_Access_Value;
-
-   function Create_Range_Value
-     (Left, Right : Iir_Value_Literal_Acc;
-      Dir : Iir_Direction;
-      Length : Iir_Index32)
-     return Iir_Value_Literal_Acc
-   is
-      subtype Range_Value is Iir_Value_Literal (Iir_Value_Range);
-      function Alloc is new Alloc_On_Pool_Addr (Range_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool,
-                (Kind => Iir_Value_Range,
-                 Left => Left,
-                 Right => Right,
-                 Dir => Dir,
-                 Length => Length)));
-   end Create_Range_Value;
-
-   function Create_File_Value (Val : Grt.Files.Ghdl_File_Index)
-                              return Iir_Value_Literal_Acc
-   is
-      subtype File_Value is Iir_Value_Literal (Iir_Value_File);
-      function Alloc is new Alloc_On_Pool_Addr (File_Value);
-   begin
-      return To_Iir_Value_Literal_Acc
-        (Alloc (Current_Pool,
-                (Kind => Iir_Value_File, File => Val)));
-   end Create_File_Value;
-
-   --  Create a range_value of life LIFE.
-   function Create_Range_Value
-     (Left, Right : Iir_Value_Literal_Acc;
-      Dir : Iir_Direction)
-      return Iir_Value_Literal_Acc
-   is
-      Low, High : Iir_Value_Literal_Acc;
-      Len : Iir_Index32;
-   begin
-      case Dir is
-         when Iir_To =>
-            Low := Left;
-            High := Right;
-         when Iir_Downto =>
-            Low := Right;
-            High := Left;
-      end case;
-
-      case (Low.Kind) is
-         when Iir_Value_B1 =>
-            if High.B1 >= Low.B1 then
-               Len := Ghdl_B1'Pos (High.B1) - Ghdl_B1'Pos (Low.B1) + 1;
-            else
-               Len := 0;
-            end if;
-         when Iir_Value_E32 =>
-            if High.E32 >= Low.E32 then
-               Len := Iir_Index32 (High.E32 - Low.E32 + 1);
-            else
-               Len := 0;
-            end if;
-         when Iir_Value_I64 =>
-            declare
-               L : Ghdl_I64;
-            begin
-               if High.I64 = Ghdl_I64'Last and Low.I64 = Ghdl_I64'First
-               then
-                  --  Prevent overflow
-                  Len := Iir_Index32'Last;
-               else
-                  L := High.I64 - Low.I64;
-                  if L >= Ghdl_I64 (Iir_Index32'Last) then
-                     --  Prevent overflow
-                     Len := Iir_Index32'Last;
-                  else
-                     L := L + 1;
-                     if L < 0 then
-                        --  null range.
-                        Len := 0;
-                     else
-                        Len := Iir_Index32 (L);
-                     end if;
-                  end if;
-               end if;
-            end;
-         when Iir_Value_F64 =>
-            Len := 0;
-         when Iir_Value_Array
-           | Iir_Value_Record
-           | Iir_Value_Access
-           | Iir_Value_File
-           | Iir_Value_Range
-           | Iir_Value_Signal
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-      return Create_Range_Value (Left, Right, Dir, Len);
-   end Create_Range_Value;
-
-   -- Return an array of length LENGTH.
-   function Create_Array_Value (Dim : Iir_Index32;
-                                Pool : Areapool_Acc := Current_Pool)
-                               return Iir_Value_Literal_Acc
-   is
-      subtype Array_Value is Iir_Value_Literal (Iir_Value_Array);
-      function Alloc_Array is new Alloc_On_Pool_Addr (Array_Value);
-      subtype Dim_Type is Value_Bounds_Array (Dim);
-      function Alloc_Bounds is new Alloc_On_Pool_Addr (Dim_Type);
-      Res : Iir_Value_Literal_Acc;
-   begin
-      Res := To_Iir_Value_Literal_Acc
-        (Alloc_Array (Pool,
-                      (Kind => Iir_Value_Array,
-                       Bounds => null, Val_Array => null)));
-
-      Res.Bounds := To_Value_Bounds_Array_Acc
-        (Alloc_Bounds (Pool, Dim_Type'(Nbr_Dims => Dim,
-                                       D => (others => null))));
-
-      return Res;
-   end Create_Array_Value;
-
-   procedure Create_Array_Data (Arr : Iir_Value_Literal_Acc;
-                                Len : Iir_Index32;
-                                Pool : Areapool_Acc := Current_Pool)
-   is
-      use System;
-      subtype Data_Type is Value_Array (Len);
-      Res : Address;
-   begin
-      --  Manually allocate the array to handle large arrays without
-      --  creating a large temporary value.
-      Allocate
-        (Pool.all, Res, Data_Type'Size / Storage_Unit, Data_Type'Alignment);
-
-      declare
-         --  Discard the warnings for no pragma Import as we really want
-         --  to use the default initialization.
-         pragma Warnings (Off);
-         Addr1 : constant Address := Res;
-         Init : Data_Type;
-         for Init'Address use Addr1;
-         pragma Warnings (On);
-      begin
-         null;
-      end;
-
-      Arr.Val_Array := To_Value_Array_Acc (Res);
-   end Create_Array_Data;
-
-   function Create_Array_Value (Length: Iir_Index32;
-                                Dim : Iir_Index32;
-                                Pool : Areapool_Acc := Current_Pool)
-                               return Iir_Value_Literal_Acc
-   is
-      Res : Iir_Value_Literal_Acc;
-   begin
-      Res := Create_Array_Value (Dim, Pool);
-      Create_Array_Data (Res, Length, Pool);
-      return Res;
-   end Create_Array_Value;
-
-   function Create_Record_Value
-     (Nbr : Iir_Index32; Pool : Areapool_Acc := Current_Pool)
-     return Iir_Value_Literal_Acc
-   is
-      subtype Record_Value is Iir_Value_Literal (Iir_Value_Record);
-      function Alloc_Record is new Alloc_On_Pool_Addr (Record_Value);
-      subtype Data_Type is Value_Array (Nbr);
-      function Alloc_Data is new Alloc_On_Pool_Addr (Data_Type);
-      Res : Iir_Value_Literal_Acc;
-   begin
-      Res := To_Iir_Value_Literal_Acc
-        (Alloc_Record (Pool, (Kind => Iir_Value_Record, Val_Record => null)));
-
-      Res.Val_Record := To_Value_Array_Acc
-        (Alloc_Data (Pool, Data_Type'(Len => Nbr, V => (others => null))));
-
-      return Res;
-   end Create_Record_Value;
-
-   -- Create a copy of SRC with a specified life.
-   function Copy (Src: in Iir_Value_Literal_Acc)
-                  return Iir_Value_Literal_Acc
-   is
-      Res: Iir_Value_Literal_Acc;
-   begin
-      case Src.Kind is
-         when Iir_Value_E32 =>
-            return Create_E32_Value (Src.E32);
-         when Iir_Value_I64 =>
-            return Create_I64_Value (Src.I64);
-         when Iir_Value_F64 =>
-            return Create_F64_Value (Src.F64);
-         when Iir_Value_B1 =>
-            return Create_B1_Value (Src.B1);
-         when Iir_Value_Access =>
-            return Create_Access_Value (Src.Val_Access);
-         when Iir_Value_Array =>
-            Res := Copy_Array_Bound (Src);
-            for I in Src.Val_Array.V'Range loop
-               Res.Val_Array.V (I) := Copy (Src.Val_Array.V (I));
-            end loop;
-            return Res;
-
-         when Iir_Value_Range =>
-            return Create_Range_Value
-              (Left => Copy (Src.Left),
-               Right => Copy (Src.Right),
-               Dir => Src.Dir,
-               Length => Src.Length);
-
-         when Iir_Value_Record =>
-            Res := Copy_Record (Src);
-            for I in Src.Val_Record.V'Range loop
-               Res.Val_Record.V (I) := Copy (Src.Val_Record.V (I));
-            end loop;
-            return Res;
-
-         when Iir_Value_File =>
-            return Create_File_Value (Src.File);
-         when Iir_Value_Protected =>
-            return Create_Protected_Value (Src.Prot);
-
-         when Iir_Value_Signal
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            raise Internal_Error;
-      end case;
-   end Copy;
-
-   function Copy_Array_Bound (Src : Iir_Value_Literal_Acc)
-                             return Iir_Value_Literal_Acc
-   is
-      Res : Iir_Value_Literal_Acc;
-   begin
-      Res := Create_Array_Value (Src.Val_Array.Len, Src.Bounds.Nbr_Dims);
-      for I in Res.Bounds.D'Range loop
-         Res.Bounds.D (I) := Copy (Src.Bounds.D (I));
-      end loop;
-      return Res;
-   end Copy_Array_Bound;
-
-   function Copy_Record (Src : Iir_Value_Literal_Acc)
-                        return Iir_Value_Literal_Acc is
-   begin
-      return Create_Record_Value (Src.Val_Record.Len);
-   end Copy_Record;
-
-   function Unshare (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
-                    return Iir_Value_Literal_Acc
-   is
-      Prev_Pool : constant Areapool_Acc := Current_Pool;
-      Res : Iir_Value_Literal_Acc;
-   begin
-      Current_Pool := Pool;
-      Res := Copy (Src);
-      Current_Pool := Prev_Pool;
-      return Res;
-   end Unshare;
-
-   function Unshare_Bounds (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
-                           return Iir_Value_Literal_Acc is
-   begin
-      if Src.Kind /= Iir_Value_Array then
-         return Src;
-      end if;
-      declare
-         Prev_Pool : constant Areapool_Acc := Current_Pool;
-         Res : Iir_Value_Literal_Acc;
-      begin
-         Current_Pool := Pool;
-         Res := Create_Array_Value (Src.Val_Array.Len, Src.Bounds.Nbr_Dims);
-         for I in Src.Bounds.D'Range loop
-            Res.Bounds.D (I) := Copy (Src.Bounds.D (I));
-         end loop;
-         Res.Val_Array.V := Src.Val_Array.V;
-         Current_Pool := Prev_Pool;
-         return Res;
-      end;
-   end Unshare_Bounds;
-
-   Heap_Pool : aliased Areapool;
-
-   function Unshare_Heap (Src : Iir_Value_Literal_Acc)
-                         return Iir_Value_Literal_Acc is
-   begin
-      --  FIXME: this is never free.
-      return Unshare (Src, Heap_Pool'Access);
-   end Unshare_Heap;
-
-   procedure Free_Heap_Value (Acc : Iir_Value_Literal_Acc) is
-   begin
-      null;
-   end Free_Heap_Value;
-
-   function Get_Nbr_Of_Scalars (Val : Iir_Value_Literal_Acc) return Natural is
-   begin
-      case Val.Kind is
-         when Iir_Value_Scalars
-           | Iir_Value_Access
-           | Iir_Value_Signal =>
-            return 1;
-         when Iir_Value_Record =>
-            declare
-               Total : Natural := 0;
-            begin
-               for I in Val.Val_Record.V'Range loop
-                  Total := Total + Get_Nbr_Of_Scalars (Val.Val_Record.V (I));
-               end loop;
-               return Total;
-            end;
-         when Iir_Value_Array =>
-            if Val.Val_Array.Len = 0 then
-               --  Nul array
-               return 0;
-            else
-               --  At least one element.
-               return Natural (Val.Val_Array.Len)
-                 * Get_Nbr_Of_Scalars (Val.Val_Array.V (1));
-            end if;
-         when Iir_Value_File
-           | Iir_Value_Range
-           | Iir_Value_Protected
-           | Iir_Value_Terminal
-           | Iir_Value_Quantity =>
-            raise Internal_Error;
-      end case;
-   end Get_Nbr_Of_Scalars;
-
-   function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural is
-   begin
-      case Val.Kind is
-         when Iir_Value_E32 =>
-            return Ghdl_E32'Pos (Val.E32);
-         when Iir_Value_B1 =>
-            return Ghdl_B1'Pos (Val.B1);
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Get_Enum_Pos;
-
-   procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc;
-                             Tab: Ada.Text_IO.Count)
-   is
-      use Ada.Text_IO;
-      use GNAT.Debug_Utilities;
-   begin
-      Set_Col (Tab);
-      if Value = null then
-         Put_Line ("*NULL*");
-         return;
-      end if;
-
-      if Boolean'(True) then
-         Put (Image (Value.all'Address) & ' ');
-      end if;
-
-      case Value.Kind is
-         when Iir_Value_B1 =>
-            Put_Line ("b1:" & Ghdl_B1'Image (Value.B1));
-         when Iir_Value_E32 =>
-            Put_Line ("e32:" & Ghdl_E32'Image (Value.E32));
-         when Iir_Value_I64 =>
-            Put_Line ("i64:" & Ghdl_I64'Image (Value.I64));
-         when Iir_Value_F64 =>
-            Put_Line ("F64:" & Ghdl_F64'Image (Value.F64));
-         when Iir_Value_Access =>
-            -- FIXME.
-            if Value.Val_Access = null then
-               Put_Line ("access: null");
-            else
-               Put ("access: ");
-               Put_Line (Image (Value.Val_Access.all'Address));
-            end if;
-         when Iir_Value_Array =>
-            if Value.Val_Array = null then
-               Put_Line ("array, without elements");
-               return;
-            else
-               Put_Line ("array, length: "
-                         & Iir_Index32'Image (Value.Val_Array.Len));
-               declare
-                  Ntab: constant Count := Tab + Indentation;
-               begin
-                  Set_Col (Ntab);
-                  if Value.Bounds /= null then
-                     Put_Line ("bounds 1 .."
-                               & Iir_Index32'Image (Value.Bounds.Nbr_Dims)
-                               & ':');
-                     for I in Value.Bounds.D'Range loop
-                        Disp_Value_Tab (Value.Bounds.D (I), Ntab);
-                     end loop;
-                  else
-                     Put_Line ("bounds = null");
-                  end if;
-                  Set_Col (Ntab);
-                  Put_Line ("values 1 .."
-                            & Iir_Index32'Image (Value.Val_Array.Len)
-                            & ':');
-                  for I in Value.Val_Array.V'Range loop
-                     Disp_Value_Tab (Value.Val_Array.V (I), Ntab);
-                  end loop;
-               end;
-            end if;
-
-         when Iir_Value_Range =>
-            Put_Line ("range:");
-            Set_Col (Tab);
-            Put (" direction: ");
-            Put (Iir_Direction'Image (Value.Dir));
-            Put (", length:");
-            Put_Line (Iir_Index32'Image (Value.Length));
-            if Value.Left /= null then
-               Set_Col (Tab);
-               Put (" left bound: ");
-               Disp_Value_Tab (Value.Left, Col);
-            end if;
-            if Value.Right /= null then
-               Set_Col (Tab);
-               Put (" right bound: ");
-               Disp_Value_Tab (Value.Right, Col);
-            end if;
-
-         when Iir_Value_Record =>
-            Put_Line ("record:");
-            for I in Value.Val_Record.V'Range loop
-               Disp_Value_Tab (Value.Val_Record.V (I), Tab + Indentation);
-            end loop;
-         when Iir_Value_Signal =>
-            Put ("signal: ");
-            if Value.Sig = null then
-               Put_Line ("(not created)");
-            else
-               Put_Line (Image (Value.Sig.all'Address));
-            end if;
-
-         when Iir_Value_File =>
-            Put_Line ("file:" & Grt.Files.Ghdl_File_Index'Image (Value.File));
-         when Iir_Value_Protected =>
-            Put_Line ("protected");
-         when Iir_Value_Quantity =>
-            Put_Line ("quantity");
-         when Iir_Value_Terminal =>
-            Put_Line ("terminal");
-      end case;
-   end Disp_Value_Tab;
-
-   procedure Disp_Value (Value: Iir_Value_Literal_Acc) is
-   begin
-      Disp_Value_Tab (Value, 1);
-   end Disp_Value;
-
-   --  Return TRUE if VALUE has an indirect value.
-   function Is_Indirect (Value : Iir_Value_Literal_Acc) return Boolean is
-   begin
-      case Value.Kind is
-         when Iir_Value_Scalars
-           | Iir_Value_Access
-           | Iir_Value_File
-           | Iir_Value_Protected
-           | Iir_Value_Quantity
-           | Iir_Value_Terminal =>
-            return False;
-         when Iir_Value_Range =>
-            return Is_Indirect (Value.Left)
-              or else Is_Indirect (Value.Right);
-         when Iir_Value_Array =>
-            for I in Value.Val_Array.V'Range loop
-               if Is_Indirect (Value.Val_Array.V (I)) then
-                  return True;
-               end if;
-            end loop;
-            return False;
-         when Iir_Value_Record =>
-            for I in Value.Val_Record.V'Range loop
-               if Is_Indirect (Value.Val_Record.V (I)) then
-                  return True;
-               end if;
-            end loop;
-            return False;
-         when Iir_Value_Signal =>
-            return True;
-      end case;
-   end Is_Indirect;
-
-   procedure Disp_Iir_Value_Array (Value: Iir_Value_Literal_Acc;
-                                   A_Type: Iir;
-                                   Dim: Iir_Index32;
-                                   Off : in out Iir_Index32)
-   is
-      use Ada.Text_IO;
-      type Last_Enum_Type is (None, Char, Identifier);
-      Last_Enum: Last_Enum_Type;
-      El_Type: Iir;
-      Enum_List: Iir_List;
-      El_Id : Name_Id;
-      El_Pos : Natural;
-   begin
-      if Dim = Value.Bounds.Nbr_Dims then
-         --  Last dimension
-         El_Type := Get_Base_Type (Get_Element_Subtype (A_Type));
-
-         --  Pretty print vectors of enumerated types
-         if Get_Kind (El_Type) = Iir_Kind_Enumeration_Type_Definition
-           and then not Is_Indirect (Value)
-         then
-            Last_Enum := None;
-            Enum_List := Get_Enumeration_Literal_List (El_Type);
-            for I in 1 .. Value.Bounds.D (Dim).Length loop
-               El_Pos := Get_Enum_Pos (Value.Val_Array.V (Off));
-               Off := Off + 1;
-               El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos));
-               if Name_Table.Is_Character (El_Id) then
-                  case Last_Enum is
-                     when None =>
-                        Put ("""");
-                     when Identifier =>
-                        Put (" & """);
-                     when Char =>
-                        null;
-                  end case;
-                  Put (Name_Table.Get_Character (El_Id));
-                  Last_Enum := Char;
-               else
-                  case Last_Enum is
-                     when None =>
-                        null;
-                     when Identifier =>
-                        Put (" & ");
-                     when Char =>
-                        Put (""" & ");
-                  end case;
-                  Put (Name_Table.Image (El_Id));
-                  Last_Enum := Identifier;
-               end if;
-            end loop;
-            case Last_Enum is
-               when None =>
-                  Put ("""");
-               when Identifier =>
-                  null;
-               when Char =>
-                  Put ("""");
-            end case;
-         else
-            Put ("(");
-            for I in 1 .. Value.Bounds.D (Dim).Length loop
-               if I /= 1 then
-                  Put (", ");
-               end if;
-               Disp_Iir_Value (Value.Val_Array.V (Off), El_Type);
-               Off := Off + 1;
-            end loop;
-            Put (")");
-         end if;
-      else
-         Put ("(");
-         for I in 1 .. Value.Bounds.D (Dim).Length loop
-            if I /= 1 then
-               Put (", ");
-            end if;
-            Disp_Iir_Value_Array (Value, A_Type, Dim + 1, Off);
-         end loop;
-         Put (")");
-      end if;
-   end Disp_Iir_Value_Array;
-
-   procedure Disp_Iir_Value_Record
-     (Value: Iir_Value_Literal_Acc; A_Type: Iir)
-   is
-      use Ada.Text_IO;
-      El : Iir_Element_Declaration;
-      List : Iir_List;
-   begin
-      List := Get_Elements_Declaration_List (Get_Base_Type (A_Type));
-      Put ("(");
-      for I in Value.Val_Record.V'Range loop
-         El := Get_Nth_Element (List, Natural (I - 1));
-         if I /= 1 then
-            Put (", ");
-         end if;
-         Put (Name_Table.Image (Get_Identifier (El)));
-         Put (" => ");
-         Disp_Iir_Value (Value.Val_Record.V (I), Get_Type (El));
-      end loop;
-      Put (")");
-   end Disp_Iir_Value_Record;
-
-   procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir) is
-      use Ada.Text_IO;
-   begin
-      if Value = null then
-         Put ("!NULL!");
-         return;
-      end if;
-      case Value.Kind is
-         when Iir_Value_I64 =>
-            Put (Ghdl_I64'Image (Value.I64));
-         when Iir_Value_F64 =>
-            Put (Ghdl_F64'Image (Value.F64));
-         when Iir_Value_E32
-           | Iir_Value_B1 =>
-            declare
-               Bt : constant Iir := Get_Base_Type (A_Type);
-               Id : Name_Id;
-               Pos : Integer;
-            begin
-               if Value.Kind = Iir_Value_E32 then
-                  Pos := Ghdl_E32'Pos (Value.E32);
-               else
-                  Pos := Ghdl_B1'Pos (Value.B1);
-               end if;
-               Id := Get_Identifier
-                 (Get_Nth_Element (Get_Enumeration_Literal_List (Bt), Pos));
-               Put (Name_Table.Image (Id));
-            end;
-         when Iir_Value_Access =>
-            if Value.Val_Access = null then
-               Put ("null");
-            else
-               -- FIXME.
-               Put ("*acc*");
-            end if;
-         when Iir_Value_Array =>
-            declare
-               Off : Iir_Index32;
-            begin
-               Off := 1;
-               Disp_Iir_Value_Array (Value, A_Type, 1, Off);
-               pragma Assert (Off = Value.Val_Array.Len + 1);
-            end;
-         when Iir_Value_File =>
-            raise Internal_Error;
-         when Iir_Value_Record =>
-            Disp_Iir_Value_Record (Value, A_Type);
-         when Iir_Value_Range =>
-            -- FIXME.
-            raise Internal_Error;
-         when Iir_Value_Quantity =>
-            Put ("[quantity]");
-         when Iir_Value_Terminal =>
-            Put ("[terminal]");
-         when Iir_Value_Signal =>
-            Put ("[signal]");
-         when Iir_Value_Protected =>
-            Put ("[protected]");
-      end case;
-   end Disp_Iir_Value;
-end Iir_Values;