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-2018, 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_Call_Marker =>
1229             null;
1230
1231             --  Enable the following code for debugging purposes only
1232
1233             --  Write_Indent_Str ("#");
1234             --  Write_Id (Target (Node));
1235             --  Write_Char ('#');
1236
1237          when N_Case_Expression =>
1238             declare
1239                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
1240                Alt        : Node_Id;
1241
1242             begin
1243                --  The syntax for case_expression does not include parentheses,
1244                --  but sometimes parentheses are required, so unconditionally
1245                --  generate them here unless already present.
1246
1247                if not Has_Parens then
1248                   Write_Char ('(');
1249                end if;
1250
1251                Write_Str_With_Col_Check_Sloc ("case ");
1252                Sprint_Node (Expression (Node));
1253                Write_Str_With_Col_Check (" is");
1254
1255                Alt := First (Alternatives (Node));
1256                loop
1257                   Sprint_Node (Alt);
1258                   Next (Alt);
1259                   exit when No (Alt);
1260                   Write_Char (',');
1261                end loop;
1262
1263                if not Has_Parens then
1264                   Write_Char (')');
1265                end if;
1266             end;
1267
1268          when N_Case_Expression_Alternative =>
1269             Write_Str_With_Col_Check (" when ");
1270             Sprint_Bar_List (Discrete_Choices (Node));
1271             Write_Str (" => ");
1272             Sprint_Node (Expression (Node));
1273
1274          when N_Case_Statement =>
1275             Write_Indent_Str_Sloc ("case ");
1276             Sprint_Node (Expression (Node));
1277             Write_Str (" is");
1278             Sprint_Indented_List (Alternatives (Node));
1279             Write_Indent_Str ("end case;");
1280
1281          when N_Case_Statement_Alternative =>
1282             Write_Indent_Str_Sloc ("when ");
1283             Sprint_Bar_List (Discrete_Choices (Node));
1284             Write_Str (" => ");
1285             Sprint_Indented_List (Statements (Node));
1286
1287          when N_Character_Literal =>
1288             if Column > Sprint_Line_Limit - 2 then
1289                Write_Indent_Str ("  ");
1290             end if;
1291
1292             Write_Char_Sloc (''');
1293             Write_Char_Code (UI_To_CC (Char_Literal_Value (Node)));
1294             Write_Char (''');
1295
1296          when N_Code_Statement =>
1297             Write_Indent;
1298             Set_Debug_Sloc;
1299             Sprint_Node (Expression (Node));
1300             Write_Char (';');
1301
1302          when N_Compilation_Unit =>
1303             Sprint_Node_List (Context_Items (Node));
1304             Sprint_Opt_Node_List (Declarations (Aux_Decls_Node (Node)));
1305
1306             if Private_Present (Node) then
1307                Write_Indent_Str ("private ");
1308                Indent_Annull;
1309             end if;
1310
1311             Sprint_Node_Sloc (Unit (Node));
1312
1313             if Present (Actions (Aux_Decls_Node (Node)))
1314                  or else
1315                Present (Pragmas_After (Aux_Decls_Node (Node)))
1316             then
1317                Write_Indent;
1318             end if;
1319
1320             Sprint_Opt_Node_List (Actions (Aux_Decls_Node (Node)));
1321             Sprint_Opt_Node_List (Pragmas_After (Aux_Decls_Node (Node)));
1322
1323          when N_Compilation_Unit_Aux =>
1324             null; -- nothing to do, never used, see above
1325
1326          when N_Component_Association =>
1327             Set_Debug_Sloc;
1328             Sprint_Bar_List (Choices (Node));
1329             Write_Str (" => ");
1330
1331             --  Ada 2005 (AI-287): Print the box if present
1332
1333             if Box_Present (Node) then
1334                Write_Str_With_Col_Check ("<>");
1335             else
1336                Sprint_Node (Expression (Node));
1337             end if;
1338
1339          when N_Iterated_Component_Association =>
1340             Set_Debug_Sloc;
1341             Write_Str (" for ");
1342             Write_Id (Defining_Identifier (Node));
1343             Write_Str (" in ");
1344             Sprint_Bar_List (Discrete_Choices (Node));
1345             Write_Str (" => ");
1346             Sprint_Node (Expression (Node));
1347
1348          when N_Component_Clause =>
1349             Write_Indent;
1350             Sprint_Node (Component_Name (Node));
1351             Write_Str_Sloc (" at ");
1352             Sprint_Node (Position (Node));
1353             Write_Char (' ');
1354             Write_Str_With_Col_Check ("range ");
1355             Sprint_Node (First_Bit (Node));
1356             Write_Str (" .. ");
1357             Sprint_Node (Last_Bit (Node));
1358             Write_Char (';');
1359
1360          when N_Component_Definition =>
1361             Set_Debug_Sloc;
1362
1363             --  Ada 2005 (AI-230): Access definition components
1364
1365             if Present (Access_Definition (Node)) then
1366                Sprint_Node (Access_Definition (Node));
1367
1368             elsif Present (Subtype_Indication (Node)) then
1369                if Aliased_Present (Node) then
1370                   Write_Str_With_Col_Check ("aliased ");
1371                end if;
1372
1373                --  Ada 2005 (AI-231)
1374
1375                if Null_Exclusion_Present (Node) then
1376                   Write_Str (" not null ");
1377                end if;
1378
1379                Sprint_Node (Subtype_Indication (Node));
1380
1381             else
1382                Write_Str (" ??? ");
1383             end if;
1384
1385          when N_Component_Declaration =>
1386             if Write_Indent_Identifiers_Sloc (Node) then
1387                Write_Str (" : ");
1388                Sprint_Node (Component_Definition (Node));
1389
1390                if Present (Expression (Node)) then
1391                   Write_Str (" := ");
1392                   Sprint_Node (Expression (Node));
1393                end if;
1394
1395                Write_Char (';');
1396             end if;
1397
1398          when N_Component_List =>
1399             if Null_Present (Node) then
1400                Indent_Begin;
1401                Write_Indent_Str_Sloc ("null");
1402                Write_Char (';');
1403                Indent_End;
1404
1405             else
1406                Set_Debug_Sloc;
1407                Sprint_Indented_List (Component_Items (Node));
1408                Sprint_Node (Variant_Part (Node));
1409             end if;
1410
1411          when N_Compound_Statement =>
1412             Write_Indent_Str ("do");
1413             Indent_Begin;
1414             Sprint_Node_List (Actions (Node));
1415             Indent_End;
1416             Write_Indent_Str ("end;");
1417
1418          when N_Conditional_Entry_Call =>
1419             Write_Indent_Str_Sloc ("select");
1420             Indent_Begin;
1421             Sprint_Node (Entry_Call_Alternative (Node));
1422             Indent_End;
1423             Write_Indent_Str ("else");
1424             Sprint_Indented_List (Else_Statements (Node));
1425             Write_Indent_Str ("end select;");
1426
1427          when N_Constrained_Array_Definition =>
1428             Write_Str_With_Col_Check_Sloc ("array ");
1429             Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
1430             Write_Str (" of ");
1431
1432             Sprint_Node (Component_Definition (Node));
1433
1434          --  A contract node should not appear in the tree. It is a semantic
1435          --  node attached to entry and [generic] subprogram entities. But we
1436          --  still provide meaningful output, in case called from the debugger.
1437
1438          when N_Contract =>
1439             declare
1440                P : Node_Id;
1441
1442             begin
1443                Indent_Begin;
1444                Write_Str ("N_Contract node");
1445                Write_Eol;
1446
1447                Write_Indent_Str ("Pre_Post_Conditions");
1448                Indent_Begin;
1449
1450                P := Pre_Post_Conditions (Node);
1451                while Present (P) loop
1452                   Sprint_Node (P);
1453                   P := Next_Pragma (P);
1454                end loop;
1455
1456                Write_Eol;
1457                Indent_End;
1458
1459                Write_Indent_Str ("Contract_Test_Cases");
1460                Indent_Begin;
1461
1462                P := Contract_Test_Cases (Node);
1463                while Present (P) loop
1464                   Sprint_Node (P);
1465                   P := Next_Pragma (P);
1466                end loop;
1467
1468                Write_Eol;
1469                Indent_End;
1470
1471                Write_Indent_Str ("Classifications");
1472                Indent_Begin;
1473
1474                P := Classifications (Node);
1475                while Present (P) loop
1476                   Sprint_Node (P);
1477                   P := Next_Pragma (P);
1478                end loop;
1479
1480                Write_Eol;
1481                Indent_End;
1482                Indent_End;
1483             end;
1484
1485          when N_Decimal_Fixed_Point_Definition =>
1486             Write_Str_With_Col_Check_Sloc (" delta ");
1487             Sprint_Node (Delta_Expression (Node));
1488             Write_Str_With_Col_Check ("digits ");
1489             Sprint_Node (Digits_Expression (Node));
1490             Sprint_Opt_Node (Real_Range_Specification (Node));
1491
1492          when N_Defining_Character_Literal =>
1493             Write_Name_With_Col_Check_Sloc (Chars (Node));
1494
1495          when N_Defining_Identifier =>
1496             Set_Debug_Sloc;
1497             Write_Id (Node);
1498
1499          when N_Defining_Operator_Symbol =>
1500             Write_Name_With_Col_Check_Sloc (Chars (Node));
1501
1502          when N_Defining_Program_Unit_Name =>
1503             Set_Debug_Sloc;
1504             Sprint_Node (Name (Node));
1505             Write_Char ('.');
1506             Write_Id (Defining_Identifier (Node));
1507
1508          when N_Delay_Alternative =>
1509             Sprint_Node_List (Pragmas_Before (Node));
1510
1511             if Present (Condition (Node)) then
1512                Write_Indent;
1513                Write_Str_With_Col_Check ("when ");
1514                Sprint_Node (Condition (Node));
1515                Write_Str (" => ");
1516                Indent_Annull;
1517             end if;
1518
1519             Sprint_Node_Sloc (Delay_Statement (Node));
1520             Sprint_Node_List (Statements (Node));
1521
1522          when N_Delay_Relative_Statement =>
1523             Write_Indent_Str_Sloc ("delay ");
1524             Sprint_Node (Expression (Node));
1525             Write_Char (';');
1526
1527          when N_Delay_Until_Statement =>
1528             Write_Indent_Str_Sloc ("delay until ");
1529             Sprint_Node (Expression (Node));
1530             Write_Char (';');
1531
1532          when N_Delta_Constraint =>
1533             Write_Str_With_Col_Check_Sloc ("delta ");
1534             Sprint_Node (Delta_Expression (Node));
1535             Sprint_Opt_Node (Range_Constraint (Node));
1536
1537          when N_Derived_Type_Definition =>
1538             if Abstract_Present (Node) then
1539                Write_Str_With_Col_Check ("abstract ");
1540             end if;
1541
1542             Write_Str_With_Col_Check ("new ");
1543
1544             --  Ada 2005 (AI-231)
1545
1546             if Null_Exclusion_Present (Node) then
1547                Write_Str_With_Col_Check ("not null ");
1548             end if;
1549
1550             Sprint_Node (Subtype_Indication (Node));
1551
1552             if Present (Interface_List (Node)) then
1553                Write_Str_With_Col_Check (" and ");
1554                Sprint_And_List (Interface_List (Node));
1555                Write_Str_With_Col_Check (" with ");
1556             end if;
1557
1558             if Present (Record_Extension_Part (Node)) then
1559                if No (Interface_List (Node)) then
1560                   Write_Str_With_Col_Check (" with ");
1561                end if;
1562
1563                Sprint_Node (Record_Extension_Part (Node));
1564             end if;
1565
1566          when N_Designator =>
1567             Sprint_Node (Name (Node));
1568             Write_Char_Sloc ('.');
1569             Write_Id (Identifier (Node));
1570
1571          when N_Digits_Constraint =>
1572             Write_Str_With_Col_Check_Sloc ("digits ");
1573             Sprint_Node (Digits_Expression (Node));
1574             Sprint_Opt_Node (Range_Constraint (Node));
1575
1576          when N_Discriminant_Association =>
1577             Set_Debug_Sloc;
1578
1579             if Present (Selector_Names (Node)) then
1580                Sprint_Bar_List (Selector_Names (Node));
1581                Write_Str (" => ");
1582             end if;
1583
1584             Set_Debug_Sloc;
1585             Sprint_Node (Expression (Node));
1586
1587          when N_Discriminant_Specification =>
1588             Set_Debug_Sloc;
1589
1590             if Write_Identifiers (Node) then
1591                Write_Str (" : ");
1592
1593                if Null_Exclusion_Present (Node) then
1594                   Write_Str ("not null ");
1595                end if;
1596
1597                Sprint_Node (Discriminant_Type (Node));
1598
1599                if Present (Expression (Node)) then
1600                   Write_Str (" := ");
1601                   Sprint_Node (Expression (Node));
1602                end if;
1603             else
1604                Write_Str (", ");
1605             end if;
1606
1607          when N_Elsif_Part =>
1608             Write_Indent_Str_Sloc ("elsif ");
1609             Sprint_Node (Condition (Node));
1610             Write_Str_With_Col_Check (" then");
1611             Sprint_Indented_List (Then_Statements (Node));
1612
1613          when N_Empty =>
1614             null;
1615
1616          when N_Entry_Body =>
1617             Write_Indent_Str_Sloc ("entry ");
1618             Write_Id (Defining_Identifier (Node));
1619             Sprint_Node (Entry_Body_Formal_Part (Node));
1620             Write_Str_With_Col_Check (" is");
1621             Sprint_Indented_List (Declarations (Node));
1622             Write_Indent_Str ("begin");
1623             Sprint_Node (Handled_Statement_Sequence (Node));
1624             Write_Indent_Str ("end ");
1625             Write_Id (Defining_Identifier (Node));
1626             Write_Char (';');
1627
1628          when N_Entry_Body_Formal_Part =>
1629             if Present (Entry_Index_Specification (Node)) then
1630                Write_Str_With_Col_Check_Sloc (" (");
1631                Sprint_Node (Entry_Index_Specification (Node));
1632                Write_Char (')');
1633             end if;
1634
1635             Write_Param_Specs (Node);
1636             Write_Str_With_Col_Check_Sloc (" when ");
1637             Sprint_Node (Condition (Node));
1638
1639          when N_Entry_Call_Alternative =>
1640             Sprint_Node_List (Pragmas_Before (Node));
1641             Sprint_Node_Sloc (Entry_Call_Statement (Node));
1642             Sprint_Node_List (Statements (Node));
1643
1644          when N_Entry_Call_Statement =>
1645             Write_Indent;
1646             Sprint_Node_Sloc (Name (Node));
1647             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1648             Write_Char (';');
1649
1650          when N_Entry_Declaration =>
1651             Write_Indent_Str_Sloc ("entry ");
1652             Write_Id (Defining_Identifier (Node));
1653
1654             if Present (Discrete_Subtype_Definition (Node)) then
1655                Write_Str_With_Col_Check (" (");
1656                Sprint_Node (Discrete_Subtype_Definition (Node));
1657                Write_Char (')');
1658             end if;
1659
1660             Write_Param_Specs (Node);
1661             Write_Char (';');
1662
1663          when N_Entry_Index_Specification =>
1664             Write_Str_With_Col_Check_Sloc ("for ");
1665             Write_Id (Defining_Identifier (Node));
1666             Write_Str_With_Col_Check (" in ");
1667             Sprint_Node (Discrete_Subtype_Definition (Node));
1668
1669          when N_Enumeration_Representation_Clause =>
1670             Write_Indent_Str_Sloc ("for ");
1671             Write_Id (Identifier (Node));
1672             Write_Str_With_Col_Check (" use ");
1673             Sprint_Node (Array_Aggregate (Node));
1674             Write_Char (';');
1675
1676          when N_Enumeration_Type_Definition =>
1677             Set_Debug_Sloc;
1678
1679             --  Skip attempt to print Literals field if it's not there and
1680             --  we are in package Standard (case of Character, which is
1681             --  handled specially (without an explicit literals list).
1682
1683             if Sloc (Node) > Standard_Location
1684               or else Present (Literals (Node))
1685             then
1686                Sprint_Paren_Comma_List (Literals (Node));
1687             end if;
1688
1689          when N_Error =>
1690             Write_Str_With_Col_Check_Sloc ("<error>");
1691
1692          when N_Exception_Declaration =>
1693             if Write_Indent_Identifiers (Node) then
1694                Write_Str_With_Col_Check (" : ");
1695
1696                if Is_Statically_Allocated (Defining_Identifier (Node)) then
1697                   Write_Str_With_Col_Check ("static ");
1698                end if;
1699
1700                Write_Str_Sloc ("exception");
1701
1702                if Present (Expression (Node)) then
1703                   Write_Str (" := ");
1704                   Sprint_Node (Expression (Node));
1705                end if;
1706
1707                Write_Char (';');
1708             end if;
1709
1710          when N_Exception_Handler =>
1711             Write_Indent_Str_Sloc ("when ");
1712
1713             if Present (Choice_Parameter (Node)) then
1714                Sprint_Node (Choice_Parameter (Node));
1715                Write_Str (" : ");
1716             end if;
1717
1718             Sprint_Bar_List (Exception_Choices (Node));
1719             Write_Str (" => ");
1720             Sprint_Indented_List (Statements (Node));
1721
1722          when N_Exception_Renaming_Declaration =>
1723             Write_Indent;
1724             Set_Debug_Sloc;
1725             Sprint_Node (Defining_Identifier (Node));
1726             Write_Str_With_Col_Check (" : exception renames ");
1727             Sprint_Node (Name (Node));
1728             Write_Char (';');
1729
1730          when N_Exit_Statement =>
1731             Write_Indent_Str_Sloc ("exit");
1732             Sprint_Opt_Node (Name (Node));
1733
1734             if Present (Condition (Node)) then
1735                Write_Str_With_Col_Check (" when ");
1736                Sprint_Node (Condition (Node));
1737             end if;
1738
1739             Write_Char (';');
1740
1741          when N_Expanded_Name =>
1742             Sprint_Node (Prefix (Node));
1743             Write_Char_Sloc ('.');
1744             Sprint_Node (Selector_Name (Node));
1745
1746          when N_Explicit_Dereference =>
1747             Sprint_Node (Prefix (Node));
1748             Write_Char_Sloc ('.');
1749             Write_Str_Sloc ("all");
1750
1751          when N_Expression_With_Actions =>
1752             Indent_Begin;
1753             Write_Indent_Str_Sloc ("do ");
1754             Indent_Begin;
1755             Sprint_Node_List (Actions (Node));
1756             Indent_End;
1757             Write_Indent;
1758             Write_Str_With_Col_Check_Sloc ("in ");
1759             Sprint_Node (Expression (Node));
1760             Write_Str_With_Col_Check (" end");
1761             Indent_End;
1762             Write_Indent;
1763
1764          when N_Expression_Function =>
1765             Write_Indent;
1766             Sprint_Node_Sloc (Specification (Node));
1767             Write_Str (" is");
1768             Indent_Begin;
1769             Write_Indent;
1770             Sprint_Node (Expression (Node));
1771             Write_Char (';');
1772             Indent_End;
1773
1774          when N_Extended_Return_Statement =>
1775             Write_Indent_Str_Sloc ("return ");
1776             Sprint_Node_List (Return_Object_Declarations (Node));
1777
1778             if Present (Handled_Statement_Sequence (Node)) then
1779                Write_Str_With_Col_Check (" do");
1780                Sprint_Node (Handled_Statement_Sequence (Node));
1781                Write_Indent_Str ("end return;");
1782             else
1783                Write_Indent_Str (";");
1784             end if;
1785
1786          when N_Delta_Aggregate =>
1787             Write_Str_With_Col_Check_Sloc ("(");
1788             Sprint_Node (Expression (Node));
1789             Write_Str_With_Col_Check (" with delta ");
1790             Sprint_Comma_List (Component_Associations (Node));
1791             Write_Char (')');
1792
1793          when N_Extension_Aggregate =>
1794             Write_Str_With_Col_Check_Sloc ("(");
1795             Sprint_Node (Ancestor_Part (Node));
1796             Write_Str_With_Col_Check (" with ");
1797
1798             if Null_Record_Present (Node) then
1799                Write_Str_With_Col_Check ("null record");
1800             else
1801                if Present (Expressions (Node)) then
1802                   Sprint_Comma_List (Expressions (Node));
1803
1804                   if Present (Component_Associations (Node)) then
1805                      Write_Str (", ");
1806                   end if;
1807                end if;
1808
1809                if Present (Component_Associations (Node)) then
1810                   Sprint_Comma_List (Component_Associations (Node));
1811                end if;
1812             end if;
1813
1814             Write_Char (')');
1815
1816          when N_Floating_Point_Definition =>
1817             Write_Str_With_Col_Check_Sloc ("digits ");
1818             Sprint_Node (Digits_Expression (Node));
1819             Sprint_Opt_Node (Real_Range_Specification (Node));
1820
1821          when N_Formal_Decimal_Fixed_Point_Definition =>
1822             Write_Str_With_Col_Check_Sloc ("delta <> digits <>");
1823
1824          when N_Formal_Derived_Type_Definition =>
1825             Write_Str_With_Col_Check_Sloc ("new ");
1826             Sprint_Node (Subtype_Mark (Node));
1827
1828             if Present (Interface_List (Node)) then
1829                Write_Str_With_Col_Check (" and ");
1830                Sprint_And_List (Interface_List (Node));
1831             end if;
1832
1833             if Private_Present (Node) then
1834                Write_Str_With_Col_Check (" with private");
1835             end if;
1836
1837          when N_Formal_Abstract_Subprogram_Declaration =>
1838             Write_Indent_Str_Sloc ("with ");
1839             Sprint_Node (Specification (Node));
1840
1841             Write_Str_With_Col_Check (" is abstract");
1842
1843             if Box_Present (Node) then
1844                Write_Str_With_Col_Check (" <>");
1845             elsif Present (Default_Name (Node)) then
1846                Write_Str_With_Col_Check (" ");
1847                Sprint_Node (Default_Name (Node));
1848             end if;
1849
1850             Write_Char (';');
1851
1852          when N_Formal_Concrete_Subprogram_Declaration =>
1853             Write_Indent_Str_Sloc ("with ");
1854             Sprint_Node (Specification (Node));
1855
1856             if Box_Present (Node) then
1857                Write_Str_With_Col_Check (" is <>");
1858             elsif Present (Default_Name (Node)) then
1859                Write_Str_With_Col_Check (" is ");
1860                Sprint_Node (Default_Name (Node));
1861             end if;
1862
1863             Write_Char (';');
1864
1865          when N_Formal_Discrete_Type_Definition =>
1866             Write_Str_With_Col_Check_Sloc ("<>");
1867
1868          when N_Formal_Floating_Point_Definition =>
1869             Write_Str_With_Col_Check_Sloc ("digits <>");
1870
1871          when N_Formal_Modular_Type_Definition =>
1872             Write_Str_With_Col_Check_Sloc ("mod <>");
1873
1874          when N_Formal_Object_Declaration =>
1875             Set_Debug_Sloc;
1876
1877             if Write_Indent_Identifiers (Node) then
1878                Write_Str (" : ");
1879
1880                if In_Present (Node) then
1881                   Write_Str_With_Col_Check ("in ");
1882                end if;
1883
1884                if Out_Present (Node) then
1885                   Write_Str_With_Col_Check ("out ");
1886                end if;
1887
1888                if Present (Subtype_Mark (Node)) then
1889
1890                   --  Ada 2005 (AI-423): Formal object with null exclusion
1891
1892                   if Null_Exclusion_Present (Node) then
1893                      Write_Str ("not null ");
1894                   end if;
1895
1896                   Sprint_Node (Subtype_Mark (Node));
1897
1898                --  Ada 2005 (AI-423): Formal object with access definition
1899
1900                else
1901                   pragma Assert (Present (Access_Definition (Node)));
1902
1903                   Sprint_Node (Access_Definition (Node));
1904                end if;
1905
1906                if Present (Default_Expression (Node)) then
1907                   Write_Str (" := ");
1908                   Sprint_Node (Default_Expression (Node));
1909                end if;
1910
1911                Write_Char (';');
1912             end if;
1913
1914          when N_Formal_Ordinary_Fixed_Point_Definition =>
1915             Write_Str_With_Col_Check_Sloc ("delta <>");
1916
1917          when N_Formal_Package_Declaration =>
1918             Write_Indent_Str_Sloc ("with package ");
1919             Write_Id (Defining_Identifier (Node));
1920             Write_Str_With_Col_Check (" is new ");
1921             Sprint_Node (Name (Node));
1922             Write_Str_With_Col_Check (" (<>);");
1923
1924          when N_Formal_Private_Type_Definition =>
1925             if Abstract_Present (Node) then
1926                Write_Str_With_Col_Check ("abstract ");
1927             end if;
1928
1929             if Tagged_Present (Node) then
1930                Write_Str_With_Col_Check ("tagged ");
1931             end if;
1932
1933             if Limited_Present (Node) then
1934                Write_Str_With_Col_Check ("limited ");
1935             end if;
1936
1937             Write_Str_With_Col_Check_Sloc ("private");
1938
1939          when N_Formal_Incomplete_Type_Definition =>
1940             if Tagged_Present (Node) then
1941                Write_Str_With_Col_Check ("is tagged ");
1942             end if;
1943
1944          when N_Formal_Signed_Integer_Type_Definition =>
1945             Write_Str_With_Col_Check_Sloc ("range <>");
1946
1947          when N_Formal_Type_Declaration =>
1948             Write_Indent_Str_Sloc ("type ");
1949             Write_Id (Defining_Identifier (Node));
1950
1951             if Present (Discriminant_Specifications (Node)) then
1952                Write_Discr_Specs (Node);
1953             elsif Unknown_Discriminants_Present (Node) then
1954                Write_Str_With_Col_Check ("(<>)");
1955             end if;
1956
1957             if Nkind (Formal_Type_Definition (Node)) /=
1958                 N_Formal_Incomplete_Type_Definition
1959             then
1960                Write_Str_With_Col_Check (" is ");
1961             end if;
1962
1963             Sprint_Node (Formal_Type_Definition (Node));
1964             Write_Char (';');
1965
1966          when N_Free_Statement =>
1967             Write_Indent_Str_Sloc ("free ");
1968             Sprint_Node (Expression (Node));
1969             Write_Char (';');
1970
1971          when N_Freeze_Entity =>
1972             if Dump_Original_Only then
1973                null;
1974
1975             --  A freeze node is output if it has some effect (i.e. non-empty
1976             --  actions, or freeze node for an itype, which causes elaboration
1977             --  of the itype), and is also always output if Dump_Freeze_Null
1978             --  is set True.
1979
1980             elsif Present (Actions (Node))
1981               or else Is_Itype (Entity (Node))
1982               or else Dump_Freeze_Null
1983             then
1984                Write_Indent;
1985                Write_Rewrite_Str ("<<<");
1986                Write_Str_With_Col_Check_Sloc ("freeze ");
1987                Write_Id (Entity (Node));
1988                Write_Str (" [");
1989
1990                if No (Actions (Node)) then
1991                   Write_Char (']');
1992
1993                else
1994                   --  Output freeze actions. We increment Freeze_Indent during
1995                   --  this output to avoid generating extra blank lines before
1996                   --  any procedures included in the freeze actions.
1997
1998                   Freeze_Indent := Freeze_Indent + 1;
1999                   Sprint_Indented_List (Actions (Node));
2000                   Freeze_Indent := Freeze_Indent - 1;
2001                   Write_Indent_Str ("]");
2002                end if;
2003
2004                Write_Rewrite_Str (">>>");
2005             end if;
2006
2007          when N_Freeze_Generic_Entity =>
2008             if Dump_Original_Only then
2009                null;
2010
2011             else
2012                Write_Indent;
2013                Write_Str_With_Col_Check_Sloc ("freeze_generic ");
2014                Write_Id (Entity (Node));
2015             end if;
2016
2017          when N_Full_Type_Declaration =>
2018             Write_Indent_Str_Sloc ("type ");
2019             Sprint_Node (Defining_Identifier (Node));
2020             Write_Discr_Specs (Node);
2021             Write_Str_With_Col_Check (" is ");
2022             Sprint_Node (Type_Definition (Node));
2023             Write_Char (';');
2024
2025          when N_Function_Call =>
2026             Set_Debug_Sloc;
2027             Write_Subprogram_Name (Name (Node));
2028             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2029
2030          when N_Function_Instantiation =>
2031             Write_Indent_Str_Sloc ("function ");
2032             Sprint_Node (Defining_Unit_Name (Node));
2033             Write_Str_With_Col_Check (" is new ");
2034             Sprint_Node (Name (Node));
2035             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2036             Write_Char (';');
2037
2038          when N_Function_Specification =>
2039             Write_Str_With_Col_Check_Sloc ("function ");
2040             Sprint_Node (Defining_Unit_Name (Node));
2041             Write_Param_Specs (Node);
2042             Write_Str_With_Col_Check (" return ");
2043
2044             --  Ada 2005 (AI-231)
2045
2046             if Nkind (Result_Definition (Node)) /= N_Access_Definition
2047               and then Null_Exclusion_Present (Node)
2048             then
2049                Write_Str (" not null ");
2050             end if;
2051
2052             Sprint_Node (Result_Definition (Node));
2053
2054          when N_Generic_Association =>
2055             Set_Debug_Sloc;
2056
2057             if Present (Selector_Name (Node)) then
2058                Sprint_Node (Selector_Name (Node));
2059                Write_Str (" => ");
2060             end if;
2061
2062             Sprint_Node (Explicit_Generic_Actual_Parameter (Node));
2063
2064          when N_Generic_Function_Renaming_Declaration =>
2065             Write_Indent_Str_Sloc ("generic function ");
2066             Sprint_Node (Defining_Unit_Name (Node));
2067             Write_Str_With_Col_Check (" renames ");
2068             Sprint_Node (Name (Node));
2069             Write_Char (';');
2070
2071          when N_Generic_Package_Declaration =>
2072             Extra_Blank_Line;
2073             Write_Indent_Str_Sloc ("generic ");
2074             Sprint_Indented_List (Generic_Formal_Declarations (Node));
2075             Write_Indent;
2076             Sprint_Node (Specification (Node));
2077             Write_Char (';');
2078
2079          when N_Generic_Package_Renaming_Declaration =>
2080             Write_Indent_Str_Sloc ("generic package ");
2081             Sprint_Node (Defining_Unit_Name (Node));
2082             Write_Str_With_Col_Check (" renames ");
2083             Sprint_Node (Name (Node));
2084             Write_Char (';');
2085
2086          when N_Generic_Procedure_Renaming_Declaration =>
2087             Write_Indent_Str_Sloc ("generic procedure ");
2088             Sprint_Node (Defining_Unit_Name (Node));
2089             Write_Str_With_Col_Check (" renames ");
2090             Sprint_Node (Name (Node));
2091             Write_Char (';');
2092
2093          when N_Generic_Subprogram_Declaration =>
2094             Extra_Blank_Line;
2095             Write_Indent_Str_Sloc ("generic ");
2096             Sprint_Indented_List (Generic_Formal_Declarations (Node));
2097             Write_Indent;
2098             Sprint_Node (Specification (Node));
2099             Write_Char (';');
2100
2101          when N_Goto_Statement =>
2102             Write_Indent_Str_Sloc ("goto ");
2103             Sprint_Node (Name (Node));
2104             Write_Char (';');
2105
2106             if Nkind (Next (Node)) = N_Label then
2107                Write_Indent;
2108             end if;
2109
2110          when N_Handled_Sequence_Of_Statements =>
2111             Set_Debug_Sloc;
2112             Sprint_Indented_List (Statements (Node));
2113
2114             if Present (Exception_Handlers (Node)) then
2115                Write_Indent_Str ("exception");
2116                Indent_Begin;
2117                Sprint_Node_List (Exception_Handlers (Node));
2118                Indent_End;
2119             end if;
2120
2121             if Present (At_End_Proc (Node)) then
2122                Write_Indent_Str ("at end");
2123                Indent_Begin;
2124                Write_Indent;
2125                Sprint_Node (At_End_Proc (Node));
2126                Write_Char (';');
2127                Indent_End;
2128             end if;
2129
2130          when N_Identifier =>
2131             Set_Debug_Sloc;
2132             Write_Id (Node);
2133
2134          when N_If_Expression =>
2135             declare
2136                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
2137                Condition  : constant Node_Id := First (Expressions (Node));
2138                Then_Expr  : constant Node_Id := Next (Condition);
2139
2140             begin
2141                --  The syntax for if_expression does not include parentheses,
2142                --  but sometimes parentheses are required, so unconditionally
2143                --  generate them here unless already present.
2144
2145                if not Has_Parens then
2146                   Write_Char ('(');
2147                end if;
2148
2149                Write_Str_With_Col_Check_Sloc ("if ");
2150                Sprint_Node (Condition);
2151                Write_Str_With_Col_Check (" then ");
2152
2153                --  Defense against junk here
2154
2155                if Present (Then_Expr) then
2156                   Sprint_Node (Then_Expr);
2157
2158                   if Present (Next (Then_Expr)) then
2159                      Write_Str_With_Col_Check (" else ");
2160                      Sprint_Node (Next (Then_Expr));
2161                   end if;
2162                end if;
2163
2164                if not Has_Parens then
2165                   Write_Char (')');
2166                end if;
2167             end;
2168
2169          when N_If_Statement =>
2170             Write_Indent_Str_Sloc ("if ");
2171             Sprint_Node (Condition (Node));
2172             Write_Str_With_Col_Check (" then");
2173             Sprint_Indented_List (Then_Statements (Node));
2174             Sprint_Opt_Node_List (Elsif_Parts (Node));
2175
2176             if Present (Else_Statements (Node)) then
2177                Write_Indent_Str ("else");
2178                Sprint_Indented_List (Else_Statements (Node));
2179             end if;
2180
2181             Write_Indent_Str ("end if;");
2182
2183          when N_Implicit_Label_Declaration =>
2184             if not Dump_Original_Only then
2185                Write_Indent;
2186                Write_Rewrite_Str ("<<<");
2187                Set_Debug_Sloc;
2188                Write_Id (Defining_Identifier (Node));
2189                Write_Str (" : ");
2190                Write_Str_With_Col_Check ("label");
2191                Write_Rewrite_Str (">>>");
2192             end if;
2193
2194          when N_In =>
2195             Sprint_Left_Opnd (Node);
2196             Write_Str_Sloc (" in ");
2197
2198             if Present (Right_Opnd (Node)) then
2199                Sprint_Right_Opnd (Node);
2200             else
2201                Sprint_Bar_List (Alternatives (Node));
2202             end if;
2203
2204          when N_Incomplete_Type_Declaration =>
2205             Write_Indent_Str_Sloc ("type ");
2206             Write_Id (Defining_Identifier (Node));
2207
2208             if Present (Discriminant_Specifications (Node)) then
2209                Write_Discr_Specs (Node);
2210             elsif Unknown_Discriminants_Present (Node) then
2211                Write_Str_With_Col_Check ("(<>)");
2212             end if;
2213
2214             Write_Char (';');
2215
2216          when N_Index_Or_Discriminant_Constraint =>
2217             Set_Debug_Sloc;
2218             Sprint_Paren_Comma_List (Constraints (Node));
2219
2220          when N_Indexed_Component =>
2221             Sprint_Node_Sloc (Prefix (Node));
2222             Sprint_Opt_Paren_Comma_List (Expressions (Node));
2223
2224          when N_Integer_Literal =>
2225             if Print_In_Hex (Node) then
2226                Write_Uint_With_Col_Check_Sloc (Intval (Node), Hex);
2227             else
2228                Write_Uint_With_Col_Check_Sloc (Intval (Node), Auto);
2229             end if;
2230
2231          when N_Iteration_Scheme =>
2232             if Present (Condition (Node)) then
2233                Write_Str_With_Col_Check_Sloc ("while ");
2234                Sprint_Node (Condition (Node));
2235             else
2236                Write_Str_With_Col_Check_Sloc ("for ");
2237
2238                if Present (Iterator_Specification (Node)) then
2239                   Sprint_Node (Iterator_Specification (Node));
2240                else
2241                   Sprint_Node (Loop_Parameter_Specification (Node));
2242                end if;
2243             end if;
2244
2245             Write_Char (' ');
2246
2247          when N_Iterator_Specification =>
2248             Set_Debug_Sloc;
2249             Write_Id (Defining_Identifier (Node));
2250
2251             if Present (Subtype_Indication (Node)) then
2252                Write_Str_With_Col_Check (" : ");
2253                Sprint_Node (Subtype_Indication (Node));
2254             end if;
2255
2256             if Of_Present (Node) then
2257                Write_Str_With_Col_Check (" of ");
2258             else
2259                Write_Str_With_Col_Check (" in ");
2260             end if;
2261
2262             if Reverse_Present (Node) then
2263                Write_Str_With_Col_Check ("reverse ");
2264             end if;
2265
2266             Sprint_Node (Name (Node));
2267
2268          when N_Itype_Reference =>
2269             Write_Indent_Str_Sloc ("reference ");
2270             Write_Id (Itype (Node));
2271
2272          when N_Label =>
2273             Write_Indent_Str_Sloc ("<<");
2274             Write_Id (Identifier (Node));
2275             Write_Str (">>");
2276
2277          when N_Loop_Parameter_Specification =>
2278             Set_Debug_Sloc;
2279             Write_Id (Defining_Identifier (Node));
2280             Write_Str_With_Col_Check (" in ");
2281
2282             if Reverse_Present (Node) then
2283                Write_Str_With_Col_Check ("reverse ");
2284             end if;
2285
2286             Sprint_Node (Discrete_Subtype_Definition (Node));
2287
2288          when N_Loop_Statement =>
2289             Write_Indent;
2290
2291             if Present (Identifier (Node))
2292               and then (not Has_Created_Identifier (Node)
2293                           or else not Dump_Original_Only)
2294             then
2295                Write_Rewrite_Str ("<<<");
2296                Write_Id (Identifier (Node));
2297                Write_Str (" : ");
2298                Write_Rewrite_Str (">>>");
2299                Sprint_Node (Iteration_Scheme (Node));
2300                Write_Str_With_Col_Check_Sloc ("loop");
2301                Sprint_Indented_List (Statements (Node));
2302                Write_Indent_Str ("end loop ");
2303                Write_Rewrite_Str ("<<<");
2304                Write_Id (Identifier (Node));
2305                Write_Rewrite_Str (">>>");
2306                Write_Char (';');
2307
2308             else
2309                Sprint_Node (Iteration_Scheme (Node));
2310                Write_Str_With_Col_Check_Sloc ("loop");
2311                Sprint_Indented_List (Statements (Node));
2312                Write_Indent_Str ("end loop;");
2313             end if;
2314
2315          when N_Mod_Clause =>
2316             Sprint_Node_List (Pragmas_Before (Node));
2317             Write_Str_With_Col_Check_Sloc ("at mod ");
2318             Sprint_Node (Expression (Node));
2319
2320          when N_Modular_Type_Definition =>
2321             Write_Str_With_Col_Check_Sloc ("mod ");
2322             Sprint_Node (Expression (Node));
2323
2324          when N_Not_In =>
2325             Sprint_Left_Opnd (Node);
2326             Write_Str_Sloc (" not in ");
2327
2328             if Present (Right_Opnd (Node)) then
2329                Sprint_Right_Opnd (Node);
2330             else
2331                Sprint_Bar_List (Alternatives (Node));
2332             end if;
2333
2334          when N_Null =>
2335             Write_Str_With_Col_Check_Sloc ("null");
2336
2337          when N_Null_Statement =>
2338             if Comes_From_Source (Node)
2339               or else Dump_Freeze_Null
2340               or else not Is_List_Member (Node)
2341               or else (No (Prev (Node)) and then No (Next (Node)))
2342             then
2343                Write_Indent_Str_Sloc ("null;");
2344             end if;
2345
2346          when N_Number_Declaration =>
2347             Set_Debug_Sloc;
2348
2349             if Write_Indent_Identifiers (Node) then
2350                Write_Str_With_Col_Check (" : constant ");
2351                Write_Str (" := ");
2352                Sprint_Node (Expression (Node));
2353                Write_Char (';');
2354             end if;
2355
2356          when N_Object_Declaration =>
2357             Set_Debug_Sloc;
2358
2359             if Write_Indent_Identifiers (Node) then
2360                declare
2361                   Def_Id : constant Entity_Id := Defining_Identifier (Node);
2362
2363                begin
2364                   Write_Str_With_Col_Check (" : ");
2365
2366                   if Is_Statically_Allocated (Def_Id) then
2367                      Write_Str_With_Col_Check ("static ");
2368                   end if;
2369
2370                   if Aliased_Present (Node) then
2371                      Write_Str_With_Col_Check ("aliased ");
2372                   end if;
2373
2374                   if Constant_Present (Node) then
2375                      Write_Str_With_Col_Check ("constant ");
2376                   end if;
2377
2378                   --  Ada 2005 (AI-231)
2379
2380                   if Null_Exclusion_Present (Node) then
2381                      Write_Str_With_Col_Check ("not null ");
2382                   end if;
2383
2384                   --  Print type. We used to print the Object_Definition from
2385                   --  the node, but it is much more useful to print the Etype
2386                   --  of the defining identifier for the case where the nominal
2387                   --  type is an unconstrained array type. For example, this
2388                   --  will be a clear reference to the Itype with the bounds
2389                   --  in the case of a type like String. The object after
2390                   --  all is constrained, even if its nominal subtype is
2391                   --  unconstrained.
2392
2393                   declare
2394                      Odef : constant Node_Id := Object_Definition (Node);
2395
2396                   begin
2397                      if Nkind (Odef) = N_Identifier
2398                        and then Present (Etype (Odef))
2399                        and then Is_Array_Type (Etype (Odef))
2400                        and then not Is_Constrained (Etype (Odef))
2401                        and then Present (Etype (Def_Id))
2402                      then
2403                         Sprint_Node (Etype (Def_Id));
2404
2405                      --  In other cases, the nominal type is fine to print
2406
2407                      else
2408                         Sprint_Node (Odef);
2409                      end if;
2410                   end;
2411
2412                   if Present (Expression (Node))
2413                     and then Expression (Node) /= Error
2414                   then
2415                      Write_Str (" := ");
2416                      Sprint_Node (Expression (Node));
2417                   end if;
2418
2419                   Write_Char (';');
2420
2421                   --  Handle implicit importation and implicit exportation of
2422                   --  object declarations:
2423                   --    $pragma import (Convention_Id, Def_Id, "...");
2424                   --    $pragma export (Convention_Id, Def_Id, "...");
2425
2426                   if Is_Internal (Def_Id)
2427                     and then Present (Interface_Name (Def_Id))
2428                   then
2429                      Write_Indent_Str_Sloc ("$pragma ");
2430
2431                      if Is_Imported (Def_Id) then
2432                         Write_Str ("import (");
2433
2434                      else pragma Assert (Is_Exported (Def_Id));
2435                         Write_Str ("export (");
2436                      end if;
2437
2438                      declare
2439                         Prefix : constant String  := "Convention_";
2440                         S      : constant String  := Convention (Def_Id)'Img;
2441
2442                      begin
2443                         Name_Len := S'Last - Prefix'Last;
2444                         Name_Buffer (1 .. Name_Len) :=
2445                           S (Prefix'Last + 1 .. S'Last);
2446                         Set_Casing (All_Lower_Case);
2447                         Write_Str (Name_Buffer (1 .. Name_Len));
2448                      end;
2449
2450                      Write_Str (", ");
2451                      Write_Id  (Def_Id);
2452                      Write_Str (", ");
2453                      Write_String_Table_Entry
2454                        (Strval (Interface_Name (Def_Id)));
2455                      Write_Str (");");
2456                   end if;
2457                end;
2458             end if;
2459
2460          when N_Object_Renaming_Declaration =>
2461             Write_Indent;
2462             Set_Debug_Sloc;
2463             Sprint_Node (Defining_Identifier (Node));
2464             Write_Str (" : ");
2465
2466             --  Ada 2005 (AI-230): Access renamings
2467
2468             if Present (Access_Definition (Node)) then
2469                Sprint_Node (Access_Definition (Node));
2470
2471             elsif Present (Subtype_Mark (Node)) then
2472
2473                --  Ada 2005 (AI-423): Object renaming with a null exclusion
2474
2475                if Null_Exclusion_Present (Node) then
2476                   Write_Str ("not null ");
2477                end if;
2478
2479                Sprint_Node (Subtype_Mark (Node));
2480
2481             else
2482                Write_Str (" ??? ");
2483             end if;
2484
2485             Write_Str_With_Col_Check (" renames ");
2486             Sprint_Node (Name (Node));
2487             Write_Char (';');
2488
2489          when N_Op_Abs =>
2490             Write_Operator (Node, "abs ");
2491             Sprint_Right_Opnd (Node);
2492
2493          when N_Op_Add =>
2494             Sprint_Left_Opnd (Node);
2495             Write_Operator (Node, " + ");
2496             Sprint_Right_Opnd (Node);
2497
2498          when N_Op_And =>
2499             Sprint_Left_Opnd (Node);
2500             Write_Operator (Node, " and ");
2501             Sprint_Right_Opnd (Node);
2502
2503          when N_Op_Concat =>
2504             Sprint_Left_Opnd (Node);
2505             Write_Operator (Node, " & ");
2506             Sprint_Right_Opnd (Node);
2507
2508          when N_Op_Divide =>
2509             Sprint_Left_Opnd (Node);
2510             Write_Char (' ');
2511             Process_TFAI_RR_Flags (Node);
2512             Write_Operator (Node, "/ ");
2513             Sprint_Right_Opnd (Node);
2514
2515          when N_Op_Eq =>
2516             Sprint_Left_Opnd (Node);
2517             Write_Operator (Node, " = ");
2518             Sprint_Right_Opnd (Node);
2519
2520          when N_Op_Expon =>
2521             Sprint_Left_Opnd (Node);
2522             Write_Operator (Node, " ** ");
2523             Sprint_Right_Opnd (Node);
2524
2525          when N_Op_Ge =>
2526             Sprint_Left_Opnd (Node);
2527             Write_Operator (Node, " >= ");
2528             Sprint_Right_Opnd (Node);
2529
2530          when N_Op_Gt =>
2531             Sprint_Left_Opnd (Node);
2532             Write_Operator (Node, " > ");
2533             Sprint_Right_Opnd (Node);
2534
2535          when N_Op_Le =>
2536             Sprint_Left_Opnd (Node);
2537             Write_Operator (Node, " <= ");
2538             Sprint_Right_Opnd (Node);
2539
2540          when N_Op_Lt =>
2541             Sprint_Left_Opnd (Node);
2542             Write_Operator (Node, " < ");
2543             Sprint_Right_Opnd (Node);
2544
2545          when N_Op_Minus =>
2546             Write_Operator (Node, "-");
2547             Sprint_Right_Opnd (Node);
2548
2549          when N_Op_Mod =>
2550             Sprint_Left_Opnd (Node);
2551
2552             if Treat_Fixed_As_Integer (Node) then
2553                Write_Str (" #");
2554             end if;
2555
2556             Write_Operator (Node, " mod ");
2557             Sprint_Right_Opnd (Node);
2558
2559          when N_Op_Multiply =>
2560             Sprint_Left_Opnd (Node);
2561             Write_Char (' ');
2562             Process_TFAI_RR_Flags (Node);
2563             Write_Operator (Node, "* ");
2564             Sprint_Right_Opnd (Node);
2565
2566          when N_Op_Ne =>
2567             Sprint_Left_Opnd (Node);
2568             Write_Operator (Node, " /= ");
2569             Sprint_Right_Opnd (Node);
2570
2571          when N_Op_Not =>
2572             Write_Operator (Node, "not ");
2573             Sprint_Right_Opnd (Node);
2574
2575          when N_Op_Or =>
2576             Sprint_Left_Opnd (Node);
2577             Write_Operator (Node, " or ");
2578             Sprint_Right_Opnd (Node);
2579
2580          when N_Op_Plus =>
2581             Write_Operator (Node, "+");
2582             Sprint_Right_Opnd (Node);
2583
2584          when N_Op_Rem =>
2585             Sprint_Left_Opnd (Node);
2586
2587             if Treat_Fixed_As_Integer (Node) then
2588                Write_Str (" #");
2589             end if;
2590
2591             Write_Operator (Node, " rem ");
2592             Sprint_Right_Opnd (Node);
2593
2594          when N_Op_Shift =>
2595             Set_Debug_Sloc;
2596             Write_Id (Node);
2597             Write_Char ('!');
2598             Write_Str_With_Col_Check ("(");
2599             Sprint_Node (Left_Opnd (Node));
2600             Write_Str (", ");
2601             Sprint_Node (Right_Opnd (Node));
2602             Write_Char (')');
2603
2604          when N_Op_Subtract =>
2605             Sprint_Left_Opnd (Node);
2606             Write_Operator (Node, " - ");
2607             Sprint_Right_Opnd (Node);
2608
2609          when N_Op_Xor =>
2610             Sprint_Left_Opnd (Node);
2611             Write_Operator (Node, " xor ");
2612             Sprint_Right_Opnd (Node);
2613
2614          when N_Operator_Symbol =>
2615             Write_Name_With_Col_Check_Sloc (Chars (Node));
2616
2617          when N_Ordinary_Fixed_Point_Definition =>
2618             Write_Str_With_Col_Check_Sloc ("delta ");
2619             Sprint_Node (Delta_Expression (Node));
2620             Sprint_Opt_Node (Real_Range_Specification (Node));
2621
2622          when N_Or_Else =>
2623             Sprint_Left_Opnd (Node);
2624             Write_Str_Sloc (" or else ");
2625             Sprint_Right_Opnd (Node);
2626
2627          when N_Others_Choice =>
2628             if All_Others (Node) then
2629                Write_Str_With_Col_Check ("all ");
2630             end if;
2631
2632             Write_Str_With_Col_Check_Sloc ("others");
2633
2634          when N_Package_Body =>
2635             Extra_Blank_Line;
2636             Write_Indent_Str_Sloc ("package body ");
2637             Sprint_Node (Defining_Unit_Name (Node));
2638             Write_Str (" is");
2639             Sprint_Indented_List (Declarations (Node));
2640
2641             if Present (Handled_Statement_Sequence (Node)) then
2642                Write_Indent_Str ("begin");
2643                Sprint_Node (Handled_Statement_Sequence (Node));
2644             end if;
2645
2646             Write_Indent_Str ("end ");
2647             Sprint_End_Label
2648               (Handled_Statement_Sequence (Node), Defining_Unit_Name (Node));
2649             Write_Char (';');
2650
2651          when N_Package_Body_Stub =>
2652             Write_Indent_Str_Sloc ("package body ");
2653             Sprint_Node (Defining_Identifier (Node));
2654             Write_Str_With_Col_Check (" is separate;");
2655
2656          when N_Package_Declaration =>
2657             Extra_Blank_Line;
2658             Write_Indent;
2659             Sprint_Node_Sloc (Specification (Node));
2660             Write_Char (';');
2661
2662             --  If this is an instantiation, get the aspects from the original
2663             --  instantiation node.
2664
2665             if Is_Generic_Instance (Defining_Entity (Node))
2666               and then Has_Aspects
2667                          (Package_Instantiation (Defining_Entity (Node)))
2668             then
2669                Sprint_Aspect_Specifications
2670                  (Package_Instantiation (Defining_Entity (Node)),
2671                    Semicolon => True);
2672             end if;
2673
2674          when N_Package_Instantiation =>
2675             Extra_Blank_Line;
2676             Write_Indent_Str_Sloc ("package ");
2677             Sprint_Node (Defining_Unit_Name (Node));
2678             Write_Str (" is new ");
2679             Sprint_Node (Name (Node));
2680             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2681             Write_Char (';');
2682
2683          when N_Package_Renaming_Declaration =>
2684             Write_Indent_Str_Sloc ("package ");
2685             Sprint_Node (Defining_Unit_Name (Node));
2686             Write_Str_With_Col_Check (" renames ");
2687             Sprint_Node (Name (Node));
2688             Write_Char (';');
2689
2690          when N_Package_Specification =>
2691             Write_Str_With_Col_Check_Sloc ("package ");
2692             Sprint_Node (Defining_Unit_Name (Node));
2693
2694             if Nkind (Parent (Node)) = N_Generic_Package_Declaration
2695               and then Has_Aspects (Parent (Node))
2696             then
2697                Sprint_Aspect_Specifications
2698                  (Parent (Node), Semicolon => False);
2699
2700             --  An instantiation is rewritten as a package declaration, but
2701             --  the aspects belong to the instantiation node.
2702
2703             elsif Nkind (Parent (Node)) = N_Package_Declaration then
2704                declare
2705                   Pack : constant Entity_Id := Defining_Entity (Node);
2706
2707                begin
2708                   if not Is_Generic_Instance (Pack) then
2709                      if Has_Aspects (Parent (Node)) then
2710                         Sprint_Aspect_Specifications
2711                           (Parent (Node), Semicolon => False);
2712                      end if;
2713                   end if;
2714                end;
2715             end if;
2716
2717             Write_Str (" is");
2718             Sprint_Indented_List (Visible_Declarations (Node));
2719
2720             if Present (Private_Declarations (Node)) then
2721                Write_Indent_Str ("private");
2722                Sprint_Indented_List (Private_Declarations (Node));
2723             end if;
2724
2725             Write_Indent_Str ("end ");
2726             Sprint_Node (Defining_Unit_Name (Node));
2727
2728          when N_Parameter_Association =>
2729             Sprint_Node_Sloc (Selector_Name (Node));
2730             Write_Str (" => ");
2731             Sprint_Node (Explicit_Actual_Parameter (Node));
2732
2733          when N_Parameter_Specification =>
2734             Set_Debug_Sloc;
2735
2736             if Write_Identifiers (Node) then
2737                Write_Str (" : ");
2738
2739                if In_Present (Node) then
2740                   Write_Str_With_Col_Check ("in ");
2741                end if;
2742
2743                if Out_Present (Node) then
2744                   Write_Str_With_Col_Check ("out ");
2745                end if;
2746
2747                --  Ada 2005 (AI-231): Parameter specification may carry null
2748                --  exclusion. Do not print it now if this is an access formal,
2749                --  it is emitted when the access definition is displayed.
2750
2751                if Null_Exclusion_Present (Node)
2752                  and then Nkind (Parameter_Type (Node)) /= N_Access_Definition
2753                then
2754                   Write_Str ("not null ");
2755                end if;
2756
2757                if Aliased_Present (Node) then
2758                   Write_Str ("aliased ");
2759                end if;
2760
2761                Sprint_Node (Parameter_Type (Node));
2762
2763                if Present (Expression (Node)) then
2764                   Write_Str (" := ");
2765                   Sprint_Node (Expression (Node));
2766                end if;
2767             else
2768                Write_Str (", ");
2769             end if;
2770
2771          when N_Pop_Constraint_Error_Label =>
2772             Write_Indent_Str ("%pop_constraint_error_label");
2773
2774          when N_Pop_Program_Error_Label =>
2775             Write_Indent_Str ("%pop_program_error_label");
2776
2777          when N_Pop_Storage_Error_Label =>
2778             Write_Indent_Str ("%pop_storage_error_label");
2779
2780          when N_Private_Extension_Declaration =>
2781             Write_Indent_Str_Sloc ("type ");
2782             Write_Id (Defining_Identifier (Node));
2783
2784             if Present (Discriminant_Specifications (Node)) then
2785                Write_Discr_Specs (Node);
2786             elsif Unknown_Discriminants_Present (Node) then
2787                Write_Str_With_Col_Check ("(<>)");
2788             end if;
2789
2790             Write_Str_With_Col_Check (" is new ");
2791             Sprint_Node (Subtype_Indication (Node));
2792
2793             if Present (Interface_List (Node)) then
2794                Write_Str_With_Col_Check (" and ");
2795                Sprint_And_List (Interface_List (Node));
2796             end if;
2797
2798             Write_Str_With_Col_Check (" with private;");
2799
2800          when N_Private_Type_Declaration =>
2801             Write_Indent_Str_Sloc ("type ");
2802             Write_Id (Defining_Identifier (Node));
2803
2804             if Present (Discriminant_Specifications (Node)) then
2805                Write_Discr_Specs (Node);
2806             elsif Unknown_Discriminants_Present (Node) then
2807                Write_Str_With_Col_Check ("(<>)");
2808             end if;
2809
2810             Write_Str (" is ");
2811
2812             if Tagged_Present (Node) then
2813                Write_Str_With_Col_Check ("tagged ");
2814             end if;
2815
2816             if Limited_Present (Node) then
2817                Write_Str_With_Col_Check ("limited ");
2818             end if;
2819
2820             Write_Str_With_Col_Check ("private;");
2821
2822          when N_Push_Constraint_Error_Label =>
2823             Write_Indent_Str ("%push_constraint_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_Program_Error_Label =>
2832             Write_Indent_Str ("%push_program_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_Push_Storage_Error_Label =>
2841             Write_Indent_Str ("%push_storage_error_label (");
2842
2843             if Present (Exception_Label (Node)) then
2844                Write_Name_With_Col_Check (Chars (Exception_Label (Node)));
2845             end if;
2846
2847             Write_Str (")");
2848
2849          when N_Pragma =>
2850             Write_Indent_Str_Sloc ("pragma ");
2851             Write_Name_With_Col_Check (Pragma_Name_Unmapped (Node));
2852
2853             if Present (Pragma_Argument_Associations (Node)) then
2854                Sprint_Opt_Paren_Comma_List
2855                  (Pragma_Argument_Associations (Node));
2856             end if;
2857
2858             Write_Char (';');
2859
2860          when N_Pragma_Argument_Association =>
2861             Set_Debug_Sloc;
2862
2863             if Chars (Node) /= No_Name then
2864                Write_Name_With_Col_Check (Chars (Node));
2865                Write_Str (" => ");
2866             end if;
2867
2868             Sprint_Node (Expression (Node));
2869
2870          when N_Procedure_Call_Statement =>
2871             Write_Indent;
2872             Set_Debug_Sloc;
2873             Write_Subprogram_Name (Name (Node));
2874             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2875             Write_Char (';');
2876
2877          when N_Procedure_Instantiation =>
2878             Write_Indent_Str_Sloc ("procedure ");
2879             Sprint_Node (Defining_Unit_Name (Node));
2880             Write_Str_With_Col_Check (" is new ");
2881             Sprint_Node (Name (Node));
2882             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2883             Write_Char (';');
2884
2885          when N_Procedure_Specification =>
2886             Write_Str_With_Col_Check_Sloc ("procedure ");
2887             Sprint_Node (Defining_Unit_Name (Node));
2888             Write_Param_Specs (Node);
2889
2890          when N_Protected_Body =>
2891             Write_Indent_Str_Sloc ("protected body ");
2892             Write_Id (Defining_Identifier (Node));
2893             Write_Str (" is");
2894             Sprint_Indented_List (Declarations (Node));
2895             Write_Indent_Str ("end ");
2896             Write_Id (Defining_Identifier (Node));
2897             Write_Char (';');
2898
2899          when N_Protected_Body_Stub =>
2900             Write_Indent_Str_Sloc ("protected body ");
2901             Write_Id (Defining_Identifier (Node));
2902             Write_Str_With_Col_Check (" is separate;");
2903
2904          when N_Protected_Definition =>
2905             Set_Debug_Sloc;
2906             Sprint_Indented_List (Visible_Declarations (Node));
2907
2908             if Present (Private_Declarations (Node)) then
2909                Write_Indent_Str ("private");
2910                Sprint_Indented_List (Private_Declarations (Node));
2911             end if;
2912
2913             Write_Indent_Str ("end ");
2914
2915          when N_Protected_Type_Declaration =>
2916             Write_Indent_Str_Sloc ("protected type ");
2917             Sprint_Node (Defining_Identifier (Node));
2918             Write_Discr_Specs (Node);
2919
2920             if Present (Interface_List (Node)) then
2921                Write_Str (" is new ");
2922                Sprint_And_List (Interface_List (Node));
2923                Write_Str (" with ");
2924             else
2925                Write_Str (" is");
2926             end if;
2927
2928             Sprint_Node (Protected_Definition (Node));
2929             Write_Id (Defining_Identifier (Node));
2930             Write_Char (';');
2931
2932          when N_Qualified_Expression =>
2933             Sprint_Node (Subtype_Mark (Node));
2934             Write_Char_Sloc (''');
2935
2936             --  Print expression, make sure we have at least one level of
2937             --  parentheses around the expression. For cases of qualified
2938             --  expressions in the source, this is always the case, but
2939             --  for generated qualifications, there may be no explicit
2940             --  parentheses present.
2941
2942             if Paren_Count (Expression (Node)) /= 0 then
2943                Sprint_Node (Expression (Node));
2944
2945             else
2946                Write_Char ('(');
2947                Sprint_Node (Expression (Node));
2948
2949                --  Odd case, for the qualified expressions used in machine
2950                --  code the argument may be a procedure call, resulting in
2951                --  a junk semicolon before the right parent, get rid of it.
2952
2953                Write_Erase_Char (';');
2954
2955                --  Now we can add the terminating right paren
2956
2957                Write_Char (')');
2958             end if;
2959
2960          when N_Quantified_Expression =>
2961             Write_Str (" for");
2962
2963             if All_Present (Node) then
2964                Write_Str (" all ");
2965             else
2966                Write_Str (" some ");
2967             end if;
2968
2969             if Present (Iterator_Specification (Node)) then
2970                Sprint_Node (Iterator_Specification (Node));
2971             else
2972                Sprint_Node (Loop_Parameter_Specification (Node));
2973             end if;
2974
2975             Write_Str (" => ");
2976             Sprint_Node (Condition (Node));
2977
2978          when N_Raise_Expression =>
2979             declare
2980                Has_Parens : constant Boolean := Paren_Count (Node) > 0;
2981
2982             begin
2983                --  The syntax for raise_expression does not include parentheses
2984                --  but sometimes parentheses are required, so unconditionally
2985                --  generate them here unless already present.
2986
2987                if not Has_Parens then
2988                   Write_Char ('(');
2989                end if;
2990
2991                Write_Str_With_Col_Check_Sloc ("raise ");
2992                Sprint_Node (Name (Node));
2993
2994                if Present (Expression (Node)) then
2995                   Write_Str_With_Col_Check (" with ");
2996                   Sprint_Node (Expression (Node));
2997                end if;
2998
2999                if not Has_Parens then
3000                   Write_Char (')');
3001                end if;
3002             end;
3003
3004          when N_Raise_Constraint_Error =>
3005
3006             --  This node can be used either as a subexpression or as a
3007             --  statement form. The following test is a reasonably reliable
3008             --  way to distinguish the two cases.
3009
3010             if Is_List_Member (Node)
3011               and then Nkind (Parent (Node)) not in N_Subexpr
3012             then
3013                Write_Indent;
3014             end if;
3015
3016             Write_Str_With_Col_Check_Sloc ("[constraint_error");
3017             Write_Condition_And_Reason (Node);
3018
3019          when N_Raise_Program_Error =>
3020
3021             --  This node can be used either as a subexpression or as a
3022             --  statement form. The following test is a reasonably reliable
3023             --  way to distinguish the two cases.
3024
3025             if Is_List_Member (Node)
3026               and then Nkind (Parent (Node)) not in N_Subexpr
3027             then
3028                Write_Indent;
3029             end if;
3030
3031             Write_Str_With_Col_Check_Sloc ("[program_error");
3032             Write_Condition_And_Reason (Node);
3033
3034          when N_Raise_Storage_Error =>
3035
3036             --  This node can be used either as a subexpression or as a
3037             --  statement form. The following test is a reasonably reliable
3038             --  way to distinguish the two cases.
3039
3040             if Is_List_Member (Node)
3041               and then Nkind (Parent (Node)) not in N_Subexpr
3042             then
3043                Write_Indent;
3044             end if;
3045
3046             Write_Str_With_Col_Check_Sloc ("[storage_error");
3047             Write_Condition_And_Reason (Node);
3048
3049          when N_Raise_Statement =>
3050             Write_Indent_Str_Sloc ("raise ");
3051             Sprint_Node (Name (Node));
3052
3053             if Present (Expression (Node)) then
3054                Write_Str_With_Col_Check_Sloc (" with ");
3055                Sprint_Node (Expression (Node));
3056             end if;
3057
3058             Write_Char (';');
3059
3060          when N_Range =>
3061             Sprint_Node (Low_Bound (Node));
3062             Write_Str_Sloc (" .. ");
3063             Sprint_Node (High_Bound (Node));
3064             Update_Itype (Node);
3065
3066          when N_Range_Constraint =>
3067             Write_Str_With_Col_Check_Sloc ("range ");
3068             Sprint_Node (Range_Expression (Node));
3069
3070          when N_Real_Literal =>
3071             Write_Ureal_With_Col_Check_Sloc (Realval (Node));
3072
3073          when N_Real_Range_Specification =>
3074             Write_Str_With_Col_Check_Sloc ("range ");
3075             Sprint_Node (Low_Bound (Node));
3076             Write_Str (" .. ");
3077             Sprint_Node (High_Bound (Node));
3078
3079          when N_Record_Definition =>
3080             if Abstract_Present (Node) then
3081                Write_Str_With_Col_Check ("abstract ");
3082             end if;
3083
3084             if Tagged_Present (Node) then
3085                Write_Str_With_Col_Check ("tagged ");
3086             end if;
3087
3088             if Limited_Present (Node) then
3089                Write_Str_With_Col_Check ("limited ");
3090             end if;
3091
3092             if Null_Present (Node) then
3093                Write_Str_With_Col_Check_Sloc ("null record");
3094
3095             else
3096                Write_Str_With_Col_Check_Sloc ("record");
3097                Sprint_Node (Component_List (Node));
3098                Write_Indent_Str ("end record");
3099             end if;
3100
3101          when N_Record_Representation_Clause =>
3102             Write_Indent_Str_Sloc ("for ");
3103             Sprint_Node (Identifier (Node));
3104             Write_Str_With_Col_Check (" use record ");
3105
3106             if Present (Mod_Clause (Node)) then
3107                Sprint_Node (Mod_Clause (Node));
3108             end if;
3109
3110             Sprint_Indented_List (Component_Clauses (Node));
3111             Write_Indent_Str ("end record;");
3112
3113          when N_Reduction_Expression =>
3114             Write_Str (" for");
3115
3116             if Present (Iterator_Specification (Node)) then
3117                Sprint_Node (Iterator_Specification (Node));
3118             else
3119                Sprint_Node (Loop_Parameter_Specification (Node));
3120             end if;
3121
3122             Write_Str (" => ");
3123             Sprint_Node (Expression (Node));
3124             null;
3125
3126          when N_Reduction_Expression_Parameter =>
3127             Write_Char ('<');
3128
3129             if Present (Expression (Node)) then
3130                Sprint_Node (Expression (Node));
3131             end if;
3132
3133             Write_Char ('>');
3134
3135          when N_Reference =>
3136             Sprint_Node (Prefix (Node));
3137             Write_Str_With_Col_Check_Sloc ("'reference");
3138
3139          when N_Requeue_Statement =>
3140             Write_Indent_Str_Sloc ("requeue ");
3141             Sprint_Node (Name (Node));
3142
3143             if Abort_Present (Node) then
3144                Write_Str_With_Col_Check (" with abort");
3145             end if;
3146
3147             Write_Char (';');
3148
3149          --  Don't we want to print more detail???
3150
3151          --  Doc of this extended syntax belongs in sinfo.ads and/or
3152          --  sprint.ads ???
3153
3154          when N_SCIL_Dispatch_Table_Tag_Init =>
3155             Write_Indent_Str ("[N_SCIL_Dispatch_Table_Tag_Init]");
3156
3157          when N_SCIL_Dispatching_Call =>
3158             Write_Indent_Str ("[N_SCIL_Dispatching_Node]");
3159
3160          when N_SCIL_Membership_Test =>
3161             Write_Indent_Str ("[N_SCIL_Membership_Test]");
3162
3163          when N_Simple_Return_Statement =>
3164             if Present (Expression (Node)) then
3165                Write_Indent_Str_Sloc ("return ");
3166                Sprint_Node (Expression (Node));
3167                Write_Char (';');
3168             else
3169                Write_Indent_Str_Sloc ("return;");
3170             end if;
3171
3172          when N_Selective_Accept =>
3173             Write_Indent_Str_Sloc ("select");
3174
3175             declare
3176                Alt_Node : Node_Id;
3177             begin
3178                Alt_Node := First (Select_Alternatives (Node));
3179                loop
3180                   Indent_Begin;
3181                   Sprint_Node (Alt_Node);
3182                   Indent_End;
3183                   Next (Alt_Node);
3184                   exit when No (Alt_Node);
3185                   Write_Indent_Str ("or");
3186                end loop;
3187             end;
3188
3189             if Present (Else_Statements (Node)) then
3190                Write_Indent_Str ("else");
3191                Sprint_Indented_List (Else_Statements (Node));
3192             end if;
3193
3194             Write_Indent_Str ("end select;");
3195
3196          when N_Signed_Integer_Type_Definition =>
3197             Write_Str_With_Col_Check_Sloc ("range ");
3198             Sprint_Node (Low_Bound (Node));
3199             Write_Str (" .. ");
3200             Sprint_Node (High_Bound (Node));
3201
3202          when N_Single_Protected_Declaration =>
3203             Write_Indent_Str_Sloc ("protected ");
3204             Write_Id (Defining_Identifier (Node));
3205             Write_Str (" is");
3206             Sprint_Node (Protected_Definition (Node));
3207             Write_Id (Defining_Identifier (Node));
3208             Write_Char (';');
3209
3210          when N_Single_Task_Declaration =>
3211             Write_Indent_Str_Sloc ("task ");
3212             Sprint_Node (Defining_Identifier (Node));
3213
3214             if Present (Task_Definition (Node)) then
3215                Write_Str (" is");
3216                Sprint_Node (Task_Definition (Node));
3217             end if;
3218
3219             Write_Char (';');
3220
3221          when N_Selected_Component =>
3222             Sprint_Node (Prefix (Node));
3223             Write_Char_Sloc ('.');
3224             Sprint_Node (Selector_Name (Node));
3225
3226          when N_Slice =>
3227             Set_Debug_Sloc;
3228             Sprint_Node (Prefix (Node));
3229             Write_Str_With_Col_Check (" (");
3230             Sprint_Node (Discrete_Range (Node));
3231             Write_Char (')');
3232
3233          when N_String_Literal =>
3234             if String_Length (Strval (Node)) + Column > Sprint_Line_Limit then
3235                Write_Indent_Str ("  ");
3236             end if;
3237
3238             Set_Debug_Sloc;
3239             Write_String_Table_Entry (Strval (Node));
3240
3241          when N_Subprogram_Body =>
3242
3243             --  Output extra blank line unless we are in freeze actions
3244
3245             if Freeze_Indent = 0 then
3246                Extra_Blank_Line;
3247             end if;
3248
3249             Write_Indent;
3250
3251             if Present (Corresponding_Spec (Node)) then
3252                Sprint_Node_Sloc (Parent (Corresponding_Spec (Node)));
3253             else
3254                Sprint_Node_Sloc (Specification (Node));
3255             end if;
3256
3257             Write_Str (" is");
3258
3259             Sprint_Indented_List (Declarations (Node));
3260             Write_Indent_Str ("begin");
3261             Sprint_Node (Handled_Statement_Sequence (Node));
3262
3263             Write_Indent_Str ("end ");
3264
3265             Sprint_End_Label
3266               (Handled_Statement_Sequence (Node),
3267                  Defining_Unit_Name (Specification (Node)));
3268             Write_Char (';');
3269
3270             if Is_List_Member (Node)
3271               and then Present (Next (Node))
3272               and then Nkind (Next (Node)) /= N_Subprogram_Body
3273             then
3274                Write_Indent;
3275             end if;
3276
3277          when N_Subprogram_Body_Stub =>
3278             Write_Indent;
3279             Sprint_Node_Sloc (Specification (Node));
3280             Write_Str_With_Col_Check (" is separate;");
3281
3282          when N_Subprogram_Declaration =>
3283             Write_Indent;
3284             Sprint_Node_Sloc (Specification (Node));
3285
3286             if Nkind (Specification (Node)) = N_Procedure_Specification
3287               and then Null_Present (Specification (Node))
3288             then
3289                Write_Str_With_Col_Check (" is null");
3290             end if;
3291
3292             Write_Char (';');
3293
3294          when N_Subprogram_Renaming_Declaration =>
3295             Write_Indent;
3296             Sprint_Node (Specification (Node));
3297             Write_Str_With_Col_Check_Sloc (" renames ");
3298             Sprint_Node (Name (Node));
3299             Write_Char (';');
3300
3301          when N_Subtype_Declaration =>
3302             Write_Indent_Str_Sloc ("subtype ");
3303             Sprint_Node (Defining_Identifier (Node));
3304             Write_Str (" is ");
3305
3306             --  Ada 2005 (AI-231)
3307
3308             if Null_Exclusion_Present (Node) then
3309                Write_Str ("not null ");
3310             end if;
3311
3312             Sprint_Node (Subtype_Indication (Node));
3313             Write_Char (';');
3314
3315          when N_Subtype_Indication =>
3316             Sprint_Node_Sloc (Subtype_Mark (Node));
3317             Write_Char (' ');
3318             Sprint_Node (Constraint (Node));
3319
3320          when N_Subunit =>
3321             Write_Indent_Str_Sloc ("separate (");
3322             Sprint_Node (Name (Node));
3323             Write_Char (')');
3324             Extra_Blank_Line;
3325             Sprint_Node (Proper_Body (Node));
3326
3327          when N_Target_Name =>
3328             Write_Char ('@');
3329
3330          when N_Task_Body =>
3331             Write_Indent_Str_Sloc ("task body ");
3332             Write_Id (Defining_Identifier (Node));
3333             Write_Str (" is");
3334             Sprint_Indented_List (Declarations (Node));
3335             Write_Indent_Str ("begin");
3336             Sprint_Node (Handled_Statement_Sequence (Node));
3337             Write_Indent_Str ("end ");
3338             Sprint_End_Label
3339               (Handled_Statement_Sequence (Node), Defining_Identifier (Node));
3340             Write_Char (';');
3341
3342          when N_Task_Body_Stub =>
3343             Write_Indent_Str_Sloc ("task body ");
3344             Write_Id (Defining_Identifier (Node));
3345             Write_Str_With_Col_Check (" is separate;");
3346
3347          when N_Task_Definition =>
3348             Set_Debug_Sloc;
3349             Sprint_Indented_List (Visible_Declarations (Node));
3350
3351             if Present (Private_Declarations (Node)) then
3352                Write_Indent_Str ("private");
3353                Sprint_Indented_List (Private_Declarations (Node));
3354             end if;
3355
3356             Write_Indent_Str ("end ");
3357             Sprint_End_Label (Node, Defining_Identifier (Parent (Node)));
3358
3359          when N_Task_Type_Declaration =>
3360             Write_Indent_Str_Sloc ("task type ");
3361             Sprint_Node (Defining_Identifier (Node));
3362             Write_Discr_Specs (Node);
3363
3364             if Present (Interface_List (Node)) then
3365                Write_Str (" is new ");
3366                Sprint_And_List (Interface_List (Node));
3367             end if;
3368
3369             if Present (Task_Definition (Node)) then
3370                if No (Interface_List (Node)) then
3371                   Write_Str (" is");
3372                else
3373                   Write_Str (" with ");
3374                end if;
3375
3376                Sprint_Node (Task_Definition (Node));
3377             end if;
3378
3379             Write_Char (';');
3380
3381          when N_Terminate_Alternative =>
3382             Sprint_Node_List (Pragmas_Before (Node));
3383             Write_Indent;
3384
3385             if Present (Condition (Node)) then
3386                Write_Str_With_Col_Check ("when ");
3387                Sprint_Node (Condition (Node));
3388                Write_Str (" => ");
3389             end if;
3390
3391             Write_Str_With_Col_Check_Sloc ("terminate;");
3392             Sprint_Node_List (Pragmas_After (Node));
3393
3394          when N_Timed_Entry_Call =>
3395             Write_Indent_Str_Sloc ("select");
3396             Indent_Begin;
3397             Sprint_Node (Entry_Call_Alternative (Node));
3398             Indent_End;
3399             Write_Indent_Str ("or");
3400             Indent_Begin;
3401             Sprint_Node (Delay_Alternative (Node));
3402             Indent_End;
3403             Write_Indent_Str ("end select;");
3404
3405          when N_Triggering_Alternative =>
3406             Sprint_Node_List (Pragmas_Before (Node));
3407             Sprint_Node_Sloc (Triggering_Statement (Node));
3408             Sprint_Node_List (Statements (Node));
3409
3410          when N_Type_Conversion =>
3411             Set_Debug_Sloc;
3412             Sprint_Node (Subtype_Mark (Node));
3413             Col_Check (4);
3414
3415             if Conversion_OK (Node) then
3416                Write_Char ('?');
3417             end if;
3418
3419             if Float_Truncate (Node) then
3420                Write_Char ('^');
3421             end if;
3422
3423             if Rounded_Result (Node) then
3424                Write_Char ('@');
3425             end if;
3426
3427             Write_Char ('(');
3428             Sprint_Node (Expression (Node));
3429             Write_Char (')');
3430
3431          when N_Unchecked_Expression =>
3432             Col_Check (10);
3433             Write_Str ("`(");
3434             Sprint_Node_Sloc (Expression (Node));
3435             Write_Char (')');
3436
3437          when N_Unchecked_Type_Conversion =>
3438             Sprint_Node (Subtype_Mark (Node));
3439             Write_Char ('!');
3440             Write_Str_With_Col_Check ("(");
3441             Sprint_Node_Sloc (Expression (Node));
3442             Write_Char (')');
3443
3444          when N_Unconstrained_Array_Definition =>
3445             Write_Str_With_Col_Check_Sloc ("array (");
3446
3447             declare
3448                Node1 : Node_Id;
3449             begin
3450                Node1 := First (Subtype_Marks (Node));
3451                loop
3452                   Sprint_Node (Node1);
3453                   Write_Str_With_Col_Check (" range <>");
3454                   Next (Node1);
3455                   exit when Node1 = Empty;
3456                   Write_Str (", ");
3457                end loop;
3458             end;
3459
3460             Write_Str (") of ");
3461             Sprint_Node (Component_Definition (Node));
3462
3463          when N_Unused_At_Start | N_Unused_At_End =>
3464             Write_Indent_Str ("***** Error, unused node encountered *****");
3465             Write_Eol;
3466
3467          when N_Use_Package_Clause =>
3468             Write_Indent_Str_Sloc ("use ");
3469             Sprint_Node_Sloc (Name (Node));
3470             Write_Char (';');
3471
3472          when N_Use_Type_Clause =>
3473             Write_Indent_Str_Sloc ("use type ");
3474             Sprint_Node_Sloc (Subtype_Mark (Node));
3475             Write_Char (';');
3476
3477          when N_Validate_Unchecked_Conversion =>
3478             Write_Indent_Str_Sloc ("validate unchecked_conversion (");
3479             Sprint_Node (Source_Type (Node));
3480             Write_Str (", ");
3481             Sprint_Node (Target_Type (Node));
3482             Write_Str (");");
3483
3484          when N_Variable_Reference_Marker =>
3485             null;
3486
3487             --  Enable the following code for debugging purposes only
3488
3489             --  if Is_Read (Node) and then Is_Write (Node) then
3490             --     Write_Indent_Str ("rw#");
3491
3492             --  elsif Is_Read (Node) then
3493             --     Write_Indent_Str ("r#");
3494
3495             --  else
3496             --     pragma Assert (Is_Write (Node));
3497             --     Write_Indent_Str ("w#");
3498             --  end if;
3499
3500             --  Write_Id (Target (Node));
3501             --  Write_Char ('#');
3502
3503          when N_Variant =>
3504             Write_Indent_Str_Sloc ("when ");
3505             Sprint_Bar_List (Discrete_Choices (Node));
3506             Write_Str (" => ");
3507             Sprint_Node (Component_List (Node));
3508
3509          when N_Variant_Part =>
3510             Indent_Begin;
3511             Write_Indent_Str_Sloc ("case ");
3512             Sprint_Node (Name (Node));
3513             Write_Str (" is ");
3514             Sprint_Indented_List (Variants (Node));
3515             Write_Indent_Str ("end case");
3516             Indent_End;
3517
3518          when N_With_Clause =>
3519
3520             --  Special test, if we are dumping the original tree only,
3521             --  then we want to eliminate the bogus with clauses that
3522             --  correspond to the non-existent children of Text_IO.
3523
3524             if Dump_Original_Only
3525               and then Is_Text_IO_Special_Unit (Name (Node))
3526             then
3527                null;
3528
3529             --  Normal case, output the with clause
3530
3531             else
3532                if First_Name (Node) or else not Dump_Original_Only then
3533
3534                   --  Ada 2005 (AI-50217): Print limited with_clauses
3535
3536                   if Private_Present (Node) and Limited_Present (Node) then
3537                      Write_Indent_Str ("limited private with ");
3538
3539                   elsif Private_Present (Node) then
3540                      Write_Indent_Str ("private with ");
3541
3542                   elsif Limited_Present (Node) then
3543                      Write_Indent_Str ("limited with ");
3544
3545                   else
3546                      Write_Indent_Str ("with ");
3547                   end if;
3548
3549                else
3550                   Write_Str (", ");
3551                end if;
3552
3553                Sprint_Node_Sloc (Name (Node));
3554
3555                if Last_Name (Node) or else not Dump_Original_Only then
3556                   Write_Char (';');
3557                end if;
3558             end if;
3559       end case;
3560
3561       --  Print aspects, except for special case of package declaration,
3562       --  where the aspects are printed inside the package specification.
3563
3564       if Has_Aspects (Node)
3565          and then not Nkind_In (Node, N_Package_Declaration,
3566                                       N_Generic_Package_Declaration)
3567       then
3568          Sprint_Aspect_Specifications (Node, Semicolon => True);
3569       end if;
3570
3571       if Nkind (Node) in N_Subexpr
3572         and then Do_Range_Check (Node)
3573       then
3574          Write_Str ("}");
3575       end if;
3576
3577       for J in 1 .. Paren_Count (Node) loop
3578          Write_Char (')');
3579       end loop;
3580
3581       Dump_Node := Save_Dump_Node;
3582    end Sprint_Node_Actual;
3583
3584    ----------------------
3585    -- Sprint_Node_List --
3586    ----------------------
3587
3588    procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False) is
3589       Node : Node_Id;
3590
3591    begin
3592       if Is_Non_Empty_List (List) then
3593          Node := First (List);
3594
3595          loop
3596             Sprint_Node (Node);
3597             Next (Node);
3598             exit when Node = Empty;
3599          end loop;
3600       end if;
3601
3602       if New_Lines and then Column /= 1 then
3603          Write_Eol;
3604       end if;
3605    end Sprint_Node_List;
3606
3607    ----------------------
3608    -- Sprint_Node_Sloc --
3609    ----------------------
3610
3611    procedure Sprint_Node_Sloc (Node : Node_Id) is
3612    begin
3613       Sprint_Node (Node);
3614
3615       if Debug_Generated_Code and then Present (Dump_Node) then
3616          Set_Sloc (Dump_Node, Sloc (Node));
3617          Dump_Node := Empty;
3618       end if;
3619    end Sprint_Node_Sloc;
3620
3621    ---------------------
3622    -- Sprint_Opt_Node --
3623    ---------------------
3624
3625    procedure Sprint_Opt_Node (Node : Node_Id) is
3626    begin
3627       if Present (Node) then
3628          Write_Char (' ');
3629          Sprint_Node (Node);
3630       end if;
3631    end Sprint_Opt_Node;
3632
3633    --------------------------
3634    -- Sprint_Opt_Node_List --
3635    --------------------------
3636
3637    procedure Sprint_Opt_Node_List (List : List_Id) is
3638    begin
3639       if Present (List) then
3640          Sprint_Node_List (List);
3641       end if;
3642    end Sprint_Opt_Node_List;
3643
3644    ---------------------------------
3645    -- Sprint_Opt_Paren_Comma_List --
3646    ---------------------------------
3647
3648    procedure Sprint_Opt_Paren_Comma_List (List : List_Id) is
3649    begin
3650       if Is_Non_Empty_List (List) then
3651          Write_Char (' ');
3652          Sprint_Paren_Comma_List (List);
3653       end if;
3654    end Sprint_Opt_Paren_Comma_List;
3655
3656    -----------------------------
3657    -- Sprint_Paren_Comma_List --
3658    -----------------------------
3659
3660    procedure Sprint_Paren_Comma_List (List : List_Id) is
3661       N           : Node_Id;
3662       Node_Exists : Boolean := False;
3663
3664    begin
3665
3666       if Is_Non_Empty_List (List) then
3667
3668          if Dump_Original_Only then
3669             N := First (List);
3670             while Present (N) loop
3671                if not Is_Rewrite_Insertion (N) then
3672                   Node_Exists := True;
3673                   exit;
3674                end if;
3675
3676                Next (N);
3677             end loop;
3678
3679             if not Node_Exists then
3680                return;
3681             end if;
3682          end if;
3683
3684          Write_Str_With_Col_Check ("(");
3685          Sprint_Comma_List (List);
3686          Write_Char (')');
3687       end if;
3688    end Sprint_Paren_Comma_List;
3689
3690    ----------------------
3691    -- Sprint_Right_Opnd --
3692    ----------------------
3693
3694    procedure Sprint_Right_Opnd (N : Node_Id) is
3695       Opnd : constant Node_Id := Right_Opnd (N);
3696
3697    begin
3698       if Paren_Count (Opnd) /= 0
3699         or else Op_Prec (Nkind (Opnd)) > Op_Prec (Nkind (N))
3700       then
3701          Sprint_Node (Opnd);
3702
3703       else
3704          Write_Char ('(');
3705          Sprint_Node (Opnd);
3706          Write_Char (')');
3707       end if;
3708    end Sprint_Right_Opnd;
3709
3710    ------------------
3711    -- Update_Itype --
3712    ------------------
3713
3714    procedure Update_Itype (Node : Node_Id) is
3715    begin
3716       if Present (Etype (Node))
3717         and then Is_Itype (Etype (Node))
3718         and then Debug_Generated_Code
3719       then
3720          Set_Sloc (Etype (Node), Sloc (Node));
3721       end if;
3722    end Update_Itype;
3723
3724    ---------------------
3725    -- Write_Char_Sloc --
3726    ---------------------
3727
3728    procedure Write_Char_Sloc (C : Character) is
3729    begin
3730       if Debug_Generated_Code and then C /= ' ' then
3731          Set_Debug_Sloc;
3732       end if;
3733
3734       Write_Char (C);
3735    end Write_Char_Sloc;
3736
3737    --------------------------------
3738    -- Write_Condition_And_Reason --
3739    --------------------------------
3740
3741    procedure Write_Condition_And_Reason (Node : Node_Id) is
3742       Cond  : constant Node_Id := Condition (Node);
3743       Image : constant String  := RT_Exception_Code'Image
3744                                     (RT_Exception_Code'Val
3745                                        (UI_To_Int (Reason (Node))));
3746
3747    begin
3748       if Present (Cond) then
3749
3750          --  If condition is a single entity, or NOT with a single entity,
3751          --  output all on one line, since it will likely fit just fine.
3752
3753          if Is_Entity_Name (Cond)
3754            or else (Nkind (Cond) = N_Op_Not
3755                      and then Is_Entity_Name (Right_Opnd (Cond)))
3756          then
3757             Write_Str_With_Col_Check (" when ");
3758             Sprint_Node (Cond);
3759             Write_Char (' ');
3760
3761             --  Otherwise for more complex condition, multiple lines
3762
3763          else
3764             Write_Str_With_Col_Check (" when");
3765             Indent := Indent + 2;
3766             Write_Indent;
3767             Sprint_Node (Cond);
3768             Write_Indent;
3769             Indent := Indent - 2;
3770          end if;
3771
3772       --  If no condition, just need a space (all on one line)
3773
3774       else
3775          Write_Char (' ');
3776       end if;
3777
3778       --  Write the reason
3779
3780       Write_Char ('"');
3781
3782       for J in 4 .. Image'Last loop
3783          if Image (J) = '_' then
3784             Write_Char (' ');
3785          else
3786             Write_Char (Fold_Lower (Image (J)));
3787          end if;
3788       end loop;
3789
3790       Write_Str ("""]");
3791    end Write_Condition_And_Reason;
3792
3793    --------------------------------
3794    -- Write_Corresponding_Source --
3795    --------------------------------
3796
3797    procedure Write_Corresponding_Source (S : String) is
3798       Loc : Source_Ptr;
3799       Src : Source_Buffer_Ptr;
3800
3801    begin
3802       --  Ignore if there is no current source file, or we're not in dump
3803       --  source text mode, or if in freeze actions.
3804
3805       if Current_Source_File > No_Source_File
3806         and then Dump_Source_Text
3807         and then Freeze_Indent = 0
3808       then
3809
3810          --  Ignore null string
3811
3812          if S = "" then
3813             return;
3814          end if;
3815
3816          --  Ignore space or semicolon at end of given string
3817
3818          if S (S'Last) = ' ' or else S (S'Last) = ';' then
3819             Write_Corresponding_Source (S (S'First .. S'Last - 1));
3820             return;
3821          end if;
3822
3823          --  Loop to look at next lines not yet printed in source file
3824
3825          for L in
3826            Last_Line_Printed + 1 .. Last_Source_Line (Current_Source_File)
3827          loop
3828             Src := Source_Text (Current_Source_File);
3829             Loc := Line_Start (L, Current_Source_File);
3830
3831             --  If comment, keep looking
3832
3833             if Src (Loc .. Loc + 1) = "--" then
3834                null;
3835
3836             --  Search to first non-blank
3837
3838             else
3839                while Src (Loc) not in Line_Terminator loop
3840
3841                   --  Non-blank found
3842
3843                   if Src (Loc) /= ' ' and then Src (Loc) /= ASCII.HT then
3844
3845                      --  Loop through characters in string to see if we match
3846
3847                      for J in S'Range loop
3848
3849                         --  If mismatch, then not the case we are looking for
3850
3851                         if Src (Loc) /= S (J) then
3852                            return;
3853                         end if;
3854
3855                         Loc := Loc + 1;
3856                      end loop;
3857
3858                      --  If we fall through, string matched, if white space or
3859                      --  semicolon after the matched string, this is the case
3860                      --  we are looking for.
3861
3862                      if Src (Loc) in Line_Terminator
3863                        or else Src (Loc) = ' '
3864                        or else Src (Loc) = ASCII.HT
3865                        or else Src (Loc) = ';'
3866                      then
3867                         --  So output source lines up to and including this one
3868
3869                         Write_Source_Lines (L);
3870                         return;
3871                      end if;
3872                   end if;
3873
3874                   Loc := Loc + 1;
3875                end loop;
3876             end if;
3877
3878          --  Line was all blanks, or a comment line, keep looking
3879
3880          end loop;
3881       end if;
3882    end Write_Corresponding_Source;
3883
3884    -----------------------
3885    -- Write_Discr_Specs --
3886    -----------------------
3887
3888    procedure Write_Discr_Specs (N : Node_Id) is
3889       Specs : List_Id;
3890       Spec  : Node_Id;
3891
3892    begin
3893       Specs := Discriminant_Specifications (N);
3894
3895       if Present (Specs) then
3896          Write_Str_With_Col_Check (" (");
3897          Spec := First (Specs);
3898
3899          loop
3900             Sprint_Node (Spec);
3901             Next (Spec);
3902             exit when Spec = Empty;
3903
3904             --  Add semicolon, unless we are printing original tree and the
3905             --  next specification is part of a list (but not the first
3906             --  element of that list)
3907
3908             if not Dump_Original_Only or else not Prev_Ids (Spec) then
3909                Write_Str ("; ");
3910             end if;
3911          end loop;
3912
3913          Write_Char (')');
3914       end if;
3915    end Write_Discr_Specs;
3916
3917    -----------------
3918    -- Write_Ekind --
3919    -----------------
3920
3921    procedure Write_Ekind (E : Entity_Id) is
3922       S : constant String := Entity_Kind'Image (Ekind (E));
3923
3924    begin
3925       Name_Len := S'Length;
3926       Name_Buffer (1 .. Name_Len) := S;
3927       Set_Casing (Mixed_Case);
3928       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3929    end Write_Ekind;
3930
3931    --------------
3932    -- Write_Id --
3933    --------------
3934
3935    procedure Write_Id (N : Node_Id) is
3936    begin
3937       --  Deal with outputting Itype
3938
3939       --  Note: if we are printing the full tree with -gnatds, then we may
3940       --  end up picking up the Associated_Node link from a generic template
3941       --  here which overlaps the Entity field, but as documented, Write_Itype
3942       --  is defended against junk calls.
3943
3944       if Nkind (N) in N_Entity then
3945          Write_Itype (N);
3946       elsif Nkind (N) in N_Has_Entity then
3947          Write_Itype (Entity (N));
3948       end if;
3949
3950       --  Case of a defining identifier
3951
3952       if Nkind (N) = N_Defining_Identifier then
3953
3954          --  If defining identifier has an interface name (and no
3955          --  address clause), then we output the interface name.
3956
3957          if (Is_Imported (N) or else Is_Exported (N))
3958            and then Present (Interface_Name (N))
3959            and then No (Address_Clause (N))
3960          then
3961             String_To_Name_Buffer (Strval (Interface_Name (N)));
3962             Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3963
3964          --  If no interface name (or inactive because there was
3965          --  an address clause), then just output the Chars name.
3966
3967          else
3968             Write_Name_With_Col_Check (Chars (N));
3969          end if;
3970
3971       --  Case of selector of an expanded name where the expanded name
3972       --  has an associated entity, output this entity. Check that the
3973       --  entity or associated node is of the right kind, see above.
3974
3975       elsif Nkind (Parent (N)) = N_Expanded_Name
3976         and then Selector_Name (Parent (N)) = N
3977         and then Present (Entity_Or_Associated_Node (Parent (N)))
3978         and then Nkind (Entity (Parent (N))) in N_Entity
3979       then
3980          Write_Id (Entity (Parent (N)));
3981
3982       --  For any other node with an associated entity, output it
3983
3984       elsif Nkind (N) in N_Has_Entity
3985         and then Present (Entity_Or_Associated_Node (N))
3986         and then Nkind (Entity_Or_Associated_Node (N)) in N_Entity
3987       then
3988          Write_Id (Entity (N));
3989
3990       --  All other cases, we just print the Chars field
3991
3992       else
3993          Write_Name_With_Col_Check (Chars (N));
3994       end if;
3995    end Write_Id;
3996
3997    -----------------------
3998    -- Write_Identifiers --
3999    -----------------------
4000
4001    function Write_Identifiers (Node : Node_Id) return Boolean is
4002    begin
4003       Sprint_Node (Defining_Identifier (Node));
4004       Update_Itype (Defining_Identifier (Node));
4005
4006       --  The remainder of the declaration must be printed unless we are
4007       --  printing the original tree and this is not the last identifier
4008
4009       return
4010          not Dump_Original_Only or else not More_Ids (Node);
4011
4012    end Write_Identifiers;
4013
4014    ------------------------
4015    -- Write_Implicit_Def --
4016    ------------------------
4017
4018    procedure Write_Implicit_Def (E : Entity_Id) is
4019       Ind : Node_Id;
4020
4021    begin
4022       case Ekind (E) is
4023          when E_Array_Subtype =>
4024             Write_Str_With_Col_Check ("subtype ");
4025             Write_Id (E);
4026             Write_Str_With_Col_Check (" is ");
4027             Write_Id (Base_Type (E));
4028             Write_Str_With_Col_Check (" (");
4029
4030             Ind := First_Index (E);
4031             while Present (Ind) loop
4032                Sprint_Node (Ind);
4033                Next_Index (Ind);
4034
4035                if Present (Ind) then
4036                   Write_Str (", ");
4037                end if;
4038             end loop;
4039
4040             Write_Str (");");
4041
4042          when E_Enumeration_Subtype
4043             | E_Signed_Integer_Subtype
4044          =>
4045             Write_Str_With_Col_Check ("subtype ");
4046             Write_Id (E);
4047             Write_Str (" is ");
4048             Write_Id (Etype (E));
4049             Write_Str_With_Col_Check (" range ");
4050             Sprint_Node (Scalar_Range (E));
4051             Write_Str (";");
4052
4053          when others =>
4054             Write_Str_With_Col_Check ("type ");
4055             Write_Id (E);
4056             Write_Str_With_Col_Check (" is <");
4057             Write_Ekind (E);
4058             Write_Str (">;");
4059       end case;
4060    end Write_Implicit_Def;
4061
4062    ------------------
4063    -- Write_Indent --
4064    ------------------
4065
4066    procedure Write_Indent is
4067       Loc : constant Source_Ptr := Sloc (Dump_Node);
4068
4069    begin
4070       if Indent_Annull_Flag then
4071          Indent_Annull_Flag := False;
4072       else
4073          --  Deal with Dump_Source_Text output. Note that we ignore implicit
4074          --  label declarations, since they typically have the sloc of the
4075          --  corresponding label, which really messes up the -gnatL output.
4076
4077          if Dump_Source_Text
4078            and then Loc > No_Location
4079            and then Nkind (Dump_Node) /= N_Implicit_Label_Declaration
4080          then
4081             if Get_Source_File_Index (Loc) = Current_Source_File then
4082                Write_Source_Lines
4083                  (Get_Physical_Line_Number (Sloc (Dump_Node)));
4084             end if;
4085          end if;
4086
4087          Write_Eol;
4088
4089          for J in 1 .. Indent loop
4090             Write_Char (' ');
4091          end loop;
4092       end if;
4093    end Write_Indent;
4094
4095    ------------------------------
4096    -- Write_Indent_Identifiers --
4097    ------------------------------
4098
4099    function Write_Indent_Identifiers (Node : Node_Id) return Boolean is
4100    begin
4101       --  We need to start a new line for every node, except in the case
4102       --  where we are printing the original tree and this is not the first
4103       --  defining identifier in the list.
4104
4105       if not Dump_Original_Only or else not Prev_Ids (Node) then
4106          Write_Indent;
4107
4108       --  If printing original tree and this is not the first defining
4109       --  identifier in the list, then the previous call to this procedure
4110       --  printed only the name, and we add a comma to separate the names.
4111
4112       else
4113          Write_Str (", ");
4114       end if;
4115
4116       Sprint_Node (Defining_Identifier (Node));
4117
4118       --  The remainder of the declaration must be printed unless we are
4119       --  printing the original tree and this is not the last identifier
4120
4121       return
4122          not Dump_Original_Only or else not More_Ids (Node);
4123    end Write_Indent_Identifiers;
4124
4125    -----------------------------------
4126    -- Write_Indent_Identifiers_Sloc --
4127    -----------------------------------
4128
4129    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean is
4130    begin
4131       --  We need to start a new line for every node, except in the case
4132       --  where we are printing the original tree and this is not the first
4133       --  defining identifier in the list.
4134
4135       if not Dump_Original_Only or else not Prev_Ids (Node) then
4136          Write_Indent;
4137
4138       --  If printing original tree and this is not the first defining
4139       --  identifier in the list, then the previous call to this procedure
4140       --  printed only the name, and we add a comma to separate the names.
4141
4142       else
4143          Write_Str (", ");
4144       end if;
4145
4146       Set_Debug_Sloc;
4147       Sprint_Node (Defining_Identifier (Node));
4148
4149       --  The remainder of the declaration must be printed unless we are
4150       --  printing the original tree and this is not the last identifier
4151
4152       return not Dump_Original_Only or else not More_Ids (Node);
4153    end Write_Indent_Identifiers_Sloc;
4154
4155    ----------------------
4156    -- Write_Indent_Str --
4157    ----------------------
4158
4159    procedure Write_Indent_Str (S : String) is
4160    begin
4161       Write_Corresponding_Source (S);
4162       Write_Indent;
4163       Write_Str (S);
4164    end Write_Indent_Str;
4165
4166    ---------------------------
4167    -- Write_Indent_Str_Sloc --
4168    ---------------------------
4169
4170    procedure Write_Indent_Str_Sloc (S : String) is
4171    begin
4172       Write_Corresponding_Source (S);
4173       Write_Indent;
4174       Write_Str_Sloc (S);
4175    end Write_Indent_Str_Sloc;
4176
4177    -----------------
4178    -- Write_Itype --
4179    -----------------
4180
4181    procedure Write_Itype (Typ : Entity_Id) is
4182
4183       procedure Write_Header (T : Boolean := True);
4184       --  Write type if T is True, subtype if T is false
4185
4186       ------------------
4187       -- Write_Header --
4188       ------------------
4189
4190       procedure Write_Header (T : Boolean := True) is
4191       begin
4192          if T then
4193             Write_Str ("[type ");
4194          else
4195             Write_Str ("[subtype ");
4196          end if;
4197
4198          Write_Name_With_Col_Check (Chars (Typ));
4199          Write_Str (" is ");
4200       end Write_Header;
4201
4202    --  Start of processing for Write_Itype
4203
4204    begin
4205       if Nkind (Typ) in N_Entity
4206         and then Is_Itype (Typ)
4207         and then not Itype_Printed (Typ)
4208       then
4209          --  Itype to be printed
4210
4211          declare
4212             B : constant Node_Id := Etype (Typ);
4213             X : Node_Id;
4214             P : constant Node_Id := Parent (Typ);
4215
4216             S : constant Saved_Output_Buffer := Save_Output_Buffer;
4217             --  Save current output buffer
4218
4219             Old_Sloc : Source_Ptr;
4220             --  Save sloc of related node, so it is not modified when
4221             --  printing with -gnatD.
4222
4223          begin
4224             --  Write indentation at start of line
4225
4226             for J in 1 .. Indent loop
4227                Write_Char (' ');
4228             end loop;
4229
4230             --  If we have a constructed declaration for the itype, print it
4231
4232             if Present (P)
4233               and then Nkind (P) in N_Declaration
4234               and then Defining_Entity (P) = Typ
4235             then
4236                --  We must set Itype_Printed true before the recursive call to
4237                --  print the node, otherwise we get an infinite recursion.
4238
4239                Set_Itype_Printed (Typ, True);
4240
4241                --  Write the declaration enclosed in [], avoiding new line
4242                --  at start of declaration, and semicolon at end.
4243
4244                --  Note: The itype may be imported from another unit, in which
4245                --  case we do not want to modify the Sloc of the declaration.
4246                --  Otherwise the itype may appear to be in the current unit,
4247                --  and the back-end will reject a reference out of scope.
4248
4249                Write_Char ('[');
4250                Indent_Annull_Flag := True;
4251                Old_Sloc := Sloc (P);
4252                Sprint_Node (P);
4253                Set_Sloc (P, Old_Sloc);
4254                Write_Erase_Char (';');
4255
4256             --  If no constructed declaration, then we have to concoct the
4257             --  source corresponding to the type entity that we have at hand.
4258
4259             else
4260                case Ekind (Typ) is
4261
4262                   --  Access types and subtypes
4263
4264                   when Access_Kind =>
4265                      Write_Header (Ekind (Typ) = E_Access_Type);
4266
4267                      if Can_Never_Be_Null (Typ) then
4268                         Write_Str ("not null ");
4269                      end if;
4270
4271                      Write_Str ("access ");
4272
4273                      if Is_Access_Constant (Typ) then
4274                         Write_Str ("constant ");
4275                      end if;
4276
4277                      Write_Id (Directly_Designated_Type (Typ));
4278
4279                   --  Array types
4280
4281                   when E_Array_Type =>
4282                      Write_Header;
4283                      Write_Str ("array (");
4284
4285                      X := First_Index (Typ);
4286                      loop
4287                         Sprint_Node (X);
4288
4289                         if not Is_Constrained (Typ) then
4290                            Write_Str (" range <>");
4291                         end if;
4292
4293                         Next_Index (X);
4294                         exit when No (X);
4295                         Write_Str (", ");
4296                      end loop;
4297
4298                      Write_Str (") of ");
4299                      X := Component_Type (Typ);
4300
4301                      --  Preserve sloc of component type, which is defined
4302                      --  elsewhere than the itype (see comment above).
4303
4304                      Old_Sloc := Sloc (X);
4305                      Sprint_Node (X);
4306                      Set_Sloc (X, Old_Sloc);
4307
4308                      --  Array subtypes
4309
4310                      --  Preserve Sloc of index subtypes, as above
4311
4312                   when E_Array_Subtype =>
4313                      Write_Header (False);
4314                      Write_Id (Etype (Typ));
4315                      Write_Str (" (");
4316
4317                      X := First_Index (Typ);
4318                      loop
4319                         Old_Sloc := Sloc (X);
4320                         Sprint_Node (X);
4321                         Set_Sloc (X, Old_Sloc);
4322                         Next_Index (X);
4323                         exit when No (X);
4324                         Write_Str (", ");
4325                      end loop;
4326
4327                      Write_Char (')');
4328
4329                   --  Signed integer types, and modular integer subtypes,
4330                   --  and also enumeration subtypes.
4331
4332                   when E_Enumeration_Subtype
4333                      | E_Modular_Integer_Subtype
4334                      | E_Signed_Integer_Subtype
4335                      | E_Signed_Integer_Type
4336                   =>
4337                      Write_Header (Ekind (Typ) = E_Signed_Integer_Type);
4338
4339                      if Ekind (Typ) = E_Signed_Integer_Type then
4340                         Write_Str ("new ");
4341                      end if;
4342
4343                      Write_Id (B);
4344
4345                      --  Print bounds if different from base type
4346
4347                      declare
4348                         L  : constant Node_Id := Type_Low_Bound (Typ);
4349                         H  : constant Node_Id := Type_High_Bound (Typ);
4350                         LE : Node_Id;
4351                         HE : Node_Id;
4352
4353                      begin
4354                         --  B can either be a scalar type, in which case the
4355                         --  declaration of Typ may constrain it with different
4356                         --  bounds, or a private type, in which case we know
4357                         --  that the declaration of Typ cannot have a scalar
4358                         --  constraint.
4359
4360                         if Is_Scalar_Type (B) then
4361                            LE := Type_Low_Bound (B);
4362                            HE := Type_High_Bound (B);
4363                         else
4364                            LE := Empty;
4365                            HE := Empty;
4366                         end if;
4367
4368                         if No (LE)
4369                           or else (True
4370                             and then Nkind (L) = N_Integer_Literal
4371                             and then Nkind (H) = N_Integer_Literal
4372                             and then Nkind (LE) = N_Integer_Literal
4373                             and then Nkind (HE) = N_Integer_Literal
4374                             and then UI_Eq (Intval (L), Intval (LE))
4375                             and then UI_Eq (Intval (H), Intval (HE)))
4376                         then
4377                            null;
4378
4379                         else
4380                            Write_Str (" range ");
4381                            Sprint_Node (Type_Low_Bound (Typ));
4382                            Write_Str (" .. ");
4383                            Sprint_Node (Type_High_Bound (Typ));
4384                         end if;
4385                      end;
4386
4387                   --  Modular integer types
4388
4389                   when E_Modular_Integer_Type =>
4390                      Write_Header;
4391                      Write_Str ("mod ");
4392                      Write_Uint_With_Col_Check (Modulus (Typ), Auto);
4393
4394                   --  Floating point types and subtypes
4395
4396                   when E_Floating_Point_Subtype
4397                      | E_Floating_Point_Type
4398                   =>
4399                      Write_Header (Ekind (Typ) = E_Floating_Point_Type);
4400
4401                      if Ekind (Typ) = E_Floating_Point_Type then
4402                         Write_Str ("new ");
4403                      end if;
4404
4405                      Write_Id (Etype (Typ));
4406
4407                      if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then
4408                         Write_Str (" digits ");
4409                         Write_Uint_With_Col_Check
4410                           (Digits_Value (Typ), Decimal);
4411                      end if;
4412
4413                      --  Print bounds if not different from base type
4414
4415                      declare
4416                         L  : constant Node_Id := Type_Low_Bound (Typ);
4417                         H  : constant Node_Id := Type_High_Bound (Typ);
4418                         LE : constant Node_Id := Type_Low_Bound (B);
4419                         HE : constant Node_Id := Type_High_Bound (B);
4420
4421                      begin
4422                         if Nkind (L) = N_Real_Literal
4423                           and then Nkind (H) = N_Real_Literal
4424                           and then Nkind (LE) = N_Real_Literal
4425                           and then Nkind (HE) = N_Real_Literal
4426                           and then UR_Eq (Realval (L), Realval (LE))
4427                           and then UR_Eq (Realval (H), Realval (HE))
4428                         then
4429                            null;
4430
4431                         else
4432                            Write_Str (" range ");
4433                            Sprint_Node (Type_Low_Bound (Typ));
4434                            Write_Str (" .. ");
4435                            Sprint_Node (Type_High_Bound (Typ));
4436                         end if;
4437                      end;
4438
4439                   --  Record subtypes
4440
4441                   when E_Record_Subtype
4442                      | E_Record_Subtype_With_Private
4443                   =>
4444                      Write_Header (False);
4445                      Write_Str ("record");
4446                      Indent_Begin;
4447
4448                      declare
4449                         C : Entity_Id;
4450                      begin
4451                         C := First_Entity (Typ);
4452                         while Present (C) loop
4453                            Write_Indent;
4454                            Write_Id (C);
4455                            Write_Str (" : ");
4456                            Write_Id (Etype (C));
4457                            Next_Entity (C);
4458                         end loop;
4459                      end;
4460
4461                      Indent_End;
4462                      Write_Indent_Str (" end record");
4463
4464                   --  Class-Wide types
4465
4466                   when E_Class_Wide_Subtype
4467                      | E_Class_Wide_Type
4468                   =>
4469                      Write_Header (Ekind (Typ) = E_Class_Wide_Type);
4470                      Write_Name_With_Col_Check (Chars (Etype (Typ)));
4471                      Write_Str ("'Class");
4472
4473                   --  Subprogram types
4474
4475                   when E_Subprogram_Type =>
4476                      Write_Header;
4477
4478                      if Etype (Typ) = Standard_Void_Type then
4479                         Write_Str ("procedure");
4480                      else
4481                         Write_Str ("function");
4482                      end if;
4483
4484                      if Present (First_Entity (Typ)) then
4485                         Write_Str (" (");
4486
4487                         declare
4488                            Param : Entity_Id;
4489
4490                         begin
4491                            Param := First_Entity (Typ);
4492                            loop
4493                               Write_Id (Param);
4494                               Write_Str (" : ");
4495
4496                               if Ekind (Param) = E_In_Out_Parameter then
4497                                  Write_Str ("in out ");
4498                               elsif Ekind (Param) = E_Out_Parameter then
4499                                  Write_Str ("out ");
4500                               end if;
4501
4502                               Write_Id (Etype (Param));
4503                               Next_Entity (Param);
4504                               exit when No (Param);
4505                               Write_Str (", ");
4506                            end loop;
4507
4508                            Write_Char (')');
4509                         end;
4510                      end if;
4511
4512                      if Etype (Typ) /= Standard_Void_Type then
4513                         Write_Str (" return ");
4514                         Write_Id (Etype (Typ));
4515                      end if;
4516
4517                   when E_String_Literal_Subtype =>
4518                      declare
4519                         LB  : constant Uint :=
4520                                 Expr_Value (String_Literal_Low_Bound (Typ));
4521                         Len : constant Uint :=
4522                                 String_Literal_Length (Typ);
4523                      begin
4524                         Write_Header (False);
4525                         Write_Str ("String (");
4526                         Write_Int (UI_To_Int (LB));
4527                         Write_Str (" .. ");
4528                         Write_Int (UI_To_Int (LB + Len) - 1);
4529                         Write_Str (");");
4530                      end;
4531
4532                   --  For all other Itypes, print ??? (fill in later)
4533
4534                   when others =>
4535                      Write_Header (True);
4536                      Write_Str ("???");
4537                end case;
4538             end if;
4539
4540             --  Add terminating bracket and restore output buffer
4541
4542             Write_Char (']');
4543             Write_Eol;
4544             Restore_Output_Buffer (S);
4545          end;
4546
4547          Set_Itype_Printed (Typ);
4548       end if;
4549    end Write_Itype;
4550
4551    -------------------------------
4552    -- Write_Name_With_Col_Check --
4553    -------------------------------
4554
4555    procedure Write_Name_With_Col_Check (N : Name_Id) is
4556       J : Natural;
4557       K : Natural;
4558       L : Natural;
4559
4560    begin
4561       --  Avoid crashing on invalid Name_Ids
4562
4563       if not Is_Valid_Name (N) then
4564          Write_Str ("<invalid name ");
4565          Write_Int (Int (N));
4566          Write_Str (">");
4567          return;
4568       end if;
4569
4570       Get_Name_String (N);
4571
4572       --  Deal with -gnatdI which replaces any sequence Cnnnb where C is an
4573       --  upper case letter, nnn is one or more digits and b is a lower case
4574       --  letter by C...b, so that listings do not depend on serial numbers.
4575
4576       if Debug_Flag_II then
4577          J := 1;
4578          while J < Name_Len - 1 loop
4579             if Name_Buffer (J) in 'A' .. 'Z'
4580               and then Name_Buffer (J + 1) in '0' .. '9'
4581             then
4582                K := J + 1;
4583                while K < Name_Len loop
4584                   exit when Name_Buffer (K) not in '0' .. '9';
4585                   K := K + 1;
4586                end loop;
4587
4588                if Name_Buffer (K) in 'a' .. 'z' then
4589                   L := Name_Len - K + 1;
4590
4591                   Name_Buffer (J + 4 .. J + L + 3) :=
4592                     Name_Buffer (K .. Name_Len);
4593                   Name_Buffer (J + 1 .. J + 3) := "...";
4594                   Name_Len := J + L + 3;
4595                   J := J + 5;
4596
4597                else
4598                   J := K;
4599                end if;
4600
4601             else
4602                J := J + 1;
4603             end if;
4604          end loop;
4605       end if;
4606
4607       --  Fall through for normal case
4608
4609       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
4610    end Write_Name_With_Col_Check;
4611
4612    ------------------------------------
4613    -- Write_Name_With_Col_Check_Sloc --
4614    ------------------------------------
4615
4616    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
4617    begin
4618       --  Avoid crashing on invalid Name_Ids
4619
4620       if not Is_Valid_Name (N) then
4621          Write_Str ("<invalid name ");
4622          Write_Int (Int (N));
4623          Write_Str (">");
4624          return;
4625       end if;
4626
4627       Get_Name_String (N);
4628       Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
4629    end Write_Name_With_Col_Check_Sloc;
4630
4631    --------------------
4632    -- Write_Operator --
4633    --------------------
4634
4635    procedure Write_Operator (N : Node_Id; S : String) is
4636       F : Natural := S'First;
4637       T : Natural := S'Last;
4638
4639    begin
4640       --  If no overflow check, just write string out, and we are done
4641
4642       if not Do_Overflow_Check (N) then
4643          Write_Str_Sloc (S);
4644
4645       --  If overflow check, we want to surround the operator with curly
4646       --  brackets, but not include spaces within the brackets.
4647
4648       else
4649          if S (F) = ' ' then
4650             Write_Char (' ');
4651             F := F + 1;
4652          end if;
4653
4654          if S (T) = ' ' then
4655             T := T - 1;
4656          end if;
4657
4658          Write_Char ('{');
4659          Write_Str_Sloc (S (F .. T));
4660          Write_Char ('}');
4661
4662          if S (S'Last) = ' ' then
4663             Write_Char (' ');
4664          end if;
4665       end if;
4666    end Write_Operator;
4667
4668    -----------------------
4669    -- Write_Param_Specs --
4670    -----------------------
4671
4672    procedure Write_Param_Specs (N : Node_Id) is
4673       Specs         : constant List_Id := Parameter_Specifications (N);
4674       Specs_Present : constant Boolean := Is_Non_Empty_List (Specs);
4675
4676       Ent    : Entity_Id;
4677       Extras : Node_Id;
4678       Spec   : Node_Id;
4679       Formal : Node_Id;
4680
4681       Output : Boolean := False;
4682       --  Set true if we output at least one parameter
4683
4684    begin
4685       --  Write out explicit specs from Parameter_Speficiations list
4686
4687       if Specs_Present then
4688          Write_Str_With_Col_Check (" (");
4689          Output := True;
4690
4691          Spec := First (Specs);
4692          loop
4693             Sprint_Node (Spec);
4694             Formal := Defining_Identifier (Spec);
4695             Next (Spec);
4696             exit when Spec = Empty;
4697
4698             --  Add semicolon, unless we are printing original tree and the
4699             --  next specification is part of a list (but not the first element
4700             --  of that list).
4701
4702             if not Dump_Original_Only or else not Prev_Ids (Spec) then
4703                Write_Str ("; ");
4704             end if;
4705          end loop;
4706       end if;
4707
4708       --  See if we have extra formals
4709
4710       if Nkind_In (N, N_Function_Specification,
4711                       N_Procedure_Specification)
4712       then
4713          Ent := Defining_Entity (N);
4714
4715          --  Loop to write extra formals (if any)
4716
4717          if Present (Ent) and then Is_Subprogram (Ent) then
4718             Extras := Extra_Formals (Ent);
4719
4720             if Present (Extras) then
4721                if not Specs_Present then
4722                   Write_Str_With_Col_Check (" (");
4723                   Output := True;
4724                end if;
4725
4726                Formal := Extras;
4727                while Present (Formal) loop
4728                   if Specs_Present or else Formal /= Extras then
4729                      Write_Str ("; ");
4730                   end if;
4731
4732                   Write_Name_With_Col_Check (Chars (Formal));
4733                   Write_Str (" : ");
4734                   Write_Name_With_Col_Check (Chars (Etype (Formal)));
4735                   Formal := Extra_Formal (Formal);
4736                end loop;
4737             end if;
4738          end if;
4739       end if;
4740
4741       if Output then
4742          Write_Char (')');
4743       end if;
4744    end Write_Param_Specs;
4745
4746    -----------------------
4747    -- Write_Rewrite_Str --
4748    -----------------------
4749
4750    procedure Write_Rewrite_Str (S : String) is
4751    begin
4752       if not Dump_Generated_Only then
4753          if S'Length = 3 and then S = ">>>" then
4754             Write_Str (">>>");
4755          else
4756             Write_Str_With_Col_Check (S);
4757          end if;
4758       end if;
4759    end Write_Rewrite_Str;
4760
4761    -----------------------
4762    -- Write_Source_Line --
4763    -----------------------
4764
4765    procedure Write_Source_Line (L : Physical_Line_Number) is
4766       Loc : Source_Ptr;
4767       Src : Source_Buffer_Ptr;
4768       Scn : Source_Ptr;
4769
4770    begin
4771       if Dump_Source_Text then
4772          Src := Source_Text (Current_Source_File);
4773          Loc := Line_Start (L, Current_Source_File);
4774          Write_Eol;
4775
4776          --  See if line is a comment line, if not, and if not line one,
4777          --  precede with blank line.
4778
4779          Scn := Loc;
4780          while Src (Scn) = ' ' or else Src (Scn) = ASCII.HT loop
4781             Scn := Scn + 1;
4782          end loop;
4783
4784          if (Src (Scn) in Line_Terminator
4785               or else Src (Scn .. Scn + 1) /= "--")
4786            and then L /= 1
4787          then
4788             Write_Eol;
4789          end if;
4790
4791          --  Now write the source text of the line
4792
4793          Write_Str ("-- ");
4794          Write_Int (Int (L));
4795          Write_Str (": ");
4796
4797          while Src (Loc) not in Line_Terminator loop
4798             Write_Char (Src (Loc));
4799             Loc := Loc + 1;
4800          end loop;
4801       end if;
4802    end Write_Source_Line;
4803
4804    ------------------------
4805    -- Write_Source_Lines --
4806    ------------------------
4807
4808    procedure Write_Source_Lines (L : Physical_Line_Number) is
4809    begin
4810       while Last_Line_Printed < L loop
4811          Last_Line_Printed := Last_Line_Printed + 1;
4812          Write_Source_Line (Last_Line_Printed);
4813       end loop;
4814    end Write_Source_Lines;
4815
4816    --------------------
4817    -- Write_Str_Sloc --
4818    --------------------
4819
4820    procedure Write_Str_Sloc (S : String) is
4821    begin
4822       for J in S'Range loop
4823          Write_Char_Sloc (S (J));
4824       end loop;
4825    end Write_Str_Sloc;
4826
4827    ------------------------------
4828    -- Write_Str_With_Col_Check --
4829    ------------------------------
4830
4831    procedure Write_Str_With_Col_Check (S : String) is
4832    begin
4833       if Int (S'Last) + Column > Sprint_Line_Limit then
4834          Write_Indent_Str ("  ");
4835
4836          if S (S'First) = ' ' then
4837             Write_Str (S (S'First + 1 .. S'Last));
4838          else
4839             Write_Str (S);
4840          end if;
4841
4842       else
4843          Write_Str (S);
4844       end if;
4845    end Write_Str_With_Col_Check;
4846
4847    -----------------------------------
4848    -- Write_Str_With_Col_Check_Sloc --
4849    -----------------------------------
4850
4851    procedure Write_Str_With_Col_Check_Sloc (S : String) is
4852    begin
4853       if Int (S'Last) + Column > Sprint_Line_Limit then
4854          Write_Indent_Str ("  ");
4855
4856          if S (S'First) = ' ' then
4857             Write_Str_Sloc (S (S'First + 1 .. S'Last));
4858          else
4859             Write_Str_Sloc (S);
4860          end if;
4861
4862       else
4863          Write_Str_Sloc (S);
4864       end if;
4865    end Write_Str_With_Col_Check_Sloc;
4866
4867    ---------------------------
4868    -- Write_Subprogram_Name --
4869    ---------------------------
4870
4871    procedure Write_Subprogram_Name (N : Node_Id) is
4872    begin
4873       if not Comes_From_Source (N)
4874         and then Is_Entity_Name (N)
4875       then
4876          declare
4877             Ent : constant Entity_Id := Entity (N);
4878          begin
4879             if not In_Extended_Main_Source_Unit (Ent)
4880               and then In_Predefined_Unit (Ent)
4881             then
4882                --  Run-time routine name, output name with a preceding dollar
4883                --  making sure that we do not get a line split between them.
4884
4885                Col_Check (Length_Of_Name (Chars (Ent)) + 1);
4886                Write_Char ('$');
4887                Write_Name (Chars (Ent));
4888                return;
4889             end if;
4890          end;
4891       end if;
4892
4893       --  Normal case, not a run-time routine name
4894
4895       Sprint_Node (N);
4896    end Write_Subprogram_Name;
4897
4898    -------------------------------
4899    -- Write_Uint_With_Col_Check --
4900    -------------------------------
4901
4902    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format) is
4903    begin
4904       Col_Check (UI_Decimal_Digits_Hi (U));
4905       UI_Write (U, Format);
4906    end Write_Uint_With_Col_Check;
4907
4908    ------------------------------------
4909    -- Write_Uint_With_Col_Check_Sloc --
4910    ------------------------------------
4911
4912    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format) is
4913    begin
4914       Col_Check (UI_Decimal_Digits_Hi (U));
4915       Set_Debug_Sloc;
4916       UI_Write (U, Format);
4917    end Write_Uint_With_Col_Check_Sloc;
4918
4919    -------------------------------------
4920    -- Write_Ureal_With_Col_Check_Sloc --
4921    -------------------------------------
4922
4923    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
4924       D : constant Uint := Denominator (U);
4925       N : constant Uint := Numerator (U);
4926    begin
4927       Col_Check (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
4928       Set_Debug_Sloc;
4929       UR_Write (U, Brackets => True);
4930    end Write_Ureal_With_Col_Check_Sloc;
4931
4932 end Sprint;