?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / ada / exp_disp.adb
blob0d203b6d289336f3ef37f544603e7ee4ea6c5294
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ D I S P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2003 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 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
26
27 with Atree; use Atree;
28 with Checks; use Checks;
29 with Einfo; use Einfo;
30 with Elists; use Elists;
31 with Errout; use Errout;
32 with Exp_Ch7; use Exp_Ch7;
33 with Exp_Tss; use Exp_Tss;
34 with Exp_Util; use Exp_Util;
35 with Fname; use Fname;
36 with Itypes; use Itypes;
37 with Lib; use Lib;
38 with Nlists; use Nlists;
39 with Nmake; use Nmake;
40 with Opt; use Opt;
41 with Rtsfind; use Rtsfind;
42 with Sem_Disp; use Sem_Disp;
43 with Sem_Res; use Sem_Res;
44 with Sem_Util; use Sem_Util;
45 with Sinfo; use Sinfo;
46 with Snames; use Snames;
47 with Stand; use Stand;
48 with Tbuild; use Tbuild;
49 with Uintp; use Uintp;
50
51 package body Exp_Disp is
52
53 Ada_Actions : constant array (DT_Access_Action) of RE_Id :=
54 (CW_Membership => RE_CW_Membership,
55 DT_Entry_Size => RE_DT_Entry_Size,
56 DT_Prologue_Size => RE_DT_Prologue_Size,
57 Get_Expanded_Name => RE_Get_Expanded_Name,
58 Get_External_Tag => RE_Get_External_Tag,
59 Get_Prim_Op_Address => RE_Get_Prim_Op_Address,
60 Get_RC_Offset => RE_Get_RC_Offset,
61 Get_Remotely_Callable => RE_Get_Remotely_Callable,
62 Get_TSD => RE_Get_TSD,
63 Inherit_DT => RE_Inherit_DT,
64 Inherit_TSD => RE_Inherit_TSD,
65 Register_Tag => RE_Register_Tag,
66 Set_Expanded_Name => RE_Set_Expanded_Name,
67 Set_External_Tag => RE_Set_External_Tag,
68 Set_Prim_Op_Address => RE_Set_Prim_Op_Address,
69 Set_RC_Offset => RE_Set_RC_Offset,
70 Set_Remotely_Callable => RE_Set_Remotely_Callable,
71 Set_TSD => RE_Set_TSD,
72 TSD_Entry_Size => RE_TSD_Entry_Size,
73 TSD_Prologue_Size => RE_TSD_Prologue_Size);
74
75 CPP_Actions : constant array (DT_Access_Action) of RE_Id :=
76 (CW_Membership => RE_CPP_CW_Membership,
77 DT_Entry_Size => RE_CPP_DT_Entry_Size,
78 DT_Prologue_Size => RE_CPP_DT_Prologue_Size,
79 Get_Expanded_Name => RE_CPP_Get_Expanded_Name,
80 Get_External_Tag => RE_CPP_Get_External_Tag,
81 Get_Prim_Op_Address => RE_CPP_Get_Prim_Op_Address,
82 Get_RC_Offset => RE_CPP_Get_RC_Offset,
83 Get_Remotely_Callable => RE_CPP_Get_Remotely_Callable,
84 Get_TSD => RE_CPP_Get_TSD,
85 Inherit_DT => RE_CPP_Inherit_DT,
86 Inherit_TSD => RE_CPP_Inherit_TSD,
87 Register_Tag => RE_CPP_Register_Tag,
88 Set_Expanded_Name => RE_CPP_Set_Expanded_Name,
89 Set_External_Tag => RE_CPP_Set_External_Tag,
90 Set_Prim_Op_Address => RE_CPP_Set_Prim_Op_Address,
91 Set_RC_Offset => RE_CPP_Set_RC_Offset,
92 Set_Remotely_Callable => RE_CPP_Set_Remotely_Callable,
93 Set_TSD => RE_CPP_Set_TSD,
94 TSD_Entry_Size => RE_CPP_TSD_Entry_Size,
95 TSD_Prologue_Size => RE_CPP_TSD_Prologue_Size);
96
97 Action_Is_Proc : constant array (DT_Access_Action) of Boolean :=
98 (CW_Membership => False,
99 DT_Entry_Size => False,
100 DT_Prologue_Size => False,
101 Get_Expanded_Name => False,
102 Get_External_Tag => False,
103 Get_Prim_Op_Address => False,
104 Get_Remotely_Callable => False,
105 Get_RC_Offset => False,
106 Get_TSD => False,
107 Inherit_DT => True,
108 Inherit_TSD => True,
109 Register_Tag => True,
110 Set_Expanded_Name => True,
111 Set_External_Tag => True,
112 Set_Prim_Op_Address => True,
113 Set_RC_Offset => True,
114 Set_Remotely_Callable => True,
115 Set_TSD => True,
116 TSD_Entry_Size => False,
117 TSD_Prologue_Size => False);
118
119 Action_Nb_Arg : constant array (DT_Access_Action) of Int :=
120 (CW_Membership => 2,
121 DT_Entry_Size => 0,
122 DT_Prologue_Size => 0,
123 Get_Expanded_Name => 1,
124 Get_External_Tag => 1,
125 Get_Prim_Op_Address => 2,
126 Get_RC_Offset => 1,
127 Get_Remotely_Callable => 1,
128 Get_TSD => 1,
129 Inherit_DT => 3,
130 Inherit_TSD => 2,
131 Register_Tag => 1,
132 Set_Expanded_Name => 2,
133 Set_External_Tag => 2,
134 Set_Prim_Op_Address => 3,
135 Set_RC_Offset => 2,
136 Set_Remotely_Callable => 2,
137 Set_TSD => 2,
138 TSD_Entry_Size => 0,
139 TSD_Prologue_Size => 0);
140
141 function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean;
142 -- Check if the type has a private view or if the public view appears
143 -- in the visible part of a package spec.
144
145 --------------------------
146 -- Expand_Dispatch_Call --
147 --------------------------
148
149 procedure Expand_Dispatch_Call (Call_Node : Node_Id) is
150 Loc : constant Source_Ptr := Sloc (Call_Node);
151 Call_Typ : constant Entity_Id := Etype (Call_Node);
152
153 Ctrl_Arg : constant Node_Id := Controlling_Argument (Call_Node);
154 Param_List : constant List_Id := Parameter_Associations (Call_Node);
155 Subp : Entity_Id := Entity (Name (Call_Node));
156
157 CW_Typ : Entity_Id;
158 New_Call : Node_Id;
159 New_Call_Name : Node_Id;
160 New_Params : List_Id := No_List;
161 Param : Node_Id;
162 Res_Typ : Entity_Id;
163 Subp_Ptr_Typ : Entity_Id;
164 Subp_Typ : Entity_Id;
165 Typ : Entity_Id;
166 Eq_Prim_Op : Entity_Id := Empty;
167
168 function New_Value (From : Node_Id) return Node_Id;
169 -- From is the original Expression. New_Value is equivalent to a call
170 -- to Duplicate_Subexpr with an explicit dereference when From is an
171 -- access parameter
172
173 ---------------
174 -- New_Value --
175 ---------------
176
177 function New_Value (From : Node_Id) return Node_Id is
178 Res : constant Node_Id := Duplicate_Subexpr (From);
179
180 begin
181 if Is_Access_Type (Etype (From)) then
182 return Make_Explicit_Dereference (Sloc (From), Res);
183 else
184 return Res;
185 end if;
186 end New_Value;
187
188 -- Start of processing for Expand_Dispatch_Call
189
190 begin
191 -- If this is an inherited operation that was overriden, the body
192 -- that is being called is its alias.
193
194 if Present (Alias (Subp))
195 and then Is_Inherited_Operation (Subp)
196 and then No (DTC_Entity (Subp))
197 then
198 Subp := Alias (Subp);
199 end if;
200
201 -- Expand_Dispatch is called directly from the semantics, so we need
202 -- a check to see whether expansion is active before proceeding
203
204 if not Expander_Active then
205 return;
206 end if;
207
208 -- Definition of the ClassWide Type and the Tagged type
209
210 if Is_Access_Type (Etype (Ctrl_Arg)) then
211 CW_Typ := Designated_Type (Etype (Ctrl_Arg));
212 else
213 CW_Typ := Etype (Ctrl_Arg);
214 end if;
215
216 Typ := Root_Type (CW_Typ);
217
218 if not Is_Limited_Type (Typ) then
219 Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
220 end if;
221
222 if Is_CPP_Class (Root_Type (Typ)) then
223
224 -- Create a new parameter list with the displaced 'this'
225
226 New_Params := New_List;
227 Param := First_Actual (Call_Node);
228 while Present (Param) loop
229
230 -- We assume that dispatching through the main dispatch table
231 -- (referenced by Tag_Component) doesn't require a displacement
232 -- so the expansion below is only done when dispatching on
233 -- another vtable pointer, in which case the first argument
234 -- is expanded into :
235
236 -- typ!(Displaced_This (Address!(Param)))
237
238 if Param = Ctrl_Arg
239 and then DTC_Entity (Subp) /= Tag_Component (Typ)
240 then
241 Append_To (New_Params,
242
243 Unchecked_Convert_To (Etype (Param),
244 Make_Function_Call (Loc,
245 Name => New_Reference_To (RTE (RE_Displaced_This), Loc),
246 Parameter_Associations => New_List (
247
248 -- Current_This
249
250 Make_Unchecked_Type_Conversion (Loc,
251 Subtype_Mark =>
252 New_Reference_To (RTE (RE_Address), Loc),
253 Expression => Relocate_Node (Param)),
254
255 -- Vptr
256
257 Make_Selected_Component (Loc,
258 Prefix => Duplicate_Subexpr (Ctrl_Arg),
259 Selector_Name =>
260 New_Reference_To (DTC_Entity (Subp), Loc)),
261
262 -- Position
263
264 Make_Integer_Literal (Loc, DT_Position (Subp))))));
265
266 else
267 Append_To (New_Params, Relocate_Node (Param));
268 end if;
269
270 Next_Actual (Param);
271 end loop;
272
273 elsif Present (Param_List) then
274
275 -- Generate the Tag checks when appropriate
276
277 New_Params := New_List;
278
279 Param := First_Actual (Call_Node);
280 while Present (Param) loop
281
282 -- No tag check with itself
283
284 if Param = Ctrl_Arg then
285 Append_To (New_Params,
286 Duplicate_Subexpr_Move_Checks (Param));
287
288 -- No tag check for parameter whose type is neither tagged nor
289 -- access to tagged (for access parameters)
290
291 elsif No (Find_Controlling_Arg (Param)) then
292 Append_To (New_Params, Relocate_Node (Param));
293
294 -- No tag check for function dispatching on result it the
295 -- Tag given by the context is this one
296
297 elsif Find_Controlling_Arg (Param) = Ctrl_Arg then
298 Append_To (New_Params, Relocate_Node (Param));
299
300 -- "=" is the only dispatching operation allowed to get
301 -- operands with incompatible tags (it just returns false).
302 -- We use Duplicate_Subexpr_Move_Checks instead of calling
303 -- Relocate_Node because the value will be duplicated to
304 -- check the tags.
305
306 elsif Subp = Eq_Prim_Op then
307 Append_To (New_Params,
308 Duplicate_Subexpr_Move_Checks (Param));
309
310 -- No check in presence of suppress flags
311
312 elsif Tag_Checks_Suppressed (Etype (Param))
313 or else (Is_Access_Type (Etype (Param))
314 and then Tag_Checks_Suppressed
315 (Designated_Type (Etype (Param))))
316 then
317 Append_To (New_Params, Relocate_Node (Param));
318
319 -- Optimization: no tag checks if the parameters are identical
320
321 elsif Is_Entity_Name (Param)
322 and then Is_Entity_Name (Ctrl_Arg)
323 and then Entity (Param) = Entity (Ctrl_Arg)
324 then
325 Append_To (New_Params, Relocate_Node (Param));
326
327 -- Now we need to generate the Tag check
328
329 else
330 -- Generate code for tag equality check
331 -- Perhaps should have Checks.Apply_Tag_Equality_Check???
332
333 Insert_Action (Ctrl_Arg,
334 Make_Implicit_If_Statement (Call_Node,
335 Condition =>
336 Make_Op_Ne (Loc,
337 Left_Opnd =>
338 Make_Selected_Component (Loc,
339 Prefix => New_Value (Ctrl_Arg),
340 Selector_Name =>
341 New_Reference_To (Tag_Component (Typ), Loc)),
342
343 Right_Opnd =>
344 Make_Selected_Component (Loc,
345 Prefix =>
346 Unchecked_Convert_To (Typ, New_Value (Param)),
347 Selector_Name =>
348 New_Reference_To (Tag_Component (Typ), Loc))),
349
350 Then_Statements =>
351 New_List (New_Constraint_Error (Loc))));
352
353 Append_To (New_Params, Relocate_Node (Param));
354 end if;
355
356 Next_Actual (Param);
357 end loop;
358 end if;
359
360 -- Generate the appropriate subprogram pointer type
361
362 if Etype (Subp) = Typ then
363 Res_Typ := CW_Typ;
364 else
365 Res_Typ := Etype (Subp);
366 end if;
367
368 Subp_Typ := Create_Itype (E_Subprogram_Type, Call_Node);
369 Subp_Ptr_Typ := Create_Itype (E_Access_Subprogram_Type, Call_Node);
370 Set_Etype (Subp_Typ, Res_Typ);
371 Init_Size_Align (Subp_Ptr_Typ);
372 Set_Returns_By_Ref (Subp_Typ, Returns_By_Ref (Subp));
373
374 -- Create a new list of parameters which is a copy of the old formal
375 -- list including the creation of a new set of matching entities.
376
377 declare
378 Old_Formal : Entity_Id := First_Formal (Subp);
379 New_Formal : Entity_Id;
380 Extra : Entity_Id;
381
382 begin
383 if Present (Old_Formal) then
384 New_Formal := New_Copy (Old_Formal);
385 Set_First_Entity (Subp_Typ, New_Formal);
386 Param := First_Actual (Call_Node);
387
388 loop
389 Set_Scope (New_Formal, Subp_Typ);
390
391 -- Change all the controlling argument types to be class-wide
392 -- to avoid a recursion in dispatching
393
394 if Is_Controlling_Actual (Param) then
395 Set_Etype (New_Formal, Etype (Param));
396 end if;
397
398 if Is_Itype (Etype (New_Formal)) then
399 Extra := New_Copy (Etype (New_Formal));
400
401 if Ekind (Extra) = E_Record_Subtype
402 or else Ekind (Extra) = E_Class_Wide_Subtype
403 then
404 Set_Cloned_Subtype (Extra, Etype (New_Formal));
405 end if;
406
407 Set_Etype (New_Formal, Extra);
408 Set_Scope (Etype (New_Formal), Subp_Typ);
409 end if;
410
411 Extra := New_Formal;
412 Next_Formal (Old_Formal);
413 exit when No (Old_Formal);
414
415 Set_Next_Entity (New_Formal, New_Copy (Old_Formal));
416 Next_Entity (New_Formal);
417 Next_Actual (Param);
418 end loop;
419 Set_Last_Entity (Subp_Typ, Extra);
420
421 -- Copy extra formals
422
423 New_Formal := First_Entity (Subp_Typ);
424 while Present (New_Formal) loop
425 if Present (Extra_Constrained (New_Formal)) then
426 Set_Extra_Formal (Extra,
427 New_Copy (Extra_Constrained (New_Formal)));
428 Extra := Extra_Formal (Extra);
429 Set_Extra_Constrained (New_Formal, Extra);
430
431 elsif Present (Extra_Accessibility (New_Formal)) then
432 Set_Extra_Formal (Extra,
433 New_Copy (Extra_Accessibility (New_Formal)));
434 Extra := Extra_Formal (Extra);
435 Set_Extra_Accessibility (New_Formal, Extra);
436 end if;
437
438 Next_Formal (New_Formal);
439 end loop;
440 end if;
441 end;
442
443 Set_Etype (Subp_Ptr_Typ, Subp_Ptr_Typ);
444 Set_Directly_Designated_Type (Subp_Ptr_Typ, Subp_Typ);
445
446 -- Generate:
447 -- Subp_Ptr_Typ!(Get_Prim_Op_Address (Ctrl._Tag, pos));
448
449 New_Call_Name :=
450 Unchecked_Convert_To (Subp_Ptr_Typ,
451 Make_DT_Access_Action (Typ,
452 Action => Get_Prim_Op_Address,
453 Args => New_List (
454
455 -- Vptr
456
457 Make_Selected_Component (Loc,
458 Prefix => Duplicate_Subexpr_Move_Checks (Ctrl_Arg),
459 Selector_Name => New_Reference_To (DTC_Entity (Subp), Loc)),
460
461 -- Position
462
463 Make_Integer_Literal (Loc, DT_Position (Subp)))));
464
465 if Nkind (Call_Node) = N_Function_Call then
466 New_Call :=
467 Make_Function_Call (Loc,
468 Name => New_Call_Name,
469 Parameter_Associations => New_Params);
470
471 -- if this is a dispatching "=", we must first compare the tags so
472 -- we generate: x.tag = y.tag and then x = y
473
474 if Subp = Eq_Prim_Op then
475
476 Param := First_Actual (Call_Node);
477 New_Call :=
478 Make_And_Then (Loc,
479 Left_Opnd =>
480 Make_Op_Eq (Loc,
481 Left_Opnd =>
482 Make_Selected_Component (Loc,
483 Prefix => New_Value (Param),
484 Selector_Name =>
485 New_Reference_To (Tag_Component (Typ), Loc)),
486
487 Right_Opnd =>
488 Make_Selected_Component (Loc,
489 Prefix =>
490 Unchecked_Convert_To (Typ,
491 New_Value (Next_Actual (Param))),
492 Selector_Name =>
493 New_Reference_To (Tag_Component (Typ), Loc))),
494
495 Right_Opnd => New_Call);
496 end if;
497
498 else
499 New_Call :=
500 Make_Procedure_Call_Statement (Loc,
501 Name => New_Call_Name,
502 Parameter_Associations => New_Params);
503 end if;
504
505 Rewrite (Call_Node, New_Call);
506 Analyze_And_Resolve (Call_Node, Call_Typ);
507 end Expand_Dispatch_Call;
508
509 -------------
510 -- Fill_DT --
511 -------------
512
513 function Fill_DT_Entry
514 (Loc : Source_Ptr;
515 Prim : Entity_Id)
516 return Node_Id
517 is
518 Typ : constant Entity_Id := Scope (DTC_Entity (Prim));
519 DT_Ptr : constant Entity_Id := Access_Disp_Table (Typ);
520
521 begin
522 return
523 Make_DT_Access_Action (Typ,
524 Action => Set_Prim_Op_Address,
525 Args => New_List (
526 New_Reference_To (DT_Ptr, Loc), -- DTptr
527
528 Make_Integer_Literal (Loc, DT_Position (Prim)), -- Position
529
530 Make_Attribute_Reference (Loc, -- Value
531 Prefix => New_Reference_To (Prim, Loc),
532 Attribute_Name => Name_Address)));
533 end Fill_DT_Entry;
534
535 ---------------------------
536 -- Get_Remotely_Callable --
537 ---------------------------
538
539 function Get_Remotely_Callable (Obj : Node_Id) return Node_Id is
540 Loc : constant Source_Ptr := Sloc (Obj);
541
542 begin
543 return Make_DT_Access_Action
544 (Typ => Etype (Obj),
545 Action => Get_Remotely_Callable,
546 Args => New_List (
547 Make_Selected_Component (Loc,
548 Prefix => Obj,
549 Selector_Name => Make_Identifier (Loc, Name_uTag))));
550 end Get_Remotely_Callable;
551
552 -------------
553 -- Make_DT --
554 -------------
555
556 function Make_DT (Typ : Entity_Id) return List_Id is
557 Loc : constant Source_Ptr := Sloc (Typ);
558
559 Result : constant List_Id := New_List;
560 Elab_Code : constant List_Id := New_List;
561
562 Tname : constant Name_Id := Chars (Typ);
563 Name_DT : constant Name_Id := New_External_Name (Tname, 'T');
564 Name_DT_Ptr : constant Name_Id := New_External_Name (Tname, 'P');
565 Name_TSD : constant Name_Id := New_External_Name (Tname, 'B');
566 Name_Exname : constant Name_Id := New_External_Name (Tname, 'E');
567 Name_No_Reg : constant Name_Id := New_External_Name (Tname, 'F');
568
569 DT : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT);
570 DT_Ptr : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT_Ptr);
571 TSD : constant Node_Id := Make_Defining_Identifier (Loc, Name_TSD);
572 Exname : constant Node_Id := Make_Defining_Identifier (Loc, Name_Exname);
573 No_Reg : constant Node_Id := Make_Defining_Identifier (Loc, Name_No_Reg);
574
575 I_Depth : Int;
576 Generalized_Tag : Entity_Id;
577 Size_Expr_Node : Node_Id;
578 Old_Tag : Node_Id;
579 Old_TSD : Node_Id;
580
581 begin
582 if not RTE_Available (RE_Tag) then
583 Error_Msg_CRT ("tagged types", Typ);
584 return New_List;
585 end if;
586
587 if Is_CPP_Class (Root_Type (Typ)) then
588 Generalized_Tag := RTE (RE_Vtable_Ptr);
589 else
590 Generalized_Tag := RTE (RE_Tag);
591 end if;
592
593 -- Dispatch table and related entities are allocated statically
594
595 Set_Ekind (DT, E_Variable);
596 Set_Is_Statically_Allocated (DT);
597
598 Set_Ekind (DT_Ptr, E_Variable);
599 Set_Is_Statically_Allocated (DT_Ptr);
600
601 Set_Ekind (TSD, E_Variable);
602 Set_Is_Statically_Allocated (TSD);
603
604 Set_Ekind (Exname, E_Variable);
605 Set_Is_Statically_Allocated (Exname);
606
607 Set_Ekind (No_Reg, E_Variable);
608 Set_Is_Statically_Allocated (No_Reg);
609
610 -- Generate code to create the storage for the Dispatch_Table object:
611
612 -- DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
613 -- for DT'Alignment use Address'Alignment
614
615 Size_Expr_Node :=
616 Make_Op_Add (Loc,
617 Left_Opnd => Make_DT_Access_Action (Typ, DT_Prologue_Size, No_List),
618 Right_Opnd =>
619 Make_Op_Multiply (Loc,
620 Left_Opnd =>
621 Make_DT_Access_Action (Typ, DT_Entry_Size, No_List),
622 Right_Opnd =>
623 Make_Integer_Literal (Loc,
624 DT_Entry_Count (Tag_Component (Typ)))));
625
626 Append_To (Result,
627 Make_Object_Declaration (Loc,
628 Defining_Identifier => DT,
629 Aliased_Present => True,
630 Object_Definition =>
631 Make_Subtype_Indication (Loc,
632 Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
633 Constraint => Make_Index_Or_Discriminant_Constraint (Loc,
634 Constraints => New_List (
635 Make_Range (Loc,
636 Low_Bound => Make_Integer_Literal (Loc, 1),
637 High_Bound => Size_Expr_Node))))));
638
639 Append_To (Result,
640 Make_Attribute_Definition_Clause (Loc,
641 Name => New_Reference_To (DT, Loc),
642 Chars => Name_Alignment,
643 Expression =>
644 Make_Attribute_Reference (Loc,
645 Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
646 Attribute_Name => Name_Alignment)));
647
648 -- Generate code to create the pointer to the dispatch table
649
650 -- DT_Ptr : Tag := Tag!(DT'Address); Ada case
651 -- or
652 -- DT_Ptr : Vtable_Ptr := Vtable_Ptr!(DT'Address); CPP case
653
654 Append_To (Result,
655 Make_Object_Declaration (Loc,
656 Defining_Identifier => DT_Ptr,
657 Constant_Present => True,
658 Object_Definition => New_Reference_To (Generalized_Tag, Loc),
659 Expression =>
660 Unchecked_Convert_To (Generalized_Tag,
661 Make_Attribute_Reference (Loc,
662 Prefix => New_Reference_To (DT, Loc),
663 Attribute_Name => Name_Address))));
664
665 -- Generate code to define the boolean that controls registration, in
666 -- order to avoid multiple registrations for tagged types defined in
667 -- multiple-called scopes
668
669 Append_To (Result,
670 Make_Object_Declaration (Loc,
671 Defining_Identifier => No_Reg,
672 Object_Definition => New_Reference_To (Standard_Boolean, Loc),
673 Expression => New_Reference_To (Standard_True, Loc)));
674
675 -- Set Access_Disp_Table field to be the dispatch table pointer
676
677 Set_Access_Disp_Table (Typ, DT_Ptr);
678
679 -- Count ancestors to compute the inheritance depth. For private
680 -- extensions, always go to the full view in order to compute the real
681 -- inheritance depth.
682
683 declare
684 Parent_Type : Entity_Id := Typ;
685 P : Entity_Id;
686
687 begin
688 I_Depth := 0;
689
690 loop
691 P := Etype (Parent_Type);
692
693 if Is_Private_Type (P) then
694 P := Full_View (Base_Type (P));
695 end if;
696
697 exit when P = Parent_Type;
698
699 I_Depth := I_Depth + 1;
700 Parent_Type := P;
701 end loop;
702 end;
703
704 -- Generate code to create the storage for the type specific data object
705
706 -- TSD: Storage_Array (1..TSD_Prologue_Size+(1+Idepth)*TSD_Entry_Size);
707 -- for TSD'Alignment use Address'Alignment
708
709 Size_Expr_Node :=
710 Make_Op_Add (Loc,
711 Left_Opnd =>
712 Make_DT_Access_Action (Typ, TSD_Prologue_Size, No_List),
713 Right_Opnd =>
714 Make_Op_Multiply (Loc,
715 Left_Opnd =>
716 Make_DT_Access_Action (Typ, TSD_Entry_Size, No_List),
717 Right_Opnd =>
718 Make_Op_Add (Loc,
719 Left_Opnd => Make_Integer_Literal (Loc, 1),
720 Right_Opnd =>
721 Make_Integer_Literal (Loc, I_Depth))));
722
723 Append_To (Result,
724 Make_Object_Declaration (Loc,
725 Defining_Identifier => TSD,
726 Aliased_Present => True,
727 Object_Definition =>
728 Make_Subtype_Indication (Loc,
729 Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
730 Constraint => Make_Index_Or_Discriminant_Constraint (Loc,
731 Constraints => New_List (
732 Make_Range (Loc,
733 Low_Bound => Make_Integer_Literal (Loc, 1),
734 High_Bound => Size_Expr_Node))))));
735
736 Append_To (Result,
737 Make_Attribute_Definition_Clause (Loc,
738 Name => New_Reference_To (TSD, Loc),
739 Chars => Name_Alignment,
740 Expression =>
741 Make_Attribute_Reference (Loc,
742 Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
743 Attribute_Name => Name_Alignment)));
744
745 -- Generate code to put the Address of the TSD in the dispatch table
746 -- Set_TSD (DT_Ptr, TSD);
747
748 Append_To (Elab_Code,
749 Make_DT_Access_Action (Typ,
750 Action => Set_TSD,
751 Args => New_List (
752 New_Reference_To (DT_Ptr, Loc), -- DTptr
753 Make_Attribute_Reference (Loc, -- Value
754 Prefix => New_Reference_To (TSD, Loc),
755 Attribute_Name => Name_Address))));
756
757 if Typ = Etype (Typ)
758 or else Is_CPP_Class (Etype (Typ))
759 then
760 Old_Tag :=
761 Unchecked_Convert_To (Generalized_Tag,
762 Make_Integer_Literal (Loc, 0));
763
764 Old_TSD :=
765 Unchecked_Convert_To (RTE (RE_Address),
766 Make_Integer_Literal (Loc, 0));
767
768 else
769 Old_Tag := New_Reference_To (Access_Disp_Table (Etype (Typ)), Loc);
770 Old_TSD :=
771 Make_DT_Access_Action (Typ,
772 Action => Get_TSD,
773 Args => New_List (
774 New_Reference_To (Access_Disp_Table (Etype (Typ)), Loc)));
775 end if;
776
777 -- Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
778
779 Append_To (Elab_Code,
780 Make_DT_Access_Action (Typ,
781 Action => Inherit_DT,
782 Args => New_List (
783 Node1 => Old_Tag,
784 Node2 => New_Reference_To (DT_Ptr, Loc),
785 Node3 => Make_Integer_Literal (Loc,
786 DT_Entry_Count (Tag_Component (Etype (Typ)))))));
787
788 -- Generate: Inherit_TSD (Get_TSD (parent), DT_Ptr);
789
790 Append_To (Elab_Code,
791 Make_DT_Access_Action (Typ,
792 Action => Inherit_TSD,
793 Args => New_List (
794 Node1 => Old_TSD,
795 Node2 => New_Reference_To (DT_Ptr, Loc))));
796
797 -- Generate: Exname : constant String := full_qualified_name (typ);
798 -- The type itself may be an anonymous parent type, so use the first
799 -- subtype to have a user-recognizable name.
800
801 Append_To (Result,
802 Make_Object_Declaration (Loc,
803 Defining_Identifier => Exname,
804 Constant_Present => True,
805 Object_Definition => New_Reference_To (Standard_String, Loc),
806 Expression =>
807 Make_String_Literal (Loc,
808 Full_Qualified_Name (First_Subtype (Typ)))));
809
810 -- Generate: Set_Expanded_Name (DT_Ptr, exname'Address);
811
812 Append_To (Elab_Code,
813 Make_DT_Access_Action (Typ,
814 Action => Set_Expanded_Name,
815 Args => New_List (
816 Node1 => New_Reference_To (DT_Ptr, Loc),
817 Node2 =>
818 Make_Attribute_Reference (Loc,
819 Prefix => New_Reference_To (Exname, Loc),
820 Attribute_Name => Name_Address))));
821
822 -- for types with no controlled components
823 -- Generate: Set_RC_Offset (DT_Ptr, 0);
824 -- for simple types with controlled components
825 -- Generate: Set_RC_Offset (DT_Ptr, type._record_controller'position);
826 -- for complex types with controlled components where the position
827 -- of the record controller is not statically computable, if there are
828 -- controlled components at this level
829 -- Generate: Set_RC_Offset (DT_Ptr, -1);
830 -- to indicate that the _controller field is right after the _parent or
831 -- if there are no controlled components at this level,
832 -- Generate: Set_RC_Offset (DT_Ptr, -2);
833 -- to indicate that we need to get the position from the parent.
834
835 declare
836 Position : Node_Id;
837
838 begin
839 if not Has_Controlled_Component (Typ) then
840 Position := Make_Integer_Literal (Loc, 0);
841
842 elsif Etype (Typ) /= Typ and then Has_Discriminants (Etype (Typ)) then
843 if Has_New_Controlled_Component (Typ) then
844 Position := Make_Integer_Literal (Loc, -1);
845 else
846 Position := Make_Integer_Literal (Loc, -2);
847 end if;
848 else
849 Position :=
850 Make_Attribute_Reference (Loc,
851 Prefix =>
852 Make_Selected_Component (Loc,
853 Prefix => New_Reference_To (Typ, Loc),
854 Selector_Name =>
855 New_Reference_To (Controller_Component (Typ), Loc)),
856 Attribute_Name => Name_Position);
857
858 -- This is not proper Ada code to use the attribute 'Position
859 -- on something else than an object but this is supported by
860 -- the back end (see comment on the Bit_Component attribute in
861 -- sem_attr). So we avoid semantic checking here.
862
863 Set_Analyzed (Position);
864 Set_Etype (Prefix (Position), RTE (RE_Record_Controller));
865 Set_Etype (Prefix (Prefix (Position)), Typ);
866 Set_Etype (Selector_Name (Prefix (Position)),
867 RTE (RE_Record_Controller));
868 Set_Etype (Position, RTE (RE_Storage_Offset));
869 end if;
870
871 Append_To (Elab_Code,
872 Make_DT_Access_Action (Typ,
873 Action => Set_RC_Offset,
874 Args => New_List (
875 Node1 => New_Reference_To (DT_Ptr, Loc),
876 Node2 => Position)));
877 end;
878
879 -- Generate: Set_Remotely_Callable (DT_Ptr, status);
880 -- where status is described in E.4 (18)
881
882 declare
883 Status : Entity_Id;
884
885 begin
886 if Is_Pure (Typ)
887 or else Is_Shared_Passive (Typ)
888 or else
889 ((Is_Remote_Types (Typ) or else Is_Remote_Call_Interface (Typ))
890 and then Original_View_In_Visible_Part (Typ))
891 or else not Comes_From_Source (Typ)
892 then
893 Status := Standard_True;
894 else
895 Status := Standard_False;
896 end if;
897
898 Append_To (Elab_Code,
899 Make_DT_Access_Action (Typ,
900 Action => Set_Remotely_Callable,
901 Args => New_List (
902 New_Occurrence_Of (DT_Ptr, Loc),
903 New_Occurrence_Of (Status, Loc))));
904 end;
905
906 -- Generate: Set_External_Tag (DT_Ptr, exname'Address);
907 -- Should be the external name not the qualified name???
908
909 if not Has_External_Tag_Rep_Clause (Typ) then
910 Append_To (Elab_Code,
911 Make_DT_Access_Action (Typ,
912 Action => Set_External_Tag,
913 Args => New_List (
914 Node1 => New_Reference_To (DT_Ptr, Loc),
915 Node2 =>
916 Make_Attribute_Reference (Loc,
917 Prefix => New_Reference_To (Exname, Loc),
918 Attribute_Name => Name_Address))));
919
920 -- Generate code to register the Tag in the External_Tag hash
921 -- table for the pure Ada type only.
922
923 -- Register_Tag (Dt_Ptr);
924
925 -- Skip this if routine not available, or in No_Run_Time mode
926
927 if RTE_Available (RE_Register_Tag)
928 and then Is_RTE (Generalized_Tag, RE_Tag)
929 and then not No_Run_Time_Mode
930 then
931 Append_To (Elab_Code,
932 Make_Procedure_Call_Statement (Loc,
933 Name => New_Reference_To (RTE (RE_Register_Tag), Loc),
934 Parameter_Associations =>
935 New_List (New_Reference_To (DT_Ptr, Loc))));
936 end if;
937 end if;
938
939 -- Generate:
940 -- if No_Reg then
941 -- <elab_code>
942 -- No_Reg := False;
943 -- end if;
944
945 Append_To (Elab_Code,
946 Make_Assignment_Statement (Loc,
947 Name => New_Reference_To (No_Reg, Loc),
948 Expression => New_Reference_To (Standard_False, Loc)));
949
950 Append_To (Result,
951 Make_Implicit_If_Statement (Typ,
952 Condition => New_Reference_To (No_Reg, Loc),
953 Then_Statements => Elab_Code));
954
955 return Result;
956 end Make_DT;
957
958 ---------------------------
959 -- Make_DT_Access_Action --
960 ---------------------------
961
962 function Make_DT_Access_Action
963 (Typ : Entity_Id;
964 Action : DT_Access_Action;
965 Args : List_Id)
966 return Node_Id
967 is
968 Action_Name : Entity_Id;
969 Loc : Source_Ptr;
970
971 begin
972 if Is_CPP_Class (Root_Type (Typ)) then
973 Action_Name := RTE (CPP_Actions (Action));
974 else
975 Action_Name := RTE (Ada_Actions (Action));
976 end if;
977
978 if No (Args) then
979
980 -- This is a constant
981
982 return New_Reference_To (Action_Name, Sloc (Typ));
983 end if;
984
985 pragma Assert (List_Length (Args) = Action_Nb_Arg (Action));
986
987 Loc := Sloc (First (Args));
988
989 if Action_Is_Proc (Action) then
990 return
991 Make_Procedure_Call_Statement (Loc,
992 Name => New_Reference_To (Action_Name, Loc),
993 Parameter_Associations => Args);
994
995 else
996 return
997 Make_Function_Call (Loc,
998 Name => New_Reference_To (Action_Name, Loc),
999 Parameter_Associations => Args);
1000 end if;
1001 end Make_DT_Access_Action;
1002
1003 -----------------------------------
1004 -- Original_View_In_Visible_Part --
1005 -----------------------------------
1006
1007 function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean is
1008 Scop : constant Entity_Id := Scope (Typ);
1009
1010 begin
1011 -- The scope must be a package
1012
1013 if Ekind (Scop) /= E_Package
1014 and then Ekind (Scop) /= E_Generic_Package
1015 then
1016 return False;
1017 end if;
1018
1019 -- A type with a private declaration has a private view declared in
1020 -- the visible part.
1021
1022 if Has_Private_Declaration (Typ) then
1023 return True;
1024 end if;
1025
1026 return List_Containing (Parent (Typ)) =
1027 Visible_Declarations (Specification (Unit_Declaration_Node (Scop)));
1028 end Original_View_In_Visible_Part;
1029
1030 -------------------------
1031 -- Set_All_DT_Position --
1032 -------------------------
1033
1034 procedure Set_All_DT_Position (Typ : Entity_Id) is
1035 Parent_Typ : constant Entity_Id := Etype (Typ);
1036 Root_Typ : constant Entity_Id := Root_Type (Typ);
1037 First_Prim : constant Elmt_Id := First_Elmt (Primitive_Operations (Typ));
1038 The_Tag : constant Entity_Id := Tag_Component (Typ);
1039 Adjusted : Boolean := False;
1040 Finalized : Boolean := False;
1041 Parent_EC : Int;
1042 Nb_Prim : Int;
1043 Prim : Entity_Id;
1044 Prim_Elmt : Elmt_Id;
1045
1046 begin
1047
1048 -- Get Entry_Count of the parent
1049
1050 if Parent_Typ /= Typ
1051 and then DT_Entry_Count (Tag_Component (Parent_Typ)) /= No_Uint
1052 then
1053 Parent_EC := UI_To_Int (DT_Entry_Count (Tag_Component (Parent_Typ)));
1054 else
1055 Parent_EC := 0;
1056 end if;
1057
1058 -- C++ Case, check that pragma CPP_Class, CPP_Virtual and CPP_Vtable
1059 -- give a coherent set of information
1060
1061 if Is_CPP_Class (Root_Typ) then
1062
1063 -- Compute the number of primitive operations in the main Vtable
1064 -- Set their position:
1065 -- - where it was set if overriden or inherited
1066 -- - after the end of the parent vtable otherwise
1067
1068 Prim_Elmt := First_Prim;
1069 Nb_Prim := 0;
1070 while Present (Prim_Elmt) loop
1071 Prim := Node (Prim_Elmt);
1072
1073 if not Is_CPP_Class (Typ) then
1074 Set_DTC_Entity (Prim, The_Tag);
1075
1076 elsif Present (Alias (Prim)) then
1077 Set_DTC_Entity (Prim, DTC_Entity (Alias (Prim)));
1078 Set_DT_Position (Prim, DT_Position (Alias (Prim)));
1079
1080 elsif No (DTC_Entity (Prim)) and then Is_CPP_Class (Typ) then
1081 Error_Msg_NE ("is a primitive operation of&," &
1082 " pragma Cpp_Virtual required", Prim, Typ);
1083 end if;
1084
1085 if DTC_Entity (Prim) = The_Tag then
1086
1087 -- Get the slot from the parent subprogram if any
1088
1089 declare
1090 H : Entity_Id := Homonym (Prim);
1091
1092 begin
1093 while Present (H) loop
1094 if Present (DTC_Entity (H))
1095 and then Root_Type (Scope (DTC_Entity (H))) = Root_Typ
1096 then
1097 Set_DT_Position (Prim, DT_Position (H));
1098 exit;
1099 end if;
1100
1101 H := Homonym (H);
1102 end loop;
1103 end;
1104
1105 -- Otherwise take the canonical slot after the end of the
1106 -- parent Vtable
1107
1108 if DT_Position (Prim) = No_Uint then
1109 Nb_Prim := Nb_Prim + 1;
1110 Set_DT_Position (Prim, UI_From_Int (Parent_EC + Nb_Prim));
1111
1112 elsif UI_To_Int (DT_Position (Prim)) > Parent_EC then
1113 Nb_Prim := Nb_Prim + 1;
1114 end if;
1115 end if;
1116
1117 Next_Elmt (Prim_Elmt);
1118 end loop;
1119
1120 -- Check that the declared size of the Vtable is bigger or equal
1121 -- than the number of primitive operations (if bigger it means that
1122 -- some of the c++ virtual functions were not imported, that is
1123 -- allowed)
1124
1125 if DT_Entry_Count (The_Tag) = No_Uint
1126 or else not Is_CPP_Class (Typ)
1127 then
1128 Set_DT_Entry_Count (The_Tag, UI_From_Int (Parent_EC + Nb_Prim));
1129
1130 elsif UI_To_Int (DT_Entry_Count (The_Tag)) < Parent_EC + Nb_Prim then
1131 Error_Msg_N ("not enough room in the Vtable for all virtual"
1132 & " functions", The_Tag);
1133 end if;
1134
1135 -- Check that Positions are not duplicate nor outside the range of
1136 -- the Vtable
1137
1138 declare
1139 Size : constant Int := UI_To_Int (DT_Entry_Count (The_Tag));
1140 Pos : Int;
1141 Prim_Pos_Table : array (1 .. Size) of Entity_Id :=
1142 (others => Empty);
1143
1144 begin
1145 Prim_Elmt := First_Prim;
1146 while Present (Prim_Elmt) loop
1147 Prim := Node (Prim_Elmt);
1148
1149 if DTC_Entity (Prim) = The_Tag then
1150 Pos := UI_To_Int (DT_Position (Prim));
1151
1152 if Pos not in Prim_Pos_Table'Range then
1153 Error_Msg_N
1154 ("position not in range of virtual table", Prim);
1155
1156 elsif Present (Prim_Pos_Table (Pos)) then
1157 Error_Msg_NE ("cannot be at the same position in the"
1158 & " vtable than&", Prim, Prim_Pos_Table (Pos));
1159
1160 else
1161 Prim_Pos_Table (Pos) := Prim;
1162 end if;
1163 end if;
1164
1165 Next_Elmt (Prim_Elmt);
1166 end loop;
1167 end;
1168
1169 -- For regular Ada tagged types, just set the DT_Position for
1170 -- each primitive operation. Perform some sanity checks to avoid
1171 -- to build completely inconsistant dispatch tables.
1172
1173 -- Note that the _Size primitive is always set at position 1 in order
1174 -- to comply with the needs of Ada.Tags.Parent_Size (see documentation
1175 -- in a-tags.ad?)
1176
1177 else
1178 Nb_Prim := 1;
1179 Prim_Elmt := First_Prim;
1180 while Present (Prim_Elmt) loop
1181 Nb_Prim := Nb_Prim + 1;
1182 Prim := Node (Prim_Elmt);
1183 Set_DTC_Entity (Prim, The_Tag);
1184
1185 if Chars (Prim) = Name_uSize then
1186 Set_DT_Position (Prim, Uint_1);
1187 Nb_Prim := Nb_Prim - 1;
1188 else
1189 Set_DT_Position (Prim, UI_From_Int (Nb_Prim));
1190 end if;
1191
1192 if Chars (Prim) = Name_Finalize
1193 and then
1194 (Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
1195 or else not Is_Predefined_File_Name
1196 (Unit_File_Name (Get_Source_Unit (Prim))))
1197 then
1198 Finalized := True;
1199 end if;
1200
1201 if Chars (Prim) = Name_Adjust then
1202 Adjusted := True;
1203 end if;
1204
1205 -- An abstract operation cannot be declared in the private part
1206 -- for a visible abstract type, because it could never be over-
1207 -- ridden. For explicit declarations this is checked at the point
1208 -- of declaration, but for inherited operations it must be done
1209 -- when building the dispatch table. Input is excluded because
1210
1211 if Is_Abstract (Typ)
1212 and then Is_Abstract (Prim)
1213 and then Present (Alias (Prim))
1214 and then Is_Derived_Type (Typ)
1215 and then In_Private_Part (Current_Scope)
1216 and then List_Containing (Parent (Prim))
1217 = Private_Declarations
1218 (Specification (Unit_Declaration_Node (Current_Scope)))
1219 and then Original_View_In_Visible_Part (Typ)
1220 then
1221 -- We exclude Input and Output stream operations because
1222 -- Limited_Controlled inherits useless Input and Output
1223 -- stream operations from Root_Controlled, which can
1224 -- never be overridden.
1225
1226 if not Is_TSS (Prim, TSS_Stream_Input)
1227 and then
1228 not Is_TSS (Prim, TSS_Stream_Output)
1229 then
1230 Error_Msg_NE
1231 ("abstract inherited private operation&" &
1232 " must be overridden ('R'M 3.9.3(10))",
1233 Parent (Typ), Prim);
1234 end if;
1235 end if;
1236 Next_Elmt (Prim_Elmt);
1237 end loop;
1238
1239 if Is_Controlled (Typ) then
1240 if not Finalized then
1241 Error_Msg_N
1242 ("controlled type has no explicit Finalize method?", Typ);
1243
1244 elsif not Adjusted then
1245 Error_Msg_N
1246 ("controlled type has no explicit Adjust method?", Typ);
1247 end if;
1248 end if;
1249
1250 Set_DT_Entry_Count (The_Tag, UI_From_Int (Nb_Prim));
1251
1252 -- The derived type must have at least as many components as its
1253 -- parent (for root types, the Etype points back to itself
1254 -- and the test should not fail)
1255
1256 pragma Assert (
1257 DT_Entry_Count (The_Tag) >=
1258 DT_Entry_Count (Tag_Component (Parent_Typ)));
1259 end if;
1260 end Set_All_DT_Position;
1261
1262 -----------------------------
1263 -- Set_Default_Constructor --
1264 -----------------------------
1265
1266 procedure Set_Default_Constructor (Typ : Entity_Id) is
1267 Loc : Source_Ptr;
1268 Init : Entity_Id;
1269 Param : Entity_Id;
1270 E : Entity_Id;
1271
1272 begin
1273 -- Look for the default constructor entity. For now only the
1274 -- default constructor has the flag Is_Constructor.
1275
1276 E := Next_Entity (Typ);
1277 while Present (E)
1278 and then (Ekind (E) /= E_Function or else not Is_Constructor (E))
1279 loop
1280 Next_Entity (E);
1281 end loop;
1282
1283 -- Create the init procedure
1284
1285 if Present (E) then
1286 Loc := Sloc (E);
1287 Init := Make_Defining_Identifier (Loc, Make_Init_Proc_Name (Typ));
1288 Param := Make_Defining_Identifier (Loc, Name_X);
1289
1290 Discard_Node (
1291 Make_Subprogram_Declaration (Loc,
1292 Make_Procedure_Specification (Loc,
1293 Defining_Unit_Name => Init,
1294 Parameter_Specifications => New_List (
1295 Make_Parameter_Specification (Loc,
1296 Defining_Identifier => Param,
1297 Parameter_Type => New_Reference_To (Typ, Loc))))));
1298
1299 Set_Init_Proc (Typ, Init);
1300 Set_Is_Imported (Init);
1301 Set_Interface_Name (Init, Interface_Name (E));
1302 Set_Convention (Init, Convention_C);
1303 Set_Is_Public (Init);
1304 Set_Has_Completion (Init);
1305
1306 -- If there are no constructors, mark the type as abstract since we
1307 -- won't be able to declare objects of that type.
1308
1309 else
1310 Set_Is_Abstract (Typ);
1311 end if;
1312 end Set_Default_Constructor;
1313
1314 end Exp_Disp;
Mirror of the offical gcc git repository hosted at gcc.gnu.org