From 5f2be92340bb4ecf1ea0e773e4c734e53204979a Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 17 Nov 2019 08:26:04 +0100 Subject: synth: initial support of access types. --- src/synth/synth-decls.adb | 29 +++++++------ src/synth/synth-decls.ads | 2 + src/synth/synth-expr.adb | 11 +++++ src/synth/synth-heap.adb | 94 +++++++++++++++++++++++++++++++++++++++++ src/synth/synth-heap.ads | 31 ++++++++++++++ src/synth/synth-static_proc.adb | 13 ++++++ src/synth/synth-stmts.adb | 13 ++++++ 7 files changed, 181 insertions(+), 12 deletions(-) create mode 100644 src/synth/synth-heap.adb create mode 100644 src/synth/synth-heap.ads diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 436ade478..4d520e578 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -330,20 +330,15 @@ package body Synth.Decls is end case; end Synth_Array_Subtype_Indication; - procedure Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) - is - Typ : Type_Acc; + function Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is begin -- TODO: handle aliases directly. case Get_Kind (Atype) is when Iir_Kind_Array_Subtype_Definition => - Typ := Synth_Array_Subtype_Indication (Syn_Inst, Atype); + return Synth_Array_Subtype_Indication (Syn_Inst, Atype); when Iir_Kind_Record_Subtype_Definition => - Typ := Synth_Record_Type_Definition (Syn_Inst, Atype); - if Typ = null then - return; - end if; + return Synth_Record_Type_Definition (Syn_Inst, Atype); when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition => @@ -355,12 +350,13 @@ package body Synth.Decls is begin if Btype.Kind in Type_Nets then -- A subtype of a bit/logic type is still a bit/logic. - Typ := Btype; + -- FIXME: bounds. + return Btype; else Rng := Synth_Discrete_Range_Constraint (Syn_Inst, Get_Range_Constraint (Atype)); W := Discrete_Range_Width (Rng); - Typ := Create_Discrete_Type (Rng, W); + return Create_Discrete_Type (Rng, W); end if; end; when Iir_Kind_Floating_Subtype_Definition => @@ -369,11 +365,20 @@ package body Synth.Decls is begin Rng := Synth_Float_Range_Constraint (Syn_Inst, Get_Range_Constraint (Atype)); - Typ := Create_Float_Type (Rng); + return Create_Float_Type (Rng); end; when others => Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype); end case; + end Synth_Subtype_Indication; + + procedure Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) + is + Typ : Type_Acc; + begin + Typ := Synth_Subtype_Indication (Syn_Inst, Atype); + pragma Assert (Typ /= null); Create_Object (Syn_Inst, Atype, Create_Value_Subtype (Typ)); end Synth_Subtype_Indication; diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index 08a548bc5..7fd104280 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -33,6 +33,8 @@ package Synth.Decls is procedure Synth_Subtype_Indication (Syn_Inst : Synth_Instance_Acc; Atype : Node); + function Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; -- Elaborate the type of DECL. procedure Synth_Declaration_Type diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 54625936d..7f701edde 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -40,6 +40,7 @@ with Synth.Environment; with Synth.Decls; with Synth.Stmts; use Synth.Stmts; with Synth.Oper; use Synth.Oper; +with Synth.Heap; use Synth.Heap; package body Synth.Expr is function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) @@ -1781,6 +1782,16 @@ package body Synth.Expr is end; when Iir_Kind_Null_Literal => return Create_Value_Access (Expr_Type, Null_Heap_Index); + when Iir_Kind_Allocator_By_Subtype => + declare + T : Type_Acc; + Acc : Heap_Index; + begin + T := Synth.Decls.Synth_Subtype_Indication + (Syn_Inst, Get_Subtype_Indication (Expr)); + Acc := Allocate_By_Type (T); + return Create_Value_Access (Expr_Type, Acc); + end; when Iir_Kind_Overflow_Literal => declare N : Net; diff --git a/src/synth/synth-heap.adb b/src/synth/synth-heap.adb new file mode 100644 index 000000000..d92d4c561 --- /dev/null +++ b/src/synth/synth-heap.adb @@ -0,0 +1,94 @@ +-- Heap 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 Tables; + +with Vhdl.Nodes; use Vhdl.Nodes; + +package body Synth.Heap is + + package Heap_Table is new Tables + (Table_Component_Type => Value_Acc, + Table_Index_Type => Heap_Index, + Table_Low_Bound => 1, + Table_Initial => 16); + + function Allocate_By_Type (T : Type_Acc) return Value_Acc is + begin + case T.Kind is + when Type_Bit + | Type_Logic => + return new Value_Type' + (Kind => Value_Discrete, Typ => T, Scal => 0); + when Type_Discrete => + return new Value_Type' + (Kind => Value_Discrete, Typ => T, Scal => T.Drange.Left); + when Type_Array => + declare + Len : constant Uns32 := Get_Array_Flat_Length (T); + El_Typ : constant Type_Acc := Get_Array_Element (T); + Arr : Value_Array_Acc; + begin + Arr := new Value_Array_Type (Iir_Index32 (Len)); + for I in Arr.V'Range loop + Arr.V (I) := Allocate_By_Type (El_Typ); + end loop; + return new Value_Type' + (Kind => Value_Const_Array, Typ => T, Arr => Arr); + end; + when others => + raise Internal_Error; + end case; + end Allocate_By_Type; + + function Allocate_By_Type (T : Type_Acc) return Heap_Index is + begin + -- FIXME: allocate type. + Heap_Table.Append (Allocate_By_Type (T)); + return Heap_Table.Last; + end Allocate_By_Type; + + function Allocate_By_Value (V : Value_Acc) return Heap_Index is + begin + raise Internal_Error; + return Null_Heap_Index; + end Allocate_By_Value; + + function Synth_Dereference (Idx : Heap_Index) return Value_Acc is + begin + return Heap_Table.Table (Idx); + end Synth_Dereference; + + procedure Free (Obj : in out Value_Acc) is + begin + -- TODO + Obj := null; + end Free; + + procedure Synth_Deallocate (Idx : Heap_Index) is + begin + if Heap_Table.Table (Idx) = null then + return; + end if; + Free (Heap_Table.Table (Idx)); + end Synth_Deallocate; + +end Synth.Heap; diff --git a/src/synth/synth-heap.ads b/src/synth/synth-heap.ads new file mode 100644 index 000000000..5568a3772 --- /dev/null +++ b/src/synth/synth-heap.ads @@ -0,0 +1,31 @@ +-- Heap 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 Synth.Values; use Synth.Values; + +package Synth.Heap is + -- Allocate a value. + function Allocate_By_Type (T : Type_Acc) return Heap_Index; + function Allocate_By_Value (V : Value_Acc) return Heap_Index; + + function Synth_Dereference (Idx : Heap_Index) return Value_Acc; + + procedure Synth_Deallocate (Idx : Heap_Index); +end Synth.Heap; diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb index 2eb71c09c..c93f3bb1f 100644 --- a/src/synth/synth-static_proc.adb +++ b/src/synth/synth-static_proc.adb @@ -20,11 +20,22 @@ 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.Heap; package body Synth.Static_Proc is + procedure Synth_Deallocate (Syn_Inst : Synth_Instance_Acc; Imp : Node) + is + Inter : constant Node := Get_Interface_Declaration_Chain (Imp); + Param : constant Value_Acc := Get_Value (Syn_Inst, Inter); + begin + Synth.Heap.Synth_Deallocate (Param.Acc); + Param.Acc := Null_Heap_Index; + end Synth_Deallocate; + procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) is @@ -32,6 +43,8 @@ package body Synth.Static_Proc is case Get_Implicit_Definition (Imp) is when Iir_Predefined_Foreign_Untruncated_Text_Read => Synth_Untruncated_Text_Read (Syn_Inst, Imp, Loc); + when Iir_Predefined_Deallocate => + Synth_Deallocate (Syn_Inst, Imp); when others => Error_Msg_Synth (+Loc, "call to implicit %n is not supported", +Imp); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 8402dcec5..7527045c8 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -44,6 +44,7 @@ with Synth.Expr; use Synth.Expr; with Synth.Insts; use Synth.Insts; with Synth.Source; with Synth.Static_Proc; +with Synth.Heap; with Netlists.Builders; use Netlists.Builders; with Netlists.Gates; @@ -315,6 +316,16 @@ package body Synth.Stmts is end if; end; + when Iir_Kind_Implicit_Dereference => + Synth_Assignment_Prefix + (Syn_Inst, Get_Prefix (Pfx), + Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); + if Dest_Off /= 0 and then Dest_Voff /= No_Net then + raise Internal_Error; + end if; + Dest_Obj := Heap.Synth_Dereference (Dest_Obj.Acc); + Dest_Type := Dest_Obj.Typ; + when others => Error_Kind ("synth_assignment_prefix", Pfx); end case; @@ -419,6 +430,8 @@ package body Synth.Stmts is case Targ.Kind is when Value_Discrete => Targ.Scal := Val.Scal; + when Value_Access => + Targ.Acc := Val.Acc; when Value_Const_Array | Value_Array => declare -- cgit v1.2.3