1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-- 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, see <gnu.org/licenses>.
with Ada.Unchecked_Conversion;
with Tables;
with Elab.Memtype; use Elab.Memtype;
package body Elab.Vhdl_Heap is
-- Each object on the heap is prefixed by this prefix (to easily convert
-- to an index).
type Slot_Prefix is record
Slot : Heap_Slot;
Pad : Uns32;
end record;
-- Size of the prefix.
Prefix_Size : constant Size_Type := Size_Type (Slot_Prefix'Size / 8);
type Slot_Prefix_Acc is access all Slot_Prefix;
function To_Slot_Prefix_Acc is new Ada.Unchecked_Conversion
(Source => Memory_Ptr, Target => Slot_Prefix_Acc);
-- Each allocated object on the heap is referenced in the heap table.
-- This is the entry in the table.
type Heap_Entry is record
-- Pointer to the prefix.
Ptr : Memory_Ptr;
-- Type of the object.
Typ : Memory_Ptr;
end record;
package Heap_Table is new Tables
(Table_Component_Type => Heap_Entry,
Table_Index_Type => Heap_Slot,
Table_Low_Bound => 1,
Table_Initial => 16);
function Alloc_Mem (Sz : Size_Type) return Memory_Ptr;
pragma Import (C, Alloc_Mem, "malloc");
-- ACC_TYP is the access type,
-- OBJ_TYP is the object type.
procedure Allocate (Acc_Typ : Type_Acc;
Obj_Typ : Type_Acc;
Res : out Memory_Ptr)
is
Typ_Sz : constant Size_Type := Acc_Typ.Acc_Type_Sz;
E : Heap_Entry;
begin
pragma Assert (Acc_Typ.Kind = Type_Access);
-- Allocate memory for the object and the prefix.
E.Ptr := Alloc_Mem (Prefix_Size + Obj_Typ.Sz);
Res := E.Ptr + Prefix_Size;
-- Allocate the memory for the type.
if Typ_Sz > 0 then
declare
T : Type_Acc;
begin
E.Typ := Alloc_Mem (Typ_Sz);
T := Save_Type (Obj_Typ, E.Typ, Typ_Sz);
pragma Unreferenced (T);
end;
else
declare
function To_Memory_Ptr is new Ada.Unchecked_Conversion
(Type_Acc, Memory_Ptr);
begin
E.Typ := To_Memory_Ptr (Obj_Typ);
end;
end if;
Heap_Table.Append (E);
To_Slot_Prefix_Acc (E.Ptr).Slot := Heap_Table.Last;
end Allocate;
function Allocate_By_Type (Acc_Typ : Type_Acc; T : Type_Acc)
return Heap_Ptr
is
Res : Memory_Ptr;
begin
Allocate (Acc_Typ, T, Res);
Write_Value_Default (Res, T);
return Heap_Ptr (Res);
end Allocate_By_Type;
function Allocate_By_Value (Acc_Typ : Type_Acc; V : Valtyp)
return Heap_Ptr
is
Mem : Memory_Ptr;
begin
Allocate (Acc_Typ, V.Typ, Mem);
Write_Value (Mem, V);
return Heap_Ptr (Mem);
end Allocate_By_Value;
function Get_Index (Ptr : Heap_Ptr) return Heap_Slot
is
Pfx : constant Memory_Ptr := Memory_Ptr (Ptr) - Prefix_Size;
begin
return To_Slot_Prefix_Acc (Pfx).Slot;
end Get_Index;
function Get_Pointer (Idx : Heap_Slot) return Heap_Ptr
is
Pfx : constant Memory_Ptr := Heap_Table.Table (Idx).Ptr;
begin
return Heap_Ptr (Pfx + Prefix_Size);
end Get_Pointer;
function Synth_Dereference (Ptr : Heap_Ptr) return Memtyp
is
function To_Type_Acc is new Ada.Unchecked_Conversion
(Memory_Ptr, Type_Acc);
Slot : constant Heap_Slot := Get_Index (Ptr);
E : Heap_Entry renames Heap_Table.Table (Slot);
begin
return (To_Type_Acc (E.Typ), E.Ptr + Prefix_Size);
end Synth_Dereference;
procedure Free (Obj : in out Heap_Entry) is
begin
-- TODO
Obj := (null, null);
end Free;
procedure Synth_Deallocate (Ptr : Heap_Ptr)
is
Slot : constant Heap_Slot := Get_Index (Ptr);
begin
if Heap_Table.Table (Slot).Ptr = null then
return;
end if;
Free (Heap_Table.Table (Slot));
end Synth_Deallocate;
end Elab.Vhdl_Heap;
|
