synth: handle untruncated_text_read.

7 files changed, 189 insertions, 74 deletions

diff --git a/src/grt/grt-files_operations.adb b/src/grt/grt-files_operations.adb
index ed15f7fa0..c7770b5f3 100644
--- a/src/grt/grt-files_operations.adb
+++ b/src/grt/grt-files_operations.adb
@@ -528,14 +528,14 @@ package body Grt.Files_Operations is
       Status := Op_Ok;
    end Ghdl_Text_Read_Length;
 
-   procedure Ghdl_Untruncated_Text_Read
-     (File : Ghdl_File_Index; Str : Std_String_Ptr; Len : out Std_Integer;
-                                                    Status : out Op_Status)
+   procedure Ghdl_Untruncated_Text_Read (File : Ghdl_File_Index;
+                                         Buf : Ghdl_C_String;
+                                         Len : in out Std_Integer;
+                                         Status : out Op_Status)
    is
       Stream : C_Files;
       Max_Len : int;
    begin
-      Len := 0;
       Get_File (File, Stream, Status);
       if Status /= Op_Ok then
          return;
@@ -545,19 +545,14 @@ package body Grt.Files_Operations is
          return;
       end if;
 
-      Max_Len := int (Str.Bounds.Dim_1.Length);
-      if fgets (Str.Base (0)'Address, Max_Len, Stream) = Null_Address then
+      Max_Len := int (Len);
+      if fgets (To_Address (Buf), Max_Len, Stream) = Null_Address then
          Status := Op_End_Of_File;
          return;
       end if;
 
       --  Compute the length.
-      for I in Ghdl_Index_Type loop
-         if Str.Base (I) = NUL then
-            Len := Std_Integer (I);
-            exit;
-         end if;
-      end loop;
+      Len := Std_Integer (strlen (Buf));
       Status := Op_Ok;
    end Ghdl_Untruncated_Text_Read;
 
diff --git a/src/grt/grt-files_operations.ads b/src/grt/grt-files_operations.ads
index c6ee8751d..176d4f06c 100644
--- a/src/grt/grt-files_operations.ads
+++ b/src/grt/grt-files_operations.ads
@@ -133,8 +133,8 @@ package Grt.Files_Operations is
                                     Length : out Std_Integer);
 
    procedure Ghdl_Untruncated_Text_Read (File : Ghdl_File_Index;
-                                         Str : Std_String_Ptr;
-                                         Len : out Std_Integer;
+                                         Buf : Ghdl_C_String;
+                                         Len : in out Std_Integer;
                                          Status : out Op_Status);
 
    procedure Ghdl_Text_File_Close (File : Ghdl_File_Index;
diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb
index 5be4de041..782908913 100644
--- a/src/synth/synth-files_operations.adb
+++ b/src/synth/synth-files_operations.adb
@@ -20,7 +20,7 @@
 
 with Types; use Types;
 
-with Grt.Types;
+with Grt.Types; use Grt.Types;
 with Grt.Files_Operations; use Grt.Files_Operations;
 
 with Vhdl.Annotations;
@@ -82,7 +82,6 @@ package body Synth.Files_Operations is
    function Elaborate_File_Declaration
      (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index
    is
-      use Grt.Types;
       File_Type : constant Node := Get_Type (Decl);
       External_Name : constant Node := Get_File_Logical_Name (Decl);
       Open_Kind : constant Node := Get_File_Open_Kind (Decl);
@@ -173,4 +172,36 @@ package body Synth.Files_Operations is
          File_Error (Loc, Status);
       end if;
    end Endfile;
+
+   --  Declaration:
+   --  procedure untruncated_text_read                              --!V87
+   --    (file f : text; str : out string; len : out natural);      --!V87
+   procedure Synth_Untruncated_Text_Read (Syn_Inst : Synth_Instance_Acc;
+                                          Imp : Node;
+                                          Loc : Node)
+   is
+      Inters : constant Node := Get_Interface_Declaration_Chain (Imp);
+      File : constant File_Index := Get_Value (Syn_Inst, Inters).File;
+      Param2 : constant Node := Get_Chain (Inters);
+      Str : constant Value_Acc := Get_Value (Syn_Inst, Param2);
+      Param3 : constant Node := Get_Chain (Param2);
+      Param_Len : constant Value_Acc := Get_Value (Syn_Inst, Param3);
+      Buf : String (1 .. Natural (Str.Arr.Len));
+      Len : Std_Integer;
+      Status : Op_Status;
+   begin
+      Len := Std_Integer (Buf'Last);
+      Ghdl_Untruncated_Text_Read
+        (File, To_Ghdl_C_String (Buf'Address), Len, Status);
+      if Status /= Op_Ok then
+         File_Error (Loc, Status);
+      end if;
+
+      for I in 1 .. Natural (Len) loop
+         Str.Arr.V (Iir_Index32 (I)).Scal := Character'Pos (Buf (I));
+      end loop;
+
+      Param_Len.Scal := Int64 (Len);
+   end Synth_Untruncated_Text_Read;
+
 end Synth.Files_Operations;
diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads
index 13852906e..a683e5022 100644
--- a/src/synth/synth-files_operations.ads
+++ b/src/synth/synth-files_operations.ads
@@ -32,4 +32,8 @@ package Synth.Files_Operations is
      (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index;
 
    function Endfile (F : File_Index; Loc : Syn_Src) return Boolean;
+
+   procedure Synth_Untruncated_Text_Read (Syn_Inst : Synth_Instance_Acc;
+                                          Imp : Node;
+                                          Loc : Node);
 end Synth.Files_Operations;
diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb
new file mode 100644
index 000000000..2eb71c09c
--- /dev/null
+++ b/src/synth/synth-static_proc.adb
@@ -0,0 +1,40 @@
+--  Predefined procedures
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Vhdl.Errors; use Vhdl.Errors;
+
+with Synth.Errors; use Synth.Errors;
+with Synth.Files_Operations; use Synth.Files_Operations;
+
+package body Synth.Static_Proc is
+
+   procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc;
+                                     Imp : Node;
+                                     Loc : Node) is
+   begin
+      case Get_Implicit_Definition (Imp) is
+         when Iir_Predefined_Foreign_Untruncated_Text_Read =>
+            Synth_Untruncated_Text_Read (Syn_Inst, Imp, Loc);
+         when others =>
+            Error_Msg_Synth
+              (+Loc, "call to implicit %n is not supported", +Imp);
+      end case;
+   end Synth_Static_Procedure;
+end Synth.Static_Proc;
diff --git a/src/synth/synth-static_proc.ads b/src/synth/synth-static_proc.ads
new file mode 100644
index 000000000..fa35bb264
--- /dev/null
+++ b/src/synth/synth-static_proc.ads
@@ -0,0 +1,28 @@
+--  Predefined procedures
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Synth.Context; use Synth.Context;
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+package Synth.Static_Proc is
+   procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc;
+                                     Imp : Node;
+                                     Loc : Node);
+end Synth.Static_Proc;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 372805d42..7c77a57ee 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -43,6 +43,7 @@ with Synth.Decls; use Synth.Decls;
 with Synth.Expr; use Synth.Expr;
 with Synth.Insts; use Synth.Insts;
 with Synth.Source;
+with Synth.Static_Proc;
 
 with Netlists.Builders; use Netlists.Builders;
 with Netlists.Gates;
@@ -143,6 +144,7 @@ package body Synth.Stmts is
            | Iir_Kind_Interface_Constant_Declaration
            | Iir_Kind_Constant_Declaration
            | Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration
            | Iir_Kind_Object_Alias_Declaration =>
             declare
                Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx);
@@ -1441,12 +1443,13 @@ package body Synth.Stmts is
       end if;
    end Synth_Label;
 
-   procedure Count_Associations
-     (Inter_Chain : Node; Assoc_Chain : Node; Nbr_Inout : out Natural)
+   function Count_Associations (Inter_Chain : Node; Assoc_Chain : Node)
+                               return Natural
    is
       Assoc : Node;
       Assoc_Inter : Node;
       Inter : Node;
+      Nbr_Inout : Natural;
    begin
       Nbr_Inout := 0;
 
@@ -1464,6 +1467,8 @@ package body Synth.Stmts is
 
          Next_Association_Interface (Assoc, Assoc_Inter);
       end loop;
+
+      return Nbr_Inout;
    end Count_Associations;
 
    function Synth_Subprogram_Call
@@ -1474,12 +1479,14 @@ package body Synth.Stmts is
       Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
       Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
       Bod : constant Node := Get_Subprogram_Body (Imp);
+      Nbr_Inout : constant Natural :=
+        Count_Associations (Inter_Chain, Assoc_Chain);
+      Infos : Target_Info_Array (1 .. Nbr_Inout);
       Area_Mark : Areapools.Mark_Type;
       Res : Value_Acc;
       C : Seq_Context;
       Wire_Mark : Wire_Id;
       Subprg_Phi : Phi_Type;
-      Nbr_Inout : Natural;
    begin
       Mark (Wire_Mark);
       Areapools.Mark (Area_Mark, Instance_Pool.all);
@@ -1498,72 +1505,64 @@ package body Synth.Stmts is
          C.W_Val := Alloc_Wire (Wire_Variable, Imp);
       end if;
 
-      Count_Associations (Inter_Chain, Assoc_Chain, Nbr_Inout);
-
-      declare
-         Infos : Target_Info_Array (1 .. Nbr_Inout);
-      begin
-         Synth_Subprogram_Association
-           (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+      Synth_Subprogram_Association
+        (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
 
-         if not Is_Func then
-            if Get_Purity_State (Imp) /= Pure then
-               Set_Instance_Const (C.Inst, False);
-            end if;
+      if not Is_Func then
+         if Get_Purity_State (Imp) /= Pure then
+            Set_Instance_Const (C.Inst, False);
          end if;
+      end if;
 
-         Push_Phi;
+      Push_Phi;
 
-         if Is_Func then
-            --  Set a default value for the return.
-            C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
-            Set_Wire_Gate (C.W_Val,
-                           Build_Signal (Build_Context,
-                                         New_Internal_Name (Build_Context),
-                                         C.Ret_Typ.W));
-            C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W);
-            Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0);
-         end if;
+      if Is_Func then
+         --  Set a default value for the return.
+         C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
+         Set_Wire_Gate (C.W_Val,
+                        Build_Signal (Build_Context,
+                                      New_Internal_Name (Build_Context),
+                                      C.Ret_Typ.W));
+         C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W);
+         Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0);
+      end if;
 
-         Set_Wire_Gate
-           (C.W_En, Build_Signal (Build_Context,
-                                  New_Internal_Name (Build_Context), 1));
-         Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);
+      Set_Wire_Gate
+        (C.W_En, Build_Signal (Build_Context,
+                               New_Internal_Name (Build_Context), 1));
+      Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);
 
