vhdl2008: add translation and support for most of implicit operators.

15 files changed, 433 insertions, 112 deletions

diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
index 4da06c594..b95c0f0a9 100644
--- a/translate/grt/grt-cbinding.c
+++ b/translate/grt/grt-cbinding.c
@@ -52,7 +52,7 @@ __ghdl_snprintf_nf (char *buf, unsigned int len, int ndigits, double val)
 }
 
 void
-__ghdl_snprintf_fmtf (const char *buf, unsigned int len,
+__ghdl_snprintf_fmtf (char *buf, unsigned int len,
 		      const char *format, double v)
 {
   snprintf (buf, len, format, v);
diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb
index 2d4d8f689..eddea38c1 100644
--- a/translate/grt/grt-errors.adb
+++ b/translate/grt/grt-errors.adb
@@ -46,6 +46,12 @@ package body Grt.Errors is
    pragma Import (C, Maybe_Return_Via_Longjump,
                   "__ghdl_maybe_return_via_longjump");
 
+   procedure Exit_Simulation is
+   begin
+      Maybe_Return_Via_Longjump (-2);
+      Internal_Error ("exit_simulation");
+   end Exit_Simulation;
+
    procedure Fatal_Error is
    begin
       if Error_Hook /= null then
diff --git a/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads
index 483ceab67..c797a71bd 100644
--- a/translate/grt/grt-errors.ads
+++ b/translate/grt/grt-errors.ads
@@ -67,6 +67,9 @@ package Grt.Errors is
    pragma No_Return (Fatal_Error);
    pragma Export (C, Fatal_Error, "__ghdl_fatal");
 
+   Exit_Status : Integer := 0;
+   procedure Exit_Simulation;
+
    --  Hook called in case of error.
    Error_Hook : Grt.Hooks.Proc_Hook_Type := null;
 
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 49bce9d75..59830c137 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -29,6 +29,7 @@ with Ada.Unchecked_Conversion;
 with Grt.Rtis_Utils; use Grt.Rtis_Utils;
 with Grt.Processes; use Grt.Processes;
 with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Errors; use Grt.Errors;
 
 package body Grt.Images is
    function To_Std_String_Basep is new Ada.Unchecked_Conversion
@@ -37,19 +38,25 @@ package body Grt.Images is
    function To_Std_String_Boundp is new Ada.Unchecked_Conversion
      (Source => System.Address, Target => Std_String_Boundp);
 
-   procedure Return_String (Res : Std_String_Ptr; Str : String)
+   procedure Set_String_Bounds (Res : Std_String_Ptr; Len : Ghdl_Index_Type)
    is
    begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
       Res.Bounds := To_Std_String_Boundp
         (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      Res.Bounds.Dim_1 := (Left => 1,
+                           Right => Std_Integer (Len),
+                           Dir => Dir_To,
+                           Length => Len);
+   end Set_String_Bounds;
+
+   procedure Return_String (Res : Std_String_Ptr; Str : String)
+   is
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
       for I in 0 .. Str'Length - 1 loop
          Res.Base (Ghdl_Index_Type (I)) := Str (Str'First + I);
       end loop;
-      Res.Bounds.Dim_1 := (Left => 1,
-                           Right => Str'Length,
-                           Dir => Dir_To,
-                           Length => Str'Length);
+      Set_String_Bounds (Res, Str'Length);
    end Return_String;
 
    procedure Return_Enum
@@ -165,20 +172,195 @@ package body Grt.Images is
       Return_String (Res, Str (1 .. P));
    end Ghdl_To_String_F64_Digits;
 
+   procedure Ghdl_To_String_F64_Format
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Format : Std_String_Ptr)
+   is
+      C_Format : String (1 .. Positive (Format.Bounds.Dim_1.Length + 1));
+      Str : Grt.Vstrings.String_Real_Format;
+      P : Natural;
+   begin
+      for I in 1 .. C_Format'Last - 1 loop
+         C_Format (I) := Format.Base (Ghdl_Index_Type (I - 1));
+      end loop;
+      C_Format (C_Format'Last) := NUL;
+
+      To_String (Str, P, Val, To_Ghdl_C_String (C_Format'Address));
+      Return_String (Res, Str (1 .. P));
+   end Ghdl_To_String_F64_Format;
+
+   subtype Log_Base_Type is Ghdl_Index_Type range 3 .. 4;
+   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
+     "0123456789ABCDEF";
+
+   procedure Ghdl_BV_To_String (Res : Std_String_Ptr;
+                                Val : Std_Bit_Vector_Basep;
+                                Len : Ghdl_Index_Type;
+                                Log_Base : Log_Base_Type)
+   is
+      Res_Len : constant Ghdl_Index_Type := (Len + Log_Base - 1) / Log_Base;
+      Pos : Ghdl_Index_Type;
+      V : Natural;
+      Sh : Natural range 0 .. 4;
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Res_Len));
+      V := 0;
+      Sh := 0;
+      Pos := Res_Len - 1;
+      for I in reverse 1 .. Len loop
+         V := V + Std_Bit'Pos (Val (I - 1)) * (2 ** Sh);
+         Sh := Sh + 1;
+         if Sh = Natural (Log_Base) or else I = 1 then
+            Res.Base (Pos) := Hex_Chars (V);
+            Pos := Pos - 1;
+            Sh := 0;
+            V := 0;
+         end if;
+      end loop;
+      Set_String_Bounds (Res, Res_Len);
+   end Ghdl_BV_To_String;
+
    procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr;
                                  Base : Std_Bit_Vector_Basep;
                                  Len : Ghdl_Index_Type) is
    begin
-      raise Program_Error;
+      Ghdl_BV_To_String (Res, Base, Len, 3);
    end Ghdl_BV_To_Ostring;
 
    procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr;
                                  Base : Std_Bit_Vector_Basep;
                                  Len : Ghdl_Index_Type) is
    begin
-      raise Program_Error;
+      Ghdl_BV_To_String (Res, Base, Len, 4);
    end Ghdl_BV_To_Hstring;
 
+   procedure To_String_Enum
+     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+      Str : Ghdl_C_String;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str := Enum_Rti.Names (Index);
+      if Str (1) = ''' then
+         Return_String (Res, Str (2 .. 2));
+      else
+         Return_String (Res, Str (1 .. strlen (Str)));
+      end if;
+   end To_String_Enum;
+
+   procedure Ghdl_To_String_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_B1'Pos (Val));
+   end Ghdl_To_String_B1;
+
+   procedure Ghdl_To_String_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_E8'Pos (Val));
+   end Ghdl_To_String_E8;
+
+   procedure Ghdl_To_String_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_E32'Pos (Val));
+   end Ghdl_To_String_E32;
+
+   procedure Ghdl_To_String_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
+     renames Ghdl_Image_P32;
+
+   procedure Ghdl_To_String_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
+     renames Ghdl_Image_P64;
+
+   procedure Ghdl_Time_To_String_Unit
+     (Res : Std_String_Ptr;
+      Val : Std_Time; Unit : Std_Time; Rti : Ghdl_Rti_Access)
+   is
+      Str : Grt.Vstrings.String_Time_Unit;
+      First : Natural;
+      Phys : constant Ghdl_Rtin_Type_Physical_Acc
+        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Unit_Len : Natural;
+   begin
+      Unit_Name := null;
+      for I in 1 .. Phys.Nbr loop
+         if Get_Physical_Unit_Value (Phys.Units (I - 1), Rti) = Ghdl_I64 (Unit)
+         then
+            Unit_Name := Get_Physical_Unit_Name (Phys.Units (I - 1));
+            exit;
+         end if;
+      end loop;
+      if Unit_Name = null then
+         Error ("no unit for to_string");
+      end if;
+      Grt.Vstrings.To_String (Str, First, Ghdl_I64 (Val), Ghdl_I64 (Unit));
+      Unit_Len := strlen (Unit_Name);
+      declare
+         L : constant Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Time_To_String_Unit;
+
+   procedure Ghdl_Array_Char_To_String_B1
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_B1_Array_Base_Ptr := To_Ghdl_B1_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_B1'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_B1;
+
+   procedure Ghdl_Array_Char_To_String_E8
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_E8_Array_Base_Ptr := To_Ghdl_E8_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_E8'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_E8;
+
+   procedure Ghdl_Array_Char_To_String_E32
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_E32_Array_Base_Ptr :=
+        To_Ghdl_E32_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_E32'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_E32;
+
 --     procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
 --     is
 --        --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads
index a5d8415a3..b85f8e6a0 100644
--- a/translate/grt/grt-images.ads
+++ b/translate/grt/grt-images.ads
@@ -46,6 +46,31 @@ package Grt.Images is
    procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
    procedure Ghdl_To_String_F64_Digits
      (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32);
+   procedure Ghdl_To_String_F64_Format
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Format : Std_String_Ptr);
+   procedure Ghdl_To_String_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Time_To_String_Unit
+     (Res : Std_String_Ptr;
+      Val : Std_Time; Unit : Std_Time; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_B1
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_E8
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_E32
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+
    procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr;
                                  Base : Std_Bit_Vector_Basep;
                                  Len : Ghdl_Index_Type);
@@ -64,6 +89,19 @@ private
    pragma Export (C, Ghdl_To_String_I32, "__ghdl_to_string_i32");
    pragma Export (C, Ghdl_To_String_F64, "__ghdl_to_string_f64");
    pragma Export (C, Ghdl_To_String_F64_Digits, "__ghdl_to_string_f64_digits");
+   pragma Export (C, Ghdl_To_String_F64_Format, "__ghdl_to_string_f64_format");
+   pragma Export (Ada, Ghdl_To_String_B1, "__ghdl_to_string_b1");
+   pragma Export (C, Ghdl_To_String_E8, "__ghdl_to_string_e8");
+   pragma Export (C, Ghdl_To_String_E32, "__ghdl_to_string_e32");
+   pragma Export (C, Ghdl_To_String_P32, "__ghdl_to_string_p32");
+   pragma Export (C, Ghdl_To_String_P64, "__ghdl_to_string_p64");
+   pragma Export (C, Ghdl_Time_To_String_Unit, "__ghdl_time_to_string_unit");
+   pragma Export (C, Ghdl_Array_Char_To_String_B1,
+                  "__ghdl_array_char_to_string_b1");
+   pragma Export (C, Ghdl_Array_Char_To_String_E8,
+                  "__ghdl_array_char_to_string_e8");
+   pragma Export (C, Ghdl_Array_Char_To_String_E32,
+                  "__ghdl_array_char_to_string_e32");
    pragma Export (C, Ghdl_BV_To_Ostring, "__ghdl_bv_to_ostring");
    pragma Export (C, Ghdl_BV_To_Hstring, "__ghdl_bv_to_hstring");
 end Grt.Images;
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
index 3c10417aa..d2b095c67 100644
--- a/translate/grt/grt-lib.adb
+++ b/translate/grt/grt-lib.adb
@@ -39,40 +39,14 @@ package body Grt.Lib is
       Memmove (Dest, Src, Size);
    end Ghdl_Memcpy;
 
-   Ieee_Name : constant String := "ieee" & NUL;
-
    procedure Do_Report (Msg : String;
                         Str : Std_String_Ptr;
                         Default_Str : String;
                         Severity : Integer;
-                        Loc : Ghdl_Location_Ptr;
-                        Unit : Ghdl_Rti_Access)
+                        Loc : Ghdl_Location_Ptr)
    is
-      use Grt.Options;
       Level : constant Integer := Severity mod 256;
    begin
-      --  Assertions from ieee library can be disabled.
-      if Unit /= null
-        and then Unit.Kind = Ghdl_Rtik_Package_Body
-        and then (Ieee_Asserts = Disable_Asserts
-                    or (Ieee_Asserts = Disable_Asserts_At_Time_0
-                          and Current_Time = 0))
-      then
-         declare
-            Blk : constant Ghdl_Rtin_Block_Acc :=
-              To_Ghdl_Rtin_Block_Acc (Unit);
-            Pkg : constant Ghdl_Rtin_Block_Acc :=
-              To_Ghdl_Rtin_Block_Acc (Blk.Parent);
-            Lib : constant Ghdl_Rtin_Type_Scalar_Acc :=
-              To_Ghdl_Rtin_Type_Scalar_Acc (Pkg.Parent);
-         begin
-            --  Return now if this assert comes from the ieee library.
-            if Strcmp (Lib.Name, To_Ghdl_C_String (Ieee_Name'Address)) = 0 then
-               return;
-            end if;
-         end;
-      end if;
-
       Report_H;
       Report_C (Loc.Filename);
       Report_C (":");
@@ -109,56 +83,52 @@ package body Grt.Lib is
    end Do_Report;
 
    procedure Ghdl_Assert_Failed
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access)
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
    is
    begin
-      Do_Report ("assertion",
-                 Str, "Assertion violation", Severity, Loc, Unit);
+      Do_Report ("assertion", Str, "Assertion violation", Severity, Loc);
    end Ghdl_Assert_Failed;
 
-   procedure Ghdl_Psl_Assert_Failed
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access)
+   procedure Ghdl_Ieee_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
    is
+      use Grt.Options;
+   begin
+      if Ieee_Asserts = Disable_Asserts
+        or else (Ieee_Asserts = Disable_Asserts_At_Time_0 and Current_Time = 0)
+      then
+         return;
+      else
+         Do_Report ("assertion", Str, "Assertion violation", Severity, Loc);
+      end if;
+   end Ghdl_Ieee_Assert_Failed;
+
+   procedure Ghdl_Psl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
    begin
-      Do_Report ("psl assertion",
-                 Str, "Assertion violation", Severity, Loc, Unit);
+      Do_Report ("psl assertion", Str, "Assertion violation", Severity, Loc);
    end Ghdl_Psl_Assert_Failed;
 
    procedure Ghdl_Psl_Cover
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access)
-   is
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
    begin
-      Do_Report ("psl cover", Str, "sequence covered", Severity, Loc, Unit);
+      Do_Report ("psl cover", Str, "sequence covered", Severity, Loc);
    end Ghdl_Psl_Cover;
 
    procedure Ghdl_Psl_Cover_Failed
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access)
-   is
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
    begin
       Do_Report ("psl cover failure",
-                 Str, "sequence not covered", Severity, Loc, Unit);
+                 Str, "sequence not covered", Severity, Loc);
    end Ghdl_Psl_Cover_Failed;
 
    procedure Ghdl_Report
      (Str : Std_String_Ptr;
       Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access)
+      Loc : Ghdl_Location_Ptr)
    is
    begin
-      Do_Report ("report", Str, "Assertion violation", Severity, Loc, Unit);
+      Do_Report ("report", Str, "Assertion violation", Severity, Loc);
    end Ghdl_Report;
 
    procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
@@ -295,7 +265,34 @@ package body Grt.Lib is
          return 1.0 / Res;
       end if;
    end Ghdl_Real_Exp;
-end Grt.Lib;
 
+   function Ghdl_Get_Resolution_Limit return Std_Time is
+   begin
+      return 1;
+   end Ghdl_Get_Resolution_Limit;
 
+   procedure Ghdl_Control_Simulation
+     (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer) is
+   begin
+      Report_H;
+      --  Report_C (Grt.Options.Progname);
+      Report_C ("simulation ");
+      if Stop then
+         Report_C ("stopped");
+      else
+         Report_C ("finished");
+      end if;
+      Report_C (" @");
+      Report_Now_C;
+      if Has_Status then
+         Report_C (" with status ");
+         Report_C (Integer (Status));
+      end if;
+      Report_E ("");
+      if Has_Status then
+         Exit_Status := Integer (Status);
+      end if;
+      Exit_Simulation;
+   end Ghdl_Control_Simulation;
 
+end Grt.Lib;
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
index b0dc0a3e5..4dac2c8d2 100644
--- a/translate/grt/grt-lib.ads
+++ b/translate/grt/grt-lib.ads
@@ -32,35 +32,24 @@ package Grt.Lib is
      (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
 
    procedure Ghdl_Assert_Failed
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access);
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+   procedure Ghdl_Ieee_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
 
    procedure Ghdl_Psl_Assert_Failed
      (Str : Std_String_Ptr;
       Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access);
+      Loc : Ghdl_Location_Ptr);
 
    --  Called when a sequence is covered (in a cover directive)
    procedure Ghdl_Psl_Cover
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access);
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
 
    procedure Ghdl_Psl_Cover_Failed
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access);
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
 
    procedure Ghdl_Report
-     (Str : Std_String_Ptr;
-      Severity : Integer;
-      Loc : Ghdl_Location_Ptr;
-      Unit : Ghdl_Rti_Access);
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
 
    Note_Severity    : constant Integer := 0;
    Warning_Severity : constant Integer := 1;
@@ -103,10 +92,15 @@ package Grt.Lib is
                                                      True,  --  H
                                                      False  --  -
                                                     );
+
+   function Ghdl_Get_Resolution_Limit return Std_Time;
+   procedure Ghdl_Control_Simulation
+     (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer);
 private
    pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy");
 
    pragma Export (C, Ghdl_Assert_Failed, "__ghdl_assert_failed");
+   pragma Export (C, Ghdl_Ieee_Assert_Failed, "__ghdl_ieee_assert_failed");
    pragma Export (C, Ghdl_Psl_Assert_Failed, "__ghdl_psl_assert_failed");
    pragma Export (C, Ghdl_Psl_Cover, "__ghdl_psl_cover");
    pragma Export (C, Ghdl_Psl_Cover_Failed, "__ghdl_psl_cover_failed");
@@ -125,4 +119,9 @@ private
 
    pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array,
                   "__ghdl_std_ulogic_to_boolean_array");
+
+   pragma Export (C, Ghdl_Get_Resolution_Limit,
+                  "__ghdl_get_resolution_limit");
+   pragma Export (Ada, Ghdl_Control_Simulation,
+                  "__ghdl_control_simulation");
 end Grt.Lib;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 3d40f3a96..64db682e2 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -995,7 +995,7 @@ package body Grt.Processes is
             Grt.Disp.Disp_Now;
          end if;
          Status := Run_Through_Longjump (Simulation_Cycle'Access);
-         exit when Status = Run_Failure;
+         exit when Status < 0;
          if Trace_Signals then
             Grt.Disp_Signals.Disp_All_Signals;
          end if;
@@ -1035,7 +1035,7 @@ package body Grt.Processes is
       if Status = Run_Failure then
          return -1;
       else
-         return 0;
+         return Exit_Status ;
       end if;
    end Simulation;
 
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index c441b4000..6bb76597e 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -190,6 +190,8 @@ package Grt.Rtis is
       Common : Ghdl_Rti_Common;
       Name : Ghdl_C_String;
       Nbr : Ghdl_Index_Type;
+      --  Characters are represented as 'X', identifiers are represented as is,
+      --  extended identifiers are represented as is too.
       Names : Ghdl_C_String_Array_Ptr;
    end record;
    type Ghdl_Rtin_Type_Enum_Acc is access Ghdl_Rtin_Type_Enum;
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index 4df5d6f6f..0d4328e7e 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -498,6 +498,28 @@ package body Grt.Rtis_Utils is
       end case;
    end Get_Physical_Unit_Name;
 
+   function Get_Physical_Unit_Value (Unit : Ghdl_Rti_Access;
+                                     Type_Rti : Ghdl_Rti_Access)
+                                    return Ghdl_I64 is
+   begin
+      case Unit.Kind is
+         when Ghdl_Rtik_Unit64 =>
+            return To_Ghdl_Rtin_Unit64_Acc (Unit).Value;
+         when Ghdl_Rtik_Unitptr =>
+            case Type_Rti.Kind is
+               when Ghdl_Rtik_Type_P64 =>
+                  return To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I64;
+               when Ghdl_Rtik_Type_P32 =>
+                  return Ghdl_I64
+                    (To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I32);
+               when others =>
+                  Internal_Error ("get_physical_unit_value(1)");
+            end case;
+         when others =>
+            Internal_Error ("get_physical_unit_value(2)");
+      end case;
+   end Get_Physical_Unit_Value;
+
    procedure Get_Enum_Value
      (Rstr : in out Rstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
    is
diff --git a/translate/grt/grt-rtis_utils.ads b/translate/grt/grt-rtis_utils.ads
index 0cb6e3e81..10c1a0f28 100644
--- a/translate/grt/grt-rtis_utils.ads
+++ b/translate/grt/grt-rtis_utils.ads
@@ -69,6 +69,12 @@ package Grt.Rtis_Utils is
    --  Get the name of a physical unit.
    function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access)
                                    return Ghdl_C_String;
+
+   --  Get the value of a physical unit.
+   function Get_Physical_Unit_Value (Unit : Ghdl_Rti_Access;
+                                     Type_Rti : Ghdl_Rti_Access)
+                                    return Ghdl_I64;
+
    --  Disp a value.
    procedure Disp_Value (Stream : FILEs;
                          Value : Value_Union;
diff --git a/translate/grt/grt-std_logic_1164.adb b/translate/grt/grt-std_logic_1164.adb
index 49d96e766..5be308bd6 100644
--- a/translate/grt/grt-std_logic_1164.adb
+++ b/translate/grt/grt-std_logic_1164.adb
@@ -26,16 +26,16 @@
 with Grt.Lib;
 
 package body Grt.Std_Logic_1164 is
-   Assert_Msg : constant String :=
+   Assert_DC_Msg : constant String :=
      "STD_LOGIC_1164: '-' operand for matching ordering operator";
 
-   Assert_Msg_Bound : constant Std_String_Bound :=
-     (Dim_1 => (Left => 1, Right => Assert_Msg'Length, Dir => Dir_To,
-                Length => Assert_Msg'Length));
+   Assert_DC_Msg_Bound : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1, Right => Assert_DC_Msg'Length, Dir => Dir_To,
+                Length => Assert_DC_Msg'Length));
 
-   Assert_Msg_Str : aliased constant Std_String :=
-     (Base => To_Std_String_Basep (Assert_Msg'Address),
-      Bounds => To_Std_String_Boundp (Assert_Msg_Bound'Address));
+   Assert_DC_Msg_Str : aliased constant Std_String :=
+     (Base => To_Std_String_Basep (Assert_DC_Msg'Address),
+      Bounds => To_Std_String_Boundp (Assert_DC_Msg_Bound'Address));
 
    Filename : constant String := "std_logic_1164.vhdl" & NUL;
    Loc : aliased constant Ghdl_Location :=
@@ -48,10 +48,9 @@ package body Grt.Std_Logic_1164 is
       use Grt.Lib;
    begin
       if V = '-' then
-         --  FIXME: assert disabled for ieee.
-         Ghdl_Assert_Failed
-           (To_Std_String_Ptr (Assert_Msg_Str'Address), Error_Severity,
-            To_Ghdl_Location_Ptr (Loc'Address), null);
+         Ghdl_Ieee_Assert_Failed
+           (To_Std_String_Ptr (Assert_DC_Msg_Str'Address), Error_Severity,
+            To_Ghdl_Location_Ptr (Loc'Address));
       end if;
    end Assert_Not_Match;
 
@@ -95,4 +94,53 @@ package body Grt.Std_Logic_1164 is
       return Std_Ulogic'Pos (Or_Table (Match_Lt_Table (Left, Right),
                                        Match_Eq_Table (Left, Right)));
    end Ghdl_Std_Ulogic_Match_Le;
+
+   Assert_Arr_Msg : constant String :=
+     "parameters of '?=' array operator are not of the same length";
+
+   Assert_Arr_Msg_Bound : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1, Right => Assert_Arr_Msg'Length, Dir => Dir_To,
+                Length => Assert_Arr_Msg'Length));
+
+   Assert_Arr_Msg_Str : aliased constant Std_String :=
+     (Base => To_Std_String_Basep (Assert_Arr_Msg'Address),
+      Bounds => To_Std_String_Boundp (Assert_Arr_Msg_Bound'Address));
+
+
+   function Ghdl_Std_Ulogic_Array_Match_Eq (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32
+   is
+      use Grt.Lib;
+      L_Arr : constant Ghdl_E8_Array_Base_Ptr :=
+        To_Ghdl_E8_Array_Base_Ptr (L);
+      R_Arr : constant Ghdl_E8_Array_Base_Ptr :=
+        To_Ghdl_E8_Array_Base_Ptr (R);
+      Res : Std_Ulogic := '1';
+   begin
+      if L_Len /= R_Len then
+         Ghdl_Ieee_Assert_Failed
+           (To_Std_String_Ptr (Assert_Arr_Msg_Str'Address), Error_Severity,
+            To_Ghdl_Location_Ptr (Loc'Address));
+      end if;
+      for I in 1 .. L_Len loop
+         Res := And_Table
+           (Res, Std_Ulogic'Val (Ghdl_Std_Ulogic_Match_Eq (L_Arr (I - 1),
+                                                           R_Arr (I - 1))));
+      end loop;
+      return Std_Ulogic'Pos (Res);
+   end Ghdl_Std_Ulogic_Array_Match_Eq;
+
+   function Ghdl_Std_Ulogic_Array_Match_Ne (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32 is
+   begin
+      return Std_Ulogic'Pos
+        (Not_Table (Std_Ulogic'Val
+                      (Ghdl_Std_Ulogic_Array_Match_Eq (L, L_Len, R, R_Len))));
+   end Ghdl_Std_Ulogic_Array_Match_Ne;
 end Grt.Std_Logic_1164;
diff --git a/translate/grt/grt-std_logic_1164.ads b/translate/grt/grt-std_logic_1164.ads
index d6b1b7d59..4d1569553 100644
--- a/translate/grt/grt-std_logic_1164.ads
+++ b/translate/grt/grt-std_logic_1164.ads
@@ -99,9 +99,26 @@ package Grt.Std_Logic_1164 is
    function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8;
    function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8;
    --  For Gt and Ge, use Lt and Le with swapped parameters.
+
+   function Ghdl_Std_Ulogic_Array_Match_Eq (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32;
+   function Ghdl_Std_Ulogic_Array_Match_Ne (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32;
+
 private
    pragma Export (C, Ghdl_Std_Ulogic_Match_Eq, "__ghdl_std_ulogic_match_eq");
    pragma Export (C, Ghdl_Std_Ulogic_Match_Ne, "__ghdl_std_ulogic_match_ne");
    pragma Export (C, Ghdl_Std_Ulogic_Match_Lt, "__ghdl_std_ulogic_match_lt");
    pragma Export (C, Ghdl_Std_Ulogic_Match_Le, "__ghdl_std_ulogic_match_le");
+
+   pragma Export (C, Ghdl_Std_Ulogic_Array_Match_Eq,
+                  "__ghdl_std_ulogic_array_match_eq");
+   pragma Export (C, Ghdl_Std_Ulogic_Array_Match_Ne,
+                  "__ghdl_std_ulogic_array_match_ne");
 end Grt.Std_Logic_1164;
diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads
index 96bd97b51..fed822554 100644
--- a/translate/grt/grt-types.ads
+++ b/translate/grt/grt-types.ads
@@ -171,7 +171,23 @@ package Grt.Types is
      (Mode_B1, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64);
 
    type Ghdl_B1_Array is array (Ghdl_Index_Type range <>) of Ghdl_B1;
+   subtype Ghdl_B1_Array_Base is Ghdl_B1_Array (Ghdl_Index_Type);
+   type Ghdl_B1_Array_Base_Ptr is access Ghdl_B1_Array_Base;
+   function To_Ghdl_B1_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_B1_Array_Base_Ptr);
+
    type Ghdl_E8_Array is array (Ghdl_Index_Type range <>) of Ghdl_E8;
+   subtype Ghdl_E8_Array_Base is Ghdl_E8_Array (Ghdl_Index_Type);
+   type Ghdl_E8_Array_Base_Ptr is access Ghdl_E8_Array_Base;
+   function To_Ghdl_E8_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_E8_Array_Base_Ptr);
+
+   type Ghdl_E32_Array is array (Ghdl_Index_Type range <>) of Ghdl_E32;
+   subtype Ghdl_E32_Array_Base is Ghdl_E32_Array (Ghdl_Index_Type);
+   type Ghdl_E32_Array_Base_Ptr is access Ghdl_E32_Array_Base;
+   function To_Ghdl_E32_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_E32_Array_Base_Ptr);
+
    type Ghdl_I32_Array is array (Ghdl_Index_Type range <>) of Ghdl_I32;
 
    type Value_Union (Mode : Mode_Type := Mode_B1) is record
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
index 209f658a5..3d703bc85 100644
--- a/translate/grt/grt-values.adb
+++ b/translate/grt/grt-values.adb
@@ -602,22 +602,7 @@ package body Grt.Values is
          Error_E ("'");
       end if;
 
-      case Multiple.Kind is
-         when Ghdl_Rtik_Unit64 =>
-            Mult := To_Ghdl_Rtin_Unit64_Acc (Multiple).Value;
-         when Ghdl_Rtik_Unitptr =>
-            case Rti.Kind is
-               when Ghdl_Rtik_Type_P64 =>
-                  Mult := To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I64;
-               when Ghdl_Rtik_Type_P32 =>
-                  Mult := Ghdl_I64
-                    (To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I32);
-               when others =>
-                  Internal_Error ("values.physical_type(P32/P64-1)");
-            end case;
-         when others =>
-            Internal_Error ("values.physical_type(P32/P64-2)");
-      end case;
+      Mult := Grt.Rtis_Utils.Get_Physical_Unit_Value (Multiple, Rti);
 
       if Lit_End = 0 then
          return Mult;