From 46ae659235e7bf1f579143f2e3869a6c2d028e5e Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 15 May 2020 19:06:18 +0200 Subject: synth: handle non-text file (add signatures). --- src/synth/synth-decls.adb | 24 +++++++++++-- src/synth/synth-files_operations.adb | 65 ++++++++++++++++++++++++++++++++---- src/synth/synth-files_operations.ads | 3 ++ src/synth/synth-objtypes.adb | 3 +- src/synth/synth-objtypes.ads | 3 +- src/synth/synth-static_proc.adb | 2 ++ 6 files changed, 90 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 0e4674b01..df5385655 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -156,12 +156,32 @@ package body Synth.Decls is (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc is File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def)); - File_Typ : Type_Acc; - Typ : Type_Acc; + File_Typ : Type_Acc; + Typ : Type_Acc; + Sig : String_Acc; begin File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); + if Get_Text_File_Flag (Def) + or else + Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition + then + Sig := null; + else + declare + Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2); + Off : Natural := Sig_Str'First; + begin + Get_File_Signature (File_Type, Sig_Str, Off); + Sig_Str (Off + 0) := '.'; + Sig_Str (Off + 1) := ASCII.NUL; + Sig := new String'(Sig_Str); + end; + end if; + Typ := Create_File_Type (File_Typ); + Typ.File_Signature := Sig; + return Typ; end Synth_File_Type_Definition; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 98fa6a5b8..8970630e5 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -26,8 +26,6 @@ with Grt.Types; use Grt.Types; with Grt.Files_Operations; use Grt.Files_Operations; with Grt.Stdio; -with Vhdl.Annotations; - with Synth.Objtypes; use Synth.Objtypes; with Synth.Expr; use Synth.Expr; with Synth.Errors; use Synth.Errors; @@ -193,14 +191,14 @@ package body Synth.Files_Operations is F := Ghdl_Text_File_Elaborate; else declare - Sig : constant String_Acc := - Vhdl.Annotations.Get_Info (File_Type).File_Signature; + File_Typ : Type_Acc; Cstr : Ghdl_C_String; begin - if Sig = null then + File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); + if File_Typ.File_Signature = null then Cstr := null; else - Cstr := To_Ghdl_C_String (Sig.all'Address); + Cstr := To_Ghdl_C_String (File_Typ.File_Signature.all'Address); end if; F := Ghdl_File_Elaborate (Cstr); end; @@ -361,4 +359,59 @@ package body Synth.Files_Operations is Write_Discrete (Param_Len, Int64 (Len)); end Synth_Untruncated_Text_Read; + procedure File_Read_Value (File : File_Index; Val : Memtyp; Loc : Node) + is + Status : Op_Status; + begin + case Val.Typ.Kind is + when Type_Discrete + | Type_Bit + | Type_Logic + | Type_Float => + Ghdl_Read_Scalar (File, Ghdl_Ptr (Val.Mem.all'Address), + Ghdl_Index_Type (Val.Typ.Sz), Status); + if Status /= Op_Ok then + File_Error (Loc, Status); + end if; + when Type_Vector + | Type_Array => + declare + El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ); + Off : Size_Type; + begin + Off := 0; + for I in 1 .. Get_Array_Flat_Length (Val.Typ) loop + File_Read_Value (File, (El_Typ, Val.Mem + Off), Loc); + Off := Off + El_Typ.Sz; + end loop; + end; + when Type_Record => + for I in Val.Typ.Rec.E'Range loop + File_Read_Value + (File, + (Val.Typ.Rec.E (I).Typ, Val.Mem + Val.Typ.Rec.E (I).Moff), + Loc); + end loop; + when Type_Unbounded_Record + | Type_Unbounded_Array + | Type_Unbounded_Vector + | Type_Protected + | Type_Slice + | Type_File + | Type_Access => + raise Internal_Error; + end case; + end File_Read_Value; + + procedure Synth_File_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).Val.File; + Param2 : constant Node := Get_Chain (Inters); + Value : constant Valtyp := Get_Value (Syn_Inst, Param2); + begin + File_Read_Value (File, (Value.Typ, Value.Val.Mem), Loc); + end Synth_File_Read; + end Synth.Files_Operations; diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads index 0b5ae456d..8f8136f76 100644 --- a/src/synth/synth-files_operations.ads +++ b/src/synth/synth-files_operations.ads @@ -44,4 +44,7 @@ package Synth.Files_Operations is procedure Synth_Untruncated_Text_Read (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + + procedure Synth_File_Read + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); end Synth.Files_Operations; diff --git a/src/synth/synth-objtypes.adb b/src/synth/synth-objtypes.adb index 77c88ee8e..585605190 100644 --- a/src/synth/synth-objtypes.adb +++ b/src/synth/synth-objtypes.adb @@ -494,7 +494,8 @@ package body Synth.Objtypes is Al => 2, Sz => 4, W => 32, - File_Typ => File_Type))); + File_Typ => File_Type, + File_Signature => null))); end Create_File_Type; function Create_Protected_Type return Type_Acc diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads index c0c2a1409..2e74db6dc 100644 --- a/src/synth/synth-objtypes.ads +++ b/src/synth/synth-objtypes.ads @@ -154,7 +154,8 @@ package Synth.Objtypes is when Type_Access => Acc_Acc : Type_Acc; when Type_File => - File_Typ : Type_Acc; + File_Typ : Type_Acc; + File_Signature : String_Acc; when Type_Protected => null; end case; diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb index ab534aa66..b8b6a4566 100644 --- a/src/synth/synth-static_proc.adb +++ b/src/synth/synth-static_proc.adb @@ -53,6 +53,8 @@ package body Synth.Static_Proc is Synth_Untruncated_Text_Read (Syn_Inst, Imp, Loc); when Iir_Predefined_Deallocate => Synth_Deallocate (Syn_Inst, Imp); + when Iir_Predefined_Read => + Synth_File_Read (Syn_Inst, Imp, Loc); when others => Error_Msg_Synth (+Loc, "call to implicit %n is not supported", +Imp); -- cgit v1.2.3