1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Einfo
; use Einfo
;
28 with Exp_Ch6
; use Exp_Ch6
;
29 with Exp_Dbug
; use Exp_Dbug
;
30 with Exp_Util
; use Exp_Util
;
31 with Freeze
; use Freeze
;
32 with Nlists
; use Nlists
;
35 with Sem_Ch8
; use Sem_Ch8
;
36 with Sinfo
; use Sinfo
;
37 with Stand
; use Stand
;
38 with Targparm
; use Targparm
;
40 package body Exp_Ch8
is
42 ---------------------------------------------
43 -- Expand_N_Exception_Renaming_Declaration --
44 ---------------------------------------------
46 procedure Expand_N_Exception_Renaming_Declaration
(N
: Node_Id
) is
47 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
50 if Present
(Decl
) then
51 Insert_Action
(N
, Decl
);
53 end Expand_N_Exception_Renaming_Declaration
;
55 ------------------------------------------
56 -- Expand_N_Object_Renaming_Declaration --
57 ------------------------------------------
59 -- Most object renaming cases can be done by just capturing the address
60 -- of the renamed object. The cases in which this is not true are when
61 -- this address is not computable, since it involves extraction of a
62 -- packed array element, or of a record component to which a component
63 -- clause applies (that can specify an arbitrary bit boundary), or where
64 -- the enclosing record itself has a non-standard representation.
66 -- In these two cases, we pre-evaluate the renaming expression, by
67 -- extracting and freezing the values of any subscripts, and then we
68 -- set the flag Is_Renaming_Of_Object which means that any reference
69 -- to the object will be handled by macro substitution in the front
70 -- end, and the back end will know to ignore the renaming declaration.
72 -- An additional odd case that requires processing by expansion is
73 -- the renaming of a discriminant of a mutable record type. The object
74 -- is a constant because it renames something that cannot be assigned to,
75 -- but in fact the underlying value can change and must be reevaluated
76 -- at each reference. Gigi does have a notion of a "constant view" of
77 -- an object, and therefore the front-end must perform the expansion.
78 -- For simplicity, and to bypass some obscure code-generation problem,
79 -- we use macro substitution for all renamed discriminants, whether the
80 -- enclosing type is constrained or not.
82 -- The other special processing required is for the case of renaming
83 -- of an object of a class wide type, where it is necessary to build
84 -- the appropriate subtype for the renamed object.
85 -- More comments needed for this para ???
87 procedure Expand_N_Object_Renaming_Declaration
(N
: Node_Id
) is
88 Nam
: constant Node_Id
:= Name
(N
);
92 procedure Evaluate_Name
(Fname
: Node_Id
);
93 -- A recursive procedure used to freeze a name in the sense described
94 -- above, i.e. any variable references or function calls are removed.
95 -- Of course the outer level variable reference must not be removed.
96 -- For example in A(J,F(K)), A is left as is, but J and F(K) are
97 -- evaluated and removed.
99 function Evaluation_Required
(Nam
: Node_Id
) return Boolean;
100 -- Determines whether it is necessary to do static name evaluation
101 -- for renaming of Nam. It is considered necessary if evaluating the
102 -- name involves indexing a packed array, or extracting a component
103 -- of a record to which a component clause applies. Note that we are
104 -- only interested in these operations if they occur as part of the
105 -- name itself, subscripts are just values that are computed as part
106 -- of the evaluation, so their form is unimportant.
112 procedure Evaluate_Name
(Fname
: Node_Id
) is
113 K
: constant Node_Kind
:= Nkind
(Fname
);
117 -- For an explicit dereference, we simply force the evaluation
118 -- of the name expression. The dereference provides a value that
119 -- is the address for the renamed object, and it is precisely
120 -- this value that we want to preserve.
122 if K
= N_Explicit_Dereference
then
123 Force_Evaluation
(Prefix
(Fname
));
125 -- For a selected component, we simply evaluate the prefix
127 elsif K
= N_Selected_Component
then
128 Evaluate_Name
(Prefix
(Fname
));
130 -- For an indexed component, or an attribute reference, we evaluate
131 -- the prefix, which is itself a name, recursively, and then force
132 -- the evaluation of all the subscripts (or attribute expressions).
134 elsif K
= N_Indexed_Component
135 or else K
= N_Attribute_Reference
137 Evaluate_Name
(Prefix
(Fname
));
139 E
:= First
(Expressions
(Fname
));
140 while Present
(E
) loop
141 Force_Evaluation
(E
);
143 if Original_Node
(E
) /= E
then
144 Set_Do_Range_Check
(E
, Do_Range_Check
(Original_Node
(E
)));
150 -- For a slice, we evaluate the prefix, as for the indexed component
151 -- case and then, if there is a range present, either directly or
152 -- as the constraint of a discrete subtype indication, we evaluate
153 -- the two bounds of this range.
155 elsif K
= N_Slice
then
156 Evaluate_Name
(Prefix
(Fname
));
159 DR
: constant Node_Id
:= Discrete_Range
(Fname
);
164 if Nkind
(DR
) = N_Range
then
165 Force_Evaluation
(Low_Bound
(DR
));
166 Force_Evaluation
(High_Bound
(DR
));
168 elsif Nkind
(DR
) = N_Subtype_Indication
then
169 Constr
:= Constraint
(DR
);
171 if Nkind
(Constr
) = N_Range_Constraint
then
172 Rexpr
:= Range_Expression
(Constr
);
174 Force_Evaluation
(Low_Bound
(Rexpr
));
175 Force_Evaluation
(High_Bound
(Rexpr
));
180 -- For a type conversion, the expression of the conversion must be
181 -- the name of an object, and we simply need to evaluate this name.
183 elsif K
= N_Type_Conversion
then
184 Evaluate_Name
(Expression
(Fname
));
186 -- For a function call, we evaluate the call
188 elsif K
= N_Function_Call
then
189 Force_Evaluation
(Fname
);
191 -- The remaining cases are direct name, operator symbol and
192 -- character literal. In all these cases, we do nothing, since
193 -- we want to reevaluate each time the renamed object is used.
200 -------------------------
201 -- Evaluation_Required --
202 -------------------------
204 function Evaluation_Required
(Nam
: Node_Id
) return Boolean is
206 if Nkind
(Nam
) = N_Indexed_Component
207 or else Nkind
(Nam
) = N_Slice
209 if Is_Packed
(Etype
(Prefix
(Nam
))) then
212 return Evaluation_Required
(Prefix
(Nam
));
215 elsif Nkind
(Nam
) = N_Selected_Component
then
217 Rec_Type
: constant Entity_Id
:= Etype
(Prefix
(Nam
));
220 if Present
(Component_Clause
(Entity
(Selector_Name
(Nam
))))
221 or else Has_Non_Standard_Rep
(Rec_Type
)
225 elsif Ekind
(Entity
(Selector_Name
(Nam
))) = E_Discriminant
226 and then Is_Record_Type
(Rec_Type
)
227 and then not Is_Concurrent_Record_Type
(Rec_Type
)
232 return Evaluation_Required
(Prefix
(Nam
));
239 end Evaluation_Required
;
241 -- Start of processing for Expand_N_Object_Renaming_Declaration
244 -- Perform name evaluation if required
246 if Evaluation_Required
(Nam
) then
248 Set_Is_Renaming_Of_Object
(Defining_Identifier
(N
));
251 -- Deal with construction of subtype in class-wide case
253 T
:= Etype
(Defining_Identifier
(N
));
255 if Is_Class_Wide_Type
(T
) then
256 Expand_Subtype_From_Expr
(N
, T
, Subtype_Mark
(N
), Name
(N
));
257 Find_Type
(Subtype_Mark
(N
));
258 Set_Etype
(Defining_Identifier
(N
), Entity
(Subtype_Mark
(N
)));
260 -- Freeze the class-wide subtype here to ensure that the subtype
261 -- and equivalent type are frozen before the renaming. This is
262 -- required for targets where Frontend_Layout_On_Target is true.
263 -- For targets where Gigi is used, class-wide subtype should not
264 -- be frozen (in that case the subtype is marked as already frozen
265 -- when it's created).
267 if Frontend_Layout_On_Target
then
268 Freeze_Before
(N
, Entity
(Subtype_Mark
(N
)));
272 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
273 -- place function, then a temporary return object needs to be created
274 -- and access to it must be passed to the function. Currently we limit
275 -- such functions to those with inherently limited result subtypes, but
276 -- eventually we plan to expand the functions that are treated as
277 -- build-in-place to include other composite result types.
279 if Ada_Version
>= Ada_05
280 and then Is_Build_In_Place_Function_Call
(Nam
)
282 Make_Build_In_Place_Call_In_Anonymous_Context
(Nam
);
285 -- Create renaming entry for debug information
287 Decl
:= Debug_Renaming_Declaration
(N
);
289 if Present
(Decl
) then
290 Insert_Action
(N
, Decl
);
292 end Expand_N_Object_Renaming_Declaration
;
294 -------------------------------------------
295 -- Expand_N_Package_Renaming_Declaration --
296 -------------------------------------------
298 procedure Expand_N_Package_Renaming_Declaration
(N
: Node_Id
) is
299 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
302 if Present
(Decl
) then
304 -- If we are in a compilation unit, then this is an outer
305 -- level declaration, and must have a scope of Standard
307 if Nkind
(Parent
(N
)) = N_Compilation_Unit
then
309 Aux
: constant Node_Id
:= Aux_Decls_Node
(Parent
(N
));
312 Push_Scope
(Standard_Standard
);
314 if No
(Actions
(Aux
)) then
315 Set_Actions
(Aux
, New_List
(Decl
));
317 Append
(Decl
, Actions
(Aux
));
322 -- Enter the debug variable in the qualification list, which
323 -- must be done at this point because auxiliary declarations
324 -- occur at the library level and aren't associated with a
327 Qualify_Entity_Names
(Decl
);
332 -- Otherwise, just insert after the package declaration
335 Insert_Action
(N
, Decl
);
338 end Expand_N_Package_Renaming_Declaration
;