-         Set_Wire_Gate
-           (C.W_Ret, Build_Signal (Build_Context,
-                                   New_Internal_Name (Build_Context), 1));
-         Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0);
+      Set_Wire_Gate
+        (C.W_Ret, Build_Signal (Build_Context,
+                                New_Internal_Name (Build_Context), 1));
+      Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0);
 
-         Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
+      Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
 
-         Synth_Sequential_Statements
-           (C, Get_Sequential_Statement_Chain (Bod));
+      Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
 
-         if Is_Func then
-            if C.Nbr_Ret = 0 then
-               raise Internal_Error;
-            elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
-               Res := C.Ret_Value;
-            else
-               Res := Create_Value_Net
-                 (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ);
-            end if;
+      if Is_Func then
+         if C.Nbr_Ret = 0 then
+            raise Internal_Error;
+         elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
+            Res := C.Ret_Value;
          else
-            Res := null;
-            Synth_Subprogram_Back_Association
-              (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+            Res := Create_Value_Net
+              (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ);
          end if;
+      else
+         Res := null;
+         Synth_Subprogram_Back_Association
+           (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+      end if;
 
-         Pop_Phi (Subprg_Phi);
+      Pop_Phi (Subprg_Phi);
 
-         Decls.Finalize_Declarations
-           (C.Inst, Get_Declaration_Chain (Bod), True);
-         pragma Unreferenced (Infos);
+      Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
+      pragma Unreferenced (Infos);
 
-         --  Propagate assignments.
-         Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark);
-      end;
+      --  Propagate assignments.
+      Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark);
 
       --  Free wires.
       Free_Wire (C.W_En);
