1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2006, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Einfo; use Einfo;
29 with Exp_Ch6; use Exp_Ch6;
30 with Exp_Dbug; use Exp_Dbug;
31 with Exp_Util; use Exp_Util;
32 with Freeze; use Freeze;
33 with Nlists; use Nlists;
36 with Sem_Ch8; use Sem_Ch8;
37 with Sinfo; use Sinfo;
38 with Stand; use Stand;
39 with Targparm; use Targparm;
41 package body Exp_Ch8 is
43 ---------------------------------------------
44 -- Expand_N_Exception_Renaming_Declaration --
45 ---------------------------------------------
47 procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is
48 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
51 if Present (Decl) then
52 Insert_Action (N, Decl);
54 end Expand_N_Exception_Renaming_Declaration;
56 ------------------------------------------
57 -- Expand_N_Object_Renaming_Declaration --
58 ------------------------------------------
60 -- Most object renaming cases can be done by just capturing the address
61 -- of the renamed object. The cases in which this is not true are when
62 -- this address is not computable, since it involves extraction of a
63 -- packed array element, or of a record component to which a component
64 -- clause applies (that can specify an arbitrary bit boundary), or where
65 -- the enclosing record itself has a non-standard representation.
67 -- In these two cases, we pre-evaluate the renaming expression, by
68 -- extracting and freezing the values of any subscripts, and then we
69 -- set the flag Is_Renaming_Of_Object which means that any reference
70 -- to the object will be handled by macro substitution in the front
71 -- end, and the back end will know to ignore the renaming declaration.
73 -- An additional odd case that requires processing by expansion is
74 -- the renaming of a discriminant of a mutable record type. The object
75 -- is a constant because it renames something that cannot be assigned to,
76 -- but in fact the underlying value can change and must be reevaluated
77 -- at each reference. Gigi does have a notion of a "constant view" of
78 -- an object, and therefore the front-end must perform the expansion.
79 -- For simplicity, and to bypass some obscure code-generation problem,
80 -- we use macro substitution for all renamed discriminants, whether the
81 -- enclosing type is constrained or not.
83 -- The other special processing required is for the case of renaming
84 -- of an object of a class wide type, where it is necessary to build
85 -- the appropriate subtype for the renamed object.
86 -- More comments needed for this para ???
88 procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
89 Nam : constant Node_Id := Name (N);
93 procedure Evaluate_Name (Fname : Node_Id);
94 -- A recursive procedure used to freeze a name in the sense described
95 -- above, i.e. any variable references or function calls are removed.
96 -- Of course the outer level variable reference must not be removed.
97 -- For example in A(J,F(K)), A is left as is, but J and F(K) are
98 -- evaluated and removed.
100 function Evaluation_Required (Nam : Node_Id) return Boolean;
101 -- Determines whether it is necessary to do static name evaluation
102 -- for renaming of Nam. It is considered necessary if evaluating the
103 -- name involves indexing a packed array, or extracting a component
104 -- of a record to which a component clause applies. Note that we are
105 -- only interested in these operations if they occur as part of the
106 -- name itself, subscripts are just values that are computed as part
107 -- of the evaluation, so their form is unimportant.
113 procedure Evaluate_Name (Fname : Node_Id) is
114 K : constant Node_Kind := Nkind (Fname);
118 -- For an explicit dereference, we simply force the evaluation
119 -- of the name expression. The dereference provides a value that
120 -- is the address for the renamed object, and it is precisely
121 -- this value that we want to preserve.
123 if K = N_Explicit_Dereference then
124 Force_Evaluation (Prefix (Fname));
126 -- For a selected component, we simply evaluate the prefix
128 elsif K = N_Selected_Component then
129 Evaluate_Name (Prefix (Fname));
131 -- For an indexed component, or an attribute reference, we evaluate
132 -- the prefix, which is itself a name, recursively, and then force
133 -- the evaluation of all the subscripts (or attribute expressions).
135 elsif K = N_Indexed_Component
136 or else K = N_Attribute_Reference
138 Evaluate_Name (Prefix (Fname));
140 E := First (Expressions (Fname));
141 while Present (E) loop
142 Force_Evaluation (E);
144 if Original_Node (E) /= E then
145 Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
151 -- For a slice, we evaluate the prefix, as for the indexed component
152 -- case and then, if there is a range present, either directly or
153 -- as the constraint of a discrete subtype indication, we evaluate
154 -- the two bounds of this range.
156 elsif K = N_Slice then
157 Evaluate_Name (Prefix (Fname));
160 DR : constant Node_Id := Discrete_Range (Fname);
165 if Nkind (DR) = N_Range then
166 Force_Evaluation (Low_Bound (DR));
167 Force_Evaluation (High_Bound (DR));
169 elsif Nkind (DR) = N_Subtype_Indication then
170 Constr := Constraint (DR);
172 if Nkind (Constr) = N_Range_Constraint then
173 Rexpr := Range_Expression (Constr);
175 Force_Evaluation (Low_Bound (Rexpr));
176 Force_Evaluation (High_Bound (Rexpr));
181 -- For a type conversion, the expression of the conversion must be
182 -- the name of an object, and we simply need to evaluate this name.
184 elsif K = N_Type_Conversion then
185 Evaluate_Name (Expression (Fname));
187 -- For a function call, we evaluate the call
189 elsif K = N_Function_Call then
190 Force_Evaluation (Fname);
192 -- The remaining cases are direct name, operator symbol and
193 -- character literal. In all these cases, we do nothing, since
194 -- we want to reevaluate each time the renamed object is used.
201 -------------------------
202 -- Evaluation_Required --
203 -------------------------
205 function Evaluation_Required (Nam : Node_Id) return Boolean is
207 if Nkind (Nam) = N_Indexed_Component
208 or else Nkind (Nam) = N_Slice
210 if Is_Packed (Etype (Prefix (Nam))) then
213 return Evaluation_Required (Prefix (Nam));
216 elsif Nkind (Nam) = N_Selected_Component then
218 Rec_Type : constant Entity_Id := Etype (Prefix (Nam));
221 if Present (Component_Clause (Entity (Selector_Name (Nam))))
222 or else Has_Non_Standard_Rep (Rec_Type)
226 elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
227 and then Is_Record_Type (Rec_Type)
228 and then not Is_Concurrent_Record_Type (Rec_Type)
233 return Evaluation_Required (Prefix (Nam));
240 end Evaluation_Required;
242 -- Start of processing for Expand_N_Object_Renaming_Declaration
245 -- Perform name evaluation if required
247 if Evaluation_Required (Nam) then
249 Set_Is_Renaming_Of_Object (Defining_Identifier (N));
252 -- Deal with construction of subtype in class-wide case
254 T := Etype (Defining_Identifier (N));
256 if Is_Class_Wide_Type (T) then
257 Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
258 Find_Type (Subtype_Mark (N));
259 Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
261 -- Freeze the class-wide subtype here to ensure that the subtype
262 -- and equivalent type are frozen before the renaming. This is
263 -- required for targets where Frontend_Layout_On_Target is true.
264 -- For targets where Gigi is used, class-wide subtype should not
265 -- be frozen (in that case the subtype is marked as already frozen
266 -- when it's created).
268 if Frontend_Layout_On_Target then
269 Freeze_Before (N, Entity (Subtype_Mark (N)));
273 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
274 -- place function, then a temporary return object needs to be created
275 -- and access to it must be passed to the function. Currently we limit
276 -- such functions to those with inherently limited result subtypes, but
277 -- eventually we plan to expand the functions that are treated as
278 -- build-in-place to include other composite result types.
280 if Ada_Version >= Ada_05
281 and then Is_Build_In_Place_Function_Call (Nam)
283 Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
286 -- Create renaming entry for debug information
288 Decl := Debug_Renaming_Declaration (N);
290 if Present (Decl) then
291 Insert_Action (N, Decl);
293 end Expand_N_Object_Renaming_Declaration;
295 -------------------------------------------
296 -- Expand_N_Package_Renaming_Declaration --
297 -------------------------------------------
299 procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is
300 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
303 if Present (Decl) then
305 -- If we are in a compilation unit, then this is an outer
306 -- level declaration, and must have a scope of Standard
308 if Nkind (Parent (N)) = N_Compilation_Unit then
310 Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
313 New_Scope (Standard_Standard);
315 if No (Actions (Aux)) then
316 Set_Actions (Aux, New_List (Decl));
318 Append (Decl, Actions (Aux));
325 -- Otherwise, just insert after the package declaration
328 Insert_Action (N, Decl);
331 end Expand_N_Package_Renaming_Declaration;