From 5fc2b23c0a27e281d3c1f1927379aa1fd9300df0 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 29 Jun 2019 03:59:12 +0200 Subject: ghdl_jit: almost add ghdlsynth --- src/areapools.adb | 147 ++++++++++++++++++++++++++++++++++++++++ src/areapools.ads | 87 ++++++++++++++++++++++++ src/ghdldrv/ghdl_jit.adb | 2 + src/vhdl/simulate/areapools.adb | 147 ---------------------------------------- src/vhdl/simulate/areapools.ads | 87 ------------------------ 5 files changed, 236 insertions(+), 234 deletions(-) create mode 100644 src/areapools.adb create mode 100644 src/areapools.ads delete mode 100644 src/vhdl/simulate/areapools.adb delete mode 100644 src/vhdl/simulate/areapools.ads (limited to 'src') diff --git a/src/areapools.adb b/src/areapools.adb new file mode 100644 index 000000000..341b14240 --- /dev/null +++ b/src/areapools.adb @@ -0,0 +1,147 @@ +-- Area based memory manager +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Unchecked_Deallocation; + +package body Areapools is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Chunk_Type, Chunk_Acc); + + Free_Chunks : Chunk_Acc; + + function Get_Chunk return Chunk_Acc is + Res : Chunk_Acc; + begin + if Free_Chunks /= null then + Res := Free_Chunks; + Free_Chunks := Res.Prev; + return Res; + else + return new Chunk_Type (Default_Chunk_Size - 1); + end if; + end Get_Chunk; + + procedure Free_Chunk (Chunk : Chunk_Acc) is + begin + Chunk.Prev := Free_Chunks; + Free_Chunks := Chunk; + end Free_Chunk; + + procedure Allocate (Pool : in out Areapool; + Res : out Address; + Size : Size_Type; + Align : Size_Type) + is + Align_M1 : constant Size_Type := Align - 1; + + function Do_Align (X : Size_Type) return Size_Type is + begin + return (X + Align_M1) and not Align_M1; + end Do_Align; + + Chunk : Chunk_Acc; + begin + -- Need to allocate a new chunk if there is no current chunk, or not + -- enough room in the current chunk. + if Pool.Last = null + or else Do_Align (Pool.Next_Use) + Size > Pool.Last.Last + then + if Size > Default_Chunk_Size then + Chunk := new Chunk_Type (Size - 1); + else + Chunk := Get_Chunk; + end if; + Chunk.Prev := Pool.Last; + Pool.Next_Use := 0; + if Pool.First = null then + Pool.First := Chunk; + end if; + Pool.Last := Chunk; + else + Chunk := Pool.Last; + Pool.Next_Use := Do_Align (Pool.Next_Use); + end if; + Res := Chunk.Data (Pool.Next_Use)'Address; + Pool.Next_Use := Pool.Next_Use + Size; + end Allocate; + + procedure Mark (M : out Mark_Type; Pool : Areapool) is + begin + M := (Last => Pool.Last, Next_Use => Pool.Next_Use); + end Mark; + + procedure Release (M : Mark_Type; Pool : in out Areapool) + is + Chunk : Chunk_Acc; + Prev : Chunk_Acc; + begin + Chunk := Pool.Last; + while Chunk /= M.Last loop + if Erase_When_Released then + Chunk.Data := (others => 16#DE#); + end if; + + Prev := Chunk.Prev; + if Chunk.Last = Default_Chunk_Size - 1 then + Free_Chunk (Chunk); + else + Deallocate (Chunk); + end if; + Chunk := Prev; + end loop; + + if Erase_When_Released + and then M.Last /= null + then + declare + Last : Size_Type; + begin + if Pool.Last = M.Last then + Last := Pool.Next_Use - 1; + else + Last := Chunk.Data'Last; + end if; + Chunk.Data (M.Next_Use .. Last) := (others => 16#DE#); + end; + end if; + + Pool.Last := M.Last; + Pool.Next_Use := M.Next_Use; + end Release; + + function Is_Empty (Pool : Areapool) return Boolean is + begin + return Pool.Last = null; + end Is_Empty; + + function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T) + return System.Address + is + Res : Address; + begin + Allocate (Pool.all, Res, T'Size / Storage_Unit, T'Alignment); + declare + Addr1 : constant Address := Res; + Init : T := Val; + for Init'Address use Addr1; + begin + null; + end; + return Res; + end Alloc_On_Pool_Addr; +end Areapools; diff --git a/src/areapools.ads b/src/areapools.ads new file mode 100644 index 000000000..186f29707 --- /dev/null +++ b/src/areapools.ads @@ -0,0 +1,87 @@ +-- Area based memory manager +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with System; use System; +with System.Storage_Elements; use System.Storage_Elements; + +package Areapools is + type Areapool is limited private; + type Mark_Type is private; + + type Areapool_Acc is access all Areapool; + + -- Modular type for the size. We don't use Storage_Offset in order to + -- make alignment computation efficient (knowing that alignment is a + -- power of two). + type Size_Type is mod System.Memory_Size; + + -- Allocate SIZE bytes (aligned on ALIGN bytes) in memory pool POOL and + -- return the address in RES. + procedure Allocate (Pool : in out Areapool; + Res : out Address; + Size : Size_Type; + Align : Size_Type); + + -- Return TRUE iff no memory is allocated in POOL. + function Is_Empty (Pool : Areapool) return Boolean; + + -- Higher level abstraction for Allocate. + generic + type T is private; + function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T) + return System.Address; + + -- Get a mark of POOL. + procedure Mark (M : out Mark_Type; + Pool : Areapool); + + -- Release memory allocated in POOL after mark M. + procedure Release (M : Mark_Type; + Pool : in out Areapool); + + Empty_Marker : constant Mark_Type; +private + -- Minimal size of allocation. + Default_Chunk_Size : constant Size_Type := 16 * 1024; + + type Chunk_Type; + type Chunk_Acc is access all Chunk_Type; + + type Data_Array is array (Size_Type range <>) of Storage_Element; + for Data_Array'Alignment use Standard'Maximum_Alignment; + + type Chunk_Type (Last : Size_Type) is record + Prev : Chunk_Acc; + Data : Data_Array (0 .. Last); + end record; + for Chunk_Type'Alignment use Standard'Maximum_Alignment; + + type Areapool is limited record + First, Last : Chunk_Acc := null; + Next_Use : Size_Type; + end record; + + type Mark_Type is record + Last : Chunk_Acc := null; + Next_Use : Size_Type; + end record; + + Empty_Marker : constant Mark_Type := (Last => null, Next_Use => 0); + + Erase_When_Released : constant Boolean := True; +end Areapools; diff --git a/src/ghdldrv/ghdl_jit.adb b/src/ghdldrv/ghdl_jit.adb index d17e7fad4..5da726e10 100644 --- a/src/ghdldrv/ghdl_jit.adb +++ b/src/ghdldrv/ghdl_jit.adb @@ -21,6 +21,7 @@ with Ghdlprint; with Ghdlrun; with Ghdlvpi; with Ghdlxml; +-- with Ghdlsynth; with Ortho_Jit; procedure Ghdl_Jit is @@ -34,6 +35,7 @@ begin Ghdlprint.Register_Commands; Ghdlvpi.Register_Commands; Ghdlxml.Register_Commands; + -- Ghdlsynth.Register_Commands; Ghdlmain.Register_Commands; Ghdlmain.Main; end Ghdl_Jit; diff --git a/src/vhdl/simulate/areapools.adb b/src/vhdl/simulate/areapools.adb deleted file mode 100644 index 341b14240..000000000 --- a/src/vhdl/simulate/areapools.adb +++ /dev/null @@ -1,147 +0,0 @@ --- Area based memory manager --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ada.Unchecked_Deallocation; - -package body Areapools is - procedure Deallocate is new Ada.Unchecked_Deallocation - (Chunk_Type, Chunk_Acc); - - Free_Chunks : Chunk_Acc; - - function Get_Chunk return Chunk_Acc is - Res : Chunk_Acc; - begin - if Free_Chunks /= null then - Res := Free_Chunks; - Free_Chunks := Res.Prev; - return Res; - else - return new Chunk_Type (Default_Chunk_Size - 1); - end if; - end Get_Chunk; - - procedure Free_Chunk (Chunk : Chunk_Acc) is - begin - Chunk.Prev := Free_Chunks; - Free_Chunks := Chunk; - end Free_Chunk; - - procedure Allocate (Pool : in out Areapool; - Res : out Address; - Size : Size_Type; - Align : Size_Type) - is - Align_M1 : constant Size_Type := Align - 1; - - function Do_Align (X : Size_Type) return Size_Type is - begin - return (X + Align_M1) and not Align_M1; - end Do_Align; - - Chunk : Chunk_Acc; - begin - -- Need to allocate a new chunk if there is no current chunk, or not - -- enough room in the current chunk. - if Pool.Last = null - or else Do_Align (Pool.Next_Use) + Size > Pool.Last.Last - then - if Size > Default_Chunk_Size then - Chunk := new Chunk_Type (Size - 1); - else - Chunk := Get_Chunk; - end if; - Chunk.Prev := Pool.Last; - Pool.Next_Use := 0; - if Pool.First = null then - Pool.First := Chunk; - end if; - Pool.Last := Chunk; - else - Chunk := Pool.Last; - Pool.Next_Use := Do_Align (Pool.Next_Use); - end if; - Res := Chunk.Data (Pool.Next_Use)'Address; - Pool.Next_Use := Pool.Next_Use + Size; - end Allocate; - - procedure Mark (M : out Mark_Type; Pool : Areapool) is - begin - M := (Last => Pool.Last, Next_Use => Pool.Next_Use); - end Mark; - - procedure Release (M : Mark_Type; Pool : in out Areapool) - is - Chunk : Chunk_Acc; - Prev : Chunk_Acc; - begin - Chunk := Pool.Last; - while Chunk /= M.Last loop - if Erase_When_Released then - Chunk.Data := (others => 16#DE#); - end if; - - Prev := Chunk.Prev; - if Chunk.Last = Default_Chunk_Size - 1 then - Free_Chunk (Chunk); - else - Deallocate (Chunk); - end if; - Chunk := Prev; - end loop; - - if Erase_When_Released - and then M.Last /= null - then - declare - Last : Size_Type; - begin - if Pool.Last = M.Last then - Last := Pool.Next_Use - 1; - else - Last := Chunk.Data'Last; - end if; - Chunk.Data (M.Next_Use .. Last) := (others => 16#DE#); - end; - end if; - - Pool.Last := M.Last; - Pool.Next_Use := M.Next_Use; - end Release; - - function Is_Empty (Pool : Areapool) return Boolean is - begin - return Pool.Last = null; - end Is_Empty; - - function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T) - return System.Address - is - Res : Address; - begin - Allocate (Pool.all, Res, T'Size / Storage_Unit, T'Alignment); - declare - Addr1 : constant Address := Res; - Init : T := Val; - for Init'Address use Addr1; - begin - null; - end; - return Res; - end Alloc_On_Pool_Addr; -end Areapools; diff --git a/src/vhdl/simulate/areapools.ads b/src/vhdl/simulate/areapools.ads deleted file mode 100644 index 186f29707..000000000 --- a/src/vhdl/simulate/areapools.ads +++ /dev/null @@ -1,87 +0,0 @@ --- Area based memory manager --- Copyright (C) 2014 Tristan Gingold --- --- GHDL 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, or (at your option) any later --- version. --- --- GHDL 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with System; use System; -with System.Storage_Elements; use System.Storage_Elements; - -package Areapools is - type Areapool is limited private; - type Mark_Type is private; - - type Areapool_Acc is access all Areapool; - - -- Modular type for the size. We don't use Storage_Offset in order to - -- make alignment computation efficient (knowing that alignment is a - -- power of two). - type Size_Type is mod System.Memory_Size; - - -- Allocate SIZE bytes (aligned on ALIGN bytes) in memory pool POOL and - -- return the address in RES. - procedure Allocate (Pool : in out Areapool; - Res : out Address; - Size : Size_Type; - Align : Size_Type); - - -- Return TRUE iff no memory is allocated in POOL. - function Is_Empty (Pool : Areapool) return Boolean; - - -- Higher level abstraction for Allocate. - generic - type T is private; - function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T) - return System.Address; - - -- Get a mark of POOL. - procedure Mark (M : out Mark_Type; - Pool : Areapool); - - -- Release memory allocated in POOL after mark M. - procedure Release (M : Mark_Type; - Pool : in out Areapool); - - Empty_Marker : constant Mark_Type; -private - -- Minimal size of allocation. - Default_Chunk_Size : constant Size_Type := 16 * 1024; - - type Chunk_Type; - type Chunk_Acc is access all Chunk_Type; - - type Data_Array is array (Size_Type range <>) of Storage_Element; - for Data_Array'Alignment use Standard'Maximum_Alignment; - - type Chunk_Type (Last : Size_Type) is record - Prev : Chunk_Acc; - Data : Data_Array (0 .. Last); - end record; - for Chunk_Type'Alignment use Standard'Maximum_Alignment; - - type Areapool is limited record - First, Last : Chunk_Acc := null; - Next_Use : Size_Type; - end record; - - type Mark_Type is record - Last : Chunk_Acc := null; - Next_Use : Size_Type; - end record; - - Empty_Marker : constant Mark_Type := (Last => null, Next_Use => 0); - - Erase_When_Released : constant Boolean := True; -end Areapools; -- cgit v1.2.3