@@ -1583,11 +1582,29 @@ package body Synth.Stmts is
    procedure Synth_Implicit_Procedure_Call
      (Syn_Inst : Synth_Instance_Acc; Call : Node)
    is
-      pragma Unreferenced (Syn_Inst);
       Imp  : constant Node := Get_Implementation (Call);
+      Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
+      Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
+      Nbr_Inout : constant Natural :=
+        Count_Associations (Inter_Chain, Assoc_Chain);
+      Infos : Target_Info_Array (1 .. Nbr_Inout);
+      Area_Mark : Areapools.Mark_Type;
+      Sub_Inst : Synth_Instance_Acc;
    begin
-      Error_Msg_Synth
-        (+Call, "call to implicit %n is not supported", +Imp);
+      Areapools.Mark (Area_Mark, Instance_Pool.all);
+      Sub_Inst := Make_Instance (Syn_Inst, Imp,
+                                 New_Internal_Name (Build_Context));
+
+      Synth_Subprogram_Association
+        (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+
+      Synth.Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call);
+
+      Synth_Subprogram_Back_Association
+        (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
+
+      Free_Instance (Sub_Inst);
+      Areapools.Release (Area_Mark, Instance_Pool.all);
    end Synth_Implicit_Procedure_Call;
 
    procedure Synth_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Stmt : Node)