7e492ad80070e600b67d505aff84ef84a8d05d48
[gcc.git] / gcc / ada / a-fihema.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- A D A . F I N A L I Z A T I O N . H E A P _ M A N A G E M E N T --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2008-2011, Free Software Foundation, Inc. --
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 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
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 with System;
33 with System.Storage_Elements;
34 with System.Storage_Pools;
35
36 package Ada.Finalization.Heap_Management is
37
38 -- A reference to any derivation of Root_Storage_Pool. Since this type may
39 -- not be used to allocate objects, its storage size is zero.
40
41 type Any_Storage_Pool_Ptr is
42 access System.Storage_Pools.Root_Storage_Pool'Class;
43 for Any_Storage_Pool_Ptr'Storage_Size use 0;
44
45 -- ??? Comment needed on overall mechanism
46
47 type Finalization_Collection is
48 new Ada.Finalization.Limited_Controlled with private;
49
50 type Finalization_Collection_Ptr is access all Finalization_Collection;
51 for Finalization_Collection_Ptr'Storage_Size use 0;
52
53 -- A reference used to describe primitive Finalize_Address
54
55 type Finalize_Address_Ptr is access procedure (Obj : System.Address);
56
57 -- Since RTSfind cannot contain names of the form RE_"+", the following
58 -- routine serves as a wrapper around System.Storage_Elements."+".
59
60 function Add_Offset_To_Address
61 (Addr : System.Address;
62 Offset : System.Storage_Elements.Storage_Offset) return System.Address;
63
64 procedure Allocate
65 (Collection : in out Finalization_Collection;
66 Addr : out System.Address;
67 Storage_Size : System.Storage_Elements.Storage_Count;
68 Alignment : System.Storage_Elements.Storage_Count;
69 Needs_Header : Boolean := True);
70 -- Allocate a chunk of memory described by Storage_Size and Alignment on
71 -- Collection's underlying storage pool. Return the address of the chunk.
72 -- The routine creates a list header which precedes the chunk of memory if
73 -- Needs_Header is True. If allocated, the header is attached to the
74 -- Collection's objects. The interface to this routine is provided by
75 -- Build_Allocate_Deallocate_Proc.
76
77 function Base_Pool
78 (Collection : Finalization_Collection) return Any_Storage_Pool_Ptr;
79 -- Return a reference to the underlying storage pool of Collection
80
81 procedure Deallocate
82 (Collection : in out Finalization_Collection;
83 Addr : System.Address;
84 Storage_Size : System.Storage_Elements.Storage_Count;
85 Alignment : System.Storage_Elements.Storage_Count;
86 Has_Header : Boolean := True);
87 -- Deallocate a chunk of memory described by Storage_Size and Alignment
88 -- from Collection's underlying storage pool. The beginning of the memory
89 -- chunk is designated by Addr. The routine detaches and destroys the
90 -- preceding list header if flag Has_Header is set. The interface to this
91 -- routine is provided by Build_Allocate_Deallocate_Proc.
92
93 overriding procedure Finalize
94 (Collection : in out Finalization_Collection);
95 -- Traverse the objects of Collection, invoking Finalize_Address on each of
96 -- them.
97
98 overriding procedure Initialize
99 (Collection : in out Finalization_Collection);
100 -- Initialize the finalization list to empty
101
102 procedure Set_Finalize_Address_Ptr
103 (Collection : in out Finalization_Collection;
104 Proc_Ptr : Finalize_Address_Ptr);
105 -- Set the finalization address routine of a finalization collection
106
107 procedure Set_Storage_Pool_Ptr
108 (Collection : in out Finalization_Collection;
109 Pool_Ptr : Any_Storage_Pool_Ptr);
110 -- Set the underlying storage pool of a finalization collection
111
112 private
113 -- Homogeneous collection types
114
115 type Node;
116 type Node_Ptr is access all Node;
117 pragma No_Strict_Aliasing (Node_Ptr);
118
119 type Node is record
120 -- This should really be limited, but we can see the full view of
121 -- Limited_Controlled, which NOT limited. If it were limited, we could
122 -- default initialize here, and get rid of Initialize for
123 -- Finalization_Collection.
124
125 Prev : Node_Ptr;
126 Next : Node_Ptr;
127 end record;
128
129 type Finalization_Collection is
130 new Ada.Finalization.Limited_Controlled with
131 record
132 Base_Pool : Any_Storage_Pool_Ptr;
133 -- All objects and node headers are allocated on this underlying pool;
134 -- the collection is simply a wrapper around it.
135
136 Objects : aliased Node;
137 -- The head of a doubly linked list containing all allocated objects
138 -- with controlled parts that still exist (Unchecked_Deallocation has
139 -- not been done on them).
140
141 Finalize_Address : Finalize_Address_Ptr;
142 -- A reference to a routine that finalizes an object denoted by its
143 -- address. The collection must be homogeneous since the same routine
144 -- will be invoked for every allocated object when the pool is
145 -- finalized.
146
147 Finalization_Started : Boolean := False;
148 pragma Atomic (Finalization_Started);
149 -- When the finalization of a collection takes place, any allocations of
150 -- objects with controlled or protected parts on the same collection are
151 -- prohibited and the action must raise Program_Error. This needs to be
152 -- atomic, because it is accessed without Lock_Task/Unlock_Task. See
153 -- RM-4.8(10.2/2).
154 end record;
155
156 procedure pcol (Collection : Finalization_Collection);
157 -- Output the contents of a collection in a readable form. Intended for
158 -- debugging purposes.
159
160 end Ada.Finalization.Heap_Management;