File : s-cmallo-zfp.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . C . M A L L O C --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2011-2012, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29
30 -- --
31 ------------------------------------------------------------------------------
32
33 -- A simple implementation of storage allocation (malloc etc) for ZFP use
34
35 pragma Restrictions (No_Elaboration_Code);
36
37 package System.C.Malloc is
38 pragma Preelaborate;
39
40 function Alloc (Size : size_t) return Address;
41 pragma Export (C, Alloc, "malloc");
42
43 procedure Free (Ptr : Address);
44 pragma Export (C, Free, "free");
45
46 function Realloc (Ptr : Address; Size : size_t) return Address;
47 pragma Export (C, Realloc, "realloc");
48
49 private
50 -- The basic implementation structures are made private in the spec so
51 -- that a child package could add extensions (statistics, consistency
52 -- checks...)
53
54 type Cell_Type;
55 -- A cell is the header before the chunk of memory. This implementation
56 -- uses doubly-linked list of cells.
57
58 type Cell_Acc is access Cell_Type;
59 pragma No_Strict_Aliasing (Cell_Acc);
60 -- Get rid of strict aliasing error message because we will convert this
61 -- access type to address and Free_Cell_Acc.
62
63 subtype Cell_Size_T is size_t
64 range 0 .. 2 ** (Standard'Address_Size - 2);
65
66 type Cell_Type is record
67 Prev : Cell_Acc;
68 -- The cell just before this one or null if this is the first cell.
69 -- There is no Next as this can be deduced from Size.
70
71 Size : Cell_Size_T;
72 -- Size of this cell rounded up to multiple of Max_Alignment
73
74 Free : Boolean;
75 -- Status flag, used to coalize blocks
76 end record;
77 pragma Pack (Cell_Type);
78 for Cell_Type'Size use 2 * Standard'Address_Size;
79 for Cell_Type'Alignment use Standard'Maximum_Alignment;
80
81 type Free_Cell_Type;
82 type Free_Cell_Acc is access Free_Cell_Type;
83 pragma No_Strict_Aliasing (Free_Cell_Acc);
84 -- Get rid of strict aliasing error message because we will convert this
85 -- access type to address and Cell_Acc.
86
87 type Free_Cell_Type is record
88 Cell : Cell_Type;
89 -- Free cells have two additional fields over busy cells
90
91 Prev_Free : Free_Cell_Acc;
92 Next_Free : Free_Cell_Acc;
93 -- Doubly linked list of free blocks
94 end record;
95
96 Free_List : Free_Cell_Acc;
97 -- Linked list of free cells ordered by increasing size
98
99 function Get_First_Cell return Cell_Acc;
100 -- The first cell. Valid only if the heap is not empty (which can be
101 -- checked with Last_Cell).
102
103 Last_Cell : Cell_Acc;
104 -- Last allocated cell (it must not be a free cell)
105
106 function Get_Next_Cell (Cell : Cell_Acc) return Cell_Acc;
107 -- Next adjacent cell
108 end System.C.Malloc;