From de68a6b6b024d438f2242e2fddb7dd29cca59f3b Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 8 Sep 2022 18:54:58 +0200 Subject: simul: add support for protected objects --- src/simul/simul-vhdl_elab.adb | 54 +++++++++++++++++++++++++- src/simul/simul-vhdl_simul.adb | 10 ++++- src/synth/elab-vhdl_context.adb | 3 +- src/synth/elab-vhdl_decls.adb | 9 +---- src/synth/elab-vhdl_prot.adb | 56 +++++++++++++++++++++++++++ src/synth/elab-vhdl_prot.ads | 26 +++++++++++++ src/synth/elab-vhdl_values.adb | 23 +++++++++++ src/synth/elab-vhdl_values.ads | 7 ++++ src/synth/synth-vhdl_decls.adb | 10 ++++- src/synth/synth-vhdl_stmts.adb | 85 ++++++++++++++++++++++++++++++++++++----- src/synth/synth-vhdl_stmts.ads | 5 +++ src/vhdl/vhdl-nodes.ads | 2 +- 12 files changed, 267 insertions(+), 23 deletions(-) create mode 100644 src/synth/elab-vhdl_prot.adb create mode 100644 src/synth/elab-vhdl_prot.ads (limited to 'src') diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb index c71345ec5..4296008eb 100644 --- a/src/simul/simul-vhdl_elab.adb +++ b/src/simul/simul-vhdl_elab.adb @@ -24,7 +24,9 @@ with Vhdl.Canon; with Synth.Vhdl_Stmts; with Trans_Analyzes; + with Elab.Vhdl_Decls; +with Elab.Vhdl_Prot; with Simul.Vhdl_Debug; @@ -195,6 +197,35 @@ package body Simul.Vhdl_Elab is Val.Val.T := Terminal_Table.Last; end Gather_Terminal; + function Create_Protected_Object (Inst : Synth_Instance_Acc; + Decl : Node; + Typ : Type_Acc) return Valtyp + is + Decl_Type : constant Node := Get_Type (Decl); + Bod : constant Node := Get_Protected_Type_Body (Decl_Type); + Obj_Inst : Synth_Instance_Acc; + Obj_Hand : Protected_Index; + Mem : Memory_Ptr; + Parent : Synth_Instance_Acc; + Res : Valtyp; + begin + Parent := Get_Instance_By_Scope (Inst, Get_Parent_Scope (Bod)); + Obj_Inst := Make_Elab_Instance (Parent, Bod, Null_Node); + Obj_Hand := Elab.Vhdl_Prot.Create (Obj_Inst); + + Instance_Pool := Global_Pool'Access; + Elab.Vhdl_Decls.Elab_Declarations + (Obj_Inst, Get_Declaration_Chain (Bod), True); + + Mem := Alloc_Memory (Typ, Instance_Pool); + Write_Protected (Mem, Obj_Hand); + + Res := Create_Value_Memory ((Typ, Mem), Instance_Pool); + Instance_Pool := null; + + return Res; + end Create_Protected_Object; + procedure Gather_Processes_Decl (Inst : Synth_Instance_Acc; Decl : Node) is begin case Get_Kind (Decl) is @@ -268,8 +299,28 @@ package body Simul.Vhdl_Elab is V := Get_Value (Inst, Decl); Convert_Type_Width (V.Typ); end; + when Iir_Kind_Variable_Declaration => + pragma Assert (Get_Shared_Flag (Decl)); + if Get_Default_Value (Decl) = Null_Node then + -- Elab doesn't set a value to variables with no default + -- value. + declare + V : Valtyp; + begin + V := Get_Value (Inst, Decl); + pragma Assert (V.Val = null); + Current_Pool := Global_Pool'Access; + if V.Typ.Kind = Type_Protected then + V := Create_Protected_Object (Inst, Decl, V.Typ); + else + V := Create_Value_Default (V.Typ); + end if; + Current_Pool := Expr_Pool'Access; + Mutate_Object (Inst, Decl, V); + end; + end if; + when Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Declaration | Iir_Kind_Non_Object_Alias_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification @@ -282,6 +333,7 @@ package body Simul.Vhdl_Elab is | Iir_Kind_Procedure_Body | Iir_Kind_Component_Declaration | Iir_Kind_File_Declaration + | Iir_Kind_Protected_Type_Body | Iir_Kind_Use_Clause => null; when others => diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index cd34a5ca4..f23934103 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -701,6 +701,7 @@ package body Simul.Vhdl_Simul is Inst : constant Synth_Instance_Acc := Process.Instance; Call : constant Node := Get_Procedure_Call (Stmt); Imp : constant Node := Get_Implementation (Call); + Obj : constant Node := Get_Method_Object (Call); Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); @@ -714,7 +715,9 @@ package body Simul.Vhdl_Simul is Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); begin + pragma Assert (Obj = Null_Node); Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Imp); + Synth_Subprogram_Association (Sub_Inst, Inst, Inter_Chain, Assoc_Chain); @@ -739,7 +742,12 @@ package body Simul.Vhdl_Simul is return; end if; - Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Bod); + if Obj /= Null_Node then + Sub_Inst := Synth_Protected_Call_Instance (Inst, Obj, Imp, Bod); + else + Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Bod); + end if; + -- Note: in fact the uninstantiated scope is the instantiated -- one! Set_Uninstantiated_Scope (Sub_Inst, Imp); diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb index 248eb6a4f..136cc50f0 100644 --- a/src/synth/elab-vhdl_context.adb +++ b/src/synth/elab-vhdl_context.adb @@ -550,7 +550,8 @@ package body Elab.Vhdl_Context is case Scope.Kind is when Kind_Block | Kind_Frame - | Kind_Process => + | Kind_Process + | Kind_Protected => declare Current : Synth_Instance_Acc; begin diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb index 4c09a656c..f873730ba 100644 --- a/src/synth/elab-vhdl_decls.adb +++ b/src/synth/elab-vhdl_decls.adb @@ -24,7 +24,6 @@ with Vhdl.Utils; use Vhdl.Utils; with Elab.Vhdl_Values; use Elab.Vhdl_Values; with Elab.Vhdl_Types; use Elab.Vhdl_Types; with Elab.Vhdl_Files; -with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; with Elab.Vhdl_Insts; @@ -150,17 +149,11 @@ package body Elab.Vhdl_Decls is Force_Init : Boolean) is Def : constant Node := Get_Default_Value (Decl); - Decl_Type : constant Node := Get_Type (Decl); Marker : Mark_Type; Init : Valtyp; Obj_Typ : Type_Acc; begin Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl); - if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then - Error_Msg_Elab (+Decl, "protected type not supported"); - return; - end if; - Mark_Expr_Pool (Marker); if Is_Valid (Def) then @@ -173,6 +166,8 @@ package body Elab.Vhdl_Decls is Init := Create_Value_Default (Obj_Typ); Current_Pool := Expr_Pool'Access; else + -- For synthesis, no need to set a value for a shared variable + -- (they will certainly become a memory). Init := (Typ => Obj_Typ, Val => null); end if; end if; diff --git a/src/synth/elab-vhdl_prot.adb b/src/synth/elab-vhdl_prot.adb new file mode 100644 index 000000000..885fbfb59 --- /dev/null +++ b/src/synth/elab-vhdl_prot.adb @@ -0,0 +1,56 @@ +-- Protected objects table +-- Copyright (C) 2022 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 Tables; + +package body Elab.Vhdl_Prot is + + package Prot_Table is new Tables + (Table_Component_Type => Synth_Instance_Acc, + Table_Index_Type => Protected_Index, + Table_Low_Bound => 1, + Table_Initial => 16); + + function Create (Inst : Synth_Instance_Acc) return Protected_Index is + begin + Prot_Table.Append (Inst); + return Prot_Table.Last; + end Create; + + function Get (Idx : Protected_Index) return Synth_Instance_Acc + is + Res : Synth_Instance_Acc; + begin + pragma Assert (Idx > No_Protected_Index); + pragma Assert (Idx <= Prot_Table.Last); + Res := Prot_Table.Table (Idx); + pragma Assert (Res /= null); + return Res; + end Get; + + procedure Destroy (Idx : Protected_Index) is + begin + pragma Assert (Idx > No_Protected_Index); + pragma Assert (Idx <= Prot_Table.Last); + pragma Assert (Prot_Table.Table (Idx) /= null); + Prot_Table.Table (Idx) := null; + + -- TODO: Decrease if last ? + end Destroy; + +end Elab.Vhdl_Prot; diff --git a/src/synth/elab-vhdl_prot.ads b/src/synth/elab-vhdl_prot.ads new file mode 100644 index 000000000..d1b30a2af --- /dev/null +++ b/src/synth/elab-vhdl_prot.ads @@ -0,0 +1,26 @@ +-- Protected objects table +-- Copyright (C) 2022 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 Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +package Elab.Vhdl_Prot is + function Create (Inst : Synth_Instance_Acc) return Protected_Index; + function Get (Idx : Protected_Index) return Synth_Instance_Acc; + procedure Destroy (Idx : Protected_Index); +end Elab.Vhdl_Prot; diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 7adf69030..f86f4739a 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -349,6 +349,29 @@ package body Elab.Vhdl_Values is return Read_Access (Mt.Mem); end Read_Access; + procedure Write_Protected (Mem : Memory_Ptr; Idx : Protected_Index) + is + V : Protected_Index; + for V'Address use Mem.all'Address; + pragma Import (Ada, V); + begin + V := Idx; + end Write_Protected; + + function Read_Protected (Mem : Memory_Ptr) return Protected_Index + is + V : Protected_Index; + for V'Address use Mem.all'Address; + pragma Import (Ada, V); + begin + return V; + end Read_Protected; + + function Read_Protected (Mt : Memtyp) return Protected_Index is + begin + return Read_Protected (Mt.Mem); + end Read_Protected; + procedure Write_Discrete (Vt : Valtyp; Val : Int64) is begin Write_Discrete (Vt.Val.Mem, Vt.Typ, Val); diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 57ef8048b..67009ba5f 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -70,6 +70,9 @@ package Elab.Vhdl_Values is type Heap_Index is new Uns32; Null_Heap_Index : constant Heap_Index := 0; + type Protected_Index is new Uns32; + No_Protected_Index : constant Protected_Index := 0; + subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; type Signal_Index_Type is new Uns32; @@ -214,6 +217,10 @@ package Elab.Vhdl_Values is function Read_Access (Mt : Memtyp) return Heap_Index; function Read_Access (Vt : Valtyp) return Heap_Index; + procedure Write_Protected (Mem : Memory_Ptr; Idx : Protected_Index); + function Read_Protected (Mem : Memory_Ptr) return Protected_Index; + function Read_Protected (Mt : Memtyp) return Protected_Index; + function Read_Fp64 (Vt : Valtyp) return Fp64; procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp); diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index 2a4b792a6..9cc7dc1bc 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -437,8 +437,13 @@ package body Synth.Vhdl_Decls is Val : Valtyp; begin Init := Get_Value (Syn_Inst, Decl); - if Init.Val = null then - Init := Create_Value_Default (Init.Typ); + if Init.Typ.Kind = Type_Protected then + Error_Msg_Synth (+Decl, "protected type not supported"); + Set_Error (Syn_Inst); + else + if Init.Val = null then + Init := Create_Value_Default (Init.Typ); + end if; end if; Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init); @@ -809,6 +814,7 @@ package body Synth.Vhdl_Decls is | Iir_Kind_Procedure_Declaration | Iir_Kind_Procedure_Body | Iir_Kind_Type_Declaration + | Iir_Kind_Protected_Type_Body | Iir_Kind_Anonymous_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Component_Declaration diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 5b958681d..a10167cf3 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -41,6 +41,7 @@ with PSL.NFAs; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; +with Elab.Vhdl_Prot; with Elab.Vhdl_Types; use Elab.Vhdl_Types; with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; with Elab.Vhdl_Debug; @@ -347,8 +348,9 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Simple_Name | Iir_Kind_Selected_Element | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Variable_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name @@ -1872,7 +1874,8 @@ package body Synth.Vhdl_Stmts is is Marker : Mark_Type; Inter : Node; - Inter_Type : Type_Acc; + Inter_Type : Node; + Inter_Typ : Type_Acc; Assoc : Node; Actual : Node; Val : Valtyp; @@ -1889,7 +1892,12 @@ package body Synth.Vhdl_Stmts is Association_Iterate_Next (Iterator, Inter, Assoc); exit when Inter = Null_Node; - Inter_Type := Get_Subtype_Object (Subprg_Inst, Get_Type (Inter)); + Inter_Type := Get_Type (Inter); + if Get_Kind (Inter_Type) = Iir_Kind_Protected_Type_Declaration then + Inter_Typ := Protected_Type; + else + Inter_Typ := Get_Subtype_Object (Subprg_Inst, Inter_Type); + end if; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration => @@ -1899,7 +1907,7 @@ package body Synth.Vhdl_Stmts is then Actual := Get_Default_Value (Inter); Val := Synth_Expression_With_Type - (Subprg_Inst, Actual, Inter_Type); + (Subprg_Inst, Actual, Inter_Typ); else if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression @@ -1909,7 +1917,7 @@ package body Synth.Vhdl_Stmts is Actual := Assoc; end if; Val := Synth_Expression_With_Type - (Caller_Inst, Actual, Inter_Type); + (Caller_Inst, Actual, Inter_Typ); end if; when Iir_Kind_Interface_Variable_Declaration => -- Always pass by value. @@ -1961,7 +1969,7 @@ package body Synth.Vhdl_Stmts is if Get_Mode (Inter) /= Iir_Out_Mode then -- Always passed by value Val := Synth_Subtype_Conversion - (Subprg_Inst, Val, Inter_Type, True, Assoc); + (Subprg_Inst, Val, Inter_Typ, True, Assoc); Val := Unshare (Val, Instance_Pool); else -- Use default value ? @@ -1983,7 +1991,7 @@ package body Synth.Vhdl_Stmts is Iir_Kinds_Scalar_Type_And_Subtype_Definition then if Get_Mode (Inter) in Iir_In_Modes then - if not Is_Scalar_Subtype_Compatible (Val.Typ, Inter_Type) + if not Is_Scalar_Subtype_Compatible (Val.Typ, Inter_Typ) then Error_Msg_Synth (+Actual, @@ -1992,7 +2000,7 @@ package body Synth.Vhdl_Stmts is end if; end if; if Get_Mode (Inter) in Iir_Out_Modes then - if not Is_Scalar_Subtype_Compatible (Inter_Type, Val.Typ) + if not Is_Scalar_Subtype_Compatible (Inter_Typ, Val.Typ) then Error_Msg_Synth (+Actual, @@ -2005,7 +2013,7 @@ package body Synth.Vhdl_Stmts is -- This is equivalent to subtype conversion for non-scalar -- types. Val := Synth_Subtype_Conversion - (Subprg_Inst, Val, Inter_Type, True, Assoc); + (Subprg_Inst, Val, Inter_Typ, True, Assoc); Val := Unshare (Val, Instance_Pool); end if; if Val.Typ /= null then @@ -2340,6 +2348,47 @@ package body Synth.Vhdl_Stmts is return Res; end Synth_Subprogram_Call_Instance; + -- Like Get_Protected_Type_Body, but also works for instances, where + -- instantiated nodes have no bodies. + -- FIXME: maybe fix the issue directly in Sem_Inst ? + function Get_Protected_Type_Body_Origin (Spec : Node) return Node + is + Res : constant Node := Get_Protected_Type_Body (Spec); + Orig : Node; + begin + if Res /= Null_Node then + return Res; + else + Orig := Vhdl.Sem_Inst.Get_Origin (Spec); + return Get_Protected_Type_Body_Origin (Orig); + end if; + end Get_Protected_Type_Body_Origin; + pragma Unreferenced (Get_Protected_Type_Body_Origin); + + function Synth_Protected_Call_Instance (Inst : Synth_Instance_Acc; + Obj : Node; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc + is + pragma Unreferenced (Imp); + Obj_Info : Target_Info; + Idx : Protected_Index; + Obj_Inst : Synth_Instance_Acc; + Res : Synth_Instance_Acc; + begin + Obj_Info := Synth_Target (Inst, Obj); + pragma Assert (Obj_Info.Kind = Target_Simple); + pragma Assert (Obj_Info.Off = No_Value_Offsets); + -- Get instance_acc of the variable + Idx := Read_Protected (Obj_Info.Obj.Val.Mem); + Obj_Inst := Elab.Vhdl_Prot.Get (Idx); + + Res := Make_Elab_Instance (Obj_Inst, Bod, Config => Null_Node); + Set_Caller_Instance (Res, Inst); + return Res; + end Synth_Protected_Call_Instance; + function Synth_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Call : Node; Init : Association_Iterator_Init) @@ -2349,6 +2398,7 @@ package body Synth.Vhdl_Stmts is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp); + Obj : Node; Area_Mark : Areapools.Mark_Type; Ret_Typ : Type_Acc; Res : Valtyp; @@ -2356,7 +2406,22 @@ package body Synth.Vhdl_Stmts is begin Areapools.Mark (Area_Mark, Instance_Pool.all); - Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); + case Get_Kind (Call) is + when Iir_Kinds_Dyadic_Operator + | Iir_Kinds_Monadic_Operator => + Obj := Null_Node; + when Iir_Kind_Function_Call + | Iir_Kind_Procedure_Call => + Obj := Get_Method_Object (Call); + when others => + raise Internal_Error; + end case; + + if Obj /= Null_Node then + Sub_Inst := Synth_Protected_Call_Instance (Syn_Inst, Obj, Imp, Bod); + else + Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); + end if; if Ctxt /= null then Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index 99aa5ff97..092249225 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -42,6 +42,11 @@ package Synth.Vhdl_Stmts is Imp : Node; Bod : Node) return Synth_Instance_Acc; + function Synth_Protected_Call_Instance (Inst : Synth_Instance_Acc; + Obj : Node; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc; procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 4ef9b466a..fe74d7796 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -2744,7 +2744,7 @@ package Vhdl.Nodes is -- Get/Set_Has_Signal_Flag (Flag3) -- Iir_Kind_Protected_Type_Declaration (Short) - -- The parent of a protected type declarationi s the same parent as the + -- The parent of a protected type declaration is the same parent as the -- type declaration. -- Get/Set_Parent (Field0) -- -- cgit v1.2.3