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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [expander.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             E X P A N D E R                              --
6
--                                                                          --
7
--                                 B o d y                                  --
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 Atree;    use Atree;
27
with Debug_A;  use Debug_A;
28
with Errout;   use Errout;
29
with Exp_Aggr; use Exp_Aggr;
30
with Exp_Alfa; use Exp_Alfa;
31
with Exp_Attr; use Exp_Attr;
32
with Exp_Ch2;  use Exp_Ch2;
33
with Exp_Ch3;  use Exp_Ch3;
34
with Exp_Ch4;  use Exp_Ch4;
35
with Exp_Ch5;  use Exp_Ch5;
36
with Exp_Ch6;  use Exp_Ch6;
37
with Exp_Ch7;  use Exp_Ch7;
38
with Exp_Ch8;  use Exp_Ch8;
39
with Exp_Ch9;  use Exp_Ch9;
40
with Exp_Ch11; use Exp_Ch11;
41
with Exp_Ch12; use Exp_Ch12;
42
with Exp_Ch13; use Exp_Ch13;
43
with Exp_Prag; use Exp_Prag;
44
with Opt;      use Opt;
45
with Rtsfind;  use Rtsfind;
46
with Sem;      use Sem;
47
with Sem_Ch8;  use Sem_Ch8;
48
with Sem_Util; use Sem_Util;
49
with Sinfo;    use Sinfo;
50
with Table;
51
 
52
package body Expander is
53
 
54
   ----------------
55
   -- Local Data --
56
   ----------------
57
 
58
   --  The following table is used to save values of the Expander_Active flag
59
   --  when they are saved by Expander_Mode_Save_And_Set. We use an extendible
60
   --  table (which is a bit of overkill) because it is easier than figuring
61
   --  out a maximum value or bothering with range checks!
62
 
63
   package Expander_Flags is new Table.Table (
64
     Table_Component_Type => Boolean,
65
     Table_Index_Type     => Int,
66
     Table_Low_Bound      => 0,
67
     Table_Initial        => 32,
68
     Table_Increment      => 200,
69
     Table_Name           => "Expander_Flags");
70
 
71
   ------------
72
   -- Expand --
73
   ------------
74
 
75
   procedure Expand (N : Node_Id) is
76
   begin
77
      --  If we were analyzing a default expression (or other spec expression)
78
      --  the Full_Analysis flag must be off. If we are in expansion mode then
79
      --  we must be performing a full analysis. If we are analyzing a generic
80
      --  then Expansion must be off.
81
 
82
      pragma Assert
83
        (not (Full_Analysis and then In_Spec_Expression)
84
          and then (Full_Analysis or else not Expander_Active)
85
          and then not (Inside_A_Generic and then Expander_Active));
86
 
87
      --  There are three reasons for the Expander_Active flag to be false
88
      --
89
      --  The first is when are not generating code. In this mode the
90
      --  Full_Analysis flag indicates whether we are performing a complete
91
      --  analysis, in which case Full_Analysis = True or a pre-analysis in
92
      --  which case Full_Analysis = False. See the spec of Sem for more
93
      --  info on this.
94
      --
95
      --  The second reason for the Expander_Active flag to be False is that
96
      --  we are performing a pre-analysis. During pre-analysis all expansion
97
      --  activity is turned off to make sure nodes are semantically decorated
98
      --  but no extra nodes are generated. This is for instance needed for
99
      --  the first pass of aggregate semantic processing. Note that in this
100
      --  case the Full_Analysis flag is set to False because the node will
101
      --  subsequently be re-analyzed with expansion on (see the spec of sem).
102
 
103
      --  Finally, expansion is turned off in a regular compilation if there
104
      --  are serious errors. In that case there will be no further expansion,
105
      --  but one cleanup action may be required: if a transient scope was
106
      --  created (e.g. for a function that returns an unconstrained type) the
107
      --  scope may still be on the stack, and must be removed explicitly,
108
      --  given that the expansion actions that would normally process it will
109
      --  not take place. This prevents cascaded errors due to stack mismatch.
110
 
111
      if not Expander_Active then
112
         Set_Analyzed (N, Full_Analysis);
113
 
114
         if Serious_Errors_Detected > 0
115
           and then Scope_Is_Transient
116
         then
117
            Scope_Stack.Table
118
             (Scope_Stack.Last).Actions_To_Be_Wrapped_Before := No_List;
119
            Scope_Stack.Table
120
             (Scope_Stack.Last).Actions_To_Be_Wrapped_After  := No_List;
121
 
122
            Pop_Scope;
123
         end if;
124
 
125
         return;
126
 
127
      else
128
         Debug_A_Entry ("expanding  ", N);
129
 
130
         begin
131
            --  In Alfa mode we only need a very limited subset of the usual
132
            --  expansions. This limited subset is implemented in Expand_Alfa.
133
 
134
            if Alfa_Mode then
135
               Expand_Alfa (N);
136
 
137
            --  Here for normal non-Alfa mode
138
 
139
            else
140
               --  Processing depends on node kind. For full details on the
141
               --  expansion activity required in each case, see bodies of
142
               --  corresponding expand routines.
143
 
144
               case Nkind (N) is
145
 
146
                  when N_Abort_Statement =>
147
                     Expand_N_Abort_Statement (N);
148
 
149
                  when N_Accept_Statement =>
150
                     Expand_N_Accept_Statement (N);
151
 
152
                  when N_Aggregate =>
153
                     Expand_N_Aggregate (N);
154
 
155
                  when N_Allocator =>
156
                     Expand_N_Allocator (N);
157
 
158
                  when N_And_Then =>
159
                     Expand_N_And_Then (N);
160
 
161
                  when N_Assignment_Statement =>
162
                     Expand_N_Assignment_Statement (N);
163
 
164
                  when N_Asynchronous_Select =>
165
                     Expand_N_Asynchronous_Select (N);
166
 
167
                  when N_Attribute_Definition_Clause =>
168
                     Expand_N_Attribute_Definition_Clause (N);
169
 
170
                  when N_Attribute_Reference =>
171
                     Expand_N_Attribute_Reference (N);
172
 
173
                  when N_Block_Statement =>
174
                     Expand_N_Block_Statement (N);
175
 
176
                  when N_Case_Expression =>
177
                     Expand_N_Case_Expression (N);
178
 
179
                  when N_Case_Statement =>
180
                     Expand_N_Case_Statement (N);
181
 
182
                  when N_Conditional_Entry_Call =>
183
                     Expand_N_Conditional_Entry_Call (N);
184
 
185
                  when N_Conditional_Expression =>
186
                     Expand_N_Conditional_Expression (N);
187
 
188
                  when N_Delay_Relative_Statement =>
189
                     Expand_N_Delay_Relative_Statement (N);
190
 
191
                  when N_Delay_Until_Statement =>
192
                     Expand_N_Delay_Until_Statement (N);
193
 
194
                  when N_Entry_Body =>
195
                     Expand_N_Entry_Body (N);
196
 
197
                  when N_Entry_Call_Statement =>
198
                     Expand_N_Entry_Call_Statement (N);
199
 
200
                  when N_Entry_Declaration =>
201
                     Expand_N_Entry_Declaration (N);
202
 
203
                  when N_Exception_Declaration =>
204
                     Expand_N_Exception_Declaration (N);
205
 
206
                  when N_Exception_Renaming_Declaration =>
207
                     Expand_N_Exception_Renaming_Declaration (N);
208
 
209
                  when N_Exit_Statement =>
210
                     Expand_N_Exit_Statement (N);
211
 
212
                  when N_Expanded_Name =>
213
                     Expand_N_Expanded_Name (N);
214
 
215
                  when N_Explicit_Dereference =>
216
                     Expand_N_Explicit_Dereference (N);
217
 
218
                  when N_Expression_With_Actions =>
219
                     Expand_N_Expression_With_Actions (N);
220
 
221
                  when N_Extended_Return_Statement =>
222
                     Expand_N_Extended_Return_Statement (N);
223
 
224
                  when N_Extension_Aggregate =>
225
                     Expand_N_Extension_Aggregate (N);
226
 
227
                  when N_Free_Statement =>
228
                     Expand_N_Free_Statement (N);
229
 
230
                  when N_Freeze_Entity =>
231
                     Expand_N_Freeze_Entity (N);
232
 
233
                  when N_Full_Type_Declaration =>
234
                     Expand_N_Full_Type_Declaration (N);
235
 
236
                  when N_Function_Call =>
237
                     Expand_N_Function_Call (N);
238
 
239
                  when N_Generic_Instantiation =>
240
                     Expand_N_Generic_Instantiation (N);
241
 
242
                  when N_Goto_Statement =>
243
                     Expand_N_Goto_Statement (N);
244
 
245
                  when N_Handled_Sequence_Of_Statements =>
246
                     Expand_N_Handled_Sequence_Of_Statements (N);
247
 
248
                  when N_Identifier =>
249
                     Expand_N_Identifier (N);
250
 
251
                  when N_Indexed_Component =>
252
                     Expand_N_Indexed_Component (N);
253
 
254
                  when N_If_Statement =>
255
                     Expand_N_If_Statement (N);
256
 
257
                  when N_In =>
258
                     Expand_N_In (N);
259
 
260
                  when N_Loop_Statement =>
261
                     Expand_N_Loop_Statement (N);
262
 
263
                  when N_Not_In =>
264
                     Expand_N_Not_In (N);
265
 
266
                  when N_Null =>
267
                     Expand_N_Null (N);
268
 
269
                  when N_Object_Declaration =>
270
                     Expand_N_Object_Declaration (N);
271
 
272
                  when N_Object_Renaming_Declaration =>
273
                     Expand_N_Object_Renaming_Declaration (N);
274
 
275
                  when N_Op_Add =>
276
                     Expand_N_Op_Add (N);
277
 
278
                  when N_Op_Abs =>
279
                     Expand_N_Op_Abs (N);
280
 
281
                  when N_Op_And =>
282
                     Expand_N_Op_And (N);
283
 
284
                  when N_Op_Concat =>
285
                     Expand_N_Op_Concat (N);
286
 
287
                  when N_Op_Divide =>
288
                     Expand_N_Op_Divide (N);
289
 
290
                  when N_Op_Eq =>
291
                     Expand_N_Op_Eq (N);
292
 
293
                  when N_Op_Expon =>
294
                     Expand_N_Op_Expon (N);
295
 
296
                  when N_Op_Ge =>
297
                     Expand_N_Op_Ge (N);
298
 
299
                  when N_Op_Gt =>
300
                     Expand_N_Op_Gt (N);
301
 
302
                  when N_Op_Le =>
303
                     Expand_N_Op_Le (N);
304
 
305
                  when N_Op_Lt =>
306
                     Expand_N_Op_Lt (N);
307
 
308
                  when N_Op_Minus =>
309
                     Expand_N_Op_Minus (N);
310
 
311
                  when N_Op_Mod =>
312
                     Expand_N_Op_Mod (N);
313
 
314
                  when N_Op_Multiply =>
315
                     Expand_N_Op_Multiply (N);
316
 
317
                  when N_Op_Ne =>
318
                     Expand_N_Op_Ne (N);
319
 
320
                  when N_Op_Not =>
321
                     Expand_N_Op_Not (N);
322
 
323
                  when N_Op_Or =>
324
                     Expand_N_Op_Or (N);
325
 
326
                  when N_Op_Plus =>
327
                     Expand_N_Op_Plus (N);
328
 
329
                  when N_Op_Rem =>
330
                     Expand_N_Op_Rem (N);
331
 
332
                  when N_Op_Rotate_Left =>
333
                     Expand_N_Op_Rotate_Left (N);
334
 
335
                  when N_Op_Rotate_Right =>
336
                     Expand_N_Op_Rotate_Right (N);
337
 
338
                  when N_Op_Shift_Left =>
339
                     Expand_N_Op_Shift_Left (N);
340
 
341
                  when N_Op_Shift_Right =>
342
                     Expand_N_Op_Shift_Right (N);
343
 
344
                  when N_Op_Shift_Right_Arithmetic =>
345
                     Expand_N_Op_Shift_Right_Arithmetic (N);
346
 
347
                  when N_Op_Subtract =>
348
                     Expand_N_Op_Subtract (N);
349
 
350
                  when N_Op_Xor =>
351
                     Expand_N_Op_Xor (N);
352
 
353
                  when N_Or_Else =>
354
                     Expand_N_Or_Else (N);
355
 
356
                  when N_Package_Body =>
357
                     Expand_N_Package_Body (N);
358
 
359
                  when N_Package_Declaration =>
360
                     Expand_N_Package_Declaration (N);
361
 
362
                  when N_Package_Renaming_Declaration =>
363
                     Expand_N_Package_Renaming_Declaration (N);
364
 
365
                  when N_Subprogram_Renaming_Declaration =>
366
                     Expand_N_Subprogram_Renaming_Declaration (N);
367
 
368
                  when N_Pragma =>
369
                     Expand_N_Pragma (N);
370
 
371
                  when N_Procedure_Call_Statement =>
372
                     Expand_N_Procedure_Call_Statement (N);
373
 
374
                  when N_Protected_Type_Declaration =>
375
                     Expand_N_Protected_Type_Declaration (N);
376
 
377
                  when N_Protected_Body =>
378
                     Expand_N_Protected_Body (N);
379
 
380
                  when N_Qualified_Expression =>
381
                     Expand_N_Qualified_Expression (N);
382
 
383
                  when N_Quantified_Expression  =>
384
                     Expand_N_Quantified_Expression (N);
385
 
386
                  when N_Raise_Statement =>
387
                     Expand_N_Raise_Statement (N);
388
 
389
                  when N_Raise_Constraint_Error =>
390
                     Expand_N_Raise_Constraint_Error (N);
391
 
392
                  when N_Raise_Program_Error =>
393
                     Expand_N_Raise_Program_Error (N);
394
 
395
                  when N_Raise_Storage_Error =>
396
                     Expand_N_Raise_Storage_Error (N);
397
 
398
                  when N_Real_Literal =>
399
                     Expand_N_Real_Literal (N);
400
 
401
                  when N_Record_Representation_Clause =>
402
                     Expand_N_Record_Representation_Clause (N);
403
 
404
                  when N_Requeue_Statement =>
405
                     Expand_N_Requeue_Statement (N);
406
 
407
                  when N_Simple_Return_Statement =>
408
                     Expand_N_Simple_Return_Statement (N);
409
 
410
                  when N_Selected_Component =>
411
                     Expand_N_Selected_Component (N);
412
 
413
                  when N_Selective_Accept =>
414
                     Expand_N_Selective_Accept (N);
415
 
416
                  when N_Single_Task_Declaration =>
417
                     Expand_N_Single_Task_Declaration (N);
418
 
419
                  when N_Slice =>
420
                     Expand_N_Slice (N);
421
 
422
                  when N_Subtype_Indication =>
423
                     Expand_N_Subtype_Indication (N);
424
 
425
                  when N_Subprogram_Body =>
426
                     Expand_N_Subprogram_Body (N);
427
 
428
                  when N_Subprogram_Body_Stub =>
429
                     Expand_N_Subprogram_Body_Stub (N);
430
 
431
                  when N_Subprogram_Declaration =>
432
                     Expand_N_Subprogram_Declaration (N);
433
 
434
                  when N_Subprogram_Info =>
435
                     Expand_N_Subprogram_Info (N);
436
 
437
                  when N_Task_Body =>
438
                     Expand_N_Task_Body (N);
439
 
440
                  when N_Task_Type_Declaration =>
441
                     Expand_N_Task_Type_Declaration (N);
442
 
443
                  when N_Timed_Entry_Call =>
444
                     Expand_N_Timed_Entry_Call (N);
445
 
446
                  when N_Type_Conversion =>
447
                     Expand_N_Type_Conversion (N);
448
 
449
                  when N_Unchecked_Expression =>
450
                     Expand_N_Unchecked_Expression (N);
451
 
452
                  when N_Unchecked_Type_Conversion =>
453
                     Expand_N_Unchecked_Type_Conversion (N);
454
 
455
                  when N_Variant_Part =>
456
                     Expand_N_Variant_Part (N);
457
 
458
                  --  For all other node kinds, no expansion activity required
459
 
460
                  when others =>
461
                     null;
462
 
463
               end case;
464
            end if;
465
 
466
         exception
467
            when RE_Not_Available =>
468
               return;
469
         end;
470
 
471
         --  Set result as analyzed and then do a possible transient wrap. The
472
         --  transient wrap must be done after the Analyzed flag is set on, so
473
         --  that we do not get a recursive attempt to expand the node N.
474
 
475
         Set_Analyzed (N);
476
 
477
         --  Deal with transient scopes
478
 
479
         if Scope_Is_Transient and then N = Node_To_Be_Wrapped then
480
            case Nkind (N) is
481
               when N_Statement_Other_Than_Procedure_Call |
482
                    N_Procedure_Call_Statement            =>
483
                  Wrap_Transient_Statement (N);
484
 
485
               when N_Object_Declaration          |
486
                    N_Object_Renaming_Declaration |
487
                    N_Subtype_Declaration         =>
488
                  Wrap_Transient_Declaration (N);
489
 
490
               when others => Wrap_Transient_Expression (N);
491
            end case;
492
         end if;
493
 
494
         Debug_A_Exit ("expanding  ", N, "  (done)");
495
      end if;
496
   end Expand;
497
 
498
   ---------------------------
499
   -- Expander_Mode_Restore --
500
   ---------------------------
501
 
502
   procedure Expander_Mode_Restore is
503
   begin
504
      --  Not active (has no effect) in ASIS mode (see comments in spec of
505
      --  Expander_Mode_Save_And_Set).
506
 
507
      if ASIS_Mode then
508
         return;
509
      end if;
510
 
511
      --  Otherwise restore the flag
512
 
513
      Expander_Active := Expander_Flags.Table (Expander_Flags.Last);
514
      Expander_Flags.Decrement_Last;
515
 
516
      --  Keep expander off if serious errors detected. In this case we do not
517
      --  need expansion, and continued expansion may cause cascaded errors or
518
      --  compiler bombs.
519
 
520
      if Serious_Errors_Detected /= 0 then
521
         Expander_Active := False;
522
      end if;
523
   end Expander_Mode_Restore;
524
 
525
   --------------------------------
526
   -- Expander_Mode_Save_And_Set --
527
   --------------------------------
528
 
529
   procedure Expander_Mode_Save_And_Set (Status : Boolean) is
530
   begin
531
      --  Not active (has no effect) in ASIS mode (see comments in spec of
532
      --  Expander_Mode_Save_And_Set).
533
 
534
      if ASIS_Mode then
535
         return;
536
      end if;
537
 
538
      --  Otherwise save and set the flag
539
 
540
      Expander_Flags.Increment_Last;
541
      Expander_Flags.Table (Expander_Flags.Last) := Expander_Active;
542
      Expander_Active := Status;
543
   end Expander_Mode_Save_And_Set;
544
 
545
end Expander;

powered by: WebSVN 2.1.0

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