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 -- $Revision: 1.2.10.1 $
11 -- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
34 ------------------------------------------------------------------------------
36 with System
.Finalization_Root
;
38 package System
.Finalization_Implementation
is
39 pragma Elaborate_Body
(Finalization_Implementation
);
41 package SFR
renames System
.Finalization_Root
;
43 ------------------------------------------------
44 -- Finalization Management Abstract Interface --
45 ------------------------------------------------
47 Global_Final_List
: SFR
.Finalizable_Ptr
;
48 -- This list stores the controlled objects defined in library-level
49 -- packages. They will be finalized after the main program completion.
51 procedure Finalize_Global_List
;
52 -- The procedure to be called in order to finalize the global list;
54 procedure Attach_To_Final_List
55 (L
: in out SFR
.Finalizable_Ptr
;
56 Obj
: in out SFR
.Finalizable
;
57 Nb_Link
: Short_Short_Integer);
58 -- Attach finalizable object Obj to the linked list L. Nb_Link controls
59 -- the number of link of the linked_list, and can be either 0 for no
60 -- attachement, 1 for simple linked lists or 2 for doubly linked lists
61 -- or even 3 for a simple attachement of a whole array of elements.
62 -- Attachement to a simply linked list is not protected against
63 -- concurrent access and should only be used in context where it
64 -- doesn't matter, such as for objects allocated on the stack. In the
65 -- case of an attachment on a doubly linked list, L must not be null
66 -- and Obj will be inserted AFTER the first element and the attachment
67 -- is protected against concurrent call. Typically used to attach to
68 -- a dynamically allocated object to a List_Controller (whose first
69 -- element is always a dummy element)
71 procedure Finalize_List
(L
: SFR
.Finalizable_Ptr
);
72 -- Call Finalize on each element of the list L;
74 procedure Finalize_One
(Obj
: in out SFR
.Finalizable
);
75 -- Call Finalize on Obj and remove its final list.
81 procedure Deep_Tag_Initialize
82 (L
: in out SFR
.Finalizable_Ptr
;
84 B
: Short_Short_Integer);
85 -- Generic initialize for tagged objects with controlled components. A
86 -- is the address of the object, L the finalization list when it needs
87 -- to be attached and B the attachement level (see Attach_To_Final_List)
89 procedure Deep_Tag_Adjust
90 (L
: in out SFR
.Finalizable_Ptr
;
92 B
: Short_Short_Integer);
93 -- Generic adjust for tagged objects with controlled components. A
94 -- is the address of the object, L the finalization list when it needs
95 -- to be attached and B the attachement level (see Attach_To_Final_List)
97 procedure Deep_Tag_Finalize
98 (L
: in out SFR
.Finalizable_Ptr
;
101 -- Generic finalize for tagged objects with controlled components. A
102 -- is the address of the object, L the finalization list when it needs
103 -- to be attached and B the attachement level (see Attach_To_Final_List)
105 procedure Deep_Tag_Attach
106 (L
: in out SFR
.Finalizable_Ptr
;
108 B
: Short_Short_Integer);
109 -- Generic attachement for tagged objects with controlled components. A
110 -- is the address of the object, L the finalization list when it needs
111 -- to be attached and B the attachement level (see Attach_To_Final_List)
113 -----------------------------
114 -- Record Controller Types --
115 -----------------------------
117 -- Definition of the types of the controller component that is included
118 -- in records containing controlled components. This controller is
119 -- attached to the finalization chain of the upper-level and carries
120 -- the pointer of the finalization chain for the lower level
122 type Limited_Record_Controller
is new SFR
.Root_Controlled
with record
123 F
: SFR
.Finalizable_Ptr
;
126 procedure Initialize
(Object
: in out Limited_Record_Controller
);
129 procedure Finalize
(Object
: in out Limited_Record_Controller
);
130 -- Finalize the controlled components of the enclosing record by
131 -- following the list starting at Object.F
133 type Record_Controller
is
134 new Limited_Record_Controller
with record
135 My_Address
: System
.Address
;
138 procedure Initialize
(Object
: in out Record_Controller
);
139 -- Initialize the field My_Address to the Object'Address
141 procedure Adjust
(Object
: in out Record_Controller
);
142 -- Adjust the components and their finalization pointers by subtracting
143 -- by the offset of the target and the source addresses of the assignment
145 -- Inherit Finalize from Limited_Record_Controller
147 procedure Detach_From_Final_List
(Obj
: in out SFR
.Finalizable
);
148 -- Remove the specified object from its Final list which must be a
149 -- doubly linked list.
151 end System
.Finalization_Implementation
;