]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/exp_cg.adb
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Correct a function pre/postcondition [PR102403].
[thirdparty/gcc.git] / gcc / ada / exp_cg.adb
CommitLineData
9c41193c
JM		 1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- E X P _ C G --
6-- --
7-- B o d y --
8-- --
8d0d46f4 9-- Copyright (C) 2010-2021, Free Software Foundation, Inc. --
9c41193c
JM		 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
104f58db
BD		 26with Atree; use Atree;
27with Einfo; use Einfo;
76f9c7f4 28with Einfo.Entities; use Einfo.Entities;
104f58db
BD		 29with Einfo.Utils; use Einfo.Utils;
30with Elists; use Elists;
31with Exp_Dbug; use Exp_Dbug;
32with Exp_Tss; use Exp_Tss;
33with Lib; use Lib;
34with Namet; use Namet;
35with Opt; use Opt;
36with Output; use Output;
37with Sem_Aux; use Sem_Aux;
38with Sem_Disp; use Sem_Disp;
39with Sem_Type; use Sem_Type;
40with Sem_Util; use Sem_Util;
41with Sinfo; use Sinfo;
42with Sinfo.Nodes; use Sinfo.Nodes;
43with Sinfo.Utils; use Sinfo.Utils;
44with Sinput; use Sinput;
45with Snames; use Snames;
46with System; use System;
9c41193c 47with Table;
104f58db 48with Uintp; use Uintp;
9c41193c
JM		 49
50package body Exp_CG is
51
c88f5c49
JM		 52 -- We duplicate here some declarations from packages Interfaces.C and
53 -- Interfaces.C_Streams because adding their dependence to the frontend
54 -- causes bootstrapping problems with old versions of the compiler.
55
56 subtype FILEs is System.Address;
57 -- Corresponds to the C type FILE*
58
59 subtype C_chars is System.Address;
60 -- Pointer to null-terminated array of characters
61
62 function fputs (Strng : C_chars; Stream : FILEs) return Integer;
63 pragma Import (C, fputs, "fputs");
64
65 -- Import the file stream associated with the "ci" output file. Done to
66 -- generate the output in the file created and left opened by routine
67 -- toplev.c before calling gnat1drv.
68
69 Callgraph_Info_File : FILEs;
70 pragma Import (C, Callgraph_Info_File);
9c41193c
JM		 71
72 package Call_Graph_Nodes is new Table.Table (
73 Table_Component_Type => Node_Id,
74 Table_Index_Type => Natural,
75 Table_Low_Bound => 1,
76 Table_Initial => 50,
77 Table_Increment => 100,
78 Table_Name => "Call_Graph_Nodes");
c88f5c49
JM		 79 -- This table records nodes associated with dispatching calls and tagged
80 -- type declarations found in the main compilation unit. Used as an
81 -- auxiliary storage because the call-graph output requires fully qualified
82 -- names and they are not available until the backend is called.
9c41193c
JM		 83
84 function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
85 -- Determines if E is a predefined primitive operation.
86 -- Note: This routine should replace the routine with the same name that is
87 -- currently available in exp_disp because it extends its functionality to
110d0820 88 -- handle fully qualified names. It's actually in Sem_Util. ???
9c41193c
JM		 89
90 function Slot_Number (Prim : Entity_Id) return Uint;
91 -- Returns the slot number associated with Prim. For predefined primitives
92 -- the slot is returned as a negative number.
93
94 procedure Write_Output (Str : String);
95 -- Used to print a line in the output file (this is used as the
96 -- argument for a call to Set_Special_Output in package Output).
97
98 procedure Write_Call_Info (Call : Node_Id);
99 -- Subsidiary of Generate_CG_Output that generates the output associated
100 -- with a dispatching call.
101
102 procedure Write_Type_Info (Typ : Entity_Id);
103 -- Subsidiary of Generate_CG_Output that generates the output associated
104 -- with a tagged type declaration.
105
106 ------------------------
107 -- Generate_CG_Output --
108 ------------------------
109
110 procedure Generate_CG_Output is
111 N : Node_Id;
112
113 begin
c88f5c49 114 -- No output if the "ci" output file has not been previously opened
1c218ac3 115 -- by toplev.c
c88f5c49 116
1c218ac3 117 if Callgraph_Info_File = Null_Address then
9c41193c
JM		 118 return;
119 end if;
120
121 -- Setup write routine, create the output file and generate the output
122
123 Set_Special_Output (Write_Output'Access);
124
125 for J in Call_Graph_Nodes.First .. Call_Graph_Nodes.Last loop
126 N := Call_Graph_Nodes.Table (J);
127
dc88759c
JM		 128 -- No action needed for subprogram calls removed by the expander
129 -- (for example, calls to ignored ghost entities).
130
131 if Nkind (N) = N_Null_Statement then
132 pragma Assert (Nkind (Original_Node (N)) in N_Subprogram_Call);
133 null;
134
135 elsif Nkind (N) in N_Subprogram_Call then
9c41193c
JM		 136 Write_Call_Info (N);
137
138 else pragma Assert (Nkind (N) = N_Defining_Identifier);
cd9909a0
AC		 139
140 -- The type may be a private untagged type whose completion is
141 -- tagged, in which case we must use the full tagged view.
142
143 if not Is_Tagged_Type (N) and then Is_Private_Type (N) then
144 N := Full_View (N);
145 end if;
146
9c41193c
JM		 147 pragma Assert (Is_Tagged_Type (N));
148
149 Write_Type_Info (N);
150 end if;
151 end loop;
0b33adf1 152
e3548b69 153 Cancel_Special_Output;
9c41193c
JM		 154 end Generate_CG_Output;
155
156 ----------------
157 -- Initialize --
158 ----------------
159
160 procedure Initialize is
161 begin
162 Call_Graph_Nodes.Init;
163 end Initialize;
164
165 -----------------------------------------
166 -- Is_Predefined_Dispatching_Operation --
167 -----------------------------------------
168
169 function Is_Predefined_Dispatching_Operation
170 (E : Entity_Id) return Boolean
171 is
172 function Homonym_Suffix_Length (E : Entity_Id) return Natural;
173 -- Returns the length of the homonym suffix corresponding to E.
174 -- Note: This routine relies on the functionality provided by routines
175 -- of Exp_Dbug. Further work needed here to decide if it should be
176 -- located in that package???
177
178 ---------------------------
179 -- Homonym_Suffix_Length --
180 ---------------------------
181
182 function Homonym_Suffix_Length (E : Entity_Id) return Natural is
39eb6542
AC		 183 Prefix_Length : constant := 2;
184 -- Length of prefix "__"
9c41193c
JM		 185
186 H : Entity_Id;
187 Nr : Nat := 1;
188
189 begin
190 if not Has_Homonym (E) then
191 return 0;
192
193 else
194 H := Homonym (E);
195 while Present (H) loop
196 if Scope (H) = Scope (E) then
197 Nr := Nr + 1;
198 end if;
199
200 H := Homonym (H);
201 end loop;
202
203 if Nr = 1 then
204 return 0;
205
206 -- Prefix "__" followed by number
207
9c41193c 208 else
d4fc0fb4
AC		 209 declare
210 Result : Natural := Prefix_Length + 1;
39eb6542 211
d4fc0fb4 212 begin
a7c764a9 213 while Nr >= 10 loop
d4fc0fb4
AC		 214 Result := Result + 1;
215 Nr := Nr / 10;
216 end loop;
39eb6542 217
d4fc0fb4
AC		 218 return Result;
219 end;
9c41193c
JM		 220 end if;
221 end if;
222 end Homonym_Suffix_Length;
223
224 -- Local variables
225
9db0b232 226 Full_Name : constant String := Get_Name_String (Chars (E));
39eb6542 227 Suffix_Length : Natural;
9db0b232 228 TSS_Name : TSS_Name_Type;
9c41193c
JM		 229
230 -- Start of processing for Is_Predefined_Dispatching_Operation
231
232 begin
233 if not Is_Dispatching_Operation (E) then
234 return False;
235 end if;
236
9db0b232
AC		 237 -- Search for and strip suffix for body-nested package entities
238
39eb6542 239 Suffix_Length := Homonym_Suffix_Length (E);
9db0b232
AC		 240 for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
241 if Full_Name (J) = 'X' then
242
243 -- Include the "X", "Xb", "Xn", ... in the part of the
244 -- suffix to be removed.
245
246 Suffix_Length := Suffix_Length + Full_Name'Last - J + 1;
247 exit;
248 end if;
249
250 exit when Full_Name (J) /= 'b' and then Full_Name (J) /= 'n';
251 end loop;
252
9c41193c
JM		 253 -- Most predefined primitives have internally generated names. Equality
254 -- must be treated differently; the predefined operation is recognized
255 -- as a homogeneous binary operator that returns Boolean.
256
257 if Full_Name'Length > TSS_Name_Type'Length then
258 TSS_Name :=
9db0b232
AC		 259 TSS_Name_Type
260 (Full_Name
261 (Full_Name'Last - TSS_Name'Length - Suffix_Length + 1
262 .. Full_Name'Last - Suffix_Length));
9c41193c
JM		 263
264 if TSS_Name = TSS_Stream_Read
265 or else TSS_Name = TSS_Stream_Write
266 or else TSS_Name = TSS_Stream_Input
267 or else TSS_Name = TSS_Stream_Output
110d0820 268 or else TSS_Name = TSS_Put_Image
9c41193c
JM		 269 or else TSS_Name = TSS_Deep_Adjust
270 or else TSS_Name = TSS_Deep_Finalize
271 then
272 return True;
273
274 elsif not Has_Fully_Qualified_Name (E) then
4a08c95c 275 if Chars (E) in Name_uSize | Name_uAlignment | Name_uAssign
9c41193c
JM		 276 or else
277 (Chars (E) = Name_Op_Eq
b69cd36a 278 and then Etype (First_Formal (E)) = Etype (Last_Formal (E)))
9c41193c
JM		 279 or else Is_Predefined_Interface_Primitive (E)
280 then
281 return True;
282 end if;
283
284 -- Handle fully qualified names
285
286 else
287 declare
288 type Names_Table is array (Positive range <>) of Name_Id;
289
290 Predef_Names_95 : constant Names_Table :=
291 (Name_uSize,
292 Name_uAlignment,
293 Name_Op_Eq,
294 Name_uAssign);
295
296 Predef_Names_05 : constant Names_Table :=
297 (Name_uDisp_Asynchronous_Select,
298 Name_uDisp_Conditional_Select,
299 Name_uDisp_Get_Prim_Op_Kind,
300 Name_uDisp_Get_Task_Id,
301 Name_uDisp_Requeue,
302 Name_uDisp_Timed_Select);
303
9c41193c
JM		 304 begin
305 for J in Predef_Names_95'Range loop
306 Get_Name_String (Predef_Names_95 (J));
307
08564036
AC		 308 -- The predefined primitive operations are identified by the
309 -- names "_size", "_alignment", etc. If we try a pattern
310 -- matching against this string, we can wrongly match other
311 -- primitive operations like "get_size". To avoid this, we
312 -- add the "__" scope separator, which can only prepend
313 -- predefined primitive operations because other primitive
314 -- operations can neither start with an underline nor
315 -- contain two consecutive underlines in its name.
316
317 if Full_Name'Last - Suffix_Length > Name_Len + 2
9c41193c
JM		 318 and then
319 Full_Name
08564036 320 (Full_Name'Last - Name_Len - 2 - Suffix_Length + 1
9c41193c 321 .. Full_Name'Last - Suffix_Length) =
08564036 322 "__" & Name_Buffer (1 .. Name_Len)
9c41193c
JM		 323 then
324 -- For the equality operator the type of the two operands
325 -- must also match.
326
327 return Predef_Names_95 (J) /= Name_Op_Eq
328 or else
ea7f928b 329 Etype (First_Formal (E)) = Etype (Last_Formal (E));
9c41193c
JM		 330 end if;
331 end loop;
332
0791fbe9 333 if Ada_Version >= Ada_2005 then
9c41193c
JM		 334 for J in Predef_Names_05'Range loop
335 Get_Name_String (Predef_Names_05 (J));
336
08564036 337 if Full_Name'Last - Suffix_Length > Name_Len + 2
9c41193c
JM		 338 and then
339 Full_Name
08564036 340 (Full_Name'Last - Name_Len - 2 - Suffix_Length + 1
9c41193c 341 .. Full_Name'Last - Suffix_Length) =
08564036 342 "__" & Name_Buffer (1 .. Name_Len)
9c41193c
JM		 343 then
344 return True;
345 end if;
346 end loop;
347 end if;
348 end;
349 end if;
350 end if;
351
352 return False;
353 end Is_Predefined_Dispatching_Operation;
354
355 ----------------------
356 -- Register_CG_Node --
357 ----------------------
358
359 procedure Register_CG_Node (N : Node_Id) is
360 begin
d3b00ce3 361 if Nkind (N) in N_Subprogram_Call then
9c41193c
JM		 362 if Current_Scope = Main_Unit_Entity
363 or else Entity_Is_In_Main_Unit (Current_Scope)
364 then
365 -- Register a copy of the dispatching call node. Needed since the
308e6f3a
RW		 366 -- node containing a dispatching call is rewritten by the
367 -- expander.
9c41193c
JM		 368
369 declare
370 Copy : constant Node_Id := New_Copy (N);
a7c764a9 371 Par : Node_Id;
9c41193c
JM		 372
373 begin
a7c764a9
AC		 374 -- Determine the enclosing scope to use when generating the
375 -- call graph. This must be done now to avoid problems with
376 -- control structures that may be rewritten during expansion.
377
378 Par := Parent (N);
379 while Nkind (Par) /= N_Subprogram_Body
380 and then Nkind (Parent (Par)) /= N_Compilation_Unit
381 loop
382 Par := Parent (Par);
76f9c7f4
BD		 383
384 -- Par can legitimately be empty inside a class-wide
385 -- precondition; the "real" call will be found inside the
386 -- generated pragma.
387
388 if No (Par) then
389 return;
390 end if;
a7c764a9 391 end loop;
9c41193c 392
a7c764a9 393 Set_Parent (Copy, Par);
9c41193c
JM		 394 Call_Graph_Nodes.Append (Copy);
395 end;
396 end if;
397
398 else pragma Assert (Nkind (N) = N_Defining_Identifier);
399 if Entity_Is_In_Main_Unit (N) then
400 Call_Graph_Nodes.Append (N);
401 end if;
402 end if;
403 end Register_CG_Node;
404
405 -----------------
406 -- Slot_Number --
407 -----------------
408
409 function Slot_Number (Prim : Entity_Id) return Uint is
1c218ac3 410 E : constant Entity_Id := Ultimate_Alias (Prim);
9c41193c 411 begin
1c218ac3
AC		 412 if Is_Predefined_Dispatching_Operation (E) then
413 return -DT_Position (E);
9c41193c 414 else
1c218ac3 415 return DT_Position (E);
9c41193c
JM		 416 end if;
417 end Slot_Number;
418
419 ------------------
420 -- Write_Output --
421 ------------------
422
9c41193c 423 procedure Write_Output (Str : String) is
c88f5c49
JM		 424 Nul : constant Character := Character'First;
425 Line : String (Str'First .. Str'Last + 1);
426 Errno : Integer;
d69cf005 427
9c41193c 428 begin
c88f5c49
JM		 429 -- Add the null character to the string as required by fputs
430
431 Line := Str & Nul;
432 Errno := fputs (Line'Address, Callgraph_Info_File);
433 pragma Assert (Errno >= 0);
9c41193c
JM		 434 end Write_Output;
435
436 ---------------------
437 -- Write_Call_Info --
438 ---------------------
439
440 procedure Write_Call_Info (Call : Node_Id) is
441 Ctrl_Arg : constant Node_Id := Controlling_Argument (Call);
442 Ctrl_Typ : constant Entity_Id := Base_Type (Etype (Ctrl_Arg));
76f9c7f4 443 Prim : constant Entity_Id := Entity (Sinfo.Nodes.Name (Call));
a7c764a9 444 P : constant Node_Id := Parent (Call);
9c41193c
JM		 445
446 begin
9c41193c
JM		 447 Write_Str ("edge: { sourcename: ");
448 Write_Char ('"');
e1d9659d
AC		 449
450 -- The parent node is the construct that contains the call: subprogram
451 -- body or library-level package. Display the qualified name of the
452 -- entity of the construct. For a subprogram, it is the entity of the
453 -- spec, which carries a homonym counter when it is overloaded.
454
e7c0dd39
AC		 455 if Nkind (P) = N_Subprogram_Body
456 and then not Acts_As_Spec (P)
457 then
93582885 458 Get_External_Name (Corresponding_Spec (P));
e1d9659d
AC		 459
460 else
93582885 461 Get_External_Name (Defining_Entity (P));
e1d9659d
AC		 462 end if;
463
008f6fd3 464 Write_Str (Name_Buffer (1 .. Name_Len));
9c41193c
JM		 465
466 if Nkind (P) = N_Package_Declaration then
467 Write_Str ("___elabs");
468
469 elsif Nkind (P) = N_Package_Body then
470 Write_Str ("___elabb");
471 end if;
472
473 Write_Char ('"');
474 Write_Eol;
475
476 -- The targetname is a triple:
477 -- N: the index in a vtable used for dispatch
478 -- V: the type who's vtable is used
479 -- S: the static type of the expression
480
481 Write_Str (" targetname: ");
482 Write_Char ('"');
483
484 pragma Assert (No (Interface_Alias (Prim)));
485
486 -- The check on Is_Ancestor is done here to avoid problems with
487 -- renamings of primitives. For example:
488
489 -- type Root is tagged ...
490 -- procedure Base (Obj : Root);
491 -- procedure Base2 (Obj : Root) renames Base;
492
493 if Present (Alias (Prim))
494 and then
495 Is_Ancestor
496 (Find_Dispatching_Type (Ultimate_Alias (Prim)),
4ac2477e
JM		 497 Root_Type (Ctrl_Typ),
498 Use_Full_View => True)
9c41193c 499 then
9db0b232
AC		 500 -- This is a special case in which we generate in the ci file the
501 -- slot number of the renaming primitive (i.e. Base2) but instead of
502 -- generating the name of this renaming entity we reference directly
503 -- the renamed entity (i.e. Base).
504
505 Write_Int (UI_To_Int (Slot_Number (Prim)));
9c41193c
JM		 506 Write_Char (':');
507 Write_Name
508 (Chars (Find_Dispatching_Type (Ultimate_Alias (Prim))));
509 else
510 Write_Int (UI_To_Int (Slot_Number (Prim)));
511 Write_Char (':');
512 Write_Name (Chars (Root_Type (Ctrl_Typ)));
513 end if;
514
515 Write_Char (',');
516 Write_Name (Chars (Root_Type (Ctrl_Typ)));
517
518 Write_Char ('"');
519 Write_Eol;
520
521 Write_Str (" label: ");
522 Write_Char ('"');
523 Write_Location (Sloc (Call));
524 Write_Char ('"');
525 Write_Eol;
526
527 Write_Char ('}');
528 Write_Eol;
529 end Write_Call_Info;
530
531 ---------------------
532 -- Write_Type_Info --
533 ---------------------
534
535 procedure Write_Type_Info (Typ : Entity_Id) is
536 Elmt : Elmt_Id;
537 Prim : Node_Id;
538
539 Parent_Typ : Entity_Id;
540 Separator_Needed : Boolean := False;
541
542 begin
543 -- Initialize Parent_Typ handling private types
544
545 Parent_Typ := Etype (Typ);
546
547 if Present (Full_View (Parent_Typ)) then
548 Parent_Typ := Full_View (Parent_Typ);
549 end if;
550
551 Write_Str ("class {");
552 Write_Eol;
553
554 Write_Str (" classname: ");
555 Write_Char ('"');
556 Write_Name (Chars (Typ));
557 Write_Char ('"');
558 Write_Eol;
559
560 Write_Str (" label: ");
561 Write_Char ('"');
562 Write_Name (Chars (Typ));
563 Write_Char ('\');
564 Write_Location (Sloc (Typ));
565 Write_Char ('"');
566 Write_Eol;
567
568 if Parent_Typ /= Typ then
569 Write_Str (" parent: ");
570 Write_Char ('"');
571 Write_Name (Chars (Parent_Typ));
572
76f9c7f4 573 -- Note: Einfo.Entities prefix not needed if this routine is moved to
9c41193c
JM		 574 -- exp_disp???
575
76f9c7f4
BD		 576 if Present (Einfo.Entities.Interfaces (Typ))
577 and then not Is_Empty_Elmt_List (Einfo.Entities.Interfaces (Typ))
9c41193c 578 then
76f9c7f4 579 Elmt := First_Elmt (Einfo.Entities.Interfaces (Typ));
9c41193c
JM		 580 while Present (Elmt) loop
581 Write_Str (", ");
582 Write_Name (Chars (Node (Elmt)));
583 Next_Elmt (Elmt);
584 end loop;
585 end if;
586
587 Write_Char ('"');
588 Write_Eol;
589 end if;
590
591 Write_Str (" virtuals: ");
592 Write_Char ('"');
593
594 Elmt := First_Elmt (Primitive_Operations (Typ));
595 while Present (Elmt) loop
596 Prim := Node (Elmt);
597
9db0b232 598 -- Skip internal entities associated with overridden interface
f5d96d00 599 -- primitives, and also inherited primitives.
9c41193c 600
f5d96d00
AC		 601 if Present (Interface_Alias (Prim))
602 or else
d69cf005
AC		 603 (Present (Alias (Prim))
604 and then Find_Dispatching_Type (Prim) /=
605 Find_Dispatching_Type (Alias (Prim)))
f5d96d00 606 then
9c41193c
JM		 607 goto Continue;
608 end if;
609
610 -- Do not generate separator for output of first primitive
611
612 if Separator_Needed then
613 Write_Str ("\n");
614 Write_Eol;
615 Write_Str (" ");
616 else
617 Separator_Needed := True;
618 end if;
619
620 Write_Int (UI_To_Int (Slot_Number (Prim)));
621 Write_Char (':');
9db0b232
AC		 622
623 -- Handle renamed primitives
624
625 if Present (Alias (Prim)) then
626 Write_Name (Chars (Ultimate_Alias (Prim)));
627 else
628 Write_Name (Chars (Prim));
629 end if;
9c41193c
JM		 630
631 -- Display overriding of parent primitives
632
633 if Present (Overridden_Operation (Prim))
634 and then
635 Is_Ancestor
4ac2477e
JM		 636 (Find_Dispatching_Type (Overridden_Operation (Prim)), Typ,
637 Use_Full_View => True)
9c41193c
JM		 638 then
639 Write_Char (',');
640 Write_Int
641 (UI_To_Int (Slot_Number (Overridden_Operation (Prim))));
642 Write_Char (':');
643 Write_Name
644 (Chars (Find_Dispatching_Type (Overridden_Operation (Prim))));
645 end if;
646
647 -- Display overriding of interface primitives
648
649 if Has_Interfaces (Typ) then
650 declare
651 Prim_Elmt : Elmt_Id;
652 Prim_Op : Node_Id;
653 Int_Alias : Entity_Id;
654
655 begin
656 Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
657 while Present (Prim_Elmt) loop
658 Prim_Op := Node (Prim_Elmt);
659 Int_Alias := Interface_Alias (Prim_Op);
660
b4d7b435 661 if Present (Int_Alias)
d69cf005 662 and then
4ac2477e
JM		 663 not Is_Ancestor (Find_Dispatching_Type (Int_Alias), Typ,
664 Use_Full_View => True)
b4d7b435
AC		 665 and then (Alias (Prim_Op)) = Prim
666 then
9c41193c
JM		 667 Write_Char (',');
668 Write_Int (UI_To_Int (Slot_Number (Int_Alias)));
669 Write_Char (':');
670 Write_Name (Chars (Find_Dispatching_Type (Int_Alias)));
671 end if;
672
673 Next_Elmt (Prim_Elmt);
674 end loop;
675 end;
676 end if;
677
678 <<Continue>>
679 Next_Elmt (Elmt);
680 end loop;
681
682 Write_Char ('"');
683 Write_Eol;
684
685 Write_Char ('}');
686 Write_Eol;
687 end Write_Type_Info;
688
689end Exp_CG;
Mirror of https://gcc.gnu.org/git/gcc.git