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