aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/grt/grt-files_operations.adb19
-rw-r--r--src/grt/grt-files_operations.ads4
-rw-r--r--src/synth/synth-files_operations.adb35
-rw-r--r--src/synth/synth-files_operations.ads4
-rw-r--r--src/synth/synth-static_proc.adb40
-rw-r--r--src/synth/synth-static_proc.ads28
-rw-r--r--src/synth/synth-stmts.adb133
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)
generated by cgit v1.2.3 (git 2.25.1) at 2025-02-02 15:59:16 +0000