OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [exp_ch7.ads] - Blame information for rev 717

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              E X P _ C H 7                               --
6
--                                                                          --
7
--                                 S p e c                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-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.  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 COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Namet; use Namet;
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
 
34
   -----------------------------
35
   -- Finalization Management --
36
   -----------------------------
37
 
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
 
43
   --  Support of exceptions from user finalization procedures
44
 
45
   --  There is a specific mechanism to handle these exceptions, continue
46
   --  finalization and then raise PE. This mechanism is used by this package
47
   --  but also by exp_intr for Ada.Unchecked_Deallocation.
48
 
49
   --  There are 3 subprograms to use this mechanism, and the type
50
   --  Finalization_Exception_Data carries internal data between these
51
   --  subprograms:
52
   --
53
   --    1. Build_Object_Declaration: create the variables for the next two
54
   --       subprograms.
55
   --    2. Build_Exception_Handler: create the exception handler for a call
56
   --       to a user finalization procedure.
57
   --    3. Build_Raise_Stmt: create code to potentially raise a PE exception
58
   --       if an exception was raise in a user finalization procedure.
59
 
60
   type Finalization_Exception_Data is record
61
      Loc : Source_Ptr;
62
      --  Sloc for the added nodes
63
 
64
      Abort_Id : Entity_Id;
65
      --  Boolean variable set to true if the finalization was triggered by
66
      --  an abort.
67
 
68
      E_Id : Entity_Id;
69
      --  Variable containing the exception occurrence raised by user code
70
 
71
      Raised_Id : Entity_Id;
72
      --  Boolean variable set to true if an exception was raised in user code
73
   end record;
74
 
75
   function Build_Exception_Handler
76
     (Data        : Finalization_Exception_Data;
77
      For_Library : Boolean := False) return Node_Id;
78
   --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
79
   --  _Body. Create an exception handler of the following form:
80
   --
81
   --    when others =>
82
   --       if not Raised_Id then
83
   --          Raised_Id := True;
84
   --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
85
   --       end if;
86
   --
87
   --  If flag For_Library is set (and not in restricted profile):
88
   --
89
   --    when others =>
90
   --       if not Raised_Id then
91
   --          Raised_Id := True;
92
   --          Save_Library_Occurrence (Get_Current_Excep.all.all);
93
   --       end if;
94
   --
95
   --  E_Id denotes the defining identifier of a local exception occurrence.
96
   --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
97
   --  used when operating at the library level, when enabled the current
98
   --  exception will be saved to a global location.
99
 
100
   procedure Build_Finalization_Master
101
     (Typ        : Entity_Id;
102
      Ins_Node   : Node_Id := Empty;
103
      Encl_Scope : Entity_Id := Empty);
104
   --  Build a finalization master for an access type. The designated type may
105
   --  not necessarely be controlled or need finalization actions. The routine
106
   --  creates a wrapper around a user-defined storage pool or the general
107
   --  storage pool for access types. Ins_Nod and Encl_Scope are used in
108
   --  conjunction with anonymous access types. Ins_Node designates the
109
   --  insertion point before which the collection should be added. Encl_Scope
110
   --  is the scope of the context, either the enclosing record or the scope
111
   --  of the related function.
112
 
113
   procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
114
   --  Build one controlling procedure when a late body overrides one of
115
   --  the controlling operations.
116
 
117
   procedure Build_Object_Declarations
118
     (Data        : out Finalization_Exception_Data;
119
      Decls       : List_Id;
120
      Loc         : Source_Ptr;
121
      For_Package : Boolean := False);
122
   --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
123
   --  list List containing the object declarations of boolean flag Abort_Id,
124
   --  the exception occurrence E_Id and boolean flag Raised_Id.
125
   --
126
   --    Abort_Id  : constant Boolean :=
127
   --                  Exception_Identity (Get_Current_Excep.all) =
128
   --                    Standard'Abort_Signal'Identity;
129
   --      <or>
130
   --    Abort_Id  : constant Boolean := False;  --  no abort or For_Package
131
   --
132
   --    E_Id      : Exception_Occurrence;
