From fce765ab6818f6f967fba3fd4c411e7fecf8410d Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 12 May 2022 18:50:10 +0200 Subject: synth: implement file_open with status --- src/synth/elab-vhdl_files.adb | 65 ++++++++++++++++++++++++++++++++++++ src/synth/elab-vhdl_files.ads | 2 ++ src/synth/synth-vhdl_static_proc.adb | 2 ++ 3 files changed, 69 insertions(+) diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index fbcce7a64..e84c00d42 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -310,6 +310,71 @@ package body Elab.Vhdl_Files is end if; end Synth_File_Open; + -- Declaration + -- procedure FILE_OPEN (Status : out FILE_OPEN_STATUS; + -- file F : FT; + -- External_Name : String; + -- Open_Kind : File_Open_Kind); + procedure Synth_File_Open_Status + (Syn_Inst : Synth_Instance_Acc; Imp : Node) + is + Inters : constant Node := Get_Interface_Declaration_Chain (Imp); + Ostatus : constant Valtyp := Get_Value (Syn_Inst, Inters); + Param2 : constant Node := Get_Chain (Inters); + F : constant File_Index := Get_Value (Syn_Inst, Param2).Val.File; + Param3 : constant Node := Get_Chain (Param2); + File_Name : constant Valtyp := Get_Value (Syn_Inst, Param3); + Param4 : constant Node := Get_Chain (Param3); + Open_Kind : constant Valtyp := Get_Value (Syn_Inst, Param4); + C_Name : C_File_Name; + C_Name_Len : Natural; + File_Mode : Ghdl_I32; + Status : Op_Status; + Vstatus : Ghdl_I32; + begin + Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); + if Status = Op_Ok then + File_Mode := Ghdl_I32 (Read_Discrete (Open_Kind)); + if Get_Text_File_Flag (Get_Type (Param2)) then + Ghdl_Text_File_Open + (F, File_Mode, To_Ghdl_C_String (C_Name'Address), Status); + else + Ghdl_File_Open + (F, File_Mode, To_Ghdl_C_String (C_Name'Address), Status); + end if; + end if; + + case Status is + when Op_Ok => + Vstatus := Open_Ok; + when Op_Status_Error => + Vstatus := Status_Error; + when Op_Mode_Error => + Vstatus := Mode_Error; + when Op_Name_Error + | Op_Signature_Error + | Op_Filename_Error => + Vstatus := Name_Error; + when Op_End_Of_File + | Op_Ungetc_Error + | Op_Not_Open + | Op_Close_Error + | Op_Read_Write_File + | Op_Write_Read_File + | Op_Read_Error + | Op_Write_Error + | Op_Bad_Index + | Op_Bad_Mode + | Op_Not_Closed => + raise File_Execution_Error; + end case; + + if Is_Static (Ostatus.Val) then + -- Avoid error storm. + Write_Discrete (Ostatus, Int64 (Vstatus)); + end if; + end Synth_File_Open_Status; + -- Declaration -- procedure FILE_CLOSE (file F : FT); procedure Synth_File_Close diff --git a/src/synth/elab-vhdl_files.ads b/src/synth/elab-vhdl_files.ads index f974a63b0..959add1b0 100644 --- a/src/synth/elab-vhdl_files.ads +++ b/src/synth/elab-vhdl_files.ads @@ -36,6 +36,8 @@ package Elab.Vhdl_Files is procedure Synth_File_Open (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + procedure Synth_File_Open_Status + (Syn_Inst : Synth_Instance_Acc; Imp : Node); procedure Synth_File_Close (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); diff --git a/src/synth/synth-vhdl_static_proc.adb b/src/synth/synth-vhdl_static_proc.adb index 4fa2c619e..0764d35c1 100644 --- a/src/synth/synth-vhdl_static_proc.adb +++ b/src/synth/synth-vhdl_static_proc.adb @@ -50,6 +50,8 @@ package body Synth.Vhdl_Static_Proc is case Get_Implicit_Definition (Imp) is when Iir_Predefined_File_Open => Synth_File_Open (Syn_Inst, Imp, Loc); + when Iir_Predefined_File_Open_Status => + Synth_File_Open_Status (Syn_Inst, Imp); when Iir_Predefined_File_Close => Synth_File_Close (Syn_Inst, Imp, Loc); when Iir_Predefined_Foreign_Untruncated_Text_Read => -- cgit v1.2.3