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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [exp_ch8.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              E X P _ C H 8                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, 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 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;
33
with Opt;      use Opt;
34
with Sem;      use Sem;
35
with Sem_Ch8;  use Sem_Ch8;
36
with Sinfo;    use Sinfo;
37
with Stand;    use Stand;
38
 
39
package body Exp_Ch8 is
40
 
41
   ---------------------------------------------
42
   -- Expand_N_Exception_Renaming_Declaration --
43
   ---------------------------------------------
44
 
45
   procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is
46
      Decl : constant Node_Id := Debug_Renaming_Declaration (N);
47
 
48
   begin
49
      if Present (Decl) then
50
         Insert_Action (N, Decl);
51
      end if;
52
   end Expand_N_Exception_Renaming_Declaration;
53
 
54
   ------------------------------------------
55
   -- Expand_N_Object_Renaming_Declaration --
56
   ------------------------------------------
57
 
58
   --  Most object renaming cases can be done by just capturing the address
59
   --  of the renamed object. The cases in which this is not true are when
60
   --  this address is not computable, since it involves extraction of a
61
   --  packed array element, or of a record component to which a component
62
   --  clause applies (that can specify an arbitrary bit boundary), or where
63
   --  the enclosing record itself has a non-standard representation.
64
 
65
   --  In these two cases, we pre-evaluate the renaming expression, by
66
   --  extracting and freezing the values of any subscripts, and then we
67
   --  set the flag Is_Renaming_Of_Object which means that any reference
68
   --  to the object will be handled by macro substitution in the front
69
   --  end, and the back end will know to ignore the renaming declaration.
70
 
71
   --  An additional odd case that requires processing by expansion is
72
   --  the renaming of a discriminant of a mutable record type. The object
73
   --  is a constant because it renames something that cannot be assigned to,
74
   --  but in fact the underlying value can change and must be reevaluated
75
   --  at each reference. Gigi does have a notion of a "constant view" of
76
   --  an object, and therefore the front-end must perform the expansion.
77
   --  For simplicity, and to bypass some obscure code-generation problem,
78
   --  we use macro substitution for all renamed discriminants, whether the
79
   --  enclosing type is constrained or not.
80
 
81
   --  The other special processing required is for the case of renaming
82
   --  of an object of a class wide type, where it is necessary to build
83
   --  the appropriate subtype for the renamed object.
84
   --  More comments needed for this para ???
85
 
86
   procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
87
      Nam  : constant Node_Id := Name (N);
88
      T    : Entity_Id;
89
      Decl : Node_Id;
90
 
91
      procedure Evaluate_Name (Fname : Node_Id);
92
      --  A recursive procedure used to freeze a name in the sense described
93
      --  above, i.e. any variable references or function calls are removed.
94
      --  Of course the outer level variable reference must not be removed.
95
      --  For example in A(J,F(K)), A is left as is, but J and F(K) are
96
      --  evaluated and removed.
97
 
98
      function Evaluation_Required (Nam : Node_Id) return Boolean;
99
      --  Determines whether it is necessary to do static name evaluation
100
      --  for renaming of Nam. It is considered necessary if evaluating the
101
      --  name involves indexing a packed array, or extracting a component
102
      --  of a record to which a component clause applies. Note that we are
103
      --  only interested in these operations if they occur as part of the
104
      --  name itself, subscripts are just values that are computed as part
105
      --  of the evaluation, so their form is unimportant.
106
 
107
      -------------------
108
      -- Evaluate_Name --
109
      -------------------
110
 
111
      procedure Evaluate_Name (Fname : Node_Id) is
112
         K : constant Node_Kind := Nkind (Fname);
113
         E : Node_Id;
114
 
115
      begin
116
         --  For an explicit dereference, we simply force the evaluation
117
         --  of the name expression. The dereference provides a value that
118
         --  is the address for the renamed object, and it is precisely
119
         --  this value that we want to preserve.
120
 
121
         if K = N_Explicit_Dereference then
122
            Force_Evaluation (Prefix (Fname));
123
 
124
         --  For a selected component, we simply evaluate the prefix
125
 
126
         elsif K = N_Selected_Component then
127
            Evaluate_Name (Prefix (Fname));
128
 
129
         --  For an indexed component, or an attribute reference, we evaluate
130
         --  the prefix, which is itself a name, recursively, and then force
131
         --  the evaluation of all the subscripts (or attribute expressions).
132
 
133
         elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
134
            Evaluate_Name (Prefix (Fname));
135
 
136
            E := First (Expressions (Fname));
137
            while Present (E) loop
138
               Force_Evaluation (E);
139
 
140
               if Original_Node (E) /= E then
141
                  Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
142
               end if;
143
 
144
               Next (E);
145
            end loop;
146
 
147
         --  For a slice, we evaluate the prefix, as for the indexed component
148
         --  case and then, if there is a range present, either directly or
149
         --  as the constraint of a discrete subtype indication, we evaluate
150
         --  the two bounds of this range.
151
 
152
         elsif K = N_Slice then
153
            Evaluate_Name (Prefix (Fname));
154
 
155
            declare
156
               DR     : constant Node_Id := Discrete_Range (Fname);
157
               Constr : Node_Id;
158
               Rexpr  : Node_Id;
159
 
160
            begin
161
               if Nkind (DR) = N_Range then
162
                  Force_Evaluation (Low_Bound (DR));
163
                  Force_Evaluation (High_Bound (DR));
164
 
165
               elsif Nkind (DR) = N_Subtype_Indication then
166
                  Constr := Constraint (DR);
167
 
168
                  if Nkind (Constr) = N_Range_Constraint then
169
                     Rexpr := Range_Expression (Constr);
170
 
171
                     Force_Evaluation (Low_Bound (Rexpr));
172
                     Force_Evaluation (High_Bound (Rexpr));
173
                  end if;
174
               end if;
175
            end;
176
 
177
         --  For a type conversion, the expression of the conversion must be
178
         --  the name of an object, and we simply need to evaluate this name.
179
 
180
         elsif K = N_Type_Conversion then
181
            Evaluate_Name (Expression (Fname));
182
 
183
         --  For a function call, we evaluate the call
184
 
185
         elsif K = N_Function_Call then
186
            Force_Evaluation (Fname);
187
 
188
         --  The remaining cases are direct name, operator symbol and
189
         --  character literal. In all these cases, we do nothing, since
190
         --  we want to reevaluate each time the renamed object is used.
191
 
192
         else
193
            return;
194
         end if;
195
      end Evaluate_Name;
196
 
197
      -------------------------
198
      -- Evaluation_Required --
199
      -------------------------
200
 
201
      function Evaluation_Required (Nam : Node_Id) return Boolean is
202
      begin
203
         if Nkind_In (Nam, N_Indexed_Component, N_Slice) then
204
            if Is_Packed (Etype (Prefix (Nam))) then
205
               return True;
206
            else
207
               return Evaluation_Required (Prefix (Nam));
208
            end if;
209
 
210
         elsif Nkind (Nam) = N_Selected_Component then
211
            declare
212
               Rec_Type : constant Entity_Id := Etype (Prefix (Nam));
213
 
214
            begin
215
               if Present (Component_Clause (Entity (Selector_Name (Nam))))
216
                 or else Has_Non_Standard_Rep (Rec_Type)
217
               then
218
                  return True;
219
 
220
               elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
221
                 and then Is_Record_Type (Rec_Type)
222
                 and then not Is_Concurrent_Record_Type (Rec_Type)
223
               then
224
                  return True;
225
 
226
               else
227
                  return Evaluation_Required (Prefix (Nam));
228
               end if;
229
            end;
230
 
231
         else
232
            return False;
233
         end if;
234
      end Evaluation_Required;
235
 
236
   --  Start of processing for Expand_N_Object_Renaming_Declaration
237
 
238
   begin
239
      --  Perform name evaluation if required
240
 
241
      if Evaluation_Required (Nam) then
242
         Evaluate_Name (Nam);
243
         Set_Is_Renaming_Of_Object (Defining_Identifier (N));
244
      end if;
245
 
246
      --  Deal with construction of subtype in class-wide case
247
 
248
      T := Etype (Defining_Identifier (N));
249
 
250
      if Is_Class_Wide_Type (T) then
251
         Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
252
         Find_Type (Subtype_Mark (N));
253
         Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
254
 
255
         --  Freeze the class-wide subtype here to ensure that the subtype
256
         --  and equivalent type are frozen before the renaming.
257
 
258
         Freeze_Before (N, Entity (Subtype_Mark (N)));
259
      end if;
260
 
261
      --  Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
262
      --  place function, then a temporary return object needs to be created
263
      --  and access to it must be passed to the function. Currently we limit
264
      --  such functions to those with inherently limited result subtypes, but
265
      --  eventually we plan to expand the functions that are treated as
266
      --  build-in-place to include other composite result types.
267
 
268
      if Ada_Version >= Ada_05
269
        and then Is_Build_In_Place_Function_Call (Nam)
270
      then
271
         Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
272
      end if;
273
 
274
      --  Create renaming entry for debug information
275
 
276
      Decl := Debug_Renaming_Declaration (N);
277
 
278
      if Present (Decl) then
279
         Insert_Action (N, Decl);
280
      end if;
281
   end Expand_N_Object_Renaming_Declaration;
282
 
283
   -------------------------------------------
284
   -- Expand_N_Package_Renaming_Declaration --
285
   -------------------------------------------
286
 
287
   procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is
288
      Decl : constant Node_Id := Debug_Renaming_Declaration (N);
289
 
290
   begin
291
      if Present (Decl) then
292
 
293
         --  If we are in a compilation unit, then this is an outer
294
         --  level declaration, and must have a scope of Standard
295
 
296
         if Nkind (Parent (N)) = N_Compilation_Unit then
297
            declare
298
               Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
299
 
300
            begin
301
               Push_Scope (Standard_Standard);
302
 
303
               if No (Actions (Aux)) then
304
                  Set_Actions (Aux, New_List (Decl));
305
               else
306
                  Append (Decl, Actions (Aux));
307
               end if;
308
 
309
               Analyze (Decl);
310
 
311
               --  Enter the debug variable in the qualification list, which
312
               --  must be done at this point because auxiliary declarations
313
               --  occur at the library level and aren't associated with a
314
               --  normal scope.
315
 
316
               Qualify_Entity_Names (Decl);
317
 
318
               Pop_Scope;
319
            end;
320
 
321
         --  Otherwise, just insert after the package declaration
322
 
323
         else
324
            Insert_Action (N, Decl);
325
         end if;
326
      end if;
327
   end Expand_N_Package_Renaming_Declaration;
328
 
329
   ----------------------------------------------
330
   -- Expand_N_Subprogram_Renaming_Declaration --
331
   ----------------------------------------------
332
 
333
   procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is
334
      Nam : constant Node_Id := Name (N);
335
 
336
   begin
337
      --  When the prefix of the name is a function call, we must force the
338
      --  call to be made by removing side effects from the call, since we
339
      --  must only call the function once.
340
 
341
      if Nkind (Nam) = N_Selected_Component
342
        and then Nkind (Prefix (Nam)) = N_Function_Call
343
      then
344
         Remove_Side_Effects (Prefix (Nam));
345
 
346
      --  For an explicit dereference, the prefix must be captured to prevent
347
      --  reevaluation on calls through the renaming, which could result in
348
      --  calling the wrong subprogram if the access value were to be changed.
349
 
350
      elsif Nkind (Nam) = N_Explicit_Dereference then
351
         Force_Evaluation (Prefix (Nam));
352
      end if;
353
   end Expand_N_Subprogram_Renaming_Declaration;
354
 
355
end Exp_Ch8;

powered by: WebSVN 2.1.0

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