133
   --    Raised_Id : Boolean := False;
134
 
135
   function Build_Raise_Statement
136
     (Data : Finalization_Exception_Data) return Node_Id;
137
   --  Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
138
   --  Deep_Record_Body. Generate the following conditional raise statement:
139
   --
140
   --    if Raised_Id and then not Abort_Id then
141
   --       Raise_From_Controlled_Operation (E_Id);
142
   --    end if;
143
   --
144
   --  Abort_Id is a local boolean flag which is set when the finalization was
145
   --  triggered by an abort, E_Id denotes the defining identifier of a local
146
   --  exception occurrence, Raised_Id is the entity of a local boolean flag.
147
 
148
   function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
149
   --  True if T is a class-wide type, or if it has controlled parts ("part"
150
   --  means T or any of its subcomponents). Same as Needs_Finalization, except
151
   --  when pragma Restrictions (No_Finalization) applies, in which case we
152
   --  know that class-wide objects do not contain controlled parts.
153
 
154
   function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id;
155
   --  Return the pool id for access type T.  This is generally the node
156
   --  corresponding to System.Global_Pool.Global_Pool_Object except on
157
   --  VMS if the access size is 32.
158
 
159
   function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
160
   --  E is a type entity. Give the same result as Has_Controlled_Component
161
   --  except for tagged extensions where the result is True only if the
162
   --  latest extension contains a controlled component.
163
 
164
   function Make_Adjust_Call
165
     (Obj_Ref    : Node_Id;
166
      Typ        : Entity_Id;
167
      For_Parent : Boolean := False) return Node_Id;
168
   --  Create a call to either Adjust or Deep_Adjust depending on the structure
169
   --  of type Typ. Obj_Ref is an expression with no-side effect (not required
170
   --  to have been previously analyzed) that references the object to be
171
   --  adjusted. Typ is the expected type of Obj_Ref. Flag For_Parent must be
172
   --  set when an adjustment call is being created for field _parent.
173
 
174
   function Make_Attach_Call
175
     (Obj_Ref : Node_Id;
176
      Ptr_Typ : Entity_Id) return Node_Id;
177
   --  Create a call to prepend an object to a finalization collection. Obj_Ref
178
   --  is the object, Ptr_Typ is the access type that owns the collection. This
179
   --  is used only for .NET/JVM, that is, when VM_Target /= No_VM.
180
   --  Generate the following:
181
   --
182
   --    Ada.Finalization.Heap_Management.Attach
