?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[RS6000] Don't be too clever with dg-do run and dg-do compile
[official-gcc.git] / gcc / ada / repinfo.adb
blobdff327221a5ad8e462ddd0ad5d9e82bffd0c8ed4
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- R E P I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2020, 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 Alloc;
27 with Atree; use Atree;
28 with Casing; use Casing;
29 with Debug; use Debug;
30 with Einfo; use Einfo;
31 with Lib; use Lib;
32 with Namet; use Namet;
33 with Nlists; use Nlists;
34 with Opt; use Opt;
35 with Output; use Output;
36 with Sem_Aux; use Sem_Aux;
37 with Sem_Eval; use Sem_Eval;
38 with Sinfo; use Sinfo;
39 with Sinput; use Sinput;
40 with Snames; use Snames;
41 with Stringt; use Stringt;
42 with Table;
43 with Ttypes;
44 with Uname; use Uname;
45 with Urealp; use Urealp;
46
47 with Ada.Unchecked_Conversion;
48
49 with GNAT.HTable;
50
51 package body Repinfo is
52
53 SSU : Pos renames Ttypes.System_Storage_Unit;
54 -- Value for Storage_Unit
55
56 ---------------------------------------
57 -- Representation of GCC Expressions --
58 ---------------------------------------
59
60 -- A table internal to this unit is used to hold the values of back
61 -- annotated expressions.
62
63 -- Node values are stored as Uint values using the negative of the node
64 -- index in this table. Constants appear as non-negative Uint values.
65
66 type Exp_Node is record
67 Expr : TCode;
68 Op1 : Node_Ref_Or_Val;
69 Op2 : Node_Ref_Or_Val;
70 Op3 : Node_Ref_Or_Val;
71 end record;
72
73 -- The following representation clause ensures that the above record
74 -- has no holes. We do this so that when instances of this record are
75 -- written, we do not write uninitialized values to the file.
76
77 for Exp_Node use record
78 Expr at 0 range 0 .. 31;
79 Op1 at 4 range 0 .. 31;
80 Op2 at 8 range 0 .. 31;
81 Op3 at 12 range 0 .. 31;
82 end record;
83
84 for Exp_Node'Size use 16 * 8;
85 -- This ensures that we did not leave out any fields
86
87 package Rep_Table is new Table.Table (
88 Table_Component_Type => Exp_Node,
89 Table_Index_Type => Nat,
90 Table_Low_Bound => 1,
91 Table_Initial => Alloc.Rep_Table_Initial,
92 Table_Increment => Alloc.Rep_Table_Increment,
93 Table_Name => "BE_Rep_Table");
94
95 --------------------------------------------------------------
96 -- Representation of Front-End Dynamic Size/Offset Entities --
97 --------------------------------------------------------------
98
99 package Dynamic_SO_Entity_Table is new Table.Table (
100 Table_Component_Type => Entity_Id,
101 Table_Index_Type => Nat,
102 Table_Low_Bound => 1,
103 Table_Initial => Alloc.Rep_Table_Initial,
104 Table_Increment => Alloc.Rep_Table_Increment,
105 Table_Name => "FE_Rep_Table");
106
107 Unit_Casing : Casing_Type;
108 -- Identifier casing for current unit. This is set by List_Rep_Info for
109 -- each unit, before calling subprograms which may read it.
110
111 Need_Separator : Boolean;
112 -- Set True if a separator is needed before outputting any information for
113 -- the current entity.
114
115 ------------------------------
116 -- Set of Relevant Entities --
117 ------------------------------
118
119 Relevant_Entities_Size : constant := 4093;
120 -- Number of headers in hash table
121
122 subtype Entity_Header_Num is Integer range 0 .. Relevant_Entities_Size - 1;
123 -- Range of headers in hash table
124
125 function Entity_Hash (Id : Entity_Id) return Entity_Header_Num;
126 -- Simple hash function for Entity_Ids
127
128 package Relevant_Entities is new GNAT.Htable.Simple_HTable
129 (Header_Num => Entity_Header_Num,
130 Element => Boolean,
131 No_Element => False,
132 Key => Entity_Id,
133 Hash => Entity_Hash,
134 Equal => "=");
135 -- Hash table to record which compiler-generated entities are relevant
136
137 -----------------------
138 -- Local Subprograms --
139 -----------------------
140
141 function Back_End_Layout return Boolean;
142 -- Test for layout mode, True = back end, False = front end. This function
143 -- is used rather than checking the configuration parameter because we do
144 -- not want Repinfo to depend on Targparm.
145
146 procedure List_Entities
147 (Ent : Entity_Id;
148 Bytes_Big_Endian : Boolean;
149 In_Subprogram : Boolean := False);
150 -- This procedure lists the entities associated with the entity E, starting
151 -- with the First_Entity and using the Next_Entity link. If a nested
152 -- package is found, entities within the package are recursively processed.
153 -- When recursing within a subprogram body, Is_Subprogram suppresses
154 -- duplicate information about signature.
155
156 procedure List_Name (Ent : Entity_Id);
157 -- List name of entity Ent in appropriate case. The name is listed with
158 -- full qualification up to but not including the compilation unit name.
159
160 procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
161 -- List representation info for array type Ent
162
163 procedure List_Common_Type_Info (Ent : Entity_Id);
164 -- List common type info (name, size, alignment) for type Ent
165
166 procedure List_Linker_Section (Ent : Entity_Id);
167 -- List linker section for Ent (caller has checked that Ent is an entity
168 -- for which the Linker_Section_Pragma field is defined).
169
170 procedure List_Location (Ent : Entity_Id);
171 -- List location information for Ent
172
173 procedure List_Object_Info (Ent : Entity_Id);
174 -- List representation info for object Ent
175
176 procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
177 -- List representation info for record type Ent
178
179 procedure List_Scalar_Storage_Order
180 (Ent : Entity_Id;
181 Bytes_Big_Endian : Boolean);
182 -- List scalar storage order information for record or array type Ent.
183 -- Also includes bit order information for record types, if necessary.
184
185 procedure List_Subprogram_Info (Ent : Entity_Id);
186 -- List subprogram info for subprogram Ent
187
188 procedure List_Type_Info (Ent : Entity_Id);
189 -- List type info for type Ent
190
191 function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
192 -- Returns True if Val represents a variable value, and False if it
193 -- represents a value that is fixed at compile time.
194
195 procedure Spaces (N : Natural);
196 -- Output given number of spaces
197
198 procedure Write_Info_Line (S : String);
199 -- Routine to write a line to Repinfo output file. This routine is passed
200 -- as a special output procedure to Output.Set_Special_Output. Note that
201 -- Write_Info_Line is called with an EOL character at the end of each line,
202 -- as per the Output spec, but the internal call to the appropriate routine
203 -- in Osint requires that the end of line sequence be stripped off.
204
205 procedure Write_Mechanism (M : Mechanism_Type);
206 -- Writes symbolic string for mechanism represented by M
207
208 procedure Write_Separator;
209 -- Called before outputting anything for an entity. Ensures that
210 -- a separator precedes the output for a particular entity.
211
212 procedure Write_Unknown_Val;
213 -- Writes symbolic string for an unknown or non-representable value
214
215 procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
216 -- Given a representation value, write it out. No_Uint values or values
217 -- dependent on discriminants are written as two question marks. If the
218 -- flag Paren is set, then the output is surrounded in parentheses if it is
219 -- other than a simple value.
220
221 ---------------------
222 -- Back_End_Layout --
223 ---------------------
224
225 function Back_End_Layout return Boolean is
226 begin
227 -- We have back-end layout if the back end has made any entries in the
228 -- table of GCC expressions, otherwise we have front-end layout.
229
230 return Rep_Table.Last > 0;
231 end Back_End_Layout;
232
233 ------------------------
234 -- Create_Discrim_Ref --
235 ------------------------
236
237 function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
238 begin
239 return Create_Node
240 (Expr => Discrim_Val,
241 Op1 => Discriminant_Number (Discr));
242 end Create_Discrim_Ref;
243
244 ---------------------------
245 -- Create_Dynamic_SO_Ref --
246 ---------------------------
247
248 function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
249 begin
250 Dynamic_SO_Entity_Table.Append (E);
251 return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
252 end Create_Dynamic_SO_Ref;
253
254 -----------------
255 -- Create_Node --
256 -----------------
257
258 function Create_Node
259 (Expr : TCode;
260 Op1 : Node_Ref_Or_Val;
261 Op2 : Node_Ref_Or_Val := No_Uint;
262 Op3 : Node_Ref_Or_Val := No_Uint) return Node_Ref
263 is
264 begin
265 Rep_Table.Append (
266 (Expr => Expr,
267 Op1 => Op1,
268 Op2 => Op2,
269 Op3 => Op3));
270 return UI_From_Int (-Rep_Table.Last);
271 end Create_Node;
272
273 -----------------
274 -- Entity_Hash --
275 -----------------
276
277 function Entity_Hash (Id : Entity_Id) return Entity_Header_Num is
278 begin
279 return Entity_Header_Num (Id mod Relevant_Entities_Size);
280 end Entity_Hash;
281
282 ---------------------------
283 -- Get_Dynamic_SO_Entity --
284 ---------------------------
285
286 function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id is
287 begin
288 return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
289 end Get_Dynamic_SO_Entity;
290
291 -----------------------
292 -- Is_Dynamic_SO_Ref --
293 -----------------------
294
295 function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
296 begin
297 return U < Uint_0;
298 end Is_Dynamic_SO_Ref;
299
300 ----------------------
301 -- Is_Static_SO_Ref --
302 ----------------------
303
304 function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
305 begin
306 return U >= Uint_0;
307 end Is_Static_SO_Ref;
308
309 ---------
310 -- lgx --
311 ---------
312
313 procedure lgx (U : Node_Ref_Or_Val) is
314 begin
315 List_GCC_Expression (U);
316 Write_Eol;
317 end lgx;
318
319 ----------------------
320 -- List_Array_Info --
321 ----------------------
322
323 procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
324 begin
325 Write_Separator;
326
327 if List_Representation_Info_To_JSON then
328 Write_Line ("{");
329 end if;
330
331 List_Common_Type_Info (Ent);
332
333 if List_Representation_Info_To_JSON then
334 Write_Line (",");
335 Write_Str (" ""Component_Size"": ");
336 Write_Val (Component_Size (Ent));
337 else
338 Write_Str ("for ");
339 List_Name (Ent);
340 Write_Str ("'Component_Size use ");
341 Write_Val (Component_Size (Ent));
342 Write_Line (";");
343 end if;
344
345 List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
346
347 List_Linker_Section (Ent);
348
349 if List_Representation_Info_To_JSON then
350 Write_Eol;
351 Write_Line ("}");
352 end if;
353
354 -- The component type is relevant for an array
355
356 if List_Representation_Info = 4
357 and then Is_Itype (Component_Type (Base_Type (Ent)))
358 then
359 Relevant_Entities.Set (Component_Type (Base_Type (Ent)), True);
360 end if;
361 end List_Array_Info;
362
363 ---------------------------
364 -- List_Common_Type_Info --
365 ---------------------------
366
367 procedure List_Common_Type_Info (Ent : Entity_Id) is
368 begin
369 if List_Representation_Info_To_JSON then
370 Write_Str (" ""name"": """);
371 List_Name (Ent);
372 Write_Line (""",");
373 List_Location (Ent);
374 end if;
375
376 -- Do not list size info for unconstrained arrays, not meaningful
377
378 if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
379 null;
380
381 else
382 -- If Esize and RM_Size are the same, list as Size. This is a common
383 -- case, which we may as well list in simple form.
384
385 if Esize (Ent) = RM_Size (Ent) then
386 if List_Representation_Info_To_JSON then
387 Write_Str (" ""Size"": ");
388 Write_Val (Esize (Ent));
389 Write_Line (",");
390 else
391 Write_Str ("for ");
392 List_Name (Ent);
393 Write_Str ("'Size use ");
394 Write_Val (Esize (Ent));
395 Write_Line (";");
396 end if;
397
398 -- Otherwise list size values separately
399
400 else
401 if List_Representation_Info_To_JSON then
402 Write_Str (" ""Object_Size"": ");
403 Write_Val (Esize (Ent));
404 Write_Line (",");
405
406 Write_Str (" ""Value_Size"": ");
407 Write_Val (RM_Size (Ent));
408 Write_Line (",");
409
410 else
411 Write_Str ("for ");
412 List_Name (Ent);
413 Write_Str ("'Object_Size use ");
414 Write_Val (Esize (Ent));
415 Write_Line (";");
416
417 Write_Str ("for ");
418 List_Name (Ent);
419 Write_Str ("'Value_Size use ");
420 Write_Val (RM_Size (Ent));
421 Write_Line (";");
422 end if;
423 end if;
424 end if;
425
426 if List_Representation_Info_To_JSON then
427 Write_Str (" ""Alignment"": ");
428 Write_Val (Alignment (Ent));
429 else
430 Write_Str ("for ");
431 List_Name (Ent);
432 Write_Str ("'Alignment use ");
433 Write_Val (Alignment (Ent));
434 Write_Line (";");
435 end if;
436 end List_Common_Type_Info;
437
438 -------------------
439 -- List_Entities --
440 -------------------
441
442 procedure List_Entities
443 (Ent : Entity_Id;
444 Bytes_Big_Endian : Boolean;
445 In_Subprogram : Boolean := False)
446 is
447 Body_E : Entity_Id;
448 E : Entity_Id;
449
450 function Find_Declaration (E : Entity_Id) return Node_Id;
451 -- Utility to retrieve declaration node for entity in the
452 -- case of package bodies and subprograms.
453
454 ----------------------
455 -- Find_Declaration --
456 ----------------------
457
458 function Find_Declaration (E : Entity_Id) return Node_Id is
459 Decl : Node_Id;
460
461 begin
462 Decl := Parent (E);
463 while Present (Decl)
464 and then Nkind (Decl) /= N_Package_Body
465 and then Nkind (Decl) /= N_Subprogram_Declaration
466 and then Nkind (Decl) /= N_Subprogram_Body
467 loop
468 Decl := Parent (Decl);
469 end loop;
470
471 return Decl;
472 end Find_Declaration;
473
474 -- Start of processing for List_Entities
475
476 begin
477 -- List entity if we have one, and it is not a renaming declaration.
478 -- For renamings, we don't get proper information, and really it makes
479 -- sense to restrict the output to the renamed entity.
480
481 if Present (Ent)
482 and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
483 and then not Is_Ignored_Ghost_Entity (Ent)
484 then
485 -- If entity is a subprogram and we are listing mechanisms,
486 -- then we need to list mechanisms for this entity. We skip this
487 -- if it is a nested subprogram, as the information has already
488 -- been produced when listing the enclosing scope.
489
490 if List_Representation_Info_Mechanisms
491 and then (Is_Subprogram (Ent)
492 or else Ekind (Ent) = E_Entry
493 or else Ekind (Ent) = E_Entry_Family)
494 and then not In_Subprogram
495 then
496 List_Subprogram_Info (Ent);
497 end if;
498
499 E := First_Entity (Ent);
500 while Present (E) loop
501 -- We list entities that come from source (excluding private or
502 -- incomplete types or deferred constants, for which we will list
503 -- the information for the full view). If requested, we also list
504 -- relevant entities that have been generated when processing the
505 -- original entities coming from source. But if debug flag A is
506 -- set, then all entities are listed.
507
508 if ((Comes_From_Source (E)
509 or else (Ekind (E) = E_Block
510 and then
511 Nkind (Parent (E)) = N_Implicit_Label_Declaration
512 and then
513 Comes_From_Source (Label_Construct (Parent (E)))))
514 and then not Is_Incomplete_Or_Private_Type (E)
515 and then not (Ekind (E) = E_Constant
516 and then Present (Full_View (E))))
517 or else (List_Representation_Info = 4
518 and then Relevant_Entities.Get (E))
519 or else Debug_Flag_AA
520 then
521 if Is_Subprogram (E) then
522 if List_Representation_Info_Mechanisms then
523 List_Subprogram_Info (E);
524 end if;
525
526 -- Recurse into entities local to subprogram
527
528 List_Entities (E, Bytes_Big_Endian, True);
529
530 elsif Ekind (E) in E_Entry
531 | E_Entry_Family
532 | E_Subprogram_Type
533 then
534 if List_Representation_Info_Mechanisms then
535 List_Subprogram_Info (E);
536 end if;
537
538 elsif Is_Record_Type (E) then
539 if List_Representation_Info >= 1 then
540 List_Record_Info (E, Bytes_Big_Endian);
541 end if;
542
543 -- Recurse into entities local to a record type
544
545 if List_Representation_Info = 4 then
546 List_Entities (E, Bytes_Big_Endian, False);
547 end if;
548
549 elsif Is_Array_Type (E) then
550 if List_Representation_Info >= 1 then
551 List_Array_Info (E, Bytes_Big_Endian);
552 end if;
553
554 elsif Is_Type (E) then
555 if List_Representation_Info >= 2 then
556 List_Type_Info (E);
557 end if;
558
559 -- Note that formals are not annotated so we skip them here
560
561 elsif Ekind (E) in E_Constant
562 | E_Loop_Parameter
563 | E_Variable
564 then
565 if List_Representation_Info >= 2 then
566 List_Object_Info (E);
567 end if;
568 end if;
569
570 -- Recurse into nested package, but not if they are package
571 -- renamings (in particular renamings of the enclosing package,
572 -- as for some Java bindings and for generic instances).
573
574 if Ekind (E) = E_Package then
575 if No (Renamed_Object (E)) then
576 List_Entities (E, Bytes_Big_Endian);
577 end if;
578
579 -- Recurse into bodies
580
581 elsif Ekind (E) in E_Package_Body
582 | E_Protected_Body
583 | E_Protected_Type
584 | E_Subprogram_Body
585 | E_Task_Body
586 | E_Task_Type
587 then
588 List_Entities (E, Bytes_Big_Endian);
589
590 -- Recurse into blocks
591
592 elsif Ekind (E) = E_Block then
593 List_Entities (E, Bytes_Big_Endian);
594 end if;
595 end if;
596
597 Next_Entity (E);
598 end loop;
599
600 -- For a package body, the entities of the visible subprograms are
601 -- declared in the corresponding spec. Iterate over its entities in
602 -- order to handle properly the subprogram bodies. Skip bodies in
603 -- subunits, which are listed independently.
604
605 if Ekind (Ent) = E_Package_Body
606 and then Present (Corresponding_Spec (Find_Declaration (Ent)))
607 then
608 E := First_Entity (Corresponding_Spec (Find_Declaration (Ent)));
609 while Present (E) loop
610 if Is_Subprogram (E)
611 and then
612 Nkind (Find_Declaration (E)) = N_Subprogram_Declaration
613 then
614 Body_E := Corresponding_Body (Find_Declaration (E));
615
616 if Present (Body_E)
617 and then
618 Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
619 then
620 List_Entities (Body_E, Bytes_Big_Endian);
621 end if;
622 end if;
623
624 Next_Entity (E);
625 end loop;
626 end if;
627 end if;
628 end List_Entities;
629
630 -------------------------
631 -- List_GCC_Expression --
632 -------------------------
633
634 procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
635
636 procedure Print_Expr (Val : Node_Ref_Or_Val);
637 -- Internal recursive procedure to print expression
638
639 ----------------
640 -- Print_Expr --
641 ----------------
642
643 procedure Print_Expr (Val : Node_Ref_Or_Val) is
644 begin
645 if Val >= 0 then
646 UI_Write (Val, Decimal);
647
648 else
649 declare
650 Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
651
652 procedure Unop (S : String);
653 -- Output text for unary operator with S being operator name
654
655 procedure Binop (S : String);
656 -- Output text for binary operator with S being operator name
657
658 ----------
659 -- Unop --
660 ----------
661
662 procedure Unop (S : String) is
663 begin
664 if List_Representation_Info_To_JSON then
665 Write_Str ("{ ""code"": """);
666 if S (S'Last) = ' ' then
667 Write_Str (S (S'First .. S'Last - 1));
668 else
669 Write_Str (S);
670 end if;
671 Write_Str (""", ""operands"": [ ");
672 Print_Expr (Node.Op1);
673 Write_Str (" ] }");
674 else
675 Write_Str (S);
676 Print_Expr (Node.Op1);
677 end if;
678 end Unop;
679
680 -----------
681 -- Binop --
682 -----------
683
684 procedure Binop (S : String) is
685 begin
686 if List_Representation_Info_To_JSON then
687 Write_Str ("{ ""code"": """);
688 Write_Str (S (S'First + 1 .. S'Last - 1));
689 Write_Str (""", ""operands"": [ ");
690 Print_Expr (Node.Op1);
691 Write_Str (", ");
692 Print_Expr (Node.Op2);
693 Write_Str (" ] }");
694 else
695 Write_Char ('(');
696 Print_Expr (Node.Op1);
697 Write_Str (S);
698 Print_Expr (Node.Op2);
699 Write_Char (')');
700 end if;
701 end Binop;
702
703 -- Start of processing for Print_Expr
704
705 begin
706 case Node.Expr is
707 when Cond_Expr =>
708 if List_Representation_Info_To_JSON then
709 Write_Str ("{ ""code"": ""?<>""");
710 Write_Str (", ""operands"": [ ");
711 Print_Expr (Node.Op1);
712 Write_Str (", ");
713 Print_Expr (Node.Op2);
714 Write_Str (", ");
715 Print_Expr (Node.Op3);
716 Write_Str (" ] }");
717 else
718 Write_Str ("(if ");
719 Print_Expr (Node.Op1);
720 Write_Str (" then ");
721 Print_Expr (Node.Op2);
722 Write_Str (" else ");
723 Print_Expr (Node.Op3);
724 Write_Str (" end)");
725 end if;
726
727 when Plus_Expr =>
728 Binop (" + ");
729
730 when Minus_Expr =>
731 Binop (" - ");
732
733 when Mult_Expr =>
734 Binop (" * ");
735
736 when Trunc_Div_Expr =>
737 Binop (" /t ");
738
739 when Ceil_Div_Expr =>
740 Binop (" /c ");
741
742 when Floor_Div_Expr =>
743 Binop (" /f ");
744
745 when Trunc_Mod_Expr =>
746 Binop (" modt ");
747
748 when Ceil_Mod_Expr =>
749 Binop (" modc ");
750
751 when Floor_Mod_Expr =>
752 Binop (" modf ");
753
754 when Exact_Div_Expr =>
755 Binop (" /e ");
756
757 when Negate_Expr =>
758 Unop ("-");
759
760 when Min_Expr =>
761 Binop (" min ");
762
763 when Max_Expr =>
764 Binop (" max ");
765
766 when Abs_Expr =>
767 Unop ("abs ");
768
769 when Truth_And_Expr =>
770 Binop (" and ");
771
772 when Truth_Or_Expr =>
773 Binop (" or ");
774
775 when Truth_Xor_Expr =>
776 Binop (" xor ");
777
778 when Truth_Not_Expr =>
779 Unop ("not ");
780
781 when Lt_Expr =>
782 Binop (" < ");
783
784 when Le_Expr =>
785 Binop (" <= ");
786
787 when Gt_Expr =>
788 Binop (" > ");
789
790 when Ge_Expr =>
791 Binop (" >= ");
792
793 when Eq_Expr =>
794 Binop (" == ");
795
796 when Ne_Expr =>
797 Binop (" != ");
798
799 when Bit_And_Expr =>
800 Binop (" & ");
801
802 when Discrim_Val =>
803 Unop ("#");
804
805 when Dynamic_Val =>
806 Unop ("var");
807 end case;
808 end;
809 end if;
810 end Print_Expr;
811
812 -- Start of processing for List_GCC_Expression
813
814 begin
815 if U = No_Uint then
816 Write_Unknown_Val;
817 else
818 Print_Expr (U);
819 end if;
820 end List_GCC_Expression;
821
822 -------------------------
823 -- List_Linker_Section --
824 -------------------------
825
826 procedure List_Linker_Section (Ent : Entity_Id) is
827 Args : List_Id;
828 Sect : Node_Id;
829
830 begin
831 if Present (Linker_Section_Pragma (Ent)) then
832 Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
833 Sect := Expr_Value_S (Get_Pragma_Arg (Last (Args)));
834
835 if List_Representation_Info_To_JSON then
836 Write_Line (",");
837 Write_Str (" ""Linker_Section"": """);
838 else
839 Write_Str ("pragma Linker_Section (");
840 List_Name (Ent);
841 Write_Str (", """);
842 end if;
843
844 pragma Assert (Nkind (Sect) = N_String_Literal);
845 String_To_Name_Buffer (Strval (Sect));
846 Write_Str (Name_Buffer (1 .. Name_Len));
847 Write_Str ("""");
848 if not List_Representation_Info_To_JSON then
849 Write_Line (");");
850 end if;
851 end if;
852 end List_Linker_Section;
853
854 -------------------
855 -- List_Location --
856 -------------------
857
858 procedure List_Location (Ent : Entity_Id) is
859 begin
860 pragma Assert (List_Representation_Info_To_JSON);
861 Write_Str (" ""location"": """);
862 Write_Location (Sloc (Ent));
863 Write_Line (""",");
864 end List_Location;
865
866 ---------------
867 -- List_Name --
868 ---------------
869
870 procedure List_Name (Ent : Entity_Id) is
871 C : Character;
872
873 begin
874 -- List the qualified name recursively, except
875 -- at compilation unit level in default mode.
876
877 if Is_Compilation_Unit (Ent) then
878 null;
879 elsif not Is_Compilation_Unit (Scope (Ent))
880 or else List_Representation_Info_To_JSON
881 then
882 List_Name (Scope (Ent));
883 Write_Char ('.');
884 end if;
885
886 Get_Unqualified_Decoded_Name_String (Chars (Ent));
887 Set_Casing (Unit_Casing);
888
889 -- The name of operators needs to be properly escaped for JSON
890
891 for J in 1 .. Name_Len loop
892 C := Name_Buffer (J);
893 if C = '"' and then List_Representation_Info_To_JSON then
894 Write_Char ('\');
895 end if;
896 Write_Char (C);
897 end loop;
898 end List_Name;
899
900 ---------------------
901 -- List_Object_Info --
902 ---------------------
903
904 procedure List_Object_Info (Ent : Entity_Id) is
905 begin
906 Write_Separator;
907
908 if List_Representation_Info_To_JSON then
909 Write_Line ("{");
910
911 Write_Str (" ""name"": """);
912 List_Name (Ent);
913 Write_Line (""",");
914 List_Location (Ent);
915
916 Write_Str (" ""Size"": ");
917 Write_Val (Esize (Ent));
918 Write_Line (",");
919
920 Write_Str (" ""Alignment"": ");
921 Write_Val (Alignment (Ent));
922
923 List_Linker_Section (Ent);
924
925 Write_Eol;
926 Write_Line ("}");
927 else
928 Write_Str ("for ");
929 List_Name (Ent);
930 Write_Str ("'Size use ");
931 Write_Val (Esize (Ent));
932 Write_Line (";");
933
934 Write_Str ("for ");
935 List_Name (Ent);
936 Write_Str ("'Alignment use ");
937 Write_Val (Alignment (Ent));
938 Write_Line (";");
939
940 List_Linker_Section (Ent);
941 end if;
942
943 -- The type is relevant for an object
944
945 if List_Representation_Info = 4 and then Is_Itype (Etype (Ent)) then
946 Relevant_Entities.Set (Etype (Ent), True);
947 end if;
948 end List_Object_Info;
949
950 ----------------------
951 -- List_Record_Info --
952 ----------------------
953
954 procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
955 procedure Compute_Max_Length
956 (Ent : Entity_Id;
957 Starting_Position : Uint := Uint_0;
958 Starting_First_Bit : Uint := Uint_0;
959 Prefix_Length : Natural := 0);
960 -- Internal recursive procedure to compute the max length
961
962 procedure List_Component_Layout
963 (Ent : Entity_Id;
964 Starting_Position : Uint := Uint_0;
965 Starting_First_Bit : Uint := Uint_0;
966 Prefix : String := "";
967 Indent : Natural := 0);
968 -- Procedure to display the layout of a single component
969
970 procedure List_Record_Layout
971 (Ent : Entity_Id;
972 Starting_Position : Uint := Uint_0;
973 Starting_First_Bit : Uint := Uint_0;
974 Prefix : String := "");
975 -- Internal recursive procedure to display the layout
976
977 procedure List_Structural_Record_Layout
978 (Ent : Entity_Id;
979 Outer_Ent : Entity_Id;
980 Variant : Node_Id := Empty;
981 Indent : Natural := 0);
982 -- Internal recursive procedure to display the structural layout
983
984 Incomplete_Layout : exception;
985 -- Exception raised if the layout is incomplete in -gnatc mode
986
987 Not_In_Extended_Main : exception;
988 -- Exception raised when an ancestor is not declared in the main unit
989
990 Max_Name_Length : Natural := 0;
991 Max_Spos_Length : Natural := 0;
992
993 ------------------------
994 -- Compute_Max_Length --
995 ------------------------
996
997 procedure Compute_Max_Length
998 (Ent : Entity_Id;
999 Starting_Position : Uint := Uint_0;
1000 Starting_First_Bit : Uint := Uint_0;
1001 Prefix_Length : Natural := 0)
1002 is
1003 Comp : Entity_Id;
1004
1005 begin
1006 Comp := First_Component_Or_Discriminant (Ent);
1007 while Present (Comp) loop
1008
1009 -- Skip a completely hidden discriminant or a discriminant in an
1010 -- unchecked union (since it is not there).
1011
1012 if Ekind (Comp) = E_Discriminant
1013 and then (Is_Completely_Hidden (Comp)
1014 or else Is_Unchecked_Union (Ent))
1015 then
1016 goto Continue;
1017 end if;
1018
1019 -- Skip _Parent component in extension (to avoid overlap)
1020
1021 if Chars (Comp) = Name_uParent then
1022 goto Continue;
1023 end if;
1024
1025 -- All other cases
1026
1027 declare
1028 Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1029 Bofs : constant Uint := Component_Bit_Offset (Comp);
1030 Npos : Uint;
1031 Fbit : Uint;
1032 Spos : Uint;
1033 Sbit : Uint;
1034
1035 Name_Length : Natural;
1036
1037 begin
1038 Get_Decoded_Name_String (Chars (Comp));
1039 Name_Length := Prefix_Length + Name_Len;
1040
1041 if Rep_Not_Constant (Bofs) then
1042
1043 -- If the record is not packed, then we know that all fields
1044 -- whose position is not specified have starting normalized
1045 -- bit position of zero.
1046
1047 if Unknown_Normalized_First_Bit (Comp)
1048 and then not Is_Packed (Ent)
1049 then
1050 Set_Normalized_First_Bit (Comp, Uint_0);
1051 end if;
1052
1053 UI_Image_Length := 2; -- For "??" marker
1054 else
1055 Npos := Bofs / SSU;
1056 Fbit := Bofs mod SSU;
1057
1058 -- Complete annotation in case not done
1059
1060 if Unknown_Normalized_First_Bit (Comp) then
1061 Set_Normalized_Position (Comp, Npos);
1062 Set_Normalized_First_Bit (Comp, Fbit);
1063 end if;
1064
1065 Spos := Starting_Position + Npos;
1066 Sbit := Starting_First_Bit + Fbit;
1067
1068 if Sbit >= SSU then
1069 Spos := Spos + 1;
1070 Sbit := Sbit - SSU;
1071 end if;
1072
1073 -- If extended information is requested, recurse fully into
1074 -- record components, i.e. skip the outer level.
1075
1076 if List_Representation_Info_Extended
1077 and then Is_Record_Type (Ctyp)
1078 then
1079 Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
1080 goto Continue;
1081 end if;
1082
1083 UI_Image (Spos);
1084 end if;
1085
1086 Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
1087 Max_Spos_Length :=
1088 Natural'Max (Max_Spos_Length, UI_Image_Length);
1089 end;
1090
1091 <<Continue>>
1092 Next_Component_Or_Discriminant (Comp);
1093 end loop;
1094 end Compute_Max_Length;
1095
1096 ---------------------------
1097 -- List_Component_Layout --
1098 ---------------------------
1099
1100 procedure List_Component_Layout
1101 (Ent : Entity_Id;
1102 Starting_Position : Uint := Uint_0;
1103 Starting_First_Bit : Uint := Uint_0;
1104 Prefix : String := "";
1105 Indent : Natural := 0)
1106 is
1107 Esiz : constant Uint := Esize (Ent);
1108 Npos : constant Uint := Normalized_Position (Ent);
1109 Fbit : constant Uint := Normalized_First_Bit (Ent);
1110 Spos : Uint;
1111 Sbit : Uint;
1112 Lbit : Uint;
1113
1114 begin
1115 if List_Representation_Info_To_JSON then
1116 Spaces (Indent);
1117 Write_Line (" {");
1118 Spaces (Indent);
1119 Write_Str (" ""name"": """);
1120 Write_Str (Prefix);
1121 Write_Str (Name_Buffer (1 .. Name_Len));
1122 Write_Line (""",");
1123 if Ekind (Ent) = E_Discriminant then
1124 Spaces (Indent);
1125 Write_Str (" ""discriminant"": ");
1126 UI_Write (Discriminant_Number (Ent), Decimal);
1127 Write_Line (",");
1128 end if;
1129 Spaces (Indent);
1130 Write_Str (" ""Position"": ");
1131 else
1132 Write_Str (" ");
1133 Write_Str (Prefix);
1134 Write_Str (Name_Buffer (1 .. Name_Len));
1135 Spaces (Max_Name_Length - Prefix'Length - Name_Len);
1136 Write_Str (" at ");
1137 end if;
1138
1139 if Known_Static_Normalized_Position (Ent) then
1140 Spos := Starting_Position + Npos;
1141 Sbit := Starting_First_Bit + Fbit;
1142
1143 if Sbit >= SSU then
1144 Spos := Spos + 1;
1145 end if;
1146
1147 UI_Image (Spos);
1148 Spaces (Max_Spos_Length - UI_Image_Length);
1149 Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
1150
1151 elsif Known_Normalized_Position (Ent)
1152 and then List_Representation_Info >= 3
1153 then
1154 Spaces (Max_Spos_Length - 2);
1155
1156 if Starting_Position /= Uint_0 then
1157 UI_Write (Starting_Position, Decimal);
1158 Write_Str (" + ");
1159 end if;
1160
1161 Write_Val (Npos);
1162
1163 else
1164 Write_Unknown_Val;
1165 end if;
1166
1167 if List_Representation_Info_To_JSON then
1168 Write_Line (",");
1169 Spaces (Indent);
1170 Write_Str (" ""First_Bit"": ");
1171 else
1172 Write_Str (" range ");
1173 end if;
1174
1175 Sbit := Starting_First_Bit + Fbit;
1176
1177 if Sbit >= SSU then
1178 Sbit := Sbit - SSU;
1179 end if;
1180
1181 UI_Write (Sbit, Decimal);
1182
1183 if List_Representation_Info_To_JSON then
1184 Write_Line (", ");
1185 Spaces (Indent);
1186 Write_Str (" ""Size"": ");
1187 else
1188 Write_Str (" .. ");
1189 end if;
1190
1191 -- Allowing Uint_0 here is an annoying special case. Really this
1192 -- should be a fine Esize value but currently it means unknown,
1193 -- except that we know after gigi has back annotated that a size
1194 -- of zero is real, since otherwise gigi back annotates using
1195 -- No_Uint as the value to indicate unknown.
1196
1197 if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent))
1198 and then Known_Static_Normalized_First_Bit (Ent)
1199 then
1200 Lbit := Sbit + Esiz - 1;
1201
1202 if List_Representation_Info_To_JSON then
1203 UI_Write (Esiz, Decimal);
1204 else
1205 if Lbit >= 0 and then Lbit < 10 then
1206 Write_Char (' ');
1207 end if;
1208
1209 UI_Write (Lbit, Decimal);
1210 end if;
1211
1212 -- The test for Esize (Ent) not Uint_0 here is an annoying special
1213 -- case. Officially a value of zero for Esize means unknown, but
1214 -- here we use the fact that we know that gigi annotates Esize with
1215 -- No_Uint, not Uint_0. Really everyone should use No_Uint???
1216
1217 elsif List_Representation_Info < 3
1218 or else (Esize (Ent) /= Uint_0 and then Unknown_Esize (Ent))
1219 then
1220 Write_Unknown_Val;
1221
1222 -- List_Representation >= 3 and Known_Esize (Ent)
1223
1224 else
1225 Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
1226
1227 -- If in front-end layout mode, then dynamic size is stored in
1228 -- storage units, so renormalize for output.
1229
1230 if not Back_End_Layout then
1231 Write_Str (" * ");
1232 Write_Int (SSU);
1233 end if;
1234
1235 -- Add appropriate first bit offset
1236
1237 if not List_Representation_Info_To_JSON then
1238 if Sbit = 0 then
1239 Write_Str (" - 1");
1240
1241 elsif Sbit = 1 then
1242 null;
1243
1244 else
1245 Write_Str (" + ");
1246 Write_Int (UI_To_Int (Sbit) - 1);
1247 end if;
1248 end if;
1249 end if;
1250
1251 if List_Representation_Info_To_JSON then
1252 Write_Eol;
1253 Spaces (Indent);
1254 Write_Str (" }");
1255 else
1256 Write_Line (";");
1257 end if;
1258
1259 -- The type is relevant for a component
1260
1261 if List_Representation_Info = 4 and then Is_Itype (Etype (Ent)) then
1262 Relevant_Entities.Set (Etype (Ent), True);
1263 end if;
1264 end List_Component_Layout;
1265
1266 ------------------------
1267 -- List_Record_Layout --
1268 ------------------------
1269
1270 procedure List_Record_Layout
1271 (Ent : Entity_Id;
1272 Starting_Position : Uint := Uint_0;
1273 Starting_First_Bit : Uint := Uint_0;
1274 Prefix : String := "")
1275 is
1276 Comp : Entity_Id;
1277 First : Boolean := True;
1278
1279 begin
1280 Comp := First_Component_Or_Discriminant (Ent);
1281 while Present (Comp) loop
1282
1283 -- Skip a completely hidden discriminant or a discriminant in an
1284 -- unchecked union (since it is not there).
1285
1286 if Ekind (Comp) = E_Discriminant
1287 and then (Is_Completely_Hidden (Comp)
1288 or else Is_Unchecked_Union (Ent))
1289 then
1290 goto Continue;
1291 end if;
1292
1293 -- Skip _Parent component in extension (to avoid overlap)
1294
1295 if Chars (Comp) = Name_uParent then
1296 goto Continue;
1297 end if;
1298
1299 -- All other cases
1300
1301 declare
1302 Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1303 Npos : constant Uint := Normalized_Position (Comp);
1304 Fbit : constant Uint := Normalized_First_Bit (Comp);
1305 Spos : Uint;
1306 Sbit : Uint;
1307
1308 begin
1309 Get_Decoded_Name_String (Chars (Comp));
1310 Set_Casing (Unit_Casing);
1311
1312 -- If extended information is requested, recurse fully into
1313 -- record components, i.e. skip the outer level.
1314
1315 if List_Representation_Info_Extended
1316 and then Is_Record_Type (Ctyp)
1317 and then Known_Static_Normalized_Position (Comp)
1318 and then Known_Static_Normalized_First_Bit (Comp)
1319 then
1320 Spos := Starting_Position + Npos;
1321 Sbit := Starting_First_Bit + Fbit;
1322
1323 if Sbit >= SSU then
1324 Spos := Spos + 1;
1325 Sbit := Sbit - SSU;
1326 end if;
1327
1328 List_Record_Layout (Ctyp,
1329 Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
1330
1331 goto Continue;
1332 end if;
1333
1334 if List_Representation_Info_To_JSON then
1335 if First then
1336 Write_Eol;
1337 First := False;
1338 else
1339 Write_Line (",");
1340 end if;
1341 end if;
1342
1343 List_Component_Layout (Comp,
1344 Starting_Position, Starting_First_Bit, Prefix);
1345 end;
1346
1347 <<Continue>>
1348 Next_Component_Or_Discriminant (Comp);
1349 end loop;
1350 end List_Record_Layout;
1351
1352 -----------------------------------
1353 -- List_Structural_Record_Layout --
1354 -----------------------------------
1355
1356 procedure List_Structural_Record_Layout
1357 (Ent : Entity_Id;
1358 Outer_Ent : Entity_Id;
1359 Variant : Node_Id := Empty;
1360 Indent : Natural := 0)
1361 is
1362 function Derived_Discriminant (Disc : Entity_Id) return Entity_Id;
1363 -- This function assumes that Outer_Ent is an extension of Ent.
1364 -- Disc is a discriminant of Ent that does not itself constrain a
1365 -- discriminant of the parent type of Ent. Return the discriminant
1366 -- of Outer_Ent that ultimately constrains Disc, if any.
1367
1368 ----------------------------
1369 -- Derived_Discriminant --
1370 ----------------------------
1371
1372 function Derived_Discriminant (Disc : Entity_Id) return Entity_Id is
1373 Corr_Disc : Entity_Id;
1374 Derived_Disc : Entity_Id;
1375
1376 begin
1377 Derived_Disc := First_Discriminant (Outer_Ent);
1378
1379 -- Loop over the discriminants of the extension
1380
1381 while Present (Derived_Disc) loop
1382
1383 -- Check if this discriminant constrains another discriminant.
1384 -- If so, find the ultimately constrained discriminant and
1385 -- compare with the original components in the base type.
1386
1387 if Present (Corresponding_Discriminant (Derived_Disc)) then
1388 Corr_Disc := Corresponding_Discriminant (Derived_Disc);
1389
1390 while Present (Corresponding_Discriminant (Corr_Disc)) loop
1391 Corr_Disc := Corresponding_Discriminant (Corr_Disc);
1392 end loop;
1393
1394 if Original_Record_Component (Corr_Disc) =
1395 Original_Record_Component (Disc)
1396 then
1397 return Derived_Disc;
1398 end if;
1399 end if;
1400
1401 Next_Discriminant (Derived_Disc);
1402 end loop;
1403
1404 -- Disc is not constrained by a discriminant of Outer_Ent
1405
1406 return Empty;
1407 end Derived_Discriminant;
1408
1409 -- Local declarations
1410
1411 Comp : Node_Id;
1412 Comp_List : Node_Id;
1413 First : Boolean := True;
1414 Var : Node_Id;
1415
1416 -- Start of processing for List_Structural_Record_Layout
1417
1418 begin
1419 -- If we are dealing with a variant, just process the components
1420
1421 if Present (Variant) then
1422 Comp_List := Component_List (Variant);
1423
1424 -- Otherwise, we are dealing with the full record and need to get
1425 -- to its definition in order to retrieve its structural layout.
1426
1427 else
1428 declare
1429 Definition : Node_Id :=
1430 Type_Definition (Declaration_Node (Ent));
1431
1432 Is_Extension : constant Boolean :=
1433 Is_Tagged_Type (Ent)
1434 and then Nkind (Definition) =
1435 N_Derived_Type_Definition;
1436
1437 Disc : Entity_Id;
1438 Listed_Disc : Entity_Id;
1439 Parent_Type : Entity_Id;
1440
1441 begin
1442 -- If this is an extension, first list the layout of the parent
1443 -- and then proceed to the extension part, if any.
1444
1445 if Is_Extension then
1446 Parent_Type := Parent_Subtype (Ent);
1447 if No (Parent_Type) then
1448 raise Incomplete_Layout;
1449 end if;
1450
1451 if Is_Private_Type (Parent_Type) then
1452 Parent_Type := Full_View (Parent_Type);
1453 pragma Assert (Present (Parent_Type));
1454 end if;
1455
1456 Parent_Type := Base_Type (Parent_Type);
1457 if not In_Extended_Main_Source_Unit (Parent_Type) then
1458 raise Not_In_Extended_Main;
1459 end if;
1460
1461 List_Structural_Record_Layout (Parent_Type, Outer_Ent);
1462 First := False;
1463
1464 if Present (Record_Extension_Part (Definition)) then
1465 Definition := Record_Extension_Part (Definition);
1466 end if;
1467 end if;
1468
1469 -- If the record has discriminants and is not an unchecked
1470 -- union, then display them now. Note that, even if this is
1471 -- a structural layout, we list the visible discriminants.
1472
1473 if Has_Discriminants (Ent)
1474 and then not Is_Unchecked_Union (Ent)
1475 then
1476 Disc := First_Discriminant (Ent);
1477 while Present (Disc) loop
1478
1479 -- If this is a record extension and the discriminant is
1480 -- the renaming of another discriminant, skip it.
1481
1482 if Is_Extension
1483 and then Present (Corresponding_Discriminant (Disc))
1484 then
1485 goto Continue_Disc;
1486 end if;
1487
1488 -- If this is the parent type of an extension, retrieve
1489 -- the derived discriminant from the extension, if any.
1490
1491 if Ent /= Outer_Ent then
1492 Listed_Disc := Derived_Discriminant (Disc);
1493
1494 if No (Listed_Disc) then
1495 goto Continue_Disc;
1496 end if;
1497 else
1498 Listed_Disc := Disc;
1499 end if;
1500
1501 Get_Decoded_Name_String (Chars (Listed_Disc));
1502 Set_Casing (Unit_Casing);
1503
1504 if First then
1505 Write_Eol;
1506 First := False;
1507 else
1508 Write_Line (",");
1509 end if;
1510
1511 List_Component_Layout (Listed_Disc, Indent => Indent);
1512
1513 <<Continue_Disc>>
1514 Next_Discriminant (Disc);
1515 end loop;
1516 end if;
1517
1518 Comp_List := Component_List (Definition);
1519 end;
1520 end if;
1521
1522 -- Bail out for the null record
1523
1524 if No (Comp_List) then
1525 return;
1526 end if;
1527
1528 -- Now deal with the regular components, if any
1529
1530 if Present (Component_Items (Comp_List)) then
1531 Comp := First_Non_Pragma (Component_Items (Comp_List));
1532 while Present (Comp) loop
1533
1534 -- Skip _Parent component in extension (to avoid overlap)
1535
1536 if Chars (Defining_Identifier (Comp)) = Name_uParent then
1537 goto Continue_Comp;
1538 end if;
1539
1540 Get_Decoded_Name_String (Chars (Defining_Identifier (Comp)));
1541 Set_Casing (Unit_Casing);
1542
1543 if First then
1544 Write_Eol;
1545 First := False;
1546 else
1547 Write_Line (",");
1548 end if;
1549
1550 List_Component_Layout
1551 (Defining_Identifier (Comp), Indent => Indent);
1552
1553 <<Continue_Comp>>
1554 Next_Non_Pragma (Comp);
1555 end loop;
1556 end if;
1557
1558 -- We are done if there is no variant part
1559
1560 if No (Variant_Part (Comp_List)) then
1561 return;
1562 end if;
1563
1564 Write_Eol;
1565 Spaces (Indent);
1566 Write_Line (" ],");
1567 Spaces (Indent);
1568 Write_Str (" ""variant"" : [");
1569
1570 -- Otherwise we recurse on each variant
1571
1572 Var := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
1573 First := True;
1574 while Present (Var) loop
1575 if First then
1576 Write_Eol;
1577 First := False;
1578 else
1579 Write_Line (",");
1580 end if;
1581
1582 Spaces (Indent);
1583 Write_Line (" {");
1584 Spaces (Indent);
1585 Write_Str (" ""present"": ");
1586 Write_Val (Present_Expr (Var));
1587 Write_Line (",");
1588 Spaces (Indent);
1589 Write_Str (" ""record"": [");
1590
1591 List_Structural_Record_Layout (Ent, Outer_Ent, Var, Indent + 4);
1592
1593 Write_Eol;
1594 Spaces (Indent);
1595 Write_Line (" ]");
1596 Spaces (Indent);
1597 Write_Str (" }");
1598 Next_Non_Pragma (Var);
1599 end loop;
1600 end List_Structural_Record_Layout;
1601
1602 -- Start of processing for List_Record_Info
1603
1604 begin
1605 Write_Separator;
1606
1607 if List_Representation_Info_To_JSON then
1608 Write_Line ("{");
1609 end if;
1610
1611 List_Common_Type_Info (Ent);
1612
1613 -- First find out max line length and max starting position
1614 -- length, for the purpose of lining things up nicely.
1615
1616 Compute_Max_Length (Ent);
1617
1618 -- Then do actual output based on those values
1619
1620 if List_Representation_Info_To_JSON then
1621 Write_Line (",");
1622 Write_Str (" ""record"": [");
1623
1624 -- ??? We can output structural layout only for base types fully
1625 -- declared in the extended main source unit for the time being,
1626 -- because otherwise declarations might not be processed at all.
1627
1628 if Is_Base_Type (Ent) then
1629 begin
1630 List_Structural_Record_Layout (Ent, Ent);
1631
1632 exception
1633 when Incomplete_Layout
1634 | Not_In_Extended_Main
1635 =>
1636 List_Record_Layout (Ent);
1637
1638 when others =>
1639 raise Program_Error;
1640 end;
1641 else
1642 List_Record_Layout (Ent);
1643 end if;
1644
1645 Write_Eol;
1646 Write_Str (" ]");
1647 else
1648 Write_Str ("for ");
1649 List_Name (Ent);
1650 Write_Line (" use record");
1651
1652 List_Record_Layout (Ent);
1653
1654 Write_Line ("end record;");
1655 end if;
1656
1657 List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1658
1659 List_Linker_Section (Ent);
1660
1661 if List_Representation_Info_To_JSON then
1662 Write_Eol;
1663 Write_Line ("}");
1664 end if;
1665
1666 -- The type is relevant for a record subtype
1667
1668 if List_Representation_Info = 4
1669 and then not Is_Base_Type (Ent)
1670 and then Is_Itype (Etype (Ent))
1671 then
1672 Relevant_Entities.Set (Etype (Ent), True);
1673 end if;
1674 end List_Record_Info;
1675
1676 -------------------
1677 -- List_Rep_Info --
1678 -------------------
1679
1680 procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1681 Col : Nat;
1682
1683 begin
1684 if List_Representation_Info /= 0
1685 or else List_Representation_Info_Mechanisms
1686 then
1687 -- For the normal case, we output a single JSON stream
1688
1689 if not List_Representation_Info_To_File
1690 and then List_Representation_Info_To_JSON
1691 then
1692 Write_Line ("[");
1693 Need_Separator := False;
1694 end if;
1695
1696 for U in Main_Unit .. Last_Unit loop
1697 if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1698 Unit_Casing := Identifier_Casing (Source_Index (U));
1699
1700 if List_Representation_Info = 4 then
1701 Relevant_Entities.Reset;
1702 end if;
1703
1704 -- Normal case, list to standard output
1705
1706 if not List_Representation_Info_To_File then
1707 if not List_Representation_Info_To_JSON then
1708 Write_Eol;
1709 Write_Str ("Representation information for unit ");
1710 Write_Unit_Name (Unit_Name (U));
1711 Col := Column;
1712 Write_Eol;
1713
1714 for J in 1 .. Col - 1 loop
1715 Write_Char ('-');
1716 end loop;
1717
1718 Write_Eol;
1719 Need_Separator := True;
1720 end if;
1721
1722 List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1723
1724 -- List representation information to file
1725
1726 else
1727 Create_Repinfo_File_Access.all
1728 (Get_Name_String (File_Name (Source_Index (U))));
1729 Set_Special_Output (Write_Info_Line'Access);
1730 if List_Representation_Info_To_JSON then
1731 Write_Line ("[");
1732 end if;
1733 Need_Separator := False;
1734 List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1735 if List_Representation_Info_To_JSON then
1736 Write_Line ("]");
1737 end if;
1738 Cancel_Special_Output;
1739 Close_Repinfo_File_Access.all;
1740 end if;
1741 end if;
1742 end loop;
1743
1744 if not List_Representation_Info_To_File
1745 and then List_Representation_Info_To_JSON
1746 then
1747 Write_Line ("]");
1748 end if;
1749 end if;
1750 end List_Rep_Info;
1751
1752 -------------------------------
1753 -- List_Scalar_Storage_Order --
1754 -------------------------------
1755
1756 procedure List_Scalar_Storage_Order
1757 (Ent : Entity_Id;
1758 Bytes_Big_Endian : Boolean)
1759 is
1760 procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1761 -- Show attribute definition clause for Attr_Name (an endianness
1762 -- attribute), depending on whether or not the endianness is reversed
1763 -- compared to native endianness.
1764
1765 ---------------
1766 -- List_Attr --
1767 ---------------
1768
1769 procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1770 begin
1771 if List_Representation_Info_To_JSON then
1772 Write_Line (",");
1773 Write_Str (" """);
1774 Write_Str (Attr_Name);
1775 Write_Str (""": ""System.");
1776 else
1777 Write_Str ("for ");
1778 List_Name (Ent);
1779 Write_Char (''');
1780 Write_Str (Attr_Name);
1781 Write_Str (" use System.");
1782 end if;
1783
1784 if Bytes_Big_Endian xor Is_Reversed then
1785 Write_Str ("High");
1786 else
1787 Write_Str ("Low");
1788 end if;
1789
1790 Write_Str ("_Order_First");
1791 if List_Representation_Info_To_JSON then
1792 Write_Str ("""");
1793 else
1794 Write_Line (";");
1795 end if;
1796 end List_Attr;
1797
1798 List_SSO : constant Boolean :=
1799 Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1800 or else SSO_Set_Low_By_Default (Ent)
1801 or else SSO_Set_High_By_Default (Ent);
1802 -- Scalar_Storage_Order is displayed if specified explicitly or set by
1803 -- Default_Scalar_Storage_Order.
1804
1805 -- Start of processing for List_Scalar_Storage_Order
1806
1807 begin
1808 -- For record types, list Bit_Order if not default, or if SSO is shown
1809
1810 -- Also, when -gnatR4 is in effect always list bit order and scalar
1811 -- storage order explicitly, so that you don't need to know the native
1812 -- endianness of the target for which the output was produced in order
1813 -- to interpret it.
1814
1815 if Is_Record_Type (Ent)
1816 and then (List_SSO
1817 or else Reverse_Bit_Order (Ent)
1818 or else List_Representation_Info = 4)
1819 then
1820 List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1821 end if;
1822
1823 -- List SSO if required. If not, then storage is supposed to be in
1824 -- native order.
1825
1826 if List_SSO or else List_Representation_Info = 4 then
1827 List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1828 else
1829 pragma Assert (not Reverse_Storage_Order (Ent));
1830 null;
1831 end if;
1832 end List_Scalar_Storage_Order;
1833
1834 --------------------------
1835 -- List_Subprogram_Info --
1836 --------------------------
1837
1838 procedure List_Subprogram_Info (Ent : Entity_Id) is
1839 First : Boolean := True;
1840 Plen : Natural;
1841 Form : Entity_Id;
1842
1843 begin
1844 Write_Separator;
1845
1846 if List_Representation_Info_To_JSON then
1847 Write_Line ("{");
1848 Write_Str (" ""name"": """);
1849 List_Name (Ent);
1850 Write_Line (""",");
1851 List_Location (Ent);
1852
1853 Write_Str (" ""Convention"": """);
1854 else
1855 case Ekind (Ent) is
1856 when E_Function =>
1857 Write_Str ("function ");
1858
1859 when E_Operator =>
1860 Write_Str ("operator ");
1861
1862 when E_Procedure =>
1863 Write_Str ("procedure ");
1864
1865 when E_Subprogram_Type =>
1866 Write_Str ("type ");
1867
1868 when E_Entry
1869 | E_Entry_Family
1870 =>
1871 Write_Str ("entry ");
1872
1873 when others =>
1874 raise Program_Error;
1875 end case;
1876
1877 List_Name (Ent);
1878 Write_Str (" declared at ");
1879 Write_Location (Sloc (Ent));
1880 Write_Eol;
1881
1882 Write_Str ("convention : ");
1883 end if;
1884
1885 case Convention (Ent) is
1886 when Convention_Ada =>
1887 Write_Str ("Ada");
1888
1889 when Convention_Ada_Pass_By_Copy =>
1890 Write_Str ("Ada_Pass_By_Copy");
1891
1892 when Convention_Ada_Pass_By_Reference =>
1893 Write_Str ("Ada_Pass_By_Reference");
1894
1895 when Convention_Intrinsic =>
1896 Write_Str ("Intrinsic");
1897
1898 when Convention_Entry =>
1899 Write_Str ("Entry");
1900
1901 when Convention_Protected =>
1902 Write_Str ("Protected");
1903
1904 when Convention_Assembler =>
1905 Write_Str ("Assembler");
1906
1907 when Convention_C =>
1908 Write_Str ("C");
1909
1910 when Convention_C_Variadic =>
1911 declare
1912 N : Nat :=
1913 Convention_Id'Pos (Convention (Ent)) -
1914 Convention_Id'Pos (Convention_C_Variadic_0);
1915 begin
1916 Write_Str ("C_Variadic_");
1917 if N >= 10 then
1918 Write_Char ('1');
1919 N := N - 10;
1920 end if;
1921 pragma Assert (N < 10);
1922 Write_Char (Character'Val (Character'Pos ('0') + N));
1923 end;
1924
1925 when Convention_COBOL =>
1926 Write_Str ("COBOL");
1927
1928 when Convention_CPP =>
1929 Write_Str ("C++");
1930
1931 when Convention_Fortran =>
1932 Write_Str ("Fortran");
1933
1934 when Convention_Stdcall =>
1935 Write_Str ("Stdcall");
1936
1937 when Convention_Stubbed =>
1938 Write_Str ("Stubbed");
1939 end case;
1940
1941 if List_Representation_Info_To_JSON then
1942 Write_Line (""",");
1943 Write_Str (" ""formal"": [");
1944 else
1945 Write_Eol;
1946 end if;
1947
1948 -- Find max length of formal name
1949
1950 Plen := 0;
1951 Form := First_Formal (Ent);
1952 while Present (Form) loop
1953 Get_Unqualified_Decoded_Name_String (Chars (Form));
1954
1955 if Name_Len > Plen then
1956 Plen := Name_Len;
1957 end if;
1958
1959 Next_Formal (Form);
1960 end loop;
1961
1962 -- Output formals and mechanisms
1963
1964 Form := First_Formal (Ent);
1965 while Present (Form) loop
1966 Get_Unqualified_Decoded_Name_String (Chars (Form));
1967 Set_Casing (Unit_Casing);
1968
1969 if List_Representation_Info_To_JSON then
1970 if First then
1971 Write_Eol;
1972 First := False;
1973 else
1974 Write_Line (",");
1975 end if;
1976
1977 Write_Line (" {");
1978 Write_Str (" ""name"": """);
1979 Write_Str (Name_Buffer (1 .. Name_Len));
1980 Write_Line (""",");
1981
1982 Write_Str (" ""mechanism"": """);
1983 Write_Mechanism (Mechanism (Form));
1984 Write_Line ("""");
1985 Write_Str (" }");
1986 else
1987 while Name_Len <= Plen loop
1988 Name_Len := Name_Len + 1;
1989 Name_Buffer (Name_Len) := ' ';
1990 end loop;
1991
1992 Write_Str (" ");
1993 Write_Str (Name_Buffer (1 .. Plen + 1));
1994 Write_Str (": passed by ");
1995
1996 Write_Mechanism (Mechanism (Form));
1997 Write_Eol;
1998 end if;
1999
2000 Next_Formal (Form);
2001 end loop;
2002
2003 if List_Representation_Info_To_JSON then
2004 Write_Eol;
2005 Write_Str (" ]");
2006 end if;
2007
2008 if Ekind (Ent) = E_Function then
2009 if List_Representation_Info_To_JSON then
2010 Write_Line (",");
2011 Write_Str (" ""mechanism"": """);
2012 Write_Mechanism (Mechanism (Ent));
2013 Write_Str ("""");
2014 else
2015 Write_Str ("returns by ");
2016 Write_Mechanism (Mechanism (Ent));
2017 Write_Eol;
2018 end if;
2019 end if;
2020
2021 if not Is_Entry (Ent) then
2022 List_Linker_Section (Ent);
2023 end if;
2024
2025 if List_Representation_Info_To_JSON then
2026 Write_Eol;
2027 Write_Line ("}");
2028 end if;
2029 end List_Subprogram_Info;
2030
2031 --------------------
2032 -- List_Type_Info --
2033 --------------------
2034
2035 procedure List_Type_Info (Ent : Entity_Id) is
2036 begin
2037 Write_Separator;
2038
2039 if List_Representation_Info_To_JSON then
2040 Write_Line ("{");
2041 end if;
2042
2043 List_Common_Type_Info (Ent);
2044
2045 -- Special stuff for fixed-point
2046
2047 if Is_Fixed_Point_Type (Ent) then
2048
2049 -- Write small (always a static constant)
2050
2051 if List_Representation_Info_To_JSON then
2052 Write_Line (",");
2053 Write_Str (" ""Small"": ");
2054 UR_Write (Small_Value (Ent));
2055 else
2056 Write_Str ("for ");
2057 List_Name (Ent);
2058 Write_Str ("'Small use ");
2059 UR_Write (Small_Value (Ent));
2060 Write_Line (";");
2061 end if;
2062
2063 -- Write range if static
2064
2065 declare
2066 R : constant Node_Id := Scalar_Range (Ent);
2067
2068 begin
2069 if Nkind (Low_Bound (R)) = N_Real_Literal
2070 and then
2071 Nkind (High_Bound (R)) = N_Real_Literal
2072 then
2073 if List_Representation_Info_To_JSON then
2074 Write_Line (",");
2075 Write_Str (" ""Range"": [ ");
2076 UR_Write (Realval (Low_Bound (R)));
2077 Write_Str (", ");
2078 UR_Write (Realval (High_Bound (R)));
2079 Write_Str (" ]");
2080 else
2081 Write_Str ("for ");
2082 List_Name (Ent);
2083 Write_Str ("'Range use ");
2084 UR_Write (Realval (Low_Bound (R)));
2085 Write_Str (" .. ");
2086 UR_Write (Realval (High_Bound (R)));
2087 Write_Line (";");
2088 end if;
2089 end if;
2090 end;
2091 end if;
2092
2093 List_Linker_Section (Ent);
2094
2095 if List_Representation_Info_To_JSON then
2096 Write_Eol;
2097 Write_Line ("}");
2098 end if;
2099 end List_Type_Info;
2100
2101 ----------------------
2102 -- Rep_Not_Constant --
2103 ----------------------
2104
2105 function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
2106 begin
2107 if Val = No_Uint or else Val < 0 then
2108 return True;
2109 else
2110 return False;
2111 end if;
2112 end Rep_Not_Constant;
2113
2114 ---------------
2115 -- Rep_Value --
2116 ---------------
2117
2118 function Rep_Value (Val : Node_Ref_Or_Val; D : Discrim_List) return Uint is
2119
2120 function B (Val : Boolean) return Uint;
2121 -- Returns Uint_0 for False, Uint_1 for True
2122
2123 function T (Val : Node_Ref_Or_Val) return Boolean;
2124 -- Returns True for 0, False for any non-zero (i.e. True)
2125
2126 function V (Val : Node_Ref_Or_Val) return Uint;
2127 -- Internal recursive routine to evaluate tree
2128
2129 function W (Val : Uint) return Word;
2130 -- Convert Val to Word, assuming Val is always in the Int range. This
2131 -- is a helper function for the evaluation of bitwise expressions like
2132 -- Bit_And_Expr, for which there is no direct support in uintp. Uint
2133 -- values out of the Int range are expected to be seen in such
2134 -- expressions only with overflowing byte sizes around, introducing
2135 -- inherent unreliabilities in computations anyway.
2136
2137 -------
2138 -- B --
2139 -------
2140
2141 function B (Val : Boolean) return Uint is
2142 begin
2143 if Val then
2144 return Uint_1;
2145 else
2146 return Uint_0;
2147 end if;
2148 end B;
2149
2150 -------
2151 -- T --
2152 -------
2153
2154 function T (Val : Node_Ref_Or_Val) return Boolean is
2155 begin
2156 if V (Val) = 0 then
2157 return False;
2158 else
2159 return True;
2160 end if;
2161 end T;
2162
2163 -------
2164 -- V --
2165 -------
2166
2167 function V (Val : Node_Ref_Or_Val) return Uint is
2168 L, R, Q : Uint;
2169
2170 begin
2171 if Val >= 0 then
2172 return Val;
2173
2174 else
2175 declare
2176 Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
2177
2178 begin
2179 case Node.Expr is
2180 when Cond_Expr =>
2181 if T (Node.Op1) then
2182 return V (Node.Op2);
2183 else
2184 return V (Node.Op3);
2185 end if;
2186
2187 when Plus_Expr =>
2188 return V (Node.Op1) + V (Node.Op2);
2189
2190 when Minus_Expr =>
2191 return V (Node.Op1) - V (Node.Op2);
2192
2193 when Mult_Expr =>
2194 return V (Node.Op1) * V (Node.Op2);
2195
2196 when Trunc_Div_Expr =>
2197 return V (Node.Op1) / V (Node.Op2);
2198
2199 when Ceil_Div_Expr =>
2200 return
2201 UR_Ceiling
2202 (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
2203
2204 when Floor_Div_Expr =>
2205 return
2206 UR_Floor
2207 (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
2208
2209 when Trunc_Mod_Expr =>
2210 return V (Node.Op1) rem V (Node.Op2);
2211
2212 when Floor_Mod_Expr =>
2213 return V (Node.Op1) mod V (Node.Op2);
2214
2215 when Ceil_Mod_Expr =>
2216 L := V (Node.Op1);
2217 R := V (Node.Op2);
2218 Q := UR_Ceiling (L / UR_From_Uint (R));
2219 return L - R * Q;
2220
2221 when Exact_Div_Expr =>
2222 return V (Node.Op1) / V (Node.Op2);
2223
2224 when Negate_Expr =>
2225 return -V (Node.Op1);
2226
2227 when Min_Expr =>
2228 return UI_Min (V (Node.Op1), V (Node.Op2));
2229
2230 when Max_Expr =>
2231 return UI_Max (V (Node.Op1), V (Node.Op2));
2232
2233 when Abs_Expr =>
2234 return UI_Abs (V (Node.Op1));
2235
2236 when Truth_And_Expr =>
2237 return B (T (Node.Op1) and then T (Node.Op2));
2238
2239 when Truth_Or_Expr =>
2240 return B (T (Node.Op1) or else T (Node.Op2));
2241
2242 when Truth_Xor_Expr =>
2243 return B (T (Node.Op1) xor T (Node.Op2));
2244
2245 when Truth_Not_Expr =>
2246 return B (not T (Node.Op1));
2247
2248 when Bit_And_Expr =>
2249 L := V (Node.Op1);
2250 R := V (Node.Op2);
2251 return UI_From_Int (Int (W (L) and W (R)));
2252
2253 when Lt_Expr =>
2254 return B (V (Node.Op1) < V (Node.Op2));
2255
2256 when Le_Expr =>
2257 return B (V (Node.Op1) <= V (Node.Op2));
2258
2259 when Gt_Expr =>
2260 return B (V (Node.Op1) > V (Node.Op2));
2261
2262 when Ge_Expr =>
2263 return B (V (Node.Op1) >= V (Node.Op2));
2264
2265 when Eq_Expr =>
2266 return B (V (Node.Op1) = V (Node.Op2));
2267
2268 when Ne_Expr =>
2269 return B (V (Node.Op1) /= V (Node.Op2));
2270
2271 when Discrim_Val =>
2272 declare
2273 Sub : constant Int := UI_To_Int (Node.Op1);
2274 begin
2275 pragma Assert (Sub in D'Range);
2276 return D (Sub);
2277 end;
2278
2279 when Dynamic_Val =>
2280 return No_Uint;
2281 end case;
2282 end;
2283 end if;
2284 end V;
2285
2286 -------
2287 -- W --
2288 -------
2289
2290 -- We use an unchecked conversion to map Int values to their Word
2291 -- bitwise equivalent, which we could not achieve with a normal type
2292 -- conversion for negative Ints. We want bitwise equivalents because W
2293 -- is used as a helper for bit operators like Bit_And_Expr, and can be
2294 -- called for negative Ints in the context of aligning expressions like
2295 -- X+Align & -Align.
2296
2297 function W (Val : Uint) return Word is
2298 function To_Word is new Ada.Unchecked_Conversion (Int, Word);
2299 begin
2300 return To_Word (UI_To_Int (Val));
2301 end W;
2302
2303 -- Start of processing for Rep_Value
2304
2305 begin
2306 if Val = No_Uint then
2307 return No_Uint;
2308
2309 else
2310 return V (Val);
2311 end if;
2312 end Rep_Value;
2313
2314 ------------
2315 -- Spaces --
2316 ------------
2317
2318 procedure Spaces (N : Natural) is
2319 begin
2320 for J in 1 .. N loop
2321 Write_Char (' ');
2322 end loop;
2323 end Spaces;
2324
2325 ---------------------
2326 -- Write_Info_Line --
2327 ---------------------
2328
2329 procedure Write_Info_Line (S : String) is
2330 begin
2331 Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
2332 end Write_Info_Line;
2333
2334 ---------------------
2335 -- Write_Mechanism --
2336 ---------------------
2337
2338 procedure Write_Mechanism (M : Mechanism_Type) is
2339 begin
2340 case M is
2341 when 0 =>
2342 Write_Str ("default");
2343
2344 when -1 =>
2345 Write_Str ("copy");
2346
2347 when -2 =>
2348 Write_Str ("reference");
2349
2350 when others =>
2351 raise Program_Error;
2352 end case;
2353 end Write_Mechanism;
2354
2355 ---------------------
2356 -- Write_Separator --
2357 ---------------------
2358
2359 procedure Write_Separator is
2360 begin
2361 if Need_Separator then
2362 if List_Representation_Info_To_JSON then
2363 Write_Line (",");
2364 else
2365 Write_Eol;
2366 end if;
2367 else
2368 Need_Separator := True;
2369 end if;
2370 end Write_Separator;
2371
2372 -----------------------
2373 -- Write_Unknown_Val --
2374 -----------------------
2375
2376 procedure Write_Unknown_Val is
2377 begin
2378 if List_Representation_Info_To_JSON then
2379 Write_Str ("""??""");
2380 else
2381 Write_Str ("??");
2382 end if;
2383 end Write_Unknown_Val;
2384
2385 ---------------
2386 -- Write_Val --
2387 ---------------
2388
2389 procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
2390 begin
2391 if Rep_Not_Constant (Val) then
2392 if List_Representation_Info < 3 or else Val = No_Uint then
2393 Write_Unknown_Val;
2394
2395 else
2396 if Paren then
2397 Write_Char ('(');
2398 end if;
2399
2400 if Back_End_Layout then
2401 List_GCC_Expression (Val);
2402 else
2403 Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
2404 end if;
2405
2406 if Paren then
2407 Write_Char (')');
2408 end if;
2409 end if;
2410
2411 else
2412 UI_Write (Val, Decimal);
2413 end if;
2414 end Write_Val;
2415
2416 end Repinfo;
Mirror of the offical gcc git repository hosted at gcc.gnu.org