diff options
Diffstat (limited to 'src/synth')
| -rw-r--r-- | src/synth/synth-decls.adb | 7 | ||||
| -rw-r--r-- | src/synth/synth-decls.ads | 1 | ||||
| -rw-r--r-- | src/synth/synth-files_operations.adb | 159 | ||||
| -rw-r--r-- | src/synth/synth-files_operations.ads | 29 | ||||
| -rw-r--r-- | src/synth/synth-values.ads | 4 |
5 files changed, 198 insertions, 2 deletions
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 834aef561..774bebd06 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -20,6 +20,7 @@ with Types; use Types; with Mutils; use Mutils; + with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; @@ -36,6 +37,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; package body Synth.Decls is procedure Synth_Anonymous_Subtype_Indication @@ -697,11 +699,14 @@ package body Synth.Decls is null; when Iir_Kind_File_Declaration => declare + F : File_Index; Res : Value_Acc; Obj_Typ : Type_Acc; begin + F := Synth.Files_Operations.Elaborate_File_Declaration + (Syn_Inst, Decl); Obj_Typ := Get_Value_Type (Syn_Inst, Get_Type (Decl)); - Res := Create_Value_File (Obj_Typ, 0); + Res := Create_Value_File (Obj_Typ, F); Create_Object (Syn_Inst, Decl, Res); end; when Iir_Kind_Psl_Default_Clock => diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index 02bf5c865..08a548bc5 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -19,6 +19,7 @@ -- MA 02110-1301, USA. with Vhdl.Nodes; use Vhdl.Nodes; + with Synth.Context; use Synth.Context; with Synth.Values; use Synth.Values; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb new file mode 100644 index 000000000..4b188e157 --- /dev/null +++ b/src/synth/synth-files_operations.adb @@ -0,0 +1,159 @@ +-- 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, write to the Free Software +-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, +-- MA 02110-1301, USA. + +with Types; use Types; + +with Grt.Types; +with Grt.Files_Operations; use Grt.Files_Operations; + +with Vhdl.Annotations; + +with Synth.Expr; use Synth.Expr; +with Synth.Source; use Synth.Source; +with Synth.Errors; use Synth.Errors; + +package body Synth.Files_Operations is + + -- 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) is + begin + pragma Assert (Status /= Op_Ok); + Error_Msg_Synth (+Loc, "file operation failed"); + raise Internal_Error; + end File_Error; + + -- VAL represents a string, so an array of characters. + procedure Convert_String (Val : Value_Acc; Res : out String) + is + Vtyp : constant Type_Acc := Val.Typ; + 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.Len = 1); + pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); + + for I in Val.Arr.V'Range loop + Res (Res'First + Natural (I - 1)) := + Character'Val (Val.Arr.V (I).Scal); + end loop; + end Convert_String; + + -- Convert filename VAL to RES + LEN. + procedure Convert_File_Name (Val : Value_Acc; + Res : out C_File_Name; + Len : out Natural; + Status : out Op_Status) is + begin + Len := Natural (Val.Arr.Len); + + if Len >= Res'Length - 1 then + Status := Op_Filename_Error; + return; + end if; + + Convert_String (Val, Res (1 .. Len)); + Res (Len + 1) := Grt.Types.NUL; + + Status := Op_Ok; + end Convert_File_Name; + + function Elaborate_File_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index + is + use Grt.Types; + 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 : Value_Acc; + C_Name : C_File_Name; + C_Name_Len : Natural; + Mode : Value_Acc; + F : File_Index; + File_Mode : Ghdl_I32; + Status : Op_Status; + begin + if Get_Text_File_Flag (File_Type) then + F := Ghdl_Text_File_Elaborate; + else + declare + Sig : constant String_Acc := + Vhdl.Annotations.Get_Info (File_Type).File_Signature; + Cstr : Ghdl_C_String; + begin + if Sig = null then + Cstr := null; + else + Cstr := To_Ghdl_C_String (Sig.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 (Mode.Scal); + 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)); + raise Internal_Error; + else + File_Error (Decl, Status); + end if; + end if; + + return F; + end Elaborate_File_Declaration; +end Synth.Files_Operations; diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads new file mode 100644 index 000000000..81dee4a91 --- /dev/null +++ b/src/synth/synth-files_operations.ads @@ -0,0 +1,29 @@ +-- 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, write to the Free Software +-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, +-- MA 02110-1301, USA. + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Synth.Values; use Synth.Values; +with Synth.Context; use Synth.Context; + +package Synth.Files_Operations is + function Elaborate_File_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index; +end Synth.Files_Operations; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 4712eb2b7..03fa9d52e 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -21,6 +21,8 @@ with Types; use Types; with Areapools; use Areapools; +with Grt.Files_Operations; + with Netlists; use Netlists; with Vhdl.Nodes; use Vhdl.Nodes; @@ -201,7 +203,7 @@ package Synth.Values is type Heap_Index is new Uns32; Null_Heap_Index : constant Heap_Index := 0; - type File_Index is new Nat32; + subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; type Value_Type (Kind : Value_Kind) is record Typ : Type_Acc; |