diff options
| -rw-r--r-- | src/grt/grt-files_operations.adb | 8 | ||||
| -rw-r--r-- | src/grt/grt-files_operations.ads | 16 | ||||
| -rw-r--r-- | src/synth/synth-files_operations.adb | 91 | ||||
| -rw-r--r-- | src/synth/synth-files_operations.ads | 4 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 5 |
5 files changed, 122 insertions, 2 deletions
diff --git a/src/grt/grt-files_operations.adb b/src/grt/grt-files_operations.adb index b1f504dc9..a98579bb7 100644 --- a/src/grt/grt-files_operations.adb +++ b/src/grt/grt-files_operations.adb @@ -249,6 +249,12 @@ package body Grt.Files_Operations is return; end Ghdl_File_Endfile; + function Simple_Open (Name : Ghdl_C_String; Mode : Ghdl_C_String) + return C_Files is + begin + return fopen (To_Address (Name), To_Address (Mode)); + end Simple_Open; + Sig_Header : constant String := "#GHDL-BINARY-FILE-0.0" & Nl; Std_Output_Name : constant String := "STD_OUTPUT" & NUL; @@ -309,7 +315,7 @@ package body Grt.Files_Operations is Str_Mode (2) := 'b'; Str_Mode (3) := NUL; end if; - F := fopen (To_Address (Name), Str_Mode'Address); + F := Open_Handler (Name, To_Ghdl_C_String (Str_Mode'Address)); if F = NULL_Stream then Status := Op_Name_Error; return; diff --git a/src/grt/grt-files_operations.ads b/src/grt/grt-files_operations.ads index 176d4f06c..4dfee186f 100644 --- a/src/grt/grt-files_operations.ads +++ b/src/grt/grt-files_operations.ads @@ -22,9 +22,12 @@ -- covered by the GNU General Public License. This exception does not -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. -with Grt.Types; use Grt.Types; + with Interfaces; +with Grt.Types; use Grt.Types; +with Grt.Stdio; + package Grt.Files_Operations is type Ghdl_File_Index is new Interfaces.Integer_32; @@ -143,4 +146,15 @@ package Grt.Files_Operations is Status : out Op_Status); procedure Ghdl_File_Flush (File : Ghdl_File_Index; Status : out Op_Status); + + type Open_Handler_Acc is access function + (Name : Ghdl_C_String; Mode : Ghdl_C_String) return Grt.Stdio.FILEs; + + -- Like fopen(3) + function Simple_Open (Name : Ghdl_C_String; Mode : Ghdl_C_String) + return Grt.Stdio.FILEs; + + -- Function called to open a file. This hook can be used to search a file + -- on a path. + Open_Handler : Open_Handler_Acc := Simple_Open'Access; end Grt.Files_Operations; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 324c7caa8..98fa6a5b8 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -19,9 +19,12 @@ -- MA 02110-1301, USA. with Types; use Types; +with Files_Map; +with Name_Table; with Grt.Types; use Grt.Types; with Grt.Files_Operations; use Grt.Files_Operations; +with Grt.Stdio; with Vhdl.Annotations; @@ -31,6 +34,11 @@ with Synth.Errors; use Synth.Errors; package body Synth.Files_Operations is + -- Variables to store the search path. + Current_Unit : Node := Null_Node; + Current_Pfx_Len : Integer := -1; + Current_Pfx_Id : Name_Id := No_Name_Id; + -- Representation of file name compatible with C (so NUL terminated). subtype C_File_Name is String (1 .. 1025); @@ -84,6 +92,84 @@ package body Synth.Files_Operations is Status := Op_Ok; end Convert_File_Name; + procedure Set_Design_Unit (Unit : Node) is + begin + Current_Unit := Unit; + Current_Pfx_Id := No_Name_Id; + end Set_Design_Unit; + + function Synth_Open (Name : Ghdl_C_String; Mode : Ghdl_C_String) + return Grt.Stdio.FILEs + is + use Grt.Stdio; + Res : FILEs; + begin + -- Try to open the file using the name given. + Res := fopen (To_Address (Name), To_Address (Mode)); + if Res /= NULL_Stream then + -- File found. + return Res; + end if; + + -- Return now if the search path is not used: + -- mode is not read, or + -- no search path given. + if Mode (1) /= 'r' then + return Res; + end if; + if Current_Unit = Null_Node then + return NULL_Stream; + end if; + + -- The search path is given by the current unit. Extract it from the + -- filename (and cache the result). + if Current_Pfx_Id = No_Name_Id then + declare + use Files_Map; + use Name_Table; + + Loc : Location_Type; + Sfe : Source_File_Entry; + Name_Len : Natural; + Name_Ptr : Thin_String_Ptr; + begin + Loc := Get_Location (Current_Unit); + Sfe := Location_To_File (Loc); + Current_Pfx_Id := Get_File_Name (Sfe); + Name_Len := Get_Name_Length (Current_Pfx_Id); + Name_Ptr := Get_Name_Ptr (Current_Pfx_Id); + Current_Pfx_Len := 0; + for I in reverse 1 .. Name_Len loop + if Name_Ptr (I) = '/' or else Name_Ptr (I) = '\' then + Current_Pfx_Len := I; + exit; + end if; + end loop; + end; + end if; + + -- No prefix. + if Current_Pfx_Len = 0 then + return NULL_Stream; + end if; + + -- Try with prefix + name. + declare + use Name_Table; + Name_Len : constant Natural := strlen (Name); + Pfx : constant Thin_String_Ptr := Get_Name_Ptr (Current_Pfx_Id); + Name2 : String (1 .. Name_Len + Current_Pfx_Len + 1); + begin + Name2 (1 .. Current_Pfx_Len) := Pfx (1 .. Current_Pfx_Len); + Name2 (Current_Pfx_Len + 1 .. Current_Pfx_Len + Name_Len) := + Name (1 .. Name_Len); + Name2 (Name2'Last) := NUL; + Res := fopen (Name2'Address, To_Address (Mode)); + end; + + return Res; + end Synth_Open; + function Elaborate_File_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index is @@ -98,6 +184,11 @@ package body Synth.Files_Operations is File_Mode : Ghdl_I32; Status : Op_Status; begin + -- Use our own handler to open a file. + -- We need to do this assignment only once, but it is simpler to do it + -- here. + Open_Handler := Synth_Open'Access; + if Get_Text_File_Flag (File_Type) then F := Ghdl_Text_File_Elaborate; else diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads index 69be99ff9..0b5ae456d 100644 --- a/src/synth/synth-files_operations.ads +++ b/src/synth/synth-files_operations.ads @@ -28,6 +28,10 @@ package Synth.Files_Operations is -- Raised in case of un-recoverable error. File_Execution_Error : exception; + -- Set the current design unit, so that its path can be used to search + -- files. + procedure Set_Design_Unit (Unit : Node); + function Elaborate_File_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index f022ac71d..2013d4939 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -52,6 +52,7 @@ with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; with Synth.Source; use Synth.Source; with Synth.Debugger; +with Synth.Files_Operations; package body Synth.Insts is Root_Instance : Synth_Instance_Acc; @@ -1464,6 +1465,10 @@ package body Synth.Insts is return; end if; + -- Save the current architecture, so that files can be open using a + -- path relative to the architecture filename. + Synth.Files_Operations.Set_Design_Unit (Arch); + Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); Set_Instance_Module (Syn_Inst, Inst.M); |