?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
ada: Update copyright notice
[official-gcc.git] / gcc / ada / exp_put_image.adb
blob19e0415e4172eea24fec00933ed4aab41b046b4f
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ P U T _ I M A G E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2020-2023, 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 Aspects; use Aspects;
27 with Atree; use Atree;
28 with Csets; use Csets;
29 with Einfo; use Einfo;
30 with Einfo.Entities; use Einfo.Entities;
31 with Einfo.Utils; use Einfo.Utils;
32 with Exp_Tss; use Exp_Tss;
33 with Exp_Util; use Exp_Util;
34 with Lib; use Lib;
35 with Namet; use Namet;
36 with Nlists; use Nlists;
37 with Nmake; use Nmake;
38 with Opt; use Opt;
39 with Rtsfind; use Rtsfind;
40 with Sem_Aux; use Sem_Aux;
41 with Sem_Util; use Sem_Util;
42 with Sinfo; use Sinfo;
43 with Sinfo.Nodes; use Sinfo.Nodes;
44 with Sinfo.Utils; use Sinfo.Utils;
45 with Snames; use Snames;
46 with Stand;
47 with Stringt; use Stringt;
48 with Tbuild; use Tbuild;
49 with Ttypes; use Ttypes;
50 with Uintp; use Uintp;
51
52 package body Exp_Put_Image is
53
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
57
58 procedure Build_Put_Image_Proc
59 (Loc : Source_Ptr;
60 Typ : Entity_Id;
61 Decl : out Node_Id;
62 Pnam : Entity_Id;
63 Stms : List_Id);
64 -- Build an array or record Put_Image procedure. Stms is the list of
65 -- statements for the body and Pnam is the name of the constructed
66 -- procedure. (The declaration list is always null.)
67
68 function Make_Put_Image_Name
69 (Loc : Source_Ptr; Typ : Entity_Id) return Entity_Id;
70 -- Return the entity that identifies the Put_Image subprogram for Typ. This
71 -- procedure deals with the difference between tagged types (where a single
72 -- subprogram associated with the type is generated) and all other cases
73 -- (where a subprogram is generated at the point of the attribute
74 -- reference). The Loc parameter is used as the Sloc of the created entity.
75
76 function Put_Image_Base_Type (E : Entity_Id) return Entity_Id;
77 -- Returns the base type, except for an array type whose whose first
78 -- subtype is constrained, in which case it returns the first subtype.
79
80 -------------------------------------
81 -- Build_Array_Put_Image_Procedure --
82 -------------------------------------
83
84 procedure Build_Array_Put_Image_Procedure
85 (Nod : Node_Id;
86 Typ : Entity_Id;
87 Decl : out Node_Id;
88 Pnam : out Entity_Id)
89 is
90 Loc : constant Source_Ptr := Sloc (Nod);
91
92 function Wrap_In_Loop
93 (Stms : List_Id;
94 Dim : Pos;
95 Index_Subtype : Entity_Id;
96 Between_Proc : RE_Id) return Node_Id;
97 -- Wrap Stms in a loop and if statement of the form:
98 --
99 -- if V'First (Dim) <= V'Last (Dim) then -- nonempty range?
100 -- declare
101 -- LDim : Index_Type_For_Dim := V'First (Dim);
102 -- begin
103 -- loop
104 -- Stms;
105 -- exit when LDim = V'Last (Dim);
106 -- Between_Proc (S);
107 -- LDim := Index_Type_For_Dim'Succ (LDim);
108 -- end loop;
109 -- end;
110 -- end if;
111 --
112 -- This is called once per dimension, from inner to outer.
113
114 function Wrap_In_Loop
115 (Stms : List_Id;
116 Dim : Pos;
117 Index_Subtype : Entity_Id;
118 Between_Proc : RE_Id) return Node_Id
119 is
120 Index : constant Entity_Id :=
121 Make_Defining_Identifier
122 (Loc, Chars => New_External_Name ('L', Dim));
123 Decl : constant Node_Id :=
124 Make_Object_Declaration (Loc,
125 Defining_Identifier => Index,
126 Object_Definition =>
127 New_Occurrence_Of (Index_Subtype, Loc),
128 Expression =>
129 Make_Attribute_Reference (Loc,
130 Prefix => Make_Identifier (Loc, Name_V),
131 Attribute_Name => Name_First,
132 Expressions => New_List (
133 Make_Integer_Literal (Loc, Dim))));
134 Loop_Stm : constant Node_Id :=
135 Make_Implicit_Loop_Statement (Nod, Statements => Stms);
136 Exit_Stm : constant Node_Id :=
137 Make_Exit_Statement (Loc,
138 Condition =>
139 Make_Op_Eq (Loc,
140 Left_Opnd => New_Occurrence_Of (Index, Loc),
141 Right_Opnd =>
142 Make_Attribute_Reference (Loc,
143 Prefix =>
144 Make_Identifier (Loc, Name_V),
145 Attribute_Name => Name_Last,
146 Expressions => New_List (
147 Make_Integer_Literal (Loc, Dim)))));
148 Increment : constant Node_Id :=
149 Make_Increment (Loc, Index, Index_Subtype);
150 Between : constant Node_Id :=
151 Make_Procedure_Call_Statement (Loc,
152 Name =>
153 New_Occurrence_Of (RTE (Between_Proc), Loc),
154 Parameter_Associations => New_List
155 (Make_Identifier (Loc, Name_S)));
156 Block : constant Node_Id :=
157 Make_Block_Statement (Loc,
158 Declarations => New_List (Decl),
159 Handled_Statement_Sequence =>
160 Make_Handled_Sequence_Of_Statements (Loc,
161 Statements => New_List (Loop_Stm)));
162 begin
163 Append_To (Stms, Exit_Stm);
164 Append_To (Stms, Between);
165 Append_To (Stms, Increment);
166 -- Note that we're appending to the Stms list passed in
167
168 return
169 Make_If_Statement (Loc,
170 Condition =>
171 Make_Op_Le (Loc,
172 Left_Opnd =>
173 Make_Attribute_Reference (Loc,
174 Prefix => Make_Identifier (Loc, Name_V),
175 Attribute_Name => Name_First,
176 Expressions => New_List (
177 Make_Integer_Literal (Loc, Dim))),
178 Right_Opnd =>
179 Make_Attribute_Reference (Loc,
180 Prefix => Make_Identifier (Loc, Name_V),
181 Attribute_Name => Name_Last,
182 Expressions => New_List (
183 Make_Integer_Literal (Loc, Dim)))),
184 Then_Statements => New_List (Block));
185 end Wrap_In_Loop;
186
187 Ndim : constant Pos := Number_Dimensions (Typ);
188 Ctyp : constant Entity_Id := Component_Type (Typ);
189
190 Stm : Node_Id;
191 Exl : constant List_Id := New_List;
192 PI_Entity : Entity_Id;
193
194 Indices : array (1 .. Ndim) of Entity_Id;
195
196 -- Start of processing for Build_Array_Put_Image_Procedure
197
198 begin
199 Pnam :=
200 Make_Defining_Identifier (Loc,
201 Chars => Make_TSS_Name_Local (Typ, TSS_Put_Image));
202
203 -- Get the Indices
204
205 declare
206 Index_Subtype : Node_Id := First_Index (Typ);
207 begin
208 for Dim in 1 .. Ndim loop
209 Indices (Dim) := Etype (Index_Subtype);
210 Next_Index (Index_Subtype);
211 end loop;
212 pragma Assert (No (Index_Subtype));
213 end;
214
215 -- Build the inner attribute call
216
217 for Dim in 1 .. Ndim loop
218 Append_To (Exl, Make_Identifier (Loc, New_External_Name ('L', Dim)));
219 end loop;
220
221 Stm :=
222 Make_Attribute_Reference (Loc,
223 Prefix => New_Occurrence_Of (Put_Image_Base_Type (Ctyp), Loc),
224 Attribute_Name => Name_Put_Image,
225 Expressions => New_List (
226 Make_Identifier (Loc, Name_S),
227 Make_Indexed_Component (Loc,
228 Prefix => Make_Identifier (Loc, Name_V),
229 Expressions => Exl)));
230
231 -- The corresponding attribute for the component type of the array might
232 -- be user-defined, and frozen after the array type. In that case,
233 -- freeze the Put_Image attribute of the component type, whose
234 -- declaration could not generate any additional freezing actions in any
235 -- case.
236
237 PI_Entity := TSS (Base_Type (Ctyp), TSS_Put_Image);
238
239 if Present (PI_Entity) and then not Is_Frozen (PI_Entity) then
240 Set_Is_Frozen (PI_Entity);
241 end if;
242
243 -- Loop through the dimensions, innermost first, generating a loop for
244 -- each dimension.
245
246 declare
247 Stms : List_Id := New_List (Stm);
248 begin
249 for Dim in reverse 1 .. Ndim loop
250 declare
251 New_Stms : constant List_Id := New_List;
252 Between_Proc : RE_Id;
253 begin
254 -- For a one-dimensional array of elementary type, use
255 -- RE_Simple_Array_Between. The same applies to the last
256 -- dimension of a multidimensional array.
257
258 if Is_Elementary_Type (Ctyp) and then Dim = Ndim then
259 Between_Proc := RE_Simple_Array_Between;
260 else
261 Between_Proc := RE_Array_Between;
262 end if;
263
264 Append_To (New_Stms,
265 Make_Procedure_Call_Statement (Loc,
266 Name => New_Occurrence_Of (RTE (RE_Array_Before), Loc),
267 Parameter_Associations => New_List
268 (Make_Identifier (Loc, Name_S))));
269
270 Append_To
271 (New_Stms,
272 Wrap_In_Loop (Stms, Dim, Indices (Dim), Between_Proc));
273
274 Append_To (New_Stms,
275 Make_Procedure_Call_Statement (Loc,
276 Name => New_Occurrence_Of (RTE (RE_Array_After), Loc),
277 Parameter_Associations => New_List
278 (Make_Identifier (Loc, Name_S))));
279
280 Stms := New_Stms;
281 end;
282 end loop;
283
284 Build_Put_Image_Proc (Loc, Typ, Decl, Pnam, Stms);
285 end;
286 end Build_Array_Put_Image_Procedure;
287
288 -------------------------------------
289 -- Build_Elementary_Put_Image_Call --
290 -------------------------------------
291
292 function Build_Elementary_Put_Image_Call (N : Node_Id) return Node_Id is
293 Loc : constant Source_Ptr := Sloc (N);
294 P_Type : constant Entity_Id := Entity (Prefix (N));
295 U_Type : constant Entity_Id := Underlying_Type (P_Type);
296 FST : constant Entity_Id := First_Subtype (U_Type);
297 Sink : constant Node_Id := First (Expressions (N));
298 Item : constant Node_Id := Next (Sink);
299 P_Size : constant Uint := Esize (FST);
300 Lib_RE : RE_Id;
301
302 begin
303 if Is_Signed_Integer_Type (U_Type) then
304 if P_Size <= Standard_Integer_Size then
305 Lib_RE := RE_Put_Image_Integer;
306 elsif P_Size <= Standard_Long_Long_Integer_Size then
307 Lib_RE := RE_Put_Image_Long_Long_Integer;
308 else
309 pragma Assert (P_Size <= Standard_Long_Long_Long_Integer_Size);
310 Lib_RE := RE_Put_Image_Long_Long_Long_Integer;
311 end if;
312
313 elsif Is_Modular_Integer_Type (U_Type) then
314 if P_Size <= Standard_Integer_Size then -- Yes, Integer
315 Lib_RE := RE_Put_Image_Unsigned;
316 elsif P_Size <= Standard_Long_Long_Integer_Size then
317 Lib_RE := RE_Put_Image_Long_Long_Unsigned;
318 else
319 pragma Assert (P_Size <= Standard_Long_Long_Long_Integer_Size);
320 Lib_RE := RE_Put_Image_Long_Long_Long_Unsigned;
321 end if;
322
323 elsif Is_Access_Type (U_Type) then
324 if Is_Access_Protected_Subprogram_Type (Base_Type (U_Type)) then
325 Lib_RE := RE_Put_Image_Access_Prot_Subp;
326 elsif Is_Access_Subprogram_Type (Base_Type (U_Type)) then
327 Lib_RE := RE_Put_Image_Access_Subp;
328 elsif P_Size = System_Address_Size then
329 Lib_RE := RE_Put_Image_Thin_Pointer;
330 else
331 pragma Assert (P_Size = 2 * System_Address_Size);
332 Lib_RE := RE_Put_Image_Fat_Pointer;
333 end if;
334
335 else
336 pragma Assert
337 (Is_Enumeration_Type (U_Type) or else Is_Real_Type (U_Type));
338
339 -- For other elementary types, generate:
340 --
341 -- Wide_Wide_Put (Root_Buffer_Type'Class (Sink),
342 -- U_Type'Wide_Wide_Image (Item));
343 --
344 -- It would be more elegant to do it the other way around (define
345 -- '[[Wide_]Wide_]Image in terms of 'Put_Image). But this is easier
346 -- to implement, because we already have support for
347 -- 'Wide_Wide_Image. Furthermore, we don't want to remove the
348 -- existing support for '[[Wide_]Wide_]Image, because we don't
349 -- currently plan to support 'Put_Image on restricted runtimes.
350
351 -- We can't do this:
352 --
353 -- Put_UTF_8 (Sink, U_Type'Image (Item));
354 --
355 -- because we need to generate UTF-8, but 'Image for enumeration
356 -- types uses the character encoding of the source file.
357 --
358 -- Note that this is putting a leading space for reals.
359
360 declare
361 Image : constant Node_Id :=
362 Make_Attribute_Reference (Loc,
363 Prefix => New_Occurrence_Of (U_Type, Loc),
364 Attribute_Name => Name_Wide_Wide_Image,
365 Expressions => New_List (Relocate_Node (Item)));
366 Sink_Exp : constant Node_Id :=
367 Make_Type_Conversion (Loc,
368 Subtype_Mark =>
369 New_Occurrence_Of
370 (Class_Wide_Type (RTE (RE_Root_Buffer_Type)), Loc),
371 Expression => Relocate_Node (Sink));
372 Put_Call : constant Node_Id :=
373 Make_Procedure_Call_Statement (Loc,
374 Name =>
375 New_Occurrence_Of (RTE (RE_Wide_Wide_Put), Loc),
376 Parameter_Associations => New_List
377 (Sink_Exp, Image));
378 begin
379 -- We have built a dispatching call to handle calls to
380 -- descendants (since they are not available through rtsfind).
381 -- Further details available in the body of Put_String_Exp.
382
383 return Put_Call;
384 end;
385 end if;
386
387 -- Unchecked-convert parameter to the required type (i.e. the type of
388 -- the corresponding parameter), and call the appropriate routine.
389 -- We could use a normal type conversion for scalars, but the
390 -- "unchecked" is needed for access and private types.
391
392 declare
393 Libent : constant Entity_Id := RTE (Lib_RE);
394 begin
395 return
396 Make_Procedure_Call_Statement (Loc,
397 Name => New_Occurrence_Of (Libent, Loc),
398 Parameter_Associations => New_List (
399 Relocate_Node (Sink),
400 Unchecked_Convert_To
401 (Etype (Next_Formal (First_Formal (Libent))),
402 Relocate_Node (Item))));
403 end;
404 end Build_Elementary_Put_Image_Call;
405
406 -------------------------------------
407 -- Build_String_Put_Image_Call --
408 -------------------------------------
409
410 function Build_String_Put_Image_Call (N : Node_Id) return Node_Id is
411 Loc : constant Source_Ptr := Sloc (N);
412 P_Type : constant Entity_Id := Entity (Prefix (N));
413 U_Type : constant Entity_Id := Underlying_Type (P_Type);
414 R : constant Entity_Id := Root_Type (U_Type);
415 Sink : constant Node_Id := First (Expressions (N));
416 Item : constant Node_Id := Next (Sink);
417 Lib_RE : RE_Id;
418 use Stand;
419 begin
420 if R = Standard_String then
421 Lib_RE := RE_Put_Image_String;
422 elsif R = Standard_Wide_String then
423 Lib_RE := RE_Put_Image_Wide_String;
424 elsif R = Standard_Wide_Wide_String then
425 Lib_RE := RE_Put_Image_Wide_Wide_String;
426 else
427 raise Program_Error;
428 end if;
429
430 -- Convert parameter to the required type (i.e. the type of the
431 -- corresponding parameter), and call the appropriate routine.
432 -- We set the Conversion_OK flag in case the type is private.
433
434 declare
435 Libent : constant Entity_Id := RTE (Lib_RE);
436 Conv : constant Node_Id :=
437 OK_Convert_To
438 (Etype (Next_Formal (First_Formal (Libent))),
439 Relocate_Node (Item));
440 begin
441 -- Do not output string delimiters if this is part of an
442 -- interpolated string literal.
443
444 if Nkind (Parent (N)) = N_Expression_With_Actions
445 and then Nkind (Original_Node (Parent (N)))
446 = N_Interpolated_String_Literal
447 then
448 return
449 Make_Procedure_Call_Statement (Loc,
450 Name => New_Occurrence_Of (Libent, Loc),
451 Parameter_Associations => New_List (
452 Relocate_Node (Sink),
453 Conv,
454 New_Occurrence_Of (Stand.Standard_False, Loc)));
455 else
456 return
457 Make_Procedure_Call_Statement (Loc,
458 Name => New_Occurrence_Of (Libent, Loc),
459 Parameter_Associations => New_List (
460 Relocate_Node (Sink),
461 Conv));
462 end if;
463 end;
464 end Build_String_Put_Image_Call;
465
466 ------------------------------------
467 -- Build_Protected_Put_Image_Call --
468 ------------------------------------
469
470 -- For "Protected_Type'Put_Image (S, Protected_Object)", build:
471 --
472 -- Put_Image_Protected (S);
473 --
474 -- The protected object is not passed.
475
476 function Build_Protected_Put_Image_Call (N : Node_Id) return Node_Id is
477 Loc : constant Source_Ptr := Sloc (N);
478 Sink : constant Node_Id := First (Expressions (N));
479 Lib_RE : constant RE_Id := RE_Put_Image_Protected;
480 Libent : constant Entity_Id := RTE (Lib_RE);
481 begin
482 return
483 Make_Procedure_Call_Statement (Loc,
484 Name => New_Occurrence_Of (Libent, Loc),
485 Parameter_Associations => New_List (
486 Relocate_Node (Sink)));
487 end Build_Protected_Put_Image_Call;
488
489 ------------------------------------
490 -- Build_Task_Put_Image_Call --
491 ------------------------------------
492
493 -- For "Task_Type'Put_Image (S, Task_Object)", build:
494 --
495 -- Put_Image_Task (S, Task_Object'Identity);
496 --
497 -- The task object is not passed; its Task_Id is.
498
499 function Build_Task_Put_Image_Call (N : Node_Id) return Node_Id is
500 Loc : constant Source_Ptr := Sloc (N);
501 Sink : constant Node_Id := First (Expressions (N));
502 Item : constant Node_Id := Next (Sink);
503 Lib_RE : constant RE_Id := RE_Put_Image_Task;
504 Libent : constant Entity_Id := RTE (Lib_RE);
505
506 Task_Id : constant Node_Id :=
507 Make_Attribute_Reference (Loc,
508 Prefix => Relocate_Node (Item),
509 Attribute_Name => Name_Identity,
510 Expressions => No_List);
511
512 begin
513 return
514 Make_Procedure_Call_Statement (Loc,
515 Name => New_Occurrence_Of (Libent, Loc),
516 Parameter_Associations => New_List (
517 Relocate_Node (Sink),
518 Task_Id));
519 end Build_Task_Put_Image_Call;
520
521 --------------------------------------
522 -- Build_Record_Put_Image_Procedure --
523 --------------------------------------
524
525 -- The form of the record Put_Image procedure is as shown by the
526 -- following example:
527
528 -- procedure Put_Image (S : in out Sink'Class; V : Typ) is
529 -- begin
530 -- Component_Type'Put_Image (S, V.component);
531 -- Component_Type'Put_Image (S, V.component);
532 -- ...
533 -- Component_Type'Put_Image (S, V.component);
534 --
535 -- case V.discriminant is
536 -- when choices =>
537 -- Component_Type'Put_Image (S, V.component);
538 -- Component_Type'Put_Image (S, V.component);
539 -- ...
540 -- Component_Type'Put_Image (S, V.component);
541 --
542 -- when choices =>
543 -- Component_Type'Put_Image (S, V.component);
544 -- Component_Type'Put_Image (S, V.component);
545 -- ...
546 -- Component_Type'Put_Image (S, V.component);
547 -- ...
548 -- end case;
549 -- end Put_Image;
550
551 procedure Build_Record_Put_Image_Procedure
552 (Loc : Source_Ptr;
553 Typ : Entity_Id;
554 Decl : out Node_Id;
555 Pnam : out Entity_Id)
556 is
557 Btyp : constant Entity_Id := Base_Type (Typ);
558 pragma Assert (not Is_Class_Wide_Type (Btyp));
559 pragma Assert (not Is_Unchecked_Union (Btyp));
560
561 First_Time : Boolean := True;
562
563 function Make_Component_List_Attributes (CL : Node_Id) return List_Id;
564 -- Returns a sequence of Component_Type'Put_Image attribute_references
565 -- to process the components that are referenced in the given component
566 -- list. Called for the main component list, and then recursively for
567 -- variants.
568
569 function Make_Component_Attributes (Clist : List_Id) return List_Id;
570 -- Given Clist, a component items list, construct series of
571 -- Component_Type'Put_Image attribute_references for componentwise
572 -- processing of the corresponding components. Called for the
573 -- discriminants, and then from Make_Component_List_Attributes for each
574 -- list (including in variants).
575
576 procedure Append_Component_Attr (Clist : List_Id; C : Entity_Id);
577 -- Given C, the entity for a discriminant or component, build a call to
578 -- Component_Type'Put_Image for the corresponding component value, and
579 -- append it onto Clist. Called from Make_Component_Attributes.
580
581 function Make_Component_Name (C : Entity_Id) return Node_Id;
582 -- Create a call that prints "Comp_Name => "
583
584 ------------------------------------
585 -- Make_Component_List_Attributes --
586 ------------------------------------
587
588 function Make_Component_List_Attributes (CL : Node_Id) return List_Id is
589 CI : constant List_Id := Component_Items (CL);
590 VP : constant Node_Id := Variant_Part (CL);
591
592 Result : List_Id;
593 Alts : List_Id;
594 V : Node_Id;
595 DC : Node_Id;
596 DCH : List_Id;
597 D_Ref : Node_Id;
598
599 begin
600 Result := Make_Component_Attributes (CI);
601
602 if Present (VP) then
603 Alts := New_List;
604
605 V := First_Non_Pragma (Variants (VP));
606 while Present (V) loop
607 DCH := New_List;
608
609 DC := First (Discrete_Choices (V));
610 while Present (DC) loop
611 Append_To (DCH, New_Copy_Tree (DC));
612 Next (DC);
613 end loop;
614
615 Append_To (Alts,
616 Make_Case_Statement_Alternative (Loc,
617 Discrete_Choices => DCH,
618 Statements =>
619 Make_Component_List_Attributes (Component_List (V))));
620 Next_Non_Pragma (V);
621 end loop;
622
623 -- Note: in the following, we use New_Occurrence_Of for the
624 -- selector, since there are cases in which we make a reference
625 -- to a hidden discriminant that is not visible.
626
627 D_Ref :=
628 Make_Selected_Component (Loc,
629 Prefix => Make_Identifier (Loc, Name_V),
630 Selector_Name =>
631 New_Occurrence_Of (Entity (Name (VP)), Loc));
632
633 Append_To (Result,
634 Make_Case_Statement (Loc,
635 Expression => D_Ref,
636 Alternatives => Alts));
637 end if;
638
639 return Result;
640 end Make_Component_List_Attributes;
641
642 --------------------------------
643 -- Append_Component_Attr --
644 --------------------------------
645
646 procedure Append_Component_Attr (Clist : List_Id; C : Entity_Id) is
647 Component_Typ : constant Entity_Id := Put_Image_Base_Type (Etype (C));
648 begin
649 if Ekind (C) /= E_Void then
650 Append_To (Clist,
651 Make_Attribute_Reference (Loc,
652 Prefix => New_Occurrence_Of (Component_Typ, Loc),
653 Attribute_Name => Name_Put_Image,
654 Expressions => New_List (
655 Make_Identifier (Loc, Name_S),
656 Make_Selected_Component (Loc,
657 Prefix => Make_Identifier (Loc, Name_V),
658 Selector_Name => New_Occurrence_Of (C, Loc)))));
659 end if;
660 end Append_Component_Attr;
661
662 -------------------------------
663 -- Make_Component_Attributes --
664 -------------------------------
665
666 function Make_Component_Attributes (Clist : List_Id) return List_Id is
667 Item : Node_Id;
668 Result : List_Id;
669
670 begin
671 Result := New_List;
672
673 if Present (Clist) then
674 Item := First (Clist);
675
676 -- Loop through components, skipping all internal components,
677 -- which are not part of the value (e.g. _Tag), except that we
678 -- don't skip the _Parent, since we do want to process that
679 -- recursively.
680
681 while Present (Item) loop
682 if Nkind (Item) in
683 N_Component_Declaration | N_Discriminant_Specification
684 then
685 if Chars (Defining_Identifier (Item)) = Name_uParent then
686 declare
687 Parent_Type : constant Entity_Id :=
688 Implementation_Base_Type
689 (Etype (Defining_Identifier (Item)));
690
691 Parent_Aspect_Spec : constant Node_Id :=
692 Find_Aspect (Parent_Type, Aspect_Put_Image);
693
694 Parent_Type_Decl : constant Node_Id :=
695 Declaration_Node (Parent_Type);
696
697 Parent_Rdef : Node_Id :=
698 Type_Definition (Parent_Type_Decl);
699 begin
700 -- If parent type has an noninherited
701 -- explicitly-specified Put_Image aspect spec, then
702 -- display parent part by calling specified procedure,
703 -- and then use extension-aggregate syntax for the
704 -- remaining components as per RM 4.10(15/5);
705 -- otherwise, "look through" the parent component
706 -- to its components - we don't want the image text
707 -- to include mention of an "_parent" component.
708
709 if Present (Parent_Aspect_Spec) and then
710 Entity (Parent_Aspect_Spec) = Parent_Type
711 then
712 Append_Component_Attr
713 (Result, Defining_Identifier (Item));
714
715 -- Omit the " with " if no subsequent components.
716
717 if not Is_Null_Extension_Of
718 (Descendant => Typ,
719 Ancestor => Parent_Type)
720 then
721 Append_To (Result,
722 Make_Procedure_Call_Statement (Loc,
723 Name =>
724 New_Occurrence_Of
725 (RTE (RE_Put_UTF_8), Loc),
726 Parameter_Associations => New_List
727 (Make_Identifier (Loc, Name_S),
728 Make_String_Literal (Loc, " with "))));
729 end if;
730 else
731 if Nkind (Parent_Rdef) = N_Derived_Type_Definition
732 then
733 Parent_Rdef :=
734 Record_Extension_Part (Parent_Rdef);
735 end if;
736
737 if Present (Component_List (Parent_Rdef)) then
738 Append_List_To (Result,
739 Make_Component_List_Attributes
740 (Component_List (Parent_Rdef)));
741 end if;
742 end if;
743 end;
744
745 elsif not Is_Internal_Name
746 (Chars (Defining_Identifier (Item)))
747 then
748 if First_Time then
749 First_Time := False;
750 else
751 Append_To (Result,
752 Make_Procedure_Call_Statement (Loc,
753 Name =>
754 New_Occurrence_Of (RTE (RE_Record_Between), Loc),
755 Parameter_Associations => New_List
756 (Make_Identifier (Loc, Name_S))));
757 end if;
758
759 Append_To (Result, Make_Component_Name (Item));
760 Append_Component_Attr
761 (Result, Defining_Identifier (Item));
762 end if;
763 end if;
764
765 Next (Item);
766 end loop;
767 end if;
768
769 return Result;
770 end Make_Component_Attributes;
771
772 -------------------------
773 -- Make_Component_Name --
774 -------------------------
775
776 function Make_Component_Name (C : Entity_Id) return Node_Id is
777 Name : constant Name_Id := Chars (Defining_Identifier (C));
778 pragma Assert (Name /= Name_uParent);
779
780 function To_Upper (S : String) return String;
781 -- Same as Ada.Characters.Handling.To_Upper, but withing
782 -- Ada.Characters.Handling seems to cause mailserver problems.
783
784 --------------
785 -- To_Upper --
786 --------------
787
788 function To_Upper (S : String) return String is
789 begin
790 return Result : String := S do
791 for Char of Result loop
792 Char := Fold_Upper (Char);
793 end loop;
794 end return;
795 end To_Upper;
796
797 -- Start of processing for Make_Component_Name
798
799 begin
800 return
801 Make_Procedure_Call_Statement (Loc,
802 Name => New_Occurrence_Of (RTE (RE_Put_UTF_8), Loc),
803 Parameter_Associations => New_List
804 (Make_Identifier (Loc, Name_S),
805 Make_String_Literal (Loc,
806 To_Upper (Get_Name_String (Name)) & " => ")));
807 end Make_Component_Name;
808
809 Stms : constant List_Id := New_List;
810 Rdef : Node_Id;
811 Type_Decl : constant Node_Id :=
812 Declaration_Node (Base_Type (Underlying_Type (Btyp)));
813
814 -- Start of processing for Build_Record_Put_Image_Procedure
815
816 begin
817 if (Ada_Version < Ada_2022)
818 or else not Enable_Put_Image (Btyp)
819 then
820 -- generate a very simple Put_Image implementation
821
822 if Is_RTE (Typ, RE_Root_Buffer_Type) then
823 -- Avoid introducing a cyclic dependency between
824 -- Ada.Strings.Text_Buffers and System.Put_Images.
825
826 Append_To (Stms,
827 Make_Raise_Program_Error (Loc,
828 Reason => PE_Explicit_Raise));
829 else
830 Append_To (Stms,
831 Make_Procedure_Call_Statement (Loc,
832 Name => New_Occurrence_Of (RTE (RE_Put_Image_Unknown), Loc),
833 Parameter_Associations => New_List
834 (Make_Identifier (Loc, Name_S),
835 Make_String_Literal (Loc,
836 To_String (Fully_Qualified_Name_String (Btyp))))));
837 end if;
838 elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True) then
839
840 -- Interface types take this path.
841
842 Append_To (Stms,
843 Make_Procedure_Call_Statement (Loc,
844 Name => New_Occurrence_Of (RTE (RE_Put_UTF_8), Loc),
845 Parameter_Associations => New_List
846 (Make_Identifier (Loc, Name_S),
847 Make_String_Literal (Loc, "(NULL RECORD)"))));
848 else
849 Append_To (Stms,
850 Make_Procedure_Call_Statement (Loc,
851 Name => New_Occurrence_Of (RTE (RE_Record_Before), Loc),
852 Parameter_Associations => New_List
853 (Make_Identifier (Loc, Name_S))));
854
855 -- Generate Put_Images for the discriminants of the type
856
857 Append_List_To (Stms,
858 Make_Component_Attributes
859 (Discriminant_Specifications (Type_Decl)));
860
861 Rdef := Type_Definition (Type_Decl);
862
863 -- In the record extension case, the components we want are to be
864 -- found in the extension (although we have to process the
865 -- _Parent component to find inherited components).
866
867 if Nkind (Rdef) = N_Derived_Type_Definition then
868 Rdef := Record_Extension_Part (Rdef);
869 end if;
870
871 if Present (Component_List (Rdef)) then
872 Append_List_To (Stms,
873 Make_Component_List_Attributes (Component_List (Rdef)));
874 end if;
875
876 Append_To (Stms,
877 Make_Procedure_Call_Statement (Loc,
878 Name => New_Occurrence_Of (RTE (RE_Record_After), Loc),
879 Parameter_Associations => New_List
880 (Make_Identifier (Loc, Name_S))));
881 end if;
882
883 Pnam := Make_Put_Image_Name (Loc, Btyp);
884 Build_Put_Image_Proc (Loc, Btyp, Decl, Pnam, Stms);
885 end Build_Record_Put_Image_Procedure;
886
887 -------------------------------
888 -- Build_Put_Image_Profile --
889 -------------------------------
890
891 function Build_Put_Image_Profile
892 (Loc : Source_Ptr; Typ : Entity_Id) return List_Id
893 is
894 begin
895 return New_List (
896 Make_Parameter_Specification (Loc,
897 Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
898 In_Present => True,
899 Out_Present => True,
900 Parameter_Type =>
901 New_Occurrence_Of
902 (Class_Wide_Type (RTE (RE_Root_Buffer_Type)), Loc)),
903
904 Make_Parameter_Specification (Loc,
905 Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
906 Parameter_Type => New_Occurrence_Of (Typ, Loc)));
907 end Build_Put_Image_Profile;
908
909 --------------------------
910 -- Build_Put_Image_Proc --
911 --------------------------
912
913 procedure Build_Put_Image_Proc
914 (Loc : Source_Ptr;
915 Typ : Entity_Id;
916 Decl : out Node_Id;
917 Pnam : Entity_Id;
918 Stms : List_Id)
919 is
920 Spec : constant Node_Id :=
921 Make_Procedure_Specification (Loc,
922 Defining_Unit_Name => Pnam,
923 Parameter_Specifications => Build_Put_Image_Profile (Loc, Typ));
924 begin
925 Decl :=
926 Make_Subprogram_Body (Loc,
927 Specification => Spec,
928 Declarations => Empty_List,
929 Handled_Statement_Sequence =>
930 Make_Handled_Sequence_Of_Statements (Loc,
931 Statements => Stms));
932 end Build_Put_Image_Proc;
933
934 ------------------------------------
935 -- Build_Unknown_Put_Image_Call --
936 ------------------------------------
937
938 function Build_Unknown_Put_Image_Call (N : Node_Id) return Node_Id is
939 Loc : constant Source_Ptr := Sloc (N);
940 Sink : constant Node_Id := First (Expressions (N));
941 Lib_RE : constant RE_Id := RE_Put_Image_Unknown;
942 Libent : constant Entity_Id := RTE (Lib_RE);
943 begin
944 return
945 Make_Procedure_Call_Statement (Loc,
946 Name => New_Occurrence_Of (Libent, Loc),
947 Parameter_Associations => New_List (
948 Relocate_Node (Sink),
949 Make_String_Literal (Loc,
950 Exp_Util.Fully_Qualified_Name_String (
951 Entity (Prefix (N)), Append_NUL => False))));
952 end Build_Unknown_Put_Image_Call;
953
954 ----------------------
955 -- Enable_Put_Image --
956 ----------------------
957
958 function Enable_Put_Image (Typ : Entity_Id) return Boolean is
959 begin
960 -- If this function returns False for a non-scalar type Typ, then
961 -- a) calls to Typ'Image will result in calls to
962 -- System.Put_Images.Put_Image_Unknown to generate the image.
963 -- b) If Typ is a tagged type, then similarly the implementation
964 -- of Typ's Put_Image procedure will call Put_Image_Unknown
965 -- and will ignore its formal parameter of type Typ.
966 -- Note that Typ will still have a Put_Image procedure
967 -- in this case, albeit one with a simplified implementation.
968 --
969 -- The name "Sink" here is a short nickname for
970 -- "Ada.Strings.Text_Buffers.Root_Buffer_Type".
971 --
972 -- Put_Image does not work for Remote_Types. We check the containing
973 -- package, rather than the type itself, because we want to include
974 -- types in the private part of a Remote_Types package.
975
976 if Is_Remote_Types (Scope (Typ))
977 or else Is_Remote_Call_Interface (Typ)
978 or else (Is_Tagged_Type (Typ) and then In_Predefined_Unit (Typ))
979 then
980 return False;
981 end if;
982
983 -- No sense in generating code for Put_Image if there are errors. This
984 -- avoids certain cascade errors.
985
986 if Total_Errors_Detected > 0 then
987 return False;
988 end if;
989
990 -- If type Sink is unavailable in this runtime, disable Put_Image
991 -- altogether.
992
993 if No_Run_Time_Mode or else not RTE_Available (RE_Root_Buffer_Type) then
994 return False;
995 end if;
996
997 -- ???Disable Put_Image on type Root_Buffer_Type declared in
998 -- Ada.Strings.Text_Buffers. Note that we can't call Is_RTU on
999 -- Ada_Strings_Text_Buffers, because it's not known yet (we might be
1000 -- compiling it). But this is insufficient to allow support for tagged
1001 -- predefined types.
1002
1003 declare
1004 Parent_Scope : constant Entity_Id := Scope (Scope (Typ));
1005 begin
1006 if Present (Parent_Scope)
1007 and then Is_RTU (Parent_Scope, Ada_Strings)
1008 and then Chars (Scope (Typ)) = Name_Find ("text_buffers")
1009 then
1010 return False;
1011 end if;
1012 end;
1013
1014 -- Disable for CPP types, because the components are unavailable on the
1015 -- Ada side.
1016
1017 if Is_Tagged_Type (Typ)
1018 and then Convention (Typ) = Convention_CPP
1019 and then Is_CPP_Class (Root_Type (Typ))
1020 then
1021 return False;
1022 end if;
1023
1024 -- Disable for unchecked unions, because there is no way to know the
1025 -- discriminant value, and therefore no way to know which components
1026 -- should be printed.
1027
1028 if Is_Unchecked_Union (Typ) then
1029 return False;
1030 end if;
1031
1032 return True;
1033 end Enable_Put_Image;
1034
1035 -------------------------
1036 -- Make_Put_Image_Name --
1037 -------------------------
1038
1039 function Make_Put_Image_Name
1040 (Loc : Source_Ptr; Typ : Entity_Id) return Entity_Id
1041 is
1042 Sname : Name_Id;
1043 begin
1044 -- For tagged types, we are dealing with a TSS associated with the
1045 -- declaration, so we use the standard primitive function name. For
1046 -- other types, generate a local TSS name since we are generating
1047 -- the subprogram at the point of use.
1048
1049 if Is_Tagged_Type (Typ) then
1050 Sname := Make_TSS_Name (Typ, TSS_Put_Image);
1051 else
1052 Sname := Make_TSS_Name_Local (Typ, TSS_Put_Image);
1053 end if;
1054
1055 return Make_Defining_Identifier (Loc, Sname);
1056 end Make_Put_Image_Name;
1057
1058 ---------------------------------
1059 -- Image_Should_Call_Put_Image --
1060 ---------------------------------
1061
1062 function Image_Should_Call_Put_Image (N : Node_Id) return Boolean is
1063 begin
1064 if Ada_Version < Ada_2022 then
1065 return False;
1066 end if;
1067
1068 -- In Ada 2022, T'Image calls T'Put_Image if there is an explicit
1069 -- (or inherited) aspect_specification for Put_Image, or if
1070 -- U_Type'Image is illegal in pre-2022 versions of Ada.
1071
1072 declare
1073 U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N)));
1074 begin
1075 if Has_Aspect (U_Type, Aspect_Put_Image) then
1076 return True;
1077 end if;
1078
1079 return not Is_Scalar_Type (U_Type);
1080 end;
1081 end Image_Should_Call_Put_Image;
1082
1083 ----------------------
1084 -- Build_Image_Call --
1085 ----------------------
1086
1087 function Build_Image_Call (N : Node_Id) return Node_Id is
1088 -- For T'[[Wide_]Wide_]Image (X) Generate an Expression_With_Actions
1089 -- node:
1090 --
1091 -- do
1092 -- S : Buffer;
1093 -- U_Type'Put_Image (S, X);
1094 -- Result : constant [[Wide_]Wide_]String :=
1095 -- [[Wide_[Wide_]]Get (S);
1096 -- Destroy (S);
1097 -- in Result end
1098 --
1099 -- where U_Type is the underlying type, as needed to bypass privacy.
1100
1101 Loc : constant Source_Ptr := Sloc (N);
1102 U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N)));
1103 Sink_Entity : constant Entity_Id :=
1104 Make_Temporary (Loc, 'S');
1105 Sink_Decl : constant Node_Id :=
1106 Make_Object_Declaration (Loc,
1107 Defining_Identifier => Sink_Entity,
1108 Object_Definition =>
1109 New_Occurrence_Of (RTE (RE_Buffer_Type), Loc));
1110
1111 Image_Prefix : constant Node_Id :=
1112 Duplicate_Subexpr (First (Expressions (N)));
1113
1114 Put_Im : constant Node_Id :=
1115 Make_Attribute_Reference (Loc,
1116 Prefix => New_Occurrence_Of (U_Type, Loc),
1117 Attribute_Name => Name_Put_Image,
1118 Expressions => New_List (
1119 New_Occurrence_Of (Sink_Entity, Loc),
1120 Image_Prefix));
1121 Result_Entity : constant Entity_Id :=
1122 Make_Temporary (Loc, 'R');
1123
1124 subtype Image_Name_Id is Name_Id with Static_Predicate =>
1125 Image_Name_Id in Name_Image | Name_Wide_Image | Name_Wide_Wide_Image;
1126 -- Attribute names that will be mapped to the corresponding result types
1127 -- and functions.
1128
1129 Attribute_Name_Id : constant Name_Id := Attribute_Name (N);
1130
1131 Result_Typ : constant Entity_Id :=
1132 (case Image_Name_Id'(Attribute_Name_Id) is
1133 when Name_Image => Stand.Standard_String,
1134 when Name_Wide_Image => Stand.Standard_Wide_String,
1135 when Name_Wide_Wide_Image => Stand.Standard_Wide_Wide_String);
1136 Get_Func_Id : constant RE_Id :=
1137 (case Image_Name_Id'(Attribute_Name_Id) is
1138 when Name_Image => RE_Get,
1139 when Name_Wide_Image => RE_Wide_Get,
1140 when Name_Wide_Wide_Image => RE_Wide_Wide_Get);
1141
1142 Result_Decl : constant Node_Id :=
1143 Make_Object_Declaration (Loc,
1144 Defining_Identifier => Result_Entity,
1145 Object_Definition =>
1146 New_Occurrence_Of (Result_Typ, Loc),
1147 Expression =>
1148 Make_Function_Call (Loc,
1149 Name => New_Occurrence_Of (RTE (Get_Func_Id), Loc),
1150 Parameter_Associations => New_List (
1151 New_Occurrence_Of (Sink_Entity, Loc))));
1152 Actions : List_Id;
1153
1154 function Put_String_Exp (String_Exp : Node_Id;
1155 Wide_Wide : Boolean := False) return Node_Id;
1156 -- Generate a call to evaluate a String (or Wide_Wide_String, depending
1157 -- on the Wide_Wide Boolean parameter) expression and output it into
1158 -- the buffer.
1159
1160 --------------------
1161 -- Put_String_Exp --
1162 --------------------
1163
1164 function Put_String_Exp (String_Exp : Node_Id;
1165 Wide_Wide : Boolean := False) return Node_Id is
1166 Put_Id : constant RE_Id :=
1167 (if Wide_Wide then RE_Wide_Wide_Put else RE_Put_UTF_8);
1168
1169 -- We could build a nondispatching call here, but to make
1170 -- that work we'd have to change Rtsfind spec to make available
1171 -- corresponding callees out of Ada.Strings.Text_Buffers.Unbounded
1172 -- (as opposed to from Ada.Strings.Text_Buffers). Seems simpler to
1173 -- introduce a type conversion and leave it to the optimizer to
1174 -- eliminate the dispatching. This does not *introduce* any problems
1175 -- if a no-dispatching-allowed restriction is in effect, since we
1176 -- are already in the middle of generating a call to T'Class'Image.
1177
1178 Sink_Exp : constant Node_Id :=
1179 Make_Type_Conversion (Loc,
1180 Subtype_Mark =>
1181 New_Occurrence_Of
1182 (Class_Wide_Type (RTE (RE_Root_Buffer_Type)), Loc),
1183 Expression => New_Occurrence_Of (Sink_Entity, Loc));
1184 begin
1185 return
1186 Make_Procedure_Call_Statement (Loc,
1187 Name => New_Occurrence_Of (RTE (Put_Id), Loc),
1188 Parameter_Associations => New_List (Sink_Exp, String_Exp));
1189 end Put_String_Exp;
1190
1191 -- Start of processing for Build_Image_Call
1192
1193 begin
1194 if Is_Class_Wide_Type (U_Type) then
1195 -- Generate qualified-expression syntax; qualification name comes
1196 -- from calling Ada.Tags.Wide_Wide_Expanded_Name.
1197
1198 declare
1199 -- The copy of Image_Prefix will be evaluated before the
1200 -- original, which is ok if no side effects are involved.
1201
1202 pragma Assert (Side_Effect_Free (Image_Prefix));
1203
1204 Specific_Type_Name : constant Node_Id :=
1205 Put_String_Exp
1206 (Make_Function_Call (Loc,
1207 Name => New_Occurrence_Of
1208 (RTE (RE_Wide_Wide_Expanded_Name), Loc),
1209 Parameter_Associations => New_List (
1210 Make_Attribute_Reference (Loc,
1211 Prefix => Duplicate_Subexpr (Image_Prefix),
1212 Attribute_Name => Name_Tag))),
1213 Wide_Wide => True);
1214
1215 Qualification : constant Node_Id :=
1216 Put_String_Exp (Make_String_Literal (Loc, "'"));
1217 begin
1218 Actions := New_List
1219 (Sink_Decl,
1220 Specific_Type_Name,
1221 Qualification,
1222 Put_Im,
1223 Result_Decl);
1224 end;
1225 else
1226 Actions := New_List (Sink_Decl, Put_Im, Result_Decl);
1227 end if;
1228
1229 return Make_Expression_With_Actions (Loc,
1230 Actions => Actions,
1231 Expression => New_Occurrence_Of (Result_Entity, Loc));
1232 end Build_Image_Call;
1233
1234 ------------------------------
1235 -- Preload_Root_Buffer_Type --
1236 ------------------------------
1237
1238 procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id) is
1239 begin
1240 -- We can't call RTE (RE_Root_Buffer_Type) for at least some
1241 -- predefined units, because it would introduce cyclic dependences.
1242 -- The package where Root_Buffer_Type is declared, for example, and
1243 -- things it depends on.
1244 --
1245 -- It's only needed for tagged types, so don't do it unless Put_Image is
1246 -- enabled for tagged types, and we've seen a tagged type. Note that
1247 -- Tagged_Seen is set True by the parser if the "tagged" reserved word
1248 -- is seen; this flag tells us whether we have any tagged types.
1249 -- It's unfortunate to have this Tagged_Seen processing so scattered
1250 -- about, but we need to know if there are tagged types where this is
1251 -- called in Analyze_Compilation_Unit, before we have analyzed any type
1252 -- declarations. This mechanism also prevents doing
1253 -- RTE (RE_Root_Buffer_Type) when compiling the compiler itself.
1254 -- Packages Ada.Strings.Buffer_Types and friends are not included
1255 -- in the compiler.
1256 --
1257 -- Don't do it if type Root_Buffer_Type is unavailable in the runtime.
1258
1259 if not In_Predefined_Unit (Compilation_Unit)
1260 and then Tagged_Seen
1261 and then not No_Run_Time_Mode
1262 and then RTE_Available (RE_Root_Buffer_Type)
1263 then
1264 declare
1265 Ignore : constant Entity_Id := RTE (RE_Root_Buffer_Type);
1266 begin
1267 null;
1268 end;
1269 end if;
1270 end Preload_Root_Buffer_Type;
1271
1272 -------------------------
1273 -- Put_Image_Base_Type --
1274 -------------------------
1275
1276 function Put_Image_Base_Type (E : Entity_Id) return Entity_Id is
1277 begin
1278 if Is_Array_Type (E) and then Is_First_Subtype (E) then
1279 return E;
1280 else
1281 return Base_Type (E);
1282 end if;
1283 end Put_Image_Base_Type;
1284
1285 end Exp_Put_Image;
Mirror of the offical gcc git repository hosted at gcc.gnu.org