gcc/ada/sprint.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               S P R I N T                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Aspects;  use Aspects;
  27 with Atree;    use Atree;
  28 with Casing;   use Casing;
  29 with Csets;    use Csets;
  30 with Debug;    use Debug;
  31 with Einfo;    use Einfo;
  32 with Lib;      use Lib;
  33 with Namet;    use Namet;
  34 with Nlists;   use Nlists;
  35 with Opt;      use Opt;
  36 with Output;   use Output;
  37 with Rtsfind;  use Rtsfind;
  38 with Sem_Eval; use Sem_Eval;
  39 with Sem_Util; use Sem_Util;
  40 with Sinfo;    use Sinfo;
  41 with Sinput;   use Sinput;
  42 with Sinput.D; use Sinput.D;
  43 with Snames;   use Snames;
  44 with Stand;    use Stand;
  45 with Stringt;  use Stringt;
  46 with Uintp;    use Uintp;
  47 with Uname;    use Uname;
  48 with Urealp;   use Urealp;
  49
  50 package body Sprint is
  51    Current_Source_File : Source_File_Index;
  52    --  Index of source file whose generated code is being dumped
  53
  54    Dump_Node : Node_Id := Empty;
  55    --  This is set to the current node, used for printing line numbers. In
  56    --  Debug_Generated_Code mode, Dump_Node is set to the current node
  57    --  requiring Sloc fixup, until Set_Debug_Sloc is called to set the proper
  58    --  value. The call clears it back to Empty.
  59
  60    First_Debug_Sloc : Source_Ptr;
  61    --  Sloc of first byte of the current output file if we are generating a
  62    --  source debug file.
  63
  64    Debug_Sloc : Source_Ptr;
  65    --  Sloc of first byte of line currently being written if we are
  66    --  generating a source debug file.
  67
  68    Dump_Original_Only : Boolean;
  69    --  Set True if the -gnatdo (dump original tree) flag is set
  70
  71    Dump_Generated_Only : Boolean;
  72    --  Set True if the -gnatdG (dump generated tree) debug flag is set
  73    --  or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
  74
  75    Dump_Freeze_Null : Boolean;
  76    --  Set True if empty freeze nodes and non-source null statements output.
  77    --  Note that freeze nodes containing freeze actions are always output,
  78    --  as are freeze nodes for itypes, which in general have the effect of
  79    --  causing elaboration of the itype.
  80
  81    Freeze_Indent : Int := 0;
  82    --  Keep track of freeze indent level (controls output of blank lines before
  83    --  procedures within expression freeze actions). Relevant only if we are
  84    --  not in Dump_Source_Text mode, since in Dump_Source_Text mode we don't
  85    --  output these blank lines in any case.
  86
  87    Indent : Int := 0;
  88    --  Number of columns for current line output indentation
  89
  90    Indent_Annull_Flag : Boolean := False;
  91    --  Set True if subsequent Write_Indent call to be ignored, gets reset
  92    --  by this call, so it is only active to suppress a single indent call.
  93
  94    Last_Line_Printed : Physical_Line_Number;
  95    --  This keeps track of the physical line number of the last source line
  96    --  that has been output. The value is only valid in Dump_Source_Text mode.
  97
  98    -------------------------------
  99    -- Operator Precedence Table --
 100    -------------------------------
 101
 102    --  This table is used to decide whether a subexpression needs to be
 103    --  parenthesized. The rule is that if an operand of an operator (which
 104    --  for this purpose includes AND THEN and OR ELSE) is itself an operator
 105    --  with a lower precedence than the operator (or equal precedence if
 106    --  appearing as the right operand), then parentheses are required.
 107
 108    Op_Prec : constant array (N_Subexpr) of Short_Short_Integer :=
 109                (N_Op_And          => 1,
 110                 N_Op_Or           => 1,
 111                 N_Op_Xor          => 1,
 112                 N_And_Then        => 1,
 113                 N_Or_Else         => 1,
 114
 115                 N_In              => 2,
 116                 N_Not_In          => 2,
 117                 N_Op_Eq           => 2,
 118                 N_Op_Ge           => 2,
 119                 N_Op_Gt           => 2,
 120                 N_Op_Le           => 2,
 121                 N_Op_Lt           => 2,
 122                 N_Op_Ne           => 2,
 123
 124                 N_Op_Add          => 3,
 125                 N_Op_Concat       => 3,
 126                 N_Op_Subtract     => 3,
 127                 N_Op_Plus         => 3,
 128                 N_Op_Minus        => 3,
 129
 130                 N_Op_Divide       => 4,
 131                 N_Op_Mod          => 4,
 132                 N_Op_Rem          => 4,
 133                 N_Op_Multiply     => 4,
 134
 135                 N_Op_Expon        => 5,
 136                 N_Op_Abs          => 5,
 137                 N_Op_Not          => 5,
 138
 139                 others            => 6);
 140
 141    procedure Sprint_Left_Opnd (N : Node_Id);
 142    --  Print left operand of operator, parenthesizing if necessary
 143
 144    procedure Sprint_Right_Opnd (N : Node_Id);
 145    --  Print right operand of operator, parenthesizing if necessary
 146
 147    -----------------------
 148    -- Local Subprograms --
 149    -----------------------
 150
 151    procedure Col_Check (N : Nat);
 152    --  Check that at least N characters remain on current line, and if not,
 153    --  then start an extra line with two characters extra indentation for
 154    --  continuing text on the next line.
 155
 156    procedure Extra_Blank_Line;
 157    --  In some situations we write extra blank lines to separate the generated
 158    --  code to make it more readable. However, these extra blank lines are not
 159    --  generated in Dump_Source_Text mode, since there the source text lines
 160    --  output with preceding blank lines are quite sufficient as separators.
 161    --  This procedure writes a blank line if Dump_Source_Text is False.
 162
 163    procedure Indent_Annull;
 164    --  Causes following call to Write_Indent to be ignored. This is used when
 165    --  a higher level node wants to stop a lower level node from starting a
 166    --  new line, when it would otherwise be inclined to do so (e.g. the case
 167    --  of an accept statement called from an accept alternative with a guard)
 168
 169    procedure Indent_Begin;
 170    --  Increase indentation level
 171
 172    procedure Indent_End;
 173    --  Decrease indentation level
 174
 175    procedure Print_Debug_Line (S : String);
 176    --  Used to print output lines in Debug_Generated_Code mode (this is used
 177    --  as the argument for a call to Set_Special_Output in package Output).
 178
 179    procedure Process_TFAI_RR_Flags (Nod : Node_Id);
 180    --  Given a divide, multiplication or division node, check the flags
 181    --  Treat_Fixed_As_Integer and Rounded_Flags, and if set, output the
 182    --  appropriate special syntax characters (# and @).
 183
 184    procedure Set_Debug_Sloc;
 185    --  If Dump_Node is non-empty, this routine sets the appropriate value
 186    --  in its Sloc field, from the current location in the debug source file
 187    --  that is currently being written.
 188
 189    procedure Sprint_And_List (List : List_Id);
 190    --  Print the given list with items separated by vertical "and"
 191
 192    procedure Sprint_Aspect_Specifications
 193      (Node      : Node_Id;
 194       Semicolon : Boolean);
 195    --  Node is a declaration node that has aspect specifications (Has_Aspects
 196    --  flag set True). It outputs the aspect specifications. For the case
 197    --  of Semicolon = True, it is called after outputting the terminating
 198    --  semicolon for the related node. The effect is to remove the semicolon
 199    --  and print the aspect specifications followed by a terminating semicolon.
 200    --  For the case of Semicolon False, no semicolon is removed or output, and
 201    --  all the aspects are printed on a single line.
 202
 203    procedure Sprint_Bar_List (List : List_Id);
 204    --  Print the given list with items separated by vertical bars
 205
 206    procedure Sprint_End_Label
 207      (Node    : Node_Id;
 208       Default : Node_Id);
 209    --  Print the end label for a Handled_Sequence_Of_Statements in a body.
 210    --  If there is no end label, use the defining identifier of the enclosing
 211    --  construct. If the end label is present, treat it as a reference to the
 212    --  defining entity of the construct: this guarantees that it carries the
 213    --  proper sloc information for debugging purposes.
 214
 215    procedure Sprint_Node_Actual (Node : Node_Id);
 216    --  This routine prints its node argument. It is a lower level routine than
 217    --  Sprint_Node, in that it does not bother about rewritten trees.
 218
 219    procedure Sprint_Node_Sloc (Node : Node_Id);
 220    --  Like Sprint_Node, but in addition, in Debug_Generated_Code mode,
 221    --  sets the Sloc of the current debug node to be a copy of the Sloc
 222    --  of the sprinted node Node. Note that this is done after printing
 223    --  Node, so that the Sloc is the proper updated value for the debug file.
 224
 225    procedure Update_Itype (Node : Node_Id);
 226    --  Update the Sloc of an itype that is not attached to the tree, when
 227    --  debugging expanded code. This routine is called from nodes whose
 228    --  type can be an Itype, such as defining_identifiers that may be of
 229    --  an anonymous access type, or ranges in slices.
 230
 231    procedure Write_Char_Sloc (C : Character);
 232    --  Like Write_Char, except that if C is non-blank, Set_Debug_Sloc is
 233    --  called to ensure that the current node has a proper Sloc set.
 234
 235    procedure Write_Condition_And_Reason (Node : Node_Id);
 236    --  Write Condition and Reason codes of Raise_xxx_Error node
 237
 238    procedure Write_Corresponding_Source (S : String);
 239    --  If S is a string with a single keyword (possibly followed by a space),
 240    --  and if the next non-comment non-blank source line matches this keyword,
 241    --  then output all source lines up to this matching line.
 242
 243    procedure Write_Discr_Specs (N : Node_Id);
 244    --  Output discriminant specification for node, which is any of the type
 245    --  declarations that can have discriminants.
 246
 247    procedure Write_Ekind (E : Entity_Id);
 248    --  Write the String corresponding to the Ekind without "E_"
 249
 250    procedure Write_Id (N : Node_Id);
 251    --  N is a node with a Chars field. This procedure writes the name that
 252    --  will be used in the generated code associated with the name. For a
 253    --  node with no associated entity, this is simply the Chars field. For
 254    --  the case where there is an entity associated with the node, we print
 255    --  the name associated with the entity (since it may have been encoded).
 256    --  One other special case is that an entity has an active external name
 257    --  (i.e. an external name present with no address clause), then this
 258    --  external name is output. This procedure also deals with outputting
 259    --  declarations of referenced itypes, if not output earlier.
 260
 261    function Write_Identifiers (Node : Node_Id) return Boolean;
 262    --  Handle node where the grammar has a list of defining identifiers, but
 263    --  the tree has a separate declaration for each identifier. Handles the
 264    --  printing of the defining identifier, and returns True if the type and
 265    --  initialization information is to be printed, False if it is to be
 266    --  skipped (the latter case happens when printing defining identifiers
 267    --  other than the first in the original tree output case).
 268
 269    procedure Write_Implicit_Def (E : Entity_Id);
 270    pragma Warnings (Off, Write_Implicit_Def);
 271    --  Write the definition of the implicit type E according to its Ekind
 272    --  For now a debugging procedure, but might be used in the future.
 273
 274    procedure Write_Indent;
 275    --  Start a new line and write indentation spacing
 276
 277    function Write_Indent_Identifiers (Node : Node_Id) return Boolean;
 278    --  Like Write_Identifiers except that each new printed declaration
 279    --  is at the start of a new line.
 280
 281    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean;
 282    --  Like Write_Indent_Identifiers except that in Debug_Generated_Code
 283    --  mode, the Sloc of the current debug node is set to point to the
 284    --  first output identifier.
 285
 286    procedure Write_Indent_Str (S : String);
 287    --  Start a new line and write indent spacing followed by given string
 288
 289    procedure Write_Indent_Str_Sloc (S : String);
 290    --  Like Write_Indent_Str, but in addition, in Debug_Generated_Code mode,
 291    --  the Sloc of the current node is set to the first non-blank character
 292    --  in the string S.
 293
 294    procedure Write_Itype (Typ : Entity_Id);
 295    --  If Typ is an Itype that has not been written yet, write it. If Typ is
 296    --  any other kind of entity or tree node, the call is ignored.
 297
 298    procedure Write_Name_With_Col_Check (N : Name_Id);
 299    --  Write name (using Write_Name) with initial column check, and possible
 300    --  initial Write_Indent (to get new line) if current line is too full.
 301
 302    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id);
 303    --  Like Write_Name_With_Col_Check but in addition, in Debug_Generated_Code
 304    --  mode, sets Sloc of current debug node to first character of name.
 305
 306    procedure Write_Operator (N : Node_Id; S : String);
 307    --  Like Write_Str_Sloc, used for operators, encloses the string in
 308    --  characters {} if the Do_Overflow flag is set on the node N.
 309
 310    procedure Write_Param_Specs (N : Node_Id);
 311    --  Output parameter specifications for node N (which is a subprogram, or
 312    --  entry or entry family or access-subprogram-definition, all of which
 313    --  have a Parameter_Specificatioons field).
 314
 315    procedure Write_Rewrite_Str (S : String);
 316    --  Writes out a string (typically containing <<< or >>>}) for a node
 317    --  created by rewriting the tree. Suppressed if we are outputting the
 318    --  generated code only, since in this case we don't specially mark nodes
 319    --  created by rewriting).
 320
 321    procedure Write_Source_Line (L : Physical_Line_Number);
 322    --  If writing of interspersed source lines is enabled, then write the given
 323    --  line from the source file, preceded by Eol, then an extra blank line if
 324    --  the line has at least one blank, is not a comment and is not line one,
 325    --  then "--" and the line number followed by period followed by text of the
 326    --  source line (without terminating Eol). If interspersed source line
 327    --  output not enabled, then the call has no effect.
 328
 329    procedure Write_Source_Lines (L : Physical_Line_Number);
 330    --  If writing of interspersed source lines is enabled, then writes source
 331    --  lines Last_Line_Printed + 1 .. L, and updates Last_Line_Printed. If
 332    --  interspersed source line output not enabled, then call has no effect.
 333
 334    procedure Write_Str_Sloc (S : String);
 335    --  Like Write_Str, but sets debug Sloc of current debug node to first
 336    --  non-blank character if a current debug node is active.
 337
 338    procedure Write_Str_With_Col_Check (S : String);
 339    --  Write string (using Write_Str) with initial column check, and possible
 340    --  initial Write_Indent (to get new line) if current line is too full.
 341
 342    procedure Write_Str_With_Col_Check_Sloc (S : String);
 343    --  Like Write_Str_With_Col_Check, but sets debug Sloc of current debug
 344    --  node to first non-blank character if a current debug node is active.
 345
 346    procedure Write_Subprogram_Name (N : Node_Id);
 347    --  N is the Name field of a function call or procedure statement call.
 348    --  The effect of the call is to output the name, preceded by a $ if the
 349    --  call is identified as an implicit call to a run time routine.
 350
 351    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format);
 352    --  Write Uint (using UI_Write) with initial column check, and possible
 353    --  initial Write_Indent (to get new line) if current line is too full.
 354    --  The format parameter determines the output format (see UI_Write).
 355
 356    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format);
 357    --  Write Uint (using UI_Write) with initial column check, and possible
 358    --  initial Write_Indent (to get new line) if current line is too full.
 359    --  The format parameter determines the output format (see UI_Write).
 360    --  In addition, in Debug_Generated_Code mode, sets the current node
 361    --  Sloc to the first character of the output value.
 362
 363    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal);
 364    --  Write Ureal (using same output format as UR_Write) with column checks
 365    --  and a possible initial Write_Indent (to get new line) if current line
 366    --  is too full. In addition, in Debug_Generated_Code mode, sets the
 367    --  current node Sloc to the first character of the output value.
 368
 369    ---------------
 370    -- Col_Check --
 371    ---------------
 372
 373    procedure Col_Check (N : Nat) is
 374    begin
 375       if N + Column > Sprint_Line_Limit then
 376          Write_Indent_Str ("  ");
 377       end if;
 378    end Col_Check;
 379
 380    ----------------------
 381    -- Extra_Blank_Line --
 382    ----------------------
 383
 384    procedure Extra_Blank_Line is
 385    begin
 386       if not Dump_Source_Text then
 387          Write_Indent;
 388       end if;
 389    end Extra_Blank_Line;
 390
 391    -------------------
 392    -- Indent_Annull --
 393    -------------------
 394
 395    procedure Indent_Annull is
 396    begin
 397       Indent_Annull_Flag := True;
 398    end Indent_Annull;
 399
 400    ------------------
 401    -- Indent_Begin --
 402    ------------------
 403
 404    procedure Indent_Begin is
 405    begin
 406       Indent := Indent + 3;
 407    end Indent_Begin;
 408
 409    ----------------
 410    -- Indent_End --
 411    ----------------
 412
 413    procedure Indent_End is
 414    begin
 415       Indent := Indent - 3;
 416    end Indent_End;
 417
 418    --------
 419    -- pg --
 420    --------
 421
 422    procedure pg (Arg : Union_Id) is
 423    begin
 424       Dump_Generated_Only := True;
 425       Dump_Original_Only  := False;
 426       Dump_Freeze_Null    := True;
 427       Current_Source_File := No_Source_File;
 428
 429       if Arg in List_Range then
 430          Sprint_Node_List (List_Id (Arg), New_Lines => True);
 431
 432       elsif Arg in Node_Range then
 433          Sprint_Node (Node_Id (Arg));
 434
 435       else
 436          null;
 437       end if;
 438
 439       Write_Eol;
 440    end pg;
 441
 442    --------
 443    -- po --
 444    --------
 445
 446    procedure po (Arg : Union_Id) is
 447    begin
 448       Dump_Generated_Only := False;
 449       Dump_Original_Only := True;
 450       Current_Source_File := No_Source_File;
 451
 452       if Arg in List_Range then
 453          Sprint_Node_List (List_Id (Arg), New_Lines => True);
 454
 455       elsif Arg in Node_Range then
 456          Sprint_Node (Node_Id (Arg));
 457
 458       else
 459          null;
 460       end if;
 461
 462       Write_Eol;
 463    end po;
 464
 465    ----------------------
 466    -- Print_Debug_Line --
 467    ----------------------
 468
 469    procedure Print_Debug_Line (S : String) is
 470    begin
 471       Write_Debug_Line (S, Debug_Sloc);
 472    end Print_Debug_Line;
 473
 474    ---------------------------
 475    -- Process_TFAI_RR_Flags --
 476    ---------------------------
 477
 478    procedure Process_TFAI_RR_Flags (Nod : Node_Id) is
 479    begin
 480       if Treat_Fixed_As_Integer (Nod) then
 481          Write_Char ('#');
 482       end if;
 483
 484       if Rounded_Result (Nod) then
 485          Write_Char ('@');
 486       end if;
 487    end Process_TFAI_RR_Flags;
 488
 489    --------
 490    -- ps --
 491    --------
 492
 493    procedure ps (Arg : Union_Id) is
 494    begin
 495       Dump_Generated_Only := False;
 496       Dump_Original_Only := False;
 497       Current_Source_File := No_Source_File;
 498
 499       if Arg in List_Range then
 500          Sprint_Node_List (List_Id (Arg), New_Lines => True);
 501
 502       elsif Arg in Node_Range then
 503          Sprint_Node (Node_Id (Arg));
 504
 505       else
 506          null;
 507       end if;
 508
 509       Write_Eol;
 510    end ps;
 511
 512    --------------------
 513    -- Set_Debug_Sloc --
 514    --------------------
 515
 516    procedure Set_Debug_Sloc is
 517    begin
 518       if Debug_Generated_Code and then Present (Dump_Node) then
 519          declare
 520             Loc : constant Source_Ptr := Sloc (Dump_Node);
 521
 522          begin
 523             --  Do not change the location of nodes defined in package Standard
 524             --  and nodes of pragmas scanned by Targparm.
 525
 526             if Loc <= Standard_Location then
 527                null;
 528
 529             --  Update the location of a node which is part of the current .dg
 530             --  output. This situation occurs in comma separated parameter
 531             --  declarations since each parameter references the same parameter
 532             --  type node (ie. obj1, obj2 : <param-type>).
 533
 534             --  Note: This case is needed here since we cannot use the routine
 535             --  In_Extended_Main_Code_Unit with nodes whose location is a .dg
 536             --  file.
 537
 538             elsif Loc >= First_Debug_Sloc then
 539                Set_Sloc (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
 540
 541             --  Do not change the location of nodes which are not part of the
 542             --  generated code
 543
 544             elsif not In_Extended_Main_Code_Unit (Loc) then
 545                null;
 546
 547             else
 548                Set_Sloc (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
 549             end if;
 550          end;
 551
 552          --  We do not know the actual end location in the generated code and
 553          --  it could be much closer than in the source code, so play safe.
 554
 555          if Nkind_In (Dump_Node, N_Case_Statement, N_If_Statement) then
 556             Set_End_Location (Dump_Node, Debug_Sloc + Source_Ptr (Column - 1));
 557          end if;
 558
 559          Dump_Node := Empty;
 560       end if;
 561    end Set_Debug_Sloc;
 562
 563    -----------------
 564    -- Source_Dump --
 565    -----------------
 566
 567    procedure Source_Dump is
 568
 569       procedure Underline;
 570       --  Put underline under string we just printed
 571
 572       ---------------
 573       -- Underline --
 574       ---------------
 575
 576       procedure Underline is
 577          Col : constant Int := Column;
 578
 579       begin
 580          Write_Eol;
 581
 582          while Col > Column loop
 583             Write_Char ('-');
 584          end loop;
 585
 586          Write_Eol;
 587       end Underline;
 588
 589    --  Start of processing for Source_Dump
 590
 591    begin
 592       Dump_Generated_Only := Debug_Flag_G or
 593                              Print_Generated_Code or
 594                              Debug_Generated_Code;
 595       Dump_Original_Only  := Debug_Flag_O;
 596       Dump_Freeze_Null    := Debug_Flag_S or Debug_Flag_G;
 597
 598       --  Note that we turn off the tree dump flags immediately, before
 599       --  starting the dump. This avoids generating two copies of the dump
 600       --  if an abort occurs after printing the dump, and more importantly,
 601       --  avoids an infinite loop if an abort occurs during the dump.
 602
 603       if Debug_Flag_Z then
 604          Current_Source_File := No_Source_File;
 605          Debug_Flag_Z := False;
 606          Write_Eol;
 607          Write_Eol;
 608          Write_Str ("Source recreated from tree of Standard (spec)");
 609          Underline;
 610          Sprint_Node (Standard_Package_Node);
 611          Write_Eol;
 612          Write_Eol;
 613       end if;
 614
 615       if Debug_Flag_S or Dump_Generated_Only or Dump_Original_Only then
 616          Debug_Flag_G := False;
 617          Debug_Flag_O := False;
 618          Debug_Flag_S := False;
 619          First_Debug_Sloc := No_Location;
 620
 621          --  Dump requested units
 622
 623          for U in Main_Unit .. Last_Unit loop
 624             Current_Source_File := Source_Index (U);
 625
 626             --  Dump all units if -gnatdf set, otherwise dump only the source
 627             --  files that are in the extended main source. Note that, if we
 628             --  are generating debug files, generating that of the main unit
 629             --  has an effect on the outcome of In_Extended_Main_Source_Unit
 630             --  because slocs are rewritten, so we also test for equality of
 631             --  Cunit_Entity to work around this effect.
 632
 633             if Debug_Flag_F
 634               or else In_Extended_Main_Source_Unit (Cunit_Entity (U))
 635               or else Cunit_Entity (U) = Cunit_Entity (Main_Unit)
 636             then
 637                --  If we are generating debug files, setup to write them
 638
 639                if Debug_Generated_Code then
 640                   Set_Special_Output (Print_Debug_Line'Access);
 641                   Create_Debug_Source (Source_Index (U), Debug_Sloc);
 642                   First_Debug_Sloc := Debug_Sloc;
 643                   Write_Source_Line (1);
 644                   Last_Line_Printed := 1;
 645
 646                   --  If this unit has the same entity as the main unit, for
 647                   --  example is the spec of a stand-alone instantiation of
 648                   --  a package and the main unit is the body, its debug file
 649                   --  will also be the same. Therefore, we need to print again
 650                   --  the main unit to have both units in the debug file.
 651
 652                   if U /= Main_Unit
 653                     and then Cunit_Entity (U) = Cunit_Entity (Main_Unit)
 654                   then
 655                      Sprint_Node (Cunit (Main_Unit));
 656                      Write_Eol;
 657                   end if;
 658
 659                   Sprint_Node (Cunit (U));
 660                   Write_Source_Lines (Last_Source_Line (Current_Source_File));
 661                   Write_Eol;
 662                   Close_Debug_Source;
 663                   Set_Special_Output (null);
 664
 665                --  Normal output to standard output file
 666
 667                else
 668                   Write_Str ("Source recreated from tree for ");
 669                   Write_Unit_Name (Unit_Name (U));
 670                   Underline;
 671                   Write_Source_Line (1);
 672                   Last_Line_Printed := 1;
 673                   Sprint_Node (Cunit (U));
 674                   Write_Source_Lines (Last_Source_Line (Current_Source_File));
 675                   Write_Eol;
 676                   Write_Eol;
 677                end if;
 678             end if;
 679          end loop;
 680       end if;
 681    end Source_Dump;
 682
 683    ---------------------
 684    -- Sprint_And_List --
 685    ---------------------
 686
 687    procedure Sprint_And_List (List : List_Id) is
 688       Node : Node_Id;
 689    begin
 690       if Is_Non_Empty_List (List) then
 691          Node := First (List);
 692          loop
 693             Sprint_Node (Node);
 694             Next (Node);
 695             exit when Node = Empty;
 696             Write_Str (" and ");
 697          end loop;
 698       end if;
 699    end Sprint_And_List;
 700
 701    ----------------------------------
 702    -- Sprint_Aspect_Specifications --
 703    ----------------------------------
 704
 705    procedure Sprint_Aspect_Specifications
 706      (Node      : Node_Id;
 707       Semicolon : Boolean)
 708    is
 709       AS : constant List_Id := Aspect_Specifications (Node);
 710       A  : Node_Id;
 711
 712    begin
 713       if Semicolon then
 714          Write_Erase_Char (';');
 715          Indent := Indent + 2;
 716          Write_Indent;
 717          Write_Str ("with ");
 718          Indent := Indent + 5;
 719
 720       else
 721          Write_Str (" with ");
 722       end if;
 723
 724       A := First (AS);
 725       loop
 726          Sprint_Node (Identifier (A));
 727
 728          if Class_Present (A) then
 729             Write_Str ("'Class");
 730          end if;
 731
 732          if Present (Expression (A)) then
 733             Write_Str (" => ");
 734             Sprint_Node (Expression (A));
 735          end if;
 736
 737          Next (A);
 738
 739          exit when No (A);
 740          Write_Char (',');
 741
 742          if Semicolon then
 743             Write_Indent;
 744          end if;
 745       end loop;
 746
 747       if Semicolon then
 748          Indent := Indent - 7;
 749          Write_Char (';');
 750       end if;
 751    end Sprint_Aspect_Specifications;
 752
 753    ---------------------
 754    -- Sprint_Bar_List --
 755    ---------------------
 756
 757    procedure Sprint_Bar_List (List : List_Id) is
 758       Node : Node_Id;
 759    begin
 760       if Is_Non_Empty_List (List) then
 761          Node := First (List);
 762          loop
 763             Sprint_Node (Node);
 764             Next (Node);
 765             exit when Node = Empty;
 766             Write_Str (" | ");
 767          end loop;
 768       end if;
 769    end Sprint_Bar_List;
 770
 771    ----------------------
 772    -- Sprint_End_Label --
 773    ----------------------
 774
 775    procedure Sprint_End_Label
 776      (Node    : Node_Id;
 777       Default : Node_Id)
 778    is
 779    begin
 780       if Present (Node)
 781         and then Present (End_Label (Node))
 782         and then Is_Entity_Name (End_Label (Node))
 783       then
 784          Set_Entity (End_Label (Node), Default);
 785
 786          --  For a function whose name is an operator, use the qualified name
 787          --  created for the defining entity.
 788
 789          if Nkind (End_Label (Node)) = N_Operator_Symbol then
 790             Set_Chars (End_Label (Node), Chars (Default));
 791          end if;
 792
 793          Sprint_Node (End_Label (Node));
 794       else
 795          Sprint_Node (Default);
 796       end if;
 797    end Sprint_End_Label;
 798
 799    -----------------------
 800    -- Sprint_Comma_List --
 801    -----------------------
 802
 803    procedure Sprint_Comma_List (List : List_Id) is
 804       Node : Node_Id;
 805
 806    begin
 807       if Is_Non_Empty_List (List) then
 808          Node := First (List);
 809          loop
 810             Sprint_Node (Node);
 811             Next (Node);
 812             exit when Node = Empty;
 813
 814             if not Is_Rewrite_Insertion (Node)
 815               or else not Dump_Original_Only
 816             then
 817                Write_Str (", ");
 818             end if;
 819          end loop;
 820       end if;
 821    end Sprint_Comma_List;
 822
 823    --------------------------
 824    -- Sprint_Indented_List --
 825    --------------------------
 826
 827    procedure Sprint_Indented_List (List : List_Id) is
 828    begin
 829       Indent_Begin;
 830       Sprint_Node_List (List);
 831       Indent_End;
 832    end Sprint_Indented_List;
 833
 834    ---------------------
 835    -- Sprint_Left_Opnd --
 836    ---------------------
 837
 838    procedure Sprint_Left_Opnd (N : Node_Id) is
 839       Opnd : constant Node_Id := Left_Opnd (N);
 840
 841    begin
 842       if Paren_Count (Opnd) /= 0
 843         or else Op_Prec (Nkind (Opnd)) >= Op_Prec (Nkind (N))
 844       then
 845          Sprint_Node (Opnd);
 846
 847       else
 848          Write_Char ('(');
 849          Sprint_Node (Opnd);
 850          Write_Char (')');
 851       end if;
 852    end Sprint_Left_Opnd;
 853
 854    -----------------
 855    -- Sprint_Node --
 856    -----------------
 857
 858    procedure Sprint_Node (Node : Node_Id) is
 859    begin
 860       if Is_Rewrite_Insertion (Node) then
 861          if not Dump_Original_Only then
 862
 863             --  For special cases of nodes that always output <<< >>>
 864             --  do not duplicate the output at this point.
 865
 866             if Nkind (Node) = N_Freeze_Entity
 867               or else Nkind (Node) = N_Freeze_Generic_Entity
 868               or else Nkind (Node) = N_Implicit_Label_Declaration
 869             then
 870                Sprint_Node_Actual (Node);
 871
 872             --  Normal case where <<< >>> may be required
 873
 874             else
 875                Write_Rewrite_Str ("<<<");
 876                Sprint_Node_Actual (Node);
 877                Write_Rewrite_Str (">>>");
 878             end if;
 879          end if;
 880
 881       elsif Is_Rewrite_Substitution (Node) then
 882
 883          --  Case of dump generated only
 884
 885          if Dump_Generated_Only then
 886             Sprint_Node_Actual (Node);
 887
 888          --  Case of dump original only
 889
 890          elsif Dump_Original_Only then
 891             Sprint_Node_Actual (Original_Node (Node));
 892
 893          --  Case of both being dumped
 894
 895          else
 896             Sprint_Node_Actual (Original_Node (Node));
 897             Write_Rewrite_Str ("<<<");
 898             Sprint_Node_Actual (Node);
 899             Write_Rewrite_Str (">>>");
 900          end if;
 901
 902       else
 903          Sprint_Node_Actual (Node);
 904       end if;
 905    end Sprint_Node;
 906
 907    ------------------------
 908    -- Sprint_Node_Actual --
 909    ------------------------
 910
 911    procedure Sprint_Node_Actual (Node : Node_Id) is
 912       Save_Dump_Node : constant Node_Id := Dump_Node;
 913
 914    begin
 915       if Node = Empty then
 916          return;
 917       end if;
 918
 919       for J in 1 .. Paren_Count (Node) loop
 920          Write_Str_With_Col_Check ("(");
 921       end loop;
 922
 923       --  Setup current dump node
 924
 925       Dump_Node := Node;
 926
 927       if Nkind (Node) in N_Subexpr
 928         and then Do_Range_Check (Node)
 929       then
 930          Write_Str_With_Col_Check ("{");
 931       end if;
 932
 933       --  Select print circuit based on node kind
 934
 935       case Nkind (Node) is
 936          when N_Abort_Statement =>
 937             Write_Indent_Str_Sloc ("abort ");
 938             Sprint_Comma_List (Names (Node));
 939             Write_Char (';');
 940
 941          when N_Abortable_Part =>
 942             Set_Debug_Sloc;
 943             Write_Str_Sloc ("abort ");
 944             Sprint_Indented_List (Statements (Node));
 945
 946          when N_Abstract_Subprogram_Declaration =>
 947             Write_Indent;
 948             Sprint_Node (Specification (Node));
 949             Write_Str_With_Col_Check (" is ");
 950             Write_Str_Sloc ("abstract;");
 951
 952          when N_Accept_Alternative =>
 953             Sprint_Node_List (Pragmas_Before (Node));
 954
 955             if Present (Condition (Node)) then
 956                Write_Indent_Str ("when ");
 957                Sprint_Node (Condition (Node));
 958                Write_Str (" => ");
 959                Indent_Annull;
 960             end if;
 961
 962             Sprint_Node_Sloc (Accept_Statement (Node));
 963             Sprint_Node_List (Statements (Node));
 964
 965          when N_Accept_Statement =>
 966             Write_Indent_Str_Sloc ("accept ");
 967             Write_Id (Entry_Direct_Name (Node));
 968
 969             if Present (Entry_Index (Node)) then
 970                Write_Str_With_Col_Check (" (");
 971                Sprint_Node (Entry_Index (Node));
 972                Write_Char (')');
 973             end if;
 974
 975             Write_Param_Specs (Node);
 976
 977             if Present (Handled_Statement_Sequence (Node)) then
 978                Write_Str_With_Col_Check (" do");
 979                Sprint_Node (Handled_Statement_Sequence (Node));
 980                Write_Indent_Str ("end ");
 981                Write_Id (Entry_Direct_Name (Node));
 982             end if;
 983
 984             Write_Char (';');
 985
 986          when N_Access_Definition =>
 987
 988             --  Ada 2005 (AI-254)
 989
 990             if Present (Access_To_Subprogram_Definition (Node)) then
 991                Sprint_Node (Access_To_Subprogram_Definition (Node));
 992             else
 993                --  Ada 2005 (AI-231)
 994
 995                if Null_Exclusion_Present (Node) then
 996                   Write_Str ("not null ");
 997                end if;
 998
 999                Write_Str_With_Col_Check_Sloc ("access ");
1000
1001                if All_Present (Node) then
1002                   Write_Str ("all ");
1003                elsif Constant_Present (Node) then
1004                   Write_Str ("constant ");
1005                end if;
1006
1007                Sprint_Node (Subtype_Mark (Node));
1008             end if;
1009
1010          when N_Access_Function_Definition =>
1011
1012             --  Ada 2005 (AI-231)
1013
1014             if Null_Exclusion_Present (Node) then
1015                Write_Str ("not null ");
1016             end if;
1017
1018             Write_Str_With_Col_Check_Sloc ("access ");
1019
1020             if Protected_Present (Node) then
1021                Write_Str_With_Col_Check ("protected ");
1022             end if;
1023
1024             Write_Str_With_Col_Check ("function");
1025             Write_Param_Specs (Node);
1026             Write_Str_With_Col_Check (" return ");
1027             Sprint_Node (Result_Definition (Node));
1028
1029          when N_Access_Procedure_Definition =>
1030
1031             --  Ada 2005 (AI-231)
1032
1033             if Null_Exclusion_Present (Node) then
1034                Write_Str ("not null ");
1035             end if;
1036
1037             Write_Str_With_Col_Check_Sloc ("access ");
1038
1039             if Protected_Present (Node) then
1040                Write_Str_With_Col_Check ("protected ");
1041             end if;
1042
1043             Write_Str_With_Col_Check ("procedure");
1044             Write_Param_Specs (Node);
1045
1046          when N_Access_To_Object_Definition =>
1047             Write_Str_With_Col_Check_Sloc ("access ");
1048
1049             if All_Present (Node) then
1050                Write_Str_With_Col_Check ("all ");
1051             elsif Constant_Present (Node) then
1052                Write_Str_With_Col_Check ("constant ");
1053             end if;
1054
1055             --  Ada 2005 (AI-231)
1056
1057             if Null_Exclusion_Present (Node) then
1058                Write_Str ("not null ");
1059             end if;
1060
1061             Sprint_Node (Subtype_Indication (Node));
1062
1063          when N_Aggregate =>
1064             if Null_Record_Present (Node) then
1065                Write_Str_With_Col_Check_Sloc ("(null record)");
1066
1067             else
1068                Write_Str_With_Col_Check_Sloc ("(");
1069
1070                if Present (Expressions (Node)) then
1071                   Sprint_Comma_List (Expressions (Node));
1072
1073                   if Present (Component_Associations (Node))
1074                     and then not Is_Empty_List (Component_Associations (Node))
1075                   then
1076                      Write_Str (", ");
1077                   end if;
1078                end if;
1079
1080                if Present (Component_Associations (Node))
1081                  and then not Is_Empty_List (Component_Associations (Node))
1082                then
1083                   Indent_Begin;
1084
1085                   declare
1086                      Nd : Node_Id;
1087
1088                   begin
1089                      Nd := First (Component_Associations (Node));
1090
1091                      loop
1092                         Write_Indent;
1093                         Sprint_Node (Nd);
1094                         Next (Nd);
1095                         exit when No (Nd);
1096
1097                         if not Is_Rewrite_Insertion (Nd)
1098                           or else not Dump_Original_Only
1099                         then
1100                            Write_Str (", ");
1101                         end if;
1102                      end loop;
1103                   end;
1104
1105                   Indent_End;
1106                end if;
1107
1108                Write_Char (')');
1109             end if;
1110
1111          when N_Allocator =>
1112             Write_Str_With_Col_Check_Sloc ("new ");
1113
1114             --  Ada 2005 (AI-231)
1115
1116             if Null_Exclusion_Present (Node) then
1117                Write_Str ("not null ");
1118             end if;
1119
1120             Sprint_Node (Expression (Node));
1121
1122             if Present (Storage_Pool (Node)) then
1123                Write_Str_With_Col_Check ("[storage_pool = ");
1124                Sprint_Node (Storage_Pool (Node));
1125                Write_Char (']');
1126             end if;
1127
1128          when N_And_Then =>
1129             Sprint_Left_Opnd (Node);
1130             Write_Str_Sloc (" and then ");
1131             Sprint_Right_Opnd (Node);
1132
1133          --  Note: the following code for N_Aspect_Specification is not
1134          --  normally used, since we deal with aspects as part of a
1135          --  declaration, but it is here in case we deliberately try
1136          --  to print an N_Aspect_Speficiation node (e.g. from GDB).
1137
1138          when N_Aspect_Specification =>
1139             Sprint_Node (Identifier (Node));
1140             Write_Str (" => ");
1141             Sprint_Node (Expression (Node));
1142
1143          when N_Assignment_Statement =>
1144             Write_Indent;
1145             Sprint_Node (Name (Node));
1146             Write_Str_Sloc (" := ");
1147             Sprint_Node (Expression (Node));
1148             Write_Char (';');
1149
1150          when N_Asynchronous_Select =>
1151             Write_Indent_Str_Sloc ("select");
1152             Indent_Begin;
1153             Sprint_Node (Triggering_Alternative (Node));
1154             Indent_End;
1155
1156             --  Note: let the printing of Abortable_Part handle outputting
1157             --  the ABORT keyword, so that the Sloc can be set correctly.
1158
1159             Write_Indent_Str ("then ");
1160             Sprint_Node (Abortable_Part (Node));
1161             Write_Indent_Str ("end select;");
1162
1163          when N_At_Clause =>
1164             Write_Indent_Str_Sloc ("for ");
1165             Write_Id (Identifier (Node));
1166             Write_Str_With_Col_Check (" use at ");
1167             Sprint_Node (Expression (Node));
1168             Write_Char (';');
1169
1170          when N_Attribute_Definition_Clause =>
1171             Write_Indent_Str_Sloc ("for ");
1172             Sprint_Node (Name (Node));
1173             Write_Char (''');
1174             Write_Name_With_Col_Check (Chars (Node));
1175             Write_Str_With_Col_Check (" use ");
1176             Sprint_Node (Expression (Node));
1177             Write_Char (';');
1178
1179          when N_Attribute_Reference =>
1180             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
1181                Write_Indent;
1182             end if;
1183
1184             Sprint_Node (Prefix (Node));
1185             Write_Char_Sloc (''');
1186             Write_Name_With_Col_Check (Attribute_Name (Node));
1187             Sprint_Paren_Comma_List (Expressions (Node));
1188
1189             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
1190                Write_Char (';');
1191             end if;
1192
1193          when N_Block_Statement =>
1194             Write_Indent;
1195
1196             if Present (Identifier (Node))
1197               and then (not Has_Created_Identifier (Node)
1198                          or else not Dump_Original_Only)
1199             then
1200                Write_Rewrite_Str ("<<<");
1201                Write_Id (Identifier (Node));
1202                Write_Str (" : ");
1203                Write_Rewrite_Str (">>>");
1204             end if;
1205
1206             if Present (Declarations (Node)) then
1207                Write_Str_With_Col_Check_Sloc ("declare");
1208                Sprint_Indented_List (Declarations (Node));
1209                Write_Indent;
1210             end if;
1211
1212             Write_Str_With_Col_Check_Sloc ("begin");
1213             Sprint_Node (Handled_Statement_Sequence (Node));
1214             Write_Indent_Str ("end");
1215
1216             if Present (Identifier (Node))
1217               and then (not Has_Created_Identifier (Node)
1218                           or else not Dump_Original_Only)
1219             then
1220                Write_Rewrite_Str ("<<<");
1221                Write_Char (' ');
1222                Write_Id (Identifier (Node));
1223                Write_Rewrite_Str (">>>");
1224             end if;
1225
1226             Write_Char (';');
1227
1228          when N_Case_Expression =>
1229             declare
1230                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
1231                Alt        : Node_Id;
1232
1233             begin
1234                --  The syntax for case_expression does not include parentheses,
1235                --  but sometimes parentheses are required, so unconditionally
1236                --  generate them here unless already present.
1237
1238                if not Has_Parens then
1239                   Write_Char ('(');
1240                end if;
1241
1242                Write_Str_With_Col_Check_Sloc ("case ");
1243                Sprint_Node (Expression (Node));
1244                Write_Str_With_Col_Check (" is");
1245
1246                Alt := First (Alternatives (Node));
1247                loop
1248                   Sprint_Node (Alt);
1249                   Next (Alt);
1250                   exit when No (Alt);
1251                   Write_Char (',');
1252                end loop;
1253
1254                if not Has_Parens then
1255                   Write_Char (')');
1256                end if;
1257             end;
1258
1259          when N_Case_Expression_Alternative =>
1260             Write_Str_With_Col_Check (" when ");
1261             Sprint_Bar_List (Discrete_Choices (Node));
1262             Write_Str (" => ");
1263             Sprint_Node (Expression (Node));
1264
1265          when N_Case_Statement =>
1266             Write_Indent_Str_Sloc ("case ");
1267             Sprint_Node (Expression (Node));
1268             Write_Str (" is");
1269             Sprint_Indented_List (Alternatives (Node));
1270             Write_Indent_Str ("end case;");
1271
1272          when N_Case_Statement_Alternative =>
1273             Write_Indent_Str_Sloc ("when ");
1274             Sprint_Bar_List (Discrete_Choices (Node));
1275             Write_Str (" => ");
1276             Sprint_Indented_List (Statements (Node));
1277
1278          when N_Character_Literal =>
1279             if Column > Sprint_Line_Limit - 2 then
1280                Write_Indent_Str ("  ");
1281             end if;
1282
1283             Write_Char_Sloc (''');
1284             Write_Char_Code (UI_To_CC (Char_Literal_Value (Node)));
1285             Write_Char (''');
1286
1287          when N_Code_Statement =>
1288             Write_Indent;
1289             Set_Debug_Sloc;
1290             Sprint_Node (Expression (Node));
1291             Write_Char (';');
1292
1293          when N_Compilation_Unit =>
1294             Sprint_Node_List (Context_Items (Node));
1295             Sprint_Opt_Node_List (Declarations (Aux_Decls_Node (Node)));
1296
1297             if Private_Present (Node) then
1298                Write_Indent_Str ("private ");
1299                Indent_Annull;
1300             end if;
1301
1302             Sprint_Node_Sloc (Unit (Node));
1303
1304             if Present (Actions (Aux_Decls_Node (Node)))
1305                  or else
1306                Present (Pragmas_After (Aux_Decls_Node (Node)))
1307             then
1308                Write_Indent;
1309             end if;
1310
1311             Sprint_Opt_Node_List (Actions (Aux_Decls_Node (Node)));
1312             Sprint_Opt_Node_List (Pragmas_After (Aux_Decls_Node (Node)));
1313
1314          when N_Compilation_Unit_Aux =>
1315             null; -- nothing to do, never used, see above
1316
1317          when N_Component_Association =>
1318             Set_Debug_Sloc;
1319             Sprint_Bar_List (Choices (Node));
1320             Write_Str (" => ");
1321
1322             --  Ada 2005 (AI-287): Print the box if present
1323
1324             if Box_Present (Node) then
1325                Write_Str_With_Col_Check ("<>");
1326             else
1327                Sprint_Node (Expression (Node));
1328             end if;
1329
1330          when N_Iterated_Component_Association =>
1331             Set_Debug_Sloc;
1332             Write_Str (" for ");
1333             Write_Id (Defining_Identifier (Node));
1334             Write_Str (" in ");
1335             Sprint_Bar_List (Discrete_Choices (Node));
1336             Write_Str (" => ");
1337             Sprint_Node (Expression (Node));
1338
1339          when N_Component_Clause =>
1340             Write_Indent;
1341             Sprint_Node (Component_Name (Node));
1342             Write_Str_Sloc (" at ");
1343             Sprint_Node (Position (Node));
1344             Write_Char (' ');
1345             Write_Str_With_Col_Check ("range ");
1346             Sprint_Node (First_Bit (Node));
1347             Write_Str (" .. ");
1348             Sprint_Node (Last_Bit (Node));
1349             Write_Char (';');
1350
1351          when N_Component_Definition =>
1352             Set_Debug_Sloc;
1353
1354             --  Ada 2005 (AI-230): Access definition components
1355
1356             if Present (Access_Definition (Node)) then
1357                Sprint_Node (Access_Definition (Node));
1358
1359             elsif Present (Subtype_Indication (Node)) then
1360                if Aliased_Present (Node) then
1361                   Write_Str_With_Col_Check ("aliased ");
1362                end if;
1363
1364                --  Ada 2005 (AI-231)
1365
1366                if Null_Exclusion_Present (Node) then
1367                   Write_Str (" not null ");
1368                end if;
1369
1370                Sprint_Node (Subtype_Indication (Node));
1371
1372             else
1373                Write_Str (" ??? ");
1374             end if;
1375
1376          when N_Component_Declaration =>
1377             if Write_Indent_Identifiers_Sloc (Node) then
1378                Write_Str (" : ");
1379                Sprint_Node (Component_Definition (Node));
1380
1381                if Present (Expression (Node)) then
1382                   Write_Str (" := ");
1383                   Sprint_Node (Expression (Node));
1384                end if;
1385
1386                Write_Char (';');
1387             end if;
1388
1389          when N_Component_List =>
1390             if Null_Present (Node) then
1391                Indent_Begin;
1392                Write_Indent_Str_Sloc ("null");
1393                Write_Char (';');
1394                Indent_End;
1395
1396             else
1397                Set_Debug_Sloc;
1398                Sprint_Indented_List (Component_Items (Node));
1399                Sprint_Node (Variant_Part (Node));
1400             end if;
1401
1402          when N_Compound_Statement =>
1403             Write_Indent_Str ("do");
1404             Indent_Begin;
1405             Sprint_Node_List (Actions (Node));
1406             Indent_End;
1407             Write_Indent_Str ("end;");
1408
1409          when N_Conditional_Entry_Call =>
1410             Write_Indent_Str_Sloc ("select");
1411             Indent_Begin;
1412             Sprint_Node (Entry_Call_Alternative (Node));
1413             Indent_End;
1414             Write_Indent_Str ("else");
1415             Sprint_Indented_List (Else_Statements (Node));
1416             Write_Indent_Str ("end select;");
1417
1418          when N_Constrained_Array_Definition =>
1419             Write_Str_With_Col_Check_Sloc ("array ");
1420             Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
1421             Write_Str (" of ");
1422
1423             Sprint_Node (Component_Definition (Node));
1424
1425          --  A contract node should not appear in the tree. It is a semantic
1426          --  node attached to entry and [generic] subprogram entities. But we
1427          --  still provide meaningful output, in case called from the debugger.
1428
1429          when N_Contract =>
1430             declare
1431                P : Node_Id;
1432
1433             begin
1434                Indent_Begin;
1435                Write_Str ("N_Contract node");
1436                Write_Eol;
1437
1438                Write_Indent_Str ("Pre_Post_Conditions");
1439                Indent_Begin;
1440
1441                P := Pre_Post_Conditions (Node);
1442                while Present (P) loop
1443                   Sprint_Node (P);
1444                   P := Next_Pragma (P);
1445                end loop;
1446
1447                Write_Eol;
1448                Indent_End;
1449
1450                Write_Indent_Str ("Contract_Test_Cases");
1451                Indent_Begin;
1452
1453                P := Contract_Test_Cases (Node);
1454                while Present (P) loop
1455                   Sprint_Node (P);
1456                   P := Next_Pragma (P);
1457                end loop;
1458
1459                Write_Eol;
1460                Indent_End;
1461
1462                Write_Indent_Str ("Classifications");
1463                Indent_Begin;
1464
1465                P := Classifications (Node);
1466                while Present (P) loop
1467                   Sprint_Node (P);
1468                   P := Next_Pragma (P);
1469                end loop;
1470
1471                Write_Eol;
1472                Indent_End;
1473                Indent_End;
1474             end;
1475
1476          when N_Decimal_Fixed_Point_Definition =>
1477             Write_Str_With_Col_Check_Sloc (" delta ");
1478             Sprint_Node (Delta_Expression (Node));
1479             Write_Str_With_Col_Check ("digits ");
1480             Sprint_Node (Digits_Expression (Node));
1481             Sprint_Opt_Node (Real_Range_Specification (Node));
1482
1483          when N_Defining_Character_Literal =>
1484             Write_Name_With_Col_Check_Sloc (Chars (Node));
1485
1486          when N_Defining_Identifier =>
1487             Set_Debug_Sloc;
1488             Write_Id (Node);
1489
1490          when N_Defining_Operator_Symbol =>
1491             Write_Name_With_Col_Check_Sloc (Chars (Node));
1492
1493          when N_Defining_Program_Unit_Name =>
1494             Set_Debug_Sloc;
1495             Sprint_Node (Name (Node));
1496             Write_Char ('.');
1497             Write_Id (Defining_Identifier (Node));
1498
1499          when N_Delay_Alternative =>
1500             Sprint_Node_List (Pragmas_Before (Node));
1501
1502             if Present (Condition (Node)) then
1503                Write_Indent;
1504                Write_Str_With_Col_Check ("when ");
1505                Sprint_Node (Condition (Node));
1506                Write_Str (" => ");
1507                Indent_Annull;
1508             end if;
1509
1510             Sprint_Node_Sloc (Delay_Statement (Node));
1511             Sprint_Node_List (Statements (Node));
1512
1513          when N_Delay_Relative_Statement =>
1514             Write_Indent_Str_Sloc ("delay ");
1515             Sprint_Node (Expression (Node));
1516             Write_Char (';');
1517
1518          when N_Delay_Until_Statement =>
1519             Write_Indent_Str_Sloc ("delay until ");
1520             Sprint_Node (Expression (Node));
1521             Write_Char (';');
1522
1523          when N_Delta_Constraint =>
1524             Write_Str_With_Col_Check_Sloc ("delta ");
1525             Sprint_Node (Delta_Expression (Node));
1526             Sprint_Opt_Node (Range_Constraint (Node));
1527
1528          when N_Derived_Type_Definition =>
1529             if Abstract_Present (Node) then
1530                Write_Str_With_Col_Check ("abstract ");
1531             end if;
1532
1533             Write_Str_With_Col_Check ("new ");
1534
1535             --  Ada 2005 (AI-231)
1536
1537             if Null_Exclusion_Present (Node) then
1538                Write_Str_With_Col_Check ("not null ");
1539             end if;
1540
1541             Sprint_Node (Subtype_Indication (Node));
1542
1543             if Present (Interface_List (Node)) then
1544                Write_Str_With_Col_Check (" and ");
1545                Sprint_And_List (Interface_List (Node));
1546                Write_Str_With_Col_Check (" with ");
1547             end if;
1548
1549             if Present (Record_Extension_Part (Node)) then
1550                if No (Interface_List (Node)) then
1551                   Write_Str_With_Col_Check (" with ");
1552                end if;
1553
1554                Sprint_Node (Record_Extension_Part (Node));
1555             end if;
1556
1557          when N_Designator =>
1558             Sprint_Node (Name (Node));
1559             Write_Char_Sloc ('.');
1560             Write_Id (Identifier (Node));
1561
1562          when N_Digits_Constraint =>
1563             Write_Str_With_Col_Check_Sloc ("digits ");
1564             Sprint_Node (Digits_Expression (Node));
1565             Sprint_Opt_Node (Range_Constraint (Node));
1566
1567          when N_Discriminant_Association =>
1568             Set_Debug_Sloc;
1569
1570             if Present (Selector_Names (Node)) then
1571                Sprint_Bar_List (Selector_Names (Node));
1572                Write_Str (" => ");
1573             end if;
1574
1575             Set_Debug_Sloc;
1576             Sprint_Node (Expression (Node));
1577
1578          when N_Discriminant_Specification =>
1579             Set_Debug_Sloc;
1580
1581             if Write_Identifiers (Node) then
1582                Write_Str (" : ");
1583
1584                if Null_Exclusion_Present (Node) then
1585                   Write_Str ("not null ");
1586                end if;
1587
1588                Sprint_Node (Discriminant_Type (Node));
1589
1590                if Present (Expression (Node)) then
1591                   Write_Str (" := ");
1592                   Sprint_Node (Expression (Node));
1593                end if;
1594             else
1595                Write_Str (", ");
1596             end if;
1597
1598          when N_Elsif_Part =>
1599             Write_Indent_Str_Sloc ("elsif ");
1600             Sprint_Node (Condition (Node));
1601             Write_Str_With_Col_Check (" then");
1602             Sprint_Indented_List (Then_Statements (Node));
1603
1604          when N_Empty =>
1605             null;
1606
1607          when N_Entry_Body =>
1608             Write_Indent_Str_Sloc ("entry ");
1609             Write_Id (Defining_Identifier (Node));
1610             Sprint_Node (Entry_Body_Formal_Part (Node));
1611             Write_Str_With_Col_Check (" is");
1612             Sprint_Indented_List (Declarations (Node));
1613             Write_Indent_Str ("begin");
1614             Sprint_Node (Handled_Statement_Sequence (Node));
1615             Write_Indent_Str ("end ");
1616             Write_Id (Defining_Identifier (Node));
1617             Write_Char (';');
1618
1619          when N_Entry_Body_Formal_Part =>
1620             if Present (Entry_Index_Specification (Node)) then
1621                Write_Str_With_Col_Check_Sloc (" (");
1622                Sprint_Node (Entry_Index_Specification (Node));
1623                Write_Char (')');
1624             end if;
1625
1626             Write_Param_Specs (Node);
1627             Write_Str_With_Col_Check_Sloc (" when ");
1628             Sprint_Node (Condition (Node));
1629
1630          when N_Entry_Call_Alternative =>
1631             Sprint_Node_List (Pragmas_Before (Node));
1632             Sprint_Node_Sloc (Entry_Call_Statement (Node));
1633             Sprint_Node_List (Statements (Node));
1634
1635          when N_Entry_Call_Statement =>
1636             Write_Indent;
1637             Sprint_Node_Sloc (Name (Node));
1638             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1639             Write_Char (';');
1640
1641          when N_Entry_Declaration =>
1642             Write_Indent_Str_Sloc ("entry ");
1643             Write_Id (Defining_Identifier (Node));
1644
1645             if Present (Discrete_Subtype_Definition (Node)) then
1646                Write_Str_With_Col_Check (" (");
1647                Sprint_Node (Discrete_Subtype_Definition (Node));
1648                Write_Char (')');
1649             end if;
1650
1651             Write_Param_Specs (Node);
1652             Write_Char (';');
1653
1654          when N_Entry_Index_Specification =>
1655             Write_Str_With_Col_Check_Sloc ("for ");
1656             Write_Id (Defining_Identifier (Node));
1657             Write_Str_With_Col_Check (" in ");
1658             Sprint_Node (Discrete_Subtype_Definition (Node));
1659
1660          when N_Enumeration_Representation_Clause =>
1661             Write_Indent_Str_Sloc ("for ");
1662             Write_Id (Identifier (Node));
1663             Write_Str_With_Col_Check (" use ");
1664             Sprint_Node (Array_Aggregate (Node));
1665             Write_Char (';');
1666
1667          when N_Enumeration_Type_Definition =>
1668             Set_Debug_Sloc;
1669
1670             --  Skip attempt to print Literals field if it's not there and
1671             --  we are in package Standard (case of Character, which is
1672             --  handled specially (without an explicit literals list).
1673
1674             if Sloc (Node) > Standard_Location
1675               or else Present (Literals (Node))
1676             then
1677                Sprint_Paren_Comma_List (Literals (Node));
1678             end if;
1679
1680          when N_Error =>
1681             Write_Str_With_Col_Check_Sloc ("<error>");
1682
1683          when N_Exception_Declaration =>
1684             if Write_Indent_Identifiers (Node) then
1685                Write_Str_With_Col_Check (" : ");
1686
1687                if Is_Statically_Allocated (Defining_Identifier (Node)) then
1688                   Write_Str_With_Col_Check ("static ");
1689                end if;
1690
1691                Write_Str_Sloc ("exception");
1692
1693                if Present (Expression (Node)) then
1694                   Write_Str (" := ");
1695                   Sprint_Node (Expression (Node));
1696                end if;
1697
1698                Write_Char (';');
1699             end if;
1700
1701          when N_Exception_Handler =>
1702             Write_Indent_Str_Sloc ("when ");
1703
1704             if Present (Choice_Parameter (Node)) then
1705                Sprint_Node (Choice_Parameter (Node));
1706                Write_Str (" : ");
1707             end if;
1708
1709             Sprint_Bar_List (Exception_Choices (Node));
1710             Write_Str (" => ");
1711             Sprint_Indented_List (Statements (Node));
1712
1713          when N_Exception_Renaming_Declaration =>
1714             Write_Indent;
1715             Set_Debug_Sloc;
1716             Sprint_Node (Defining_Identifier (Node));
1717             Write_Str_With_Col_Check (" : exception renames ");
1718             Sprint_Node (Name (Node));
1719             Write_Char (';');
1720
1721          when N_Exit_Statement =>
1722             Write_Indent_Str_Sloc ("exit");
1723             Sprint_Opt_Node (Name (Node));
1724
1725             if Present (Condition (Node)) then
1726                Write_Str_With_Col_Check (" when ");
1727                Sprint_Node (Condition (Node));
1728             end if;
1729
1730             Write_Char (';');
1731
1732          when N_Expanded_Name =>
1733             Sprint_Node (Prefix (Node));
1734             Write_Char_Sloc ('.');
1735             Sprint_Node (Selector_Name (Node));
1736
1737          when N_Explicit_Dereference =>
1738             Sprint_Node (Prefix (Node));
1739             Write_Char_Sloc ('.');
1740             Write_Str_Sloc ("all");
1741
1742          when N_Expression_With_Actions =>
1743             Indent_Begin;
1744             Write_Indent_Str_Sloc ("do ");
1745             Indent_Begin;
1746             Sprint_Node_List (Actions (Node));
1747             Indent_End;
1748             Write_Indent;
1749             Write_Str_With_Col_Check_Sloc ("in ");
1750             Sprint_Node (Expression (Node));
1751             Write_Str_With_Col_Check (" end");
1752             Indent_End;
1753             Write_Indent;
1754
1755          when N_Expression_Function =>
1756             Write_Indent;
1757             Sprint_Node_Sloc (Specification (Node));
1758             Write_Str (" is");
1759             Indent_Begin;
1760             Write_Indent;
1761             Sprint_Node (Expression (Node));
1762             Write_Char (';');
1763             Indent_End;
1764
1765          when N_Extended_Return_Statement =>
1766             Write_Indent_Str_Sloc ("return ");
1767             Sprint_Node_List (Return_Object_Declarations (Node));
1768
1769             if Present (Handled_Statement_Sequence (Node)) then
1770                Write_Str_With_Col_Check (" do");
1771                Sprint_Node (Handled_Statement_Sequence (Node));
1772                Write_Indent_Str ("end return;");
1773             else
1774                Write_Indent_Str (";");
1775             end if;
1776
1777          when N_Delta_Aggregate =>
1778             Write_Str_With_Col_Check_Sloc ("(");
1779             Sprint_Node (Expression (Node));
1780             Write_Str_With_Col_Check (" with delta ");
1781             Sprint_Comma_List (Component_Associations (Node));
1782             Write_Char (')');
1783
1784          when N_Extension_Aggregate =>
1785             Write_Str_With_Col_Check_Sloc ("(");
1786             Sprint_Node (Ancestor_Part (Node));
1787             Write_Str_With_Col_Check (" with ");
1788
1789             if Null_Record_Present (Node) then
1790                Write_Str_With_Col_Check ("null record");
1791             else
1792                if Present (Expressions (Node)) then
1793                   Sprint_Comma_List (Expressions (Node));
1794
1795                   if Present (Component_Associations (Node)) then
1796                      Write_Str (", ");
1797                   end if;
1798                end if;
1799
1800                if Present (Component_Associations (Node)) then
1801                   Sprint_Comma_List (Component_Associations (Node));
1802                end if;
1803             end if;
1804
1805             Write_Char (')');
1806
1807          when N_Floating_Point_Definition =>
1808             Write_Str_With_Col_Check_Sloc ("digits ");
1809             Sprint_Node (Digits_Expression (Node));
1810             Sprint_Opt_Node (Real_Range_Specification (Node));
1811
1812          when N_Formal_Decimal_Fixed_Point_Definition =>
1813             Write_Str_With_Col_Check_Sloc ("delta <> digits <>");
1814
1815          when N_Formal_Derived_Type_Definition =>
1816             Write_Str_With_Col_Check_Sloc ("new ");
1817             Sprint_Node (Subtype_Mark (Node));
1818
1819             if Present (Interface_List (Node)) then
1820                Write_Str_With_Col_Check (" and ");
1821                Sprint_And_List (Interface_List (Node));
1822             end if;
1823
1824             if Private_Present (Node) then
1825                Write_Str_With_Col_Check (" with private");
1826             end if;
1827
1828          when N_Formal_Abstract_Subprogram_Declaration =>
1829             Write_Indent_Str_Sloc ("with ");
1830             Sprint_Node (Specification (Node));
1831
1832             Write_Str_With_Col_Check (" is abstract");
1833
1834             if Box_Present (Node) then
1835                Write_Str_With_Col_Check (" <>");
1836             elsif Present (Default_Name (Node)) then
1837                Write_Str_With_Col_Check (" ");
1838                Sprint_Node (Default_Name (Node));
1839             end if;
1840
1841             Write_Char (';');
1842
1843          when N_Formal_Concrete_Subprogram_Declaration =>
1844             Write_Indent_Str_Sloc ("with ");
1845             Sprint_Node (Specification (Node));
1846
1847             if Box_Present (Node) then
1848                Write_Str_With_Col_Check (" is <>");
1849             elsif Present (Default_Name (Node)) then
1850                Write_Str_With_Col_Check (" is ");
1851                Sprint_Node (Default_Name (Node));
1852             end if;
1853
1854             Write_Char (';');
1855
1856          when N_Formal_Discrete_Type_Definition =>
1857             Write_Str_With_Col_Check_Sloc ("<>");
1858
1859          when N_Formal_Floating_Point_Definition =>
1860             Write_Str_With_Col_Check_Sloc ("digits <>");
1861
1862          when N_Formal_Modular_Type_Definition =>
1863             Write_Str_With_Col_Check_Sloc ("mod <>");
1864
1865          when N_Formal_Object_Declaration =>
1866             Set_Debug_Sloc;
1867
1868             if Write_Indent_Identifiers (Node) then
1869                Write_Str (" : ");
1870
1871                if In_Present (Node) then
1872                   Write_Str_With_Col_Check ("in ");
1873                end if;
1874
1875                if Out_Present (Node) then
1876                   Write_Str_With_Col_Check ("out ");
1877                end if;
1878
1879                if Present (Subtype_Mark (Node)) then
1880
1881                   --  Ada 2005 (AI-423): Formal object with null exclusion
1882
1883                   if Null_Exclusion_Present (Node) then
1884                      Write_Str ("not null ");
1885                   end if;
1886
1887                   Sprint_Node (Subtype_Mark (Node));
1888
1889                --  Ada 2005 (AI-423): Formal object with access definition
1890
1891                else
1892                   pragma Assert (Present (Access_Definition (Node)));
1893
1894                   Sprint_Node (Access_Definition (Node));
1895                end if;
1896
1897                if Present (Default_Expression (Node)) then
1898                   Write_Str (" := ");
1899                   Sprint_Node (Default_Expression (Node));
1900                end if;
1901
1902                Write_Char (';');
1903             end if;
1904
1905          when N_Formal_Ordinary_Fixed_Point_Definition =>
1906             Write_Str_With_Col_Check_Sloc ("delta <>");
1907
1908          when N_Formal_Package_Declaration =>
1909             Write_Indent_Str_Sloc ("with package ");
1910             Write_Id (Defining_Identifier (Node));
1911             Write_Str_With_Col_Check (" is new ");
1912             Sprint_Node (Name (Node));
1913             Write_Str_With_Col_Check (" (<>);");
1914
1915          when N_Formal_Private_Type_Definition =>
1916             if Abstract_Present (Node) then
1917                Write_Str_With_Col_Check ("abstract ");
1918             end if;
1919
1920             if Tagged_Present (Node) then
1921                Write_Str_With_Col_Check ("tagged ");
1922             end if;
1923
1924             if Limited_Present (Node) then
1925                Write_Str_With_Col_Check ("limited ");
1926             end if;
1927
1928             Write_Str_With_Col_Check_Sloc ("private");
1929
1930          when N_Formal_Incomplete_Type_Definition =>
1931             if Tagged_Present (Node) then
1932                Write_Str_With_Col_Check ("is tagged ");
1933             end if;
1934
1935          when N_Formal_Signed_Integer_Type_Definition =>
1936             Write_Str_With_Col_Check_Sloc ("range <>");
1937
1938          when N_Formal_Type_Declaration =>
1939             Write_Indent_Str_Sloc ("type ");
1940             Write_Id (Defining_Identifier (Node));
1941
1942             if Present (Discriminant_Specifications (Node)) then
1943                Write_Discr_Specs (Node);
1944             elsif Unknown_Discriminants_Present (Node) then
1945                Write_Str_With_Col_Check ("(<>)");
1946             end if;
1947
1948             if Nkind (Formal_Type_Definition (Node)) /=
1949                 N_Formal_Incomplete_Type_Definition
1950             then
1951                Write_Str_With_Col_Check (" is ");
1952             end if;
1953
1954             Sprint_Node (Formal_Type_Definition (Node));
1955             Write_Char (';');
1956
1957          when N_Free_Statement =>
1958             Write_Indent_Str_Sloc ("free ");
1959             Sprint_Node (Expression (Node));
1960             Write_Char (';');
1961
1962          when N_Freeze_Entity =>
1963             if Dump_Original_Only then
1964                null;
1965
1966             --  A freeze node is output if it has some effect (i.e. non-empty
1967             --  actions, or freeze node for an itype, which causes elaboration
1968             --  of the itype), and is also always output if Dump_Freeze_Null
1969             --  is set True.
1970
1971             elsif Present (Actions (Node))
1972               or else Is_Itype (Entity (Node))
1973               or else Dump_Freeze_Null
1974             then
1975                Write_Indent;
1976                Write_Rewrite_Str ("<<<");
1977                Write_Str_With_Col_Check_Sloc ("freeze ");
1978                Write_Id (Entity (Node));
1979                Write_Str (" [");
1980
1981                if No (Actions (Node)) then
1982                   Write_Char (']');
1983
1984                else
1985                   --  Output freeze actions. We increment Freeze_Indent during
1986                   --  this output to avoid generating extra blank lines before
1987                   --  any procedures included in the freeze actions.
1988
1989                   Freeze_Indent := Freeze_Indent + 1;
1990                   Sprint_Indented_List (Actions (Node));
1991                   Freeze_Indent := Freeze_Indent - 1;
1992                   Write_Indent_Str ("]");
1993                end if;
1994
1995                Write_Rewrite_Str (">>>");
1996             end if;
1997
1998          when N_Freeze_Generic_Entity =>
1999             if Dump_Original_Only then
2000                null;
2001
2002             else
2003                Write_Indent;
2004                Write_Str_With_Col_Check_Sloc ("freeze_generic ");
2005                Write_Id (Entity (Node));
2006             end if;
2007
2008          when N_Full_Type_Declaration =>
2009             Write_Indent_Str_Sloc ("type ");
2010             Sprint_Node (Defining_Identifier (Node));
2011             Write_Discr_Specs (Node);
2012             Write_Str_With_Col_Check (" is ");
2013             Sprint_Node (Type_Definition (Node));
2014             Write_Char (';');
2015
2016          when N_Function_Call =>
2017             Set_Debug_Sloc;
2018             Write_Subprogram_Name (Name (Node));
2019             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2020
2021          when N_Function_Instantiation =>
2022             Write_Indent_Str_Sloc ("function ");
2023             Sprint_Node (Defining_Unit_Name (Node));
2024             Write_Str_With_Col_Check (" is new ");
2025             Sprint_Node (Name (Node));
2026             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2027             Write_Char (';');
2028
2029          when N_Function_Specification =>
2030             Write_Str_With_Col_Check_Sloc ("function ");
2031             Sprint_Node (Defining_Unit_Name (Node));
2032             Write_Param_Specs (Node);
2033             Write_Str_With_Col_Check (" return ");
2034
2035             --  Ada 2005 (AI-231)
2036
2037             if Nkind (Result_Definition (Node)) /= N_Access_Definition
2038               and then Null_Exclusion_Present (Node)
2039             then
2040                Write_Str (" not null ");
2041             end if;
2042
2043             Sprint_Node (Result_Definition (Node));
2044
2045          when N_Generic_Association =>
2046             Set_Debug_Sloc;
2047
2048             if Present (Selector_Name (Node)) then
2049                Sprint_Node (Selector_Name (Node));
2050                Write_Str (" => ");
2051             end if;
2052
2053             Sprint_Node (Explicit_Generic_Actual_Parameter (Node));
2054
2055          when N_Generic_Function_Renaming_Declaration =>
2056             Write_Indent_Str_Sloc ("generic function ");
2057             Sprint_Node (Defining_Unit_Name (Node));
2058             Write_Str_With_Col_Check (" renames ");
2059             Sprint_Node (Name (Node));
2060             Write_Char (';');
2061
2062          when N_Generic_Package_Declaration =>
2063             Extra_Blank_Line;
2064             Write_Indent_Str_Sloc ("generic ");
2065             Sprint_Indented_List (Generic_Formal_Declarations (Node));
2066             Write_Indent;
2067             Sprint_Node (Specification (Node));
2068             Write_Char (';');
2069
2070          when N_Generic_Package_Renaming_Declaration =>
2071             Write_Indent_Str_Sloc ("generic package ");
2072             Sprint_Node (Defining_Unit_Name (Node));
2073             Write_Str_With_Col_Check (" renames ");
2074             Sprint_Node (Name (Node));
2075             Write_Char (';');
2076
2077          when N_Generic_Procedure_Renaming_Declaration =>
2078             Write_Indent_Str_Sloc ("generic procedure ");
2079             Sprint_Node (Defining_Unit_Name (Node));
2080             Write_Str_With_Col_Check (" renames ");
2081             Sprint_Node (Name (Node));
2082             Write_Char (';');
2083
2084          when N_Generic_Subprogram_Declaration =>
2085             Extra_Blank_Line;
2086             Write_Indent_Str_Sloc ("generic ");
2087             Sprint_Indented_List (Generic_Formal_Declarations (Node));
2088             Write_Indent;
2089             Sprint_Node (Specification (Node));
2090             Write_Char (';');
2091
2092          when N_Goto_Statement =>
2093             Write_Indent_Str_Sloc ("goto ");
2094             Sprint_Node (Name (Node));
2095             Write_Char (';');
2096
2097             if Nkind (Next (Node)) = N_Label then
2098                Write_Indent;
2099             end if;
2100
2101          when N_Handled_Sequence_Of_Statements =>
2102             Set_Debug_Sloc;
2103             Sprint_Indented_List (Statements (Node));
2104
2105             if Present (Exception_Handlers (Node)) then
2106                Write_Indent_Str ("exception");
2107                Indent_Begin;
2108                Sprint_Node_List (Exception_Handlers (Node));
2109                Indent_End;
2110             end if;
2111
2112             if Present (At_End_Proc (Node)) then
2113                Write_Indent_Str ("at end");
2114                Indent_Begin;
2115                Write_Indent;
2116                Sprint_Node (At_End_Proc (Node));
2117                Write_Char (';');
2118                Indent_End;
2119             end if;
2120
2121          when N_Identifier =>
2122             Set_Debug_Sloc;
2123             Write_Id (Node);
2124
2125          when N_If_Expression =>
2126             declare
2127                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
2128                Condition  : constant Node_Id := First (Expressions (Node));
2129                Then_Expr  : constant Node_Id := Next (Condition);
2130
2131             begin
2132                --  The syntax for if_expression does not include parentheses,
2133                --  but sometimes parentheses are required, so unconditionally
2134                --  generate them here unless already present.
2135
2136                if not Has_Parens then
2137                   Write_Char ('(');
2138                end if;
2139
2140                Write_Str_With_Col_Check_Sloc ("if ");
2141                Sprint_Node (Condition);
2142                Write_Str_With_Col_Check (" then ");
2143
2144                --  Defense against junk here
2145
2146                if Present (Then_Expr) then
2147                   Sprint_Node (Then_Expr);
2148
2149                   if Present (Next (Then_Expr)) then
2150                      Write_Str_With_Col_Check (" else ");
2151                      Sprint_Node (Next (Then_Expr));
2152                   end if;
2153                end if;
2154
2155                if not Has_Parens then
2156                   Write_Char (')');
2157                end if;
2158             end;
2159
2160          when N_If_Statement =>
2161             Write_Indent_Str_Sloc ("if ");
2162             Sprint_Node (Condition (Node));
2163             Write_Str_With_Col_Check (" then");
2164             Sprint_Indented_List (Then_Statements (Node));
2165             Sprint_Opt_Node_List (Elsif_Parts (Node));
2166
2167             if Present (Else_Statements (Node)) then
2168                Write_Indent_Str ("else");
2169                Sprint_Indented_List (Else_Statements (Node));
2170             end if;
2171
2172             Write_Indent_Str ("end if;");
2173
2174          when N_Implicit_Label_Declaration =>
2175             if not Dump_Original_Only then
2176                Write_Indent;
2177                Write_Rewrite_Str ("<<<");
2178                Set_Debug_Sloc;
2179                Write_Id (Defining_Identifier (Node));
2180                Write_Str (" : ");
2181                Write_Str_With_Col_Check ("label");
2182                Write_Rewrite_Str (">>>");
2183             end if;
2184
2185          when N_In =>
2186             Sprint_Left_Opnd (Node);
2187             Write_Str_Sloc (" in ");
2188
2189             if Present (Right_Opnd (Node)) then
2190                Sprint_Right_Opnd (Node);
2191             else
2192                Sprint_Bar_List (Alternatives (Node));
2193             end if;
2194
2195          when N_Incomplete_Type_Declaration =>
2196             Write_Indent_Str_Sloc ("type ");
2197             Write_Id (Defining_Identifier (Node));
2198
2199             if Present (Discriminant_Specifications (Node)) then
2200                Write_Discr_Specs (Node);
2201             elsif Unknown_Discriminants_Present (Node) then
2202                Write_Str_With_Col_Check ("(<>)");
2203             end if;
2204
2205             Write_Char (';');
2206
2207          when N_Index_Or_Discriminant_Constraint =>
2208             Set_Debug_Sloc;
2209             Sprint_Paren_Comma_List (Constraints (Node));
2210
2211          when N_Indexed_Component =>
2212             Sprint_Node_Sloc (Prefix (Node));
2213             Sprint_Opt_Paren_Comma_List (Expressions (Node));
2214
2215          when N_Integer_Literal =>
2216             if Print_In_Hex (Node) then
2217                Write_Uint_With_Col_Check_Sloc (Intval (Node), Hex);
2218             else
2219                Write_Uint_With_Col_Check_Sloc (Intval (Node), Auto);
2220             end if;
2221
2222          when N_Iteration_Scheme =>
2223             if Present (Condition (Node)) then
2224                Write_Str_With_Col_Check_Sloc ("while ");
2225                Sprint_Node (Condition (Node));
2226             else
2227                Write_Str_With_Col_Check_Sloc ("for ");
2228
2229                if Present (Iterator_Specification (Node)) then
2230                   Sprint_Node (Iterator_Specification (Node));
2231                else
2232                   Sprint_Node (Loop_Parameter_Specification (Node));
2233                end if;
2234             end if;
2235
2236             Write_Char (' ');
2237
2238          when N_Iterator_Specification =>
2239             Set_Debug_Sloc;
2240             Write_Id (Defining_Identifier (Node));
2241
2242             if Present (Subtype_Indication (Node)) then
2243                Write_Str_With_Col_Check (" : ");
2244                Sprint_Node (Subtype_Indication (Node));
2245             end if;
2246
2247             if Of_Present (Node) then
2248                Write_Str_With_Col_Check (" of ");
2249             else
2250                Write_Str_With_Col_Check (" in ");
2251             end if;
2252
2253             if Reverse_Present (Node) then
2254                Write_Str_With_Col_Check ("reverse ");
2255             end if;
2256
2257             Sprint_Node (Name (Node));
2258
2259          when N_Itype_Reference =>
2260             Write_Indent_Str_Sloc ("reference ");
2261             Write_Id (Itype (Node));
2262
2263          when N_Label =>
2264             Write_Indent_Str_Sloc ("<<");
2265             Write_Id (Identifier (Node));
2266             Write_Str (">>");
2267
2268          when N_Loop_Parameter_Specification =>
2269             Set_Debug_Sloc;
2270             Write_Id (Defining_Identifier (Node));
2271             Write_Str_With_Col_Check (" in ");
2272
2273             if Reverse_Present (Node) then
2274                Write_Str_With_Col_Check ("reverse ");
2275             end if;
2276
2277             Sprint_Node (Discrete_Subtype_Definition (Node));
2278
2279          when N_Loop_Statement =>
2280             Write_Indent;
2281
2282             if Present (Identifier (Node))
2283               and then (not Has_Created_Identifier (Node)
2284                           or else not Dump_Original_Only)
2285             then
2286                Write_Rewrite_Str ("<<<");
2287                Write_Id (Identifier (Node));
2288                Write_Str (" : ");
2289                Write_Rewrite_Str (">>>");
2290                Sprint_Node (Iteration_Scheme (Node));
2291                Write_Str_With_Col_Check_Sloc ("loop");
2292                Sprint_Indented_List (Statements (Node));
2293                Write_Indent_Str ("end loop ");
2294                Write_Rewrite_Str ("<<<");
2295                Write_Id (Identifier (Node));
2296                Write_Rewrite_Str (">>>");
2297                Write_Char (';');
2298
2299             else
2300                Sprint_Node (Iteration_Scheme (Node));
2301                Write_Str_With_Col_Check_Sloc ("loop");
2302                Sprint_Indented_List (Statements (Node));
2303                Write_Indent_Str ("end loop;");
2304             end if;
2305
2306          when N_Mod_Clause =>
2307             Sprint_Node_List (Pragmas_Before (Node));
2308             Write_Str_With_Col_Check_Sloc ("at mod ");
2309             Sprint_Node (Expression (Node));
2310
2311          when N_Modular_Type_Definition =>
2312             Write_Str_With_Col_Check_Sloc ("mod ");
2313             Sprint_Node (Expression (Node));
2314
2315          when N_Not_In =>
2316             Sprint_Left_Opnd (Node);
2317             Write_Str_Sloc (" not in ");
2318
2319             if Present (Right_Opnd (Node)) then
2320                Sprint_Right_Opnd (Node);
2321             else
2322                Sprint_Bar_List (Alternatives (Node));
2323             end if;
2324
2325          when N_Null =>
2326             Write_Str_With_Col_Check_Sloc ("null");
2327
2328          when N_Null_Statement =>
2329             if Comes_From_Source (Node)
2330               or else Dump_Freeze_Null
2331               or else not Is_List_Member (Node)
2332               or else (No (Prev (Node)) and then No (Next (Node)))
2333             then
2334                Write_Indent_Str_Sloc ("null;");
2335             end if;
2336
2337          when N_Number_Declaration =>
2338             Set_Debug_Sloc;
2339
2340             if Write_Indent_Identifiers (Node) then
2341                Write_Str_With_Col_Check (" : constant ");
2342                Write_Str (" := ");
2343                Sprint_Node (Expression (Node));
2344                Write_Char (';');
2345             end if;
2346
2347          when N_Object_Declaration =>
2348             Set_Debug_Sloc;
2349
2350             if Write_Indent_Identifiers (Node) then
2351                declare
2352                   Def_Id : constant Entity_Id := Defining_Identifier (Node);
2353
2354                begin
2355                   Write_Str_With_Col_Check (" : ");
2356
2357                   if Is_Statically_Allocated (Def_Id) then
2358                      Write_Str_With_Col_Check ("static ");
2359                   end if;
2360
2361                   if Aliased_Present (Node) then
2362                      Write_Str_With_Col_Check ("aliased ");
2363                   end if;
2364
2365                   if Constant_Present (Node) then
2366                      Write_Str_With_Col_Check ("constant ");
2367                   end if;
2368
2369                   --  Ada 2005 (AI-231)
2370
2371                   if Null_Exclusion_Present (Node) then
2372                      Write_Str_With_Col_Check ("not null ");
2373                   end if;
2374
2375                   --  Print type. We used to print the Object_Definition from
2376                   --  the node, but it is much more useful to print the Etype
2377                   --  of the defining identifier for the case where the nominal
2378                   --  type is an unconstrained array type. For example, this
2379                   --  will be a clear reference to the Itype with the bounds
2380                   --  in the case of a type like String. The object after
2381                   --  all is constrained, even if its nominal subtype is
2382                   --  unconstrained.
2383
2384                   declare
2385                      Odef : constant Node_Id := Object_Definition (Node);
2386
2387                   begin
2388                      if Nkind (Odef) = N_Identifier
2389                        and then Present (Etype (Odef))
2390                        and then Is_Array_Type (Etype (Odef))
2391                        and then not Is_Constrained (Etype (Odef))
2392                        and then Present (Etype (Def_Id))
2393                      then
2394                         Sprint_Node (Etype (Def_Id));
2395
2396                      --  In other cases, the nominal type is fine to print
2397
2398                      else
2399                         Sprint_Node (Odef);
2400                      end if;
2401                   end;
2402
2403                   if Present (Expression (Node))
2404                     and then Expression (Node) /= Error
2405                   then
2406                      Write_Str (" := ");
2407                      Sprint_Node (Expression (Node));
2408                   end if;
2409
2410                   Write_Char (';');
2411
2412                   --  Handle implicit importation and implicit exportation of
2413                   --  object declarations:
2414                   --    $pragma import (Convention_Id, Def_Id, "...");
2415                   --    $pragma export (Convention_Id, Def_Id, "...");
2416
2417                   if Is_Internal (Def_Id)
2418                     and then Present (Interface_Name (Def_Id))
2419                   then
2420                      Write_Indent_Str_Sloc ("$pragma ");
2421
2422                      if Is_Imported (Def_Id) then
2423                         Write_Str ("import (");
2424
2425                      else pragma Assert (Is_Exported (Def_Id));
2426                         Write_Str ("export (");
2427                      end if;
2428
2429                      declare
2430                         Prefix : constant String  := "Convention_";
2431                         S      : constant String  := Convention (Def_Id)'Img;
2432
2433                      begin
2434                         Name_Len := S'Last - Prefix'Last;
2435                         Name_Buffer (1 .. Name_Len) :=
2436                           S (Prefix'Last + 1 .. S'Last);
2437                         Set_Casing (All_Lower_Case);
2438                         Write_Str (Name_Buffer (1 .. Name_Len));
2439                      end;
2440
2441                      Write_Str (", ");
2442                      Write_Id  (Def_Id);
2443                      Write_Str (", ");
2444                      Write_String_Table_Entry
2445                        (Strval (Interface_Name (Def_Id)));
2446                      Write_Str (");");
2447                   end if;
2448                end;
2449             end if;
2450
2451          when N_Object_Renaming_Declaration =>
2452             Write_Indent;
2453             Set_Debug_Sloc;
2454             Sprint_Node (Defining_Identifier (Node));
2455             Write_Str (" : ");
2456
2457             --  Ada 2005 (AI-230): Access renamings
2458
2459             if Present (Access_Definition (Node)) then
2460                Sprint_Node (Access_Definition (Node));
2461
2462             elsif Present (Subtype_Mark (Node)) then
2463
2464                --  Ada 2005 (AI-423): Object renaming with a null exclusion
2465
2466                if Null_Exclusion_Present (Node) then
2467                   Write_Str ("not null ");
2468                end if;
2469
2470                Sprint_Node (Subtype_Mark (Node));
2471
2472             else
2473                Write_Str (" ??? ");
2474             end if;
2475
2476             Write_Str_With_Col_Check (" renames ");
2477             Sprint_Node (Name (Node));
2478             Write_Char (';');
2479
2480          when N_Op_Abs =>
2481             Write_Operator (Node, "abs ");
2482             Sprint_Right_Opnd (Node);
2483
2484          when N_Op_Add =>
2485             Sprint_Left_Opnd (Node);
2486             Write_Operator (Node, " + ");
2487             Sprint_Right_Opnd (Node);
2488
2489          when N_Op_And =>
2490             Sprint_Left_Opnd (Node);
2491             Write_Operator (Node, " and ");
2492             Sprint_Right_Opnd (Node);
2493
2494          when N_Op_Concat =>
2495             Sprint_Left_Opnd (Node);
2496             Write_Operator (Node, " & ");
2497             Sprint_Right_Opnd (Node);
2498
2499          when N_Op_Divide =>
2500             Sprint_Left_Opnd (Node);
2501             Write_Char (' ');
2502             Process_TFAI_RR_Flags (Node);
2503             Write_Operator (Node, "/ ");
2504             Sprint_Right_Opnd (Node);
2505
2506          when N_Op_Eq =>
2507             Sprint_Left_Opnd (Node);
2508             Write_Operator (Node, " = ");
2509             Sprint_Right_Opnd (Node);
2510
2511          when N_Op_Expon =>
2512             Sprint_Left_Opnd (Node);
2513             Write_Operator (Node, " ** ");
2514             Sprint_Right_Opnd (Node);
2515
2516          when N_Op_Ge =>
2517             Sprint_Left_Opnd (Node);
2518             Write_Operator (Node, " >= ");
2519             Sprint_Right_Opnd (Node);
2520
2521          when N_Op_Gt =>
2522             Sprint_Left_Opnd (Node);
2523             Write_Operator (Node, " > ");
2524             Sprint_Right_Opnd (Node);
2525
2526          when N_Op_Le =>
2527             Sprint_Left_Opnd (Node);
2528             Write_Operator (Node, " <= ");
2529             Sprint_Right_Opnd (Node);
2530
2531          when N_Op_Lt =>
2532             Sprint_Left_Opnd (Node);
2533             Write_Operator (Node, " < ");
2534             Sprint_Right_Opnd (Node);
2535
2536          when N_Op_Minus =>
2537             Write_Operator (Node, "-");
2538             Sprint_Right_Opnd (Node);
2539
2540          when N_Op_Mod =>
2541             Sprint_Left_Opnd (Node);
2542
2543             if Treat_Fixed_As_Integer (Node) then
2544                Write_Str (" #");
2545             end if;
2546
2547             Write_Operator (Node, " mod ");
2548             Sprint_Right_Opnd (Node);
2549
2550          when N_Op_Multiply =>
2551             Sprint_Left_Opnd (Node);
2552             Write_Char (' ');
2553             Process_TFAI_RR_Flags (Node);
2554             Write_Operator (Node, "* ");
2555             Sprint_Right_Opnd (Node);
2556
2557          when N_Op_Ne =>
2558             Sprint_Left_Opnd (Node);
2559             Write_Operator (Node, " /= ");
2560             Sprint_Right_Opnd (Node);
2561
2562          when N_Op_Not =>
2563             Write_Operator (Node, "not ");
2564             Sprint_Right_Opnd (Node);
2565
2566          when N_Op_Or =>
2567             Sprint_Left_Opnd (Node);
2568             Write_Operator (Node, " or ");
2569             Sprint_Right_Opnd (Node);
2570
2571          when N_Op_Plus =>
2572             Write_Operator (Node, "+");
2573             Sprint_Right_Opnd (Node);
2574
2575          when N_Op_Rem =>
2576             Sprint_Left_Opnd (Node);
2577
2578             if Treat_Fixed_As_Integer (Node) then
2579                Write_Str (" #");
2580             end if;
2581
2582             Write_Operator (Node, " rem ");
2583             Sprint_Right_Opnd (Node);
2584
2585          when N_Op_Shift =>
2586             Set_Debug_Sloc;
2587             Write_Id (Node);
2588             Write_Char ('!');
2589             Write_Str_With_Col_Check ("(");
2590             Sprint_Node (Left_Opnd (Node));
2591             Write_Str (", ");
2592             Sprint_Node (Right_Opnd (Node));
2593             Write_Char (')');
2594
2595          when N_Op_Subtract =>
2596             Sprint_Left_Opnd (Node);
2597             Write_Operator (Node, " - ");
2598             Sprint_Right_Opnd (Node);
2599
2600          when N_Op_Xor =>
2601             Sprint_Left_Opnd (Node);
2602             Write_Operator (Node, " xor ");
2603             Sprint_Right_Opnd (Node);
2604
2605          when N_Operator_Symbol =>
2606             Write_Name_With_Col_Check_Sloc (Chars (Node));
2607
2608          when N_Ordinary_Fixed_Point_Definition =>
2609             Write_Str_With_Col_Check_Sloc ("delta ");
2610             Sprint_Node (Delta_Expression (Node));
2611             Sprint_Opt_Node (Real_Range_Specification (Node));
2612
2613          when N_Or_Else =>
2614             Sprint_Left_Opnd (Node);
2615             Write_Str_Sloc (" or else ");
2616             Sprint_Right_Opnd (Node);
2617
2618          when N_Others_Choice =>
2619             if All_Others (Node) then
2620                Write_Str_With_Col_Check ("all ");
2621             end if;
2622
2623             Write_Str_With_Col_Check_Sloc ("others");
2624
2625          when N_Package_Body =>
2626             Extra_Blank_Line;
2627             Write_Indent_Str_Sloc ("package body ");
2628             Sprint_Node (Defining_Unit_Name (Node));
2629             Write_Str (" is");
2630             Sprint_Indented_List (Declarations (Node));
2631
2632             if Present (Handled_Statement_Sequence (Node)) then
2633                Write_Indent_Str ("begin");
2634                Sprint_Node (Handled_Statement_Sequence (Node));
2635             end if;
2636
2637             Write_Indent_Str ("end ");
2638             Sprint_End_Label
2639               (Handled_Statement_Sequence (Node), Defining_Unit_Name (Node));
2640             Write_Char (';');
2641
2642          when N_Package_Body_Stub =>
2643             Write_Indent_Str_Sloc ("package body ");
2644             Sprint_Node (Defining_Identifier (Node));
2645             Write_Str_With_Col_Check (" is separate;");
2646
2647          when N_Package_Declaration =>
2648             Extra_Blank_Line;
2649             Write_Indent;
2650             Sprint_Node_Sloc (Specification (Node));
2651             Write_Char (';');
2652
2653             --  If this is an instantiation, get the aspects from the original
2654             --  instantiation node.
2655
2656             if Is_Generic_Instance (Defining_Entity (Node))
2657               and then Has_Aspects
2658                          (Package_Instantiation (Defining_Entity (Node)))
2659             then
2660                Sprint_Aspect_Specifications
2661                  (Package_Instantiation (Defining_Entity (Node)),
2662                    Semicolon => True);
2663             end if;
2664
2665          when N_Package_Instantiation =>
2666             Extra_Blank_Line;
2667             Write_Indent_Str_Sloc ("package ");
2668             Sprint_Node (Defining_Unit_Name (Node));
2669             Write_Str (" is new ");
2670             Sprint_Node (Name (Node));
2671             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2672             Write_Char (';');
2673
2674          when N_Package_Renaming_Declaration =>
2675             Write_Indent_Str_Sloc ("package ");
2676             Sprint_Node (Defining_Unit_Name (Node));
2677             Write_Str_With_Col_Check (" renames ");
2678             Sprint_Node (Name (Node));
2679             Write_Char (';');
2680
2681          when N_Package_Specification =>
2682             Write_Str_With_Col_Check_Sloc ("package ");
2683             Sprint_Node (Defining_Unit_Name (Node));
2684
2685             if Nkind (Parent (Node)) = N_Generic_Package_Declaration
2686               and then Has_Aspects (Parent (Node))
2687             then
2688                Sprint_Aspect_Specifications
2689                  (Parent (Node), Semicolon => False);
2690
2691             --  An instantiation is rewritten as a package declaration, but
2692             --  the aspects belong to the instantiation node.
2693
2694             elsif Nkind (Parent (Node)) = N_Package_Declaration then
2695                declare
2696                   Pack : constant Entity_Id := Defining_Entity (Node);
2697
2698                begin
2699                   if not Is_Generic_Instance (Pack) then
2700                      if Has_Aspects (Parent (Node)) then
2701                         Sprint_Aspect_Specifications
2702                           (Parent (Node), Semicolon => False);
2703                      end if;
2704                   end if;
2705                end;
2706             end if;
2707
2708             Write_Str (" is");
2709             Sprint_Indented_List (Visible_Declarations (Node));
2710
2711             if Present (Private_Declarations (Node)) then
2712                Write_Indent_Str ("private");
2713                Sprint_Indented_List (Private_Declarations (Node));
2714             end if;
2715
2716             Write_Indent_Str ("end ");
2717             Sprint_Node (Defining_Unit_Name (Node));
2718
2719          when N_Parameter_Association =>
2720             Sprint_Node_Sloc (Selector_Name (Node));
2721             Write_Str (" => ");
2722             Sprint_Node (Explicit_Actual_Parameter (Node));
2723
2724          when N_Parameter_Specification =>
2725             Set_Debug_Sloc;
2726
2727             if Write_Identifiers (Node) then
2728                Write_Str (" : ");
2729
2730                if In_Present (Node) then
2731                   Write_Str_With_Col_Check ("in ");
2732                end if;
2733
2734                if Out_Present (Node) then
2735                   Write_Str_With_Col_Check ("out ");
2736                end if;
2737
2738                --  Ada 2005 (AI-231): Parameter specification may carry null
2739                --  exclusion. Do not print it now if this is an access formal,
2740                --  it is emitted when the access definition is displayed.
2741
2742                if Null_Exclusion_Present (Node)
2743                  and then Nkind (Parameter_Type (Node)) /= N_Access_Definition
2744                then
2745                   Write_Str ("not null ");
2746                end if;
2747
2748                if Aliased_Present (Node) then
2749                   Write_Str ("aliased ");
2750                end if;
2751
2752                Sprint_Node (Parameter_Type (Node));
2753
2754                if Present (Expression (Node)) then
2755                   Write_Str (" := ");
2756                   Sprint_Node (Expression (Node));
2757                end if;
2758             else
2759                Write_Str (", ");
2760             end if;
2761
2762          when N_Pop_Constraint_Error_Label =>
2763             Write_Indent_Str ("%pop_constraint_error_label");
2764
2765          when N_Pop_Program_Error_Label =>
2766             Write_Indent_Str ("%pop_program_error_label");
2767
2768          when N_Pop_Storage_Error_Label =>
2769             Write_Indent_Str ("%pop_storage_error_label");
2770
2771          when N_Private_Extension_Declaration =>
2772             Write_Indent_Str_Sloc ("type ");
2773             Write_Id (Defining_Identifier (Node));
2774
2775             if Present (Discriminant_Specifications (Node)) then
2776                Write_Discr_Specs (Node);
2777             elsif Unknown_Discriminants_Present (Node) then
2778                Write_Str_With_Col_Check ("(<>)");
2779             end if;
2780
2781             Write_Str_With_Col_Check (" is new ");
2782             Sprint_Node (Subtype_Indication (Node));
2783
2784             if Present (Interface_List (Node)) then
2785                Write_Str_With_Col_Check (" and ");
2786                Sprint_And_List (Interface_List (Node));
2787             end if;
2788
2789             Write_Str_With_Col_Check (" with private;");
2790
2791          when N_Private_Type_Declaration =>
2792             Write_Indent_Str_Sloc ("type ");
2793             Write_Id (Defining_Identifier (Node));
2794
2795             if Present (Discriminant_Specifications (Node)) then
2796                Write_Discr_Specs (Node);
2797             elsif Unknown_Discriminants_Present (Node) then
2798                Write_Str_With_Col_Check ("(<>)");
2799             end if;
2800
2801             Write_Str (" is ");
2802
2803             if Tagged_Present (Node) then
2804                Write_Str_With_Col_Check ("tagged ");
2805             end if;
2806
2807             if Limited_Present (Node) then
2808                Write_Str_With_Col_Check ("limited ");
2809             end if;
2810
2811             Write_Str_With_Col_Check ("private;");
2812
2813          when N_Push_Constraint_Error_Label =>
2814             Write_Indent_Str ("%push_constraint_error_label (");
2815
2816             if Present (Exception_Label (Node)) then
2817                Write_Name_With_Col_Check (Chars (Exception_Label (Node)));
2818             end if;
2819
2820             Write_Str (")");
2821
2822          when N_Push_Program_Error_Label =>
2823             Write_Indent_Str ("%push_program_error_label (");
2824
2825             if Present (Exception_Label (Node)) then
2826                Write_Name_With_Col_Check (Chars (Exception_Label (Node)));
2827             end if;
2828
2829             Write_Str (")");
2830
2831          when N_Push_Storage_Error_Label =>
2832             Write_Indent_Str ("%push_storage_error_label (");
2833
2834             if Present (Exception_Label (Node)) then
2835                Write_Name_With_Col_Check (Chars (Exception_Label (Node)));
2836             end if;
2837
2838             Write_Str (")");
2839
2840          when N_Pragma =>
2841             Write_Indent_Str_Sloc ("pragma ");
2842             Write_Name_With_Col_Check (Pragma_Name_Unmapped (Node));
2843
2844             if Present (Pragma_Argument_Associations (Node)) then
2845                Sprint_Opt_Paren_Comma_List
2846                  (Pragma_Argument_Associations (Node));
2847             end if;
2848
2849             Write_Char (';');
2850
2851          when N_Pragma_Argument_Association =>
2852             Set_Debug_Sloc;
2853
2854             if Chars (Node) /= No_Name then
2855                Write_Name_With_Col_Check (Chars (Node));
2856                Write_Str (" => ");
2857             end if;
2858
2859             Sprint_Node (Expression (Node));
2860
2861          when N_Procedure_Call_Statement =>
2862             Write_Indent;
2863             Set_Debug_Sloc;
2864             Write_Subprogram_Name (Name (Node));
2865             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2866             Write_Char (';');
2867
2868          when N_Procedure_Instantiation =>
2869             Write_Indent_Str_Sloc ("procedure ");
2870             Sprint_Node (Defining_Unit_Name (Node));
2871             Write_Str_With_Col_Check (" is new ");
2872             Sprint_Node (Name (Node));
2873             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2874             Write_Char (';');
2875
2876          when N_Procedure_Specification =>
2877             Write_Str_With_Col_Check_Sloc ("procedure ");
2878             Sprint_Node (Defining_Unit_Name (Node));
2879             Write_Param_Specs (Node);
2880
2881          when N_Protected_Body =>
2882             Write_Indent_Str_Sloc ("protected body ");
2883             Write_Id (Defining_Identifier (Node));
2884             Write_Str (" is");
2885             Sprint_Indented_List (Declarations (Node));
2886             Write_Indent_Str ("end ");
2887             Write_Id (Defining_Identifier (Node));
2888             Write_Char (';');
2889
2890          when N_Protected_Body_Stub =>
2891             Write_Indent_Str_Sloc ("protected body ");
2892             Write_Id (Defining_Identifier (Node));
2893             Write_Str_With_Col_Check (" is separate;");
2894
2895          when N_Protected_Definition =>
2896             Set_Debug_Sloc;
2897             Sprint_Indented_List (Visible_Declarations (Node));
2898
2899             if Present (Private_Declarations (Node)) then
2900                Write_Indent_Str ("private");
2901                Sprint_Indented_List (Private_Declarations (Node));
2902             end if;
2903
2904             Write_Indent_Str ("end ");
2905
2906          when N_Protected_Type_Declaration =>
2907             Write_Indent_Str_Sloc ("protected type ");
2908             Sprint_Node (Defining_Identifier (Node));
2909             Write_Discr_Specs (Node);
2910
2911             if Present (Interface_List (Node)) then
2912                Write_Str (" is new ");
2913                Sprint_And_List (Interface_List (Node));
2914                Write_Str (" with ");
2915             else
2916                Write_Str (" is");
2917             end if;
2918
2919             Sprint_Node (Protected_Definition (Node));
2920             Write_Id (Defining_Identifier (Node));
2921             Write_Char (';');
2922
2923          when N_Qualified_Expression =>
2924             Sprint_Node (Subtype_Mark (Node));
2925             Write_Char_Sloc (''');
2926
2927             --  Print expression, make sure we have at least one level of
2928             --  parentheses around the expression. For cases of qualified
2929             --  expressions in the source, this is always the case, but
2930             --  for generated qualifications, there may be no explicit
2931             --  parentheses present.
2932
2933             if Paren_Count (Expression (Node)) /= 0 then
2934                Sprint_Node (Expression (Node));
2935
2936             else
2937                Write_Char ('(');
2938                Sprint_Node (Expression (Node));
2939
2940                --  Odd case, for the qualified expressions used in machine
2941                --  code the argument may be a procedure call, resulting in
2942                --  a junk semicolon before the right parent, get rid of it.
2943
2944                Write_Erase_Char (';');
2945
2946                --  Now we can add the terminating right paren
2947
2948                Write_Char (')');
2949             end if;
2950
2951          when N_Quantified_Expression =>
2952             Write_Str (" for");
2953
2954             if All_Present (Node) then
2955                Write_Str (" all ");
2956             else
2957                Write_Str (" some ");
2958             end if;
2959
2960             if Present (Iterator_Specification (Node)) then
2961                Sprint_Node (Iterator_Specification (Node));
2962             else
2963                Sprint_Node (Loop_Parameter_Specification (Node));
2964             end if;
2965
2966             Write_Str (" => ");
2967             Sprint_Node (Condition (Node));
2968
2969          when N_Raise_Expression =>
2970             declare
2971                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
2972
2973             begin
2974                --  The syntax for raise_expression does not include parentheses
2975                --  but sometimes parentheses are required, so unconditionally
2976                --  generate them here unless already present.
2977
2978                if not Has_Parens then
2979                   Write_Char ('(');
2980                end if;
2981
2982                Write_Str_With_Col_Check_Sloc ("raise ");
2983                Sprint_Node (Name (Node));
2984
2985                if Present (Expression (Node)) then
2986                   Write_Str_With_Col_Check (" with ");
2987                   Sprint_Node (Expression (Node));
2988                end if;
2989
2990                if not Has_Parens then
2991                   Write_Char (')');
2992                end if;
2993             end;
2994
2995          when N_Raise_Constraint_Error =>
2996
2997             --  This node can be used either as a subexpression or as a
2998             --  statement form. The following test is a reasonably reliable
2999             --  way to distinguish the two cases.
3000
3001             if Is_List_Member (Node)
3002               and then Nkind (Parent (Node)) not in N_Subexpr
3003             then
3004                Write_Indent;
3005             end if;
3006
3007             Write_Str_With_Col_Check_Sloc ("[constraint_error");
3008             Write_Condition_And_Reason (Node);
3009
3010          when N_Raise_Program_Error =>
3011
3012             --  This node can be used either as a subexpression or as a
3013             --  statement form. The following test is a reasonably reliable
3014             --  way to distinguish the two cases.
3015
3016             if Is_List_Member (Node)
3017               and then Nkind (Parent (Node)) not in N_Subexpr
3018             then
3019                Write_Indent;
3020             end if;
3021
3022             Write_Str_With_Col_Check_Sloc ("[program_error");
3023             Write_Condition_And_Reason (Node);
3024
3025          when N_Raise_Storage_Error =>
3026
3027             --  This node can be used either as a subexpression or as a
3028             --  statement form. The following test is a reasonably reliable
3029             --  way to distinguish the two cases.
3030
3031             if Is_List_Member (Node)
3032               and then Nkind (Parent (Node)) not in N_Subexpr
3033             then
3034                Write_Indent;
3035             end if;
3036
3037             Write_Str_With_Col_Check_Sloc ("[storage_error");
3038             Write_Condition_And_Reason (Node);
3039
3040          when N_Raise_Statement =>
3041             Write_Indent_Str_Sloc ("raise ");
3042             Sprint_Node (Name (Node));
3043
3044             if Present (Expression (Node)) then
3045                Write_Str_With_Col_Check_Sloc (" with ");
3046                Sprint_Node (Expression (Node));
3047             end if;
3048
3049             Write_Char (';');
3050
3051          when N_Range =>
3052             Sprint_Node (Low_Bound (Node));
3053             Write_Str_Sloc (" .. ");
3054             Sprint_Node (High_Bound (Node));
3055             Update_Itype (Node);
3056
3057          when N_Range_Constraint =>
3058             Write_Str_With_Col_Check_Sloc ("range ");
3059             Sprint_Node (Range_Expression (Node));
3060
3061          when N_Real_Literal =>
3062             Write_Ureal_With_Col_Check_Sloc (Realval (Node));
3063
3064          when N_Real_Range_Specification =>
3065             Write_Str_With_Col_Check_Sloc ("range ");
3066             Sprint_Node (Low_Bound (Node));
3067             Write_Str (" .. ");
3068             Sprint_Node (High_Bound (Node));
3069
3070          when N_Record_Definition =>
3071             if Abstract_Present (Node) then
3072                Write_Str_With_Col_Check ("abstract ");
3073             end if;
3074
3075             if Tagged_Present (Node) then
3076                Write_Str_With_Col_Check ("tagged ");
3077             end if;
3078
3079             if Limited_Present (Node) then
3080                Write_Str_With_Col_Check ("limited ");
3081             end if;
3082
3083             if Null_Present (Node) then
3084                Write_Str_With_Col_Check_Sloc ("null record");
3085
3086             else
3087                Write_Str_With_Col_Check_Sloc ("record");
3088                Sprint_Node (Component_List (Node));
3089                Write_Indent_Str ("end record");
3090             end if;
3091
3092          when N_Record_Representation_Clause =>
3093             Write_Indent_Str_Sloc ("for ");
3094             Sprint_Node (Identifier (Node));
3095             Write_Str_With_Col_Check (" use record ");
3096
3097             if Present (Mod_Clause (Node)) then
3098                Sprint_Node (Mod_Clause (Node));
3099             end if;
3100
3101             Sprint_Indented_List (Component_Clauses (Node));
3102             Write_Indent_Str ("end record;");
3103
3104          when N_Reference =>
3105             Sprint_Node (Prefix (Node));
3106             Write_Str_With_Col_Check_Sloc ("'reference");
3107
3108          when N_Requeue_Statement =>
3109             Write_Indent_Str_Sloc ("requeue ");
3110             Sprint_Node (Name (Node));
3111
3112             if Abort_Present (Node) then
3113                Write_Str_With_Col_Check (" with abort");
3114             end if;
3115
3116             Write_Char (';');
3117
3118          --  Don't we want to print more detail???
3119
3120          --  Doc of this extended syntax belongs in sinfo.ads and/or
3121          --  sprint.ads ???
3122
3123          when N_SCIL_Dispatch_Table_Tag_Init =>
3124             Write_Indent_Str ("[N_SCIL_Dispatch_Table_Tag_Init]");
3125
3126          when N_SCIL_Dispatching_Call =>
3127             Write_Indent_Str ("[N_SCIL_Dispatching_Node]");
3128
3129          when N_SCIL_Membership_Test =>
3130             Write_Indent_Str ("[N_SCIL_Membership_Test]");
3131
3132          when N_Simple_Return_Statement =>
3133             if Present (Expression (Node)) then
3134                Write_Indent_Str_Sloc ("return ");
3135                Sprint_Node (Expression (Node));
3136                Write_Char (';');
3137             else
3138                Write_Indent_Str_Sloc ("return;");
3139             end if;
3140
3141          when N_Selective_Accept =>
3142             Write_Indent_Str_Sloc ("select");
3143
3144             declare
3145                Alt_Node : Node_Id;
3146             begin
3147                Alt_Node := First (Select_Alternatives (Node));
3148                loop
3149                   Indent_Begin;
3150                   Sprint_Node (Alt_Node);
3151                   Indent_End;
3152                   Next (Alt_Node);
3153                   exit when No (Alt_Node);
3154                   Write_Indent_Str ("or");
3155                end loop;
3156             end;
3157
3158             if Present (Else_Statements (Node)) then
3159                Write_Indent_Str ("else");
3160                Sprint_Indented_List (Else_Statements (Node));
3161             end if;
3162
3163             Write_Indent_Str ("end select;");
3164
3165          when N_Signed_Integer_Type_Definition =>
3166             Write_Str_With_Col_Check_Sloc ("range ");
3167             Sprint_Node (Low_Bound (Node));
3168             Write_Str (" .. ");
3169             Sprint_Node (High_Bound (Node));
3170
3171          when N_Single_Protected_Declaration =>
3172             Write_Indent_Str_Sloc ("protected ");
3173             Write_Id (Defining_Identifier (Node));
3174             Write_Str (" is");
3175             Sprint_Node (Protected_Definition (Node));
3176             Write_Id (Defining_Identifier (Node));
3177             Write_Char (';');
3178
3179          when N_Single_Task_Declaration =>
3180             Write_Indent_Str_Sloc ("task ");
3181             Sprint_Node (Defining_Identifier (Node));
3182
3183             if Present (Task_Definition (Node)) then
3184                Write_Str (" is");
3185                Sprint_Node (Task_Definition (Node));
3186             end if;
3187
3188             Write_Char (';');
3189
3190          when N_Selected_Component =>
3191             Sprint_Node (Prefix (Node));
3192             Write_Char_Sloc ('.');
3193             Sprint_Node (Selector_Name (Node));
3194
3195          when N_Slice =>
3196             Set_Debug_Sloc;
3197             Sprint_Node (Prefix (Node));
3198             Write_Str_With_Col_Check (" (");
3199             Sprint_Node (Discrete_Range (Node));
3200             Write_Char (')');
3201
3202          when N_String_Literal =>
3203             if String_Length (Strval (Node)) + Column > Sprint_Line_Limit then
3204                Write_Indent_Str ("  ");
3205             end if;
3206
3207             Set_Debug_Sloc;
3208             Write_String_Table_Entry (Strval (Node));
3209
3210          when N_Subprogram_Body =>
3211
3212             --  Output extra blank line unless we are in freeze actions
3213
3214             if Freeze_Indent = 0 then
3215                Extra_Blank_Line;
3216             end if;
3217
3218             Write_Indent;
3219
3220             if Present (Corresponding_Spec (Node)) then
3221                Sprint_Node_Sloc (Parent (Corresponding_Spec (Node)));
3222             else
3223                Sprint_Node_Sloc (Specification (Node));
3224             end if;
3225
3226             Write_Str (" is");
3227
3228             Sprint_Indented_List (Declarations (Node));
3229             Write_Indent_Str ("begin");
3230             Sprint_Node (Handled_Statement_Sequence (Node));
3231
3232             Write_Indent_Str ("end ");
3233
3234             Sprint_End_Label
3235               (Handled_Statement_Sequence (Node),
3236                  Defining_Unit_Name (Specification (Node)));
3237             Write_Char (';');
3238
3239             if Is_List_Member (Node)
3240               and then Present (Next (Node))
3241               and then Nkind (Next (Node)) /= N_Subprogram_Body
3242             then
3243                Write_Indent;
3244             end if;
3245
3246          when N_Subprogram_Body_Stub =>
3247             Write_Indent;
3248             Sprint_Node_Sloc (Specification (Node));
3249             Write_Str_With_Col_Check (" is separate;");
3250
3251          when N_Subprogram_Declaration =>
3252             Write_Indent;
3253             Sprint_Node_Sloc (Specification (Node));
3254
3255             if Nkind (Specification (Node)) = N_Procedure_Specification
3256               and then Null_Present (Specification (Node))
3257             then
3258                Write_Str_With_Col_Check (" is null");
3259             end if;
3260
3261             Write_Char (';');
3262
3263          when N_Subprogram_Renaming_Declaration =>
3264             Write_Indent;
3265             Sprint_Node (Specification (Node));
3266             Write_Str_With_Col_Check_Sloc (" renames ");
3267             Sprint_Node (Name (Node));
3268             Write_Char (';');
3269
3270          when N_Subtype_Declaration =>
3271             Write_Indent_Str_Sloc ("subtype ");
3272             Sprint_Node (Defining_Identifier (Node));
3273             Write_Str (" is ");
3274
3275             --  Ada 2005 (AI-231)
3276
3277             if Null_Exclusion_Present (Node) then
3278                Write_Str ("not null ");
3279             end if;
3280
3281             Sprint_Node (Subtype_Indication (Node));
3282             Write_Char (';');
3283
3284          when N_Subtype_Indication =>
3285             Sprint_Node_Sloc (Subtype_Mark (Node));
3286             Write_Char (' ');
3287             Sprint_Node (Constraint (Node));
3288
3289          when N_Subunit =>
3290             Write_Indent_Str_Sloc ("separate (");
3291             Sprint_Node (Name (Node));
3292             Write_Char (')');
3293             Extra_Blank_Line;
3294             Sprint_Node (Proper_Body (Node));
3295
3296          when N_Target_Name =>
3297             Write_Char ('@');
3298
3299          when N_Task_Body =>
3300             Write_Indent_Str_Sloc ("task body ");
3301             Write_Id (Defining_Identifier (Node));
3302             Write_Str (" is");
3303             Sprint_Indented_List (Declarations (Node));
3304             Write_Indent_Str ("begin");
3305             Sprint_Node (Handled_Statement_Sequence (Node));
3306             Write_Indent_Str ("end ");
3307             Sprint_End_Label
3308               (Handled_Statement_Sequence (Node), Defining_Identifier (Node));
3309             Write_Char (';');
3310
3311          when N_Task_Body_Stub =>
3312             Write_Indent_Str_Sloc ("task body ");
3313             Write_Id (Defining_Identifier (Node));
3314             Write_Str_With_Col_Check (" is separate;");
3315
3316          when N_Task_Definition =>
3317             Set_Debug_Sloc;
3318             Sprint_Indented_List (Visible_Declarations (Node));
3319
3320             if Present (Private_Declarations (Node)) then
3321                Write_Indent_Str ("private");
3322                Sprint_Indented_List (Private_Declarations (Node));
3323             end if;
3324
3325             Write_Indent_Str ("end ");
3326             Sprint_End_Label (Node, Defining_Identifier (Parent (Node)));
3327
3328          when N_Task_Type_Declaration =>
3329             Write_Indent_Str_Sloc ("task type ");
3330             Sprint_Node (Defining_Identifier (Node));
3331             Write_Discr_Specs (Node);
3332
3333             if Present (Interface_List (Node)) then
3334                Write_Str (" is new ");
3335                Sprint_And_List (Interface_List (Node));
3336             end if;
3337
3338             if Present (Task_Definition (Node)) then
3339                if No (Interface_List (Node)) then
3340                   Write_Str (" is");
3341                else
3342                   Write_Str (" with ");
3343                end if;
3344
3345                Sprint_Node (Task_Definition (Node));
3346             end if;
3347
3348             Write_Char (';');
3349
3350          when N_Terminate_Alternative =>
3351             Sprint_Node_List (Pragmas_Before (Node));
3352             Write_Indent;
3353
3354             if Present (Condition (Node)) then
3355                Write_Str_With_Col_Check ("when ");
3356                Sprint_Node (Condition (Node));
3357                Write_Str (" => ");
3358             end if;
3359
3360             Write_Str_With_Col_Check_Sloc ("terminate;");
3361             Sprint_Node_List (Pragmas_After (Node));
3362
3363          when N_Timed_Entry_Call =>
3364             Write_Indent_Str_Sloc ("select");
3365             Indent_Begin;
3366             Sprint_Node (Entry_Call_Alternative (Node));
3367             Indent_End;
3368             Write_Indent_Str ("or");
3369             Indent_Begin;
3370             Sprint_Node (Delay_Alternative (Node));
3371             Indent_End;
3372             Write_Indent_Str ("end select;");
3373
3374          when N_Triggering_Alternative =>
3375             Sprint_Node_List (Pragmas_Before (Node));
3376             Sprint_Node_Sloc (Triggering_Statement (Node));
3377             Sprint_Node_List (Statements (Node));
3378
3379          when N_Type_Conversion =>
3380             Set_Debug_Sloc;
3381             Sprint_Node (Subtype_Mark (Node));
3382             Col_Check (4);
3383
3384             if Conversion_OK (Node) then
3385                Write_Char ('?');
3386             end if;
3387
3388             if Float_Truncate (Node) then
3389                Write_Char ('^');
3390             end if;
3391
3392             if Rounded_Result (Node) then
3393                Write_Char ('@');
3394             end if;
3395
3396             Write_Char ('(');
3397             Sprint_Node (Expression (Node));
3398             Write_Char (')');
3399
3400          when N_Unchecked_Expression =>
3401             Col_Check (10);
3402             Write_Str ("`(");
3403             Sprint_Node_Sloc (Expression (Node));
3404             Write_Char (')');
3405
3406          when N_Unchecked_Type_Conversion =>
3407             Sprint_Node (Subtype_Mark (Node));
3408             Write_Char ('!');
3409             Write_Str_With_Col_Check ("(");
3410             Sprint_Node_Sloc (Expression (Node));
3411             Write_Char (')');
3412
3413          when N_Unconstrained_Array_Definition =>
3414             Write_Str_With_Col_Check_Sloc ("array (");
3415
3416             declare
3417                Node1 : Node_Id;
3418             begin
3419                Node1 := First (Subtype_Marks (Node));
3420                loop
3421                   Sprint_Node (Node1);
3422                   Write_Str_With_Col_Check (" range <>");
3423                   Next (Node1);
3424                   exit when Node1 = Empty;
3425                   Write_Str (", ");
3426                end loop;
3427             end;
3428
3429             Write_Str (") of ");
3430             Sprint_Node (Component_Definition (Node));
3431
3432          when N_Unused_At_Start | N_Unused_At_End =>
3433             Write_Indent_Str ("***** Error, unused node encountered *****");
3434             Write_Eol;
3435
3436          when N_Use_Package_Clause =>
3437             Write_Indent_Str_Sloc ("use ");
3438             Sprint_Comma_List (Names (Node));
3439             Write_Char (';');
3440
3441          when N_Use_Type_Clause =>
3442             Write_Indent_Str_Sloc ("use type ");
3443             Sprint_Comma_List (Subtype_Marks (Node));
3444             Write_Char (';');
3445
3446          when N_Validate_Unchecked_Conversion =>
3447             Write_Indent_Str_Sloc ("validate unchecked_conversion (");
3448             Sprint_Node (Source_Type (Node));
3449             Write_Str (", ");
3450             Sprint_Node (Target_Type (Node));
3451             Write_Str (");");
3452
3453          when N_Variant =>
3454             Write_Indent_Str_Sloc ("when ");
3455             Sprint_Bar_List (Discrete_Choices (Node));
3456             Write_Str (" => ");
3457             Sprint_Node (Component_List (Node));
3458
3459          when N_Variant_Part =>
3460             Indent_Begin;
3461             Write_Indent_Str_Sloc ("case ");
3462             Sprint_Node (Name (Node));
3463             Write_Str (" is ");
3464             Sprint_Indented_List (Variants (Node));
3465             Write_Indent_Str ("end case");
3466             Indent_End;
3467
3468          when N_With_Clause =>
3469
3470             --  Special test, if we are dumping the original tree only,
3471             --  then we want to eliminate the bogus with clauses that
3472             --  correspond to the non-existent children of Text_IO.
3473
3474             if Dump_Original_Only
3475               and then Is_Text_IO_Special_Unit (Name (Node))
3476             then
3477                null;
3478
3479             --  Normal case, output the with clause
3480
3481             else
3482                if First_Name (Node) or else not Dump_Original_Only then
3483
3484                   --  Ada 2005 (AI-50217): Print limited with_clauses
3485
3486                   if Private_Present (Node) and Limited_Present (Node) then
3487                      Write_Indent_Str ("limited private with ");
3488
3489                   elsif Private_Present (Node) then
3490                      Write_Indent_Str ("private with ");
3491
3492                   elsif Limited_Present (Node) then
3493                      Write_Indent_Str ("limited with ");
3494
3495                   else
3496                      Write_Indent_Str ("with ");
3497                   end if;
3498
3499                else
3500                   Write_Str (", ");
3501                end if;
3502
3503                Sprint_Node_Sloc (Name (Node));
3504
3505                if Last_Name (Node) or else not Dump_Original_Only then
3506                   Write_Char (';');
3507                end if;
3508             end if;
3509       end case;
3510
3511       --  Print aspects, except for special case of package declaration,
3512       --  where the aspects are printed inside the package specification.
3513
3514       if Has_Aspects (Node)
3515          and then not Nkind_In (Node, N_Package_Declaration,
3516                                       N_Generic_Package_Declaration)
3517       then
3518          Sprint_Aspect_Specifications (Node, Semicolon => True);
3519       end if;
3520
3521       if Nkind (Node) in N_Subexpr
3522         and then Do_Range_Check (Node)
3523       then
3524          Write_Str ("}");
3525       end if;
3526
3527       for J in 1 .. Paren_Count (Node) loop
3528          Write_Char (')');
3529       end loop;
3530
3531       Dump_Node := Save_Dump_Node;
3532    end Sprint_Node_Actual;
3533
3534    ----------------------
3535    -- Sprint_Node_List --
3536    ----------------------
3537
3538    procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False) is
3539       Node : Node_Id;
3540
3541    begin
3542       if Is_Non_Empty_List (List) then
3543          Node := First (List);
3544
3545          loop
3546             Sprint_Node (Node);
3547             Next (Node);
3548             exit when Node = Empty;
3549          end loop;
3550       end if;
3551
3552       if New_Lines and then Column /= 1 then
3553          Write_Eol;
3554       end if;
3555    end Sprint_Node_List;
3556
3557    ----------------------
3558    -- Sprint_Node_Sloc --
3559    ----------------------
3560
3561    procedure Sprint_Node_Sloc (Node : Node_Id) is
3562    begin
3563       Sprint_Node (Node);
3564
3565       if Debug_Generated_Code and then Present (Dump_Node) then
3566          Set_Sloc (Dump_Node, Sloc (Node));
3567          Dump_Node := Empty;
3568       end if;
3569    end Sprint_Node_Sloc;
3570
3571    ---------------------
3572    -- Sprint_Opt_Node --
3573    ---------------------
3574
3575    procedure Sprint_Opt_Node (Node : Node_Id) is
3576    begin
3577       if Present (Node) then
3578          Write_Char (' ');
3579          Sprint_Node (Node);
3580       end if;
3581    end Sprint_Opt_Node;
3582
3583    --------------------------
3584    -- Sprint_Opt_Node_List --
3585    --------------------------
3586
3587    procedure Sprint_Opt_Node_List (List : List_Id) is
3588    begin
3589       if Present (List) then
3590          Sprint_Node_List (List);
3591       end if;
3592    end Sprint_Opt_Node_List;
3593
3594    ---------------------------------
3595    -- Sprint_Opt_Paren_Comma_List --
3596    ---------------------------------
3597
3598    procedure Sprint_Opt_Paren_Comma_List (List : List_Id) is
3599    begin
3600       if Is_Non_Empty_List (List) then
3601          Write_Char (' ');
3602          Sprint_Paren_Comma_List (List);
3603       end if;
3604    end Sprint_Opt_Paren_Comma_List;
3605
3606    -----------------------------
3607    -- Sprint_Paren_Comma_List --
3608    -----------------------------
3609
3610    procedure Sprint_Paren_Comma_List (List : List_Id) is
3611       N           : Node_Id;
3612       Node_Exists : Boolean := False;
3613
3614    begin
3615
3616       if Is_Non_Empty_List (List) then
3617
3618          if Dump_Original_Only then
3619             N := First (List);
3620             while Present (N) loop
3621                if not Is_Rewrite_Insertion (N) then
3622                   Node_Exists := True;
3623                   exit;
3624                end if;
3625
3626                Next (N);
3627             end loop;
3628
3629             if not Node_Exists then
3630                return;
3631             end if;
3632          end if;
3633
3634          Write_Str_With_Col_Check ("(");
3635          Sprint_Comma_List (List);
3636          Write_Char (')');
3637       end if;
3638    end Sprint_Paren_Comma_List;
3639
3640    ----------------------
3641    -- Sprint_Right_Opnd --
3642    ----------------------
3643
3644    procedure Sprint_Right_Opnd (N : Node_Id) is
3645       Opnd : constant Node_Id := Right_Opnd (N);
3646
3647    begin
3648       if Paren_Count (Opnd) /= 0
3649         or else Op_Prec (Nkind (Opnd)) > Op_Prec (Nkind (N))
3650       then
3651          Sprint_Node (Opnd);
3652
3653       else
3654          Write_Char ('(');
3655          Sprint_Node (Opnd);
3656          Write_Char (')');
3657       end if;
3658    end Sprint_Right_Opnd;
3659
3660    ------------------
3661    -- Update_Itype --
3662    ------------------
3663
3664    procedure Update_Itype (Node : Node_Id) is
3665    begin
3666       if Present (Etype (Node))
3667         and then Is_Itype (Etype (Node))
3668         and then Debug_Generated_Code
3669       then
3670          Set_Sloc (Etype (Node), Sloc (Node));
3671       end if;
3672    end Update_Itype;
3673
3674    ---------------------
3675    -- Write_Char_Sloc --
3676    ---------------------
3677
3678    procedure Write_Char_Sloc (C : Character) is
3679    begin
3680       if Debug_Generated_Code and then C /= ' ' then
3681          Set_Debug_Sloc;
3682       end if;
3683
3684       Write_Char (C);
3685    end Write_Char_Sloc;
3686
3687    --------------------------------
3688    -- Write_Condition_And_Reason --
3689    --------------------------------
3690
3691    procedure Write_Condition_And_Reason (Node : Node_Id) is
3692       Cond  : constant Node_Id := Condition (Node);
3693       Image : constant String  := RT_Exception_Code'Image
3694                                     (RT_Exception_Code'Val
3695                                        (UI_To_Int (Reason (Node))));
3696
3697    begin
3698       if Present (Cond) then
3699
3700          --  If condition is a single entity, or NOT with a single entity,
3701          --  output all on one line, since it will likely fit just fine.
3702
3703          if Is_Entity_Name (Cond)
3704            or else (Nkind (Cond) = N_Op_Not
3705                      and then Is_Entity_Name (Right_Opnd (Cond)))
3706          then
3707             Write_Str_With_Col_Check (" when ");
3708             Sprint_Node (Cond);
3709             Write_Char (' ');
3710
3711             --  Otherwise for more complex condition, multiple lines
3712
3713          else
3714             Write_Str_With_Col_Check (" when");
3715             Indent := Indent + 2;
3716             Write_Indent;
3717             Sprint_Node (Cond);
3718             Write_Indent;
3719             Indent := Indent - 2;
3720          end if;
3721
3722       --  If no condition, just need a space (all on one line)
3723
3724       else
3725          Write_Char (' ');
3726       end if;
3727
3728       --  Write the reason
3729
3730       Write_Char ('"');
3731
3732       for J in 4 .. Image'Last loop
3733          if Image (J) = '_' then
3734             Write_Char (' ');
3735          else
3736             Write_Char (Fold_Lower (Image (J)));
3737          end if;
3738       end loop;
3739
3740       Write_Str ("""]");
3741    end Write_Condition_And_Reason;
3742
3743    --------------------------------
3744    -- Write_Corresponding_Source --
3745    --------------------------------
3746
3747    procedure Write_Corresponding_Source (S : String) is
3748       Loc : Source_Ptr;
3749       Src : Source_Buffer_Ptr;
3750
3751    begin
3752       --  Ignore if not in dump source text mode, or if in freeze actions
3753
3754       if Dump_Source_Text and then Freeze_Indent = 0 then
3755
3756          --  Ignore null string
3757
3758          if S = "" then
3759             return;
3760          end if;
3761
3762          --  Ignore space or semicolon at end of given string
3763
3764          if S (S'Last) = ' ' or else S (S'Last) = ';' then
3765             Write_Corresponding_Source (S (S'First .. S'Last - 1));
3766             return;
3767          end if;
3768
3769          --  Loop to look at next lines not yet printed in source file
3770
3771          for L in
3772            Last_Line_Printed + 1 .. Last_Source_Line (Current_Source_File)
3773          loop
3774             Src := Source_Text (Current_Source_File);
3775             Loc := Line_Start (L, Current_Source_File);
3776
3777             --  If comment, keep looking
3778
3779             if Src (Loc .. Loc + 1) = "--" then
3780                null;
3781
3782             --  Search to first non-blank
3783
3784             else
3785                while Src (Loc) not in Line_Terminator loop
3786
3787                   --  Non-blank found
3788
3789                   if Src (Loc) /= ' ' and then Src (Loc) /= ASCII.HT then
3790
3791                      --  Loop through characters in string to see if we match
3792
3793                      for J in S'Range loop
3794
3795                         --  If mismatch, then not the case we are looking for
3796
3797                         if Src (Loc) /= S (J) then
3798                            return;
3799                         end if;
3800
3801                         Loc := Loc + 1;
3802                      end loop;
3803
3804                      --  If we fall through, string matched, if white space or
3805                      --  semicolon after the matched string, this is the case
3806                      --  we are looking for.
3807
3808                      if Src (Loc) in Line_Terminator
3809                        or else Src (Loc) = ' '
3810                        or else Src (Loc) = ASCII.HT
3811                        or else Src (Loc) = ';'
3812                      then
3813                         --  So output source lines up to and including this one
3814
3815                         Write_Source_Lines (L);
3816                         return;
3817                      end if;
3818                   end if;
3819
3820                   Loc := Loc + 1;
3821                end loop;
3822             end if;
3823
3824          --  Line was all blanks, or a comment line, keep looking
3825
3826          end loop;
3827       end if;
3828    end Write_Corresponding_Source;
3829
3830    -----------------------
3831    -- Write_Discr_Specs --
3832    -----------------------
3833
3834    procedure Write_Discr_Specs (N : Node_Id) is
3835       Specs : List_Id;
3836       Spec  : Node_Id;
3837
3838    begin
3839       Specs := Discriminant_Specifications (N);
3840
3841       if Present (Specs) then
3842          Write_Str_With_Col_Check (" (");
3843          Spec := First (Specs);
3844
3845          loop
3846             Sprint_Node (Spec);
3847             Next (Spec);
3848             exit when Spec = Empty;
3849
3850             --  Add semicolon, unless we are printing original tree and the
3851             --  next specification is part of a list (but not the first
3852             --  element of that list)
3853
3854             if not Dump_Original_Only or else not Prev_Ids (Spec) then
3855                Write_Str ("; ");
3856             end if;
3857          end loop;
3858
3859          Write_Char (')');
3860       end if;
3861    end Write_Discr_Specs;
3862
3863    -----------------
3864    -- Write_Ekind --
3865    -----------------
3866
3867    procedure Write_Ekind (E : Entity_Id) is
3868       S : constant String := Entity_Kind'Image (Ekind (E));
3869
3870    begin
3871       Name_Len := S'Length;
3872       Name_Buffer (1 .. Name_Len) := S;
3873       Set_Casing (Mixed_Case);
3874       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3875    end Write_Ekind;
3876
3877    --------------
3878    -- Write_Id --
3879    --------------
3880
3881    procedure Write_Id (N : Node_Id) is
3882    begin
3883       --  Deal with outputting Itype
3884
3885       --  Note: if we are printing the full tree with -gnatds, then we may
3886       --  end up picking up the Associated_Node link from a generic template
3887       --  here which overlaps the Entity field, but as documented, Write_Itype
3888       --  is defended against junk calls.
3889
3890       if Nkind (N) in N_Entity then
3891          Write_Itype (N);
3892       elsif Nkind (N) in N_Has_Entity then
3893          Write_Itype (Entity (N));
3894       end if;
3895
3896       --  Case of a defining identifier
3897
3898       if Nkind (N) = N_Defining_Identifier then
3899
3900          --  If defining identifier has an interface name (and no
3901          --  address clause), then we output the interface name.
3902
3903          if (Is_Imported (N) or else Is_Exported (N))
3904            and then Present (Interface_Name (N))
3905            and then No (Address_Clause (N))
3906          then
3907             String_To_Name_Buffer (Strval (Interface_Name (N)));
3908             Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3909
3910          --  If no interface name (or inactive because there was
3911          --  an address clause), then just output the Chars name.
3912
3913          else
3914             Write_Name_With_Col_Check (Chars (N));
3915          end if;
3916
3917       --  Case of selector of an expanded name where the expanded name
3918       --  has an associated entity, output this entity. Check that the
3919       --  entity or associated node is of the right kind, see above.
3920
3921       elsif Nkind (Parent (N)) = N_Expanded_Name
3922         and then Selector_Name (Parent (N)) = N
3923         and then Present (Entity_Or_Associated_Node (Parent (N)))
3924         and then Nkind (Entity (Parent (N))) in N_Entity
3925       then
3926          Write_Id (Entity (Parent (N)));
3927
3928       --  For any other node with an associated entity, output it
3929
3930       elsif Nkind (N) in N_Has_Entity
3931         and then Present (Entity_Or_Associated_Node (N))
3932         and then Nkind (Entity_Or_Associated_Node (N)) in N_Entity
3933       then
3934          Write_Id (Entity (N));
3935
3936       --  All other cases, we just print the Chars field
3937
3938       else
3939          Write_Name_With_Col_Check (Chars (N));
3940       end if;
3941    end Write_Id;
3942
3943    -----------------------
3944    -- Write_Identifiers --
3945    -----------------------
3946
3947    function Write_Identifiers (Node : Node_Id) return Boolean is
3948    begin
3949       Sprint_Node (Defining_Identifier (Node));
3950       Update_Itype (Defining_Identifier (Node));
3951
3952       --  The remainder of the declaration must be printed unless we are
3953       --  printing the original tree and this is not the last identifier
3954
3955       return
3956          not Dump_Original_Only or else not More_Ids (Node);
3957
3958    end Write_Identifiers;
3959
3960    ------------------------
3961    -- Write_Implicit_Def --
3962    ------------------------
3963
3964    procedure Write_Implicit_Def (E : Entity_Id) is
3965       Ind : Node_Id;
3966
3967    begin
3968       case Ekind (E) is
3969          when E_Array_Subtype =>
3970             Write_Str_With_Col_Check ("subtype ");
3971             Write_Id (E);
3972             Write_Str_With_Col_Check (" is ");
3973             Write_Id (Base_Type (E));
3974             Write_Str_With_Col_Check (" (");
3975
3976             Ind := First_Index (E);
3977             while Present (Ind) loop
3978                Sprint_Node (Ind);
3979                Next_Index (Ind);
3980
3981                if Present (Ind) then
3982                   Write_Str (", ");
3983                end if;
3984             end loop;
3985
3986             Write_Str (");");
3987
3988          when E_Enumeration_Subtype
3989             | E_Signed_Integer_Subtype
3990          =>
3991             Write_Str_With_Col_Check ("subtype ");
3992             Write_Id (E);
3993             Write_Str (" is ");
3994             Write_Id (Etype (E));
3995             Write_Str_With_Col_Check (" range ");
3996             Sprint_Node (Scalar_Range (E));
3997             Write_Str (";");
3998
3999          when others =>
4000             Write_Str_With_Col_Check ("type ");
4001             Write_Id (E);
4002             Write_Str_With_Col_Check (" is <");
4003             Write_Ekind (E);
4004             Write_Str (">;");
4005       end case;
4006    end Write_Implicit_Def;
4007
4008    ------------------
4009    -- Write_Indent --
4010    ------------------
4011
4012    procedure Write_Indent is
4013       Loc : constant Source_Ptr := Sloc (Dump_Node);
4014
4015    begin
4016       if Indent_Annull_Flag then
4017          Indent_Annull_Flag := False;
4018       else
4019          --  Deal with Dump_Source_Text output. Note that we ignore implicit
4020          --  label declarations, since they typically have the sloc of the
4021          --  corresponding label, which really messes up the -gnatL output.
4022
4023          if Dump_Source_Text
4024            and then Loc > No_Location
4025            and then Nkind (Dump_Node) /= N_Implicit_Label_Declaration
4026          then
4027             if Get_Source_File_Index (Loc) = Current_Source_File then
4028                Write_Source_Lines
4029                  (Get_Physical_Line_Number (Sloc (Dump_Node)));
4030             end if;
4031          end if;
4032
4033          Write_Eol;
4034
4035          for J in 1 .. Indent loop
4036             Write_Char (' ');
4037          end loop;
4038       end if;
4039    end Write_Indent;
4040
4041    ------------------------------
4042    -- Write_Indent_Identifiers --
4043    ------------------------------
4044
4045    function Write_Indent_Identifiers (Node : Node_Id) return Boolean is
4046    begin
4047       --  We need to start a new line for every node, except in the case
4048       --  where we are printing the original tree and this is not the first
4049       --  defining identifier in the list.
4050
4051       if not Dump_Original_Only or else not Prev_Ids (Node) then
4052          Write_Indent;
4053
4054       --  If printing original tree and this is not the first defining
4055       --  identifier in the list, then the previous call to this procedure
4056       --  printed only the name, and we add a comma to separate the names.
4057
4058       else
4059          Write_Str (", ");
4060       end if;
4061
4062       Sprint_Node (Defining_Identifier (Node));
4063
4064       --  The remainder of the declaration must be printed unless we are
4065       --  printing the original tree and this is not the last identifier
4066
4067       return
4068          not Dump_Original_Only or else not More_Ids (Node);
4069    end Write_Indent_Identifiers;
4070
4071    -----------------------------------
4072    -- Write_Indent_Identifiers_Sloc --
4073    -----------------------------------
4074
4075    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean is
4076    begin
4077       --  We need to start a new line for every node, except in the case
4078       --  where we are printing the original tree and this is not the first
4079       --  defining identifier in the list.
4080
4081       if not Dump_Original_Only or else not Prev_Ids (Node) then
4082          Write_Indent;
4083
4084       --  If printing original tree and this is not the first defining
4085       --  identifier in the list, then the previous call to this procedure
4086       --  printed only the name, and we add a comma to separate the names.
4087
4088       else
4089          Write_Str (", ");
4090       end if;
4091
4092       Set_Debug_Sloc;
4093       Sprint_Node (Defining_Identifier (Node));
4094
4095       --  The remainder of the declaration must be printed unless we are
4096       --  printing the original tree and this is not the last identifier
4097
4098       return not Dump_Original_Only or else not More_Ids (Node);
4099    end Write_Indent_Identifiers_Sloc;
4100
4101    ----------------------
4102    -- Write_Indent_Str --
4103    ----------------------
4104
4105    procedure Write_Indent_Str (S : String) is
4106    begin
4107       Write_Corresponding_Source (S);
4108       Write_Indent;
4109       Write_Str (S);
4110    end Write_Indent_Str;
4111
4112    ---------------------------
4113    -- Write_Indent_Str_Sloc --
4114    ---------------------------
4115
4116    procedure Write_Indent_Str_Sloc (S : String) is
4117    begin
4118       Write_Corresponding_Source (S);
4119       Write_Indent;
4120       Write_Str_Sloc (S);
4121    end Write_Indent_Str_Sloc;
4122
4123    -----------------
4124    -- Write_Itype --
4125    -----------------
4126
4127    procedure Write_Itype (Typ : Entity_Id) is
4128
4129       procedure Write_Header (T : Boolean := True);
4130       --  Write type if T is True, subtype if T is false
4131
4132       ------------------
4133       -- Write_Header --
4134       ------------------
4135
4136       procedure Write_Header (T : Boolean := True) is
4137       begin
4138          if T then
4139             Write_Str ("[type ");
4140          else
4141             Write_Str ("[subtype ");
4142          end if;
4143
4144          Write_Name_With_Col_Check (Chars (Typ));
4145          Write_Str (" is ");
4146       end Write_Header;
4147
4148    --  Start of processing for Write_Itype
4149
4150    begin
4151       if Nkind (Typ) in N_Entity
4152         and then Is_Itype (Typ)
4153         and then not Itype_Printed (Typ)
4154       then
4155          --  Itype to be printed
4156
4157          declare
4158             B : constant Node_Id := Etype (Typ);
4159             X : Node_Id;
4160             P : constant Node_Id := Parent (Typ);
4161
4162             S : constant Saved_Output_Buffer := Save_Output_Buffer;
4163             --  Save current output buffer
4164
4165             Old_Sloc : Source_Ptr;
4166             --  Save sloc of related node, so it is not modified when
4167             --  printing with -gnatD.
4168
4169          begin
4170             --  Write indentation at start of line
4171
4172             for J in 1 .. Indent loop
4173                Write_Char (' ');
4174             end loop;
4175
4176             --  If we have a constructed declaration for the itype, print it
4177
4178             if Present (P)
4179               and then Nkind (P) in N_Declaration
4180               and then Defining_Entity (P) = Typ
4181             then
4182                --  We must set Itype_Printed true before the recursive call to
4183                --  print the node, otherwise we get an infinite recursion.
4184
4185                Set_Itype_Printed (Typ, True);
4186
4187                --  Write the declaration enclosed in [], avoiding new line
4188                --  at start of declaration, and semicolon at end.
4189
4190                --  Note: The itype may be imported from another unit, in which
4191                --  case we do not want to modify the Sloc of the declaration.
4192                --  Otherwise the itype may appear to be in the current unit,
4193                --  and the back-end will reject a reference out of scope.
4194
4195                Write_Char ('[');
4196                Indent_Annull_Flag := True;
4197                Old_Sloc := Sloc (P);
4198                Sprint_Node (P);
4199                Set_Sloc (P, Old_Sloc);
4200                Write_Erase_Char (';');
4201
4202             --  If no constructed declaration, then we have to concoct the
4203             --  source corresponding to the type entity that we have at hand.
4204
4205             else
4206                case Ekind (Typ) is
4207
4208                   --  Access types and subtypes
4209
4210                   when Access_Kind =>
4211                      Write_Header (Ekind (Typ) = E_Access_Type);
4212
4213                      if Can_Never_Be_Null (Typ) then
4214                         Write_Str ("not null ");
4215                      end if;
4216
4217                      Write_Str ("access ");
4218
4219                      if Is_Access_Constant (Typ) then
4220                         Write_Str ("constant ");
4221                      end if;
4222
4223                      Write_Id (Directly_Designated_Type (Typ));
4224
4225                   --  Array types
4226
4227                   when E_Array_Type =>
4228                      Write_Header;
4229                      Write_Str ("array (");
4230
4231                      X := First_Index (Typ);
4232                      loop
4233                         Sprint_Node (X);
4234
4235                         if not Is_Constrained (Typ) then
4236                            Write_Str (" range <>");
4237                         end if;
4238
4239                         Next_Index (X);
4240                         exit when No (X);
4241                         Write_Str (", ");
4242                      end loop;
4243
4244                      Write_Str (") of ");
4245                      X := Component_Type (Typ);
4246
4247                      --  Preserve sloc of component type, which is defined
4248                      --  elsewhere than the itype (see comment above).
4249
4250                      Old_Sloc := Sloc (X);
4251                      Sprint_Node (X);
4252                      Set_Sloc (X, Old_Sloc);
4253
4254                      --  Array subtypes
4255
4256                      --  Preserve Sloc of index subtypes, as above
4257
4258                   when E_Array_Subtype =>
4259                      Write_Header (False);
4260                      Write_Id (Etype (Typ));
4261                      Write_Str (" (");
4262
4263                      X := First_Index (Typ);
4264                      loop
4265                         Old_Sloc := Sloc (X);
4266                         Sprint_Node (X);
4267                         Set_Sloc (X, Old_Sloc);
4268                         Next_Index (X);
4269                         exit when No (X);
4270                         Write_Str (", ");
4271                      end loop;
4272
4273                      Write_Char (')');
4274
4275                   --  Signed integer types, and modular integer subtypes,
4276                   --  and also enumeration subtypes.
4277
4278                   when E_Enumeration_Subtype
4279                      | E_Modular_Integer_Subtype
4280                      | E_Signed_Integer_Subtype
4281                      | E_Signed_Integer_Type
4282                   =>
4283                      Write_Header (Ekind (Typ) = E_Signed_Integer_Type);
4284
4285                      if Ekind (Typ) = E_Signed_Integer_Type then
4286                         Write_Str ("new ");
4287                      end if;
4288
4289                      Write_Id (B);
4290
4291                      --  Print bounds if different from base type
4292
4293                      declare
4294                         L  : constant Node_Id := Type_Low_Bound (Typ);
4295                         H  : constant Node_Id := Type_High_Bound (Typ);
4296                         LE : Node_Id;
4297                         HE : Node_Id;
4298
4299                      begin
4300                         --  B can either be a scalar type, in which case the
4301                         --  declaration of Typ may constrain it with different
4302                         --  bounds, or a private type, in which case we know
4303                         --  that the declaration of Typ cannot have a scalar
4304                         --  constraint.
4305
4306                         if Is_Scalar_Type (B) then
4307                            LE := Type_Low_Bound (B);
4308                            HE := Type_High_Bound (B);
4309                         else
4310                            LE := Empty;
4311                            HE := Empty;
4312                         end if;
4313
4314                         if No (LE)
4315                           or else (True
4316                             and then Nkind (L) = N_Integer_Literal
4317                             and then Nkind (H) = N_Integer_Literal
4318                             and then Nkind (LE) = N_Integer_Literal
4319                             and then Nkind (HE) = N_Integer_Literal
4320                             and then UI_Eq (Intval (L), Intval (LE))
4321                             and then UI_Eq (Intval (H), Intval (HE)))
4322                         then
4323                            null;
4324
4325                         else
4326                            Write_Str (" range ");
4327                            Sprint_Node (Type_Low_Bound (Typ));
4328                            Write_Str (" .. ");
4329                            Sprint_Node (Type_High_Bound (Typ));
4330                         end if;
4331                      end;
4332
4333                   --  Modular integer types
4334
4335                   when E_Modular_Integer_Type =>
4336                      Write_Header;
4337                      Write_Str ("mod ");
4338                      Write_Uint_With_Col_Check (Modulus (Typ), Auto);
4339
4340                   --  Floating point types and subtypes
4341
4342                   when E_Floating_Point_Subtype
4343                      | E_Floating_Point_Type
4344                   =>
4345                      Write_Header (Ekind (Typ) = E_Floating_Point_Type);
4346
4347                      if Ekind (Typ) = E_Floating_Point_Type then
4348                         Write_Str ("new ");
4349                      end if;
4350
4351                      Write_Id (Etype (Typ));
4352
4353                      if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then
4354                         Write_Str (" digits ");
4355                         Write_Uint_With_Col_Check
4356                           (Digits_Value (Typ), Decimal);
4357                      end if;
4358
4359                      --  Print bounds if not different from base type
4360
4361                      declare
4362                         L  : constant Node_Id := Type_Low_Bound (Typ);
4363                         H  : constant Node_Id := Type_High_Bound (Typ);
4364                         LE : constant Node_Id := Type_Low_Bound (B);
4365                         HE : constant Node_Id := Type_High_Bound (B);
4366
4367                      begin
4368                         if Nkind (L) = N_Real_Literal
4369                           and then Nkind (H) = N_Real_Literal
4370                           and then Nkind (LE) = N_Real_Literal
4371                           and then Nkind (HE) = N_Real_Literal
4372                           and then UR_Eq (Realval (L), Realval (LE))
4373                           and then UR_Eq (Realval (H), Realval (HE))
4374                         then
4375                            null;
4376
4377                         else
4378                            Write_Str (" range ");
4379                            Sprint_Node (Type_Low_Bound (Typ));
4380                            Write_Str (" .. ");
4381                            Sprint_Node (Type_High_Bound (Typ));
4382                         end if;
4383                      end;
4384
4385                   --  Record subtypes
4386
4387                   when E_Record_Subtype
4388                      | E_Record_Subtype_With_Private
4389                   =>
4390                      Write_Header (False);
4391                      Write_Str ("record");
4392                      Indent_Begin;
4393
4394                      declare
4395                         C : Entity_Id;
4396                      begin
4397                         C := First_Entity (Typ);
4398                         while Present (C) loop
4399                            Write_Indent;
4400                            Write_Id (C);
4401                            Write_Str (" : ");
4402                            Write_Id (Etype (C));
4403                            Next_Entity (C);
4404                         end loop;
4405                      end;
4406
4407                      Indent_End;
4408                      Write_Indent_Str (" end record");
4409
4410                   --  Class-Wide types
4411
4412                   when E_Class_Wide_Subtype
4413                      | E_Class_Wide_Type
4414                   =>
4415                      Write_Header (Ekind (Typ) = E_Class_Wide_Type);
4416                      Write_Name_With_Col_Check (Chars (Etype (Typ)));
4417                      Write_Str ("'Class");
4418
4419                   --  Subprogram types
4420
4421                   when E_Subprogram_Type =>
4422                      Write_Header;
4423
4424                      if Etype (Typ) = Standard_Void_Type then
4425                         Write_Str ("procedure");
4426                      else
4427                         Write_Str ("function");
4428                      end if;
4429
4430                      if Present (First_Entity (Typ)) then
4431                         Write_Str (" (");
4432
4433                         declare
4434                            Param : Entity_Id;
4435
4436                         begin
4437                            Param := First_Entity (Typ);
4438                            loop
4439                               Write_Id (Param);
4440                               Write_Str (" : ");
4441
4442                               if Ekind (Param) = E_In_Out_Parameter then
4443                                  Write_Str ("in out ");
4444                               elsif Ekind (Param) = E_Out_Parameter then
4445                                  Write_Str ("out ");
4446                               end if;
4447
4448                               Write_Id (Etype (Param));
4449                               Next_Entity (Param);
4450                               exit when No (Param);
4451                               Write_Str (", ");
4452                            end loop;
4453
4454                            Write_Char (')');
4455                         end;
4456                      end if;
4457
4458                      if Etype (Typ) /= Standard_Void_Type then
4459                         Write_Str (" return ");
4460                         Write_Id (Etype (Typ));
4461                      end if;
4462
4463                   when E_String_Literal_Subtype =>
4464                      declare
4465                         LB  : constant Uint :=
4466                                 Expr_Value (String_Literal_Low_Bound (Typ));
4467                         Len : constant Uint :=
4468                                 String_Literal_Length (Typ);
4469                      begin
4470                         Write_Header (False);
4471                         Write_Str ("String (");
4472                         Write_Int (UI_To_Int (LB));
4473                         Write_Str (" .. ");
4474                         Write_Int (UI_To_Int (LB + Len) - 1);
4475                         Write_Str (");");
4476                      end;
4477
4478                   --  For all other Itypes, print ??? (fill in later)
4479
4480                   when others =>
4481                      Write_Header (True);
4482                      Write_Str ("???");
4483                end case;
4484             end if;
4485
4486             --  Add terminating bracket and restore output buffer
4487
4488             Write_Char (']');
4489             Write_Eol;
4490             Restore_Output_Buffer (S);
4491          end;
4492
4493          Set_Itype_Printed (Typ);
4494       end if;
4495    end Write_Itype;
4496
4497    -------------------------------
4498    -- Write_Name_With_Col_Check --
4499    -------------------------------
4500
4501    procedure Write_Name_With_Col_Check (N : Name_Id) is
4502       J : Natural;
4503       K : Natural;
4504       L : Natural;
4505
4506    begin
4507       Get_Name_String (N);
4508
4509       --  Deal with -gnatdI which replaces any sequence Cnnnb where C is an
4510       --  upper case letter, nnn is one or more digits and b is a lower case
4511       --  letter by C...b, so that listings do not depend on serial numbers.
4512
4513       if Debug_Flag_II then
4514          J := 1;
4515          while J < Name_Len - 1 loop
4516             if Name_Buffer (J) in 'A' .. 'Z'
4517               and then Name_Buffer (J + 1) in '0' .. '9'
4518             then
4519                K := J + 1;
4520                while K < Name_Len loop
4521                   exit when Name_Buffer (K) not in '0' .. '9';
4522                   K := K + 1;
4523                end loop;
4524
4525                if Name_Buffer (K) in 'a' .. 'z' then
4526                   L := Name_Len - K + 1;
4527
4528                   Name_Buffer (J + 4 .. J + L + 3) :=
4529                     Name_Buffer (K .. Name_Len);
4530                   Name_Buffer (J + 1 .. J + 3) := "...";
4531                   Name_Len := J + L + 3;
4532                   J := J + 5;
4533
4534                else
4535                   J := K;
4536                end if;
4537
4538             else
4539                J := J + 1;
4540             end if;
4541          end loop;
4542       end if;
4543
4544       --  Fall through for normal case
4545
4546       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
4547    end Write_Name_With_Col_Check;
4548
4549    ------------------------------------
4550    -- Write_Name_With_Col_Check_Sloc --
4551    ------------------------------------
4552
4553    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
4554    begin
4555       Get_Name_String (N);
4556       Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
4557    end Write_Name_With_Col_Check_Sloc;
4558
4559    --------------------
4560    -- Write_Operator --
4561    --------------------
4562
4563    procedure Write_Operator (N : Node_Id; S : String) is
4564       F : Natural := S'First;
4565       T : Natural := S'Last;
4566
4567    begin
4568       --  If no overflow check, just write string out, and we are done
4569
4570       if not Do_Overflow_Check (N) then
4571          Write_Str_Sloc (S);
4572
4573       --  If overflow check, we want to surround the operator with curly
4574       --  brackets, but not include spaces within the brackets.
4575
4576       else
4577          if S (F) = ' ' then
4578             Write_Char (' ');
4579             F := F + 1;
4580          end if;
4581
4582          if S (T) = ' ' then
4583             T := T - 1;
4584          end if;
4585
4586          Write_Char ('{');
4587          Write_Str_Sloc (S (F .. T));
4588          Write_Char ('}');
4589
4590          if S (S'Last) = ' ' then
4591             Write_Char (' ');
4592          end if;
4593       end if;
4594    end Write_Operator;
4595
4596    -----------------------
4597    -- Write_Param_Specs --
4598    -----------------------
4599
4600    procedure Write_Param_Specs (N : Node_Id) is
4601       Specs         : constant List_Id := Parameter_Specifications (N);
4602       Specs_Present : constant Boolean := Is_Non_Empty_List (Specs);
4603
4604       Ent    : Entity_Id;
4605       Extras : Node_Id;
4606       Spec   : Node_Id;
4607       Formal : Node_Id;
4608
4609       Output : Boolean := False;
4610       --  Set true if we output at least one parameter
4611
4612    begin
4613       --  Write out explicit specs from Parameter_Speficiations list
4614
4615       if Specs_Present then
4616          Write_Str_With_Col_Check (" (");
4617          Output := True;
4618
4619          Spec := First (Specs);
4620          loop
4621             Sprint_Node (Spec);
4622             Formal := Defining_Identifier (Spec);
4623             Next (Spec);
4624             exit when Spec = Empty;
4625
4626             --  Add semicolon, unless we are printing original tree and the
4627             --  next specification is part of a list (but not the first element
4628             --  of that list).
4629
4630             if not Dump_Original_Only or else not Prev_Ids (Spec) then
4631                Write_Str ("; ");
4632             end if;
4633          end loop;
4634       end if;
4635
4636       --  See if we have extra formals
4637
4638       if Nkind_In (N, N_Function_Specification,
4639                       N_Procedure_Specification)
4640       then
4641          Ent := Defining_Entity (N);
4642
4643          --  Loop to write extra formals (if any)
4644
4645          if Present (Ent) and then Is_Subprogram (Ent) then
4646             Extras := Extra_Formals (Ent);
4647
4648             if Present (Extras) then
4649                if not Specs_Present then
4650                   Write_Str_With_Col_Check (" (");
4651                   Output := True;
4652                end if;
4653
4654                Formal := Extras;
4655                while Present (Formal) loop
4656                   if Specs_Present or else Formal /= Extras then
4657                      Write_Str ("; ");
4658                   end if;
4659
4660                   Write_Name_With_Col_Check (Chars (Formal));
4661                   Write_Str (" : ");
4662                   Write_Name_With_Col_Check (Chars (Etype (Formal)));
4663                   Formal := Extra_Formal (Formal);
4664                end loop;
4665             end if;
4666          end if;
4667       end if;
4668
4669       if Output then
4670          Write_Char (')');
4671       end if;
4672    end Write_Param_Specs;
4673
4674    -----------------------
4675    -- Write_Rewrite_Str --
4676    -----------------------
4677
4678    procedure Write_Rewrite_Str (S : String) is
4679    begin
4680       if not Dump_Generated_Only then
4681          if S'Length = 3 and then S = ">>>" then
4682             Write_Str (">>>");
4683          else
4684             Write_Str_With_Col_Check (S);
4685          end if;
4686       end if;
4687    end Write_Rewrite_Str;
4688
4689    -----------------------
4690    -- Write_Source_Line --
4691    -----------------------
4692
4693    procedure Write_Source_Line (L : Physical_Line_Number) is
4694       Loc : Source_Ptr;
4695       Src : Source_Buffer_Ptr;
4696       Scn : Source_Ptr;
4697
4698    begin
4699       if Dump_Source_Text then
4700          Src := Source_Text (Current_Source_File);
4701          Loc := Line_Start (L, Current_Source_File);
4702          Write_Eol;
4703
4704          --  See if line is a comment line, if not, and if not line one,
4705          --  precede with blank line.
4706
4707          Scn := Loc;
4708          while Src (Scn) = ' ' or else Src (Scn) = ASCII.HT loop
4709             Scn := Scn + 1;
4710          end loop;
4711
4712          if (Src (Scn) in Line_Terminator
4713               or else Src (Scn .. Scn + 1) /= "--")
4714            and then L /= 1
4715          then
4716             Write_Eol;
4717          end if;
4718
4719          --  Now write the source text of the line
4720
4721          Write_Str ("-- ");
4722          Write_Int (Int (L));
4723          Write_Str (": ");
4724
4725          while Src (Loc) not in Line_Terminator loop
4726             Write_Char (Src (Loc));
4727             Loc := Loc + 1;
4728          end loop;
4729       end if;
4730    end Write_Source_Line;
4731
4732    ------------------------
4733    -- Write_Source_Lines --
4734    ------------------------
4735
4736    procedure Write_Source_Lines (L : Physical_Line_Number) is
4737    begin
4738       while Last_Line_Printed < L loop
4739          Last_Line_Printed := Last_Line_Printed + 1;
4740          Write_Source_Line (Last_Line_Printed);
4741       end loop;
4742    end Write_Source_Lines;
4743
4744    --------------------
4745    -- Write_Str_Sloc --
4746    --------------------
4747
4748    procedure Write_Str_Sloc (S : String) is
4749    begin
4750       for J in S'Range loop
4751          Write_Char_Sloc (S (J));
4752       end loop;
4753    end Write_Str_Sloc;
4754
4755    ------------------------------
4756    -- Write_Str_With_Col_Check --
4757    ------------------------------
4758
4759    procedure Write_Str_With_Col_Check (S : String) is
4760    begin
4761       if Int (S'Last) + Column > Sprint_Line_Limit then
4762          Write_Indent_Str ("  ");
4763
4764          if S (S'First) = ' ' then
4765             Write_Str (S (S'First + 1 .. S'Last));
4766          else
4767             Write_Str (S);
4768          end if;
4769
4770       else
4771          Write_Str (S);
4772       end if;
4773    end Write_Str_With_Col_Check;
4774
4775    -----------------------------------
4776    -- Write_Str_With_Col_Check_Sloc --
4777    -----------------------------------
4778
4779    procedure Write_Str_With_Col_Check_Sloc (S : String) is
4780    begin
4781       if Int (S'Last) + Column > Sprint_Line_Limit then
4782          Write_Indent_Str ("  ");
4783
4784          if S (S'First) = ' ' then
4785             Write_Str_Sloc (S (S'First + 1 .. S'Last));
4786          else
4787             Write_Str_Sloc (S);
4788          end if;
4789
4790       else
4791          Write_Str_Sloc (S);
4792       end if;
4793    end Write_Str_With_Col_Check_Sloc;
4794
4795    ---------------------------
4796    -- Write_Subprogram_Name --
4797    ---------------------------
4798
4799    procedure Write_Subprogram_Name (N : Node_Id) is
4800    begin
4801       if not Comes_From_Source (N)
4802         and then Is_Entity_Name (N)
4803       then
4804          declare
4805             Ent : constant Entity_Id := Entity (N);
4806          begin
4807             if not In_Extended_Main_Source_Unit (Ent)
4808               and then In_Predefined_Unit (Ent)
4809             then
4810                --  Run-time routine name, output name with a preceding dollar
4811                --  making sure that we do not get a line split between them.
4812
4813                Col_Check (Length_Of_Name (Chars (Ent)) + 1);
4814                Write_Char ('$');
4815                Write_Name (Chars (Ent));
4816                return;
4817             end if;
4818          end;
4819       end if;
4820
4821       --  Normal case, not a run-time routine name
4822
4823       Sprint_Node (N);
4824    end Write_Subprogram_Name;
4825
4826    -------------------------------
4827    -- Write_Uint_With_Col_Check --
4828    -------------------------------
4829
4830    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format) is
4831    begin
4832       Col_Check (UI_Decimal_Digits_Hi (U));
4833       UI_Write (U, Format);
4834    end Write_Uint_With_Col_Check;
4835
4836    ------------------------------------
4837    -- Write_Uint_With_Col_Check_Sloc --
4838    ------------------------------------
4839
4840    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format) is
4841    begin
4842       Col_Check (UI_Decimal_Digits_Hi (U));
4843       Set_Debug_Sloc;
4844       UI_Write (U, Format);
4845    end Write_Uint_With_Col_Check_Sloc;
4846
4847    -------------------------------------
4848    -- Write_Ureal_With_Col_Check_Sloc --
4849    -------------------------------------
4850
4851    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
4852       D : constant Uint := Denominator (U);
4853       N : constant Uint := Numerator (U);
4854    begin
4855       Col_Check (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
4856       Set_Debug_Sloc;
4857       UR_Write (U, Brackets => True);
4858    end Write_Ureal_With_Col_Check_Sloc;
4859
4860 end Sprint;