183
   --      (<Ptr_Typ>FC,
184
   --       System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
185
 
186
   function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id;
187
   --  Create a call to unhook an object from an arbitrary list. Obj_Ref is the
188
   --  object. Generate the following:
189
   --
190
   --    Ada.Finalization.Heap_Management.Detach
191
   --      (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
192
 
193
   function Make_Final_Call
194
     (Obj_Ref    : Node_Id;
195
      Typ        : Entity_Id;
196
      For_Parent : Boolean := False) return Node_Id;
197
   --  Create a call to either Finalize or Deep_Finalize depending on the
198
   --  structure of type Typ. Obj_Ref is an expression (with no-side effect and
199
   --  is not required to have been previously analyzed) that references the
200
   --  object to be finalized. Typ is the expected type of Obj_Ref. Flag For_
201
   --  Parent must be set when a finalization call is being created for field
202
   --  _parent.
203
 
204
   procedure Make_Finalize_Address_Body (Typ : Entity_Id);
205
   --  Create the body of TSS routine Finalize_Address if Typ is controlled and
206
   --  does not have a TSS entry for Finalize_Address. The procedure converts
207
   --  an address into a pointer and subsequently calls Deep_Finalize on the
208
   --  dereference.
209
 
210
   function Make_Init_Call
211
     (Obj_Ref : Node_Id;
212
      Typ     : Entity_Id) return Node_Id;
213
   --  Obj_Ref is an expression with no-side effect (not required to have been
214
   --  previously analyzed) that references the object to be initialized. Typ
215
   --  is the expected type of Obj_Ref, which is either a controlled type
216
   --  (Is_Controlled) or a type with controlled components (Has_Controlled_
217
   --  Components).
218
 
219
   function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id;
220
   --  Generate an implicit exception handler with an 'others' choice,
221
   --  converting any occurrence to a raise of Program_Error.
222
 
223
   function Make_Local_Deep_Finalize
224
     (Typ : Entity_Id;
225
      Nam : Entity_Id) return Node_Id;
226
   --  Create a special version of Deep_Finalize with identifier Nam. The
227
   --  routine has state information and can parform partial finalization.
228
 
229
   function Make_Set_Finalize_Address_Call
230
     (Loc     : Source_Ptr;
231
      Typ     : Entity_Id;
232
      Ptr_Typ : Entity_Id) return Node_Id;
233
   --  Generate the following call:
234
   --
235
   --    Set_Finalize_Address (<Ptr_Typ>FM, <Typ>FD'Unrestricted_Access);
236
   --
237
   --  where Finalize_Address is the corresponding TSS primitive of type Typ
238
   --  and Ptr_Typ is the access type of the related allocation. Loc is the
239
   --  source location of the related allocator.
240
 
241
   --------------------------------------------
242
   -- Task and Protected Object finalization --
243
   --------------------------------------------
244
 
245
   function Cleanup_Array
246
     (N   : Node_Id;
247
      Obj : Node_Id;
248
      Typ : Entity_Id) return List_Id;
249
   --  Generate loops to finalize any tasks or simple protected objects that
250
   --  are subcomponents of an array.
251
 
252
   function Cleanup_Protected_Object
253
     (N   : Node_Id;
254
      Ref : Node_Id) return Node_Id;
255
   --  Generate code to finalize a protected object without entries
256
 
257
   function Cleanup_Record
258
     (N   : Node_Id;
259
      Obj : Node_Id;
260
      Typ : Entity_Id) return List_Id;
261
   --  For each subcomponent of a record that contains tasks or simple
262
   --  protected objects, generate the appropriate finalization call.
263
 
264
   function Cleanup_Task
265
     (N   : Node_Id;
266
      Ref : Node_Id) return Node_Id;
267
   --  Generate code to finalize a task
268
 
269
   function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
270
   --  Check whether composite type contains a simple protected component
271
 
272
   function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
273
   --  Determine whether T denotes a protected type without entires whose
274
   --  _object field is of type System.Tasking.Protected_Objects.Protection.
275
 
276
   --------------------------------
277
   -- Transient Scope Management --
278
   --------------------------------
279
 
280
   procedure Expand_Cleanup_Actions (N : Node_Id);
281
   --  Expand the necessary stuff into a scope to enable finalization of local
282
   --  objects and deallocation of transient data when exiting the scope. N is
283
   --  a "scope node" that is to say one of the following: N_Block_Statement,
284
   --  N_Subprogram_Body, N_Task_Body, N_Entry_Body.
285
 
286
   procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
287
   --  Push a new transient scope on the scope stack. N is the node responsible
288
   --  for the need of a transient scope. If Sec_Stack is True then the
289
   --  secondary stack is brought in, otherwise it isn't.
290
 
291
   function Node_To_Be_Wrapped return Node_Id;
292
   --  Return the node to be wrapped if the current scope is transient
293
 
294
   procedure Store_Before_Actions_In_Scope (L : List_Id);
295
   --  Append the list L of actions to the end of the before-actions store in
296
   --  the top of the scope stack.
297
 
298
   procedure Store_After_Actions_In_Scope (L : List_Id);
299
   --  Append the list L of actions to the beginning of the after-actions store
300
   --  in the top of the scope stack.
301
 
302
   procedure Wrap_Transient_Declaration (N : Node_Id);
303
   --  N is an object declaration. Expand the finalization calls after the
304
   --  declaration and make the outer scope being the transient one.
305
 
306
   procedure Wrap_Transient_Expression (N : Node_Id);
307
   --  N is a sub-expression. Expand a transient block around an expression
308
 
309
   procedure Wrap_Transient_Statement (N : Node_Id);
310
   --  N is a statement. Expand a transient block around an instruction
311
 
312
end Exp_Ch7;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.