1 files changed, 50 insertions, 1 deletions

diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb
index 8b71e7f63..9510dcd0f 100644
--- a/src/synth/elab-vhdl_files.adb
+++ b/src/synth/elab-vhdl_files.adb
@@ -21,6 +21,7 @@ with Files_Map;
 with Name_Table;
 
 with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
 
 with Grt.Types; use Grt.Types;
 with Grt.Vhdl_Types; use Grt.Vhdl_Types;
@@ -502,6 +503,40 @@ package body Elab.Vhdl_Files is
       File_Read_Value (File, (Value.Typ, Value.Val.Mem), Loc);
    end Synth_File_Read;
 
+   procedure Synth_File_Read_Length
+     (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node)
+   is
+      Param1 : constant Node := Get_Interface_Declaration_Chain (Imp);
+      File : constant File_Index := Get_Value (Syn_Inst, Param1).Val.File;
+      Param2 : constant Node := Get_Chain (Param1);
+      Value : constant Valtyp := Get_Value (Syn_Inst, Param2);
+      Param3 : constant Node := Get_Chain (Param2);
+      Length : constant Valtyp := Get_Value (Syn_Inst, Param3);
+
+      El_Typ : constant Type_Acc := Get_Array_Element (Value.Typ);
+      Len : Uns32;
+      Status : Op_Status;
+      Off    : Size_Type;
+   begin
+      Ghdl_Read_Scalar (File, Ghdl_Ptr (Len'Address), 4, Status);
+      if Status /= Op_Ok then
+         File_Error (Loc, Status);
+         return;
+      end if;
+      Off := 0;
+      for I in 1 .. Len loop
+         if I <= Value.Typ.Abound.Len then
+            File_Read_Value (File, (El_Typ, Value.Val.Mem + Off), Loc);
+            Off := Off + El_Typ.Sz;
+         else
+            --  FIXME: for empty arrays ??
+            --  Lose_Binary (File, Value.Val_Array (0));
+            raise Internal_Error;
+         end if;
+      end loop;
+      Write_Discrete (Length, Int64 (Len));
+   end Synth_File_Read_Length;
+
    procedure File_Write_Value (File : File_Index; Val : Memtyp; Loc : Node)
    is
       Status : Op_Status;
@@ -580,14 +615,28 @@ package body Elab.Vhdl_Files is
      (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node)
    is
       Inters : constant Node := Get_Interface_Declaration_Chain (Imp);
-      Is_Text : constant Boolean := Get_Text_File_Flag (Get_Type (Inters));
+      File_Type : constant Node := Get_Type (Inters);
+      Is_Text : constant Boolean := Get_Text_File_Flag (File_Type);
       File : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File;
       Param2 : constant Node := Get_Chain (Inters);
       Value : constant Valtyp := Get_Value (Syn_Inst, Param2);
+      Type_Mark : Node;
+      Len : Uns32;
+      Status : Op_Status;
    begin
       if Is_Text then
          File_Write_Text (File, (Value.Typ, Value.Val.Mem), Loc);
       else
+         Type_Mark := Get_Type (Get_File_Type_Mark (File_Type));
+         if not Is_Fully_Constrained_Type (Type_Mark) then
+            pragma Assert (Value.Typ.Kind = Type_Array
+                             or Value.Typ.Kind = Type_Vector);
+            Len := Value.Typ.Abound.Len;
+            Ghdl_Write_Scalar (File, Ghdl_Ptr (Len'Address), 4, Status);
+            if Status /= Op_Ok then
+               File_Error (Loc, Status);
+            end if;
+         end if;
          File_Write_Value (File, (Value.Typ, Value.Val.Mem), Loc);
       end if;
    end Synth_File_Write;