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-2003 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 System
.Finalization_Root
;
36 package System
.Finalization_Implementation
is
37 pragma Elaborate_Body
(Finalization_Implementation
);
39 package SFR
renames System
.Finalization_Root
;
41 ------------------------------------------------
42 -- Finalization Management Abstract Interface --
43 ------------------------------------------------
45 Global_Final_List
: SFR
.Finalizable_Ptr
;
46 -- This list stores the controlled objects defined in library-level
47 -- packages. They will be finalized after the main program completion.
49 procedure Finalize_Global_List
;
50 -- The procedure to be called in order to finalize the global list;
52 procedure Attach_To_Final_List
53 (L
: in out SFR
.Finalizable_Ptr
;
54 Obj
: in out SFR
.Finalizable
;
55 Nb_Link
: Short_Short_Integer);
56 -- Attach finalizable object Obj to the linked list L. Nb_Link controls
57 -- the number of link of the linked_list, and can be either 0 for no
58 -- attachement, 1 for simple linked lists or 2 for doubly linked lists
59 -- or even 3 for a simple attachement of a whole array of elements.
60 -- Attachement to a simply linked list is not protected against
61 -- concurrent access and should only be used in contexts where it
62 -- doesn't matter, such as for objects allocated on the stack. In the
63 -- case of an attachment on a doubly linked list, L must not be null
64 -- and Obj will be inserted AFTER the first element and the attachment
65 -- is protected against concurrent call. Typically used to attach to
66 -- a dynamically allocated object to a List_Controller (whose first
67 -- element is always a dummy element)
69 procedure Finalize_List
(L
: SFR
.Finalizable_Ptr
);
70 -- Call Finalize on each element of the list L;
72 procedure Finalize_One
(Obj
: in out SFR
.Finalizable
);
73 -- Call Finalize on Obj and remove its final list.
79 procedure Deep_Tag_Initialize
80 (L
: in out SFR
.Finalizable_Ptr
;
82 B
: Short_Short_Integer);
83 -- Generic initialize for tagged objects with controlled components.
84 -- A is the address of the object, L the finalization list when it needs
85 -- to be attached and B the attachement level (see Attach_To_Final_List).
87 procedure Deep_Tag_Adjust
88 (L
: in out SFR
.Finalizable_Ptr
;
90 B
: Short_Short_Integer);
91 -- Generic adjust for tagged objects with controlled components.
92 -- A is the address of the object, L the finalization list when it needs
93 -- to be attached and B the attachement level (see Attach_To_Final_List).
95 procedure Deep_Tag_Finalize
96 (L
: in out SFR
.Finalizable_Ptr
;
99 -- Generic finalize for tagged objects with controlled components.
100 -- A is the address of the object, L the finalization list when it needs
101 -- to be attached and B the attachement level (see Attach_To_Final_List).
103 procedure Deep_Tag_Attach
104 (L
: in out SFR
.Finalizable_Ptr
;
106 B
: Short_Short_Integer);
107 -- Generic attachement for tagged objects with controlled components.
108 -- A is the address of the object, L the finalization list when it needs
109 -- to be attached and B the attachement level (see Attach_To_Final_List).
111 -----------------------------
112 -- Record Controller Types --
113 -----------------------------
115 -- Definition of the types of the controller component that is included
116 -- in records containing controlled components. This controller is
117 -- attached to the finalization chain of the upper-level and carries
118 -- the pointer of the finalization chain for the lower level.
120 type Limited_Record_Controller
is new SFR
.Root_Controlled
with record
121 F
: SFR
.Finalizable_Ptr
;
124 procedure Initialize
(Object
: in out Limited_Record_Controller
);
127 procedure Finalize
(Object
: in out Limited_Record_Controller
);
128 -- Finalize the controlled components of the enclosing record by
129 -- following the list starting at Object.F.
131 type Record_Controller
is
132 new Limited_Record_Controller
with record
133 My_Address
: System
.Address
;
136 procedure Initialize
(Object
: in out Record_Controller
);
137 -- Initialize the field My_Address to the Object'Address
139 procedure Adjust
(Object
: in out Record_Controller
);
140 -- Adjust the components and their finalization pointers by substracting
141 -- by the offset of the target and the source addresses of the assignment.
143 -- Inherit Finalize from Limited_Record_Controller
145 procedure Detach_From_Final_List
(Obj
: in out SFR
.Finalizable
);
146 -- Remove the specified object from its Final list, which must be a
147 -- doubly linked list.
149 end System
.Finalization_Implementation
;