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 Nkind_In
(K
, N_Indexed_Component
, N_Attribute_Reference
) then
135 Evaluate_Name
(Prefix
(Fname
));
137 E
:= First
(Expressions
(Fname
));
138 while Present
(E
) loop
139 Force_Evaluation
(E
);
141 if Original_Node
(E
) /= E
then
142 Set_Do_Range_Check
(E
, Do_Range_Check
(Original_Node
(E
)));
148 -- For a slice, we evaluate the prefix, as for the indexed component
149 -- case and then, if there is a range present, either directly or
150 -- as the constraint of a discrete subtype indication, we evaluate
151 -- the two bounds of this range.
153 elsif K
= N_Slice
then
154 Evaluate_Name
(Prefix
(Fname
));
157 DR
: constant Node_Id
:= Discrete_Range
(Fname
);
162 if Nkind
(DR
) = N_Range
then
163 Force_Evaluation
(Low_Bound
(DR
));
164 Force_Evaluation
(High_Bound
(DR
));
166 elsif Nkind
(DR
) = N_Subtype_Indication
then
167 Constr
:= Constraint
(DR
);
169 if Nkind
(Constr
) = N_Range_Constraint
then
170 Rexpr
:= Range_Expression
(Constr
);
172 Force_Evaluation
(Low_Bound
(Rexpr
));
173 Force_Evaluation
(High_Bound
(Rexpr
));
178 -- For a type conversion, the expression of the conversion must be
179 -- the name of an object, and we simply need to evaluate this name.
181 elsif K
= N_Type_Conversion
then
182 Evaluate_Name
(Expression
(Fname
));
184 -- For a function call, we evaluate the call
186 elsif K
= N_Function_Call
then
187 Force_Evaluation
(Fname
);
189 -- The remaining cases are direct name, operator symbol and
190 -- character literal. In all these cases, we do nothing, since
191 -- we want to reevaluate each time the renamed object is used.
198 -------------------------
199 -- Evaluation_Required --
200 -------------------------
202 function Evaluation_Required
(Nam
: Node_Id
) return Boolean is
204 if Nkind_In
(Nam
, N_Indexed_Component
, N_Slice
) then
205 if Is_Packed
(Etype
(Prefix
(Nam
))) then
208 return Evaluation_Required
(Prefix
(Nam
));
211 elsif Nkind
(Nam
) = N_Selected_Component
then
213 Rec_Type
: constant Entity_Id
:= Etype
(Prefix
(Nam
));
216 if Present
(Component_Clause
(Entity
(Selector_Name
(Nam
))))
217 or else Has_Non_Standard_Rep
(Rec_Type
)
221 elsif Ekind
(Entity
(Selector_Name
(Nam
))) = E_Discriminant
222 and then Is_Record_Type
(Rec_Type
)
223 and then not Is_Concurrent_Record_Type
(Rec_Type
)
228 return Evaluation_Required
(Prefix
(Nam
));
235 end Evaluation_Required
;
237 -- Start of processing for Expand_N_Object_Renaming_Declaration
240 -- Perform name evaluation if required
242 if Evaluation_Required
(Nam
) then
244 Set_Is_Renaming_Of_Object
(Defining_Identifier
(N
));
247 -- Deal with construction of subtype in class-wide case
249 T
:= Etype
(Defining_Identifier
(N
));
251 if Is_Class_Wide_Type
(T
) then
252 Expand_Subtype_From_Expr
(N
, T
, Subtype_Mark
(N
), Name
(N
));
253 Find_Type
(Subtype_Mark
(N
));
254 Set_Etype
(Defining_Identifier
(N
), Entity
(Subtype_Mark
(N
)));
256 -- Freeze the class-wide subtype here to ensure that the subtype
257 -- and equivalent type are frozen before the renaming. This is
258 -- required for targets where Frontend_Layout_On_Target is true.
259 -- For targets where Gigi is used, class-wide subtype should not
260 -- be frozen (in that case the subtype is marked as already frozen
261 -- when it's created).
263 if Frontend_Layout_On_Target
then
264 Freeze_Before
(N
, Entity
(Subtype_Mark
(N
)));
268 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
269 -- place function, then a temporary return object needs to be created
270 -- and access to it must be passed to the function. Currently we limit
271 -- such functions to those with inherently limited result subtypes, but
272 -- eventually we plan to expand the functions that are treated as
273 -- build-in-place to include other composite result types.
275 if Ada_Version
>= Ada_05
276 and then Is_Build_In_Place_Function_Call
(Nam
)
278 Make_Build_In_Place_Call_In_Anonymous_Context
(Nam
);
281 -- Create renaming entry for debug information
283 Decl
:= Debug_Renaming_Declaration
(N
);
285 if Present
(Decl
) then
286 Insert_Action
(N
, Decl
);
288 end Expand_N_Object_Renaming_Declaration
;
290 -------------------------------------------
291 -- Expand_N_Package_Renaming_Declaration --
292 -------------------------------------------
294 procedure Expand_N_Package_Renaming_Declaration
(N
: Node_Id
) is
295 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
298 if Present
(Decl
) then
300 -- If we are in a compilation unit, then this is an outer
301 -- level declaration, and must have a scope of Standard
303 if Nkind
(Parent
(N
)) = N_Compilation_Unit
then
305 Aux
: constant Node_Id
:= Aux_Decls_Node
(Parent
(N
));
308 Push_Scope
(Standard_Standard
);
310 if No
(Actions
(Aux
)) then
311 Set_Actions
(Aux
, New_List
(Decl
));
313 Append
(Decl
, Actions
(Aux
));
318 -- Enter the debug variable in the qualification list, which
319 -- must be done at this point because auxiliary declarations
320 -- occur at the library level and aren't associated with a
323 Qualify_Entity_Names
(Decl
);
328 -- Otherwise, just insert after the package declaration
331 Insert_Action
(N
, Decl
);
334 end Expand_N_Package_Renaming_Declaration
;
336 ----------------------------------------------
337 -- Expand_N_Subprogram_Renaming_Declaration --
338 ----------------------------------------------
340 procedure Expand_N_Subprogram_Renaming_Declaration
(N
: Node_Id
) is
341 Nam
: constant Node_Id
:= Name
(N
);
344 -- When the prefix of the name is a function call, we must force the
345 -- call to be made by removing side effects from the call, since we
346 -- must only call the function once.
348 if Nkind
(Nam
) = N_Selected_Component
349 and then Nkind
(Prefix
(Nam
)) = N_Function_Call
351 Remove_Side_Effects
(Prefix
(Nam
));
353 -- For an explicit dereference, the prefix must be captured to prevent
354 -- reevaluation on calls through the renaming, which could result in
355 -- calling the wrong subprogram if the access value were to be changed.
357 elsif Nkind
(Nam
) = N_Explicit_Dereference
then
358 Force_Evaluation
(Prefix
(Nam
));
360 end Expand_N_Subprogram_Renaming_Declaration
;