1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . F I N A L I Z A T I O N _ I M P L E M E N T A T I O N --
9 -- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Unchecked_Conversion
;
36 with System
.Storage_Elements
;
37 with System
.Finalization_Root
;
39 package System
.Finalization_Implementation
is
40 pragma Elaborate_Body
;
42 package SSE
renames System
.Storage_Elements
;
43 package SFR
renames System
.Finalization_Root
;
45 ------------------------------------------------
46 -- Finalization Management Abstract Interface --
47 ------------------------------------------------
49 function To_Finalizable_Ptr
is new Ada
.Unchecked_Conversion
50 (Source
=> System
.Address
, Target
=> SFR
.Finalizable_Ptr
);
52 Collection_Finalization_Started
: constant SFR
.Finalizable_Ptr
:=
53 To_Finalizable_Ptr
(SSE
.To_Address
(1));
54 -- This is used to implement the rule in RM-4.8(10.2/2) that requires an
55 -- allocator to raise Program_Error if the collection finalization has
56 -- already started. See also Ada.Finalization.List_Controller. Finalize on
57 -- List_Controller first sets the list to Collection_Finalization_Started,
58 -- to indicate that finalization has started. An allocator will call
59 -- Attach_To_Final_List, which checks for the special value and raises
60 -- Program_Error if appropriate. The value of
61 -- Collection_Finalization_Started must be different from 'Access of any
62 -- finalizable object, and different from null. See AI-280.
64 Global_Final_List
: SFR
.Finalizable_Ptr
;
65 -- This list stores the controlled objects defined in library-level
66 -- packages. They will be finalized after the main program completion.
68 procedure Finalize_Global_List
;
69 -- The procedure to be called in order to finalize the global list;
71 procedure Attach_To_Final_List
72 (L
: in out SFR
.Finalizable_Ptr
;
73 Obj
: in out SFR
.Finalizable
;
74 Nb_Link
: Short_Short_Integer);
75 -- Attach finalizable object Obj to the linked list L. Nb_Link controls
76 -- the number of link of the linked_list, and can be either 0 for no
77 -- attachement, 1 for simple linked lists or 2 for doubly linked lists
78 -- or even 3 for a simple attachement of a whole array of elements.
79 -- Attachement to a simply linked list is not protected against
80 -- concurrent access and should only be used in contexts where it
81 -- doesn't matter, such as for objects allocated on the stack. In the
82 -- case of an attachment on a doubly linked list, L must not be null
83 -- and Obj will be inserted AFTER the first element and the attachment
84 -- is protected against concurrent call. Typically used to attach to
85 -- a dynamically allocated object to a List_Controller (whose first
86 -- element is always a dummy element)
88 procedure Finalize_List
(L
: SFR
.Finalizable_Ptr
);
89 -- Call Finalize on each element of the list L;
91 procedure Finalize_One
(Obj
: in out SFR
.Finalizable
);
92 -- Call Finalize on Obj and remove its final list.
98 procedure Deep_Tag_Initialize
99 (L
: in out SFR
.Finalizable_Ptr
;
101 B
: Short_Short_Integer);
102 -- Generic initialize for tagged objects with controlled components.
103 -- A is the address of the object, L the finalization list when it needs
104 -- to be attached and B the attachement level (see Attach_To_Final_List).
106 procedure Deep_Tag_Adjust
107 (L
: in out SFR
.Finalizable_Ptr
;
109 B
: Short_Short_Integer);
110 -- Generic adjust for tagged objects with controlled components.
111 -- A is the address of the object, L the finalization list when it needs
112 -- to be attached and B the attachement level (see Attach_To_Final_List).
114 procedure Deep_Tag_Finalize
115 (L
: in out SFR
.Finalizable_Ptr
;
118 -- Generic finalize for tagged objects with controlled components.
119 -- A is the address of the object, L the finalization list when it needs
120 -- to be attached and B the attachement level (see Attach_To_Final_List).
122 procedure Deep_Tag_Attach
123 (L
: in out SFR
.Finalizable_Ptr
;
125 B
: Short_Short_Integer);
126 -- Generic attachement for tagged objects with controlled components.
127 -- A is the address of the object, L the finalization list when it needs
128 -- to be attached and B the attachement level (see Attach_To_Final_List).
130 -----------------------------
131 -- Record Controller Types --
132 -----------------------------
134 -- Definition of the types of the controller component that is included
135 -- in records containing controlled components. This controller is
136 -- attached to the finalization chain of the upper-level and carries
137 -- the pointer of the finalization chain for the lower level.
139 type Limited_Record_Controller
is new SFR
.Root_Controlled
with record
140 F
: SFR
.Finalizable_Ptr
;
143 procedure Initialize
(Object
: in out Limited_Record_Controller
);
146 procedure Finalize
(Object
: in out Limited_Record_Controller
);
147 -- Finalize the controlled components of the enclosing record by
148 -- following the list starting at Object.F.
150 type Record_Controller
is
151 new Limited_Record_Controller
with record
152 My_Address
: System
.Address
;
155 procedure Initialize
(Object
: in out Record_Controller
);
156 -- Initialize the field My_Address to the Object'Address
158 procedure Adjust
(Object
: in out Record_Controller
);
159 -- Adjust the components and their finalization pointers by subtracting
160 -- by the offset of the target and the source addresses of the assignment.
162 -- Inherit Finalize from Limited_Record_Controller
164 procedure Detach_From_Final_List
(Obj
: in out SFR
.Finalizable
);
165 -- Remove the specified object from its Final list, which must be a
166 -- doubly linked list.
168 end System
.Finalization_Implementation
;