diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-11-17 08:26:04 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-11-17 08:26:04 +0100 |
commit | 5f2be92340bb4ecf1ea0e773e4c734e53204979a (patch) | |
tree | 66a015397e1532a9288364f98458ed054905c956 /src/synth/synth-heap.adb | |
parent | 21d4678928b235098131dbe5dabdc74a51a48850 (diff) | |
download | ghdl-5f2be92340bb4ecf1ea0e773e4c734e53204979a.tar.gz ghdl-5f2be92340bb4ecf1ea0e773e4c734e53204979a.tar.bz2 ghdl-5f2be92340bb4ecf1ea0e773e4c734e53204979a.zip |
synth: initial support of access types.
Diffstat (limited to 'src/synth/synth-heap.adb')
-rw-r--r-- | src/synth/synth-heap.adb | 94 |
1 files changed, 94 insertions, 0 deletions
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; |