simulate: update (and revive).

6 files changed, 87 insertions, 33 deletions

diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb
index 058e3c480..75f099c8e 100644
--- a/src/vhdl/simulate/debugger.adb
+++ b/src/vhdl/simulate/debugger.adb
@@ -137,7 +137,6 @@ package body Debugger is
    procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is
    begin
       Disp_Iir_Location (Loc);
-      Put (Standard_Error, ' ');
       Put_Line (Standard_Error, Msg);
       Grt.Errors.Fatal_Error;
    end Error_Msg_Exec;
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index 08872c833..ef5db6bdb 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -465,13 +465,16 @@ package body Elaboration is
          if Get_Kind (Design) = Iir_Kind_Entity_Aspect_Entity then
             --  During Sem, the architecture may be still unknown, and the
             --  dependency is therefore the aspect.
-            Library_Unit := Get_Architecture (Design);
-            if Get_Kind (Library_Unit) in Iir_Kinds_Denoting_Name then
-               Design := Get_Named_Entity (Library_Unit);
-               Library_Unit := Get_Library_Unit (Design);
-            else
-               Design := Get_Design_Unit (Library_Unit);
-            end if;
+            Library_Unit := Strip_Denoting_Name (Get_Architecture (Design));
+            case Get_Kind (Library_Unit) is
+               when Iir_Kind_Architecture_Body =>
+                  Design := Get_Design_Unit (Library_Unit);
+               when Iir_Kind_Design_Unit =>
+                  Design := Library_Unit;
+                  Library_Unit := Get_Library_Unit (Design);
+               when others =>
+                  Error_Kind ("elaborate_dependence(1)", Library_Unit);
+            end case;
          else
             Library_Unit := Get_Library_Unit (Design);
          end if;
@@ -1206,16 +1209,17 @@ package body Elaboration is
      (Formal_Instance : Block_Instance_Acc;
       Local_Instance : Block_Instance_Acc;
       Actual_Expr : Iir_Value_Literal_Acc;
-      Assoc : Iir_Association_Element_By_Expression)
+      Assoc : Iir_Association_Element_By_Expression;
+      Inter : Iir)
    is
-      Inter : Iir;
+      Formal : Iir;
       Actual : Iir;
       Local_Expr : Iir_Value_Literal_Acc;
       Formal_Expr : Iir_Value_Literal_Acc;
    begin
-      Inter := Get_Formal (Assoc);
+      Formal := Get_Association_Formal (Assoc, Inter);
       Actual := Get_Actual (Assoc);
