summaryrefslogtreecommitdiff
path: root/simulate/areapools.adb
diff options
context:
space:
mode:
authorTristan Gingold2014-11-04 20:14:19 +0100
committerTristan Gingold2014-11-04 20:14:19 +0100
commit9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch)
tree575346e529b99e26382b4a06f6ff2caa0b391ab2 /simulate/areapools.adb
parent184a123f91e07c927292d67462561dc84f3a920d (diff)
downloadghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip
Move sources to src/ subdirectory.
Diffstat (limited to 'simulate/areapools.adb')
-rw-r--r--simulate/areapools.adb147
1 files changed, 0 insertions, 147 deletions
diff --git a/simulate/areapools.adb b/simulate/areapools.adb
deleted file mode 100644
index 341b142..0000000
--- a/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;