From 2cd953d9b01cd9faf94bc66a466cb640485946f8 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 16 Apr 2021 06:50:16 +0200 Subject: synth: refactoring (synth.files_operations -> synth.vhdl_files) --- src/synth/synth-decls.adb | 4 +- src/synth/synth-files_operations.adb | 415 ----------------------------------- src/synth/synth-files_operations.ads | 48 ---- src/synth/synth-insts.adb | 4 +- src/synth/synth-static_oper.adb | 4 +- src/synth/synth-static_proc.adb | 2 +- src/synth/synth-vhdl_files.adb | 415 +++++++++++++++++++++++++++++++++++ src/synth/synth-vhdl_files.ads | 48 ++++ 8 files changed, 470 insertions(+), 470 deletions(-) delete mode 100644 src/synth/synth-files_operations.adb delete mode 100644 src/synth/synth-files_operations.ads create mode 100644 src/synth/synth-vhdl_files.adb create mode 100644 src/synth/synth-vhdl_files.ads (limited to 'src/synth') diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index b9207e0a6..938860b0e 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -35,7 +35,7 @@ with Synth.Expr; use Synth.Expr; with Synth.Stmts; with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; -with Synth.Files_Operations; +with Synth.Vhdl_Files; with Synth.Values; use Synth.Values; package body Synth.Decls is @@ -1044,7 +1044,7 @@ package body Synth.Decls is Res : Valtyp; Obj_Typ : Type_Acc; begin - F := Synth.Files_Operations.Elaborate_File_Declaration + F := Synth.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl); Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); Res := Create_Value_File (Obj_Typ, F); diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb deleted file mode 100644 index 40c163976..000000000 --- a/src/synth/synth-files_operations.adb +++ /dev/null @@ -1,415 +0,0 @@ --- Create declarations for synthesis. --- Copyright (C) 2017 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, see . - -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 Synth.Objtypes; use Synth.Objtypes; -with Synth.Expr; use Synth.Expr; -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); - - procedure File_Error (Loc : Node; Status : Op_Status); - pragma No_Return (File_Error); - - procedure File_Error (Loc : Node; Status : Op_Status) is - begin - pragma Assert (Status /= Op_Ok); - Error_Msg_Synth (+Loc, "file operation failed"); - raise File_Execution_Error; - end File_Error; - - -- VAL represents a string, so an array of characters. - procedure Convert_String (Val : Valtyp; Res : out String) - is - Vtyp : constant Type_Acc := Val.Typ; - Vlen : constant Uns32 := Vtyp.Abounds.D (1).Len; - begin - pragma Assert (Vtyp.Kind = Type_Array); - pragma Assert (Vtyp.Arr_El.Kind = Type_Discrete); - pragma Assert (Vtyp.Arr_El.W in 7 .. 8); -- Could be 7 in vhdl87 - pragma Assert (Vtyp.Abounds.Ndim = 1); - pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); - - for I in 1 .. Vlen loop - Res (Res'First + Natural (I - 1)) := - Character'Val (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); - end loop; - end Convert_String; - - -- Convert filename VAL to RES + LEN. - procedure Convert_File_Name (Val : Valtyp; - Res : out C_File_Name; - Len : out Natural; - Status : out Op_Status) - is - Name : constant Valtyp := Strip_Alias_Const (Val); - pragma Unreferenced (Val); - begin - Len := Natural (Name.Typ.Abounds.D (1).Len); - - if Len >= Res'Length - 1 then - Status := Op_Filename_Error; - return; - end if; - - Convert_String (Name, Res (1 .. Len)); - Res (Len + 1) := Grt.Types.NUL; - - 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 - 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); - File_Name : Valtyp; - C_Name : C_File_Name; - C_Name_Len : Natural; - Mode : Valtyp; - F : File_Index; - 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 - declare - File_Typ : Type_Acc; - Cstr : Ghdl_C_String; - begin - File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); - if File_Typ.File_Signature = null then - Cstr := null; - else - Cstr := To_Ghdl_C_String (File_Typ.File_Signature.all'Address); - end if; - F := Ghdl_File_Elaborate (Cstr); - end; - end if; - - -- LRM93 4.3.1.4 - -- If file open information is not included in a given file declaration, - -- then the file declared by the declaration is not opened when the file - -- declaration is elaborated. - if External_Name = Null_Node then - return F; - end if; - - File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name); - - if Open_Kind /= Null_Node then - Mode := Synth_Expression (Syn_Inst, Open_Kind); - File_Mode := Ghdl_I32 (Read_Discrete (Mode)); - else - case Get_Mode (Decl) is - when Iir_In_Mode => - File_Mode := Read_Mode; - when Iir_Out_Mode => - File_Mode := Write_Mode; - when others => - raise Internal_Error; - end case; - end if; - - Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); - if Status = Op_Ok then - if Get_Text_File_Flag (File_Type) 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; - - if Status /= Op_Ok then - if Status = Op_Name_Error then - Error_Msg_Synth - (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len)); - Set_Error (Syn_Inst); - else - File_Error (Decl, Status); - end if; - end if; - - return F; - end Elaborate_File_Declaration; - - function Endfile (F : File_Index; Loc : Syn_Src) return Boolean - is - Status : Op_Status; - begin - Ghdl_File_Endfile (F, Status); - - if Status = Op_Ok then - return False; - elsif Status = Op_End_Of_File then - return True; - else - File_Error (Loc, Status); - end if; - end Endfile; - - -- Declaration - -- procedure FILE_OPEN (file F : FT; - -- External_Name : String; - -- Open_Kind : File_Open_Kind); - procedure Synth_File_Open - (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) - is - Inters : constant Node := Get_Interface_Declaration_Chain (Imp); - F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; - Param2 : constant Node := Get_Chain (Inters); - File_Name : constant Valtyp := Get_Value (Syn_Inst, Param2); - Param3 : constant Node := Get_Chain (Param2); - Open_Kind : constant Valtyp := Get_Value (Syn_Inst, Param3); - C_Name : C_File_Name; - C_Name_Len : Natural; - File_Mode : Ghdl_I32; - Status : Op_Status; - 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 (Inters)) 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; - - if Status /= Op_Ok then - if Status = Op_Name_Error then - Error_Msg_Synth - (+Loc, "cannot open file: " & C_Name (1 .. C_Name_Len)); - raise File_Execution_Error; - else - File_Error (Loc, Status); - end if; - end if; - end Synth_File_Open; - - -- Declaration - -- procedure FILE_CLOSE (file F : FT); - procedure Synth_File_Close - (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) - is - Inters : constant Node := Get_Interface_Declaration_Chain (Imp); - F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; - Status : Op_Status; - begin - if Get_Text_File_Flag (Get_Type (Inters)) then - Ghdl_Text_File_Close (F, Status); - else - Ghdl_File_Close (F, Status); - end if; - - if Status /= Op_Ok then - File_Error (Loc, Status); - end if; - end Synth_File_Close; - - -- 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).Val.File; - Param2 : constant Node := Get_Chain (Inters); - Str : constant Valtyp := Get_Value (Syn_Inst, Param2); - Param3 : constant Node := Get_Chain (Param2); - Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); - Buf : String (1 .. Natural (Str.Typ.Abounds.D (1).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 - Write_U8 (Str.Val.Mem + Size_Type (I - 1), Character'Pos (Buf (I))); - end loop; - - 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 deleted file mode 100644 index 8d95a7cec..000000000 --- a/src/synth/synth-files_operations.ads +++ /dev/null @@ -1,48 +0,0 @@ --- Create declarations for synthesis. --- Copyright (C) 2017 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, see . - -with Vhdl.Nodes; use Vhdl.Nodes; - -with Synth.Source; use Synth.Source; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; - -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; - - function Endfile (F : File_Index; Loc : Syn_Src) return Boolean; - - procedure Synth_File_Open - (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); - procedure Synth_File_Close - (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); - - 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-insts.adb b/src/synth/synth-insts.adb index 250fbcf61..adb7332a6 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -50,7 +50,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; +with Synth.Vhdl_Files; with Synth.Errors; package body Synth.Insts is @@ -1647,7 +1647,7 @@ package body Synth.Insts is -- 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.Vhdl_Files.Set_Design_Unit (Arch); Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index dca886777..80ec64b76 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -32,7 +32,7 @@ with Synth.Expr; use Synth.Expr; with Synth.Vhdl_Oper; with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; with Synth.Ieee.Numeric_Std; use Synth.Ieee.Numeric_Std; -with Synth.Files_Operations; +with Synth.Vhdl_Files; with Synth.Values; use Synth.Values; package body Synth.Static_Oper is @@ -847,7 +847,7 @@ package body Synth.Static_Oper is declare Res : Boolean; begin - Res := Synth.Files_Operations.Endfile (Param1.Val.File, Expr); + Res := Synth.Vhdl_Files.Endfile (Param1.Val.File, Expr); return Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type); end; diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb index 44595b6a4..5dfe354cc 100644 --- a/src/synth/synth-static_proc.adb +++ b/src/synth/synth-static_proc.adb @@ -20,7 +20,7 @@ with Vhdl.Errors; use Vhdl.Errors; with Synth.Values; use Synth.Values; with Synth.Errors; use Synth.Errors; -with Synth.Files_Operations; use Synth.Files_Operations; +with Synth.Vhdl_Files; use Synth.Vhdl_Files; with Synth.Heap; package body Synth.Static_Proc is diff --git a/src/synth/synth-vhdl_files.adb b/src/synth/synth-vhdl_files.adb new file mode 100644 index 000000000..e9015afaf --- /dev/null +++ b/src/synth/synth-vhdl_files.adb @@ -0,0 +1,415 @@ +-- Create declarations for synthesis. +-- Copyright (C) 2017 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, see . + +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 Synth.Objtypes; use Synth.Objtypes; +with Synth.Expr; use Synth.Expr; +with Synth.Errors; use Synth.Errors; + +package body Synth.Vhdl_Files 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); + + procedure File_Error (Loc : Node; Status : Op_Status); + pragma No_Return (File_Error); + + procedure File_Error (Loc : Node; Status : Op_Status) is + begin + pragma Assert (Status /= Op_Ok); + Error_Msg_Synth (+Loc, "file operation failed"); + raise File_Execution_Error; + end File_Error; + + -- VAL represents a string, so an array of characters. + procedure Convert_String (Val : Valtyp; Res : out String) + is + Vtyp : constant Type_Acc := Val.Typ; + Vlen : constant Uns32 := Vtyp.Abounds.D (1).Len; + begin + pragma Assert (Vtyp.Kind = Type_Array); + pragma Assert (Vtyp.Arr_El.Kind = Type_Discrete); + pragma Assert (Vtyp.Arr_El.W in 7 .. 8); -- Could be 7 in vhdl87 + pragma Assert (Vtyp.Abounds.Ndim = 1); + pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); + + for I in 1 .. Vlen loop + Res (Res'First + Natural (I - 1)) := + Character'Val (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); + end loop; + end Convert_String; + + -- Convert filename VAL to RES + LEN. + procedure Convert_File_Name (Val : Valtyp; + Res : out C_File_Name; + Len : out Natural; + Status : out Op_Status) + is + Name : constant Valtyp := Strip_Alias_Const (Val); + pragma Unreferenced (Val); + begin + Len := Natural (Name.Typ.Abounds.D (1).Len); + + if Len >= Res'Length - 1 then + Status := Op_Filename_Error; + return; + end if; + + Convert_String (Name, Res (1 .. Len)); + Res (Len + 1) := Grt.Types.NUL; + + 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 + 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); + File_Name : Valtyp; + C_Name : C_File_Name; + C_Name_Len : Natural; + Mode : Valtyp; + F : File_Index; + 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 + declare + File_Typ : Type_Acc; + Cstr : Ghdl_C_String; + begin + File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); + if File_Typ.File_Signature = null then + Cstr := null; + else + Cstr := To_Ghdl_C_String (File_Typ.File_Signature.all'Address); + end if; + F := Ghdl_File_Elaborate (Cstr); + end; + end if; + + -- LRM93 4.3.1.4 + -- If file open information is not included in a given file declaration, + -- then the file declared by the declaration is not opened when the file + -- declaration is elaborated. + if External_Name = Null_Node then + return F; + end if; + + File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name); + + if Open_Kind /= Null_Node then + Mode := Synth_Expression (Syn_Inst, Open_Kind); + File_Mode := Ghdl_I32 (Read_Discrete (Mode)); + else + case Get_Mode (Decl) is + when Iir_In_Mode => + File_Mode := Read_Mode; + when Iir_Out_Mode => + File_Mode := Write_Mode; + when others => + raise Internal_Error; + end case; + end if; + + Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); + if Status = Op_Ok then + if Get_Text_File_Flag (File_Type) 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; + + if Status /= Op_Ok then + if Status = Op_Name_Error then + Error_Msg_Synth + (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len)); + Set_Error (Syn_Inst); + else + File_Error (Decl, Status); + end if; + end if; + + return F; + end Elaborate_File_Declaration; + + function Endfile (F : File_Index; Loc : Syn_Src) return Boolean + is + Status : Op_Status; + begin + Ghdl_File_Endfile (F, Status); + + if Status = Op_Ok then + return False; + elsif Status = Op_End_Of_File then + return True; + else + File_Error (Loc, Status); + end if; + end Endfile; + + -- Declaration + -- procedure FILE_OPEN (file F : FT; + -- External_Name : String; + -- Open_Kind : File_Open_Kind); + procedure Synth_File_Open + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) + is + Inters : constant Node := Get_Interface_Declaration_Chain (Imp); + F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; + Param2 : constant Node := Get_Chain (Inters); + File_Name : constant Valtyp := Get_Value (Syn_Inst, Param2); + Param3 : constant Node := Get_Chain (Param2); + Open_Kind : constant Valtyp := Get_Value (Syn_Inst, Param3); + C_Name : C_File_Name; + C_Name_Len : Natural; + File_Mode : Ghdl_I32; + Status : Op_Status; + 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 (Inters)) 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; + + if Status /= Op_Ok then + if Status = Op_Name_Error then + Error_Msg_Synth + (+Loc, "cannot open file: " & C_Name (1 .. C_Name_Len)); + raise File_Execution_Error; + else + File_Error (Loc, Status); + end if; + end if; + end Synth_File_Open; + + -- Declaration + -- procedure FILE_CLOSE (file F : FT); + procedure Synth_File_Close + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) + is + Inters : constant Node := Get_Interface_Declaration_Chain (Imp); + F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; + Status : Op_Status; + begin + if Get_Text_File_Flag (Get_Type (Inters)) then + Ghdl_Text_File_Close (F, Status); + else + Ghdl_File_Close (F, Status); + end if; + + if Status /= Op_Ok then + File_Error (Loc, Status); + end if; + end Synth_File_Close; + + -- 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).Val.File; + Param2 : constant Node := Get_Chain (Inters); + Str : constant Valtyp := Get_Value (Syn_Inst, Param2); + Param3 : constant Node := Get_Chain (Param2); + Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); + Buf : String (1 .. Natural (Str.Typ.Abounds.D (1).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 + Write_U8 (Str.Val.Mem + Size_Type (I - 1), Character'Pos (Buf (I))); + end loop; + + 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.Vhdl_Files; diff --git a/src/synth/synth-vhdl_files.ads b/src/synth/synth-vhdl_files.ads new file mode 100644 index 000000000..1d373664e --- /dev/null +++ b/src/synth/synth-vhdl_files.ads @@ -0,0 +1,48 @@ +-- Create declarations for synthesis. +-- Copyright (C) 2017 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, see . + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Synth.Source; use Synth.Source; +with Synth.Values; use Synth.Values; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; + +package Synth.Vhdl_Files 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; + + function Endfile (F : File_Index; Loc : Syn_Src) return Boolean; + + procedure Synth_File_Open + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + procedure Synth_File_Close + (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); + + 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.Vhdl_Files; -- cgit v1.2.3