-      Formal_Expr := Execute_Name (Formal_Instance, Inter, True);
+      Formal_Expr := Execute_Name (Formal_Instance, Formal, True);
       Formal_Expr := Unshare_Bounds (Formal_Expr, Global_Pool'Access);
       if Actual_Expr = null then
          Local_Expr := Execute_Name (Local_Instance, Actual, True);
@@ -1280,7 +1284,7 @@ package body Elaboration is
                  and then Get_Formal_Conversion (Assoc) = Null_Iir
                then
                   Actual := Get_Actual (Assoc);
-                  Formal := Get_Formal (Assoc);
+                  Formal := Get_Association_Formal (Assoc, Inter);
                   if Is_Signal_Name (Actual) then
                      --  Association with a signal
                      Init_Expr := Execute_Signal_Init_Value
@@ -1353,8 +1357,8 @@ package body Elaboration is
                   --  or slice thereof designated by the formal part is then
                   --  associated with the signal or expression designated
                   --  by the actual part.
-                  Elab_Connect
-                    (Formal_Instance, Actual_Instance, Actual_Expr, Assoc);
+                  Elab_Connect (Formal_Instance, Actual_Instance, Actual_Expr,
+                                Assoc, Inter);
                end if;
 
             when Iir_Kind_Association_Element_Open =>
@@ -1969,7 +1973,8 @@ package body Elaboration is
          when Iir_Kind_Entity_Aspect_Entity =>
             Entity := Get_Entity (Aspect);
             if Get_Architecture (Aspect) /= Null_Iir then
-               Arch_Name := Get_Identifier (Get_Architecture (Aspect));
+               Arch_Name := Get_Identifier
+                 (Strip_Denoting_Name (Get_Architecture (Aspect)));
             end if;
          when Iir_Kind_Entity_Aspect_Configuration =>
             if Sub_Conf /= Null_Iir then
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index 18f42a7bd..ad15360f9 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -573,7 +573,9 @@ package body Execution is
    is
       pragma Unsuppress (Overflow_Check);
 
-      Func : Iir_Predefined_Functions;
+      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;
@@ -596,15 +598,7 @@ package body Execution is
          --  Need to copy as the result is modified.
          Result := Unshare (Left, Expr_Pool'Access);
       end Eval_Array;
-
-      Imp : Iir;
    begin
-      Imp := Get_Implementation (Expr);
-      if Get_Kind (Imp) in Iir_Kinds_Denoting_Name then
-         Imp := Get_Named_Entity (Imp);
-      end if;
-      Func := Get_Implicit_Definition (Imp);
-
       --  Eval left operand.
       case Func is
          when Iir_Predefined_Now_Function =>
@@ -1566,6 +1560,9 @@ package body Execution is
             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;
@@ -3479,8 +3476,8 @@ package body Execution is
       Assoc_Inter := Inter_Chain;
       Assoc_Idx := 1;
       while Assoc /= Null_Iir loop
-         Formal := Get_Formal (Assoc);
          Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+         Formal := Get_Association_Formal (Assoc, Inter);
 
          --  Extract the actual value.
          case Get_Kind (Assoc) is
@@ -3635,8 +3632,9 @@ package body Execution is
       Assoc_Idx := 1;
       while Assoc /= Null_Iir loop
          if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then
-            Formal := Get_Formal (Assoc);
             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
@@ -3703,17 +3701,20 @@ package body Execution is
      (Block: Block_Instance_Acc; Expr : Iir; Imp : Iir)
       return Iir_Value_Literal_Acc
    is
-      pragma Unreferenced (Block);
+      Res : Iir_Value_Literal_Acc;
    begin
       case Get_Identifier (Imp) is
          when Std_Names.Name_Get_Resolution_Limit =>
-            return Create_I64_Value
+            Res := Create_I64_Value
               (Ghdl_I64
                  (Evaluation.Get_Physical_Value (Std_Package.Time_Base)));
+         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 null;
+      return Res;
    end Execute_Foreign_Function_Call;
 
    -- BLOCK is the block instance in which the function call appears.
diff --git a/src/vhdl/simulate/file_operation.adb b/src/vhdl/simulate/file_operation.adb
index d5d141c53..dab6ec889 100644
--- a/src/vhdl/simulate/file_operation.adb
+++ b/src/vhdl/simulate/file_operation.adb
@@ -20,8 +20,8 @@ with Types; use Types;
 with Annotations; use Annotations;
 with Execution; use Execution;
 with Debugger; use Debugger;
-with Grt.Types; use Grt.Types;
 with Grt_Interface; use Grt_Interface;
+with Grt.Lib;
 
 package body File_Operation is
    --  Open a file.
@@ -342,4 +342,43 @@ package body File_Operation is
    begin
       Ghdl_File_Flush (File.File);
    end Flush;
+
+   procedure Textio_Write_Real (Str : Iir_Value_Literal_Acc;
+                                Len : Iir_Value_Literal_Acc;
+                                Val : Ghdl_F64;
+                                Ndigits : Std_Integer)
+   is
+      Len_Arg : aliased Std_Integer;
+      Str_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (Str.Bounds.D (1).Length);
+      Str_Str : aliased Std_String_Uncons (1 .. Str_Len);
+      Str_Bnd : aliased Std_String_Bound := Build_Bound (Str);
+      Str_Arg : aliased Std_String := (To_Std_String_Basep (Str_Str'Address),
+                                       To_Std_String_Boundp (Str_Bnd'Address));
+   begin
+      Grt.Lib.Textio_Write_Real
+        (Str_Arg'Unrestricted_Access, Len_Arg'Unrestricted_Access,
+         Val, Ndigits);
+      for I in 1 .. Len_Arg loop
+         Str.Val_Array.V (Iir_Index32 (I)).E8 :=
+           Character'Pos (Str_Str (Ghdl_Index_Type (I)));
+      end loop;
+      Len.I64 := Ghdl_I64 (Len_Arg);
+   end Textio_Write_Real;
+
+   function Textio_Read_Real (Str : Iir_Value_Literal_Acc) return Ghdl_F64
+   is
+      Str_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (Str.Bounds.D (1).Length);
+      Str_Str : aliased Std_String_Uncons (1 .. Str_Len);
+      Str_Bnd : aliased Std_String_Bound := Build_Bound (Str);
+      Str_Arg : aliased Std_String := (To_Std_String_Basep (Str_Str'Address),
+                                       To_Std_String_Boundp (Str_Bnd'Address));
+   begin
+      for I in Str.Val_Array.V'Range loop
+         Str_Str (Ghdl_Index_Type (I)) :=
+           Character'Val (Str.Val_Array.V (I).E8);
+      end loop;
+      return Grt.Lib.Textio_Read_Real (Str_Arg'Unrestricted_Access);
+   end Textio_Read_Real;
 end File_Operation;
diff --git a/src/vhdl/simulate/file_operation.ads b/src/vhdl/simulate/file_operation.ads
index b66a06756..ea59f60d6 100644
--- a/src/vhdl/simulate/file_operation.ads
+++ b/src/vhdl/simulate/file_operation.ads
@@ -20,6 +20,7 @@ with Iirs; use Iirs;
 with Iir_Values; use Iir_Values;
 with Elaboration; use Elaboration;
 with Grt.Files; use Grt.Files;
+with Grt.Types; use Grt.Types;
 
 package File_Operation is
    Null_File : constant Natural := 0;
@@ -77,5 +78,13 @@ package File_Operation is
 
    --  Test end of FILE is reached.
    function Endfile (File : Iir_Value_Literal_Acc; Stmt : Iir)
-     return Boolean;
+                    return Boolean;
+
+   --  Fp to string
+   procedure Textio_Write_Real (Str : Iir_Value_Literal_Acc;
+                                Len : Iir_Value_Literal_Acc;
+                                Val : Ghdl_F64;
+                                Ndigits : Std_Integer);
+
+   function Textio_Read_Real (Str : Iir_Value_Literal_Acc) return Ghdl_F64;
 end File_Operation;
diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb
index 26c5e9508..0b01a4c88 100644
--- a/src/vhdl/simulate/simulation.adb
+++ b/src/vhdl/simulate/simulation.adb
@@ -523,7 +523,8 @@ package body Simulation is
          Expr := Get_Timeout_Clause (Stmt);
          if Expr /= Null_Iir then
             Res := Execute_Expression (Instance, Expr);
-            Grt.Processes.Ghdl_Process_Wait_Set_Timeout (Std_Time (Res.I64));
+            Grt.Processes.Ghdl_Process_Wait_Set_Timeout
+              (Std_Time (Res.I64), null, 0);
          end if;
 
          -- LRM93 8.1