diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-11-16 08:05:59 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-11-16 08:05:59 +0100 |
commit | 706fd3a64ca9d55591542d0488b87698e3835c21 (patch) | |
tree | 08673255458c20801c8d77a0149538935203220f /src | |
parent | 2d50cc903f5cf5eb55ebdc082c9ccb7168e75987 (diff) | |
download | ghdl-706fd3a64ca9d55591542d0488b87698e3835c21.tar.gz ghdl-706fd3a64ca9d55591542d0488b87698e3835c21.tar.bz2 ghdl-706fd3a64ca9d55591542d0488b87698e3835c21.zip |
synth: handle untruncated_text_read.
Diffstat (limited to 'src')
-rw-r--r-- | src/grt/grt-files_operations.adb | 19 | ||||
-rw-r--r-- | src/grt/grt-files_operations.ads | 4 | ||||
-rw-r--r-- | src/synth/synth-files_operations.adb | 35 | ||||
-rw-r--r-- | src/synth/synth-files_operations.ads | 4 | ||||
-rw-r--r-- | src/synth/synth-static_proc.adb | 40 | ||||
-rw-r--r-- | src/synth/synth-static_proc.ads | 28 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 133 |
7 files changed, 189 insertions, 74 deletions
diff --git a/src/grt/grt-files_operations.adb b/src/grt/grt-files_operations.adb index ed15f7fa0..c7770b5f3 100644 --- a/src/grt/grt-files_operations.adb +++ b/src/grt/grt-files_operations.adb @@ -528,14 +528,14 @@ package body Grt.Files_Operations is Status := Op_Ok; end Ghdl_Text_Read_Length; - procedure Ghdl_Untruncated_Text_Read - (File : Ghdl_File_Index; Str : Std_String_Ptr; Len : out Std_Integer; - Status : out Op_Status) + procedure Ghdl_Untruncated_Text_Read (File : Ghdl_File_Index; + Buf : Ghdl_C_String; + Len : in out Std_Integer; + Status : out Op_Status) is Stream : C_Files; Max_Len : int; begin - Len := 0; Get_File (File, Stream, Status); if Status /= Op_Ok then return; @@ -545,19 +545,14 @@ package body Grt.Files_Operations is return; end if; - Max_Len := int (Str.Bounds.Dim_1.Length); - if fgets (Str.Base (0)'Address, Max_Len, Stream) = Null_Address then + Max_Len := int (Len); + if fgets (To_Address (Buf), Max_Len, Stream) = Null_Address then Status := Op_End_Of_File; return; end if; -- Compute the length. - for I in Ghdl_Index_Type loop - if Str.Base (I) = NUL then - Len := Std_Integer (I); - exit; - end if; - end loop; + Len := Std_Integer (strlen (Buf)); Status := Op_Ok; end Ghdl_Untruncated_Text_Read; diff --git a/src/grt/grt-files_operations.ads b/src/grt/grt-files_operations.ads index c6ee8751d..176d4f06c 100644 --- a/src/grt/grt-files_operations.ads +++ b/src/grt/grt-files_operations.ads @@ -133,8 +133,8 @@ package Grt.Files_Operations is Length : out Std_Integer); procedure Ghdl_Untruncated_Text_Read (File : Ghdl_File_Index; - Str : Std_String_Ptr; - Len : out Std_Integer; + Buf : Ghdl_C_String; + Len : in out Std_Integer; Status : out Op_Status); procedure Ghdl_Text_File_Close (File : Ghdl_File_Index; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 5be4de041..782908913 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -20,7 +20,7 @@ with Types; use Types; -with Grt.Types; +with Grt.Types; use Grt.Types; with Grt.Files_Operations; use Grt.Files_Operations; with Vhdl.Annotations; @@ -82,7 +82,6 @@ package body Synth.Files_Operations is 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); @@ -173,4 +172,36 @@ package body Synth.Files_Operations is File_Error (Loc, Status); end if; end Endfile; + + -- 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).File; + Param2 : constant Node := Get_Chain (Inters); + Str : constant Value_Acc := Get_Value (Syn_Inst, Param2); + Param3 : constant Node := Get_Chain (Param2); + Param_Len : constant Value_Acc := Get_Value (Syn_Inst, Param3); + Buf : String (1 .. Natural (Str.Arr.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 + Str.Arr.V (Iir_Index32 (I)).Scal := Character'Pos (Buf (I)); + end loop; + + Param_Len.Scal := Int64 (Len); + end Synth_Untruncated_Text_Read; + end Synth.Files_Operations; diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads index 13852906e..a683e5022 100644 --- a/src/synth/synth-files_operations.ads +++ b/src/synth/synth-files_operations.ads @@ -32,4 +32,8 @@ package Synth.Files_Operations is (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index; function Endfile (F : File_Index; Loc : Syn_Src) return Boolean; + + procedure Synth_Untruncated_Text_Read (Syn_Inst : Synth_Instance_Acc; + Imp : Node; + Loc : Node); end Synth.Files_Operations; diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb new file mode 100644 index 000000000..2eb71c09c --- /dev/null +++ b/src/synth/synth-static_proc.adb @@ -0,0 +1,40 @@ +-- Predefined procedures +-- Copyright (C) 2019 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.Errors; use Vhdl.Errors; + +with Synth.Errors; use Synth.Errors; +with Synth.Files_Operations; use Synth.Files_Operations; + +package body Synth.Static_Proc is + + procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; + Imp : Node; + Loc : Node) is + begin + case Get_Implicit_Definition (Imp) is + when Iir_Predefined_Foreign_Untruncated_Text_Read => + Synth_Untruncated_Text_Read (Syn_Inst, Imp, Loc); + when others => + Error_Msg_Synth + (+Loc, "call to implicit %n is not supported", +Imp); + end case; + end Synth_Static_Procedure; +end Synth.Static_Proc; diff --git a/src/synth/synth-static_proc.ads b/src/synth/synth-static_proc.ads new file mode 100644 index 000000000..fa35bb264 --- /dev/null +++ b/src/synth/synth-static_proc.ads @@ -0,0 +1,28 @@ +-- Predefined procedures +-- Copyright (C) 2019 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 Synth.Context; use Synth.Context; +with Vhdl.Nodes; use Vhdl.Nodes; + +package Synth.Static_Proc is + procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; + Imp : Node; + Loc : Node); +end Synth.Static_Proc; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 372805d42..7c77a57ee 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -43,6 +43,7 @@ with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; with Synth.Insts; use Synth.Insts; with Synth.Source; +with Synth.Static_Proc; with Netlists.Builders; use Netlists.Builders; with Netlists.Gates; @@ -143,6 +144,7 @@ package body Synth.Stmts is | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_File_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration => declare Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx); @@ -1441,12 +1443,13 @@ package body Synth.Stmts is end if; end Synth_Label; - procedure Count_Associations - (Inter_Chain : Node; Assoc_Chain : Node; Nbr_Inout : out Natural) + function Count_Associations (Inter_Chain : Node; Assoc_Chain : Node) + return Natural is Assoc : Node; Assoc_Inter : Node; Inter : Node; + Nbr_Inout : Natural; begin Nbr_Inout := 0; @@ -1464,6 +1467,8 @@ package body Synth.Stmts is Next_Association_Interface (Assoc, Assoc_Inter); end loop; + + return Nbr_Inout; end Count_Associations; function Synth_Subprogram_Call @@ -1474,12 +1479,14 @@ package body Synth.Stmts is Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Bod : constant Node := Get_Subprogram_Body (Imp); + Nbr_Inout : constant Natural := + Count_Associations (Inter_Chain, Assoc_Chain); + Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; Res : Value_Acc; C : Seq_Context; Wire_Mark : Wire_Id; Subprg_Phi : Phi_Type; - Nbr_Inout : Natural; begin Mark (Wire_Mark); Areapools.Mark (Area_Mark, Instance_Pool.all); @@ -1498,72 +1505,64 @@ package body Synth.Stmts is C.W_Val := Alloc_Wire (Wire_Variable, Imp); end if; - Count_Associations (Inter_Chain, Assoc_Chain, Nbr_Inout); - - declare - Infos : Target_Info_Array (1 .. Nbr_Inout); - begin - Synth_Subprogram_Association - (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + Synth_Subprogram_Association + (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); - if not Is_Func then - if Get_Purity_State (Imp) /= Pure then - Set_Instance_Const (C.Inst, False); - end if; + if not Is_Func then + if Get_Purity_State (Imp) /= Pure then + Set_Instance_Const (C.Inst, False); end if; + end if; - Push_Phi; + Push_Phi; - if Is_Func then - -- Set a default value for the return. - C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); - Set_Wire_Gate (C.W_Val, - Build_Signal (Build_Context, - New_Internal_Name (Build_Context), - C.Ret_Typ.W)); - C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W); - Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0); - end if; + if Is_Func then + -- Set a default value for the return. + C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + Set_Wire_Gate (C.W_Val, + Build_Signal (Build_Context, + New_Internal_Name (Build_Context), + C.Ret_Typ.W)); + C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W); + Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0); + end if; - Set_Wire_Gate - (C.W_En, Build_Signal (Build_Context, - New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); + Set_Wire_Gate + (C.W_En, Build_Signal (Build_Context, + New_Internal_Name (Build_Context), 1)); + Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); - Set_Wire_Gate - (C.W_Ret, Build_Signal (Build_Context, - New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); + Set_Wire_Gate + (C.W_Ret, Build_Signal (Build_Context, + New_Internal_Name (Build_Context), 1)); + Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); - Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - Synth_Sequential_Statements - (C, Get_Sequential_Statement_Chain (Bod)); + Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod)); - if Is_Func then - if C.Nbr_Ret = 0 then - raise Internal_Error; - elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then - Res := C.Ret_Value; - else - Res := Create_Value_Net - (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ); - end if; + if Is_Func then + if C.Nbr_Ret = 0 then + raise Internal_Error; + elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then + Res := C.Ret_Value; else - Res := null; - Synth_Subprogram_Back_Association - (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + Res := Create_Value_Net + (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ); end if; + else + Res := null; + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + end if; - Pop_Phi (Subprg_Phi); + Pop_Phi (Subprg_Phi); - Decls.Finalize_Declarations - (C.Inst, Get_Declaration_Chain (Bod), True); - pragma Unreferenced (Infos); + Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + pragma Unreferenced (Infos); - -- Propagate assignments. - Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark); - end; + -- Propagate assignments. + Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark); -- Free wires. Free_Wire (C.W_En); @@ -1583,11 +1582,29 @@ package body Synth.Stmts is procedure Synth_Implicit_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Call : Node) is - pragma Unreferenced (Syn_Inst); Imp : constant Node := Get_Implementation (Call); + Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); + Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); + Nbr_Inout : constant Natural := + Count_Associations (Inter_Chain, Assoc_Chain); + Infos : Target_Info_Array (1 .. Nbr_Inout); + Area_Mark : Areapools.Mark_Type; + Sub_Inst : Synth_Instance_Acc; begin - Error_Msg_Synth - (+Call, "call to implicit %n is not supported", +Imp); + Areapools.Mark (Area_Mark, Instance_Pool.all); + Sub_Inst := Make_Instance (Syn_Inst, Imp, + New_Internal_Name (Build_Context)); + + Synth_Subprogram_Association + (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + + Synth.Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call); + + Synth_Subprogram_Back_Association + (Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + + Free_Instance (Sub_Inst); + Areapools.Release (Area_Mark, Instance_Pool.all); end Synth_Implicit_Procedure_Call; procedure Synth_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Stmt : Node) |