]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- E X P _ C H 7 -- | |
6 | -- -- | |
7 | -- S p e c -- | |
8 | -- -- | |
df3e68b1 | 9 | -- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- |
70482933 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
70482933 RK |
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 -- | |
b5c84c3c RD |
18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
70482933 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
dbe13a37 | 26 | with Namet; use Namet; |
70482933 RK |
27 | with Types; use Types; |
28 | ||
29 | package Exp_Ch7 is | |
30 | ||
31 | procedure Expand_N_Package_Body (N : Node_Id); | |
32 | procedure Expand_N_Package_Declaration (N : Node_Id); | |
33 | ||
0da2c8ac AC |
34 | ----------------------------- |
35 | -- Finalization Management -- | |
36 | ----------------------------- | |
70482933 | 37 | |
70482933 RK |
38 | procedure Build_Controlling_Procs (Typ : Entity_Id); |
39 | -- Typ is a record, and array type having controlled components. | |
40 | -- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize | |
41 | -- that take care of finalization management at run-time. | |
42 | ||
df3e68b1 HK |
43 | procedure Build_Finalization_Collection |
44 | (Typ : Entity_Id; | |
45 | Ins_Node : Node_Id := Empty; | |
46 | Encl_Scope : Entity_Id := Empty); | |
47 | -- Build a finalization collection for an access type. The designated type | |
48 | -- may not necessarely be controlled or need finalization actions. The | |
49 | -- routine creates a wrapper around a user-defined storage pool or the | |
50 | -- general storage pool for access types. Ins_Nod and Encl_Scope are used | |
51 | -- in conjunction with anonymous access types. Ins_Node designates the | |
52 | -- insertion point before which the collection should be added. Encl_Scope | |
53 | -- is the scope of the context, either the enclosing record or the scope | |
54 | -- of the related function. | |
55 | ||
07fc65c4 GB |
56 | procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id); |
57 | -- Build one controlling procedure when a late body overrides one of | |
58 | -- the controlling operations. | |
59 | ||
f9ad6b62 AC |
60 | function Build_Object_Declarations |
61 | (Loc : Source_Ptr; | |
62 | Abort_Id : Entity_Id; | |
63 | E_Id : Entity_Id; | |
64 | Raised_Id : Entity_Id) return List_Id; | |
65 | -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a | |
66 | -- list containing the object declarations of boolean flag Abort_Id, the | |
67 | -- exception occurrence E_Id and boolean flag Raised_Id. | |
68 | -- | |
69 | -- Abort_Id : constant Boolean := | |
70 | -- Exception_Identity (Get_Current_Excep.all) = | |
71 | -- Standard'Abort_Signal'Identity; | |
72 | -- <or> | |
73 | -- Abort_Id : constant Boolean := False; -- no abort | |
74 | -- | |
75 | -- E_Id : Exception_Occurrence; | |
76 | -- Raised_Id : Boolean := False; | |
77 | ||
df3e68b1 | 78 | function Build_Raise_Statement |
f9ad6b62 AC |
79 | (Loc : Source_Ptr; |
80 | Abort_Id : Entity_Id; | |
81 | E_Id : Entity_Id; | |
82 | Raised_Id : Entity_Id) return Node_Id; | |
df3e68b1 HK |
83 | -- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_ |
84 | -- Deep_Record_Body. Generate the following conditional raise statement: | |
85 | -- | |
f9ad6b62 AC |
86 | -- if Raised_Id then |
87 | -- Raise_From_Controlled_Operation (E_Id, Abort_Id); | |
df3e68b1 HK |
88 | -- end if; |
89 | -- | |
f9ad6b62 AC |
90 | -- Abort_Id is a local boolean flag which is set when the finalization was |
91 | -- triggered by an abort, E_Id denotes the defining identifier of a local | |
92 | -- exception occurrence, Raised_Id is the entity of a local boolean flag. | |
70482933 | 93 | |
048e5cef BD |
94 | function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean; |
95 | -- True if T is a class-wide type, or if it has controlled parts ("part" | |
96 | -- means T or any of its subcomponents). This is the same as | |
97 | -- Needs_Finalization, except when pragma Restrictions (No_Finalization) | |
98 | -- applies, in which case we know that class-wide objects do not contain | |
99 | -- controlled parts. | |
afe4375b | 100 | |
6367dd30 AC |
101 | function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id; |
102 | -- Return the pool id for access type T. This is generally the node | |
103 | -- corresponding to System.Global_Pool.Global_Pool_Object except on | |
104 | -- VMS if the access size is 32. | |
105 | ||
70482933 | 106 | function Has_New_Controlled_Component (E : Entity_Id) return Boolean; |
8fc789c8 | 107 | -- E is a type entity. Give the same result as Has_Controlled_Component |
70482933 RK |
108 | -- except for tagged extensions where the result is True only if the |
109 | -- latest extension contains a controlled component. | |
110 | ||
70482933 | 111 | function Make_Adjust_Call |
df3e68b1 HK |
112 | (Obj_Ref : Node_Id; |
113 | Typ : Entity_Id; | |
114 | For_Parent : Boolean := False) return Node_Id; | |
115 | -- Create a call to either Adjust or Deep_Adjust depending on the structure | |
116 | -- of type Typ. Obj_Ref is an expression with no-side effect (not required | |
117 | -- to have been previously analyzed) that references the object to be | |
118 | -- adjusted. Typ is the expected type of Obj_Ref. Flag For_Parent must be | |
119 | -- set when an adjustment call is being created for field _parent. | |
70482933 | 120 | |
deb8dacc HK |
121 | function Make_Attach_Call |
122 | (Obj_Ref : Node_Id; | |
123 | Ptr_Typ : Entity_Id) return Node_Id; | |
124 | -- Create a call to prepend an object to a finalization collection. Obj_Ref | |
125 | -- is the object, Ptr_Typ is the access type that owns the collection. | |
126 | -- Generate the following: | |
2c1b72d7 | 127 | -- |
deb8dacc HK |
128 | -- Ada.Finalization.Heap_Managment.Attach |
129 | -- (<Ptr_Typ>FC, | |
130 | -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); | |
131 | ||
132 | function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id; | |
133 | -- Create a call to unhook an object from an arbitrary list. Obj_Ref is the | |
134 | -- object. Generate the following: | |
2c1b72d7 | 135 | -- |
deb8dacc HK |
136 | -- Ada.Finalization.Heap_Management.Detach |
137 | -- (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); | |
138 | ||
70482933 | 139 | function Make_Final_Call |
df3e68b1 HK |
140 | (Obj_Ref : Node_Id; |
141 | Typ : Entity_Id; | |
142 | For_Parent : Boolean := False) return Node_Id; | |
143 | -- Create a call to either Finalize or Deep_Finalize depending on the | |
144 | -- structure of type Typ. Obj_Ref is an expression (with no-side effect and | |
145 | -- is not required to have been previously analyzed) that references the | |
146 | -- object to be finalized. Typ is the expected type of Obj_Ref. Flag For_ | |
147 | -- Parent must be set when a finalization call is being created for field | |
148 | -- _parent. | |
149 | ||
150 | procedure Make_Finalize_Address_Body (Typ : Entity_Id); | |
151 | -- Create the body of TSS routine Finalize_Address if Typ is controlled and | |
152 | -- does not have a TSS entry for Finalize_Address. The procedure converts | |
153 | -- an address into a pointer and subsequently calls Deep_Finalize on the | |
154 | -- dereference. | |
155 | ||
156 | function Make_Init_Call | |
157 | (Obj_Ref : Node_Id; | |
158 | Typ : Entity_Id) return Node_Id; | |
159 | -- Obj_Ref is an expression with no-side effect (not required to have been | |
160 | -- previously analyzed) that references the object to be initialized. Typ | |
161 | -- is the expected type of Obj_Ref, which is either a controlled type | |
162 | -- (Is_Controlled) or a type with controlled components (Has_Controlled_ | |
163 | -- Components). | |
70482933 | 164 | |
dbe13a37 ES |
165 | function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id; |
166 | -- Generate an implicit exception handler with an 'others' choice, | |
167 | -- converting any occurrence to a raise of Program_Error. | |
168 | ||
df3e68b1 HK |
169 | function Make_Local_Deep_Finalize |
170 | (Typ : Entity_Id; | |
171 | Nam : Entity_Id) return Node_Id; | |
172 | -- Create a special version of Deep_Finalize with identifier Nam. The | |
173 | -- routine has state information and can parform partial finalization. | |
174 | ||
175 | function Make_Set_Finalize_Address_Ptr_Call | |
176 | (Loc : Source_Ptr; | |
177 | Typ : Entity_Id; | |
178 | Ptr_Typ : Entity_Id) return Node_Id; | |
179 | -- Generate the following call: | |
180 | -- | |
181 | -- Set_Finalize_Address_Ptr (<Ptr_Typ>FC, <Typ>FD'Unrestricted_Access); | |
182 | -- | |
183 | -- where Finalize_Address is the corresponding TSS primitive of type Typ | |
184 | -- and Ptr_Typ is the access type of the related allocation. Loc is the | |
185 | -- source location of the related allocator. | |
77cde610 | 186 | |
fbf5a39b AC |
187 | -------------------------------------------- |
188 | -- Task and Protected Object finalization -- | |
189 | -------------------------------------------- | |
190 | ||
191 | function Cleanup_Array | |
0da2c8ac AC |
192 | (N : Node_Id; |
193 | Obj : Node_Id; | |
194 | Typ : Entity_Id) return List_Id; | |
afe4375b ES |
195 | -- Generate loops to finalize any tasks or simple protected objects that |
196 | -- are subcomponents of an array. | |
fbf5a39b AC |
197 | |
198 | function Cleanup_Protected_Object | |
0da2c8ac AC |
199 | (N : Node_Id; |
200 | Ref : Node_Id) return Node_Id; | |
9de61fcb | 201 | -- Generate code to finalize a protected object without entries |
fbf5a39b AC |
202 | |
203 | function Cleanup_Record | |
0da2c8ac AC |
204 | (N : Node_Id; |
205 | Obj : Node_Id; | |
206 | Typ : Entity_Id) return List_Id; | |
fbf5a39b AC |
207 | -- For each subcomponent of a record that contains tasks or simple |
208 | -- protected objects, generate the appropriate finalization call. | |
209 | ||
210 | function Cleanup_Task | |
0da2c8ac AC |
211 | (N : Node_Id; |
212 | Ref : Node_Id) return Node_Id; | |
9de61fcb | 213 | -- Generate code to finalize a task |
fbf5a39b AC |
214 | |
215 | function Has_Simple_Protected_Object (T : Entity_Id) return Boolean; | |
9de61fcb | 216 | -- Check whether composite type contains a simple protected component |
fbf5a39b AC |
217 | |
218 | function Is_Simple_Protected_Type (T : Entity_Id) return Boolean; | |
df3e68b1 HK |
219 | -- Determine whether T denotes a protected type without entires whose |
220 | -- _object field is of type System.Tasking.Protected_Objects.Protection. | |
fbf5a39b | 221 | |
70482933 RK |
222 | -------------------------------- |
223 | -- Transient Scope Management -- | |
224 | -------------------------------- | |
225 | ||
226 | procedure Expand_Cleanup_Actions (N : Node_Id); | |
227 | -- Expand the necessary stuff into a scope to enable finalization of local | |
228 | -- objects and deallocation of transient data when exiting the scope. N is | |
229 | -- a "scope node" that is to say one of the following: N_Block_Statement, | |
230 | -- N_Subprogram_Body, N_Task_Body, N_Entry_Body. | |
231 | ||
232 | procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean); | |
233 | -- Push a new transient scope on the scope stack. N is the node responsible | |
234 | -- for the need of a transient scope. If Sec_Stack is True then the | |
235 | -- secondary stack is brought in, otherwise it isn't. | |
236 | ||
237 | function Node_To_Be_Wrapped return Node_Id; | |
df3e68b1 | 238 | -- Return the node to be wrapped if the current scope is transient |
70482933 RK |
239 | |
240 | procedure Store_Before_Actions_In_Scope (L : List_Id); | |
afe4375b | 241 | -- Append the list L of actions to the end of the before-actions store in |
2287a75d | 242 | -- the top of the scope stack. |
70482933 RK |
243 | |
244 | procedure Store_After_Actions_In_Scope (L : List_Id); | |
afe4375b | 245 | -- Append the list L of actions to the beginning of the after-actions store |
2287a75d | 246 | -- in the top of the scope stack. |
70482933 RK |
247 | |
248 | procedure Wrap_Transient_Declaration (N : Node_Id); | |
249 | -- N is an object declaration. Expand the finalization calls after the | |
8fc789c8 | 250 | -- declaration and make the outer scope being the transient one. |
70482933 RK |
251 | |
252 | procedure Wrap_Transient_Expression (N : Node_Id); | |
253 | -- N is a sub-expression. Expand a transient block around an expression | |
254 | ||
255 | procedure Wrap_Transient_Statement (N : Node_Id); | |
256 | -- N is a statement. Expand a transient block around an instruction | |
257 | ||
258 | end Exp_Ch7; |